block_partial_copy_2d1d_c Subroutine

private subroutine block_partial_copy_2d1d_c(dst, dst_tr, src, src_rs, src_cs, src_tr, dst_r_lb, dst_c_lb, src_r_lb, src_c_lb, nrow, ncol, src_offset)

Copies a block subset

Note

see block_partial_copy_a

Arguments

Type IntentOptional Attributes Name
complex(kind=real_4), intent(inout), DIMENSION(:, :) :: dst
logical, intent(in) :: dst_tr
complex(kind=real_4), intent(in), DIMENSION(:) :: src
integer, intent(in) :: src_rs
integer, intent(in) :: src_cs
logical, intent(in) :: src_tr
integer, intent(in) :: dst_r_lb
integer, intent(in) :: dst_c_lb
integer, intent(in) :: src_r_lb
integer, intent(in) :: src_c_lb
integer, intent(in) :: nrow
integer, intent(in) :: ncol
integer, intent(in) :: src_offset

Source Code

      PURE_BLOCKOPS SUBROUTINE block_partial_copy_2d1d_c (dst, dst_tr, &
                                                                      src, src_rs, src_cs, src_tr, &
                                                                      dst_r_lb, dst_c_lb, src_r_lb, src_c_lb, nrow, ncol, &
                                                                      src_offset)
     !! Copies a block subset
     !! @note see block_partial_copy_a

#if defined(__LIBXSMM_BLOCKOPS)
         USE libxsmm, ONLY: libxsmm_matcopy, libxsmm_otrans, libxsmm_ptr0
#endif
         COMPLEX(kind=real_4), DIMENSION(:, :), &
            INTENT(INOUT)                         :: dst
         INTEGER, INTENT(IN)                      :: src_offset
         LOGICAL, INTENT(IN)                      :: dst_tr
         COMPLEX(kind=real_4), DIMENSION(:), &
            INTENT(IN)                            :: src
         INTEGER, INTENT(IN)                      :: src_rs, src_cs
         LOGICAL, INTENT(IN)                      :: src_tr
         INTEGER, INTENT(IN)                      :: dst_r_lb, dst_c_lb, src_r_lb, &
                                                     src_c_lb, nrow, ncol

         INTEGER                                  :: col, row
!    ---------------------------------------------------------------------------
!    Factors out the 4 combinations to remove branches from the inner loop.
!    rs is the logical row size so it always remains the leading dimension.
         IF (.NOT. dst_tr .AND. .NOT. src_tr) THEN
            DO col = 0, ncol - 1
               DO row = 0, nrow - 1
                  dst(dst_r_lb + row, dst_c_lb + col) &
                     = src(src_offset + src_r_lb + row + (src_c_lb + col - 1)*src_rs)
               END DO
            END DO
         ELSEIF (dst_tr .AND. .NOT. src_tr) THEN
            DO col = 0, ncol - 1
               DO row = 0, nrow - 1
                  dst(dst_c_lb + col, dst_r_lb + row) &
                     = src(src_offset + src_r_lb + row + (src_c_lb + col - 1)*src_rs)
               END DO
            END DO
         ELSEIF (.NOT. dst_tr .AND. src_tr) THEN
            DO col = 0, ncol - 1
               DO row = 0, nrow - 1
                  dst(dst_r_lb + row, dst_c_lb + col) &
                     = src(src_offset + src_c_lb + col + (src_r_lb + row - 1)*src_cs)
               END DO
            END DO
         ELSE
            DBCSR_ASSERT(dst_tr .AND. src_tr)
            DO col = 0, ncol - 1
               DO row = 0, nrow - 1
                  dst(dst_c_lb + col, dst_r_lb + row) &
                     = src(src_offset + src_c_lb + col + (src_r_lb + row - 1)*src_cs)
               END DO
            END DO
         END IF
      END SUBROUTINE block_partial_copy_2d1d_c