Adds two blocks
Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
type(dbcsr_data_obj), | intent(inout) | :: | block_a |
Block to add to |
||
type(dbcsr_data_obj), | intent(in) | :: | block_b |
Block to add to block_a |
||
integer, | intent(in), | optional | :: | len |
SUBROUTINE block_add_anytype(block_a, block_b, len) !! Adds two blocks TYPE(dbcsr_data_obj), INTENT(INOUT) :: block_a !! Block to add to TYPE(dbcsr_data_obj), INTENT(IN) :: block_b !! Block to add to block_a INTEGER, INTENT(IN), OPTIONAL :: len INTEGER :: n ! --------------------------------------------------------------------------- IF (careful_mod) THEN IF (dbcsr_data_get_type(block_a) /= dbcsr_data_get_type(block_a)) & DBCSR_ABORT("Mismatched data types.") END IF IF (PRESENT(len)) THEN n = len IF (dbcsr_data_get_size(block_b) < n) & DBCSR_ABORT("Block B too small.") ELSE n = dbcsr_data_get_size_referenced(block_b) END IF IF (dbcsr_data_get_size(block_a) < n) & DBCSR_ABORT("Block A too small.") SELECT CASE (dbcsr_data_get_type(block_a)) CASE (dbcsr_type_real_4) CALL block_add_s(block_a%d%r_sp, block_b%d%r_sp, n) CASE (dbcsr_type_real_8) CALL block_add_d(block_a%d%r_dp, block_b%d%r_dp, n) CASE (dbcsr_type_complex_4) CALL block_add_c(block_a%d%c_sp, block_b%d%c_sp, n) CASE (dbcsr_type_complex_8) CALL block_add_z(block_a%d%c_dp, block_b%d%c_dp, n) CASE (dbcsr_type_real_4_2d) CALL block_add_s(block_a%d%r2_sp, block_b%d%r2_sp, n) CASE (dbcsr_type_real_8_2d) CALL block_add_d(block_a%d%r2_dp, block_b%d%r2_dp, n) CASE (dbcsr_type_complex_4_2d) CALL block_add_c(block_a%d%c2_sp, block_b%d%c2_sp, n) CASE (dbcsr_type_complex_8_2d) CALL block_add_z(block_a%d%c2_dp, block_b%d%c2_dp, n) CASE default DBCSR_ABORT("Invalid data type!") END SELECT END SUBROUTINE block_add_anytype