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