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 |
||
type(dbcsr_data_obj), | intent(in) | :: | src |
source data area |
||
integer, | intent(in) | :: | row_size |
row size of existing block column size of existing block |
||
integer, | intent(in) | :: | col_size |
row size of existing block column size of existing block |
||
integer, | intent(in), | optional | :: | lb |
lower bound for destination (and source if not given explicitly) lower bound of source |
|
integer, | intent(in), | optional | :: | source_lb |
lower bound for destination (and source if not given explicitly) lower bound of source |
|
type(dbcsr_scalar_type), | intent(in), | optional | :: | scale |
scale data |
SUBROUTINE dbcsr_block_copy_aa(dst, src, & row_size, col_size, lb, source_lb, scale) !! 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 TYPE(dbcsr_data_obj), INTENT(IN) :: src !! source data area INTEGER, INTENT(IN) :: row_size, col_size !! row size of existing block !! column size of existing block INTEGER, INTENT(IN), OPTIONAL :: lb, source_lb !! lower bound for destination (and source if not given explicitly) !! lower bound of source TYPE(dbcsr_scalar_type), INTENT(IN), OPTIONAL :: scale !! scale data INTEGER :: data_size, lb_s, lb_t, ub_s, ub_t ! --------------------------------------------------------------------------- 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 /= src%d%data_type) & DBCSR_ABORT("Data type must be the same.") IF (dst%d%data_type .NE. dbcsr_type_real_8 & .AND. dst%d%data_type .NE. dbcsr_type_real_4 & .AND. dst%d%data_type .NE. dbcsr_type_complex_8 & .AND. dst%d%data_type .NE. dbcsr_type_complex_4) & DBCSR_WARN("Incorrect data type.") IF (PRESENT(scale)) THEN IF (dbcsr_type_is_2d(src%d%data_type)) THEN IF (scale%data_type /= dbcsr_type_2d_to_1d(src%d%data_type)) & DBCSR_ABORT("Incompatible data types") ELSE IF (scale%data_type /= src%d%data_type) & DBCSR_ABORT("Incompatible data types") END IF END IF END IF data_size = row_size*col_size lb_t = 1 IF (PRESENT(lb)) lb_t = lb ub_t = lb_t + data_size - 1 IF (PRESENT(source_lb)) THEN lb_s = source_lb ub_s = source_lb + data_size - 1 ELSE lb_s = lb_t ub_s = ub_t END IF SELECT CASE (src%d%data_type) CASE (dbcsr_type_real_8) IF (PRESENT(scale)) THEN CALL dbcsr_block_copy(dst%d%r_dp(lb_t:ub_t), & src%d%r_dp(lb_s:ub_s)*scale%r_dp, & row_size, col_size) ELSE CALL dbcsr_block_copy(dst%d%r_dp(lb_t:ub_t), & src%d%r_dp(lb_s:ub_s), & row_size, col_size) END IF CASE (dbcsr_type_real_4) IF (PRESENT(scale)) THEN CALL dbcsr_block_copy(dst%d%r_sp(lb_t:ub_t), & src%d%r_sp(lb_s:ub_s)*scale%r_sp, & row_size, col_size) ELSE CALL dbcsr_block_copy(dst%d%r_sp(lb_t:ub_t), & src%d%r_sp(lb_s:ub_s), & row_size, col_size) END IF CASE (dbcsr_type_complex_8) IF (PRESENT(scale)) THEN CALL dbcsr_block_copy(dst%d%c_dp(lb_t:ub_t), & src%d%c_dp(lb_s:ub_s)*scale%c_dp, & row_size, col_size) ELSE CALL dbcsr_block_copy(dst%d%c_dp(lb_t:ub_t), & src%d%c_dp(lb_s:ub_s), & row_size, col_size) END IF CASE (dbcsr_type_complex_4) IF (PRESENT(scale)) THEN CALL dbcsr_block_copy(dst%d%c_sp(lb_t:ub_t), & src%d%c_sp(lb_s:ub_s)*scale%c_sp, & row_size, col_size) ELSE CALL dbcsr_block_copy(dst%d%c_sp(lb_t:ub_t), & src%d%c_sp(lb_s:ub_s), & row_size, col_size) END IF CASE default DBCSR_ABORT("Incorrect data type.") END SELECT END SUBROUTINE dbcsr_block_copy_aa