dbcsr_data_verify_bounds Subroutine

public subroutine dbcsr_data_verify_bounds(area, lb, ub)

Verifies bounds of a data area

Arguments

Type IntentOptional Attributes Name
type(dbcsr_data_obj), intent(in) :: area

Data area

integer, intent(in), DIMENSION(:) :: lb

lower bounds upper bounds

integer, intent(in), DIMENSION(:) :: ub

lower bounds upper bounds


Contents


Source Code

   SUBROUTINE dbcsr_data_verify_bounds(area, lb, ub)
      !! Verifies bounds of a data area

      TYPE(dbcsr_data_obj), INTENT(IN)                   :: area
         !! Data area
      INTEGER, DIMENSION(:), INTENT(IN)                  :: lb, ub
         !! lower bounds
         !! upper bounds

      CHARACTER(len=*), PARAMETER :: routineN = 'dbcsr_data_verify_bounds'

      INTEGER                                            :: data_type, handle

!   ---------------------------------------------------------------------------

      CALL timeset(routineN, handle)
      data_type = dbcsr_data_get_type(area)
      IF (dbcsr_type_is_2d(data_type)) THEN
         IF (SIZE(lb) /= 2) &
            DBCSR_ABORT("size must be 2 for 2-d lb")
         IF (SIZE(ub) /= 2) &
            DBCSR_ABORT("size must be 2 for 2-d ub")
      ELSE
         IF (SIZE(lb) /= 1) &
            DBCSR_ABORT("size must be 1 for 1-d lb")
         IF (SIZE(ub) /= 1) &
            DBCSR_ABORT("size must be 1 for 1-d ub")
      END IF
      SELECT CASE (data_type)
      CASE (dbcsr_type_real_4)
         IF (lb(1) < LBOUND(area%d%r_sp, 1)) DBCSR_ABORT("lb r_sp")
         IF (ub(1) > UBOUND(area%d%r_sp, 1)) DBCSR_ABORT("ub r_sp")
      CASE (dbcsr_type_real_4_2d)
         IF (lb(1) < LBOUND(area%d%r2_sp, 1)) DBCSR_ABORT("lb r_sp 2d")
         IF (ub(1) > UBOUND(area%d%r2_sp, 1)) DBCSR_ABORT("ub r_sp 2d")
         IF (lb(2) < LBOUND(area%d%r2_sp, 2)) DBCSR_ABORT("lb r_sp 2d")
         IF (ub(2) > UBOUND(area%d%r2_sp, 2)) DBCSR_ABORT("ub r_sp 2d")
      CASE (dbcsr_type_real_8)
         IF (lb(1) < LBOUND(area%d%r_dp, 1)) DBCSR_ABORT("lb r_dp")
         IF (ub(1) > UBOUND(area%d%r_dp, 1)) DBCSR_ABORT("ub r_dp")
      CASE (dbcsr_type_real_8_2d)
         IF (lb(1) < LBOUND(area%d%r2_dp, 1)) DBCSR_ABORT("lb r_dp 2d")
         IF (ub(1) > UBOUND(area%d%r2_dp, 1)) DBCSR_ABORT("ub r_dp 2d")
         IF (lb(2) < LBOUND(area%d%r2_dp, 2)) DBCSR_ABORT("lb r_dp 2d")
         IF (ub(2) > UBOUND(area%d%r2_dp, 2)) DBCSR_ABORT("ub r_dp 2d")
      CASE (dbcsr_type_complex_4)
         IF (lb(1) < LBOUND(area%d%c_sp, 1)) DBCSR_ABORT("lb c_sp")
         IF (ub(1) > UBOUND(area%d%c_sp, 1)) DBCSR_ABORT("ub c_sp")
      CASE (dbcsr_type_complex_4_2d)
         IF (lb(1) < LBOUND(area%d%c2_sp, 1)) DBCSR_ABORT("lb c_sp 2d")
         IF (ub(1) > UBOUND(area%d%c2_sp, 1)) DBCSR_ABORT("ub c_sp 2d")
         IF (lb(2) < LBOUND(area%d%c2_sp, 2)) DBCSR_ABORT("lb c_sp 2d")
         IF (ub(2) > UBOUND(area%d%c2_sp, 2)) DBCSR_ABORT("ub c_sp 2d")
      CASE (dbcsr_type_complex_8)
         IF (lb(1) < LBOUND(area%d%c_dp, 1)) DBCSR_ABORT("lb c_dp")
         IF (ub(1) > UBOUND(area%d%c_dp, 1)) DBCSR_ABORT("ub c_dp")
      CASE (dbcsr_type_complex_8_2d)
         IF (lb(1) < LBOUND(area%d%c2_dp, 1)) DBCSR_ABORT("lb c_dp 2d")
         IF (ub(1) > UBOUND(area%d%c2_dp, 1)) DBCSR_ABORT("ub c_dp 2d")
         IF (lb(2) < LBOUND(area%d%c2_dp, 2)) DBCSR_ABORT("lb c_dp 2d")
         IF (ub(2) > UBOUND(area%d%c2_dp, 2)) DBCSR_ABORT("ub c_dp 2d")
      CASE default
         DBCSR_ABORT("Invalid data type")
      END SELECT
      CALL timestop(handle)
   END SUBROUTINE dbcsr_data_verify_bounds