dbcsr_block_partial_copy Subroutine

public 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

Arguments

Type IntentOptional 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

Source Code

   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