[3852] | 1 | LOGICAL FUNCTION iso_verif_noNaN_nostop(x,err_msg) RESULT(out) |
---|
| 2 | USE infotrac, ONLY: isoCheck |
---|
| 3 | IMPLICIT NONE |
---|
| 4 | !--- Display the message if x is NaN and return .TRUE. if an error occured. |
---|
| 5 | REAL, INTENT(IN) :: x |
---|
| 6 | CHARACTER(LEN=*), INTENT(IN) :: err_msg |
---|
| 7 | include "iniprint.h" |
---|
| 8 | REAL, PARAMETER :: borne=1e19 |
---|
| 9 | out = .FALSE. |
---|
| 10 | IF(.NOT.isoCheck) RETURN |
---|
| 11 | out = x<=-borne .OR. x>=borne |
---|
| 12 | IF(.NOT.out) RETURN |
---|
| 13 | WRITE(lunout,*) 'Error detected by iso_verif_noNaN: '//TRIM(err_msg) |
---|
| 14 | WRITE(lunout,*) 'x=',x |
---|
| 15 | END FUNCTION iso_verif_noNaN_nostop |
---|
[2270] | 16 | |
---|
[3852] | 17 | LOGICAL FUNCTION iso_verif_egalite_nostop(a,b,err_msg) RESULT(out) |
---|
| 18 | USE infotrac, ONLY: isoCheck |
---|
| 19 | IMPLICIT NONE |
---|
| 20 | !--- Display the message if a/=b and return .FALSE. if an error occured. |
---|
| 21 | ! Equality is checked for absolute and relative error. |
---|
| 22 | REAL, INTENT(IN) :: a,b |
---|
| 23 | CHARACTER(LEN=*), INTENT(IN) :: err_msg |
---|
| 24 | include "iniprint.h" |
---|
| 25 | REAL, PARAMETER :: errmax=1e-8, errmaxrel=1e-3 |
---|
| 26 | out = .FALSE. |
---|
| 27 | IF(.NOT.isoCheck) RETURN |
---|
| 28 | out = ABS(a-b)>errmax |
---|
| 29 | IF(out) out = ABS((a-b)/MAX(MAX(ABS(b),ABS(a)),1e-18))>errmaxrel |
---|
| 30 | IF(.NOT.out) RETURN |
---|
| 31 | WRITE(lunout,*) 'Error detected by iso_verif_egalite: '//TRIM(err_msg) |
---|
| 32 | WRITE(lunout,*) 'a=',a |
---|
| 33 | WRITE(lunout,*) 'b=',b |
---|
| 34 | END FUNCTION iso_verif_egalite_nostop |
---|
[2270] | 35 | |
---|
[3852] | 36 | LOGICAL FUNCTION iso_verif_aberrant_nostop(x,kiso,q,err_msg) RESULT(out) |
---|
| 37 | USE infotrac, ONLY: isoCheck, tnat |
---|
| 38 | IMPLICIT NONE |
---|
| 39 | !--- Display the message if a/=b and return .FALSE. if an error occured. |
---|
| 40 | ! Equality is checked for absolute and relative error. |
---|
| 41 | REAL, INTENT(IN) :: x, q |
---|
| 42 | INTEGER, INTENT(IN) :: kiso ! 2=HDO, 1=O18 |
---|
| 43 | CHARACTER(LEN=*), INTENT(IN) :: err_msg |
---|
| 44 | include "iniprint.h" |
---|
| 45 | REAL, PARAMETER :: qmin=1e-11, deltaDmax=200.0, deltaDmin=-999.9 |
---|
| 46 | REAL :: deltaD |
---|
| 47 | out = .FALSE. |
---|
| 48 | IF(.NOT.isoCheck) RETURN |
---|
| 49 | IF(q<qmin) RETURN |
---|
| 50 | deltaD = (x/q/tnat(kiso)-1)*1000 |
---|
| 51 | out = deltaD>deltaDmax .OR. deltaD<deltaDmin |
---|
| 52 | IF(.NOT.out) RETURN |
---|
| 53 | WRITE(lunout,*) 'Error detected by iso_verif_aberrant: '//TRIM(err_msg) |
---|
| 54 | WRITE(lunout,*) 'q = ',q |
---|
| 55 | WRITE(lunout,*) 'deltaD = ',deltaD |
---|
| 56 | WRITE(lunout,*) 'kiso = ',kiso |
---|
| 57 | END FUNCTION iso_verif_aberrant_nostop |
---|
[2270] | 58 | |
---|