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