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