dbcsr_block_copy_aa Subroutine

public subroutine dbcsr_block_copy_aa(dst, src, row_size, col_size, lb, source_lb, scale)

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

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

source data area

integer, intent(in) :: row_size

row size of existing block column size of existing block

integer, intent(in) :: col_size

row size of existing block column size of existing block

integer, intent(in), optional :: lb

lower bound for destination (and source if not given explicitly) lower bound of source

integer, intent(in), optional :: source_lb

lower bound for destination (and source if not given explicitly) lower bound of source

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

scale data


Contents

Source Code


Source Code

   SUBROUTINE dbcsr_block_copy_aa(dst, src, &
                                  row_size, col_size, lb, source_lb, scale)
      !! 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
      TYPE(dbcsr_data_obj), INTENT(IN)                   :: src
         !! source data area
      INTEGER, INTENT(IN)                                :: row_size, col_size
         !! row size of existing block
         !! column size of existing block
      INTEGER, INTENT(IN), OPTIONAL                      :: lb, source_lb
         !! lower bound for destination (and source if not given explicitly)
         !! lower bound of source
      TYPE(dbcsr_scalar_type), INTENT(IN), OPTIONAL      :: scale
         !! scale data

      INTEGER                                            :: data_size, lb_s, lb_t, ub_s, ub_t

!     ---------------------------------------------------------------------------
      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 /= src%d%data_type) &
            DBCSR_ABORT("Data type must be the same.")
         IF (dst%d%data_type .NE. dbcsr_type_real_8 &
             .AND. dst%d%data_type .NE. dbcsr_type_real_4 &
             .AND. dst%d%data_type .NE. dbcsr_type_complex_8 &
             .AND. dst%d%data_type .NE. dbcsr_type_complex_4) &
            DBCSR_WARN("Incorrect data type.")
         IF (PRESENT(scale)) THEN
            IF (dbcsr_type_is_2d(src%d%data_type)) THEN
               IF (scale%data_type /= dbcsr_type_2d_to_1d(src%d%data_type)) &
                  DBCSR_ABORT("Incompatible data types")
            ELSE
               IF (scale%data_type /= src%d%data_type) &
                  DBCSR_ABORT("Incompatible data types")
            END IF
         END IF
      END IF
      data_size = row_size*col_size
      lb_t = 1
      IF (PRESENT(lb)) lb_t = lb
      ub_t = lb_t + data_size - 1
      IF (PRESENT(source_lb)) THEN
         lb_s = source_lb
         ub_s = source_lb + data_size - 1
      ELSE
         lb_s = lb_t
         ub_s = ub_t
      END IF
      SELECT CASE (src%d%data_type)
      CASE (dbcsr_type_real_8)
         IF (PRESENT(scale)) THEN
            CALL dbcsr_block_copy(dst%d%r_dp(lb_t:ub_t), &
                                  src%d%r_dp(lb_s:ub_s)*scale%r_dp, &
                                  row_size, col_size)
         ELSE
            CALL dbcsr_block_copy(dst%d%r_dp(lb_t:ub_t), &
                                  src%d%r_dp(lb_s:ub_s), &
                                  row_size, col_size)
         END IF
      CASE (dbcsr_type_real_4)
         IF (PRESENT(scale)) THEN
            CALL dbcsr_block_copy(dst%d%r_sp(lb_t:ub_t), &
                                  src%d%r_sp(lb_s:ub_s)*scale%r_sp, &
                                  row_size, col_size)
         ELSE
            CALL dbcsr_block_copy(dst%d%r_sp(lb_t:ub_t), &
                                  src%d%r_sp(lb_s:ub_s), &
                                  row_size, col_size)
         END IF
      CASE (dbcsr_type_complex_8)
         IF (PRESENT(scale)) THEN
            CALL dbcsr_block_copy(dst%d%c_dp(lb_t:ub_t), &
                                  src%d%c_dp(lb_s:ub_s)*scale%c_dp, &
                                  row_size, col_size)
         ELSE
            CALL dbcsr_block_copy(dst%d%c_dp(lb_t:ub_t), &
                                  src%d%c_dp(lb_s:ub_s), &
                                  row_size, col_size)
         END IF
      CASE (dbcsr_type_complex_4)
         IF (PRESENT(scale)) THEN
            CALL dbcsr_block_copy(dst%d%c_sp(lb_t:ub_t), &
                                  src%d%c_sp(lb_s:ub_s)*scale%c_sp, &
                                  row_size, col_size)
         ELSE
            CALL dbcsr_block_copy(dst%d%c_sp(lb_t:ub_t), &
                                  src%d%c_sp(lb_s:ub_s), &
                                  row_size, col_size)
         END IF
      CASE default
         DBCSR_ABORT("Incorrect data type.")
      END SELECT
   END SUBROUTINE dbcsr_block_copy_aa