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

Last change on this file since 4263 was 4050, checked in by dcugnet, 3 years ago

Second commit for new tracers.

  • include most of the keys in the tracers descriptor vector "tracers(:)".
  • fix in phylmdiso/cv3_routines: fq_* variables were used where their fxt_* counterparts were expected.
  • multiple IF(nqdesc(iq)>0) and IF(nqfils(iq)>0) tests suppressed, because they are not needed: "do ... enddo" loops with 0 upper bound are not executed.
  • remove French accents from comments (encoding problem) in phylmdiso/cv3_routines and phylmdiso/cv30_routines.
  • modifications in "isotopes_verif_mod", where the call to function "iso_verif_tag17_q_deltad_chn" in "iso_verif_tag17_q_deltad_chn" was not detected at linking stage, although defined in the same module (?).
File size: 2.8 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)
[4050]66        USE infotrac, ONLY: tnat
[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
76        real deltaDmax,deltaDmin
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
87             deltaD=(x/q/tnat(iso)-1)*1000
88             if ((deltaD.gt.deltaDmax).or.(deltaD.lt.deltaDmin)) then
89                  write(*,*) 'erreur detectee par iso_verif_aberrant:'
90                  write(*,*) err_msg
91                  write(*,*) 'q=',q
92                  write(*,*) 'deltaD=',deltaD
93                  write(*,*) 'iso=',iso
94                  iso_verif_aberrant_nostop=1
95             endif !if ((deltaD.gt.deltaDmax).or.(deltaD.lt.deltaDmin)) then
96          endif !if (q(i,k,iq).gt.qmin) then
97
98       
99        return
100        end       
101
Note: See TracBrowser for help on using the repository browser.