get_partial_conv1d_kernel_val Subroutine

  pure subroutine get_partial_conv1d_kernel_val(this, upstream_grad, output)
    !! Get partial derivative wrt kernel for 1D convolution (subroutine version)
    implicit none

    class(array_type), intent(in) :: this
    real(real32), dimension(:,:), intent(in) :: upstream_grad
    real(real32), dimension(:,:), intent(out) :: output

    ! Local variables
    integer :: i, k, c_in, c_out, s
    integer :: i_in, k_idx, out_idx
    integer :: input_h, kernel_h, output_h, num_channels, num_filters
    integer :: stride, dilation
    real(real32) :: grad_sum


    ! Unpack parameters
    num_channels = this%indices(1)
    num_filters = this%indices(2)
    stride = this%adj_ja(1,1)
    dilation = this%adj_ja(1,2)
    kernel_h = this%adj_ja(1,3)

    input_h = this%left_operand%shape(1)
    output_h = this%shape(1)

    output = 0._real32

    ! Parallelised over filters, channels, and kernel positions
    do concurrent(c_out = 1:num_filters, c_in = 1:num_channels, k = 1:kernel_h)
       k_idx = k + ( c_in - 1 ) * kernel_h + &
            ( c_out - 1 ) * kernel_h * num_channels

       grad_sum = 0._real32
       do s = 1, size(upstream_grad, dim=2)
          do i = 1, output_h
             i_in = ( i - 1 ) * stride + ( k - 1 ) * dilation + 1
             if(i_in .ge. 1 .and. i_in .le. input_h)then
                out_idx = i + ( c_out - 1 ) * output_h
                grad_sum = grad_sum + upstream_grad(out_idx, s) * &
                     this%left_operand%val(i_in + ( c_in - 1 ) * input_h, s)
             end if
          end do
       end do
       output(k_idx, 1) = grad_sum
    end do

  end subroutine get_partial_conv1d_kernel_val