Verifies bounds of a data area
Type | Intent | Optional | 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 |
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