source: LMDZ6/trunk/libf/dyn3d_common/iso_verif_dyn.F @ 5183

Last change on this file since 5183 was 5183, checked in by dcugnet, 8 weeks ago
  • Remove INCA retro-compatibility with "traceur.def" (containing only water tracers but getting chemical species from an internal INCA routine).
  • The "trac_type" derived type internal to "readTracFiles_mod" is removed because a generic "keys_type" is enough: no explicit key ("%" operator) is needed, even %name.
  • The "trac_type" and "isot_type" derived types are now defined locally in "infotrac" and "infotrac_phy" (and more generally in each context: dynamic, lmdz dynamics, lmdz physics, etc.). The "readTracFiles_mod" module is now only used in these two routines:
    • few internal routines/variables (addPhase, delPhase, new2oldH2O, newHNO3, oldHNO3) are made available through "infotrac" and "infotrac_phy".
    • the "getKey" routine is only used in these two routines to define the explicit keys ("%" operator) of the local derived types "trac_type" and "isot_type". It could be in principle used outside this scope to get tracers parameters (read from "tracer.def") or isotopic parameters (read from "isotopes_params.def" - disabled for now).
  • 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. "ltnat1" is no longer hardcoded but defined with the *.def files parameter "tnat1"
  • Few minor changes:
    • use "infotrac_phy" instead of "infotrac" in calfis* because "tracers(:)%isAdvected" is defined in physics only.
    • "isotopes_mod" now ready for several isotopes classes (currently: only H2O)
    • isotopes class name (the name of the parent of the isotopes) is now %name and no longer %parent.
    • improvement of "getKey"
File size: 3.2 KB
Line 
1        function iso_verif_noNaN_nostop(x,err_msg)
2        implicit none
3        ! si x est NaN, on affiche message
4        ! d'erreur et return 1 si erreur
5
6        ! input:
7        real x
8        character*(*) err_msg ! message d''erreur à afficher
9
10        ! output
11        real borne
12        parameter (borne=1e19)
13        integer iso_verif_noNaN_nostop
14
15        if ((x.gt.-borne).and.(x.lt.borne)) then
16                iso_verif_noNAN_nostop=0
17        else
18            write(*,*) 'erreur detectee par iso_verif_nonNaN:'
19            write(*,*) err_msg
20            write(*,*) 'x=',x
21            iso_verif_noNaN_nostop=1
22        endif     
23
24        return
25        end
26
27        function iso_verif_egalite_nostop
28     :           (a,b,err_msg)
29        implicit none
30        ! compare a et b. Si pas egal, on affiche message
31        ! d'erreur et stoppe
32        ! pour egalite, on verifie erreur absolue et arreur relative
33
34        ! input:
35        real a, b
36        character*(*) err_msg ! message d''erreur à afficher
37
38        ! locals
39        real errmax ! erreur maximale en absolu.
40        real errmaxrel ! erreur maximale en relatif autorisée
41        parameter (errmax=1e-8)
42        parameter (errmaxrel=1e-3)
43
44        ! output
45        integer iso_verif_egalite_nostop
46
47        iso_verif_egalite_nostop=0
48
49        if (abs(a-b).gt.errmax) then
50          if (abs((a-b)/max(max(abs(b),abs(a)),1e-18))
51     :            .gt.errmaxrel) then
52            write(*,*) 'erreur detectee par iso_verif_egalite:'
53            write(*,*) err_msg
54            write(*,*) 'a=',a
55            write(*,*) 'b=',b
56            iso_verif_egalite_nostop=1
57          endif
58        endif     
59       
60        return
61        end       
62
63
64        function iso_verif_aberrant_nostop
65     :           (x,iso,q,err_msg)
66#ifdef CPP_IOIPSL
67        USE IOIPSL, ONLY: getin
68#else
69        USE ioipsl_getincom, ONLY: getin
70#endif
71        USE iso_params_mod, ONLY: tnat_HDO
72        implicit none
73       
74        ! input:
75        real x,q
76        integer iso ! 2=HDO, 1=O18
77        character*(*) err_msg ! message d''erreur à afficher
78
79        ! locals
80        real qmin,deltaD
81        real deltaDmax,deltaDmin
82        parameter (qmin=1e-11)
83        parameter (deltaDmax=200.0,deltaDmin=-999.9)
84        LOGICAL       :: ltnat1
85        LOGICAL, SAVE :: lFirst=.TRUE.
86        REAL,    SAVE :: tnat
87
88        ! output
89        integer iso_verif_aberrant_nostop
90
91        IF(lFirst) THEN
92           ltnat1 = .TRUE.; CALL getin('tnateq1', ltnat1)
93           tnat = tnat_HDO; IF(ltnat1) tnat = 1.0
94           lFirst = .FALSE.
95        END IF
96        iso_verif_aberrant_nostop=0
97
98        ! verifier que HDO est raisonable
99         if (q.gt.qmin) then
100             deltaD=(x/q/tnat-1)*1000
101             if ((deltaD.gt.deltaDmax).or.(deltaD.lt.deltaDmin)) then
102                  write(*,*) 'erreur detectee par iso_verif_aberrant:'
103                  write(*,*) err_msg
104                  write(*,*) 'q=',q
105                  write(*,*) 'deltaD=',deltaD
106                  write(*,*) 'iso=',iso
107                  iso_verif_aberrant_nostop=1
108             endif !if ((deltaD.gt.deltaDmax).or.(deltaD.lt.deltaDmin)) then
109          endif !if (q(i,k,iq).gt.qmin) then
110
111       
112        return
113        end       
114
Note: See TracBrowser for help on using the repository browser.