dbcsr_data_copy_aa2 Subroutine

private subroutine dbcsr_data_copy_aa2(dst, dst_lb, dst_sizes, src, src_lb, src_sizes)

Copy data from one data area to another, the most basic form. There are no checks done for correctness!

Arguments

TypeIntentOptionalAttributesName
type(dbcsr_data_obj), intent(inout) :: dst

destination data area

integer, intent(in), DIMENSION(:):: dst_lb

lower bounds for destination sizes for destination

integer, intent(in), DIMENSION(:):: dst_sizes

lower bounds for destination sizes for destination

type(dbcsr_data_obj), intent(in) :: src

source data area

integer, intent(in), DIMENSION(:):: src_lb

lower bounds for source sizes for source

integer, intent(in), DIMENSION(:):: src_sizes

lower bounds for source sizes for source


Contents

Source Code


Source Code

   SUBROUTINE dbcsr_data_copy_aa2(dst, dst_lb, dst_sizes, &
                                  src, src_lb, src_sizes)
      !! Copy data from one data area to another, the most basic form.
      !! There are no checks done for correctness!

      TYPE(dbcsr_data_obj), INTENT(INOUT)                :: dst
         !! destination data area
      INTEGER, DIMENSION(:), INTENT(IN)                  :: dst_lb, dst_sizes
         !! lower bounds for destination
         !! sizes for destination
      TYPE(dbcsr_data_obj), INTENT(IN)                   :: src
         !! source data area
      INTEGER, DIMENSION(:), INTENT(IN)                  :: src_lb, src_sizes
         !! lower bounds for source
         !! sizes for source

      CHARACTER(len=*), PARAMETER :: routineN = 'dbcsr_data_copy_aa2'

      INTEGER                                            :: dst_d, dst_dt, handle, src_d, src_dt
      INTEGER, DIMENSION(2)                              :: dst_ub, src_ub
!     ---------------------------------------------------------------------------
      CALL timeset(routineN, handle)
      !
      src_dt = dbcsr_data_get_type(src)
      dst_dt = dbcsr_data_get_type(dst)
      IF (dbcsr_type_is_2d(src_dt)) THEN
         src_d = 2
      ELSE
         src_d = 1
      END IF
      IF (dbcsr_type_is_2d(dst_dt)) THEN
         dst_d = 2
      ELSE
         dst_d = 1
      END IF
      src_ub(1:src_d) = src_lb(1:src_d) + src_sizes(1:src_d) - 1
      dst_ub(1:dst_d) = dst_lb(1:dst_d) + dst_sizes(1:dst_d) - 1
      IF (careful_mod) THEN
         IF (.NOT. dbcsr_data_exists(dst)) &
            DBCSR_ABORT("Invalid target data area")
         IF (.NOT. dbcsr_data_exists(src)) &
            DBCSR_ABORT("Invalid source data area")
         IF (dbcsr_type_2d_to_1d(src_dt) /= dbcsr_type_2d_to_1d(dst_dt)) &
            DBCSR_ABORT("Data types must be comptable: ")
         IF (dbcsr_type_is_2d(dst_dt)) THEN
            IF (SIZE(dst_lb) /= 2) &
               DBCSR_ABORT("size must be 2 for 2-d dst_lb")
            IF (SIZE(dst_sizes) /= 2) &
               DBCSR_ABORT("size must be 2 for 2-d dst_sizes")
         ELSE
            IF (SIZE(dst_lb) /= 1) &
               DBCSR_ABORT("size must be 1 for 1-d dst_lb")
            IF (SIZE(dst_sizes) /= 1) &
               DBCSR_ABORT("size must be 1 for 1-d dst_sizes")
         END IF
         IF (dbcsr_type_is_2d(src_dt)) THEN
            IF (SIZE(src_lb) /= 2) &
               DBCSR_ABORT("size must be 2 for 2-d src_lb")
            IF (SIZE(src_sizes) /= 2) &
               DBCSR_ABORT("size must be 2 for 2-d src_sizes")
         ELSE
            IF (SIZE(src_lb) /= 1) &
               DBCSR_ABORT("size must be 1 for 1-d src_lb")
            IF (SIZE(src_sizes) /= 1) &
               DBCSR_ABORT("size must be 1 for 1-d src_sizes")
         END IF
         IF (debug_mod) THEN
            CALL dbcsr_data_verify_bounds(dst, dst_lb(1:dst_d), dst_ub(1:dst_d))
            CALL dbcsr_data_verify_bounds(src, src_lb(1:src_d), src_ub(1:src_d))
         END IF
      END IF
      !
      SELECT CASE (src_dt)
      CASE (dbcsr_type_real_4)
         IF (dbcsr_type_is_2d(dst_dt)) THEN
            CALL dbcsr_block_copy(dst%d%r2_sp(dst_lb(1):dst_ub(1), &
                                              dst_lb(2):dst_ub(2)), &
                                  src%d%r_sp(src_lb(1):src_ub(1)), &
                                  src_sizes(1), 1)
         ELSE
            CALL dbcsr_block_copy(dst%d%r_sp(dst_lb(1):dst_ub(1)), &
                                  src%d%r_sp(src_lb(1):src_ub(1)), &
                                  src_sizes(1), 1)
         END IF
      CASE (dbcsr_type_real_8)
         IF (dbcsr_type_is_2d(dst_dt)) THEN
            CALL dbcsr_block_copy(dst%d%r2_dp(dst_lb(1):dst_ub(1), &
                                              dst_lb(2):dst_ub(2)), &
                                  src%d%r_dp(src_lb(1):src_ub(1)), &
                                  src_sizes(1), 1)
         ELSE
            CALL dbcsr_block_copy(dst%d%r_dp(dst_lb(1):dst_ub(1)), &
                                  src%d%r_dp(src_lb(1):src_ub(1)), &
                                  src_sizes(1), 1)
         END IF
      CASE (dbcsr_type_complex_4)
         IF (dbcsr_type_is_2d(dst_dt)) THEN
            CALL dbcsr_block_copy(dst%d%c2_sp(dst_lb(1):dst_ub(1), &
                                              dst_lb(2):dst_ub(2)), &
                                  src%d%c_sp(src_lb(1):src_ub(1)), &
                                  src_sizes(1), 1)
         ELSE
            CALL dbcsr_block_copy(dst%d%c_sp(dst_lb(1):dst_ub(1)), &
                                  src%d%c_sp(src_lb(1):src_ub(1)), &
                                  src_sizes(1), 1)
         END IF
      CASE (dbcsr_type_complex_8)
         IF (dbcsr_type_is_2d(dst_dt)) THEN
            CALL dbcsr_block_copy(dst%d%c2_dp(dst_lb(1):dst_ub(1), &
                                              dst_lb(2):dst_ub(2)), &
                                  src%d%c_dp(src_lb(1):src_ub(1)), &
                                  src_sizes(1), 1)
         ELSE
            CALL dbcsr_block_copy(dst%d%c_dp(dst_lb(1):dst_ub(1)), &
                                  src%d%c_dp(src_lb(1):src_ub(1)), &
                                  src_sizes(1), 1)
         END IF
      CASE (dbcsr_type_real_4_2d)
         IF (dbcsr_type_is_2d(dst_dt)) THEN
            CALL dbcsr_block_copy(dst%d%r2_sp(dst_lb(1):dst_ub(1), &
                                              dst_lb(2):dst_ub(2)), &
                                  src%d%r2_sp(src_lb(1):src_ub(1), &
                                              src_lb(2):src_ub(2)), &
                                  dst_sizes(1), dst_sizes(2))
         ELSE
            CALL dbcsr_block_copy(dst%d%r_sp(dst_lb(1):dst_ub(1)), &
                                  src%d%r2_sp(src_lb(1):src_ub(1), &
                                              src_lb(2):src_ub(2)), &
                                  dst_sizes(1), dst_sizes(2))
         END IF
      CASE (dbcsr_type_real_8_2d)
         IF (dbcsr_type_is_2d(dst_dt)) THEN
            CALL dbcsr_block_copy(dst%d%r2_dp(dst_lb(1):dst_ub(1), &
                                              dst_lb(2):dst_ub(2)), &
                                  src%d%r2_dp(src_lb(1):src_ub(1), &
                                              src_lb(2):src_ub(2)), &
                                  dst_sizes(1), dst_sizes(2))
         ELSE
            CALL dbcsr_block_copy(dst%d%r_dp(dst_lb(1):dst_ub(1)), &
                                  src%d%r2_dp(src_lb(1):src_ub(1), &
                                              src_lb(2):src_ub(2)), &
                                  dst_sizes(1), dst_sizes(2))
         END IF
      CASE (dbcsr_type_complex_4_2d)
         IF (dbcsr_type_is_2d(dst_dt)) THEN
            CALL dbcsr_block_copy(dst%d%c2_sp(dst_lb(1):dst_ub(1), &
                                              dst_lb(2):dst_ub(2)), &
                                  src%d%c2_sp(src_lb(1):src_ub(1), &
                                              src_lb(2):src_ub(2)), &
                                  dst_sizes(1), dst_sizes(2))
         ELSE
            CALL dbcsr_block_copy(dst%d%c_sp(dst_lb(1):dst_ub(1)), &
                                  src%d%c2_sp(src_lb(1):src_ub(1), &
                                              src_lb(2):src_ub(2)), &
                                  dst_sizes(1), dst_sizes(2))
         END IF
      CASE (dbcsr_type_complex_8_2d)
         IF (dbcsr_type_is_2d(dst_dt)) THEN
            CALL dbcsr_block_copy(dst%d%c2_dp(dst_lb(1):dst_ub(1), &
                                              dst_lb(2):dst_ub(2)), &
                                  src%d%c2_dp(src_lb(1):src_ub(1), &
                                              src_lb(2):src_ub(2)), &
                                  dst_sizes(1), dst_sizes(2))
         ELSE
            CALL dbcsr_block_copy(dst%d%c_dp(dst_lb(1):dst_ub(1)), &
                                  src%d%c2_dp(src_lb(1):src_ub(1), &
                                              src_lb(2):src_ub(2)), &
                                  dst_sizes(1), dst_sizes(2))
         END IF
      CASE default
         DBCSR_ABORT("Invalid data type")
      END SELECT
      CALL timestop(handle)
   END SUBROUTINE dbcsr_data_copy_aa2