dbcsr_data_copy_aa Subroutine

private subroutine dbcsr_data_copy_aa(dst, lb, data_size, src, source_lb, scale, lb2, data_size2, source_lb2)

Copy data from one data area to another. There are no checks done for correctness!

Arguments

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

destination data area

integer, intent(in) :: lb

lower bound for destination (and source if not given explicitly) number of elements to copy

integer, intent(in) :: data_size

lower bound for destination (and source if not given explicitly) number of elements to copy

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

source data area

integer, intent(in), optional :: source_lb

lower bound of source

type(dbcsr_scalar_type), intent(in), optional :: scale

scale by this factor

integer, intent(in), optional :: lb2

2nd dimension lower bound 2nd dimension data size 2nd dimension lower bound for source

integer, intent(in), optional :: data_size2

2nd dimension lower bound 2nd dimension data size 2nd dimension lower bound for source

integer, intent(in), optional :: source_lb2

2nd dimension lower bound 2nd dimension data size 2nd dimension lower bound for source


Contents

Source Code


Source Code

   SUBROUTINE dbcsr_data_copy_aa(dst, lb, data_size, src, source_lb, scale, &
                                 lb2, data_size2, 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
      INTEGER, INTENT(IN)                                :: lb, data_size
         !! lower bound for destination (and source if not given explicitly)
         !! number of elements to copy
      TYPE(dbcsr_data_obj), INTENT(IN)                   :: src
         !! source data area
      INTEGER, INTENT(IN), OPTIONAL                      :: source_lb
         !! lower bound of source
      TYPE(dbcsr_scalar_type), INTENT(IN), OPTIONAL      :: scale
         !! scale by this factor
      INTEGER, INTENT(IN), OPTIONAL                      :: lb2, data_size2, source_lb2
         !! 2nd dimension lower bound
         !! 2nd dimension data size
         !! 2nd dimension lower bound for source

      INTEGER                                            :: lb2_s, lb_s, ub, ub2, ub2_s, ub_s
!     ---------------------------------------------------------------------------

      lb2_s = 0
      ub2_s = 0
      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 .NE. src%d%data_type) &
            DBCSR_ABORT("Data type must be the same.")
      END IF
      IF (PRESENT(scale) .AND. careful_mod) THEN
         IF (dbcsr_type_is_2d(src%d%data_type)) THEN
            IF (scale%data_type .NE. dbcsr_type_2d_to_1d(src%d%data_type)) &
               DBCSR_ABORT("Incomptable data types")
         ELSE
            IF (scale%data_type .NE. src%d%data_type) &
               DBCSR_ABORT("Incomptable data types")
         END IF
      END IF
      ub = lb + data_size - 1
      IF (PRESENT(source_lb)) THEN
         lb_s = source_lb
         ub_s = source_lb + data_size - 1
      ELSE
         lb_s = lb
         ub_s = ub
      END IF
      IF (careful_mod) THEN
         IF (dbcsr_type_is_2d(src%d%data_type) .AND. .NOT. PRESENT(lb2)) &
            DBCSR_ABORT("Must specify lb2 for 2-D data area")
         IF (dbcsr_type_is_2d(src%d%data_type) .AND. .NOT. PRESENT(data_size2)) &
            DBCSR_ABORT("Must specify data_size2 for 2-D data area")
      END IF
      IF (PRESENT(lb2)) THEN
         IF (careful_mod) THEN
            IF (.NOT. dbcsr_type_is_2d(src%d%data_type)) &
               DBCSR_WARN("Should not specify lb2 for 1-D data")
         END IF
         ub2 = lb2 + data_size2 - 1
         IF (PRESENT(source_lb2)) THEN
            lb2_s = source_lb2
            ub2_s = source_lb2 + data_size2 - 1
         ELSE
            lb2_s = lb2
            ub2_s = ub2
         END IF
      END IF
      SELECT CASE (src%d%data_type)
      CASE (dbcsr_type_real_4)
         IF (debug_mod) THEN
            IF (.NOT. ASSOCIATED(dst%d%r_sp)) &
               DBCSR_ABORT("associated(dst%d%r_sp)")
            IF (.NOT. ASSOCIATED(src%d%r_sp)) &
               DBCSR_ABORT("associated(src%d%r_sp)")
            IF (lb < LBOUND(dst%d%r_sp, 1)) &
               DBCSR_ABORT("lb dst%d%r_sp")
            IF (ub > UBOUND(dst%d%r_sp, 1)) &
               DBCSR_ABORT("ub dst%d%r_sp")
            IF (lb_s < LBOUND(src%d%r_sp, 1)) &
               DBCSR_ABORT("lb src%d%r_sp")
            IF (ub_s > UBOUND(src%d%r_sp, 1)) &
               DBCSR_ABORT("ub src%d%r_sp")
         END IF
         IF (PRESENT(scale)) THEN
            dst%d%r_sp(lb:ub) = scale%r_sp*src%d%r_sp(lb_s:ub_s)
         ELSE
            dst%d%r_sp(lb:ub) = src%d%r_sp(lb_s:ub_s)
         END IF
      CASE (dbcsr_type_real_8)
         IF (debug_mod) THEN
            IF (.NOT. ASSOCIATED(dst%d%r_dp)) &
               DBCSR_ABORT("associated(dst%d%r_dp)")
            IF (.NOT. ASSOCIATED(src%d%r_dp)) &
               DBCSR_ABORT("associated(src%d%r_dp)")
            IF (lb < LBOUND(dst%d%r_dp, 1)) &
               DBCSR_ABORT("lb dst%d%r_dp")
            IF (ub > UBOUND(dst%d%r_dp, 1)) &
               DBCSR_ABORT("ub dst%d%r_dp")
            IF (lb_s < LBOUND(src%d%r_dp, 1)) &
               DBCSR_ABORT("lb src%d%r_dp")
            IF (ub_s > UBOUND(src%d%r_dp, 1)) &
               DBCSR_ABORT("ub src%d%r_dp")
         END IF
         IF (PRESENT(scale)) THEN
            dst%d%r_dp(lb:ub) = scale%r_dp*src%d%r_dp(lb_s:ub_s)
         ELSE
            dst%d%r_dp(lb:ub) = src%d%r_dp(lb_s:ub_s)
         END IF
      CASE (dbcsr_type_complex_4)
         IF (debug_mod) THEN
            IF (.NOT. ASSOCIATED(dst%d%c_sp)) &
               DBCSR_ABORT("associated(dst%d%c_sp)")
            IF (.NOT. ASSOCIATED(src%d%c_sp)) &
               DBCSR_ABORT("associated(src%d%c_sp)")
            IF (lb < LBOUND(dst%d%c_sp, 1)) &
               DBCSR_ABORT("lb dst%d%c_sp")
            IF (ub > UBOUND(dst%d%c_sp, 1)) &
               DBCSR_ABORT("ub dst%d%c_sp")
            IF (lb_s < LBOUND(src%d%c_sp, 1)) &
               DBCSR_ABORT("lb src%d%c_sp")
            IF (ub_s > UBOUND(src%d%c_sp, 1)) &
               DBCSR_ABORT("ub src%d%c_sp")
         END IF
         IF (PRESENT(scale)) THEN
            dst%d%c_sp(lb:ub) = scale%c_sp*src%d%c_sp(lb_s:ub_s)
         ELSE
            dst%d%c_sp(lb:ub) = src%d%c_sp(lb_s:ub_s)
         END IF
      CASE (dbcsr_type_complex_8)
         IF (debug_mod) THEN
            IF (.NOT. ASSOCIATED(dst%d%c_dp)) &
               DBCSR_ABORT("associated(dst%d%c_dp)")
            IF (.NOT. ASSOCIATED(src%d%c_dp)) &
               DBCSR_ABORT("associated(src%d%c_dp)")
            IF (lb < LBOUND(dst%d%c_dp, 1)) &
               DBCSR_ABORT("lb dst%d%c_dp")
            IF (ub > UBOUND(dst%d%c_dp, 1)) &
               DBCSR_ABORT("ub dst%d%c_dp")
            IF (lb_s < LBOUND(src%d%c_dp, 1)) &
               DBCSR_ABORT("lb src%d%c_dp")
            IF (ub_s > UBOUND(src%d%c_dp, 1)) &
               DBCSR_ABORT("ub src%d%c_dp")
         END IF
         IF (PRESENT(scale)) THEN
            dst%d%c_dp(lb:ub) = scale%c_dp*src%d%c_dp(lb_s:ub_s)
         ELSE
            dst%d%c_dp(lb:ub) = src%d%c_dp(lb_s:ub_s)
         END IF
      CASE (dbcsr_type_real_4_2d)
         IF (PRESENT(scale)) THEN
            dst%d%r2_sp(lb:ub, lb2:ub2) = &
               scale%r_sp*src%d%r2_sp(lb_s:ub_s, lb2_s:ub2_s)
         ELSE
            dst%d%r2_sp(lb:ub, lb2:ub2) = src%d%r2_sp(lb_s:ub_s, lb2_s:ub2_s)
         END IF
      CASE (dbcsr_type_real_8_2d)
         IF (PRESENT(scale)) THEN
            dst%d%r2_dp(lb:ub, lb2:ub2) = &
               scale%r_dp*src%d%r2_dp(lb_s:ub_s, lb2_s:ub2_s)
         ELSE
            dst%d%r2_dp(lb:ub, lb2:ub2) = src%d%r2_dp(lb_s:ub_s, lb2_s:ub2_s)
         END IF
      CASE (dbcsr_type_complex_4_2d)
         IF (PRESENT(scale)) THEN
            dst%d%c2_sp(lb:ub, lb2:ub2) = &
               scale%c_sp*src%d%c2_sp(lb_s:ub_s, lb2_s:ub2_s)
         ELSE
            dst%d%c2_sp(lb:ub, lb2:ub2) = src%d%c2_sp(lb_s:ub_s, lb2_s:ub2_s)
         END IF
      CASE (dbcsr_type_complex_8_2d)
         IF (PRESENT(scale)) THEN
            dst%d%c2_dp(lb:ub, lb2:ub2) = &
               scale%c_dp*src%d%c2_dp(lb_s:ub_s, lb2_s:ub2_s)
         ELSE
            dst%d%c2_dp(lb:ub, lb2:ub2) = src%d%c2_dp(lb_s:ub_s, lb2_s:ub2_s)
         END IF
      CASE default
         DBCSR_ABORT("Invalid data type")
      END SELECT
   END SUBROUTINE dbcsr_data_copy_aa