Copy data from one data area to another. 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) | :: | lb |
lower bound for destination (and source if not given explicitly) number of elements to copy |
||
| integer, | intent(in) | :: | data_size |
lower bound for destination (and source if not given explicitly) number of elements to copy |
||
| type(dbcsr_data_obj), | intent(in) | :: | src |
source data area |
||
| integer, | intent(in), | optional | :: | source_lb |
lower bound of source |
|
| type(dbcsr_scalar_type), | intent(in), | optional | :: | scale |
scale by this factor |
|
| integer, | intent(in), | optional | :: | lb2 |
2nd dimension lower bound 2nd dimension data size 2nd dimension lower bound for source |
|
| integer, | intent(in), | optional | :: | data_size2 |
2nd dimension lower bound 2nd dimension data size 2nd dimension lower bound for source |
|
| integer, | intent(in), | optional | :: | source_lb2 |
2nd dimension lower bound 2nd dimension data size 2nd dimension lower bound for source |
SUBROUTINE dbcsr_data_copy_aa(dst, lb, data_size, src, source_lb, scale, &
lb2, data_size2, source_lb2)
!! Copy data from one data area to another.
!! There are no checks done for correctness!
TYPE(dbcsr_data_obj), INTENT(INOUT) :: dst
!! destination data area
INTEGER, INTENT(IN) :: lb, data_size
!! lower bound for destination (and source if not given explicitly)
!! number of elements to copy
TYPE(dbcsr_data_obj), INTENT(IN) :: src
!! source data area
INTEGER, INTENT(IN), OPTIONAL :: source_lb
!! lower bound of source
TYPE(dbcsr_scalar_type), INTENT(IN), OPTIONAL :: scale
!! scale by this factor
INTEGER, INTENT(IN), OPTIONAL :: lb2, data_size2, source_lb2
!! 2nd dimension lower bound
!! 2nd dimension data size
!! 2nd dimension lower bound for source
INTEGER :: lb2_s, lb_s, ub, ub2, ub2_s, ub_s
! ---------------------------------------------------------------------------
lb2_s = 0
ub2_s = 0
IF (debug_mod) THEN
IF (.NOT. ASSOCIATED(dst%d) .OR. .NOT. ASSOCIATED(src%d)) &
DBCSR_ABORT("Data areas must be setup.")
IF (dst%d%data_type .NE. src%d%data_type) &
DBCSR_ABORT("Data type must be the same.")
END IF
IF (PRESENT(scale) .AND. careful_mod) THEN
IF (dbcsr_type_is_2d(src%d%data_type)) THEN
IF (scale%data_type .NE. dbcsr_type_2d_to_1d(src%d%data_type)) &
DBCSR_ABORT("Incomptable data types")
ELSE
IF (scale%data_type .NE. src%d%data_type) &
DBCSR_ABORT("Incomptable data types")
END IF
END IF
ub = lb + data_size - 1
IF (PRESENT(source_lb)) THEN
lb_s = source_lb
ub_s = source_lb + data_size - 1
ELSE
lb_s = lb
ub_s = ub
END IF
IF (careful_mod) THEN
IF (dbcsr_type_is_2d(src%d%data_type) .AND. .NOT. PRESENT(lb2)) &
DBCSR_ABORT("Must specify lb2 for 2-D data area")
IF (dbcsr_type_is_2d(src%d%data_type) .AND. .NOT. PRESENT(data_size2)) &
DBCSR_ABORT("Must specify data_size2 for 2-D data area")
END IF
IF (PRESENT(lb2)) THEN
IF (careful_mod) THEN
IF (.NOT. dbcsr_type_is_2d(src%d%data_type)) &
DBCSR_WARN("Should not specify lb2 for 1-D data")
END IF
ub2 = lb2 + data_size2 - 1
IF (PRESENT(source_lb2)) THEN
lb2_s = source_lb2
ub2_s = source_lb2 + data_size2 - 1
ELSE
lb2_s = lb2
ub2_s = ub2
END IF
END IF
SELECT CASE (src%d%data_type)
CASE (dbcsr_type_real_4)
IF (debug_mod) THEN
IF (.NOT. ASSOCIATED(dst%d%r_sp)) &
DBCSR_ABORT("associated(dst%d%r_sp)")
IF (.NOT. ASSOCIATED(src%d%r_sp)) &
DBCSR_ABORT("associated(src%d%r_sp)")
IF (lb < LBOUND(dst%d%r_sp, 1)) &
DBCSR_ABORT("lb dst%d%r_sp")
IF (ub > UBOUND(dst%d%r_sp, 1)) &
DBCSR_ABORT("ub dst%d%r_sp")
IF (lb_s < LBOUND(src%d%r_sp, 1)) &
DBCSR_ABORT("lb src%d%r_sp")
IF (ub_s > UBOUND(src%d%r_sp, 1)) &
DBCSR_ABORT("ub src%d%r_sp")
END IF
IF (PRESENT(scale)) THEN
dst%d%r_sp(lb:ub) = scale%r_sp*src%d%r_sp(lb_s:ub_s)
ELSE
dst%d%r_sp(lb:ub) = src%d%r_sp(lb_s:ub_s)
END IF
CASE (dbcsr_type_real_8)
IF (debug_mod) THEN
IF (.NOT. ASSOCIATED(dst%d%r_dp)) &
DBCSR_ABORT("associated(dst%d%r_dp)")
IF (.NOT. ASSOCIATED(src%d%r_dp)) &
DBCSR_ABORT("associated(src%d%r_dp)")
IF (lb < LBOUND(dst%d%r_dp, 1)) &
DBCSR_ABORT("lb dst%d%r_dp")
IF (ub > UBOUND(dst%d%r_dp, 1)) &
DBCSR_ABORT("ub dst%d%r_dp")
IF (lb_s < LBOUND(src%d%r_dp, 1)) &
DBCSR_ABORT("lb src%d%r_dp")
IF (ub_s > UBOUND(src%d%r_dp, 1)) &
DBCSR_ABORT("ub src%d%r_dp")
END IF
IF (PRESENT(scale)) THEN
dst%d%r_dp(lb:ub) = scale%r_dp*src%d%r_dp(lb_s:ub_s)
ELSE
dst%d%r_dp(lb:ub) = src%d%r_dp(lb_s:ub_s)
END IF
CASE (dbcsr_type_complex_4)
IF (debug_mod) THEN
IF (.NOT. ASSOCIATED(dst%d%c_sp)) &
DBCSR_ABORT("associated(dst%d%c_sp)")
IF (.NOT. ASSOCIATED(src%d%c_sp)) &
DBCSR_ABORT("associated(src%d%c_sp)")
IF (lb < LBOUND(dst%d%c_sp, 1)) &
DBCSR_ABORT("lb dst%d%c_sp")
IF (ub > UBOUND(dst%d%c_sp, 1)) &
DBCSR_ABORT("ub dst%d%c_sp")
IF (lb_s < LBOUND(src%d%c_sp, 1)) &
DBCSR_ABORT("lb src%d%c_sp")
IF (ub_s > UBOUND(src%d%c_sp, 1)) &
DBCSR_ABORT("ub src%d%c_sp")
END IF
IF (PRESENT(scale)) THEN
dst%d%c_sp(lb:ub) = scale%c_sp*src%d%c_sp(lb_s:ub_s)
ELSE
dst%d%c_sp(lb:ub) = src%d%c_sp(lb_s:ub_s)
END IF
CASE (dbcsr_type_complex_8)
IF (debug_mod) THEN
IF (.NOT. ASSOCIATED(dst%d%c_dp)) &
DBCSR_ABORT("associated(dst%d%c_dp)")
IF (.NOT. ASSOCIATED(src%d%c_dp)) &
DBCSR_ABORT("associated(src%d%c_dp)")
IF (lb < LBOUND(dst%d%c_dp, 1)) &
DBCSR_ABORT("lb dst%d%c_dp")
IF (ub > UBOUND(dst%d%c_dp, 1)) &
DBCSR_ABORT("ub dst%d%c_dp")
IF (lb_s < LBOUND(src%d%c_dp, 1)) &
DBCSR_ABORT("lb src%d%c_dp")
IF (ub_s > UBOUND(src%d%c_dp, 1)) &
DBCSR_ABORT("ub src%d%c_dp")
END IF
IF (PRESENT(scale)) THEN
dst%d%c_dp(lb:ub) = scale%c_dp*src%d%c_dp(lb_s:ub_s)
ELSE
dst%d%c_dp(lb:ub) = src%d%c_dp(lb_s:ub_s)
END IF
CASE (dbcsr_type_real_4_2d)
IF (PRESENT(scale)) THEN
dst%d%r2_sp(lb:ub, lb2:ub2) = &
scale%r_sp*src%d%r2_sp(lb_s:ub_s, lb2_s:ub2_s)
ELSE
dst%d%r2_sp(lb:ub, lb2:ub2) = src%d%r2_sp(lb_s:ub_s, lb2_s:ub2_s)
END IF
CASE (dbcsr_type_real_8_2d)
IF (PRESENT(scale)) THEN
dst%d%r2_dp(lb:ub, lb2:ub2) = &
scale%r_dp*src%d%r2_dp(lb_s:ub_s, lb2_s:ub2_s)
ELSE
dst%d%r2_dp(lb:ub, lb2:ub2) = src%d%r2_dp(lb_s:ub_s, lb2_s:ub2_s)
END IF
CASE (dbcsr_type_complex_4_2d)
IF (PRESENT(scale)) THEN
dst%d%c2_sp(lb:ub, lb2:ub2) = &
scale%c_sp*src%d%c2_sp(lb_s:ub_s, lb2_s:ub2_s)
ELSE
dst%d%c2_sp(lb:ub, lb2:ub2) = src%d%c2_sp(lb_s:ub_s, lb2_s:ub2_s)
END IF
CASE (dbcsr_type_complex_8_2d)
IF (PRESENT(scale)) THEN
dst%d%c2_dp(lb:ub, lb2:ub2) = &
scale%c_dp*src%d%c2_dp(lb_s:ub_s, lb2_s:ub2_s)
ELSE
dst%d%c2_dp(lb:ub, lb2:ub2) = src%d%c2_dp(lb_s:ub_s, lb2_s:ub2_s)
END IF
CASE default
DBCSR_ABORT("Invalid data type")
END SELECT
END SUBROUTINE dbcsr_data_copy_aa