block_add_anytype_bounds Subroutine

private subroutine block_add_anytype_bounds(block_a, block_b, lb_a, lb_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) :: lb_a
integer, intent(in) :: lb_b
integer, intent(in) :: len

Source Code

   SUBROUTINE block_add_anytype_bounds(block_a, block_b, lb_a, lb_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)                                :: lb_a, lb_b, len

!     ---------------------------------------------------------------------------
      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 (dbcsr_data_get_size(block_b) < lb_b + len - 1) &
         DBCSR_ABORT("Block B too small.")
      IF (dbcsr_data_get_size(block_a) < lb_a + len - 1) &
         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(lb_a:), block_b%d%r_sp(lb_b:), len)
      CASE (dbcsr_type_real_8)
         CALL block_add_d(block_a%d%r_dp(lb_a:), block_b%d%r_dp(lb_b:), len)
      CASE (dbcsr_type_complex_4)
         CALL block_add_c(block_a%d%c_sp(lb_a:), block_b%d%c_sp(lb_b:), len)
      CASE (dbcsr_type_complex_8)
         CALL block_add_z(block_a%d%c_dp(lb_a:), block_b%d%c_dp(lb_b:), len)
      CASE default
         DBCSR_ABORT("Invalid data type!")
      END SELECT
   END SUBROUTINE block_add_anytype_bounds