Scale a data area. There are no checks done for correctness!
History - 2010-09 [??] Copied from block_transpose? - 2010-09-20 [UB] Swaps/corrects row/column definitions for 2-D bounds
| Type | Intent | Optional | Attributes | Name | ||
|---|---|---|---|---|---|---|
| type(dbcsr_data_obj), | intent(inout) | :: | dst | |||
| type(dbcsr_scalar_type), | intent(in) | :: | scale |
scale data |
||
| 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 2nd dimension for target |
|
| integer, | intent(in), | optional | :: | lb2 |
lower bound for destination (and source if not given explicitly) lower bound of 2nd dimension for target |
SUBROUTINE dbcsr_block_scale(dst, scale, &
row_size, col_size, lb, lb2)
!! Scale a data area.
!! There are no checks done for correctness!
!!
!! History
!! - 2010-09 [??] Copied from block_transpose?
!! - 2010-09-20 [UB] Swaps/corrects row/column definitions for 2-D bounds
TYPE(dbcsr_data_obj), INTENT(INOUT) :: dst
TYPE(dbcsr_scalar_type), INTENT(IN) :: scale
!! scale data
INTEGER, INTENT(IN) :: row_size, col_size
!! row size of existing block
!! column size of existing block
INTEGER, INTENT(IN), OPTIONAL :: lb, lb2
!! lower bound for destination (and source if not given explicitly)
!! lower bound of 2nd dimension for target
CHARACTER(len=*), PARAMETER :: routineN = 'dbcsr_block_scale'
INTEGER :: data_size, handle, lb2_t, lb_t, ub_t
! ---------------------------------------------------------------------------
IF (careful_mod) CALL timeset(routineN, handle)
IF (debug_mod) THEN
IF (.NOT. ASSOCIATED(dst%d)) &
DBCSR_ABORT("Data area must be setup.")
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 &
.AND. dst%d%data_type .NE. dbcsr_type_real_8_2d &
.AND. dst%d%data_type .NE. dbcsr_type_real_4_2d &
.AND. dst%d%data_type .NE. dbcsr_type_complex_8_2d &
.AND. dst%d%data_type .NE. dbcsr_type_complex_4_2d) &
DBCSR_WARN("Incorrect data type.")
END IF
IF (scale%data_type /= dbcsr_type_2d_to_1d(dst%d%data_type)) &
DBCSR_ABORT("Incompatible data types")
data_size = row_size*col_size
lb_t = 1
IF (PRESENT(lb)) lb_t = lb
ub_t = lb_t + data_size - 1
lb2_t = 1
IF (PRESENT(lb2)) lb2_t = lb2
SELECT CASE (dst%d%data_type)
CASE (dbcsr_type_real_8)
dst%d%r_dp(lb_t:ub_t) = dst%d%r_dp(lb_t:ub_t)*scale%r_dp
CASE (dbcsr_type_real_4)
dst%d%r_sp(lb_t:ub_t) = dst%d%r_sp(lb_t:ub_t)*scale%r_sp
CASE (dbcsr_type_complex_8)
dst%d%c_dp(lb_t:ub_t) = dst%d%c_dp(lb_t:ub_t)*scale%c_dp
CASE (dbcsr_type_complex_4)
dst%d%c_sp(lb_t:ub_t) = dst%d%c_sp(lb_t:ub_t)*scale%c_sp
CASE (dbcsr_type_real_8_2d)
dst%d%r2_dp(lb_t:lb_t + row_size - 1, lb2_t:lb2_t + col_size - 1) = &
dst%d%r2_dp(lb_t:lb_t + row_size - 1, lb2_t:lb2_t + col_size - 1)*scale%r_dp
CASE (dbcsr_type_real_4_2d)
dst%d%r2_sp(lb_t:lb_t + row_size - 1, lb2_t:lb2_t + col_size - 1) = &
dst%d%r2_sp(lb_t:lb_t + row_size - 1, lb2_t:lb2_t + col_size - 1)*scale%r_sp
CASE (dbcsr_type_complex_8_2d)
dst%d%c2_dp(lb_t:lb_t + row_size - 1, lb2_t:lb2_t + col_size - 1) = &
dst%d%c2_dp(lb_t:lb_t + row_size - 1, lb2_t:lb2_t + col_size - 1)*scale%c_dp
CASE (dbcsr_type_complex_4_2d)
dst%d%c2_sp(lb_t:lb_t + row_size - 1, lb2_t:lb2_t + col_size - 1) = &
dst%d%c2_sp(lb_t:lb_t + row_size - 1, lb2_t:lb2_t + col_size - 1)*scale%c_sp
CASE default
DBCSR_ABORT("Incorrect data type.")
END SELECT
IF (careful_mod) CALL timestop(handle)
END SUBROUTINE dbcsr_block_scale