dbcsr_data_copy_aa

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

Type	Intent	Optional		Name
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

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

dbcsr_data_copy_aa Subroutine

Contents

Source Code

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

Arguments

Source Code