Context Navigation

isotopes_verif_mod.F90 @ 4050

Last change on this file since 4050 was 4050, checked in by dcugnet, 2 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 (?).

Property svn:executable set to *

File size: 81.8 KB

Line
1
2	#ifdef ISOVERIF
3	! $Id: $
4
5	MODULE isotopes_verif_mod
6	!use isotopes_mod, ONLY:
7	!#ifdef ISOTRAC
8	!use isotrac_mod, ONLY:
9	!#endif
10	implicit none
11	save
12
13	! variables de vérifications
14	real errmax ! erreur maximale en absolu.
15	parameter (errmax=1e-8)
16	real errmax_sol ! erreur maximale en absolu.
17	parameter (errmax_sol=5e-7)
18	real errmaxrel ! erreur maximale en relatif autorisée
19	! parameter (errmaxrel=1e10)
20	parameter (errmaxrel=1e-3)
21	real borne ! valeur maximale que n'importe quelle variable peut
22	! atteindre, en val abs; utile pour vérif que pas NAN
23	parameter (borne=1e19)
24	real, save :: deltalim ! deltalim est le maximum de deltaD qu'on
25	! autorise dans la vapeur, au-dela, en suppose que c'est abérrant.
26	! dans le liquide, on autorise deltalim*faccond.
27	!$OMP THREADPRIVATE(deltalim)
28	! parameter (deltalim=1e10)
29	! parameter (deltalim=300.0)
30	! maintenant défini dans iso.def
31
32	real, save :: deltalimtrac ! max de deltaD dans les traceurs, défini dans iso.def
33	!$OMP THREADPRIVATE(deltalimtrac)
34
35	real, save :: deltalim_snow ! deltalim est le maximum de deltaD qu'on
36	! autorise dans la neige, au-dela, en suppose que c'est abérrant.
37	!$OMP THREADPRIVATE(deltalim_snow)
38	! parameter (deltalim_snow=500.0) ! initalisé dans iso_init
39
40	real, save :: deltaDmin
41	!$OMP THREADPRIVATE(deltaDmin)
42	! parameter (deltaDmin=-900.0)
43	! maintentant, défini dans iso.def
44
45	real, save :: o17excess_bas,o17excess_haut ! bornes inf et sup de l'O17-excess
46	! parameter(o17excess_bas=-200.0,o17excess_haut=120)
47	!$OMP THREADPRIVATE(o17excess_bas,o17excess_haut)
48	integer nlevmaxO17
49	!$OMP THREADPRIVATE(nlevmaxO17)
50
51	logical, save :: O17_verif
52	!$OMP THREADPRIVATE(O17_verif)
53	! parameter (O17_verif=.true.)
54
55	real, save :: dexcess_min,dexcess_max
56	!$OMP THREADPRIVATE(dexcess_min,dexcess_max)
57
58	real faccond ! dans le liquide, on autorise R(deltalim)*faccond.
59	parameter (faccond=1.1)
60
61	! logical bidouille_anti_divergence ! si true, alors on fait un
62	! ! rappel régulier des xt4 vers les q pour
63	! !éviter accumulation d'érreurs et divergences
64	! parameter (bidouille_anti_divergence=.true.)
65	! parameter (bidouille_anti_divergence=.false.)
66	! bidouille_anti_divergence a été déplacé dans wateriso2.h et est lue à l'execution
67
68
69	real deltaDfaible ! deltaD en dessous duquel la vapeur est tellement faible
70	!que on peut accepter que la remise à l'équilibre du sol avec
71	! cette vapeur donne des deltaDevap aberrants.
72	parameter (deltaDfaible=-300)
73	real deltaDfaible_lax ! deltaD en dessous duquel la vapeur est tellement faible
74	!que on peut accepter que la remise à l'équilibre du sol avec
75	! cette vapeur donne des deltaDevap aberrants.
76	parameter (deltaDfaible_lax=-180)
77
78	real faible_evap ! faible évaporation: on est plus laxiste
79	!pour les deltaD aberrant dans le cas de l'évap venant d'orchidee
80	parameter (faible_evap=3.0)
81
82	real Tmin_verif
83	parameter (Tmin_verif=5.0) ! en K
84	real Tmax_verif
85	parameter (Tmax_verif=1000.0) ! en K
86
87
88	! subroutines de vérifications génériques, à ne pas modifier
89
90
91	CONTAINS
92
93	SUBROUTINE iso_verif_init()
94	use ioipsl_getin_p_mod, ONLY : getin_p
95	!USE infotrac_phy, ONLY: use_iso
96	use isotopes_mod, ONLY: iso_O17, iso_O18, iso_HDO
97	implicit none
98
99	write(,) 'iso_verif_init 99: entree'
100	deltalim=300.0
101	deltalim_snow=500.0
102	deltaDmin=-900.0
103	deltalimtrac=2000.0
104	O17_verif=.false.
105	o17excess_bas=-200.0
106	o17excess_haut=120.0
107	dexcess_min=-100.0
108	dexcess_max=1000.0
109
110	call getin_p('deltalim',deltalim)
111	deltalim_snow=deltalim+200.0
112	call getin_p('deltaDmin',deltaDmin)
113	call getin_p('deltalimtrac',deltalimtrac)
114
115	write(,) 'iso_O17,iso_O18,iso_HDO=',iso_O17,iso_O18,iso_HDO
116	if ((iso_O17.gt.0).and.(iso_O18.gt.0)) then
117	call getin_p('O17_verif',O17_verif)
118	call getin_p('o17excess_bas',o17excess_bas)
119	call getin_p('o17excess_haut',o17excess_haut)
120	call getin_p('nlevmaxO17',nlevmaxO17)
121	endif
122	if ((iso_HDO.gt.0).and.(iso_O18.gt.0)) then
123	call getin_p('dexcess_min',dexcess_min)
124	call getin_p('dexcess_max',dexcess_max)
125	endif
126
127	write(,) 'deltalim=',deltalim
128	write(,) 'deltaDmin=',deltaDmin
129	write(,) 'deltalimtrac=',deltalimtrac
130	write(,) 'O17_verif=',O17_verif
131	write(,) 'o17excess_bas=',o17excess_bas
132	write(,) 'o17excess_haut=',o17excess_haut
133	write(,) 'dexcess_min=',dexcess_min
134	write(,) 'dexcess_max=',dexcess_max
135
136	end SUBROUTINE iso_verif_init
137
138	subroutine iso_verif_egalite(a,b,err_msg)
139	implicit none
140	! compare a et b. Si pas egal à errmax près, on affiche message
141	! d'erreur et stoppe
142
143	! input:
144	real a, b
145	character() err_msg ! message d''erreur à afficher
146
147	! local
148	!integer iso_verif_egalite_choix_nostop
149
150
151	if (iso_verif_egalite_choix_nostop(a,b,err_msg, &
152	& errmax,errmaxrel).eq.1) then
153	stop
154	endif
155
156	#ifdef ISOVERIF
157	#else
158	write(,) 'err_msg=',err_msg,': pourquoi verif?'
159	stop
160	#endif
161
162	return
163	end subroutine iso_verif_egalite
164
165	!*****************
166
167	function iso_verif_egalite_nostop(a,b,err_msg)
168	implicit none
169	! compare a et b. Si pas egal à errmax près, on affiche message
170	! d'erreur et stoppe
171
172	! input:
173	real a, b
174	character() err_msg ! message d''erreur à afficher
175	!ouptut
176	integer iso_verif_egalite_nostop
177	! local
178	!integer iso_verif_egalite_choix_nostop
179
180
181	iso_verif_egalite_nostop=iso_verif_egalite_choix_nostop &
182	& (a,b,err_msg,errmax,errmaxrel)
183
184	#ifdef ISOVERIF
185	#else
186	write(,) 'err_msg=',err_msg,': pourquoi verif?'
187	stop
188	#endif
189
190	return
191	end function iso_verif_egalite_nostop
192
193
194
195	!************************************
196
197	subroutine iso_verif_aberrant(R,err_msg)
198	!USE infotrac_phy, ONLY: use_iso
199	use isotopes_mod, ONLY: ridicule, iso_HDO
200	implicit none
201	! si le rapprot iso R est plus grand que deltaDlim, on affiche message
202	! d'erreur et stoppe
203
204	! input:
205	real R
206	character() err_msg ! message d''erreur à afficher
207	!real deltaD
208	!integer iso_verif_aberrant_choix_nostop
209
210
211	if (iso_verif_aberrant_choix_nostop(R,1.0,ridicule, &
212	& deltalim,err_msg).eq.1) then
213	stop
214	endif
215
216	#ifdef ISOVERIF
217	if (.not.(iso_HDO.gt.0)) then
218	write(,) 'iso86: err_msg=',err_msg,': pourquoi verif?'
219	stop
220	endif
221	#else
222	write(,) 'iso 90: err_msg=',err_msg,': pourquoi verif?'
223	stop
224	#endif
225
226	end subroutine iso_verif_aberrant
227
228	subroutine iso_verif_aberrant_encadre(R,err_msg)
229	!use infotrac_phy, ONLY: use_iso
230	use isotopes_mod, ONLY: ridicule, iso_HDO
231	implicit none
232	! si le rapprot iso R est plus grand que deltaDlim, on affiche message
233	! d'erreur et stoppe
234
235	! input:
236	real R
237	character() err_msg ! message d''erreur à afficher
238	!real deltaD
239
240	!integer iso_verif_aberrant_enc_choix_nostop
241
242
243	if (iso_verif_aberrant_enc_choix_nostop(R,1.0,ridicule, &
244	& deltalim,err_msg).eq.1) then
245	write(,) 'deltaD=',deltaD(R)
246	call abort_physic('isotopes_verif_mod > iso_verif_aberrant_encadre',err_msg,1)
247	!stop
248	endif
249
250	#ifdef ISOVERIF
251	if (.not.(iso_HDO.gt.0)) then
252	write(,) 'iso86: err_msg=',err_msg,': pourquoi verif?'
253	stop
254	endif
255	#else
256	write(,) 'iso 90: err_msg=',err_msg,': pourquoi verif?'
257	stop
258	#endif
259
260	end subroutine iso_verif_aberrant_encadre
261
262	!************************************
263
264	subroutine iso_verif_aberrant_choix(xt,q,qmin,deltaDmax,err_msg)
265	!use infotrac_phy, ONLY: use_iso
266	use isotopes_mod, ONLY: iso_HDO
267	implicit none
268	! si le rapprot iso R est plus grand que deltaDlim, on affiche message
269	! d'erreur et stoppe
270
271	! input:
272	real xt,q,qmin,deltaDmax
273	character() err_msg ! message d''erreur à afficher
274	!real deltaD
275
276	! locals
277	!integer iso_verif_aberrant_choix_nostop
278
279
280	if (iso_verif_aberrant_choix_nostop(xt,q,qmin, &
281	& deltaDmax,err_msg).eq.1) then
282	stop
283	endif
284
285	#ifdef ISOVERIF
286	if (.not.(iso_HDO.gt.0)) then
287	write(,) 'iso122: err_msg=',err_msg,': pourquoi verif?'
288	stop
289	endif
290	#else
291	write(,) 'iso126: err_msg=',err_msg,': pourquoi verif?'
292	stop
293	#endif
294
295	end subroutine iso_verif_aberrant_choix
296
297	!************************************
298
299	function iso_verif_aberrant_nostop(R,err_msg)
300	!use infotrac_phy, ONLY: use_iso
301	use isotopes_mod, ONLY: ridicule,iso_HDO
302	implicit none
303	! si le rapprot iso R est plus grand que deltaDlim, on affiche message
304	! d'erreur et stoppe
305
306	! input:
307	real R
308	character() err_msg ! message d''erreur à afficher
309	integer iso_verif_aberrant_nostop ! output: 1 si erreur, 0 sinon
310	!real deltaD
311
312	! locals
313	!integer iso_verif_aberrant_choix_nostop
314
315	iso_verif_aberrant_nostop=iso_verif_aberrant_choix_nostop &
316	& (R,1.0,ridicule,deltalim,err_msg)
317
318	#ifdef ISOVERIF
319	if (.not.(iso_HDO.gt.0)) then
320	write(,) 'iso156: err_msg=',err_msg,': pourquoi verif?'
321	stop
322	endif
323	#else
324	write(,) 'iso160: err_msg=',err_msg,': pourquoi verif?'
325	stop
326	#endif
327
328	return
329	end function iso_verif_aberrant_nostop
330
331	function iso_verif_aberrant_enc_nostop(R,err_msg)
332	!use infotrac_phy, ONLY: use_iso
333	use isotopes_mod, ONLY: ridicule,iso_HDO
334	implicit none
335	! si le rapprot iso R est plus grand que deltaDlim, on affiche message
336	! d'erreur et stoppe
337
338	! input:
339	real R
340	character() err_msg ! message d''erreur à afficher
341	integer iso_verif_aberrant_enc_nostop ! output: 1 si erreur, 0 sinon
342	!real deltaD
343
344	! locals
345	!integer iso_verif_aberrant_enc_choix_nostop
346
347	iso_verif_aberrant_enc_nostop= &
348	& iso_verif_aberrant_enc_choix_nostop &
349	& (R,1.0,ridicule,deltalim,err_msg)
350
351	#ifdef ISOVERIF
352	if (.not.(iso_HDO.gt.0)) then
353	write(,) 'iso156: err_msg=',err_msg,': pourquoi verif?'
354	stop
355	endif
356	#else
357	write(,) 'iso160: err_msg=',err_msg,': pourquoi verif?'
358	stop
359	#endif
360	return
361	end function iso_verif_aberrant_enc_nostop
362
363	!************************************
364
365	function iso_verif_aberrant_choix_nostop(xt,q, &
366	& qmin,deltaDmax,err_msg)
367
368	!use infotrac_phy, ONLY: use_iso
369	use isotopes_mod, ONLY: iso_HDO
370	implicit none
371	! si le rapprot iso R est plus grand que deltaDlim, on affiche message
372	! d'erreur et stoppe
373
374	! input:
375	real xt,q,qmin,deltaDmax
376	character() err_msg ! message d''erreur à afficher
377	! output
378	integer iso_verif_aberrant_choix_nostop
379	! locals
380	!real deltaD
381	!integer iso_verif_noNaN_nostop
382
383
384	iso_verif_aberrant_choix_nostop=0
385
386	#ifdef ISOVERIF
387	if (iso_verif_noNaN_nostop(q,err_msg).eq.1) then
388	write(,) 'q=',q
389	iso_verif_aberrant_choix_nostop=1
390	endif
391	if (iso_verif_noNaN_nostop(xt,err_msg).eq.1) then
392	write(,) 'xt=',xt
393	iso_verif_aberrant_choix_nostop=1
394	endif
395	#endif
396
397	if (q.gt.qmin) then
398	if ((deltaD(xt/q).gt.deltaDmax).or. &
399	& (deltaD(xt/q).lt.-borne).or. &
400	& (xt.lt.-borne).or. &
401	& (xt.gt.borne)) then
402	write(,) 'erreur detectee par '// &
403	& 'iso_verif_aberrant_choix_nostop:'
404	write(,) err_msg
405	write(,) 'q,deltaD=',q,deltaD(xt/q)
406	write(,) 'deltaDmax=',deltaDmax
407	iso_verif_aberrant_choix_nostop=1
408	if (abs(xt-q)/q.lt.errmax) then
409	write(,) 'attention, n''a-t-on pas confondu'// &
410	& ' iso_HDO et iso_eau dans l''appel à la verif?'
411	endif
412	endif
413	endif
414
415	#ifdef ISOVERIF
416	if (.not.(iso_HDO.gt.0)) then
417	write(,) 'iso205: err_msg=',err_msg,': pourquoi verif?'
418	stop
419	endif
420	#else
421	write(,) 'iso 209: err_msg=',err_msg,': pourquoi verif?'
422	stop
423	#endif
424
425	return
426	end function iso_verif_aberrant_choix_nostop
427
428	function iso_verif_aberrant_enc_choix_nostop(xt,q, &
429	& qmin,deltaDmax,err_msg)
430	!use infotrac_phy, ONLY: use_iso
431	use isotopes_mod, ONLY: iso_HDO
432	implicit none
433	! si le rapprot iso R est plus grand que deltaDlim, on affiche message
434	! d'erreur et stoppe
435
436	! input:
437	real xt,q,qmin,deltaDmax
438	character() err_msg ! message d''erreur à afficher
439	! output
440	integer iso_verif_aberrant_enc_choix_nostop
441	! locals
442	!real deltaD
443
444	iso_verif_aberrant_enc_choix_nostop=0
445	if (q.gt.qmin) then
446	if ((deltaD(xt/q).gt.deltaDmax).or. &
447	& (deltaD(xt/q).lt.deltaDmin)) then
448	write(,) 'erreur detectee par '// &
449	& 'iso_verif_aberrant_choix_nostop:'
450	write(,) err_msg
451	write(,) 'q,deltaD=',q,deltaD(xt/q)
452	iso_verif_aberrant_enc_choix_nostop=1
453	if (abs(xt-q)/q.lt.errmax) then
454	write(,) 'attention, n''a-t-on pas confondu'// &
455	& ' iso_HDO et iso_eau dans l''appel à la verif?'
456	endif
457	endif
458	endif
459
460	#ifdef ISOVERIF
461	if (.not.(iso_HDO.gt.0)) then
462	write(,) 'iso205: err_msg=',err_msg,': pourquoi verif?'
463	stop
464	endif
465	#else
466	write(,) 'iso 209: err_msg=',err_msg,': pourquoi verif?'
467	stop
468	#endif
469
470	return
471	end function iso_verif_aberrant_enc_choix_nostop
472
473	!*******************
474
475	subroutine iso_verif_aberrant_o17(R17,R18,err_msg)
476	implicit none
477	! si l'O17-excess est aberrant, on affiche un message
478	! d'erreur et stoppe
479
480	! input:
481	real R17,R18
482	character() err_msg ! message d''erreur à afficher
483	!real o17excess
484
485	! locals
486	!integer iso_verif_aberrant_o17_nostop
487
488	! write(,) 'O17_verif=',O17_verif
489	if (O17_verif) then
490	if (iso_verif_aberrant_o17_nostop(R17,R18,err_msg) &
491	& .eq.1) then
492	stop
493	endif
494	endif !if (O17_verif) then
495
496	#ifdef ISOVERIF
497	#else
498	write(,) 'err_msg=',err_msg,': pourquoi verif?'
499	stop
500	#endif
501
502	return
503	end subroutine iso_verif_aberrant_o17
504
505	!*******************
506
507	function iso_verif_aberrant_o17_nostop(R17,R18,err_msg)
508	USE isotopes_mod, ONLY: tnat,iso_O17,iso_O18
509	implicit none
510	! si l'O17-excess est aberrant, on affiche un message
511	! d'erreur et renvoit 1
512
513	! input:
514	real R17,R18
515	character() err_msg ! message d''erreur à afficher
516	!local
517	!real o17excess
518	! output
519	integer iso_verif_aberrant_o17_nostop
520
521	if (O17_verif) then
522
523	iso_verif_aberrant_o17_nostop=0
524	if ((o17excess(R17,R18).gt.o17excess_haut).or. &
525	& (o17excess(R17,R18).lt.o17excess_bas)) then
526	write(,) 'erreur detectee par iso_verif_aberrant_O17:'
527	write(,) err_msg
528	write(,) 'o17excess=',o17excess(R17,R18)
529	write(,) 'deltaO17=',(R17/tnat(iso_o17)-1.0)*1000.0
530	write(,) 'deltaO18=',(R18/tnat(iso_O18)-1.0)*1000.0
531	! attention, vérifier que la ligne suivante est bien activée
532	iso_verif_aberrant_o17_nostop=1
533	endif
534
535	endif !if (O17_verif) then
536
537	#ifdef ISOVERIF
538	#else
539	write(,) 'err_msg=',err_msg,': pourquoi verif?'
540	stop
541	#endif
542
543	return
544	end function iso_verif_aberrant_o17_nostop
545
546
547	!************************************
548
549	subroutine iso_verif_noNaN(x,err_msg)
550	implicit none
551	! si x est NaN, on affiche message
552	! d'erreur et stoppe
553
554	! input:
555	real x
556	character() err_msg ! message d''erreur à afficher
557
558	! locals
559	!integer iso_verif_noNAN_nostop
560
561	if (iso_verif_noNAN_nostop(x,err_msg).eq.1) then
562	stop
563	endif
564	#ifdef ISOVERIF
565	#else
566	write(,) 'err_msg iso443=',err_msg,': pourquoi verif?'
567	stop
568	#endif
569
570	end subroutine iso_verif_noNaN
571
572	!************************************
573
574	function iso_verif_noNaN_nostop(x,err_msg)
575	implicit none
576	! si x est NaN, on affiche message
577	! d'erreur et return 1 si erreur
578
579	! input:
580	real x
581	character() err_msg ! message d''erreur à afficher
582
583	! output
584	integer iso_verif_noNAN_nostop
585
586	if ((x.gt.-borne).and.(x.lt.borne)) then
587	iso_verif_noNAN_nostop=0
588	else
589	write(,) 'erreur detectee par iso_verif_nonNAN:'
590	write(,) err_msg
591	write(,) 'x=',x
592	iso_verif_noNAN_nostop=1
593	endif
594
595	#ifdef ISOVERIF
596	#else
597	write(,) 'err_msg iso 482=',err_msg,': pourquoi verif?'
598	stop
599	#endif
600
601	return
602	end function iso_verif_noNaN_nostop
603
604	subroutine iso_verif_noNaN_vect2D(x,err_msg,ni,n,m)
605	implicit none
606	! si x est NaN, on affiche message
607	! d'erreur et return 1 si erreur
608
609	! input:
610	integer n,m,ni
611	real x(ni,n,m)
612	character() err_msg ! message d''erreur à afficher
613
614	! output
615
616	! locals
617	integer i,j,ixt
618
619	do i=1,n
620	do j=1,m
621	do ixt=1,ni
622	if ((x(ixt,i,j).gt.-borne).and. &
623	& (x(ixt,i,j).lt.borne)) then
624	else !if ((x(ixt,i,j).gt.-borne).and.
625	write(,) 'erreur detectee par iso_verif_nonNAN:'
626	write(,) err_msg
627	write(,) 'x,ixt,i,j=',x(ixt,i,j),ixt,i,j
628	stop
629	endif !if ((x(ixt,i,j).gt.-borne).and.
630	enddo !do ixt=1,ni
631	enddo !do j=1,m
632	enddo !do i=1,n
633
634	#ifdef ISOVERIF
635	#else
636	write(,) 'err_msg iso525=',err_msg,': pourquoi verif?'
637	stop
638	#endif
639
640	end subroutine iso_verif_noNaN_vect2D
641
642
643	subroutine iso_verif_noNaN_vect1D(x,err_msg,ni,n)
644	implicit none
645	! si x est NaN, on affiche message
646	! d'erreur et return 1 si erreur
647
648	! input:
649	integer n,ni
650	real x(ni,n)
651	character() err_msg ! message d''erreur à afficher
652
653	! output
654
655	! locals
656	integer i,ixt
657
658	do i=1,n
659	do ixt=1,ni
660	if ((x(ixt,i).gt.-borne).and. &
661	& (x(ixt,i).lt.borne)) then
662	else !if ((x(ixt,i,j).gt.-borne).and.
663	write(,) 'erreur detectee par iso_verif_nonNAN:'
664	write(,) err_msg
665	write(,) 'x,ixt,i=',x(ixt,i),ixt,i
666	stop
667	endif !if ((x(ixt,i,j).gt.-borne).and.
668	enddo !do ixt=1,ni
669	enddo !do i=1,n
670
671	#ifdef ISOVERIF
672	#else
673	write(,) 'err_msg iso525=',err_msg,': pourquoi verif?'
674	stop
675	#endif
676
677	end subroutine iso_verif_noNaN_vect1D
678
679
680
681	!************************
682	subroutine iso_verif_egalite_choix(a,b,err_msg,erabs,errel)
683	implicit none
684	! compare a et b. Si pas egal, on affiche message
685	! d'erreur et stoppe
686	! pour egalite, on verifie erreur absolue et arreur relative
687
688	! input:
689	real a, b
690	real erabs,errel !erreur absolue et relative
691	character() err_msg ! message d''erreur à afficher
692
693	! locals
694	!integer iso_verif_egalite_choix_nostop
695
696	if (iso_verif_egalite_choix_nostop( &
697	& a,b,err_msg,erabs,errel).eq.1) then
698	stop
699	endif
700
701	#ifdef ISOVERIF
702	#else
703	write(,) 'err_msg=',err_msg,': pourquoi verif?'
704	stop
705	#endif
706
707	end subroutine iso_verif_egalite_choix
708
709	!************************
710	function iso_verif_egalite_choix_nostop &
711	& (a,b,err_msg,erabs,errel)
712	implicit none
713	! compare a et b. Si pas egal, on affiche message
714	! d'erreur et stoppe
715	! pour egalite, on verifie erreur absolue et arreur relative
716
717	! input:
718	real a, b
719	real erabs,errel !erreur absolue et relative
720	character() err_msg ! message d''erreur à afficher
721
722	! output
723	integer iso_verif_egalite_choix_nostop
724	! locals
725	!integer iso_verif_noNaN_nostop
726
727	iso_verif_egalite_choix_nostop=0
728
729	#ifdef ISOVERIF
730	if (iso_verif_noNaN_nostop(a,err_msg).eq.1) then
731	write(,) 'a=',a
732	iso_verif_egalite_choix_nostop=1
733	endif
734	if (iso_verif_noNaN_nostop(b,err_msg).eq.1) then
735	write(,) 'b=',b
736	iso_verif_egalite_choix_nostop=1
737	endif
738	#endif
739
740	if (abs(a-b).gt.erabs) then
741	if (abs((a-b)/max(max(abs(b),abs(a)),1e-18)) &
742	& .gt.errel) then
743	write(,) 'erreur detectee par iso_verif_egalite:'
744	write(,) err_msg
745	write(,) 'a=',a
746	write(,) 'b=',b
747	write(,) 'erabs,errel=',erabs,errel
748	iso_verif_egalite_choix_nostop=1
749	! stop
750	endif
751	endif
752
753	#ifdef ISOVERIF
754	#else
755	write(,) 'err_msg=',err_msg,': pourquoi verif?'
756	stop
757	#endif
758
759	return
760	end function iso_verif_egalite_choix_nostop
761
762
763
764	!******************
765	subroutine iso_verif_positif(x,err_msg)
766	use isotopes_mod, ONLY: ridicule
767	implicit none
768	! si x<0, on plante.
769	! si très limite, on le met à 0.
770
771	! input:
772	real x
773	character() err_msg ! message d''erreur à afficher
774
775	! locals
776	!integer iso_verif_positif_choix_nostop
777
778	if (iso_verif_positif_choix_nostop(x,ridicule,err_msg) &
779	& .eq.1) then
780	stop
781	endif
782
783	#ifdef ISOVERIF
784	#else
785	write(,) 'iso_verif 637: err_msg=',err_msg, &
786	& ': pourquoi verif?'
787	stop
788	#endif
789
790	end subroutine iso_verif_positif
791
792	!******************
793	subroutine iso_verif_positif_vect(x,n,err_msg)
794	use isotopes_mod, ONLY: ridicule
795	implicit none
796	! si x<0, on plante.
797
798	! input:
799	integer n
800	real x(n)
801	character() err_msg ! message d''erreur à afficher
802
803	! locals
804	integer i
805	integer iso_verif_positif_nostop
806	integer ifaux
807
808	iso_verif_positif_nostop=0
809	do i=1,n
810	if (x(i).lt.-ridicule) then
811	iso_verif_positif_nostop=1
812	ifaux=i
813	endif
814	enddo
815	if (iso_verif_positif_nostop.eq.1) then
816	write(,) 'erreur detectee par iso_verif_positif_vect:'
817	write(,) err_msg
818	write(,) 'i,x=',ifaux,x(ifaux)
819	stop
820	endif
821
822	end subroutine iso_verif_positif_vect
823
824	subroutine iso_verif_positif_choix_vect(x,n,ridic,err_msg)
825	implicit none
826	! si x<0, on plante.
827
828	! input:
829	integer n
830	real x(n)
831	real ridic
832	character() err_msg ! message d''erreur à afficher
833	! locals
834	integer i
835	integer iso_verif_positif_nostop
836	integer ifaux
837
838	iso_verif_positif_nostop=0
839	do i=1,n
840	if (x(i).lt.-ridic) then
841	iso_verif_positif_nostop=1
842	ifaux=i
843	endif
844	enddo
845	if (iso_verif_positif_nostop.eq.1) then
846	write(,) 'erreur detectee par iso_verif_positif_choix_vect:'
847	write(,) err_msg
848	write(,) 'i,x=',ifaux,x(ifaux)
849	stop
850	endif
851
852	end subroutine iso_verif_positif_choix_vect
853
854
855	!******************
856	subroutine iso_verif_positif_strict(x,err_msg)
857	implicit none
858	! si x<0, on plante.
859	! si très limite, on le met à 0.
860
861	! input:
862	real x
863	character() err_msg ! message d''erreur à afficher
864
865	! locals
866	!integer iso_verif_positif_strict_nostop
867
868	if (iso_verif_positif_strict_nostop(x,err_msg) &
869	& .eq.1) then
870	stop
871	endif
872
873	end subroutine iso_verif_positif_strict
874
875	!******************
876
877	function iso_verif_positif_strict_nostop(x,err_msg)
878	implicit none
879	! si x<0, on plante.
880	! si très limite, on le met à 0.
881
882	! input:
883	real x
884	character() err_msg ! message d''erreur à afficher*
885
886	! output
887	integer iso_verif_positif_strict_nostop
888
889	if (x.gt.0.0) then
890	iso_verif_positif_strict_nostop=0
891	else
892	write(,) 'erreur detectee par iso_verif_positif_strict:'
893	write(,) err_msg
894	write(,) 'x=',x
895	iso_verif_positif_strict_nostop=1
896	! stop
897	endif
898
899	return
900	end function iso_verif_positif_strict_nostop
901
902	!******************
903
904	subroutine iso_verif_positif_choix(x,ridic,err_msg)
905	implicit none
906	! si x<0, on plante.
907	! si très limite, on le met à 0.
908
909	! input:
910	real x
911	real ridic
912	character() err_msg ! message d''erreur à afficher
913
914	! locals
915	!integer iso_verif_positif_choix_nostop
916
917	if (iso_verif_positif_choix_nostop(x,ridic,err_msg) &
918	& .eq.1) then
919	stop
920	endif
921
922	#ifdef ISOVERIF
923	#else
924	write(,) 'iso_verif 801: err_msg=',err_msg, &
925	& ': pourquoi verif?'
926	stop
927	#endif
928
929	end subroutine iso_verif_positif_choix
930
931	!******************
932	function iso_verif_positif_nostop(x,err_msg)
933	use isotopes_mod, ONLY: ridicule
934	implicit none
935	! si x<0, on plante.
936	! si très limite, on le met à 0.
937
938	! input:
939	real x
940	character() err_msg ! message d''erreur à afficher
941
942	! output
943	integer iso_verif_positif_nostop
944
945	! locals
946	!integer iso_verif_positif_choix_nostop
947
948	iso_verif_positif_nostop=iso_verif_positif_choix_nostop &
949	& (x,ridicule,err_msg)
950
951	#ifdef ISOVERIF
952	#else
953	write(,) 'iso_verif 837: err_msg=',err_msg, &
954	& ': pourquoi verif?'
955	stop
956
957	#endif
958
959	return
960	end function iso_verif_positif_nostop
961
962	!******************
963	function iso_verif_positif_choix_nostop(x,ridic,err_msg)
964	implicit none
965	! si x<0, on plante.
966	! si très limite, on le met à 0.
967
968	! input:
969	real x
970	real ridic
971	character() err_msg ! message d''erreur à afficher
972
973	! output
974	integer iso_verif_positif_choix_nostop
975
976	if (x.lt.-ridic) then
977	write(,) 'erreur detectee par iso_verif_positif_nostop:'
978	write(,) err_msg
979	write(,) 'x=',x
980	iso_verif_positif_choix_nostop=1
981	else
982	! x=max(x,0.0)
983	iso_verif_positif_choix_nostop=0
984	endif
985
986	#ifdef ISOVERIF
987	#else
988	write(,) 'iso_verif 877: err_msg=',err_msg, &
989	& ': pourquoi verif?'
990	stop
991	#endif
992
993	return
994	end function iso_verif_positif_choix_nostop
995
996
997	!**************
998
999
1000	subroutine iso_verif_O18_aberrant(Rd,Ro,err_msg)
1001	implicit none
1002
1003	! vérifie que:
1004	! 1) deltaD et deltaO18 dans bonne gamme
1005	! 2) dexcess dans bonne gamme
1006	! input:
1007	real Rd,Ro
1008	character() err_msg ! message d''erreur à afficher
1009
1010	! local
1011	!integer iso_verif_O18_aberrant_nostop
1012
1013	if (iso_verif_O18_aberrant_nostop(Rd,Ro,err_msg).eq.1) then
1014	stop
1015	endif
1016
1017	end subroutine iso_verif_O18_aberrant
1018
1019	function iso_verif_O18_aberrant_nostop(Rd,Ro,err_msg)
1020	USE isotopes_mod, ONLY: tnat, iso_HDO, iso_O18
1021	implicit none
1022
1023	! vérifie que:
1024	! 1) deltaD et deltaO18 dans bonne gamme
1025	! 2) dexcess dans bonne gamme
1026
1027	! input:
1028	real Rd,Ro
1029	character() err_msg ! message d''erreur à afficher
1030
1031	! outputs
1032	integer iso_verif_O18_aberrant_nostop
1033
1034	!locals
1035	real deltaD,deltao,dexcess
1036
1037	deltaD=(Rd/tnat(iso_hdo)-1)*1000
1038	deltao=(Ro/tnat(iso_O18)-1)*1000
1039	dexcess=deltaD-8*deltao
1040
1041	iso_verif_O18_aberrant_nostop=0
1042	if ((deltaD.lt.deltaDmin).or.(deltao.lt.deltaDmin/2.0).or. &
1043	& (deltaD.gt.deltalim).or.(deltao.gt.deltalim/8.0).or. &
1044	& ((deltaD.gt.-500.0).and.((dexcess.lt.dexcess_min) &
1045	& .or.(dexcess.gt.dexcess_max)))) then
1046	write(,) 'erreur detectee par iso_verif_O18_aberrant:'
1047	write(,) err_msg
1048	write(,) 'delta180=',deltao
1049	write(,) 'deltaD=',deltaD
1050	write(,) 'Dexcess=',dexcess
1051	! stop
1052	iso_verif_O18_aberrant_nostop=1
1053	endif
1054
1055	#ifdef ISOVERIF
1056	#else
1057	write(,) 'err_msg=',err_msg,': pourquoi verif?'
1058	stop
1059	#endif
1060
1061	return
1062	end function iso_verif_O18_aberrant_nostop
1063
1064
1065	! **********
1066	function deltaD(R)
1067	!use infotrac_phy, ONLY: use_iso
1068	USE isotopes_mod, ONLY: tnat,iso_HDO
1069	implicit none
1070	real R,deltaD
1071
1072
1073	if (iso_HDO.gt.0) then
1074	deltaD=(R/tnat(iso_HDO)-1)*1000.0
1075	else
1076	write(,) 'iso_verif_egalite>deltaD 260: iso_HDO.gt.0=', &
1077	& iso_HDO.gt.0
1078	endif
1079	return
1080	end function deltaD
1081
1082	! **********
1083	function deltaO(R)
1084	!use infotrac_phy, ONLY: use_iso
1085	USE isotopes_mod, ONLY: tnat,iso_O18
1086	implicit none
1087	real R,deltaO
1088
1089	if (iso_O18.gt.0) then
1090	deltaO=(R/tnat(iso_O18)-1)*1000.0
1091	else
1092	write(,) 'iso_verif_egalite>deltaO18 260: iso_O18.gt.0=', &
1093	& iso_O18.gt.0
1094	endif
1095	return
1096	end function deltaO
1097
1098	! **********
1099	function dexcess(RD,RO)
1100	!use infotrac_phy, ONLY: use_iso
1101	USE isotopes_mod, ONLY: tnat,iso_O18,iso_HDO
1102	implicit none
1103	real RD,RO,deltaD,deltaO,dexcess
1104
1105	if ((iso_O18.gt.0).and.(iso_HDO.gt.0)) then
1106	deltaD=(RD/tnat(iso_HDO)-1)*1000.0
1107	deltaO=(RO/tnat(iso_O18)-1)*1000.0
1108	dexcess=deltaD-8*deltaO
1109	else
1110	write(,) 'iso_verif_egalite 1109: iso_O18,iso_HDO=',iso_O18,iso_HDO
1111	endif
1112	return
1113	end function dexcess
1114
1115
1116	! **********
1117	function delta_all(R,ixt)
1118	USE isotopes_mod, ONLY: tnat
1119	implicit none
1120	real R,delta_all
1121	integer ixt
1122
1123	delta_all=(R/tnat(ixt)-1)*1000.0
1124	return
1125	end function delta_all
1126
1127	! **********
1128	function delta_to_R(delta,ixt)
1129	USE isotopes_mod, ONLY: tnat
1130	implicit none
1131	real delta,delta_to_R
1132	integer ixt
1133
1134	delta_to_R=(delta/1000.0+1.0)*tnat(ixt)
1135	return
1136	end function delta_to_R
1137
1138	! **********
1139	function o17excess(R17,R18)
1140	!use infotrac_phy, ONLY: use_iso
1141	USE isotopes_mod, ONLY: tnat,iso_O18,iso_O17
1142	implicit none
1143	real R17,R18,o17excess
1144
1145	if ((iso_O17.gt.0).and.(iso_O18.gt.0)) then
1146
1147	o17excess=1e6*(log(R17/tnat(iso_o17)) &
1148	& -0.528*log(R18/tnat(iso_O18)))
1149	! write(,) 'o17excess=',o17excess
1150	else
1151	write(,) 'iso_verif_egalite>deltaD 260: iso_O17.gt.0,18=', &
1152	& iso_O17.gt.0,iso_O18.gt.0
1153	endif
1154	return
1155	end function o17excess
1156
1157	! ****************
1158
1159	subroutine iso_verif_egalite_vect2D( &
1160	& xt,q,err_msg,ni,n,m)
1161
1162	!use infotrac_phy, ONLY: use_iso
1163	USE isotopes_mod, ONLY: iso_eau
1164	implicit none
1165
1166	! inputs
1167	integer n,m,ni
1168	real q(n,m)
1169	real xt(ni,n,m)
1170	character() err_msg
1171
1172	! locals
1173	integer iso_verif_egalite_nostop_loc
1174	integer i,j,ixt
1175	integer ifaux,jfaux
1176
1177	!write(,) 'iso_verif_egalite_vect2D 1099 tmp: q(2,1),xt(iso_eau,2,1)=',q(2,1),xt(iso_eau,2,1)
1178	!write(,) 'ni,n,m=',ni,n,m,errmax,errmaxrel
1179	if (iso_eau.gt.0) then
1180	iso_verif_egalite_nostop_loc=0
1181	do i=1,n
1182	do j=1,m
1183	if (abs(q(i,j)-xt(iso_eau,i,j)).gt.errmax) then
1184	if (abs((q(i,j)-xt(iso_eau,i,j))/ &
1185	& max(max(abs(q(i,j)),abs(xt(iso_eau,i,j))),1e-18)) &
1186	& .gt.errmaxrel) then
1187	iso_verif_egalite_nostop_loc=1
1188	ifaux=i
1189	jfaux=j
1190	endif
1191	endif
1192	enddo !do j=1,m
1193	enddo !do i=1,n
1194
1195	if (iso_verif_egalite_nostop_loc.eq.1) then
1196	write(,) 'erreur detectee par iso_verif_egalite_vect2D:'
1197	write(,) err_msg
1198	write(,) 'i,j=',ifaux,jfaux
1199	write(,) 'xt,q=',xt(iso_eau,ifaux,jfaux),q(ifaux,jfaux)
1200	stop
1201	endif
1202	endif
1203
1204	#ifdef ISOVERIF
1205	call iso_verif_noNaN_vect2D(xt,err_msg,ni,n,m)
1206	#endif
1207
1208	return
1209	end subroutine iso_verif_egalite_vect2D
1210
1211	subroutine iso_verif_egalite_vect1D( &
1212	& xt,q,err_msg,ni,n)
1213
1214	!use infotrac_phy, ONLY: use_iso
1215	USE isotopes_mod, ONLY: iso_eau
1216	implicit none
1217
1218	! inputs
1219	integer n,ni
1220	real q(n)
1221	real xt(ni,n)
1222	character() err_msg
1223
1224	! locals
1225	integer iso_verif_egalite_nostop_loc
1226	integer i
1227	integer ifaux
1228
1229	if (iso_eau.gt.0) then
1230	iso_verif_egalite_nostop_loc=0
1231	do i=1,n
1232	if (abs(q(i)-xt(iso_eau,i)).gt.errmax) then
1233	if (abs((q(i)-xt(iso_eau,i))/ &
1234	& max(max(abs(q(i)),abs(xt(iso_eau,i))),1e-18)) &
1235	& .gt.errmaxrel) then
1236	iso_verif_egalite_nostop_loc=1
1237	ifaux=i
1238	endif !if (abs((q(i)-xt(iso_eau,i))/
1239	endif !if (abs(q(i)-xt(iso_eau,i)).gt.errmax) then
1240	enddo !do i=1,n
1241
1242	if (iso_verif_egalite_nostop_loc.eq.1) then
1243	write(,) 'erreur detectee par iso_verif_egalite_vect2D:'
1244	write(,) err_msg
1245	write(,) 'i=',ifaux
1246	write(,) 'xt,q=',xt(iso_eau,ifaux),q(ifaux)
1247	stop
1248	endif !if (iso_verif_egalite_nostop.eq.1) then
1249	endif !if (iso_eau.gt.0) then
1250
1251	end subroutine iso_verif_egalite_vect1D
1252
1253	subroutine iso_verif_egalite_std_vect( &
1254	& a,b,err_msg,n,m,errmax,errmaxrel)
1255
1256	implicit none
1257
1258	! inputs
1259	integer n,m,ni
1260	real a(n,m)
1261	real b(n,m)
1262	character() err_msg
1263	real errmax,errmaxrel
1264
1265	! locals
1266	integer iso_verif_egalite_nostop_loc
1267	integer i,j
1268	integer ifaux,jfaux
1269
1270	iso_verif_egalite_nostop_loc=0
1271	do i=1,n
1272	do j=1,m
1273	if (abs(a(i,j)-b(i,j)).gt.errmax) then
1274	if (abs((a(i,j)-b(i,j))/ &
1275	& max(max(abs(a(i,j)),abs(b(i,j))),1e-18)) &
1276	& .gt.errmaxrel) then
1277	iso_verif_egalite_nostop_loc=1
1278	ifaux=i
1279	jfaux=j
1280	endif
1281	endif
1282	enddo !do j=1,m
1283	enddo !do i=1,n
1284
1285	if (iso_verif_egalite_nostop_loc.eq.1) then
1286	write(,) 'erreur detectee par iso_verif_egalite_vect2D:'
1287	write(,) err_msg
1288	write(,) 'i,j=',ifaux,jfaux
1289	write(,) 'a,b=',a(ifaux,jfaux),b(ifaux,jfaux)
1290	stop
1291	endif
1292
1293	return
1294	end subroutine iso_verif_egalite_std_vect
1295
1296	subroutine iso_verif_aberrant_vect2D( &
1297	& xt,q,err_msg,ni,n,m)
1298	!use infotrac_phy, ONLY: use_iso
1299	use isotopes_mod, ONLY: ridicule,tnat,iso_HDO
1300	implicit none
1301
1302	! inputs
1303	integer n,m,ni
1304	real q(n,m)
1305	real xt(ni,n,m)
1306	character() err_msg
1307
1308	! locals
1309	integer iso_verif_aberrant_nostop_loc
1310	integer i,j
1311	integer ifaux,jfaux
1312	!real deltaD
1313
1314	if (iso_HDO.gt.0) then
1315	iso_verif_aberrant_nostop_loc=0
1316	do i=1,n
1317	do j=1,m
1318	if (q(i,j).gt.ridicule) then
1319	if (((xt(iso_HDO,i,j)/q(i,j)/tnat(iso_HDO)-1)*1000.0 &
1320	& .gt.deltalim).or. &
1321	& ((xt(iso_HDO,i,j)/q(i,j)/tnat(iso_HDO)-1)*1000.0 &
1322	& .lt.-borne)) then
1323	iso_verif_aberrant_nostop_loc=1
1324	ifaux=i
1325	jfaux=j
1326	endif
1327	endif
1328	enddo !do j=1,m
1329	enddo !do i=1,n
1330
1331	if (iso_verif_aberrant_nostop_loc.eq.1) then
1332	write(,) 'erreur detectee par iso_verif_aberrant_vect2D:'
1333	write(,) err_msg
1334	write(,) 'i,j=',ifaux,jfaux
1335	write(,) 'deltaD=',deltaD(xt(iso_HDO,ifaux,jfaux) &
1336	& /q(ifaux,jfaux))
1337	write(,) 'xt(:,ifaux,jfaux)=',xt(:,ifaux,jfaux)
1338	stop
1339	endif
1340	endif !if (iso_HDO.gt.0) then
1341
1342	end subroutine iso_verif_aberrant_vect2D
1343
1344	subroutine iso_verif_aberrant_enc_vect2D( &
1345	& xt,q,err_msg,ni,n,m)
1346
1347	!use infotrac_phy, ONLY: use_iso
1348	use isotopes_mod, ONLY: ridicule,tnat,iso_HDO
1349	implicit none
1350
1351	! inputs
1352	integer n,m,ni
1353	real q(n,m)
1354	real xt(ni,n,m)
1355	character() err_msg
1356
1357	! locals
1358	integer iso_verif_aberrant_nostop_loc
1359	integer i,j
1360	integer ifaux,jfaux
1361	!real deltaD
1362
1363	if (iso_HDO.gt.0) then
1364	iso_verif_aberrant_nostop_loc=0
1365	do i=1,n
1366	do j=1,m
1367	if (q(i,j).gt.ridicule) then
1368	if (((xt(iso_HDO,i,j)/q(i,j)/tnat(iso_HDO)-1)*1000.0 &
1369	& .gt.deltalim).or. &
1370	& ((xt(iso_HDO,i,j)/q(i,j)/tnat(iso_HDO)-1)*1000.0 &
1371	& .lt.deltaDmin).or. &
1372	& (xt(iso_HDO,i,j).lt.-borne).or. &
1373	& (xt(iso_HDO,i,j).gt.borne)) then
1374	iso_verif_aberrant_nostop_loc=1
1375	ifaux=i
1376	jfaux=j
1377	endif
1378	endif
1379	enddo !do j=1,m
1380	enddo !do i=1,n
1381
1382	if (iso_verif_aberrant_nostop_loc.eq.1) then
1383	write(,) 'erreur detectee par ', &
1384	& 'iso_verif_aberrant_enc_vect2D:'
1385	write(,) err_msg
1386	write(,) 'i,j=',ifaux,jfaux
1387	write(,) 'deltaD=',deltaD(xt(iso_HDO,ifaux,jfaux) &
1388	& /q(ifaux,jfaux))
1389	write(,) 'xt(:,ifaux,jfaux)=',xt(:,ifaux,jfaux)
1390	write(,) 'q(ifaux,jfaux)=',q(ifaux,jfaux)
1391	call abort_physic('isotopes_verif_mod','iso_verif_aberrant_enc_vect2D',1)
1392	endif
1393	endif !if (iso_HDO.gt.0) then
1394
1395	end subroutine iso_verif_aberrant_enc_vect2D
1396
1397
1398	subroutine iso_verif_aberrant_enc_vect2D_ns( &
1399	& xt,q,err_msg,ni,n,m)
1400
1401	!use infotrac_phy, ONLY: use_iso
1402	use isotopes_mod, ONLY: ridicule,tnat,iso_HDO
1403	implicit none
1404
1405	! inputs
1406	integer n,m,ni
1407	real q(n,m)
1408	real xt(ni,n,m)
1409	character() err_msg
1410
1411	! locals
1412	integer iso_verif_aberrant_nostop_loc
1413	integer i,j
1414	integer ifaux,jfaux
1415	!real deltaD
1416
1417	if (iso_HDO.gt.0) then
1418	iso_verif_aberrant_nostop_loc=0
1419	do i=1,n
1420	do j=1,m
1421	if (q(i,j).gt.ridicule) then
1422	if (((xt(iso_HDO,i,j)/q(i,j)/tnat(iso_HDO)-1)*1000.0 &
1423	& .gt.deltalim).or. &
1424	& ((xt(iso_HDO,i,j)/q(i,j)/tnat(iso_HDO)-1)*1000.0 &
1425	& .lt.deltaDmin)) then
1426	iso_verif_aberrant_nostop_loc=1
1427	ifaux=i
1428	jfaux=j
1429	endif
1430	endif
1431	enddo !do j=1,m
1432	enddo !do i=1,n
1433
1434	if (iso_verif_aberrant_nostop_loc.eq.1) then
1435	write(,) 'erreur detectee par ', &
1436	& 'iso_verif_aberrant_vect2D_ns:'
1437	write(,) err_msg
1438	write(,) 'i,j=',ifaux,jfaux
1439	write(,) 'deltaD=',deltaD(xt(iso_HDO,ifaux,jfaux) &
1440	& /q(ifaux,jfaux))
1441	write(,) 'xt(:,ifaux,jfaux)=',xt(:,ifaux,jfaux)
1442	! stop
1443	endif
1444	endif !if (iso_HDO.gt.0) then
1445
1446	end subroutine iso_verif_aberrant_enc_vect2D_ns
1447
1448
1449	subroutine iso_verif_aberrant_vect2Dch( &
1450	& xt,q,err_msg,ni,n,m,deltaDmax)
1451
1452	!use infotrac_phy, ONLY: use_iso
1453	use isotopes_mod, ONLY: ridicule,tnat,iso_HDO
1454	implicit none
1455
1456
1457	! inputs
1458	integer n,m,ni
1459	real q(n,m)
1460	real xt(ni,n,m)
1461	character() err_msg
1462	real deltaDmax
1463
1464	! locals
1465	integer iso_verif_aberrant_nostop_loc
1466	integer i,j
1467	integer ifaux,jfaux
1468	!real deltaD
1469
1470	if (iso_HDO.gt.0) then
1471	iso_verif_aberrant_nostop_loc=0
1472	do i=1,n
1473	do j=1,m
1474	if (q(i,j).gt.ridicule) then
1475	if (((xt(iso_HDO,i,j)/q(i,j)/tnat(iso_HDO)-1)*1000.0 &
1476	& .gt.deltaDmax).or. &
1477	& ((xt(iso_HDO,i,j)/q(i,j)/tnat(iso_HDO)-1)*1000.0 &
1478	& .lt.-borne)) then
1479	iso_verif_aberrant_nostop_loc=1
1480	ifaux=i
1481	jfaux=j
1482	endif
1483	endif
1484	enddo !do j=1,m
1485	enddo !do i=1,n
1486
1487	if (iso_verif_aberrant_nostop_loc.eq.1) then
1488	write(,) 'erreur detectee par iso_verif_aberrant_vect2D:'
1489	write(,) err_msg
1490	write(,) 'i,j=',ifaux,jfaux
1491	write(,) 'deltaD=',deltaD(xt(iso_HDO,ifaux,jfaux) &
1492	& /q(ifaux,jfaux))
1493	write(,) 'xt(:,ifaux,jfaux)=',xt(:,ifaux,jfaux)
1494	stop
1495	endif
1496	endif !if (iso_HDO.gt.0) then
1497
1498	end subroutine iso_verif_aberrant_vect2Dch
1499
1500	subroutine iso_verif_O18_aberrant_enc_vect2D( &
1501	& xt,q,err_msg,ni,n,m)
1502
1503	!use infotrac_phy, ONLY: use_iso
1504	use isotopes_mod, ONLY: ridicule,tnat,iso_HDO,iso_O18
1505	implicit none
1506
1507	! inputs
1508	integer n,m,ni
1509	real q(n,m)
1510	real xt(ni,n,m)
1511	character() err_msg
1512
1513	! locals
1514	integer iso_verif_aberrant_nostop_loc
1515	integer i,j
1516	integer ifaux,jfaux
1517	real deltaDloc,deltaoloc,dexcessloc
1518
1519	if ((iso_HDO.gt.0).and.(iso_O18.gt.0)) then
1520	iso_verif_aberrant_nostop_loc=0
1521	do i=1,n
1522	do j=1,m
1523	if (q(i,j).gt.ridicule) then
1524
1525	deltaDloc=(xt(iso_HDO,i,j)/q(i,j)/tnat(iso_hdo)-1)*1000
1526	deltaoloc=(xt(iso_O18,i,j)/q(i,j)/tnat(iso_O18)-1)*1000
1527	dexcessloc=deltaDloc-8*deltaoloc
1528	if ((deltaDloc.lt.deltaDmin).or.(deltaoloc.lt.deltaDmin/2.0).or. &
1529	& (deltaDloc.gt.deltalim).or.(deltaoloc.gt.deltalim/8.0).or. &
1530	& ((deltaDloc.gt.-500.0).and.((dexcessloc.lt.dexcess_min) &
1531	& .or.(dexcessloc.gt.dexcess_max)))) then
1532	iso_verif_aberrant_nostop_loc=1
1533	ifaux=i
1534	jfaux=j
1535	write(,) 'deltaD,deltao,dexcess=',deltaDloc,deltaoloc,dexcessloc
1536	endif
1537	endif
1538	enddo !do j=1,m
1539	enddo !do i=1,n
1540
1541	if (iso_verif_aberrant_nostop_loc.eq.1) then
1542	write(,) 'erreur detectee par ', &
1543	& 'iso_verif_aberrant_enc_vect2D:'
1544	write(,) err_msg
1545	write(,) 'i,j=',ifaux,jfaux
1546	write(,) 'xt(:,ifaux,jfaux)=',xt(:,ifaux,jfaux)
1547	write(,) 'q(ifaux,jfaux)=',q(ifaux,jfaux)
1548	call abort_physic('isotopes_verif_mod','iso_verif_aberrant_enc_vect2D',1)
1549	endif
1550	endif !if (iso_HDO.gt.0) then
1551
1552	end subroutine iso_verif_O18_aberrant_enc_vect2D
1553
1554
1555	subroutine select_dim23_from4D(n1,n2,n3,n4, &
1556	& var,vec,i1,i4)
1557	implicit none
1558
1559	! inputs
1560	integer n1,n2,n3,n4
1561	real var(n1,n2,n3,n4)
1562	integer i1,i4
1563	! outputs
1564	real vec(n2,n3)
1565	! locals
1566	integer i2,i3
1567
1568	do i2=1,n2
1569	do i3=1,n3
1570	vec(i2,i3)=var(i1,i2,i3,i4)
1571	enddo
1572	enddo
1573
1574	return
1575	end subroutine select_dim23_from4D
1576
1577
1578	subroutine select_dim4_from4D(ntime,nlev,nlat,nlon, &
1579	& var,vec,itime,ilev,ilat)
1580	implicit none
1581
1582	! inputs
1583	integer ntime,nlev,nlat,nlon
1584	real var(ntime,nlev,nlat,nlon)
1585	integer itime,ilev,ilat
1586	! outputs
1587	real vec(nlon)
1588	! locals
1589	integer ilon
1590
1591	do ilon=1,nlon
1592	vec(ilon)=var(itime,ilev,ilat,ilon)
1593	enddo
1594
1595	return
1596	end subroutine select_dim4_from4D
1597
1598	subroutine select_dim5_from5D(n1,n2,n3,n4,n5, &
1599	& var,vec,i1,i2,i3,i4)
1600	implicit none
1601
1602	! inputs
1603	integer n1,n2,n3,n4,n5
1604	real var(n1,n2,n3,n4,n5)
1605	integer i1,i2,i3,i4
1606	! outputs
1607	real vec(n5)
1608	! locals
1609	integer i5
1610
1611	do i5=1,n5
1612	vec(i5)=var(i1,i2,i3,i4,i5)
1613	enddo
1614
1615	end subroutine select_dim5_from5D
1616
1617
1618	subroutine select_dim3_from3D(ntime,nlat,nlon, &
1619	& var,vec,itime,ilat)
1620	implicit none
1621
1622	! inputs
1623	integer ntime,nlat,nlon
1624	real var(ntime,nlat,nlon)
1625	integer itime,ilat
1626	! outputs
1627	real vec(nlon)
1628	! locals
1629	integer ilon
1630
1631	do ilon=1,nlon
1632	vec(ilon)=var(itime,ilat,ilon)
1633	enddo
1634
1635	end subroutine select_dim3_from3D
1636
1637
1638	subroutine select_dim23_from3D(n1,n2,n3, &
1639	& var,vec,i1)
1640	implicit none
1641
1642	! inputs
1643	integer n1,n2,n3
1644	real var(n1,n2,n3)
1645	integer i1
1646	! outputs
1647	real vec(n2,n3)
1648	! locals
1649	integer i2,i3
1650
1651	do i2=1,n2
1652	do i3=1,n3
1653	vec(i2,i3)=var(i1,i2,i3)
1654	enddo
1655	enddo
1656
1657	end subroutine select_dim23_from3D
1658
1659	subroutine putinto_dim23_from4D(n1,n2,n3,n4, &
1660	& var,vec,i1,i4)
1661	implicit none
1662
1663	! inputs
1664	integer n1,n2,n3,n4
1665	real vec(n2,n3)
1666	integer i1,i4
1667	! inout
1668	real var(n1,n2,n3,n4)
1669	! locals
1670	integer i2,i3
1671
1672	do i2=1,n2
1673	do i3=1,n3
1674	var(i1,i2,i3,i4)=vec(i2,i3)
1675	enddo
1676	enddo
1677
1678	end subroutine putinto_dim23_from4D
1679
1680
1681	subroutine putinto_dim12_from4D(n1,n2,n3,n4, &
1682	& var,vec,i3,i4)
1683	implicit none
1684
1685	! inputs
1686	integer n1,n2,n3,n4
1687	real vec(n1,n2)
1688	integer i3,i4
1689	! inout
1690	real var(n1,n2,n3,n4)
1691	! locals
1692	integer i1,i2
1693
1694	do i1=1,n1
1695	do i2=1,n2
1696	var(i1,i2,i3,i4)=vec(i1,i2)
1697	enddo
1698	enddo
1699
1700	end subroutine putinto_dim12_from4D
1701
1702	subroutine putinto_dim23_from3D(n1,n2,n3, &
1703	& var,vec,i1)
1704	implicit none
1705
1706	! inputs
1707	integer n1,n2,n3
1708	real vec(n2,n3)
1709	integer i1
1710	! inout
1711	real var(n1,n2,n3)
1712	! locals
1713	integer i2,i3
1714
1715	do i2=1,n2
1716	do i3=1,n3
1717	var(i1,i2,i3)=vec(i2,i3)
1718	enddo
1719	enddo
1720
1721	end subroutine putinto_dim23_from3D
1722
1723
1724
1725	subroutine iso_verif_noNaN_par2D(x,err_msg,ni,n,m,ib,ie)
1726	implicit none
1727	! si x est NaN, on affiche message
1728	! d'erreur et return 1 si erreur
1729
1730	! input:
1731	integer n,m,ni,ib,ie
1732	real x(ni,n,m)
1733	character() err_msg ! message d''erreur à afficher
1734
1735	! output
1736
1737	! locals
1738	integer i,j,ixt
1739
1740	do i=ib,ie
1741	do j=1,m
1742	do ixt=1,ni
1743	if ((x(ixt,i,j).gt.-borne).and. &
1744	& (x(ixt,i,j).lt.borne)) then
1745	else !if ((x(ixt,i,j).gt.-borne).and.
1746	write(,) 'erreur detectee par iso_verif_nonNAN:'
1747	write(,) err_msg
1748	write(,) 'x,ixt,i,j=',x(ixt,i,j),ixt,i,j
1749	stop
1750	endif !if ((x(ixt,i,j).gt.-borne).and.
1751	enddo !do ixt=1,ni
1752	enddo !do j=1,m
1753	enddo !do i=1,n
1754
1755	#ifdef ISOVERIF
1756	#else
1757	write(,) 'err_msg iso1772=',err_msg,': pourquoi verif?'
1758	stop
1759	#endif
1760
1761	return
1762	end subroutine iso_verif_noNaN_par2D
1763
1764
1765	subroutine iso_verif_aberrant_enc_par2D( &
1766	& xt,q,err_msg,ni,n,m,ib,ie)
1767
1768	!use infotrac_phy, ONLY: use_iso
1769	use isotopes_mod, ONLY: ridicule,tnat,iso_HDO
1770	implicit none
1771
1772	! inputs
1773	integer n,m,ni,ib,ie
1774	real q(n,m)
1775	real xt(ni,n,m)
1776	character() err_msg
1777
1778	! locals
1779	integer iso_verif_aberrant_nostop_loc
1780	integer i,j
1781	integer ifaux,jfaux
1782	!real deltaD
1783
1784	if (iso_HDO.gt.0) then
1785	iso_verif_aberrant_nostop_loc=0
1786	do i=ib,ie
1787	do j=1,m
1788	if (q(i,j).gt.ridicule) then
1789	if (((xt(iso_HDO,i,j)/q(i,j)/tnat(iso_HDO)-1)*1000.0 &
1790	& .gt.deltalim).or. &
1791	& ((xt(iso_HDO,i,j)/q(i,j)/tnat(iso_HDO)-1)*1000.0 &
1792	& .lt.deltaDmin)) then
1793	iso_verif_aberrant_nostop_loc=1
1794	ifaux=i
1795	jfaux=j
1796	endif
1797	endif
1798	enddo !do j=1,m
1799	enddo !do i=1,n
1800
1801	if (iso_verif_aberrant_nostop_loc.eq.1) then
1802	write(,) 'erreur detectee par iso_verif_aberrant_par2D:'
1803	write(,) err_msg
1804	write(,) 'i,j=',ifaux,jfaux
1805	write(,) 'deltaD=',deltaD(xt(iso_HDO,ifaux,jfaux) &
1806	& /q(ifaux,jfaux))
1807	write(,) 'xt(:,ifaux,jfaux)=',xt(:,ifaux,jfaux)
1808	write(,) 'q(ifaux,jfaux)=',q(ifaux,jfaux)
1809	stop
1810	endif
1811	endif !if (iso_HDO.gt.0) then
1812
1813	end subroutine iso_verif_aberrant_enc_par2D
1814
1815
1816	subroutine iso_verif_egalite_par2D( &
1817	& xt,q,err_msg,ni,n,m,ib,ie)
1818
1819	!use infotrac_phy, ONLY: use_iso
1820	USE isotopes_mod, ONLY: iso_eau
1821	implicit none
1822
1823	! inputs
1824	integer n,m,ni,ib,ie
1825	real q(n,m)
1826	real xt(ni,n,m)
1827	character() err_msg
1828
1829	! locals
1830	integer iso_verif_egalite_nostop_loc
1831	integer i,j
1832	integer ifaux,jfaux
1833
1834	if (iso_eau.gt.0) then
1835	iso_verif_egalite_nostop_loc=0
1836	do i=ib,ie
1837	do j=1,m
1838	if (abs(q(i,j)-xt(iso_eau,i,j)).gt.errmax) then
1839	if (abs((q(i,j)-xt(iso_eau,i,j))/ &
1840	& max(max(abs(q(i,j)),abs(xt(iso_eau,i,j))),1e-18)) &
1841	& .gt.errmaxrel) then
1842	iso_verif_egalite_nostop_loc=1
1843	ifaux=i
1844	jfaux=j
1845	endif
1846	endif
1847	enddo !do j=1,m
1848	enddo !do i=1,n
1849
1850	if (iso_verif_egalite_nostop_loc.eq.1) then
1851	write(,) 'erreur detectee par iso_verif_egalite_vect2D:'
1852	write(,) err_msg
1853	write(,) 'i,j=',ifaux,jfaux
1854	write(,) 'xt,q=',xt(iso_eau,ifaux,jfaux),q(ifaux,jfaux)
1855	stop
1856	endif
1857	endif
1858
1859	end subroutine iso_verif_egalite_par2D
1860
1861	#ifdef ISOTRAC
1862
1863	function iso_verif_traceur_choix_nostop(x,err_msg, &
1864	& errmax,errmaxrel,ridicule_trac,deltalimtrac)
1865	USE infotrac_phy, ONLY: ntraciso
1866	use isotopes_mod, ONLY: iso_HDO
1867	implicit none
1868	! vérifier des choses sur les traceurs
1869	! * toutes les zones donne t l'istope total
1870	! * pas de deltaD aberrant
1871
1872	! inputs
1873	real x(ntraciso)
1874	character() err_msg ! message d''erreur à afficher
1875	real errmax,errmaxrel,ridicule_trac,deltalimtrac
1876
1877	! output
1878	integer iso_verif_traceur_choix_nostop
1879
1880	! locals
1881	!integer iso_verif_traceur_noNaN_nostop
1882	!integer iso_verif_tracm_choix_nostop
1883	!integer iso_verif_tracdD_choix_nostop
1884	!integer iso_verif_tracpos_choix_nostop
1885
1886	iso_verif_traceur_choix_nostop=0
1887
1888	! verif noNaN
1889	if (iso_verif_traceur_noNaN_nostop(x,err_msg).eq.1) then
1890	iso_verif_traceur_choix_nostop=1
1891	endif
1892
1893	! verif masse
1894	if (iso_verif_tracm_choix_nostop(x,err_msg, &
1895	& errmax,errmaxrel).eq.1) then
1896	iso_verif_traceur_choix_nostop=1
1897	endif
1898
1899	! verif deltaD
1900	if (iso_HDO.gt.0) then
1901	if (iso_verif_tracdD_choix_nostop(x,err_msg, &
1902	& ridicule_trac,deltalimtrac).eq.1) then
1903	iso_verif_traceur_choix_nostop=1
1904	endif
1905	endif !if (iso_HDO.gt.0) then
1906
1907	! verif pas aberramment negatif
1908	if (iso_verif_tracpos_choix_nostop(x,err_msg, &
1909	& 1e-5).eq.1) then
1910	iso_verif_traceur_choix_nostop=1
1911	endif
1912
1913	end function iso_verif_traceur_choix_nostop
1914
1915	function iso_verif_tracnps_choix_nostop(x,err_msg, &
1916	& errmax,errmaxrel,ridicule_trac,deltalimtrac)
1917	USE infotrac_phy, ONLY: ntraciso
1918	USE isotopes_mod, ONLY: iso_HDO
1919	implicit none
1920	! vérifier des choses sur les traceurs
1921	! * toutes les zones donne t l'istope total
1922	! * pas de deltaD aberrant
1923	! on ne vérfie pas la positivité
1924
1925	! inputs
1926	real x(ntraciso)
1927	character() err_msg ! message d''erreur à afficher
1928	real errmax,errmaxrel,ridicule_trac,deltalimtrac
1929
1930	! output
1931	integer iso_verif_tracnps_choix_nostop
1932
1933	! locals
1934	!integer iso_verif_traceur_noNaN_nostop
1935	!integer iso_verif_tracm_choix_nostop
1936	!integer iso_verif_tracdD_choix_nostop
1937
1938	iso_verif_tracnps_choix_nostop=0
1939
1940	! verif noNaN
1941	if (iso_verif_traceur_noNaN_nostop(x,err_msg).eq.1) then
1942	iso_verif_tracnps_choix_nostop=1
1943	endif
1944
1945	! verif masse
1946	if (iso_verif_tracm_choix_nostop(x,err_msg, &
1947	& errmax,errmaxrel).eq.1) then
1948	iso_verif_tracnps_choix_nostop=1
1949	endif
1950
1951	! verif deltaD
1952	if (iso_HDO.gt.0) then
1953	if (iso_verif_tracdD_choix_nostop(x,err_msg, &
1954	& ridicule_trac,deltalimtrac).eq.1) then
1955	iso_verif_tracnps_choix_nostop=1
1956	endif
1957	endif ! if (iso_HDO.gt.0) then
1958
1959	return
1960	end function iso_verif_tracnps_choix_nostop
1961
1962	function iso_verif_tracpos_choix_nostop(x,err_msg,seuil)
1963	use infotrac_phy, ONLY: ntraciso,niso
1964	use isotrac_mod, only: index_iso,strtrac,index_zone
1965	use isotopes_mod, only: striso
1966	implicit none
1967
1968	! inputs
1969	real x(ntraciso)
1970	character() err_msg ! message d''erreur à afficher
1971	real seuil
1972
1973	! output
1974	integer iso_verif_tracpos_choix_nostop
1975
1976	! locals
1977	integer lnblnk
1978	integer iiso,ixt
1979	!integer iso_verif_positif_choix_nostop
1980
1981	iso_verif_tracpos_choix_nostop=0
1982
1983	do ixt=niso+1,ntraciso
1984	iiso=index_iso(ixt)
1985	if (iso_verif_positif_choix_nostop(x(ixt),seuil,err_msg// &
1986	& ', verif positif, iso'//striso(iiso) &
1987	& //strtrac(index_zone(ixt))).eq.1) then
1988	iso_verif_tracpos_choix_nostop=1
1989	endif
1990	enddo
1991
1992	end function iso_verif_tracpos_choix_nostop
1993
1994
1995	function iso_verif_traceur_noNaN_nostop(x,err_msg)
1996	use infotrac_phy, ONLY: ntraciso,niso
1997	use isotrac_mod, only: index_iso
1998	use isotopes_mod, only: striso
1999	implicit none
2000
2001	! on vérifie juste que pas NaN
2002	! inputs
2003	real x(ntraciso)
2004	character() err_msg ! message d''erreur à afficher
2005
2006	! output
2007	integer iso_verif_traceur_noNaN_nostop
2008
2009	! locals
2010	integer lnblnk
2011	integer iiso,ixt
2012	!integer iso_verif_nonaN_nostop
2013
2014	iso_verif_traceur_noNaN_nostop=0
2015
2016	do ixt=niso+1,ntraciso
2017	iiso=index_iso(ixt)
2018	! write(,) 'iso_verif_traceurs 154: iiso,ixt=',iiso,ixt
2019	if (iso_verif_noNaN_nostop(x(ixt),err_msg// &
2020	& ', verif trac no NaN, iso'//striso(iiso)) &
2021	& .eq.1) then
2022	iso_verif_traceur_noNaN_nostop=1
2023	endif
2024	enddo
2025
2026	end function iso_verif_traceur_noNaN_nostop
2027
2028	function iso_verif_tracm_choix_nostop(x,err_msg, &
2029	& errmaxin,errmaxrelin)
2030
2031	use infotrac_phy, ONLY: index_trac,ntraciso,niso
2032	use isotopes_mod, ONLY: ridicule,striso
2033	use isotrac_mod, only: ntraceurs_zone
2034	! on vérifie juste bilan de masse
2035	implicit none
2036
2037	! inputs
2038	real x(ntraciso)
2039	character() err_msg ! message d''erreur à afficher
2040	real errmaxin,errmaxrelin
2041
2042	! output
2043	integer iso_verif_tracm_choix_nostop
2044
2045	! locals
2046	!integer iso_verif_egalite_choix_nostop
2047	integer iiso,izone,ixt
2048	real xtractot
2049
2050	iso_verif_tracm_choix_nostop=0
2051
2052	do iiso=1,niso
2053
2054	xtractot=0.0
2055	do izone=1,ntraceurs_zone
2056	ixt=index_trac(izone,iiso)
2057	xtractot=xtractot+x(ixt)
2058	enddo !do izone=1,ntraceurs_zone
2059
2060	if (iso_verif_egalite_choix_nostop(xtractot,x(iiso), &
2061	& err_msg//', verif trac egalite, iso '//striso(iiso), &
2062	& errmaxin,errmaxrelin).eq.1) then
2063	write(,) 'iso_verif_traceur 202: x=',x
2064	! write(,) 'xtractot=',xtractot
2065	iso_verif_tracm_choix_nostop=1
2066	endif
2067
2068	! verif ajoutée le 19 fev 2011
2069	if ((abs(xtractot).lt.ridicule**2).and. &
2070	& (abs(x(iiso)).gt.ridicule)) then
2071	write(,) err_msg,', verif masse traceurs, iso ', &
2072	& striso(iiso)
2073	write(,) 'iso_verif_traceur 209: x=',x
2074	! iso_verif_tracm_choix_nostop=1
2075	endif
2076
2077	enddo !do iiso=1,ntraceurs_iso
2078
2079	end function iso_verif_tracm_choix_nostop
2080
2081	function iso_verif_tracdD_choix_nostop(x,err_msg, &
2082	& ridicule_trac,deltalimtrac)
2083
2084	use infotrac_phy, ONLY: index_trac,ntraciso
2085	USE isotopes_mod, ONLY: iso_eau, iso_HDO
2086	use isotrac_mod, only: strtrac,ntraceurs_zone
2087	! on vérifie juste deltaD
2088	implicit none
2089
2090	! inputs
2091	real x(ntraciso)
2092	character() err_msg ! message d''erreur à afficher
2093	real ridicule_trac,deltalimtrac
2094
2095	! output
2096	integer iso_verif_tracdD_choix_nostop
2097
2098	! locals
2099	integer izone,ieau,ixt
2100	!integer iso_verif_aberrant_choix_nostop
2101
2102	iso_verif_tracdD_choix_nostop=0
2103
2104	if ((iso_eau.gt.0).and.(iso_HDO.gt.0)) then
2105	do izone=1,ntraceurs_zone
2106	ieau=index_trac(izone,iso_eau)
2107	ixt=index_trac(izone,iso_HDO)
2108
2109	if (iso_verif_aberrant_choix_nostop(x(ixt),x(ieau), &
2110	& ridicule_trac,deltalimtrac,err_msg// &
2111	& ', verif trac no aberrant zone '//strtrac(izone)) &
2112	& .eq.1) then
2113	iso_verif_tracdD_choix_nostop=1
2114	endif
2115	! if (x(ieau).gt.ridicule) then
2116	! call iso_verif_aberrant(x(ixt)/x(ieau),
2117	! : err_msg//', verif trac no aberrant zone '
2118	! : //strtrac(izone))
2119	! endif
2120	enddo !do izone=1,ntraceurs_zone
2121	endif ! if ((iso_eau.gt.0).and.(iso_HDO.gt.0)) then
2122
2123	end function iso_verif_tracdD_choix_nostop
2124
2125	INTEGER FUNCTION iso_verif_tag17_q_deltaD_chns(x,err_msg) RESULT(res)
2126	USE infotrac_phy, ONLY: index_trac, ntraciso
2127	USE isotopes_mod, ONLY: iso_HDO, iso_eau, ridicule
2128	USE isotrac_mod, ONLY: nzone_temp, option_traceurs
2129	IMPLICIT NONE
2130	REAL, INTENT(IN) :: x(ntraciso)
2131	CHARACTER(LEN=*), INTENT(IN) :: err_msg
2132	INTEGER :: ieau, ixt, ieau1
2133	res = 0
2134	IF(ALL([17,18]/=option_traceurs)) RETURN
2135	!--- Check whether * deltaD(highest tagging layer) < 200 permil
2136	! * q <
2137	ieau=index_trac(nzone_temp,iso_eau)
2138	ixt=index_trac(nzone_temp,iso_HDO)
2139	IF(x(ieau)>ridicule) THEN
2140	IF(iso_verif_positif_nostop(-200.0-deltaD(x(ixt)/x(ieau)), err_msg//': deltaDt05 trop fort')==1) THEN
2141	res=1; write(,) 'x=',x
2142	END IF
2143	END IF
2144	IF(iso_verif_positif_nostop(2.0e-3-x(ieau),err_msg//': qt05 trop fort')==1) THEN
2145	res=1; write(,) 'x=',x
2146	END IF
2147	!--- Check whether q is small ; then, qt01 < 10%
2148	IF(x(iso_eau)<2.0e-3) THEN
2149	ieau1= index_trac(1,iso_eau)
2150	IF(iso_verif_positif_nostop(0.1-(x(ieau1)/x(iso_eau)),err_msg//': qt01 trop abondant')==1) THEN
2151	res=1; write(,) 'x=',x
2152	END IF
2153	END IF
2154	END FUNCTION iso_verif_tag17_q_deltaD_chns
2155
2156	SUBROUTINE iso_verif_trac17_q_deltaD(x,err_msg)
2157	USE isotrac_mod, ONLY: nzone_temp, option_traceurs
2158	USE infotrac_phy, ONLY: ntraciso
2159	IMPLICIT NONE
2160	REAL, INTENT(IN) :: x(ntraciso)
2161	CHARACTER(LEN=*), INTENT(IN) :: err_msg
2162	IF(ALL([17,18]/=option_traceurs)) RETURN
2163	IF(nzone_temp>=5) THEN
2164	IF(iso_verif_tag17_q_deltaD_chns(x,err_msg)==1) STOP
2165	END IF
2166	END SUBROUTINE iso_verif_trac17_q_deltaD
2167
2168	subroutine iso_verif_traceur(x,err_msg)
2169	USE infotrac_phy, ONLY: ntraciso
2170	use isotrac_mod, only: ridicule_trac
2171	implicit none
2172	! vérifier des choses sur les traceurs
2173	! * toutes les zones donne t l'istope total
2174	! * pas de deltaD aberrant
2175
2176	! on prend les valeurs pas défaut pour
2177	! errmax,errmaxrel,ridicule_trac,deltalimtrac
2178
2179	! inputs
2180	real x(ntraciso)
2181	character() err_msg ! message d''erreur à afficher
2182
2183	! locals
2184	!integer iso_verif_traceur_choix_nostop
2185
2186	if (iso_verif_traceur_choix_nostop(x,err_msg, &
2187	& errmax,errmaxrel,ridicule_trac,deltalimtrac) &
2188	& .eq.1) then
2189	stop
2190	endif
2191
2192	end subroutine iso_verif_traceur
2193
2194
2195	subroutine iso_verif_traceur_retourne3D(x,n1,n2,n3, &
2196	& i1,i2,i3,err_msg)
2197	USE infotrac_phy, ONLY: ntraciso
2198	use isotrac_mod, only: ridicule_trac
2199
2200	implicit none
2201	! vérifier des choses sur les traceurs
2202	! * toutes les zones donne t l'istope total
2203	! * pas de deltaD aberrant
2204
2205	! on prend les valeurs pas défaut pour
2206	! errmax,errmaxrel,ridicule_trac,deltalimtrac
2207
2208	! inputs
2209	integer n1,n2,n3
2210	real x(n1,n2,n3,ntraciso)
2211	character() err_msg ! message d''erreur à afficher
2212	integer i1,i2,i3
2213
2214	! locals
2215	!integer iso_verif_traceur_choix_nostop
2216	real xiso(ntraciso)
2217
2218	call select_dim4_from4D(n1,n2,n3,ntraciso, &
2219	& x,xiso,i1,i2,i3)
2220	if (iso_verif_traceur_choix_nostop(xiso,err_msg, &
2221	& errmax,errmaxrel,ridicule_trac,deltalimtrac) &
2222	& .eq.1) then
2223	stop
2224	endif
2225
2226	end subroutine iso_verif_traceur_retourne3D
2227
2228	subroutine iso_verif_traceur_retourne4D(x,n1,n2,n3,n4, &
2229	& i1,i2,i3,i4,err_msg)
2230	USE infotrac_phy, ONLY: ntraciso
2231	use isotrac_mod, only: ridicule_trac
2232
2233	implicit none
2234	! vérifier des choses sur les traceurs
2235	! * toutes les zones donne t l'istope total
2236	! * pas de deltaD aberrant
2237
2238	! on prend les valeurs pas défaut pour
2239	! errmax,errmaxrel,ridicule_trac,deltalimtrac
2240
2241	! inputs
2242	integer n1,n2,n3,n4
2243	real x(n1,n2,n3,n4,ntraciso)
2244	character() err_msg ! message d''erreur à afficher
2245	integer i1,i2,i3,i4
2246
2247	! locals
2248	!integer iso_verif_traceur_choix_nostop
2249	real xiso(ntraciso)
2250
2251	call select_dim5_from5D(n1,n2,n3,n4,ntraciso, &
2252	& x,xiso,i1,i2,i3,i4)
2253	if (iso_verif_traceur_choix_nostop(xiso,err_msg, &
2254	& errmax,errmaxrel,ridicule_trac,deltalimtrac) &
2255	& .eq.1) then
2256	stop
2257	endif
2258
2259	end subroutine iso_verif_traceur_retourne4D
2260
2261
2262	subroutine iso_verif_traceur_retourne2D(x,n1,n2, &
2263	& i1,i2,err_msg)
2264	USE infotrac_phy, ONLY: ntraciso
2265	use isotrac_mod, only: ridicule_trac
2266	implicit none
2267	! vérifier des choses sur les traceurs
2268	! * toutes les zones donne t l'istope total
2269	! * pas de deltaD aberrant
2270
2271	! on prend les valeurs pas défaut pour
2272	! errmax,errmaxrel,ridicule_trac,deltalimtrac
2273
2274	! inputs
2275	integer n1,n2
2276	real x(n1,n2,ntraciso)
2277	character() err_msg ! message d''erreur à afficher
2278	integer i1,i2
2279
2280	! locals
2281	!integer iso_verif_traceur_choix_nostop
2282	real xiso(ntraciso)
2283
2284	call select_dim3_from3D(n1,n2,ntraciso, &
2285	& x,xiso,i1,i2)
2286	if (iso_verif_traceur_choix_nostop(xiso,err_msg, &
2287	& errmax,errmaxrel,ridicule_trac,deltalimtrac) &
2288	& .eq.1) then
2289	stop
2290	endif
2291
2292	end subroutine iso_verif_traceur_retourne2D
2293
2294	subroutine iso_verif_traceur_vect(x,n,m,err_msg)
2295	USE infotrac_phy, ONLY: ntraciso
2296	USE isotopes_mod, ONLY: iso_HDO
2297	implicit none
2298	! vérifier des choses sur les traceurs
2299	! * toutes les zones donne t l'istope total
2300	! * pas de deltaD aberrant
2301
2302	! on prend les valeurs pas défaut pour
2303	! errmax,errmaxrel,ridicule_trac,deltalimtrac
2304
2305	! inputs
2306	integer n,m
2307	real x(ntraciso,n,m)
2308	character() err_msg ! message d''erreur à afficher
2309
2310	! locals
2311	logical iso_verif_traceur_nostop
2312	integer i,j,ixt,iiso,izone,ieau
2313	integer ifaux,jfaux,ixtfaux
2314
2315	call iso_verif_traceur_noNaN_vect(x,n,m,err_msg)
2316
2317	! verif masse: iso_verif_tracm_choix_nostop
2318	call iso_verif_trac_masse_vect(x,n,m,err_msg,errmax,errmaxrel)
2319
2320	! verif deltaD: iso_verif_tracdD_choix_nostop
2321	if (iso_HDO.gt.0) then
2322	call iso_verif_tracdd_vect(x,n,m,err_msg)
2323	endif !if (iso_HDO.gt.0) then
2324
2325	! verif pas aberramment negatif: iso_verif_tracpos_choix_nostop
2326	call iso_verif_tracpos_vect(x,n,m,err_msg,1e-5)
2327
2328	end subroutine iso_verif_traceur_vect
2329
2330	subroutine iso_verif_tracnps_vect(x,n,m,err_msg)
2331	USE infotrac_phy, ONLY: ntraciso
2332	USE isotopes_mod, ONLY: iso_HDO
2333	implicit none
2334	! vérifier des choses sur les traceurs
2335	! * toutes les zones donne t l'istope total
2336	! * pas de deltaD aberrant
2337
2338	! on prend les valeurs pas défaut pour
2339	! errmax,errmaxrel,ridicule_trac,deltalimtrac
2340
2341	! inputs
2342	integer n,m
2343	real x(ntraciso,n,m)
2344	character() err_msg ! message d''erreur à afficher
2345
2346	! locals
2347	logical iso_verif_traceur_nostop
2348	integer i,j,ixt,iiso,izone,ieau
2349	integer ifaux,jfaux,ixtfaux
2350
2351	call iso_verif_traceur_noNaN_vect(x,n,m,err_msg)
2352
2353	! verif masse: iso_verif_tracm_choix_nostop
2354	call iso_verif_trac_masse_vect(x,n,m,err_msg,errmax,errmaxrel)
2355
2356	! verif deltaD: iso_verif_tracdD_choix_nostop
2357	if (iso_HDO.gt.0) then
2358	call iso_verif_tracdd_vect(x,n,m,err_msg)
2359	endif !if (iso_HDO.gt.0) then
2360
2361	end subroutine iso_verif_tracnps_vect
2362
2363
2364	subroutine iso_verif_traceur_noNaN_vect(x,n,m,err_msg)
2365	USE infotrac_phy, ONLY: ntraciso,niso
2366	implicit none
2367
2368	! inputs
2369	integer n,m
2370	real x(ntraciso,n,m)
2371	character() err_msg ! message d''erreur à afficher
2372
2373	! locals
2374	logical iso_verif_traceur_nostop
2375	integer i,j,ixt,iiso
2376	integer ifaux,jfaux,ixtfaux
2377
2378
2379	iso_verif_traceur_nostop=.false.
2380	! verif noNaN: iso_verif_traceur_noNaN_nostop
2381	do j=1,m
2382	do i=1,n
2383	do ixt=niso+1,ntraciso
2384	if ((x(ixt,i,j).gt.-borne).and.(x(ixt,i,j).lt.borne)) then
2385	else !if ((x.gt.-borne).and.(x.lt.borne)) then
2386	iso_verif_traceur_nostop=.true.
2387	ifaux=i
2388	jfaux=i
2389	endif !if ((x.gt.-borne).and.(x.lt.borne)) then
2390	enddo !do ixt=niso+1,ntraciso
2391	enddo ! do i=1,n
2392	enddo ! do j=1,m
2393
2394
2395	if (iso_verif_traceur_nostop) then
2396	write(,) 'erreur detectée par iso_verif_nonNAN ', &
2397	& 'dans iso_verif_traceur_vect'
2398	write(,) ''
2399	write(,) err_msg
2400	write(,) 'x=',x(:,ifaux,jfaux)
2401	stop
2402	endif
2403
2404	end subroutine iso_verif_traceur_noNaN_vect
2405
2406
2407	subroutine iso_verif_trac_masse_vect(x,n,m,err_msg, &
2408	& errmax,errmaxrel)
2409	USE infotrac_phy, ONLY: index_trac,ntraciso,niso
2410	use isotopes_mod, only: striso
2411	use isotrac_mod, only: ntraceurs_zone
2412	implicit none
2413
2414	! inputs
2415	integer n,m
2416	real x(ntraciso,n,m)
2417	character() err_msg ! message d''erreur à afficher
2418	real errmax,errmaxrel
2419
2420	! locals
2421	logical iso_verif_traceur_nostop
2422	integer i,j,ixt,iiso,izone
2423	integer ifaux,jfaux,ixtfaux
2424	real xtractot(n,m)
2425	real xiiso(n,m)
2426
2427	do iiso=1,niso
2428	do j=1,m
2429	do i=1,n
2430	xtractot(i,j)=0.0
2431	xiiso(i,j)=x(iiso,i,j)
2432	do izone=1,ntraceurs_zone
2433	ixt=index_trac(izone,iiso)
2434	xtractot(i,j)=xtractot(i,j)+x(ixt,i,j)
2435	enddo !do izone=1,ntraceurs_zone
2436	enddo !do i=1,n
2437	enddo !do j=1,m
2438
2439
2440	call iso_verif_egalite_std_vect( &
2441	& xtractot,xiiso, &
2442	& err_msg//', verif trac egalite, iso '//striso(iiso), &
2443	& n,m,errmax,errmaxrel)
2444	enddo !do iiso=1,niso
2445
2446	end subroutine iso_verif_trac_masse_vect
2447
2448	subroutine iso_verif_tracdd_vect(x,n,m,err_msg)
2449	use infotrac_phy, only: index_trac,ntraciso,niso
2450	use isotopes_mod, only: iso_HDO,iso_eau
2451	use isotrac_mod, only: strtrac,ntraceurs_zone
2452	implicit none
2453
2454	! inputs
2455	integer n,m
2456	real x(ntraciso,n,m)
2457	character() err_msg ! message d''erreur à afficher
2458
2459	! locals
2460	integer i,j,iiso,izone,ieau,ixt
2461	real xiiso(niso,n,m)
2462	real xeau(n,m)
2463	integer lnblnk
2464
2465	if (iso_HDO.gt.0) then
2466	do izone=1,ntraceurs_zone
2467	ieau=index_trac(izone,iso_eau)
2468	do iiso=1,niso
2469	ixt=index_trac(izone,iiso)
2470	do j=1,m
2471	do i=1,n
2472	xiiso(iiso,i,j)=x(ixt,i,j)
2473	enddo !do i=1,n
2474	enddo !do j=1,m
2475	enddo !do iiso=1,niso
2476
2477	do j=1,m
2478	do i=1,n
2479	xeau(i,j)=x(ieau,i,j)
2480	enddo !do i=1,n
2481	enddo !do j=1,m
2482
2483	call iso_verif_aberrant_vect2Dch( &
2484	& xiiso,xeau,err_msg//strtrac(izone),niso,n,m, &
2485	& deltalimtrac)
2486	enddo !do izone=1,ntraceurs_zone
2487	endif !if (iso_HDO.gt.0) then
2488
2489	end subroutine iso_verif_tracdd_vect
2490
2491	subroutine iso_verif_tracpos_vect(x,n,m,err_msg,seuil)
2492	USE infotrac_phy, ONLY: ntraciso,niso
2493	implicit none
2494
2495	! inputs
2496	integer n,m
2497	real x(ntraciso,n,m)
2498	character() err_msg ! message d''erreur à afficher
2499	real seuil
2500
2501	! locals
2502	integer i,j,ixt
2503	logical iso_verif_traceur_nostop
2504	integer ifaux,jfaux,ixtfaux
2505
2506	iso_verif_traceur_nostop=.false.
2507	do j=1,m
2508	do i=1,n
2509	do ixt=niso+1,ntraciso
2510	if (x(ixt,i,j).lt.-seuil) then
2511	ifaux=i
2512	jfaux=j
2513	ixtfaux=ixt
2514	iso_verif_traceur_nostop=.true.
2515	endif
2516	enddo !do ixt=niso+1,ntraciso
2517	enddo !do i=1,n
2518	enddo !do j=1,m
2519
2520	if (iso_verif_traceur_nostop) then
2521	write(,) 'erreur detectée par verif positif ', &
2522	& 'dans iso_verif_traceur_vect'
2523	write(,) ''
2524	write(,) err_msg
2525	write(,) 'x=',x(:,ifaux,jfaux)
2526	stop
2527	endif
2528
2529	end subroutine iso_verif_tracpos_vect
2530
2531
2532
2533	subroutine iso_verif_tracnps(x,err_msg)
2534	USE infotrac_phy, ONLY: ntraciso
2535	use isotrac_mod, only: ridicule_trac
2536
2537	implicit none
2538	! vérifier des choses sur les traceurs
2539	! * toutes les zones donne t l'istope total
2540	! * pas de deltaD aberrant
2541
2542	! on prend les valeurs pas défaut pour
2543	! errmax,errmaxrel,ridicule_trac,deltalimtrac
2544
2545	! inputs
2546	real x(ntraciso)
2547	character() err_msg ! message d''erreur à afficher
2548
2549	! locals
2550	!integer iso_verif_tracnps_choix_nostop
2551
2552	if (iso_verif_tracnps_choix_nostop(x,err_msg, &
2553	& errmax,errmaxrel,ridicule_trac,deltalimtrac) &
2554	& .eq.1) then
2555	stop
2556	endif
2557
2558	end subroutine iso_verif_tracnps
2559
2560	subroutine iso_verif_tracpos_choix(x,err_msg,seuil)
2561	USE infotrac_phy, ONLY: ntraciso
2562	implicit none
2563	! vérifier des choses sur les traceurs
2564	! * toutes les zones donne t l'istope total
2565	! * pas de deltaD aberrant
2566
2567	! on prend les valeurs pas défaut pour
2568	! errmax,errmaxrel,ridicule_trac,deltalimtrac
2569
2570	! inputs
2571	real x(ntraciso)
2572	character() err_msg ! message d''erreur à afficher
2573	real seuil
2574
2575	! locals
2576	!integer iso_verif_tracpos_choix_nostop
2577
2578	if (iso_verif_tracpos_choix_nostop(x,err_msg,seuil) &
2579	& .eq.1) then
2580	stop
2581	endif
2582
2583	end subroutine iso_verif_tracpos_choix
2584
2585	subroutine iso_verif_traceur_choix(x,err_msg, &
2586	& errmax,errmaxrel,ridicule_trac_loc,deltalimtrac)
2587	USE infotrac_phy, ONLY: ntraciso
2588	implicit none
2589	! vérifier des choses sur les traceurs
2590	! * toutes les zones donne t l'istope total
2591	! * pas de deltaD aberrant
2592
2593	! inputs
2594	real x(ntraciso)
2595	character() err_msg ! message d''erreur à afficher
2596	real errmax,errmaxrel,ridicule_trac_loc,deltalimtrac
2597
2598	! locals
2599	!integer iso_verif_traceur_choix_nostop
2600
2601	if (iso_verif_traceur_choix_nostop(x,err_msg, &
2602	& errmax,errmaxrel,ridicule_trac_loc,deltalimtrac) &
2603	& .eq.1) then
2604	stop
2605	endif
2606
2607	end subroutine iso_verif_traceur_choix
2608
2609	function iso_verif_traceur_nostop(x,err_msg)
2610	USE infotrac_phy, ONLY: ntraciso
2611	use isotrac_mod, only: ridicule_trac
2612	!use isotopes_verif, only: errmax,errmaxrel,deltalimtrac
2613	implicit none
2614	! vérifier des choses sur les traceurs
2615	! * toutes les zones donne t l'istope total
2616	! * pas de deltaD aberrant
2617
2618	! on prend les valeurs pas défaut pour
2619	! errmax,errmaxrel,ridicule_trac,deltalimtrac
2620
2621	! inputs
2622	real x(ntraciso)
2623	character() err_msg ! message d''erreur à afficher
2624
2625	! output
2626	integer iso_verif_traceur_nostop
2627
2628	! locals
2629	!integer iso_verif_traceur_choix_nostop
2630
2631	iso_verif_traceur_nostop= &
2632	& iso_verif_traceur_choix_nostop(x,err_msg, &
2633	& errmax,errmaxrel,ridicule_trac,deltalimtrac)
2634
2635	end function iso_verif_traceur_nostop
2636
2637
2638	subroutine iso_verif_traceur_justmass(x,err_msg)
2639	USE infotrac_phy, ONLY: ntraciso
2640	implicit none
2641	! on vérifie que noNaN et masse
2642
2643	! on prend les valeurs pas défaut pour
2644	! errmax,errmaxrel,ridicule_trac,deltalimtrac
2645
2646	! inputs
2647	real x(ntraciso)
2648	character() err_msg ! message d''erreur à afficher
2649
2650	! locals
2651	!integer iso_verif_traceur_noNaN_nostop
2652	!integer iso_verif_tracm_choix_nostop
2653
2654	! verif noNaN
2655	if (iso_verif_traceur_noNaN_nostop(x,err_msg).eq.1) then
2656	stop
2657	endif
2658
2659	! verif masse
2660	if (iso_verif_tracm_choix_nostop(x,err_msg, &
2661	& errmax,errmaxrel).eq.1) then
2662	stop
2663	endif
2664
2665	end subroutine iso_verif_traceur_justmass
2666
2667	function iso_verif_traceur_jm_nostop(x,err_msg)
2668	USE infotrac_phy, ONLY: ntraciso
2669	implicit none
2670	! on vérifie que noNaN et masse
2671
2672	! on prend les valeurs pas défaut pour
2673	! errmax,errmaxrel,ridicule_trac,deltalimtrac
2674
2675	! inputs
2676	real x(ntraciso)
2677	character() err_msg ! message d''erreur à afficher
2678
2679	! output
2680	integer iso_verif_traceur_jm_nostop
2681
2682	! locals
2683	! integer iso_verif_traceur_noNaN_nostop
2684	!integer iso_verif_tracm_choix_nostop
2685
2686	iso_verif_traceur_jm_nostop=0
2687	! ! verif noNaN
2688	! if (iso_verif_traceur_noNaN_nostop(x,err_msg).eq.1) then
2689	! iso_verif_traceur_jm_nostop=1
2690	! endif
2691
2692	! verif masse
2693	if (iso_verif_tracm_choix_nostop(x,err_msg, &
2694	& errmax,errmaxrel).eq.1) then
2695	iso_verif_traceur_jm_nostop=1
2696	endif
2697
2698	end function iso_verif_traceur_jm_nostop
2699
2700	subroutine iso_verif_tag17_q_deltaD_vect(x,n,m,err_msg)
2701	USE infotrac_phy, ONLY: index_trac,ntraciso
2702	USE isotopes_mod, ONLY: tnat,iso_eau, ridicule,iso_HDO
2703	use isotrac_mod, only: option_traceurs,nzone_temp
2704	implicit none
2705
2706	! inputs
2707	integer n,m
2708	real x(ntraciso,n,m)
2709	character() err_msg
2710
2711	! locals
2712	!integer iso_verif_positif_nostop
2713	!real deltaD
2714	integer ieau,ixt,ieau1
2715	integer i,k
2716
2717	if ((option_traceurs.eq.17).or. &
2718	& (option_traceurs.eq.18)) then
2719	! verifier que deltaD du tag de la couche la plus haute <
2720	! 200 permil, et vérifier que son q est inférieur à
2721	ieau=index_trac(nzone_temp,iso_eau)
2722	ixt=index_trac(nzone_temp,iso_HDO)
2723	ieau1=index_trac(1,iso_eau)
2724	do i=1,n
2725	do k=1,m
2726	if (x(ieau,i,k).gt.ridicule) then
2727	if ((x(ixt,i,k)/x(ieau,i,k)/tnat(iso_HDO)-1)*1000 &
2728	& .gt.-200.0) then
2729	write(,) err_msg,', vect:deltaDt05 trop fort'
2730	write(,) 'i,k=',i,k
2731	write(,) 'x(:,i,k)=',x(:,i,k)
2732	stop
2733	endif !if (iso_verif_positif_nostop(-200.0-deltaD(x(ixt),x(ieau)),
2734	endif !if (x(ieau).gt.ridicule) then
2735	if (x(ieau,i,k).gt.2.0e-3) then
2736	write(,) err_msg,', vect:qt05 trop fort'
2737	write(,) 'i,k=',i,k
2738	write(,) 'x(:,i,k)=',x(:,i,k)
2739	stop
2740	endif !if (iso_verif_positif_nostop(1.0e-3-x(ieau),
2741	if (x(iso_eau,i,k).lt.2.0e-3) then
2742	if (x(ieau1,i,k)/x(iso_eau,i,k).gt.0.1) then
2743	write(,) err_msg,', vect: qt01 trop abondant'
2744	write(,) 'i,k=',i,k
2745	write(,) 'ieau1,iso_eau,x(ieau1,i,k),', &
2746	& 'x(iso_eau,i,k)=',ieau1,iso_eau, &
2747	& x(ieau1,i,k),x(iso_eau,i,k)
2748	write(,) 'x(:,i,k)=',x(:,i,k)
2749	stop
2750	endif !if (x(ieau1,i,k)/x(iso_eau,i,k).gt.0.1) then
2751	endif
2752	enddo !do k=1,m
2753	enddo !do i=1,n
2754
2755	endif !if (option_traceurs.eq.17) then
2756
2757	end subroutine iso_verif_tag17_q_deltaD_vect
2758
2759
2760	subroutine iso_verif_tag17_q_deltaD_vect_ret3D(x,n,m,nq,err_msg)
2761	USE infotrac_phy, ONLY: index_trac,ntraciso
2762	USE isotopes_mod, ONLY: tnat,iso_eau,iso_HDO,ridicule
2763	use isotrac_mod, only: option_traceurs,nzone_temp
2764	implicit none
2765
2766	! inputs
2767	integer n,m,nq
2768	real x(n,m,nq,ntraciso)
2769	character() err_msg
2770
2771	! locals
2772	!integer iso_verif_positif_nostop
2773	!real deltaD
2774	integer ieau,ixt,ieau1
2775	integer i,k,iq
2776
2777	if ((option_traceurs.eq.17).or. &
2778	& (option_traceurs.eq.18)) then
2779	! verifier que deltaD du tag de la couche la plus haute <
2780	! 200 permil, et vérifier que son q est inférieur à
2781	ieau=index_trac(nzone_temp,iso_eau)
2782	ixt=index_trac(nzone_temp,iso_HDO)
2783	ieau1=index_trac(1,iso_eau)
2784	do iq=1,nq
2785	do i=1,n
2786	do k=1,m
2787	if (x(i,k,iq,ieau).gt.ridicule) then
2788	if ((x(i,k,iq,ixt)/x(i,k,iq,ieau)/tnat(iso_HDO)-1)*1000 &
2789	& .gt.-200.0) then
2790	write(,) err_msg,', vect:deltaDt05 trop fort'
2791	write(,) 'i,k=',i,k
2792	write(,) 'x(i,k,iq,:)=',x(i,k,iq,:)
2793	stop
2794	endif !if (iso_verif_positif_nostop(-200.0-deltaD(x(ixt),x(ieau)),
2795	endif !if (x(ieau).gt.ridicule) then
2796	if (x(i,k,iq,ieau).gt.2.0e-3) then
2797	write(,) err_msg,', vect:qt05 trop fort'
2798	write(,) 'i,k=',i,k
2799	write(,) 'x(i,k,iq,:)=',x(i,k,iq,:)
2800	stop
2801	endif !if (iso_verif_positif_nostop(1.0e-3-x(ieau),
2802	if (x(i,k,iq,iso_eau).lt.2.0e-3) then
2803	if (x(i,k,iq,ieau1)/x(i,k,iq,iso_eau).gt.0.1) then
2804	write(,) err_msg,', vect: qt01 trop abondant'
2805	write(,) 'i,k=',i,k
2806	write(,) 'ieau1,iso_eau,x(i,k,iq,ieau1),', &
2807	& 'x(i,k,iq,ieau)=',ieau1,iso_eau, &
2808	& x(i,k,iq,ieau1),x(i,k,iq,iso_eau)
2809	write(,) 'x(i,k,iq,:)=',x(i,k,iq,:)
2810	stop
2811	endif !if (x(ieau1,i,k)/x(iso_eau,i,k).gt.0.1) then
2812	endif
2813	enddo !do k=1,m
2814	enddo !do i=1,n
2815	enddo ! do iq=1,nq
2816
2817	endif !if (option_traceurs.eq.17) then
2818
2819	end subroutine iso_verif_tag17_q_deltaD_vect_ret3D
2820
2821
2822	#endif
2823	! endif ISOTRAC
2824
2825	END MODULE isotopes_verif_mod
2826
2827	#endif
2828	! endif ISOVERIF
2829

Note: See TracBrowser for help on using the repository browser.

Download in other formats:

Original Format