Copies a block subset
| Type | Intent | Optional | Attributes | Name | ||
|---|---|---|---|---|---|---|
| type(dbcsr_data_obj), | intent(inout) | :: | dst |
target data area |
||
| integer, | intent(in) | :: | dst_rs |
target block row size (logical) target block column size (logical) |
||
| integer, | intent(in) | :: | dst_cs |
target block row size (logical) target block column size (logical) |
||
| logical | :: | dst_tr |
whether target block is transposed |
|||
| type(dbcsr_data_obj), | intent(in) | :: | src |
source data area |
||
| integer, | intent(in) | :: | src_rs |
source block row size (logical) source block column size (logical) |
||
| integer, | intent(in) | :: | src_cs |
source block row size (logical) source block column size (logical) |
||
| logical | :: | src_tr |
whether source block is transposed |
|||
| integer, | intent(in) | :: | dst_r_lb |
first row in target first column in target first_row in source first column in target number of rows to copy number of columns to copy |
||
| integer, | intent(in) | :: | dst_c_lb |
first row in target first column in target first_row in source first column in target number of rows to copy number of columns to copy |
||
| integer, | intent(in) | :: | src_r_lb |
first row in target first column in target first_row in source first column in target number of rows to copy number of columns to copy |
||
| integer, | intent(in) | :: | src_c_lb |
first row in target first column in target first_row in source first column in target number of rows to copy number of columns to copy |
||
| integer, | intent(in) | :: | nrow |
first row in target first column in target first_row in source first column in target number of rows to copy number of columns to copy |
||
| integer, | intent(in) | :: | ncol |
first row in target first column in target first_row in source first column in target number of rows to copy number of columns to copy |
||
| integer, | intent(in), | optional | :: | dst_offset |
offset in target offset in source |
|
| integer, | intent(in), | optional | :: | src_offset |
offset in target offset in source |
SUBROUTINE dbcsr_block_partial_copy(dst, dst_rs, dst_cs, dst_tr, &
src, src_rs, src_cs, src_tr, &
dst_r_lb, dst_c_lb, src_r_lb, src_c_lb, nrow, ncol, &
dst_offset, src_offset)
!! Copies a block subset
TYPE(dbcsr_data_obj), INTENT(INOUT) :: dst
!! target data area
INTEGER, INTENT(IN) :: dst_rs, dst_cs
!! target block row size (logical)
!! target block column size (logical)
LOGICAL :: dst_tr
!! whether target block is transposed
TYPE(dbcsr_data_obj), INTENT(IN) :: src
!! source data area
INTEGER, INTENT(IN) :: src_rs, src_cs
!! source block row size (logical)
!! source block column size (logical)
LOGICAL :: src_tr
!! whether source block is transposed
INTEGER, INTENT(IN) :: dst_r_lb, dst_c_lb, src_r_lb, src_c_lb, &
nrow, ncol
!! first row in target
!! first column in target
!! first_row in source
!! first column in target
!! number of rows to copy
!! number of columns to copy
INTEGER, INTENT(IN), OPTIONAL :: dst_offset, src_offset
!! offset in target
!! offset in source
LOGICAL, PARAMETER :: verification = careful_mod
INTEGER :: dst_o, src_o
LOGICAL :: src_is_2d
! ---------------------------------------------------------------------------
IF (careful_mod) THEN
IF (dbcsr_type_2d_to_1d(dbcsr_data_get_type(dst)) /= dbcsr_type_2d_to_1d(dbcsr_data_get_type(src))) &
DBCSR_ABORT("Incompatible data types.")
END IF
dst_o = 0; src_o = 0
IF (PRESENT(dst_offset)) dst_o = dst_offset
IF (PRESENT(src_offset)) src_o = src_offset
IF (verification) THEN
IF (dst_r_lb + nrow - 1 > dst_rs) &
DBCSR_ABORT("Incompatible dst row sizes")
IF (dst_c_lb + ncol - 1 > dst_cs) &
DBCSR_ABORT("Incompatible dst col sizes")
IF (src_r_lb + nrow - 1 > src_rs) &
DBCSR_ABORT("Incompatible src row sizes")
IF (src_c_lb + ncol - 1 > src_cs) &
DBCSR_ABORT("Incompatible src col sizes")
END IF
!
src_is_2d = dbcsr_type_is_2d(dbcsr_data_get_type(src))
SELECT CASE (dbcsr_data_get_type(dst))
CASE (dbcsr_type_real_4)
IF (src_is_2d) THEN
CALL block_partial_copy_1d2d_s(dst%d%r_sp, dst_rs, dst_cs, dst_tr, &
src%d%r2_sp, src_tr, &
dst_r_lb, dst_c_lb, src_r_lb, src_c_lb, nrow, ncol, &
dst_offset=dst_o)
ELSE
CALL block_partial_copy_s(dst%d%r_sp, dst_rs, dst_cs, dst_tr, &
src%d%r_sp, src_rs, src_cs, src_tr, &
dst_r_lb, dst_c_lb, src_r_lb, src_c_lb, nrow, ncol, &
dst_offset=dst_o, src_offset=src_o)
END IF
CASE (dbcsr_type_real_8)
IF (src_is_2d) THEN
CALL block_partial_copy_1d2d_d(dst%d%r_dp, dst_rs, dst_cs, dst_tr, &
src%d%r2_dp, src_tr, &
dst_r_lb, dst_c_lb, src_r_lb, src_c_lb, nrow, ncol, &
dst_offset=dst_o)
ELSE
CALL block_partial_copy_d(dst%d%r_dp, dst_rs, dst_cs, dst_tr, &
src%d%r_dp, src_rs, src_cs, src_tr, &
dst_r_lb, dst_c_lb, src_r_lb, src_c_lb, nrow, ncol, &
dst_offset=dst_o, src_offset=src_o)
END IF
CASE (dbcsr_type_complex_4)
IF (src_is_2d) THEN
CALL block_partial_copy_1d2d_c(dst%d%c_sp, dst_rs, dst_cs, dst_tr, &
src%d%c2_sp, src_tr, &
dst_r_lb, dst_c_lb, src_r_lb, src_c_lb, nrow, ncol, &
dst_offset=dst_o)
ELSE
CALL block_partial_copy_c(dst%d%c_sp, dst_rs, dst_cs, dst_tr, &
src%d%c_sp, src_rs, src_cs, src_tr, &
dst_r_lb, dst_c_lb, src_r_lb, src_c_lb, nrow, ncol, &
dst_offset=dst_o, src_offset=src_o)
END IF
CASE (dbcsr_type_complex_8)
IF (src_is_2d) THEN
CALL block_partial_copy_1d2d_z(dst%d%c_dp, dst_rs, dst_cs, dst_tr, &
src%d%c2_dp, src_tr, &
dst_r_lb, dst_c_lb, src_r_lb, src_c_lb, nrow, ncol, &
dst_offset=dst_o)
ELSE
CALL block_partial_copy_z(dst%d%c_dp, dst_rs, dst_cs, dst_tr, &
src%d%c_dp, src_rs, src_cs, src_tr, &
dst_r_lb, dst_c_lb, src_r_lb, src_c_lb, nrow, ncol, &
dst_offset=dst_o, src_offset=src_o)
END IF
CASE (dbcsr_type_real_4_2d)
IF (src_is_2d) THEN
CALL block_partial_copy_2d2d_s(dst%d%r2_sp, dst_tr, &
src%d%r2_sp, src_tr, &
dst_r_lb, dst_c_lb, src_r_lb, src_c_lb, nrow, ncol)
ELSE
CALL block_partial_copy_2d1d_s(dst%d%r2_sp, dst_tr, &
src%d%r_sp, src_rs, src_cs, src_tr, &
dst_r_lb, dst_c_lb, src_r_lb, src_c_lb, nrow, ncol, &
src_offset=src_o)
END IF
CASE (dbcsr_type_real_8_2d)
IF (src_is_2d) THEN
CALL block_partial_copy_2d2d_d(dst%d%r2_dp, dst_tr, &
src%d%r2_dp, src_tr, &
dst_r_lb, dst_c_lb, src_r_lb, src_c_lb, nrow, ncol)
ELSE
CALL block_partial_copy_2d1d_d(dst%d%r2_dp, dst_tr, &
src%d%r_dp, src_rs, src_cs, src_tr, &
dst_r_lb, dst_c_lb, src_r_lb, src_c_lb, nrow, ncol, &
src_offset=src_o)
END IF
CASE (dbcsr_type_complex_4_2d)
IF (src_is_2d) THEN
CALL block_partial_copy_2d2d_c(dst%d%c2_sp, dst_tr, &
src%d%c2_sp, src_tr, &
dst_r_lb, dst_c_lb, src_r_lb, src_c_lb, nrow, ncol)
ELSE
CALL block_partial_copy_2d1d_c(dst%d%c2_sp, dst_tr, &
src%d%c_sp, src_rs, src_cs, src_tr, &
dst_r_lb, dst_c_lb, src_r_lb, src_c_lb, nrow, ncol, &
src_offset=src_o)
END IF
CASE (dbcsr_type_complex_8_2d)
IF (src_is_2d) THEN
CALL block_partial_copy_2d2d_z(dst%d%c2_dp, dst_tr, &
src%d%c2_dp, src_tr, &
dst_r_lb, dst_c_lb, src_r_lb, src_c_lb, nrow, ncol)
ELSE
CALL block_partial_copy_2d1d_z(dst%d%c2_dp, dst_tr, &
src%d%c_dp, src_rs, src_cs, src_tr, &
dst_r_lb, dst_c_lb, src_r_lb, src_c_lb, nrow, ncol, &
src_offset=src_o)
END IF
CASE default
DBCSR_ABORT("Invalid data type.")
END SELECT
END SUBROUTINE dbcsr_block_partial_copy