Copies a block subset
see block_partial_copy_a
Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
complex(kind=real_8), | intent(inout), | DIMENSION(:) | :: | dst | ||
integer, | intent(in) | :: | dst_rs | |||
integer, | intent(in) | :: | dst_cs | |||
logical, | intent(in) | :: | dst_tr | |||
complex(kind=real_8), | intent(in), | DIMENSION(:, :) | :: | 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 |
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
#if defined(__LIBXSMM_BLOCKOPS)
USE libxsmm, ONLY: libxsmm_matcopy, libxsmm_otrans, libxsmm_ptr0
#else
INTEGER :: col, row
#endif
COMPLEX(kind=real_8), DIMENSION(:), &
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(:, :), &
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(__LIBXSMM_BLOCKOPS)
IF ((0 .LT. ncol) .AND. (0 .LT. nrow)) THEN
CALL libxsmm_matcopy(libxsmm_ptr0(dst(dst_offset + dst_r_lb + (dst_c_lb - 1)*dst_rs)), &
libxsmm_ptr0(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(__LIBXSMM_BLOCKOPS)
IF ((0 .LT. ncol) .AND. (0 .LT. nrow)) THEN
CALL libxsmm_otrans(libxsmm_ptr0(dst(dst_offset + dst_c_lb + (dst_r_lb - 1)*dst_cs)), &
libxsmm_ptr0(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(__LIBXSMM_BLOCKOPS)
IF ((0 .LT. ncol) .AND. (0 .LT. nrow)) THEN
CALL libxsmm_otrans(libxsmm_ptr0(dst(dst_offset + dst_r_lb + (dst_c_lb - 1)*dst_rs)), &
libxsmm_ptr0(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(__LIBXSMM_BLOCKOPS)
IF ((0 .LT. ncol) .AND. (0 .LT. nrow)) THEN
CALL libxsmm_matcopy(libxsmm_ptr0(dst(dst_offset + dst_c_lb + (dst_r_lb - 1)*dst_cs)), &
libxsmm_ptr0(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