block_add_anytype Subroutine

private subroutine block_add_anytype(block_a, block_b, len)

Adds two blocks

Arguments

Type IntentOptional 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

Source Code

   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