We allow : matrix(dp) [+]= [scale(dp)] * block(dp) matrix(dp) [+]= [scale(dp)] * block(sp) matrix(sp) [+]= [scale(dp)] * block(sp)
Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
type(dbcsr_type), | intent(inout) | :: | matrix | |||
integer, | intent(in) | :: | row | |||
integer, | intent(in) | :: | col | |||
type(dbcsr_data_obj) | :: | block | ||||
integer, | intent(inout), | optional, | DIMENSION(2) | :: | lb_row_col | |
logical, | intent(in), | optional | :: | transposed | ||
logical, | intent(in), | optional | :: | summation | ||
integer(kind=int_8), | intent(inout), | optional | :: | flop | ||
type(dbcsr_scalar_type), | intent(in), | optional | :: | scale |
SUBROUTINE dbcsr_put_block_area(matrix, row, col, block, lb_row_col, transposed, & summation, flop, scale) !! We allow : !! matrix(dp) [+]= [scale(dp)] * block(dp) !! matrix(dp) [+]= [scale(dp)] * block(sp) !! matrix(sp) [+]= [scale(dp)] * block(sp) TYPE(dbcsr_type), INTENT(INOUT) :: matrix INTEGER, INTENT(IN) :: row, col TYPE(dbcsr_data_obj) :: block INTEGER, DIMENSION(2), INTENT(INOUT), OPTIONAL :: lb_row_col LOGICAL, INTENT(IN), OPTIONAL :: transposed, summation INTEGER(KIND=int_8), INTENT(INOUT), OPTIONAL :: flop TYPE(dbcsr_scalar_type), INTENT(IN), OPTIONAL :: scale CHARACTER(len=*), PARAMETER :: routineN = 'dbcsr_put_block_area' INTEGER :: data_type_m, error_handle LOGICAL :: do_scale ! --------------------------------------------------------------------------- IF (careful_mod) CALL timeset(routineN, error_handle) data_type_m = dbcsr_get_data_type(matrix) do_scale = PRESENT(scale) IF (do_scale) THEN !IF(data_type_m /= scale%data_type) & ! DBCSR_ABORT("Incompatible data types matrix="//data_type_m//" scale="//scale%data_type) END IF IF (.NOT. ASSOCIATED(block%d)) & DBCSR_ABORT("Can only add valid data block!") SELECT CASE (block%d%data_type) CASE (dbcsr_type_real_4) IF (do_scale) THEN IF (data_type_m .EQ. dbcsr_type_real_4) THEN CALL dbcsr_put_block(matrix, row, col, dbcsr_get_data_p_s(block), lb_row_col, transposed, & summation, flop, scale=scale%r_sp) ELSEIF (data_type_m .EQ. dbcsr_type_real_8) THEN CALL dbcsr_put_block(matrix, row, col, & REAL(dbcsr_get_data_p_s(block), real_8), lb_row_col, transposed, & summation, flop, scale=REAL(scale%r_sp, real_8)) END IF ELSE IF (data_type_m .EQ. dbcsr_type_real_4) THEN CALL dbcsr_put_block(matrix, row, col, dbcsr_get_data_p_s(block), lb_row_col, transposed, & summation, flop) ELSEIF (data_type_m .EQ. dbcsr_type_real_8) THEN CALL dbcsr_put_block(matrix, row, col, & REAL(dbcsr_get_data_p_s(block), real_8), lb_row_col, transposed, & summation, flop) END IF END IF CASE (dbcsr_type_real_8) IF (do_scale) THEN CALL dbcsr_put_block(matrix, row, col, dbcsr_get_data_p_d(block), lb_row_col, transposed, & summation, flop, scale=scale%r_dp) ELSE CALL dbcsr_put_block(matrix, row, col, dbcsr_get_data_p_d(block), lb_row_col, transposed, & summation, flop) END IF CASE (dbcsr_type_complex_4) IF (do_scale) THEN CALL dbcsr_put_block(matrix, row, col, dbcsr_get_data_p_c(block), lb_row_col, transposed, & summation, flop, scale=scale%c_sp) ELSE CALL dbcsr_put_block(matrix, row, col, dbcsr_get_data_p_c(block), lb_row_col, transposed, & summation, flop) END IF CASE (dbcsr_type_complex_8) IF (do_scale) THEN CALL dbcsr_put_block(matrix, row, col, block%d%c_dp, lb_row_col, transposed, & summation, flop, scale=scale%c_dp) ELSE CALL dbcsr_put_block(matrix, row, col, block%d%c_dp, lb_row_col, transposed, & summation, flop) END IF CASE (dbcsr_type_real_4_2d) IF (do_scale) THEN CALL dbcsr_put_block(matrix, row, col, block%d%r2_sp, lb_row_col, transposed, & summation, flop, scale=scale%r_sp) ELSE CALL dbcsr_put_block(matrix, row, col, block%d%r2_sp, lb_row_col, transposed, & summation, flop) END IF CASE (dbcsr_type_real_8_2d) IF (do_scale) THEN CALL dbcsr_put_block(matrix, row, col, block%d%r2_dp, lb_row_col, transposed, & summation, flop, scale=scale%r_dp) ELSE CALL dbcsr_put_block(matrix, row, col, block%d%r2_dp, lb_row_col, transposed, & summation, flop) END IF CASE (dbcsr_type_complex_4_2d) IF (do_scale) THEN CALL dbcsr_put_block(matrix, row, col, block%d%c2_sp, lb_row_col, transposed, & summation, flop, scale=scale%c_sp) ELSE CALL dbcsr_put_block(matrix, row, col, block%d%c2_sp, lb_row_col, transposed, & summation, flop) END IF CASE (dbcsr_type_complex_8_2d) IF (do_scale) THEN CALL dbcsr_put_block(matrix, row, col, block%d%c2_dp, lb_row_col, transposed, & summation, flop, scale=scale%c_dp) ELSE CALL dbcsr_put_block(matrix, row, col, block%d%c2_dp, lb_row_col, transposed, & summation, flop) END IF CASE default DBCSR_ABORT("Invalid data type") END SELECT IF (careful_mod) CALL timestop(error_handle) END SUBROUTINE dbcsr_put_block_area