|
| 1 | +program example_error_state2 |
| 2 | + !! This example shows how to set a `type(state_type)` variable to process output conditions |
| 3 | + !! out of a simple division routine. The example is meant to highlight: |
| 4 | + !! 1) the different mechanisms that can be used to initialize the `state_type` variable providing |
| 5 | + !! strings, scalars, or arrays, on input to it; |
| 6 | + !! 2) `pure` setup of the error control |
| 7 | + use stdlib_error, only: state_type, STDLIB_VALUE_ERROR, STDLIB_SUCCESS |
| 8 | + implicit none |
| 9 | + type(state_type) :: err |
| 10 | + real :: a_div_b |
| 11 | + |
| 12 | + ! OK |
| 13 | + call very_simple_division(0.0,2.0,a_div_b,err) |
| 14 | + print *, err%print() |
| 15 | + |
| 16 | + ! Division by zero |
| 17 | + call very_simple_division(1.0,0.0,a_div_b,err) |
| 18 | + print *, err%print() |
| 19 | + |
| 20 | + ! Out of bounds |
| 21 | + call very_simple_division(huge(0.0),0.001,a_div_b,err) |
| 22 | + print *, err%print() |
| 23 | + |
| 24 | + contains |
| 25 | + |
| 26 | + !> Simple division returning an integer flag (LAPACK style) |
| 27 | + elemental subroutine very_simple_division(a,b,a_div_b,err) |
| 28 | + real, intent(in) :: a,b |
| 29 | + real, intent(out) :: a_div_b |
| 30 | + type(state_type), optional, intent(out) :: err |
| 31 | + |
| 32 | + type(state_type) :: err0 |
| 33 | + real, parameter :: MAXABS = huge(0.0) |
| 34 | + character(*), parameter :: this = 'simple division' |
| 35 | + |
| 36 | + !> Check a |
| 37 | + if (b==0.0) then |
| 38 | + ! Division by zero |
| 39 | + err0 = state_type(this,STDLIB_VALUE_ERROR,'Division by zero trying ',a,'/',b) |
| 40 | + elseif (.not.abs(b)<MAXABS) then |
| 41 | + ! B is out of bounds |
| 42 | + err0 = state_type(this,STDLIB_VALUE_ERROR,'B is infinity in a/b: ',[a,b]) ! use an array |
| 43 | + elseif (.not.abs(a)<MAXABS) then |
| 44 | + ! A is out of bounds |
| 45 | + err0 = state_type(this,STDLIB_VALUE_ERROR,'A is infinity in a/b: a=',a,' b=',b) |
| 46 | + else |
| 47 | + a_div_b = a/b |
| 48 | + if (.not.abs(a_div_b)<MAXABS) then |
| 49 | + ! Result is out of bounds |
| 50 | + err0 = state_type(this,STDLIB_VALUE_ERROR,'A/B is infinity in a/b: a=',a,' b=',b) |
| 51 | + else |
| 52 | + err0%state = STDLIB_SUCCESS |
| 53 | + end if |
| 54 | + end if |
| 55 | + |
| 56 | + ! Return error flag, or hard stop on failure |
| 57 | + call err0%handle(err) |
| 58 | + |
| 59 | + end subroutine very_simple_division |
| 60 | + |
| 61 | + |
| 62 | +end program example_error_state2 |
0 commit comments