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

Last change on this file since 4933 was 4325, checked in by dcugnet, 2 years ago
  • simplify the parser usage:
    • the getKey_init routine is now embedded in the readTracersFile routine.
    • the initIsotopes routine is now embedded in the readIsotopesFile routine.
    • the database is now unique, but can be changed using the get/setKeysDBase.
    • the derived types descriptions, originally located in trac_types_mod, are moved to readTracFiles_mod.
    • few checkings moved from infotrac to the routine testIsotopes, contained in the readIsotopesFile function from readTracFiles_mod.
    • the readTracersFiles and readIsotopesFile routines no longer use a tracers/isotopes argument.
  • remove tnat and alpha_ideal from infotrac ; use instead getKey to get them where they are used (check_isotopes, dynetat0, iniacademic)
  • the trac_type field %Childs is renamed %Children
  • move the isoSelect routine and the corresponding variables routine from infotrac and infotrac_phy to readTracFiles_mod
  • infotrac_phy routine is now fully independant of the (very similar) routine infotrac (init_infotrac_phy has no arguments left).
  • all the explicit keys of the trac_type are now included in the embedded keys database, accessible using the getKey function.
  • the getKey/addKey routines are expanded to handle vectors of integers, reals, logicals or strings.
  • few subroutines converted into functions with error return value.
  • corrections for isotopic tagging tracers mode (to be continued).
File size: 3.0 KB
RevLine 
[2270]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)
[4325]66        USE infotrac, ONLY: isoName, getKey
[2270]67        implicit none
68       
69        ! input:
70        real x,q
71        integer iso ! 2=HDO, 1=O18
72        character*(*) err_msg ! message d''erreur à afficher
73
74        ! locals
75        real qmin,deltaD
[4325]76        real deltaDmax,deltaDmin,tnat
[2270]77        parameter (qmin=1e-11)
78        parameter (deltaDmax=200.0,deltaDmin=-999.9)
79
80        ! output
81        integer iso_verif_aberrant_nostop
82
83        iso_verif_aberrant_nostop=0
84
85        ! verifier que HDO est raisonable
86         if (q.gt.qmin) then
[4325]87             IF(getKey('tnat', tnat, isoName(iso))) THEN
88                  err_msg = 'Missing isotopic parameter "tnat"'
89                  iso_verif_aberrant_nostop=1
90                  RETURN
91             END IF
92             deltaD=(x/q/tnat-1)*1000
[2270]93             if ((deltaD.gt.deltaDmax).or.(deltaD.lt.deltaDmin)) then
94                  write(*,*) 'erreur detectee par iso_verif_aberrant:'
95                  write(*,*) err_msg
96                  write(*,*) 'q=',q
97                  write(*,*) 'deltaD=',deltaD
98                  write(*,*) 'iso=',iso
99                  iso_verif_aberrant_nostop=1
100             endif !if ((deltaD.gt.deltaDmax).or.(deltaD.lt.deltaDmin)) then
101          endif !if (q(i,k,iq).gt.qmin) then
102
103       
104        return
105        end       
106
Note: See TracBrowser for help on using the repository browser.