source: LMDZ6/trunk/libf/dyn3d_common/iso_verif_dyn.F90 @ 5246

Last change on this file since 5246 was 5214, checked in by dcugnet, 2 months ago

The fortran parameters file "iso_params_mod.F90" is introduced so that "tnat" and "alpha_ideal" are defined in a single place but used in several.
The "getKey" routine is only used in "infotrac" and "infotrac_phy" routines, but could be used outside this scope to get tracers parameters (read from "tracer.def") or isotopic parameters (read from "isotopes_params.def" - disabled for now).

File size: 2.2 KB
Line 
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
13
14
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
32
33
34LOGICAL FUNCTION iso_verif_aberrant_nostop(x, iso, q, err_msg) RESULT(lerr)
35#ifdef CPP_IOIPSL
36   USE IOIPSL, ONLY: getin
37#else
38   USE ioipsl_getincom, ONLY: getin
39#endif
40   USE iso_params_mod, ONLY: tnat_HDO
41   IMPLICIT NONE
42   REAL,             INTENT(IN) :: x, q
43   INTEGER,          INTENT(IN) :: iso ! 2=HDO, 1=O18
44   CHARACTER(LEN=*), INTENT(IN) :: err_msg
45
46   REAL, PARAMETER :: qmin = 1e-11, &
47                 deltaDmax = 200.0, &
48                 deltaDmin =-999.9
49   LOGICAL       :: ltnat1
50   LOGICAL, SAVE :: lFirst=.TRUE.
51   REAL,    SAVE :: tnat
52   REAL          :: deltaD
53   IF(lFirst) THEN
54      ltnat1 = .TRUE.; CALL getin('tnateq1', ltnat1)
55      tnat = tnat_HDO; IF(ltnat1) tnat = 1.0
56      lFirst = .FALSE.
57   END IF
58   lerr = q > qmin
59   IF(.NOT.lerr) RETURN
60   deltaD = (x / q /tnat - 1.) * 1000.
61   lerr = deltaD > deltaDmax .OR. deltaD < deltaDmin
62   IF(.NOT.lerr) RETURN
63   WRITE(*,*) 'erreur detectee par iso_verif_aberrant:'
64   WRITE(*,*) err_msg
65   WRITE(*,*) 'q=',q
66   WRITE(*,*) 'deltaD=',deltaD
67   WRITE(*,*) 'iso=',iso
68END FUNCTION iso_verif_aberrant_nostop
69
Note: See TracBrowser for help on using the repository browser.