block_partial_copy_1d2d_z Subroutine

private subroutine block_partial_copy_1d2d_z(dst, dst_rs, dst_cs, dst_tr, src, src_tr, dst_r_lb, dst_c_lb, src_r_lb, src_c_lb, nrow, ncol, dst_offset)

Copies a block subset

Note

see block_partial_copy_a

Arguments

Type IntentOptional Attributes Name
complex(kind=real_8), intent(inout), DIMENSION(:), TARGET :: dst
integer, intent(in) :: dst_rs
integer, intent(in) :: dst_cs
logical, intent(in) :: dst_tr
complex(kind=real_8), intent(in), DIMENSION(:, :), TARGET :: src
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) :: dst_offset

Source Code

      PURE_BLOCKOPS SUBROUTINE block_partial_copy_1d2d_z (dst, dst_rs, dst_cs, dst_tr, &
                                                                      src, src_tr, &
                                                                      dst_r_lb, dst_c_lb, src_r_lb, src_c_lb, nrow, ncol, &
                                                                      dst_offset)
     !! Copies a block subset
     !! @note
     !! see block_partial_copy_a
     !! @endnote

#if defined(__LIBXS)
         USE LIBXS, ONLY: libxs_matcopy, libxs_otrans, C_LOC
#else
         INTEGER                                  :: col, row
#endif
         COMPLEX(kind=real_8), DIMENSION(:), TARGET, &
            INTENT(INOUT)                         :: dst
         INTEGER, INTENT(IN)                      :: dst_rs, dst_cs
         INTEGER, INTENT(IN)                      :: dst_offset
         LOGICAL, INTENT(IN)                      :: dst_tr
         COMPLEX(kind=real_8), DIMENSION(:, :), TARGET, &
            INTENT(IN)                            :: src
         LOGICAL, INTENT(IN)                      :: src_tr
         INTEGER, INTENT(IN)                      :: dst_r_lb, dst_c_lb, src_r_lb, &
                                                     src_c_lb, nrow, ncol

!    ---------------------------------------------------------------------------
!    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
#if defined(__LIBXS)
            IF ((0 .LT. ncol) .AND. (0 .LT. nrow)) THEN
               CALL libxs_matcopy(C_LOC(dst(dst_offset + dst_r_lb + (dst_c_lb - 1)*dst_rs)), &
                                  C_LOC(src(src_r_lb, src_c_lb)), &
                                  16, nrow, ncol, SIZE(src, 1), dst_rs)
            END IF
#else
            DO col = 0, ncol - 1
               DO row = 0, nrow - 1
                  dst(dst_offset + dst_r_lb + row + (dst_c_lb + col - 1)*dst_rs) &
                     = src(src_r_lb + row, src_c_lb + col)
               END DO
            END DO
#endif
         ELSEIF (dst_tr .AND. .NOT. src_tr) THEN
#if defined(__LIBXS)
            IF ((0 .LT. ncol) .AND. (0 .LT. nrow)) THEN
               CALL libxs_otrans(C_LOC(dst(dst_offset + dst_c_lb + (dst_r_lb - 1)*dst_cs)), &
                                 C_LOC(src(src_r_lb, src_c_lb)), &
                                 16, nrow, ncol, SIZE(src, 1), dst_cs)
            END IF
#else
            DO col = 0, ncol - 1
               DO row = 0, nrow - 1
                  dst(dst_offset + dst_c_lb + col + (dst_r_lb + row - 1)*dst_cs) &
                     = src(src_r_lb + row, src_c_lb + col)
               END DO
            END DO
#endif
         ELSEIF (.NOT. dst_tr .AND. src_tr) THEN
#if defined(__LIBXS)
            IF ((0 .LT. ncol) .AND. (0 .LT. nrow)) THEN
               CALL libxs_otrans(C_LOC(dst(dst_offset + dst_r_lb + (dst_c_lb - 1)*dst_rs)), &
                                 C_LOC(src(src_c_lb, src_r_lb)), &
                                 16, nrow, ncol, SIZE(src, 2), dst_rs)
            END IF
#else
            DO col = 0, ncol - 1
               DO row = 0, nrow - 1
                  dst(dst_offset + dst_r_lb + row + (dst_c_lb + col - 1)*dst_rs) &
                     = src(src_c_lb + col, src_r_lb + row)
               END DO
            END DO
#endif
         ELSE
            DBCSR_ASSERT(dst_tr .AND. src_tr)
#if defined(__LIBXS)
            IF ((0 .LT. ncol) .AND. (0 .LT. nrow)) THEN
               CALL libxs_matcopy(C_LOC(dst(dst_offset + dst_c_lb + (dst_r_lb - 1)*dst_cs)), &
                                  C_LOC(src(src_c_lb, src_r_lb)), &
                                  16, nrow, ncol, SIZE(src, 2), dst_cs)
            END IF
#else
            DO col = 0, ncol - 1
               DO row = 0, nrow - 1
                  dst(dst_offset + dst_c_lb + col + (dst_r_lb + row - 1)*dst_cs) &
                     = src(src_c_lb + col, src_r_lb + row)
               END DO
            END DO
#endif
         END IF
      END SUBROUTINE block_partial_copy_1d2d_z