get_partial_pack_mask_val Subroutine

pure subroutine get_partial_pack_mask_val(this, upstream_grad, output)

Arguments

Type IntentOptional Attributes Name
class(array_type), intent(in) :: this
real(kind=real32), intent(in), dimension(:,:) :: upstream_grad
real(kind=real32), intent(out), dimension(:,:) :: output

Source Code

  pure subroutine get_partial_pack_mask_val(this, upstream_grad, output)
    implicit none
    class(array_type), intent(in) :: this
    real(real32), dimension(:,:), intent(in) :: upstream_grad
    real(real32), dimension(:,:), intent(out) :: output

    integer :: i, j, s, itmp1

    output = 0.0_real32
    if(allocated(this%indices))then
       itmp1 = size(this%indices)
       if(this%adj_ja(1,1).eq.1)then
          do concurrent(s=1:size(upstream_grad,2), j=1:itmp1)
             output(this%indices(j), s) = upstream_grad(j, s)
          end do
       elseif(this%adj_ja(1,1).eq.2)then
          do concurrent(s=1:itmp1, j=1:size(upstream_grad,1))
             output(j, this%indices(s)) = upstream_grad(j, s)
          end do
       end if
    end if
  end subroutine get_partial_pack_mask_val