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