source: LMDZ6/trunk/libf/dyn3d_common/iso_verif_dyn.f90 @ 5456

Last change on this file since 5456 was 5268, checked in by abarral, 2 months ago

.f90 <-> .F90 depending on cpp key use

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