source: trunk/LMDZ.COMMON/libf/dyn3d_common/iso_verif_dyn.F @ 2757

Last change on this file since 2757 was 1508, checked in by emillour, 9 years ago

Common dynamics:
Updates in the dynamics (seq and ) to keep up with updates
in LMDZ5 (up to LMDZ5 trunk, rev 2325):
IMPORTANT: Modifications for isotopes are only done in dyn3d, not in dyn3dpar

as in LMDZ5 these modifications were done in dyn3dmem.
Related LMDZ5 revisions are r2270 and r2281

  • in dynlonlat_phylonlat:
  • add module "grid_atob_m.F90" (a regridding utility so far only used by phylmd/ce0l.F90, used to be dyn3d_common/grid_atob.F)
  • in misc:
  • follow up updates on wxios.F (add missing_val module variable)
  • in dyn3d_common:
  • pression.F => pression.F90
  • misc_mod.F90: moved from misc to dyn3d_common
  • added new iso_verif_dyn.F
  • covcont.F => covcont.F90
  • infotrac.F90 : add handling of isotopes (reading of corresponding traceur.def for planets not implemented)
  • dynetat0.F => dynetat0.F90 with some code factorization
  • dynredem.F => dynredem.F90 with some code factorization
  • added dynredem_mod.F90: routines used by dynredem
  • iniacademic.F90 : added isotopes-related initialization for Earth case
  • in dyn3d:
  • added check_isotopes.F
  • modified (isotopes) advtrac.F90, caladvtrac.F
  • guide_mod.F90: ported updates
  • leapfrog.F : (isotopes) updates (NB: call integrd with nqtot tracers)
  • qminimium.F : adaptations for isotopes (copied over, except that #include comvert.h is not needed).
  • vlsplt.F: adaptations for isotopes (copied over, except than #include logic.h, comvert.h not needed, and replace "include comconst.h" with use comconst_mod, ONLY: pi)
  • vlspltqs.F : same as vlsplt.F, but also keeping added modification for CP(T)
  • in dyn3dpar:
  • leapfrog_p.F: remove unecessary #ifdef CPP_EARTH cpp flag. and call integrd_p with nqtot tracers (only important for Earth)
  • dynredem_p.F => dynredem_p.F90 and some code factorization
  • and no isotopes-relates changes in dyn3dpar (since these changes have been made in LMDZ5 dyn3dmem).

EM
File size: 2.8 KB
RevLine 
[1508]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        USE infotrac
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.