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