Copy data from one data area to another, the most basic form. There are no checks done for correctness!
| Type | Intent | Optional | Attributes | Name | ||
|---|---|---|---|---|---|---|
| type(dbcsr_data_obj), | intent(inout) | :: | dst |
destination data area |
||
| integer, | intent(in), | DIMENSION(:) | :: | dst_lb |
lower bounds for destination sizes for destination |
|
| integer, | intent(in), | DIMENSION(:) | :: | dst_sizes |
lower bounds for destination sizes for destination |
|
| type(dbcsr_data_obj), | intent(in) | :: | src |
source data area |
||
| integer, | intent(in), | DIMENSION(:) | :: | src_lb |
lower bounds for source sizes for source |
|
| integer, | intent(in), | DIMENSION(:) | :: | src_sizes |
lower bounds for source sizes for source |
SUBROUTINE dbcsr_data_copy_aa2(dst, dst_lb, dst_sizes, &
src, src_lb, src_sizes)
!! Copy data from one data area to another, the most basic form.
!! There are no checks done for correctness!
TYPE(dbcsr_data_obj), INTENT(INOUT) :: dst
!! destination data area
INTEGER, DIMENSION(:), INTENT(IN) :: dst_lb, dst_sizes
!! lower bounds for destination
!! sizes for destination
TYPE(dbcsr_data_obj), INTENT(IN) :: src
!! source data area
INTEGER, DIMENSION(:), INTENT(IN) :: src_lb, src_sizes
!! lower bounds for source
!! sizes for source
CHARACTER(len=*), PARAMETER :: routineN = 'dbcsr_data_copy_aa2'
INTEGER :: dst_d, dst_dt, handle, src_d, src_dt
INTEGER, DIMENSION(2) :: dst_ub, src_ub
! ---------------------------------------------------------------------------
CALL timeset(routineN, handle)
!
src_dt = dbcsr_data_get_type(src)
dst_dt = dbcsr_data_get_type(dst)
IF (dbcsr_type_is_2d(src_dt)) THEN
src_d = 2
ELSE
src_d = 1
END IF
IF (dbcsr_type_is_2d(dst_dt)) THEN
dst_d = 2
ELSE
dst_d = 1
END IF
src_ub(1:src_d) = src_lb(1:src_d) + src_sizes(1:src_d) - 1
dst_ub(1:dst_d) = dst_lb(1:dst_d) + dst_sizes(1:dst_d) - 1
IF (careful_mod) THEN
IF (.NOT. dbcsr_data_exists(dst)) &
DBCSR_ABORT("Invalid target data area")
IF (.NOT. dbcsr_data_exists(src)) &
DBCSR_ABORT("Invalid source data area")
IF (dbcsr_type_2d_to_1d(src_dt) /= dbcsr_type_2d_to_1d(dst_dt)) &
DBCSR_ABORT("Data types must be comptable: ")
IF (dbcsr_type_is_2d(dst_dt)) THEN
IF (SIZE(dst_lb) /= 2) &
DBCSR_ABORT("size must be 2 for 2-d dst_lb")
IF (SIZE(dst_sizes) /= 2) &
DBCSR_ABORT("size must be 2 for 2-d dst_sizes")
ELSE
IF (SIZE(dst_lb) /= 1) &
DBCSR_ABORT("size must be 1 for 1-d dst_lb")
IF (SIZE(dst_sizes) /= 1) &
DBCSR_ABORT("size must be 1 for 1-d dst_sizes")
END IF
IF (dbcsr_type_is_2d(src_dt)) THEN
IF (SIZE(src_lb) /= 2) &
DBCSR_ABORT("size must be 2 for 2-d src_lb")
IF (SIZE(src_sizes) /= 2) &
DBCSR_ABORT("size must be 2 for 2-d src_sizes")
ELSE
IF (SIZE(src_lb) /= 1) &
DBCSR_ABORT("size must be 1 for 1-d src_lb")
IF (SIZE(src_sizes) /= 1) &
DBCSR_ABORT("size must be 1 for 1-d src_sizes")
END IF
IF (debug_mod) THEN
CALL dbcsr_data_verify_bounds(dst, dst_lb(1:dst_d), dst_ub(1:dst_d))
CALL dbcsr_data_verify_bounds(src, src_lb(1:src_d), src_ub(1:src_d))
END IF
END IF
!
SELECT CASE (src_dt)
CASE (dbcsr_type_real_4)
IF (dbcsr_type_is_2d(dst_dt)) THEN
CALL dbcsr_block_copy(dst%d%r2_sp(dst_lb(1):dst_ub(1), &
dst_lb(2):dst_ub(2)), &
src%d%r_sp(src_lb(1):src_ub(1)), &
src_sizes(1), 1)
ELSE
CALL dbcsr_block_copy(dst%d%r_sp(dst_lb(1):dst_ub(1)), &
src%d%r_sp(src_lb(1):src_ub(1)), &
src_sizes(1), 1)
END IF
CASE (dbcsr_type_real_8)
IF (dbcsr_type_is_2d(dst_dt)) THEN
CALL dbcsr_block_copy(dst%d%r2_dp(dst_lb(1):dst_ub(1), &
dst_lb(2):dst_ub(2)), &
src%d%r_dp(src_lb(1):src_ub(1)), &
src_sizes(1), 1)
ELSE
CALL dbcsr_block_copy(dst%d%r_dp(dst_lb(1):dst_ub(1)), &
src%d%r_dp(src_lb(1):src_ub(1)), &
src_sizes(1), 1)
END IF
CASE (dbcsr_type_complex_4)
IF (dbcsr_type_is_2d(dst_dt)) THEN
CALL dbcsr_block_copy(dst%d%c2_sp(dst_lb(1):dst_ub(1), &
dst_lb(2):dst_ub(2)), &
src%d%c_sp(src_lb(1):src_ub(1)), &
src_sizes(1), 1)
ELSE
CALL dbcsr_block_copy(dst%d%c_sp(dst_lb(1):dst_ub(1)), &
src%d%c_sp(src_lb(1):src_ub(1)), &
src_sizes(1), 1)
END IF
CASE (dbcsr_type_complex_8)
IF (dbcsr_type_is_2d(dst_dt)) THEN
CALL dbcsr_block_copy(dst%d%c2_dp(dst_lb(1):dst_ub(1), &
dst_lb(2):dst_ub(2)), &
src%d%c_dp(src_lb(1):src_ub(1)), &
src_sizes(1), 1)
ELSE
CALL dbcsr_block_copy(dst%d%c_dp(dst_lb(1):dst_ub(1)), &
src%d%c_dp(src_lb(1):src_ub(1)), &
src_sizes(1), 1)
END IF
CASE (dbcsr_type_real_4_2d)
IF (dbcsr_type_is_2d(dst_dt)) THEN
CALL dbcsr_block_copy(dst%d%r2_sp(dst_lb(1):dst_ub(1), &
dst_lb(2):dst_ub(2)), &
src%d%r2_sp(src_lb(1):src_ub(1), &
src_lb(2):src_ub(2)), &
dst_sizes(1), dst_sizes(2))
ELSE
CALL dbcsr_block_copy(dst%d%r_sp(dst_lb(1):dst_ub(1)), &
src%d%r2_sp(src_lb(1):src_ub(1), &
src_lb(2):src_ub(2)), &
dst_sizes(1), dst_sizes(2))
END IF
CASE (dbcsr_type_real_8_2d)
IF (dbcsr_type_is_2d(dst_dt)) THEN
CALL dbcsr_block_copy(dst%d%r2_dp(dst_lb(1):dst_ub(1), &
dst_lb(2):dst_ub(2)), &
src%d%r2_dp(src_lb(1):src_ub(1), &
src_lb(2):src_ub(2)), &
dst_sizes(1), dst_sizes(2))
ELSE
CALL dbcsr_block_copy(dst%d%r_dp(dst_lb(1):dst_ub(1)), &
src%d%r2_dp(src_lb(1):src_ub(1), &
src_lb(2):src_ub(2)), &
dst_sizes(1), dst_sizes(2))
END IF
CASE (dbcsr_type_complex_4_2d)
IF (dbcsr_type_is_2d(dst_dt)) THEN
CALL dbcsr_block_copy(dst%d%c2_sp(dst_lb(1):dst_ub(1), &
dst_lb(2):dst_ub(2)), &
src%d%c2_sp(src_lb(1):src_ub(1), &
src_lb(2):src_ub(2)), &
dst_sizes(1), dst_sizes(2))
ELSE
CALL dbcsr_block_copy(dst%d%c_sp(dst_lb(1):dst_ub(1)), &
src%d%c2_sp(src_lb(1):src_ub(1), &
src_lb(2):src_ub(2)), &
dst_sizes(1), dst_sizes(2))
END IF
CASE (dbcsr_type_complex_8_2d)
IF (dbcsr_type_is_2d(dst_dt)) THEN
CALL dbcsr_block_copy(dst%d%c2_dp(dst_lb(1):dst_ub(1), &
dst_lb(2):dst_ub(2)), &
src%d%c2_dp(src_lb(1):src_ub(1), &
src_lb(2):src_ub(2)), &
dst_sizes(1), dst_sizes(2))
ELSE
CALL dbcsr_block_copy(dst%d%c_dp(dst_lb(1):dst_ub(1)), &
src%d%c2_dp(src_lb(1):src_ub(1), &
src_lb(2):src_ub(2)), &
dst_sizes(1), dst_sizes(2))
END IF
CASE default
DBCSR_ABORT("Invalid data type")
END SELECT
CALL timestop(handle)
END SUBROUTINE dbcsr_data_copy_aa2