Copies a block subset
see block_partial_copy_a
Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
real(kind=real_4), | intent(inout), | DIMENSION(:, :) | :: | dst | ||
logical, | intent(in) | :: | dst_tr | |||
real(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 |
PURE_BLOCKOPS SUBROUTINE block_partial_copy_2d1d_s (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
REAL(kind=real_4), DIMENSION(:, :), &
INTENT(INOUT) :: dst
INTEGER, INTENT(IN) :: src_offset
LOGICAL, INTENT(IN) :: dst_tr
REAL(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_s