LMDZ
check_isotopes_loc.F
Go to the documentation of this file.
1  subroutine check_isotopes(q,ijb,ije,err_msg)
2  USE infotrac
3  USE parallel_lmdz
4  implicit none
5 
6 #include "dimensions.h"
7 
8  ! inputs
9  integer ijb,ije ! peut être local et différent de ijb_u,ije_u, ex: dans qminimum
10  real q(ijb_u:ije_u,llm,nqtot)
11  character*(*) err_msg ! message d''erreur à afficher
12 
13  ! locals
14  integer ixt,phase,k,i,iq,iiso,izone,ieau,iqeau
15  real xtractot,xiiso
16  real borne
17  real qmin
18  real errmax ! erreur maximale en absolu.
19  real errmaxrel ! erreur maximale en relatif autorisée
20  real deltaDmax,deltaDmin
21  real ridicule
22  parameter(borne=1e19)
23  parameter(errmax=1e-8)
24  parameter(errmaxrel=1e-3)
25  parameter(qmin=1e-11)
26  parameter(deltadmax=200.0,deltadmin=-999.9)
27  parameter(ridicule=1e-12)
28  real deltaD
29 
30  if (ok_isotopes) then
31 
32  !write(*,*) 'check_isotopes 31: err_msg=',err_msg
33  ! verifier que rien n'est NaN
34  do ixt=1,ntraciso
35  do phase=1,nqo
36  iq=iqiso(ixt,phase)
37 c$omp DO schedule(static,omp_chunk)
38  do k=1,llm
39  DO i = ijb,ije
40  if ((q(i,k,iq).gt.-borne).and.
41  : (q(i,k,iq).lt.borne)) then
42  else !if ((x(ixt,i,j).gt.-borne).and.
43  write(*,*) 'erreur detectee par iso_verif_noNaN:'
44  write(*,*) err_msg
45  write(*,*) 'q,i,k,iq=',q(i,k,iq),i,k,iq
46  write(*,*) 'borne=',borne
47  stop
48  endif !if ((x(ixt,i,j).gt.-borne).and.
49  enddo !DO i = ijb,ije
50  enddo !do k=1,llm
51 c$omp END DO nowait
52  enddo !do phase=1,nqo
53  enddo !do ixt=1,ntraciso
54 
55  !write(*,*) 'check_isotopes 52'
56  ! verifier que l'eau normale est OK
57  if (use_iso(1)) then
58  ixt=indnum_fn_num(1)
59  do phase=1,nqo
60  iq=iqiso(ixt,phase)
61 c$omp DO schedule(static,omp_chunk)
62  do k=1,llm
63  DO i = ijb,ije
64  if ((abs(q(i,k,phase)-q(i,k,iq)).gt.errmax).and.
65  : (abs((q(i,k,phase)-q(i,k,iq))/
66  : max(max(abs(q(i,k,phase)),abs(q(i,k,iq))),1e-18))
67  : .gt.errmaxrel)) then
68  write(*,*) 'erreur detectee par iso_verif_egalite:'
69  write(*,*) err_msg
70  write(*,*) 'ixt,phase,ijb=',ixt,phase,ijb
71  write(*,*) 'q,iq,i,k=',q(i,k,iq),iq,i,k
72  write(*,*) 'q(i,k,phase)=',q(i,k,phase)
73  stop
74  endif !if ((abs(q(i,k,phase)-q(i,k,iq)).gt.errmax).and.
75  ! bidouille pour éviter divergence:
76  q(i,k,iq)= q(i,k,phase)
77  enddo ! DO i = ijb,ije
78  enddo !do k=1,llm
79 c$omp END DO nowait
80  enddo ! do phase=1,nqo
81  endif !if (use_iso(1)) then
82 
83  !write(*,*) 'check_isotopes 78'
84  ! verifier que HDO est raisonable
85  if (use_iso(2)) then
86  ixt=indnum_fn_num(2)
87  do phase=1,nqo
88  iq=iqiso(ixt,phase)
89 c$omp DO schedule(static,omp_chunk)
90  do k=1,llm
91  DO i = ijb,ije
92  if (q(i,k,iq).gt.qmin) then
93  deltad=(q(i,k,iq)/q(i,k,phase)/tnat(2)-1)*1000
94  if ((deltad.gt.deltadmax).or.(deltad.lt.deltadmin)) then
95  write(*,*) 'erreur detectee par iso_verif_aberrant:'
96  write(*,*) err_msg
97  write(*,*) 'ixt,phase=',ixt,phase
98  write(*,*) 'q,iq,i,k,=',q(i,k,iq),iq,i,k
99  write(*,*) 'q=',q(i,k,:)
100  write(*,*) 'deltaD=',deltad
101  stop
102  endif !if ((deltaD.gt.deltaDmax).or.(deltaD.lt.deltaDmin)) then
103  endif !if (q(i,k,iq).gt.qmin) then
104  enddo !DO i = ijb,ije
105  enddo !do k=1,llm
106 c$omp END DO nowait
107  enddo ! do phase=1,nqo
108  endif !if (use_iso(2)) then
109 
110  !write(*,*) 'check_isotopes 103'
111  ! verifier que O18 est raisonable
112  if (use_iso(3)) then
113  ixt=indnum_fn_num(3)
114  do phase=1,nqo
115  iq=iqiso(ixt,phase)
116 c$omp DO schedule(static,omp_chunk)
117  do k=1,llm
118  DO i = ijb,ije
119  if (q(i,k,iq).gt.qmin) then
120  deltad=(q(i,k,iq)/q(i,k,phase)/tnat(3)-1)*1000
121  if ((deltad.gt.deltadmax).or.(deltad.lt.deltadmin)) then
122  write(*,*) 'erreur detectee iso_verif_aberrant O18:'
123  write(*,*) err_msg
124  write(*,*) 'ixt,phase=',ixt,phase
125  write(*,*) 'q,iq,i,k,=',q(i,k,phase),iq,i,k
126  write(*,*) 'xt=',q(i,k,:)
127  write(*,*) 'deltaO18=',deltad
128  stop
129  endif !if ((deltaD.gt.deltaDmax).or.(deltaD.lt.deltaDmin)) then
130  endif !if (q(i,k,iq).gt.qmin) then
131  enddo !DO i = ijb,ije
132  enddo !do k=1,llm
133 c$omp END DO nowait
134  enddo ! do phase=1,nqo
135  endif !if (use_iso(2)) then
136 
137 
138  !write(*,*) 'check_isotopes 129'
139  if (ok_isotrac) then
140 
141  if (use_iso(2).and.use_iso(1)) then
142  do izone=1,ntraceurs_zone
143  ixt=index_trac(izone,indnum_fn_num(2))
144  ieau=index_trac(izone,indnum_fn_num(1))
145  do phase=1,nqo
146  iq=iqiso(ixt,phase)
147  iqeau=iqiso(ieau,phase)
148 c$omp DO schedule(static,omp_chunk)
149  do k=1,llm
150  DO i = ijb,ije
151  if (q(i,k,iq).gt.qmin) then
152  deltad=(q(i,k,iq)/q(i,k,iqeau)/tnat(2)-1)*1000
153  if ((deltad.gt.deltadmax).or.
154  & (deltad.lt.deltadmin)) then
155  write(*,*) 'erreur dans iso_verif_aberrant trac:'
156  write(*,*) err_msg
157  write(*,*) 'izone,phase=',izone,phase
158  write(*,*) 'ixt,ieau=',ixt,ieau
159  write(*,*) 'q,iq,i,k,=',q(i,k,iq),iq,i,k
160  write(*,*) 'deltaD=',deltad
161  stop
162  endif !if ((deltaD.gt.deltaDmax).or.
163  endif !if (q(i,k,iq).gt.qmin) then
164  enddo !DO i = ijb,ije
165  enddo ! do k=1,llm
166 c$omp END DO nowait
167  enddo ! do phase=1,nqo
168  enddo !do izone=1,ntraceurs_zone
169  endif !if (use_iso(2).and.use_iso(1)) then
170 
171  do iiso=1,niso
172  do phase=1,nqo
173  iq=iqiso(iiso,phase)
174 c$omp DO schedule(static,omp_chunk)
175  do k=1,llm
176  DO i = ijb,ije
177  xtractot=0.0
178  xiiso=q(i,k,iq)
179  do izone=1,ntraceurs_zone
180  iq=iqiso(index_trac(izone,iiso),phase)
181  xtractot=xtractot+ q(i,k,iq)
182  enddo !do izone=1,ntraceurs_zone
183  if ((abs(xtractot-xiiso).gt.errmax).and.
184  : (abs(xtractot-xiiso)/
185  : max(max(abs(xtractot),abs(xiiso)),1e-18)
186  : .gt.errmaxrel)) then
187  write(*,*) 'erreur detectee par iso_verif_traceurs:'
188  write(*,*) err_msg
189  write(*,*) 'iiso,phase=',iiso,phase
190  write(*,*) 'i,k,=',i,k
191  write(*,*) 'q(i,k,:)=',q(i,k,:)
192  stop
193  endif !if ((abs(q(i,k,phase)-q(i,k,iq)).gt.errmax).and.
194 
195  ! bidouille pour éviter divergence:
196  if (abs(xtractot).gt.ridicule) then
197  do izone=1,ntraceurs_zone
198  ixt=index_trac(izone,iiso)
199  q(i,k,iq)=q(i,k,iq)/xtractot*xiiso
200  enddo !do izone=1,ntraceurs_zone
201  endif !if ((abs(xtractot).gt.ridicule) then
202  enddo !DO i = ijb,ije
203  enddo !do k=1,llm
204 c$omp END DO nowait
205  enddo !do phase=1,nqo
206  enddo !do iiso=1,niso
207 
208  endif !if (ok_isotrac) then
209 
210  endif ! if (ok_isotopes)
211  !write(*,*) 'check_isotopes 198'
212 
213  end
214 
215 
infotrac::ok_isotrac
logical, save ok_isotrac
Definition: infotrac.F90:44
check_isotopes
subroutine check_isotopes(q, ijb, ije, err_msg)
Definition: check_isotopes_loc.F:2
infotrac::ntraceurs_zone
integer, save ntraceurs_zone
Definition: infotrac.F90:56
infotrac::tnat
real, dimension(niso_possibles), save tnat
Definition: infotrac.F90:47
llm
!$Id Turb_fcg_gcssold get_uvd hqturb_gcssold endif!large scale llm day day1 day day1 *dt_toga endif!time annee_ref dt_toga u_toga vq_toga w_prof vq_prof llm day day1 day day1 *dt_dice endif!time annee_ref dt_dice swup_dice vg_dice omega_dice tg_prof vg_profd w_profd omega_profd!do llm!print llm l llm
Definition: 1D_interp_cases.h:103
infotrac::index_trac
integer, dimension(:,:), allocatable, save index_trac
Definition: infotrac.F90:55
infotrac::nqtot
integer, save nqtot
Definition: infotrac.F90:6
infotrac::iqiso
integer, dimension(:,:), allocatable, save iqiso
Definition: infotrac.F90:49
infotrac::nqo
integer, save nqo
Definition: infotrac.F90:8
infotrac::indnum_fn_num
integer, dimension(niso_possibles), save indnum_fn_num
Definition: infotrac.F90:54
parallel_lmdz
Definition: parallel_lmdz.F90:4
parameter
!$Header!integer nvarmx parameter(nfmx=10, imx=200, jmx=150, lmx=200, nvarmx=1000) real xd(imx
infotrac::use_iso
logical, dimension(niso_possibles), save use_iso
Definition: infotrac.F90:48
parallel_lmdz::omp_chunk
integer, save omp_chunk
Definition: parallel_lmdz.F90:46
infotrac::ok_isotopes
logical, save ok_isotopes
Definition: infotrac.F90:44
infotrac::niso
integer, save niso
Definition: infotrac.F90:56
parallel_lmdz::ije_u
integer, save ije_u
Definition: parallel_lmdz.F90:35
infotrac::ntraciso
integer, save ntraciso
Definition: infotrac.F90:56
parallel_lmdz::ijb_u
integer, save ijb_u
Definition: parallel_lmdz.F90:34