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 |
|
| integer, | intent(in), | optional | :: | lb2 |
lower bound of 2nd dimension for target lower bound of 2nd dimension for source |
|
| integer, | intent(in), | optional | :: | source_lb2 |
lower bound of 2nd dimension for target lower bound of 2nd dimension for source |
SUBROUTINE dbcsr_block_transpose_aa(dst, src, &
row_size, col_size, lb, source_lb, scale, lb2, 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
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, INTENT(IN), OPTIONAL :: lb2, source_lb2
!! lower bound of 2nd dimension for target
!! lower bound of 2nd dimension for source
INTEGER :: data_size, lb2_s, lb2_t, 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 &
.AND. dst%d%data_type .NE. dbcsr_type_real_8_2d &
.AND. dst%d%data_type .NE. dbcsr_type_real_4_2d &
.AND. dst%d%data_type .NE. dbcsr_type_complex_8_2d &
.AND. dst%d%data_type .NE. dbcsr_type_complex_4_2d) &
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
lb2_t = 1
IF (PRESENT(lb2)) lb2_t = lb2
IF (PRESENT(source_lb2)) THEN
lb2_s = source_lb2
ELSE
lb2_s = lb2_t
END IF
SELECT CASE (src%d%data_type)
CASE (dbcsr_type_real_8)
IF (PRESENT(scale)) THEN
CALL dbcsr_block_transpose(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_transpose(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_transpose(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_transpose(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_transpose(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_transpose(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_transpose(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_transpose(dst%d%c_sp(lb_t:ub_t), &
src%d%c_sp(lb_s:ub_s), &
row_size, col_size)
END IF
CASE (dbcsr_type_real_8_2d)
IF (PRESENT(scale)) THEN
dst%d%r2_dp(lb_t:lb_t + col_size - 1, lb2_t:lb2_t + row_size - 1) = &
TRANSPOSE( &
src%d%r2_dp(lb_s:lb_s + row_size - 1, lb2_s:lb2_s + col_size - 1) &
*scale%r_dp)
ELSE
dst%d%r2_dp(lb_t:lb_t + col_size - 1, lb2_t:lb2_t + row_size - 1) = &
TRANSPOSE( &
src%d%r2_dp(lb_s:lb_s + row_size - 1, lb2_s:lb2_s + col_size - 1))
END IF
CASE (dbcsr_type_real_4_2d)
IF (PRESENT(scale)) THEN
dst%d%r2_sp(lb_t:lb_t + col_size - 1, lb2_t:lb2_t + row_size - 1) = &
TRANSPOSE( &
src%d%r2_sp(lb_s:lb_s + row_size - 1, lb2_s:lb2_s + col_size - 1) &
*scale%r_sp)
ELSE
dst%d%r2_sp(lb_t:lb_t + col_size - 1, lb2_t:lb2_t + row_size - 1) = &
TRANSPOSE( &
src%d%r2_sp(lb_s:lb_s + row_size - 1, lb2_s:lb2_s + col_size - 1))
END IF
CASE (dbcsr_type_complex_8_2d)
IF (PRESENT(scale)) THEN
dst%d%c2_dp(lb_t:lb_t + col_size - 1, lb2_t:lb2_t + row_size - 1) = &
TRANSPOSE( &
src%d%c2_dp(lb_s:lb_s + row_size - 1, lb2_s:lb2_s + col_size - 1) &
*scale%c_dp)
ELSE
dst%d%c2_dp(lb_t:lb_t + col_size - 1, lb2_t:lb2_t + row_size - 1) = &
TRANSPOSE( &
src%d%c2_dp(lb_s:lb_s + row_size - 1, lb2_s:lb2_s + col_size - 1))
END IF
CASE (dbcsr_type_complex_4_2d)
IF (PRESENT(scale)) THEN
dst%d%c2_sp(lb_t:lb_t + col_size - 1, lb2_t:lb2_t + row_size - 1) = &
TRANSPOSE( &
src%d%c2_sp(lb_s:lb_s + row_size - 1, lb2_s:lb2_s + col_size - 1) &
*scale%c_sp)
ELSE
dst%d%c2_sp(lb_t:lb_t + col_size - 1, lb2_t:lb2_t + row_size - 1) = &
TRANSPOSE( &
src%d%c2_sp(lb_s:lb_s + row_size - 1, lb2_s:lb2_s + col_size - 1))
END IF
CASE default
DBCSR_ABORT("Incorrect data type.")
END SELECT
END SUBROUTINE dbcsr_block_transpose_aa