| 1 | LOGICAL FUNCTION iso_verif_noNaN_nostop(x, err_msg) RESULT(lerr) |
|---|
| 2 | IMPLICIT NONE |
|---|
| 3 | ! If "x" is NaN, print an error message . |
|---|
| 4 | REAL, INTENT(IN) :: x |
|---|
| 5 | CHARACTER(LEN=*), INTENT(IN) :: err_msg |
|---|
| 6 | REAL, PARAMETER :: borne = 1e19 |
|---|
| 7 | lerr = x > -borne .AND. x < borne |
|---|
| 8 | IF(.NOT.lerr) RETURN |
|---|
| 9 | WRITE(*,*) 'erreur detectee par iso_verif_nonNaN:' |
|---|
| 10 | WRITE(*,*) err_msg |
|---|
| 11 | WRITE(*,*) 'x=',x |
|---|
| 12 | END FUNCTION iso_verif_noNaN_nostop |
|---|
| 13 | |
|---|
| 14 | LOGICAL FUNCTION iso_verif_egalite_nostop(a, b, err_msg) RESULT(lerr) |
|---|
| 15 | IMPLICIT NONE |
|---|
| 16 | ! Compare "a" and "b". If a/=b, print an error message. |
|---|
| 17 | ! Both absolute and relative errors are checked for equality. |
|---|
| 18 | REAL, INTENT(IN) :: a, b |
|---|
| 19 | CHARACTER(LEN=*), INTENT(IN) :: err_msg |
|---|
| 20 | REAL, PARAMETER :: errmax = 1e-8, & ! max absolute error |
|---|
| 21 | errmaxrel = 1e-3 ! max relative error |
|---|
| 22 | lerr = ABS(a-b) > errmax |
|---|
| 23 | IF(.NOT.lerr) RETURN |
|---|
| 24 | lerr = ABS( (a-b) / MAX(MAX(ABS(b), ABS(a)),1e-18) ) > errmaxrel |
|---|
| 25 | IF(.NOT.lerr) RETURN |
|---|
| 26 | WRITE(*,*) 'erreur detectee par iso_verif_egalite:' |
|---|
| 27 | WRITE(*,*) err_msg |
|---|
| 28 | WRITE(*,*) 'a=',a |
|---|
| 29 | WRITE(*,*) 'b=',b |
|---|
| 30 | END FUNCTION iso_verif_egalite_nostop |
|---|
| 31 | |
|---|
| 32 | |
|---|
| 33 | LOGICAL FUNCTION iso_verif_aberrant_nostop(x, iso, q, err_msg) RESULT(lerr) |
|---|
| 34 | USE ioipsl, ONLY: getin |
|---|
| 35 | USE iso_params_mod, ONLY: tnat_HDO |
|---|
| 36 | |
|---|
| 37 | IMPLICIT NONE |
|---|
| 38 | |
|---|
| 39 | REAL, INTENT(IN) :: x, q |
|---|
| 40 | INTEGER, INTENT(IN) :: iso ! 2=HDO, 1=O18 |
|---|
| 41 | CHARACTER(LEN = *), INTENT(IN) :: err_msg |
|---|
| 42 | |
|---|
| 43 | REAL, PARAMETER :: qmin = 1e-11, & |
|---|
| 44 | deltaDmax = 200.0, & |
|---|
| 45 | deltaDmin =-999.9 |
|---|
| 46 | LOGICAL :: ltnat1 |
|---|
| 47 | LOGICAL, SAVE :: lFirst=.TRUE. |
|---|
| 48 | REAL, SAVE :: tnat |
|---|
| 49 | REAL :: deltaD |
|---|
| 50 | IF(lFirst) THEN |
|---|
| 51 | ltnat1 = .TRUE.; CALL getin('tnateq1', ltnat1) |
|---|
| 52 | tnat = tnat_HDO; IF(ltnat1) tnat = 1.0 |
|---|
| 53 | lFirst = .FALSE. |
|---|
| 54 | END IF |
|---|
| 55 | lerr = q > qmin |
|---|
| 56 | IF(.NOT.lerr) RETURN |
|---|
| 57 | deltaD = (x / q /tnat - 1.) * 1000. |
|---|
| 58 | lerr = deltaD > deltaDmax .OR. deltaD < deltaDmin |
|---|
| 59 | IF(.NOT.lerr) RETURN |
|---|
| 60 | WRITE(*,*) 'erreur detectee par iso_verif_aberrant:' |
|---|
| 61 | WRITE(*,*) err_msg |
|---|
| 62 | WRITE(*,*) 'q=',q |
|---|
| 63 | WRITE(*,*) 'deltaD=',deltaD |
|---|
| 64 | WRITE(*,*) 'iso=',iso |
|---|
| 65 | END FUNCTION iso_verif_aberrant_nostop |
|---|
