Context Navigation

isotopes_verif_mod.F90

Last change on this file was 3331, checked in by acozic, 7 years ago
Add modification for isotopes
Property svn:executable set to ``*
File size: 82.3 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	if ((deltaD.lt.deltaDmin).or.(deltao.lt.deltaDmin/2.0).or. &
1042	& (deltaD.gt.deltalim).or.(deltao.gt.deltalim/8.0).or. &
1043	& ((deltaD.gt.-500.0).and.((dexcess.lt.dexcess_min) &
1044	& .or.(dexcess.gt.dexcess_max)))) then
1045	write(,) 'erreur detectee par iso_verif_o18_aberrant:'
1046	write(,) err_msg
1047	write(,) 'delta180=',deltao
1048	write(,) 'deltaD=',deltaD
1049	write(,) 'Dexcess=',dexcess
1050	! stop
1051	iso_verif_o18_aberrant_nostop=1
1052	endif
1053
1054	#ifdef ISOVERIF
1055	#else
1056	write(,) 'err_msg=',err_msg,': pourquoi verif?'
1057	stop
1058	#endif
1059
1060	return
1061	end function iso_verif_o18_aberrant_nostop
1062
1063
1064	! **********
1065	function deltaD(R)
1066	!use infotrac_phy, ONLY: use_iso
1067	USE isotopes_mod, ONLY: tnat,iso_HDO
1068	implicit none
1069	real R,deltaD
1070
1071
1072	if (iso_HDO.gt.0) then
1073	deltaD=(R/tnat(iso_HDO)-1)*1000.0
1074	else
1075	write(,) 'iso_verif_egalite>deltaD 260: iso_HDO.gt.0=', &
1076	& iso_HDO.gt.0
1077	endif
1078	return
1079	end function deltaD
1080
1081	! **********
1082	function deltaO(R)
1083	!use infotrac_phy, ONLY: use_iso
1084	USE isotopes_mod, ONLY: tnat,iso_O18
1085	implicit none
1086	real R,deltaO
1087
1088	if (iso_O18.gt.0) then
1089	deltaO=(R/tnat(iso_O18)-1)*1000.0
1090	else
1091	write(,) 'iso_verif_egalite>deltaO18 260: iso_O18.gt.0=', &
1092	& iso_O18.gt.0
1093	endif
1094	return
1095	end function deltaO
1096
1097	! **********
1098	function delta_all(R,ixt)
1099	USE isotopes_mod, ONLY: tnat
1100	implicit none
1101	real R,delta_all
1102	integer ixt
1103
1104	delta_all=(R/tnat(ixt)-1)*1000.0
1105	return
1106	end function delta_all
1107
1108	! **********
1109	function delta_to_R(delta,ixt)
1110	USE isotopes_mod, ONLY: tnat
1111	implicit none
1112	real delta,delta_to_R
1113	integer ixt
1114
1115	delta_to_R=(delta/1000.0+1.0)*tnat(ixt)
1116	return
1117	end function delta_to_R
1118
1119	! **********
1120	function o17excess(R17,R18)
1121	!use infotrac_phy, ONLY: use_iso
1122	USE isotopes_mod, ONLY: tnat,iso_O18,iso_O17
1123	implicit none
1124	real R17,R18,o17excess
1125
1126	if ((iso_O17.gt.0).and.(iso_O18.gt.0)) then
1127
1128	o17excess=1e6*(log(R17/tnat(iso_o17)) &
1129	& -0.528*log(R18/tnat(iso_o18)))
1130	! write(,) 'o17excess=',o17excess
1131	else
1132	write(,) 'iso_verif_egalite>deltaD 260: iso_O17.gt.0,18=', &
1133	& iso_O17.gt.0,iso_O18.gt.0
1134	endif
1135	return
1136	end function o17excess
1137
1138	! ****************
1139
1140	subroutine iso_verif_egalite_vect2D( &
1141	& xt,q,err_msg,ni,n,m)
1142
1143	!use infotrac_phy, ONLY: use_iso
1144	USE isotopes_mod, ONLY: iso_eau
1145	implicit none
1146
1147	! inputs
1148	integer n,m,ni
1149	real q(n,m)
1150	real xt(ni,n,m)
1151	character() err_msg
1152
1153	! locals
1154	integer iso_verif_egalite_nostop_loc
1155	integer i,j,ixt
1156	integer ifaux,jfaux
1157
1158	!write(,) 'iso_verif_egalite_vect2D 1099 tmp: q(2,1),xt(iso_eau,2,1)=',q(2,1),xt(iso_eau,2,1)
1159	!write(,) 'ni,n,m=',ni,n,m,errmax,errmaxrel
1160	if (iso_eau.gt.0) then
1161	iso_verif_egalite_nostop_loc=0
1162	do i=1,n
1163	do j=1,m
1164	if (abs(q(i,j)-xt(iso_eau,i,j)).gt.errmax) then
1165	if (abs((q(i,j)-xt(iso_eau,i,j))/ &
1166	& max(max(abs(q(i,j)),abs(xt(iso_eau,i,j))),1e-18)) &
1167	& .gt.errmaxrel) then
1168	iso_verif_egalite_nostop_loc=1
1169	ifaux=i
1170	jfaux=j
1171	endif
1172	endif
1173	enddo !do j=1,m
1174	enddo !do i=1,n
1175
1176	if (iso_verif_egalite_nostop_loc.eq.1) then
1177	write(,) 'erreur detectee par iso_verif_egalite_vect2D:'
1178	write(,) err_msg
1179	write(,) 'i,j=',ifaux,jfaux
1180	write(,) 'xt,q=',xt(iso_eau,ifaux,jfaux),q(ifaux,jfaux)
1181	stop
1182	endif
1183	endif
1184
1185	#ifdef ISOVERIF
1186	call iso_verif_noNaN_vect2D(xt,err_msg,ni,n,m)
1187	#endif
1188
1189	return
1190	end subroutine iso_verif_egalite_vect2D
1191
1192	subroutine iso_verif_egalite_vect1D( &
1193	& xt,q,err_msg,ni,n)
1194
1195	!use infotrac_phy, ONLY: use_iso
1196	USE isotopes_mod, ONLY: iso_eau
1197	implicit none
1198
1199	! inputs
1200	integer n,ni
1201	real q(n)
1202	real xt(ni,n)
1203	character() err_msg
1204
1205	! locals
1206	integer iso_verif_egalite_nostop_loc
1207	integer i
1208	integer ifaux
1209
1210	if (iso_eau.gt.0) then
1211	iso_verif_egalite_nostop_loc=0
1212	do i=1,n
1213	if (abs(q(i)-xt(iso_eau,i)).gt.errmax) then
1214	if (abs((q(i)-xt(iso_eau,i))/ &
1215	& max(max(abs(q(i)),abs(xt(iso_eau,i))),1e-18)) &
1216	& .gt.errmaxrel) then
1217	iso_verif_egalite_nostop_loc=1
1218	ifaux=i
1219	endif !if (abs((q(i)-xt(iso_eau,i))/
1220	endif !if (abs(q(i)-xt(iso_eau,i)).gt.errmax) then
1221	enddo !do i=1,n
1222
1223	if (iso_verif_egalite_nostop_loc.eq.1) then
1224	write(,) 'erreur detectee par iso_verif_egalite_vect2D:'
1225	write(,) err_msg
1226	write(,) 'i=',ifaux
1227	write(,) 'xt,q=',xt(iso_eau,ifaux),q(ifaux)
1228	stop
1229	endif !if (iso_verif_egalite_nostop.eq.1) then
1230	endif !if (iso_eau.gt.0) then
1231
1232	end subroutine iso_verif_egalite_vect1D
1233
1234	subroutine iso_verif_egalite_std_vect( &
1235	& a,b,err_msg,n,m,errmax,errmaxrel)
1236
1237	implicit none
1238
1239	! inputs
1240	integer n,m,ni
1241	real a(n,m)
1242	real b(n,m)
1243	character() err_msg
1244	real errmax,errmaxrel
1245
1246	! locals
1247	integer iso_verif_egalite_nostop_loc
1248	integer i,j
1249	integer ifaux,jfaux
1250
1251	iso_verif_egalite_nostop_loc=0
1252	do i=1,n
1253	do j=1,m
1254	if (abs(a(i,j)-b(i,j)).gt.errmax) then
1255	if (abs((a(i,j)-b(i,j))/ &
1256	& max(max(abs(a(i,j)),abs(b(i,j))),1e-18)) &
1257	& .gt.errmaxrel) then
1258	iso_verif_egalite_nostop_loc=1
1259	ifaux=i
1260	jfaux=j
1261	endif
1262	endif
1263	enddo !do j=1,m
1264	enddo !do i=1,n
1265
1266	if (iso_verif_egalite_nostop_loc.eq.1) then
1267	write(,) 'erreur detectee par iso_verif_egalite_vect2D:'
1268	write(,) err_msg
1269	write(,) 'i,j=',ifaux,jfaux
1270	write(,) 'a,b=',a(ifaux,jfaux),b(ifaux,jfaux)
1271	stop
1272	endif
1273
1274	return
1275	end subroutine iso_verif_egalite_std_vect
1276
1277	subroutine iso_verif_aberrant_vect2D( &
1278	& xt,q,err_msg,ni,n,m)
1279	!use infotrac_phy, ONLY: use_iso
1280	use isotopes_mod, ONLY: ridicule,tnat,iso_HDO
1281	implicit none
1282
1283	! inputs
1284	integer n,m,ni
1285	real q(n,m)
1286	real xt(ni,n,m)
1287	character() err_msg
1288
1289	! locals
1290	integer iso_verif_aberrant_nostop_loc
1291	integer i,j
1292	integer ifaux,jfaux
1293	!real deltaD
1294
1295	if (iso_HDO.gt.0) then
1296	iso_verif_aberrant_nostop_loc=0
1297	do i=1,n
1298	do j=1,m
1299	if (q(i,j).gt.ridicule) then
1300	if (((xt(iso_HDO,i,j)/q(i,j)/tnat(iso_HDO)-1)*1000.0 &
1301	& .gt.deltalim).or. &
1302	& ((xt(iso_HDO,i,j)/q(i,j)/tnat(iso_HDO)-1)*1000.0 &
1303	& .lt.-borne)) then
1304	iso_verif_aberrant_nostop_loc=1
1305	ifaux=i
1306	jfaux=j
1307	endif
1308	endif
1309	enddo !do j=1,m
1310	enddo !do i=1,n
1311
1312	if (iso_verif_aberrant_nostop_loc.eq.1) then
1313	write(,) 'erreur detectee par iso_verif_aberrant_vect2D:'
1314	write(,) err_msg
1315	write(,) 'i,j=',ifaux,jfaux
1316	write(,) 'deltaD=',deltaD(xt(iso_HDO,ifaux,jfaux) &
1317	& /q(ifaux,jfaux))
1318	write(,) 'xt(:,ifaux,jfaux)=',xt(:,ifaux,jfaux)
1319	stop
1320	endif
1321	endif !if (iso_HDO.gt.0) then
1322
1323	end subroutine iso_verif_aberrant_vect2D
1324
1325	subroutine iso_verif_aberrant_enc_vect2D( &
1326	& xt,q,err_msg,ni,n,m)
1327
1328	!use infotrac_phy, ONLY: use_iso
1329	use isotopes_mod, ONLY: ridicule,tnat,iso_HDO
1330	implicit none
1331
1332	! inputs
1333	integer n,m,ni
1334	real q(n,m)
1335	real xt(ni,n,m)
1336	character() err_msg
1337
1338	! locals
1339	integer iso_verif_aberrant_nostop_loc
1340	integer i,j
1341	integer ifaux,jfaux
1342	!real deltaD
1343
1344	if (iso_HDO.gt.0) then
1345	iso_verif_aberrant_nostop_loc=0
1346	do i=1,n
1347	do j=1,m
1348	if (q(i,j).gt.ridicule) then
1349	if (((xt(iso_HDO,i,j)/q(i,j)/tnat(iso_HDO)-1)*1000.0 &
1350	& .gt.deltalim).or. &
1351	& ((xt(iso_HDO,i,j)/q(i,j)/tnat(iso_HDO)-1)*1000.0 &
1352	& .lt.deltaDmin).or. &
1353	& (xt(iso_HDO,i,j).lt.-borne).or. &
1354	& (xt(iso_HDO,i,j).gt.borne)) then
1355	iso_verif_aberrant_nostop_loc=1
1356	ifaux=i
1357	jfaux=j
1358	endif
1359	endif
1360	enddo !do j=1,m
1361	enddo !do i=1,n
1362
1363	if (iso_verif_aberrant_nostop_loc.eq.1) then
1364	write(,) 'erreur detectee par ', &
1365	& 'iso_verif_aberrant_enc_vect2D:'
1366	write(,) err_msg
1367	write(,) 'i,j=',ifaux,jfaux
1368	write(,) 'deltaD=',deltaD(xt(iso_HDO,ifaux,jfaux) &
1369	& /q(ifaux,jfaux))
1370	write(,) 'xt(:,ifaux,jfaux)=',xt(:,ifaux,jfaux)
1371	write(,) 'q(ifaux,jfaux)=',q(ifaux,jfaux)
1372	call abort_physic('isotopes_verif_mod','iso_verif_aberrant_enc_vect2D',1)
1373	endif
1374	endif !if (iso_HDO.gt.0) then
1375
1376	end subroutine iso_verif_aberrant_enc_vect2D
1377
1378
1379	subroutine iso_verif_aberrant_enc_vect2D_ns( &
1380	& xt,q,err_msg,ni,n,m)
1381
1382	!use infotrac_phy, ONLY: use_iso
1383	use isotopes_mod, ONLY: ridicule,tnat,iso_HDO
1384	implicit none
1385
1386	! inputs
1387	integer n,m,ni
1388	real q(n,m)
1389	real xt(ni,n,m)
1390	character() err_msg
1391
1392	! locals
1393	integer iso_verif_aberrant_nostop_loc
1394	integer i,j
1395	integer ifaux,jfaux
1396	!real deltaD
1397
1398	if (iso_HDO.gt.0) then
1399	iso_verif_aberrant_nostop_loc=0
1400	do i=1,n
1401	do j=1,m
1402	if (q(i,j).gt.ridicule) then
1403	if (((xt(iso_HDO,i,j)/q(i,j)/tnat(iso_HDO)-1)*1000.0 &
1404	& .gt.deltalim).or. &
1405	& ((xt(iso_HDO,i,j)/q(i,j)/tnat(iso_HDO)-1)*1000.0 &
1406	& .lt.deltaDmin)) then
1407	iso_verif_aberrant_nostop_loc=1
1408	ifaux=i
1409	jfaux=j
1410	endif
1411	endif
1412	enddo !do j=1,m
1413	enddo !do i=1,n
1414
1415	if (iso_verif_aberrant_nostop_loc.eq.1) then
1416	write(,) 'erreur detectee par ', &
1417	& 'iso_verif_aberrant_vect2D_ns:'
1418	write(,) err_msg
1419	write(,) 'i,j=',ifaux,jfaux
1420	write(,) 'deltaD=',deltaD(xt(iso_HDO,ifaux,jfaux) &
1421	& /q(ifaux,jfaux))
1422	write(,) 'xt(:,ifaux,jfaux)=',xt(:,ifaux,jfaux)
1423	! stop
1424	endif
1425	endif !if (iso_HDO.gt.0) then
1426
1427	end subroutine iso_verif_aberrant_enc_vect2D_ns
1428
1429
1430	subroutine iso_verif_aberrant_vect2Dch( &
1431	& xt,q,err_msg,ni,n,m,deltaDmax)
1432
1433	!use infotrac_phy, ONLY: use_iso
1434	use isotopes_mod, ONLY: ridicule,tnat,iso_HDO
1435	implicit none
1436
1437
1438	! inputs
1439	integer n,m,ni
1440	real q(n,m)
1441	real xt(ni,n,m)
1442	character() err_msg
1443	real deltaDmax
1444
1445	! locals
1446	integer iso_verif_aberrant_nostop_loc
1447	integer i,j
1448	integer ifaux,jfaux
1449	!real deltaD
1450
1451	if (iso_HDO.gt.0) then
1452	iso_verif_aberrant_nostop_loc=0
1453	do i=1,n
1454	do j=1,m
1455	if (q(i,j).gt.ridicule) then
1456	if (((xt(iso_HDO,i,j)/q(i,j)/tnat(iso_HDO)-1)*1000.0 &
1457	& .gt.deltaDmax).or. &
1458	& ((xt(iso_HDO,i,j)/q(i,j)/tnat(iso_HDO)-1)*1000.0 &
1459	& .lt.-borne)) then
1460	iso_verif_aberrant_nostop_loc=1
1461	ifaux=i
1462	jfaux=j
1463	endif
1464	endif
1465	enddo !do j=1,m
1466	enddo !do i=1,n
1467
1468	if (iso_verif_aberrant_nostop_loc.eq.1) then
1469	write(,) 'erreur detectee par iso_verif_aberrant_vect2D:'
1470	write(,) err_msg
1471	write(,) 'i,j=',ifaux,jfaux
1472	write(,) 'deltaD=',deltaD(xt(iso_HDO,ifaux,jfaux) &
1473	& /q(ifaux,jfaux))
1474	write(,) 'xt(:,ifaux,jfaux)=',xt(:,ifaux,jfaux)
1475	stop
1476	endif
1477	endif !if (iso_HDO.gt.0) then
1478
1479	end subroutine iso_verif_aberrant_vect2Dch
1480
1481	subroutine iso_verif_o18_aberrant_enc_vect2D( &
1482	& xt,q,err_msg,ni,n,m)
1483
1484	!use infotrac_phy, ONLY: use_iso
1485	use isotopes_mod, ONLY: ridicule,tnat,iso_HDO,iso_O18
1486	implicit none
1487
1488	! inputs
1489	integer n,m,ni
1490	real q(n,m)
1491	real xt(ni,n,m)
1492	character() err_msg
1493
1494	! locals
1495	integer iso_verif_aberrant_nostop_loc
1496	integer i,j
1497	integer ifaux,jfaux
1498	real deltaDloc,deltaoloc,dexcessloc
1499
1500	if ((iso_HDO.gt.0).and.(iso_O18.gt.0)) then
1501	iso_verif_aberrant_nostop_loc=0
1502	do i=1,n
1503	do j=1,m
1504	if (q(i,j).gt.ridicule) then
1505
1506	deltaDloc=(xt(iso_HDO,i,j)/q(i,j)/tnat(iso_hdo)-1)*1000
1507	deltaoloc=(xt(iso_O18,i,j)/q(i,j)/tnat(iso_O18)-1)*1000
1508	dexcessloc=deltaDloc-8*deltaoloc
1509	if ((deltaDloc.lt.deltaDmin).or.(deltaoloc.lt.deltaDmin/2.0).or. &
1510	& (deltaDloc.gt.deltalim).or.(deltaoloc.gt.deltalim/8.0).or. &
1511	& ((deltaDloc.gt.-500.0).and.((dexcessloc.lt.dexcess_min) &
1512	& .or.(dexcessloc.gt.dexcess_max)))) then
1513	iso_verif_aberrant_nostop_loc=1
1514	ifaux=i
1515	jfaux=j
1516	write(,) 'deltaD,deltao,dexcess=',deltaDloc,deltaoloc,dexcessloc
1517	endif
1518	endif
1519	enddo !do j=1,m
1520	enddo !do i=1,n
1521
1522	if (iso_verif_aberrant_nostop_loc.eq.1) then
1523	write(,) 'erreur detectee par ', &
1524	& 'iso_verif_aberrant_enc_vect2D:'
1525	write(,) err_msg
1526	write(,) 'i,j=',ifaux,jfaux
1527	write(,) 'xt(:,ifaux,jfaux)=',xt(:,ifaux,jfaux)
1528	write(,) 'q(ifaux,jfaux)=',q(ifaux,jfaux)
1529	call abort_physic('isotopes_verif_mod','iso_verif_aberrant_enc_vect2D',1)
1530	endif
1531	endif !if (iso_HDO.gt.0) then
1532
1533	end subroutine iso_verif_o18_aberrant_enc_vect2D
1534
1535
1536	subroutine select_dim23_from4D(n1,n2,n3,n4, &
1537	& var,vec,i1,i4)
1538	implicit none
1539
1540	! inputs
1541	integer n1,n2,n3,n4
1542	real var(n1,n2,n3,n4)
1543	integer i1,i4
1544	! outputs
1545	real vec(n2,n3)
1546	! locals
1547	integer i2,i3
1548
1549	do i2=1,n2
1550	do i3=1,n3
1551	vec(i2,i3)=var(i1,i2,i3,i4)
1552	enddo
1553	enddo
1554
1555	return
1556	end subroutine select_dim23_from4D
1557
1558
1559	subroutine select_dim4_from4D(ntime,nlev,nlat,nlon, &
1560	& var,vec,itime,ilev,ilat)
1561	implicit none
1562
1563	! inputs
1564	integer ntime,nlev,nlat,nlon
1565	real var(ntime,nlev,nlat,nlon)
1566	integer itime,ilev,ilat
1567	! outputs
1568	real vec(nlon)
1569	! locals
1570	integer ilon
1571
1572	do ilon=1,nlon
1573	vec(ilon)=var(itime,ilev,ilat,ilon)
1574	enddo
1575
1576	return
1577	end subroutine select_dim4_from4D
1578
1579	subroutine select_dim5_from5D(n1,n2,n3,n4,n5, &
1580	& var,vec,i1,i2,i3,i4)
1581	implicit none
1582
1583	! inputs
1584	integer n1,n2,n3,n4,n5
1585	real var(n1,n2,n3,n4,n5)
1586	integer i1,i2,i3,i4
1587	! outputs
1588	real vec(n5)
1589	! locals
1590	integer i5
1591
1592	do i5=1,n5
1593	vec(i5)=var(i1,i2,i3,i4,i5)
1594	enddo
1595
1596	end subroutine select_dim5_from5D
1597
1598
1599	subroutine select_dim3_from3D(ntime,nlat,nlon, &
1600	& var,vec,itime,ilat)
1601	implicit none
1602
1603	! inputs
1604	integer ntime,nlat,nlon
1605	real var(ntime,nlat,nlon)
1606	integer itime,ilat
1607	! outputs
1608	real vec(nlon)
1609	! locals
1610	integer ilon
1611
1612	do ilon=1,nlon
1613	vec(ilon)=var(itime,ilat,ilon)
1614	enddo
1615
1616	end subroutine select_dim3_from3D
1617
1618
1619	subroutine select_dim23_from3D(n1,n2,n3, &
1620	& var,vec,i1)
1621	implicit none
1622
1623	! inputs
1624	integer n1,n2,n3
1625	real var(n1,n2,n3)
1626	integer i1
1627	! outputs
1628	real vec(n2,n3)
1629	! locals
1630	integer i2,i3
1631
1632	do i2=1,n2
1633	do i3=1,n3
1634	vec(i2,i3)=var(i1,i2,i3)
1635	enddo
1636	enddo
1637
1638	end subroutine select_dim23_from3D
1639
1640	subroutine putinto_dim23_from4D(n1,n2,n3,n4, &
1641	& var,vec,i1,i4)
1642	implicit none
1643
1644	! inputs
1645	integer n1,n2,n3,n4
1646	real vec(n2,n3)
1647	integer i1,i4
1648	! inout
1649	real var(n1,n2,n3,n4)
1650	! locals
1651	integer i2,i3
1652
1653	do i2=1,n2
1654	do i3=1,n3
1655	var(i1,i2,i3,i4)=vec(i2,i3)
1656	enddo
1657	enddo
1658
1659	end subroutine putinto_dim23_from4D
1660
1661
1662	subroutine putinto_dim12_from4D(n1,n2,n3,n4, &
1663	& var,vec,i3,i4)
1664	implicit none
1665
1666	! inputs
1667	integer n1,n2,n3,n4
1668	real vec(n1,n2)
1669	integer i3,i4
1670	! inout
1671	real var(n1,n2,n3,n4)
1672	! locals
1673	integer i1,i2
1674
1675	do i1=1,n1
1676	do i2=1,n2
1677	var(i1,i2,i3,i4)=vec(i1,i2)
1678	enddo
1679	enddo
1680
1681	end subroutine putinto_dim12_from4D
1682
1683	subroutine putinto_dim23_from3D(n1,n2,n3, &
1684	& var,vec,i1)
1685	implicit none
1686
1687	! inputs
1688	integer n1,n2,n3
1689	real vec(n2,n3)
1690	integer i1
1691	! inout
1692	real var(n1,n2,n3)
1693	! locals
1694	integer i2,i3
1695
1696	do i2=1,n2
1697	do i3=1,n3
1698	var(i1,i2,i3)=vec(i2,i3)
1699	enddo
1700	enddo
1701
1702	end subroutine putinto_dim23_from3D
1703
1704
1705
1706	subroutine iso_verif_noNaN_par2D(x,err_msg,ni,n,m,ib,ie)
1707	implicit none
1708	! si x est NaN, on affiche message
1709	! d'erreur et return 1 si erreur
1710
1711	! input:
1712	integer n,m,ni,ib,ie
1713	real x(ni,n,m)
1714	character() err_msg ! message d''erreur à afficher
1715
1716	! output
1717
1718	! locals
1719	integer i,j,ixt
1720
1721	do i=ib,ie
1722	do j=1,m
1723	do ixt=1,ni
1724	if ((x(ixt,i,j).gt.-borne).and. &
1725	& (x(ixt,i,j).lt.borne)) then
1726	else !if ((x(ixt,i,j).gt.-borne).and.
1727	write(,) 'erreur detectee par iso_verif_nonNAN:'
1728	write(,) err_msg
1729	write(,) 'x,ixt,i,j=',x(ixt,i,j),ixt,i,j
1730	stop
1731	endif !if ((x(ixt,i,j).gt.-borne).and.
1732	enddo !do ixt=1,ni
1733	enddo !do j=1,m
1734	enddo !do i=1,n
1735
1736	#ifdef ISOVERIF
1737	#else
1738	write(,) 'err_msg iso1772=',err_msg,': pourquoi verif?'
1739	stop
1740	#endif
1741
1742	return
1743	end subroutine iso_verif_noNaN_par2D
1744
1745
1746	subroutine iso_verif_aberrant_enc_par2D( &
1747	& xt,q,err_msg,ni,n,m,ib,ie)
1748
1749	!use infotrac_phy, ONLY: use_iso
1750	use isotopes_mod, ONLY: ridicule,tnat,iso_HDO
1751	implicit none
1752
1753	! inputs
1754	integer n,m,ni,ib,ie
1755	real q(n,m)
1756	real xt(ni,n,m)
1757	character() err_msg
1758
1759	! locals
1760	integer iso_verif_aberrant_nostop_loc
1761	integer i,j
1762	integer ifaux,jfaux
1763	!real deltaD
1764
1765	if (iso_HDO.gt.0) then
1766	iso_verif_aberrant_nostop_loc=0
1767	do i=ib,ie
1768	do j=1,m
1769	if (q(i,j).gt.ridicule) then
1770	if (((xt(iso_HDO,i,j)/q(i,j)/tnat(iso_HDO)-1)*1000.0 &
1771	& .gt.deltalim).or. &
1772	& ((xt(iso_HDO,i,j)/q(i,j)/tnat(iso_HDO)-1)*1000.0 &
1773	& .lt.deltaDmin)) then
1774	iso_verif_aberrant_nostop_loc=1
1775	ifaux=i
1776	jfaux=j
1777	endif
1778	endif
1779	enddo !do j=1,m
1780	enddo !do i=1,n
1781
1782	if (iso_verif_aberrant_nostop_loc.eq.1) then
1783	write(,) 'erreur detectee par iso_verif_aberrant_par2D:'
1784	write(,) err_msg
1785	write(,) 'i,j=',ifaux,jfaux
1786	write(,) 'deltaD=',deltaD(xt(iso_HDO,ifaux,jfaux) &
1787	& /q(ifaux,jfaux))
1788	write(,) 'xt(:,ifaux,jfaux)=',xt(:,ifaux,jfaux)
1789	write(,) 'q(ifaux,jfaux)=',q(ifaux,jfaux)
1790	stop
1791	endif
1792	endif !if (iso_HDO.gt.0) then
1793
1794	end subroutine iso_verif_aberrant_enc_par2D
1795
1796
1797	subroutine iso_verif_egalite_par2D( &
1798	& xt,q,err_msg,ni,n,m,ib,ie)
1799
1800	!use infotrac_phy, ONLY: use_iso
1801	USE isotopes_mod, ONLY: iso_eau
1802	implicit none
1803
1804	! inputs
1805	integer n,m,ni,ib,ie
1806	real q(n,m)
1807	real xt(ni,n,m)
1808	character() err_msg
1809
1810	! locals
1811	integer iso_verif_egalite_nostop_loc
1812	integer i,j
1813	integer ifaux,jfaux
1814
1815	if (iso_eau.gt.0) then
1816	iso_verif_egalite_nostop_loc=0
1817	do i=ib,ie
1818	do j=1,m
1819	if (abs(q(i,j)-xt(iso_eau,i,j)).gt.errmax) then
1820	if (abs((q(i,j)-xt(iso_eau,i,j))/ &
1821	& max(max(abs(q(i,j)),abs(xt(iso_eau,i,j))),1e-18)) &
1822	& .gt.errmaxrel) then
1823	iso_verif_egalite_nostop_loc=1
1824	ifaux=i
1825	jfaux=j
1826	endif
1827	endif
1828	enddo !do j=1,m
1829	enddo !do i=1,n
1830
1831	if (iso_verif_egalite_nostop_loc.eq.1) then
1832	write(,) 'erreur detectee par iso_verif_egalite_vect2D:'
1833	write(,) err_msg
1834	write(,) 'i,j=',ifaux,jfaux
1835	write(,) 'xt,q=',xt(iso_eau,ifaux,jfaux),q(ifaux,jfaux)
1836	stop
1837	endif
1838	endif
1839
1840	end subroutine iso_verif_egalite_par2D
1841
1842	#ifdef ISOTRAC
1843
1844	function iso_verif_traceur_choix_nostop(x,err_msg, &
1845	& errmax,errmaxrel,ridicule_trac,deltalimtrac)
1846	USE infotrac_phy, ONLY: ntraciso
1847	use isotopes_mod, ONLY: iso_HDO
1848	implicit none
1849	! vérifier des choses sur les traceurs
1850	! * toutes les zones donne t l'istope total
1851	! * pas de deltaD aberrant
1852
1853	! inputs
1854	real x(ntraciso)
1855	character() err_msg ! message d''erreur à afficher
1856	real errmax,errmaxrel,ridicule_trac,deltalimtrac
1857
1858	! output
1859	integer iso_verif_traceur_choix_nostop
1860
1861	! locals
1862	!integer iso_verif_traceur_noNaN_nostop
1863	!integer iso_verif_tracm_choix_nostop
1864	!integer iso_verif_tracdD_choix_nostop
1865	!integer iso_verif_tracpos_choix_nostop
1866
1867	iso_verif_traceur_choix_nostop=0
1868
1869	! verif noNaN
1870	if (iso_verif_traceur_noNaN_nostop(x,err_msg).eq.1) then
1871	iso_verif_traceur_choix_nostop=1
1872	endif
1873
1874	! verif masse
1875	if (iso_verif_tracm_choix_nostop(x,err_msg, &
1876	& errmax,errmaxrel).eq.1) then
1877	iso_verif_traceur_choix_nostop=1
1878	endif
1879
1880	! verif deltaD
1881	if (iso_HDO.gt.0) then
1882	if (iso_verif_tracdD_choix_nostop(x,err_msg, &
1883	& ridicule_trac,deltalimtrac).eq.1) then
1884	iso_verif_traceur_choix_nostop=1
1885	endif
1886	endif !if (iso_HDO.gt.0) then
1887
1888	! verif pas aberramment negatif
1889	if (iso_verif_tracpos_choix_nostop(x,err_msg, &
1890	& 1e-5).eq.1) then
1891	iso_verif_traceur_choix_nostop=1
1892	endif
1893
1894	end function iso_verif_traceur_choix_nostop
1895
1896	function iso_verif_tracnps_choix_nostop(x,err_msg, &
1897	& errmax,errmaxrel,ridicule_trac,deltalimtrac)
1898	USE infotrac_phy, ONLY: ntraciso
1899	USE isotopes_mod, ONLY: iso_HDO
1900	implicit none
1901	! vérifier des choses sur les traceurs
1902	! * toutes les zones donne t l'istope total
1903	! * pas de deltaD aberrant
1904	! on ne vérfie pas la positivité
1905
1906	! inputs
1907	real x(ntraciso)
1908	character() err_msg ! message d''erreur à afficher
1909	real errmax,errmaxrel,ridicule_trac,deltalimtrac
1910
1911	! output
1912	integer iso_verif_tracnps_choix_nostop
1913
1914	! locals
1915	!integer iso_verif_traceur_noNaN_nostop
1916	!integer iso_verif_tracm_choix_nostop
1917	!integer iso_verif_tracdD_choix_nostop
1918
1919	iso_verif_tracnps_choix_nostop=0
1920
1921	! verif noNaN
1922	if (iso_verif_traceur_noNaN_nostop(x,err_msg).eq.1) then
1923	iso_verif_tracnps_choix_nostop=1
1924	endif
1925
1926	! verif masse
1927	if (iso_verif_tracm_choix_nostop(x,err_msg, &
1928	& errmax,errmaxrel).eq.1) then
1929	iso_verif_tracnps_choix_nostop=1
1930	endif
1931
1932	! verif deltaD
1933	if (iso_HDO.gt.0) then
1934	if (iso_verif_tracdD_choix_nostop(x,err_msg, &
1935	& ridicule_trac,deltalimtrac).eq.1) then
1936	iso_verif_tracnps_choix_nostop=1
1937	endif
1938	endif ! if (iso_HDO.gt.0) then
1939
1940	return
1941	end function iso_verif_tracnps_choix_nostop
1942
1943	function iso_verif_tracpos_choix_nostop(x,err_msg,seuil)
1944	use infotrac_phy, ONLY: ntraciso,niso
1945	use isotrac_mod, only: index_iso,strtrac,index_zone
1946	use isotopes_mod, only: striso
1947	implicit none
1948
1949	! inputs
1950	real x(ntraciso)
1951	character() err_msg ! message d''erreur à afficher
1952	real seuil
1953
1954	! output
1955	integer iso_verif_tracpos_choix_nostop
1956
1957	! locals
1958	integer lnblnk
1959	integer iiso,ixt
1960	!integer iso_verif_positif_choix_nostop
1961
1962	iso_verif_tracpos_choix_nostop=0
1963
1964	do ixt=niso+1,ntraciso
1965	iiso=index_iso(ixt)
1966	if (iso_verif_positif_choix_nostop(x(ixt),seuil,err_msg// &
1967	& ', verif positif, iso'//striso(iiso) &
1968	& //strtrac(index_zone(ixt))).eq.1) then
1969	iso_verif_tracpos_choix_nostop=1
1970	endif
1971	enddo
1972
1973	end function iso_verif_tracpos_choix_nostop
1974
1975
1976	function iso_verif_traceur_noNaN_nostop(x,err_msg)
1977	use infotrac_phy, ONLY: ntraciso,niso
1978	use isotrac_mod, only: index_iso
1979	use isotopes_mod, only: striso
1980	implicit none
1981
1982	! on vérifie juste que pas NaN
1983	! inputs
1984	real x(ntraciso)
1985	character() err_msg ! message d''erreur à afficher
1986
1987	! output
1988	integer iso_verif_traceur_noNaN_nostop
1989
1990	! locals
1991	integer lnblnk
1992	integer iiso,ixt
1993	!integer iso_verif_nonaN_nostop
1994
1995	iso_verif_traceur_noNaN_nostop=0
1996
1997	do ixt=niso+1,ntraciso
1998	iiso=index_iso(ixt)
1999	! write(,) 'iso_verif_traceurs 154: iiso,ixt=',iiso,ixt
2000	if (iso_verif_noNaN_nostop(x(ixt),err_msg// &
2001	& ', verif trac no NaN, iso'//striso(iiso)) &
2002	& .eq.1) then
2003	iso_verif_traceur_noNaN_nostop=1
2004	endif
2005	enddo
2006
2007	end function iso_verif_traceur_noNaN_nostop
2008
2009	function iso_verif_tracm_choix_nostop(x,err_msg, &
2010	& errmaxin,errmaxrelin)
2011
2012	use infotrac_phy, ONLY: index_trac,ntraciso,niso
2013	use isotopes_mod, ONLY: ridicule,striso
2014	use isotrac_mod, only: ntraceurs_zone
2015	! on vérifie juste bilan de masse
2016	implicit none
2017
2018	! inputs
2019	real x(ntraciso)
2020	character() err_msg ! message d''erreur à afficher
2021	real errmaxin,errmaxrelin
2022
2023	! output
2024	integer iso_verif_tracm_choix_nostop
2025
2026	! locals
2027	!integer iso_verif_egalite_choix_nostop
2028	integer iiso,izone,ixt
2029	real xtractot
2030
2031	iso_verif_tracm_choix_nostop=0
2032
2033	do iiso=1,niso
2034
2035	xtractot=0.0
2036	do izone=1,ntraceurs_zone
2037	ixt=index_trac(izone,iiso)
2038	xtractot=xtractot+x(ixt)
2039	enddo !do izone=1,ntraceurs_zone
2040
2041	if (iso_verif_egalite_choix_nostop(xtractot,x(iiso), &
2042	& err_msg//', verif trac egalite, iso '//striso(iiso), &
2043	& errmaxin,errmaxrelin).eq.1) then
2044	write(,) 'iso_verif_traceur 202: x=',x
2045	! write(,) 'xtractot=',xtractot
2046	iso_verif_tracm_choix_nostop=1
2047	endif
2048
2049	! verif ajoutée le 19 fev 2011
2050	if ((abs(xtractot).lt.ridicule**2).and. &
2051	& (abs(x(iiso)).gt.ridicule)) then
2052	write(,) err_msg,', verif masse traceurs, iso ', &
2053	& striso(iiso)
2054	write(,) 'iso_verif_traceur 209: x=',x
2055	! iso_verif_tracm_choix_nostop=1
2056	endif
2057
2058	enddo !do iiso=1,ntraceurs_iso
2059
2060	end function iso_verif_tracm_choix_nostop
2061
2062	function iso_verif_tracdD_choix_nostop(x,err_msg, &
2063	& ridicule_trac,deltalimtrac)
2064
2065	use infotrac_phy, ONLY: index_trac,ntraciso
2066	USE isotopes_mod, ONLY: iso_eau, iso_HDO
2067	use isotrac_mod, only: strtrac,ntraceurs_zone
2068	! on vérifie juste deltaD
2069	implicit none
2070
2071	! inputs
2072	real x(ntraciso)
2073	character() err_msg ! message d''erreur à afficher
2074	real ridicule_trac,deltalimtrac
2075
2076	! output
2077	integer iso_verif_tracdD_choix_nostop
2078
2079	! locals
2080	integer izone,ieau,ixt
2081	!integer iso_verif_aberrant_choix_nostop
2082
2083	iso_verif_tracdD_choix_nostop=0
2084
2085	if ((iso_eau.gt.0).and.(iso_HDO.gt.0)) then
2086	do izone=1,ntraceurs_zone
2087	ieau=index_trac(izone,iso_eau)
2088	ixt=index_trac(izone,iso_HDO)
2089
2090	if (iso_verif_aberrant_choix_nostop(x(ixt),x(ieau), &
2091	& ridicule_trac,deltalimtrac,err_msg// &
2092	& ', verif trac no aberrant zone '//strtrac(izone)) &
2093	& .eq.1) then
2094	iso_verif_tracdD_choix_nostop=1
2095	endif
2096	! if (x(ieau).gt.ridicule) then
2097	! call iso_verif_aberrant(x(ixt)/x(ieau),
2098	! : err_msg//', verif trac no aberrant zone '
2099	! : //strtrac(izone))
2100	! endif
2101	enddo !do izone=1,ntraceurs_zone
2102	endif ! if ((iso_eau.gt.0).and.(iso_HDO.gt.0)) then
2103
2104	end function iso_verif_tracdD_choix_nostop
2105
2106	subroutine iso_verif_trac17_q_deltaD(x,err_msg)
2107	use isotrac_mod, only: nzone_temp,option_traceurs
2108	USE infotrac_phy, ONLY: ntraciso
2109	implicit none
2110
2111	! inputs
2112	real x(ntraciso)
2113	character() err_msg
2114	! local
2115	integer iso_verif_tag17_q_deltaD_chns
2116
2117	if ((option_traceurs.eq.17).or. &
2118	& (option_traceurs.eq.18)) then
2119	if (nzone_temp.ge.5) then
2120	if (iso_verif_tag17_q_deltaD_chns(x,err_msg).eq.1) then
2121	stop
2122	endif
2123	endif
2124	endif !if (option_traceurs.eq.17) then
2125
2126	end subroutine iso_verif_trac17_q_deltaD
2127
2128	subroutine iso_verif_traceur(x,err_msg)
2129	USE infotrac_phy, ONLY: ntraciso
2130	use isotrac_mod, only: ridicule_trac
2131	implicit none
2132	! vérifier des choses sur les traceurs
2133	! * toutes les zones donne t l'istope total
2134	! * pas de deltaD aberrant
2135
2136	! on prend les valeurs pas défaut pour
2137	! errmax,errmaxrel,ridicule_trac,deltalimtrac
2138
2139	! inputs
2140	real x(ntraciso)
2141	character() err_msg ! message d''erreur à afficher
2142
2143	! locals
2144	!integer iso_verif_traceur_choix_nostop
2145
2146	if (iso_verif_traceur_choix_nostop(x,err_msg, &
2147	& errmax,errmaxrel,ridicule_trac,deltalimtrac) &
2148	& .eq.1) then
2149	stop
2150	endif
2151
2152	end subroutine iso_verif_traceur
2153
2154
2155	subroutine iso_verif_traceur_retourne3D(x,n1,n2,n3, &
2156	& i1,i2,i3,err_msg)
2157	USE infotrac_phy, ONLY: ntraciso
2158	use isotrac_mod, only: ridicule_trac
2159
2160	implicit none
2161	! vérifier des choses sur les traceurs
2162	! * toutes les zones donne t l'istope total
2163	! * pas de deltaD aberrant
2164
2165	! on prend les valeurs pas défaut pour
2166	! errmax,errmaxrel,ridicule_trac,deltalimtrac
2167
2168	! inputs
2169	integer n1,n2,n3
2170	real x(n1,n2,n3,ntraciso)
2171	character() err_msg ! message d''erreur à afficher
2172	integer i1,i2,i3
2173
2174	! locals
2175	!integer iso_verif_traceur_choix_nostop
2176	real xiso(ntraciso)
2177
2178	call select_dim4_from4D(n1,n2,n3,ntraciso, &
2179	& x,xiso,i1,i2,i3)
2180	if (iso_verif_traceur_choix_nostop(xiso,err_msg, &
2181	& errmax,errmaxrel,ridicule_trac,deltalimtrac) &
2182	& .eq.1) then
2183	stop
2184	endif
2185
2186	end subroutine iso_verif_traceur_retourne3D
2187
2188	subroutine iso_verif_traceur_retourne4D(x,n1,n2,n3,n4, &
2189	& i1,i2,i3,i4,err_msg)
2190	USE infotrac_phy, ONLY: ntraciso
2191	use isotrac_mod, only: ridicule_trac
2192
2193	implicit none
2194	! vérifier des choses sur les traceurs
2195	! * toutes les zones donne t l'istope total
2196	! * pas de deltaD aberrant
2197
2198	! on prend les valeurs pas défaut pour
2199	! errmax,errmaxrel,ridicule_trac,deltalimtrac
2200
2201	! inputs
2202	integer n1,n2,n3,n4
2203	real x(n1,n2,n3,n4,ntraciso)
2204	character() err_msg ! message d''erreur à afficher
2205	integer i1,i2,i3,i4
2206
2207	! locals
2208	!integer iso_verif_traceur_choix_nostop
2209	real xiso(ntraciso)
2210
2211	call select_dim5_from5D(n1,n2,n3,n4,ntraciso, &
2212	& x,xiso,i1,i2,i3,i4)
2213	if (iso_verif_traceur_choix_nostop(xiso,err_msg, &
2214	& errmax,errmaxrel,ridicule_trac,deltalimtrac) &
2215	& .eq.1) then
2216	stop
2217	endif
2218
2219	end subroutine iso_verif_traceur_retourne4D
2220
2221
2222	subroutine iso_verif_traceur_retourne2D(x,n1,n2, &
2223	& i1,i2,err_msg)
2224	USE infotrac_phy, ONLY: ntraciso
2225	use isotrac_mod, only: ridicule_trac
2226	implicit none
2227	! vérifier des choses sur les traceurs
2228	! * toutes les zones donne t l'istope total
2229	! * pas de deltaD aberrant
2230
2231	! on prend les valeurs pas défaut pour
2232	! errmax,errmaxrel,ridicule_trac,deltalimtrac
2233
2234	! inputs
2235	integer n1,n2
2236	real x(n1,n2,ntraciso)
2237	character() err_msg ! message d''erreur à afficher
2238	integer i1,i2
2239
2240	! locals
2241	!integer iso_verif_traceur_choix_nostop
2242	real xiso(ntraciso)
2243
2244	call select_dim3_from3D(n1,n2,ntraciso, &
2245	& x,xiso,i1,i2)
2246	if (iso_verif_traceur_choix_nostop(xiso,err_msg, &
2247	& errmax,errmaxrel,ridicule_trac,deltalimtrac) &
2248	& .eq.1) then
2249	stop
2250	endif
2251
2252	end subroutine iso_verif_traceur_retourne2D
2253
2254	subroutine iso_verif_traceur_vect(x,n,m,err_msg)
2255	USE infotrac_phy, ONLY: ntraciso
2256	USE isotopes_mod, ONLY: iso_HDO
2257	implicit none
2258	! vérifier des choses sur les traceurs
2259	! * toutes les zones donne t l'istope total
2260	! * pas de deltaD aberrant
2261
2262	! on prend les valeurs pas défaut pour
2263	! errmax,errmaxrel,ridicule_trac,deltalimtrac
2264
2265	! inputs
2266	integer n,m
2267	real x(ntraciso,n,m)
2268	character() err_msg ! message d''erreur à afficher
2269
2270	! locals
2271	logical iso_verif_traceur_nostop
2272	integer i,j,ixt,iiso,izone,ieau
2273	integer ifaux,jfaux,ixtfaux
2274
2275	call iso_verif_traceur_noNaN_vect(x,n,m,err_msg)
2276
2277	! verif masse: iso_verif_tracm_choix_nostop
2278	call iso_verif_trac_masse_vect(x,n,m,err_msg,errmax,errmaxrel)
2279
2280	! verif deltaD: iso_verif_tracdD_choix_nostop
2281	if (iso_HDO.gt.0) then
2282	call iso_verif_tracdd_vect(x,n,m,err_msg)
2283	endif !if (iso_HDO.gt.0) then
2284
2285	! verif pas aberramment negatif: iso_verif_tracpos_choix_nostop
2286	call iso_verif_tracpos_vect(x,n,m,err_msg,1e-5)
2287
2288	end subroutine iso_verif_traceur_vect
2289
2290	subroutine iso_verif_tracnps_vect(x,n,m,err_msg)
2291	USE infotrac_phy, ONLY: ntraciso
2292	USE isotopes_mod, ONLY: iso_HDO
2293	implicit none
2294	! vérifier des choses sur les traceurs
2295	! * toutes les zones donne t l'istope total
2296	! * pas de deltaD aberrant
2297
2298	! on prend les valeurs pas défaut pour
2299	! errmax,errmaxrel,ridicule_trac,deltalimtrac
2300
2301	! inputs
2302	integer n,m
2303	real x(ntraciso,n,m)
2304	character() err_msg ! message d''erreur à afficher
2305
2306	! locals
2307	logical iso_verif_traceur_nostop
2308	integer i,j,ixt,iiso,izone,ieau
2309	integer ifaux,jfaux,ixtfaux
2310
2311	call iso_verif_traceur_noNaN_vect(x,n,m,err_msg)
2312
2313	! verif masse: iso_verif_tracm_choix_nostop
2314	call iso_verif_trac_masse_vect(x,n,m,err_msg,errmax,errmaxrel)
2315
2316	! verif deltaD: iso_verif_tracdD_choix_nostop
2317	if (iso_HDO.gt.0) then
2318	call iso_verif_tracdd_vect(x,n,m,err_msg)
2319	endif !if (iso_HDO.gt.0) then
2320
2321	end subroutine iso_verif_tracnps_vect
2322
2323
2324	subroutine iso_verif_traceur_noNaN_vect(x,n,m,err_msg)
2325	USE infotrac_phy, ONLY: ntraciso,niso
2326	implicit none
2327
2328	! inputs
2329	integer n,m
2330	real x(ntraciso,n,m)
2331	character() err_msg ! message d''erreur à afficher
2332
2333	! locals
2334	logical iso_verif_traceur_nostop
2335	integer i,j,ixt,iiso
2336	integer ifaux,jfaux,ixtfaux
2337
2338
2339	iso_verif_traceur_nostop=.false.
2340	! verif noNaN: iso_verif_traceur_noNaN_nostop
2341	do j=1,m
2342	do i=1,n
2343	do ixt=niso+1,ntraciso
2344	if ((x(ixt,i,j).gt.-borne).and.(x(ixt,i,j).lt.borne)) then
2345	else !if ((x.gt.-borne).and.(x.lt.borne)) then
2346	iso_verif_traceur_nostop=.true.
2347	ifaux=i
2348	jfaux=i
2349	endif !if ((x.gt.-borne).and.(x.lt.borne)) then
2350	enddo !do ixt=niso+1,ntraciso
2351	enddo ! do i=1,n
2352	enddo ! do j=1,m
2353
2354
2355	if (iso_verif_traceur_nostop) then
2356	write(,) 'erreur detectée par iso_verif_nonNAN ', &
2357	& 'dans iso_verif_traceur_vect'
2358	write(,) ''
2359	write(,) err_msg
2360	write(,) 'x=',x(:,ifaux,jfaux)
2361	stop
2362	endif
2363
2364	end subroutine iso_verif_traceur_noNaN_vect
2365
2366
2367	subroutine iso_verif_trac_masse_vect(x,n,m,err_msg, &
2368	& errmax,errmaxrel)
2369	USE infotrac_phy, ONLY: index_trac,ntraciso,niso
2370	use isotopes_mod, only: striso
2371	use isotrac_mod, only: ntraceurs_zone
2372	implicit none
2373
2374	! inputs
2375	integer n,m
2376	real x(ntraciso,n,m)
2377	character() err_msg ! message d''erreur à afficher
2378	real errmax,errmaxrel
2379
2380	! locals
2381	logical iso_verif_traceur_nostop
2382	integer i,j,ixt,iiso,izone
2383	integer ifaux,jfaux,ixtfaux
2384	real xtractot(n,m)
2385	real xiiso(n,m)
2386
2387	do iiso=1,niso
2388	do j=1,m
2389	do i=1,n
2390	xtractot(i,j)=0.0
2391	xiiso(i,j)=x(iiso,i,j)
2392	do izone=1,ntraceurs_zone
2393	ixt=index_trac(izone,iiso)
2394	xtractot(i,j)=xtractot(i,j)+x(ixt,i,j)
2395	enddo !do izone=1,ntraceurs_zone
2396	enddo !do i=1,n
2397	enddo !do j=1,m
2398
2399
2400	call iso_verif_egalite_std_vect( &
2401	& xtractot,xiiso, &
2402	& err_msg//', verif trac egalite, iso '//striso(iiso), &
2403	& n,m,errmax,errmaxrel)
2404	enddo !do iiso=1,niso
2405
2406	end subroutine iso_verif_trac_masse_vect
2407
2408	subroutine iso_verif_tracdd_vect(x,n,m,err_msg)
2409	use infotrac_phy, only: index_trac,ntraciso,niso
2410	use isotopes_mod, only: iso_HDO,iso_eau
2411	use isotrac_mod, only: strtrac,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
2419	! locals
2420	integer i,j,iiso,izone,ieau,ixt
2421	real xiiso(niso,n,m)
2422	real xeau(n,m)
2423	integer lnblnk
2424
2425	if (iso_HDO.gt.0) then
2426	do izone=1,ntraceurs_zone
2427	ieau=index_trac(izone,iso_eau)
2428	do iiso=1,niso
2429	ixt=index_trac(izone,iiso)
2430	do j=1,m
2431	do i=1,n
2432	xiiso(iiso,i,j)=x(ixt,i,j)
2433	enddo !do i=1,n
2434	enddo !do j=1,m
2435	enddo !do iiso=1,niso
2436
2437	do j=1,m
2438	do i=1,n
2439	xeau(i,j)=x(ieau,i,j)
2440	enddo !do i=1,n
2441	enddo !do j=1,m
2442
2443	call iso_verif_aberrant_vect2Dch( &
2444	& xiiso,xeau,err_msg//strtrac(izone),niso,n,m, &
2445	& deltalimtrac)
2446	enddo !do izone=1,ntraceurs_zone
2447	endif !if (iso_HDO.gt.0) then
2448
2449	end subroutine iso_verif_tracdd_vect
2450
2451	subroutine iso_verif_tracpos_vect(x,n,m,err_msg,seuil)
2452	USE infotrac_phy, ONLY: ntraciso,niso
2453	implicit none
2454
2455	! inputs
2456	integer n,m
2457	real x(ntraciso,n,m)
2458	character() err_msg ! message d''erreur à afficher
2459	real seuil
2460
2461	! locals
2462	integer i,j,ixt
2463	logical iso_verif_traceur_nostop
2464	integer ifaux,jfaux,ixtfaux
2465
2466	iso_verif_traceur_nostop=.false.
2467	do j=1,m
2468	do i=1,n
2469	do ixt=niso+1,ntraciso
2470	if (x(ixt,i,j).lt.-seuil) then
2471	ifaux=i
2472	jfaux=j
2473	ixtfaux=ixt
2474	iso_verif_traceur_nostop=.true.
2475	endif
2476	enddo !do ixt=niso+1,ntraciso
2477	enddo !do i=1,n
2478	enddo !do j=1,m
2479
2480	if (iso_verif_traceur_nostop) then
2481	write(,) 'erreur detectée par verif positif ', &
2482	& 'dans iso_verif_traceur_vect'
2483	write(,) ''
2484	write(,) err_msg
2485	write(,) 'x=',x(:,ifaux,jfaux)
2486	stop
2487	endif
2488
2489	end subroutine iso_verif_tracpos_vect
2490
2491
2492
2493	subroutine iso_verif_tracnps(x,err_msg)
2494	USE infotrac_phy, ONLY: ntraciso
2495	use isotrac_mod, only: ridicule_trac
2496
2497	implicit none
2498	! vérifier des choses sur les traceurs
2499	! * toutes les zones donne t l'istope total
2500	! * pas de deltaD aberrant
2501
2502	! on prend les valeurs pas défaut pour
2503	! errmax,errmaxrel,ridicule_trac,deltalimtrac
2504
2505	! inputs
2506	real x(ntraciso)
2507	character() err_msg ! message d''erreur à afficher
2508
2509	! locals
2510	!integer iso_verif_tracnps_choix_nostop
2511
2512	if (iso_verif_tracnps_choix_nostop(x,err_msg, &
2513	& errmax,errmaxrel,ridicule_trac,deltalimtrac) &
2514	& .eq.1) then
2515	stop
2516	endif
2517
2518	end subroutine iso_verif_tracnps
2519
2520	subroutine iso_verif_tracpos_choix(x,err_msg,seuil)
2521	USE infotrac_phy, ONLY: ntraciso
2522	implicit none
2523	! vérifier des choses sur les traceurs
2524	! * toutes les zones donne t l'istope total
2525	! * pas de deltaD aberrant
2526
2527	! on prend les valeurs pas défaut pour
2528	! errmax,errmaxrel,ridicule_trac,deltalimtrac
2529
2530	! inputs
2531	real x(ntraciso)
2532	character() err_msg ! message d''erreur à afficher
2533	real seuil
2534
2535	! locals
2536	!integer iso_verif_tracpos_choix_nostop
2537
2538	if (iso_verif_tracpos_choix_nostop(x,err_msg,seuil) &
2539	& .eq.1) then
2540	stop
2541	endif
2542
2543	end subroutine iso_verif_tracpos_choix
2544
2545	subroutine iso_verif_traceur_choix(x,err_msg, &
2546	& errmax,errmaxrel,ridicule_trac_loc,deltalimtrac)
2547	USE infotrac_phy, ONLY: ntraciso
2548	implicit none
2549	! vérifier des choses sur les traceurs
2550	! * toutes les zones donne t l'istope total
2551	! * pas de deltaD aberrant
2552
2553	! inputs
2554	real x(ntraciso)
2555	character() err_msg ! message d''erreur à afficher
2556	real errmax,errmaxrel,ridicule_trac_loc,deltalimtrac
2557
2558	! locals
2559	!integer iso_verif_traceur_choix_nostop
2560
2561	if (iso_verif_traceur_choix_nostop(x,err_msg, &
2562	& errmax,errmaxrel,ridicule_trac_loc,deltalimtrac) &
2563	& .eq.1) then
2564	stop
2565	endif
2566
2567	end subroutine iso_verif_traceur_choix
2568
2569	function iso_verif_traceur_nostop(x,err_msg)
2570	USE infotrac_phy, ONLY: ntraciso
2571	use isotrac_mod, only: ridicule_trac
2572	!use isotopes_verif, only: errmax,errmaxrel,deltalimtrac
2573	implicit none
2574	! vérifier des choses sur les traceurs
2575	! * toutes les zones donne t l'istope total
2576	! * pas de deltaD aberrant
2577
2578	! on prend les valeurs pas défaut pour
2579	! errmax,errmaxrel,ridicule_trac,deltalimtrac
2580
2581	! inputs
2582	real x(ntraciso)
2583	character() err_msg ! message d''erreur à afficher
2584
2585	! output
2586	integer iso_verif_traceur_nostop
2587
2588	! locals
2589	!integer iso_verif_traceur_choix_nostop
2590
2591	iso_verif_traceur_nostop= &
2592	& iso_verif_traceur_choix_nostop(x,err_msg, &
2593	& errmax,errmaxrel,ridicule_trac,deltalimtrac)
2594
2595	end function iso_verif_traceur_nostop
2596
2597
2598	subroutine iso_verif_traceur_justmass(x,err_msg)
2599	USE infotrac_phy, ONLY: ntraciso
2600	implicit none
2601	! on vérifie que noNaN et masse
2602
2603	! on prend les valeurs pas défaut pour
2604	! errmax,errmaxrel,ridicule_trac,deltalimtrac
2605
2606	! inputs
2607	real x(ntraciso)
2608	character() err_msg ! message d''erreur à afficher
2609
2610	! locals
2611	!integer iso_verif_traceur_noNaN_nostop
2612	!integer iso_verif_tracm_choix_nostop
2613
2614	! verif noNaN
2615	if (iso_verif_traceur_noNaN_nostop(x,err_msg).eq.1) then
2616	stop
2617	endif
2618
2619	! verif masse
2620	if (iso_verif_tracm_choix_nostop(x,err_msg, &
2621	& errmax,errmaxrel).eq.1) then
2622	stop
2623	endif
2624
2625	end subroutine iso_verif_traceur_justmass
2626
2627	function iso_verif_traceur_jm_nostop(x,err_msg)
2628	USE infotrac_phy, ONLY: ntraciso
2629	implicit none
2630	! on vérifie que noNaN et masse
2631
2632	! on prend les valeurs pas défaut pour
2633	! errmax,errmaxrel,ridicule_trac,deltalimtrac
2634
2635	! inputs
2636	real x(ntraciso)
2637	character() err_msg ! message d''erreur à afficher
2638
2639	! output
2640	integer iso_verif_traceur_jm_nostop
2641
2642	! locals
2643	! integer iso_verif_traceur_noNaN_nostop
2644	!integer iso_verif_tracm_choix_nostop
2645
2646	iso_verif_traceur_jm_nostop=0
2647	! ! verif noNaN
2648	! if (iso_verif_traceur_noNaN_nostop(x,err_msg).eq.1) then
2649	! iso_verif_traceur_jm_nostop=1
2650	! endif
2651
2652	! verif masse
2653	if (iso_verif_tracm_choix_nostop(x,err_msg, &
2654	& errmax,errmaxrel).eq.1) then
2655	iso_verif_traceur_jm_nostop=1
2656	endif
2657
2658	end function iso_verif_traceur_jm_nostop
2659
2660	function iso_verif_tag17_q_deltaD_chns(x,err_msg)
2661	USE infotrac_phy, ONLY: index_trac,ntraciso
2662	use isotopes_mod, ONLY: iso_HDO,iso_eau,ridicule
2663	use isotrac_mod, only: nzone_temp,option_traceurs
2664	implicit none
2665
2666	! inputs
2667	real x(ntraciso)
2668	character() err_msg
2669	! output
2670	integer iso_verif_tag17_q_deltaD_chns
2671	! locals
2672	!integer iso_verif_positif_nostop
2673	!real deltaD
2674	integer ieau,ixt,ieau1
2675
2676	iso_verif_tag17_q_deltaD_chns=0
2677
2678	if ((option_traceurs.eq.17).or. &
2679	& (option_traceurs.eq.18)) then
2680	! verifier que deltaD du tag de la couche la plus haute <
2681	! 200 permil, et vérifier que son q est inférieur à
2682	ieau=index_trac(nzone_temp,iso_eau)
2683	ixt=index_trac(nzone_temp,iso_HDO)
2684
2685	if (x(ieau).gt.ridicule) then
2686	if (iso_verif_positif_nostop(-200.0-deltaD(x(ixt)/x(ieau)), &
2687	& err_msg//': deltaDt05 trop fort').eq.1) then
2688	write(,) 'x=',x
2689	iso_verif_tag17_q_deltaD_chns=1
2690	endif !if (iso_verif_positif_nostop(-200.0-deltaD(x(ixt),x(ieau)),
2691	endif !if (x(ieau).gt.ridicule) then
2692
2693	if (iso_verif_positif_nostop(2.0e-3-x(ieau), &
2694	& err_msg//': qt05 trop fort').eq.1) then
2695	write(,) 'x=',x
2696	iso_verif_tag17_q_deltaD_chns=1
2697	endif !if (iso_verif_positif_nostop(1.0e-3-x(ieau),
2698
2699	! on vérifie que si q est petit, alors qt01 fait moins de 10%
2700	if (x(iso_eau).lt.2.0e-3) then
2701	ieau1= index_trac(1,iso_eau)
2702	if (iso_verif_positif_nostop(0.1-(x(ieau1)/x(iso_eau)), &
2703	& err_msg//': qt01 trop abondant').eq.1) then
2704	write(,) 'x=',x
2705	iso_verif_tag17_q_deltaD_chns=1
2706	endif ! if (iso_verif_positif(0.1-(x(ixt)/x(ieau)),
2707	endif !if (x(ieau).lt.2.0e-3) then
2708
2709	endif !if (option_traceurs.eq.17) then
2710
2711	end function iso_verif_tag17_q_deltaD_chns
2712
2713	subroutine iso_verif_tag17_q_deltaD_vect(x,n,m,err_msg)
2714	USE infotrac_phy, ONLY: index_trac,ntraciso
2715	USE isotopes_mod, ONLY: tnat,iso_eau, ridicule,iso_HDO
2716	use isotrac_mod, only: option_traceurs,nzone_temp
2717	implicit none
2718
2719	! inputs
2720	integer n,m
2721	real x(ntraciso,n,m)
2722	character() err_msg
2723
2724	! locals
2725	!integer iso_verif_positif_nostop
2726	!real deltaD
2727	integer ieau,ixt,ieau1
2728	integer i,k
2729
2730	if ((option_traceurs.eq.17).or. &
2731	& (option_traceurs.eq.18)) then
2732	! verifier que deltaD du tag de la couche la plus haute <
2733	! 200 permil, et vérifier que son q est inférieur à
2734	ieau=index_trac(nzone_temp,iso_eau)
2735	ixt=index_trac(nzone_temp,iso_HDO)
2736	ieau1=index_trac(1,iso_eau)
2737	do i=1,n
2738	do k=1,m
2739	if (x(ieau,i,k).gt.ridicule) then
2740	if ((x(ixt,i,k)/x(ieau,i,k)/tnat(iso_HDO)-1)*1000 &
2741	& .gt.-200.0) then
2742	write(,) err_msg,', vect:deltaDt05 trop fort'
2743	write(,) 'i,k=',i,k
2744	write(,) 'x(:,i,k)=',x(:,i,k)
2745	stop
2746	endif !if (iso_verif_positif_nostop(-200.0-deltaD(x(ixt),x(ieau)),
2747	endif !if (x(ieau).gt.ridicule) then
2748	if (x(ieau,i,k).gt.2.0e-3) then
2749	write(,) err_msg,', vect:qt05 trop fort'
2750	write(,) 'i,k=',i,k
2751	write(,) 'x(:,i,k)=',x(:,i,k)
2752	stop
2753	endif !if (iso_verif_positif_nostop(1.0e-3-x(ieau),
2754	if (x(iso_eau,i,k).lt.2.0e-3) then
2755	if (x(ieau1,i,k)/x(iso_eau,i,k).gt.0.1) then
2756	write(,) err_msg,', vect: qt01 trop abondant'
2757	write(,) 'i,k=',i,k
2758	write(,) 'ieau1,iso_eau,x(ieau1,i,k),', &
2759	& 'x(iso_eau,i,k)=',ieau1,iso_eau, &
2760	& x(ieau1,i,k),x(iso_eau,i,k)
2761	write(,) 'x(:,i,k)=',x(:,i,k)
2762	stop
2763	endif !if (x(ieau1,i,k)/x(iso_eau,i,k).gt.0.1) then
2764	endif
2765	enddo !do k=1,m
2766	enddo !do i=1,n
2767
2768	endif !if (option_traceurs.eq.17) then
2769
2770	end subroutine iso_verif_tag17_q_deltaD_vect
2771
2772
2773	subroutine iso_verif_tag17_q_deltaD_vect_ret3D(x,n,m,nq,err_msg)
2774	USE infotrac_phy, ONLY: index_trac,ntraciso
2775	USE isotopes_mod, ONLY: tnat,iso_eau,iso_HDO,ridicule
2776	use isotrac_mod, only: option_traceurs,nzone_temp
2777	implicit none
2778
2779	! inputs
2780	integer n,m,nq
2781	real x(n,m,nq,ntraciso)
2782	character() err_msg
2783
2784	! locals
2785	!integer iso_verif_positif_nostop
2786	!real deltaD
2787	integer ieau,ixt,ieau1
2788	integer i,k,iq
2789
2790	if ((option_traceurs.eq.17).or. &
2791	& (option_traceurs.eq.18)) then
2792	! verifier que deltaD du tag de la couche la plus haute <
2793	! 200 permil, et vérifier que son q est inférieur à
2794	ieau=index_trac(nzone_temp,iso_eau)
2795	ixt=index_trac(nzone_temp,iso_HDO)
2796	ieau1=index_trac(1,iso_eau)
2797	do iq=1,nq
2798	do i=1,n
2799	do k=1,m
2800	if (x(i,k,iq,ieau).gt.ridicule) then
2801	if ((x(i,k,iq,ixt)/x(i,k,iq,ieau)/tnat(iso_HDO)-1)*1000 &
2802	& .gt.-200.0) then
2803	write(,) err_msg,', vect:deltaDt05 trop fort'
2804	write(,) 'i,k=',i,k
2805	write(,) 'x(i,k,iq,:)=',x(i,k,iq,:)
2806	stop
2807	endif !if (iso_verif_positif_nostop(-200.0-deltaD(x(ixt),x(ieau)),
2808	endif !if (x(ieau).gt.ridicule) then
2809	if (x(i,k,iq,ieau).gt.2.0e-3) then
2810	write(,) err_msg,', vect:qt05 trop fort'
2811	write(,) 'i,k=',i,k
2812	write(,) 'x(i,k,iq,:)=',x(i,k,iq,:)
2813	stop
2814	endif !if (iso_verif_positif_nostop(1.0e-3-x(ieau),
2815	if (x(i,k,iq,iso_eau).lt.2.0e-3) then
2816	if (x(i,k,iq,ieau1)/x(i,k,iq,iso_eau).gt.0.1) then
2817	write(,) err_msg,', vect: qt01 trop abondant'
2818	write(,) 'i,k=',i,k
2819	write(,) 'ieau1,iso_eau,x(i,k,iq,ieau1),', &
2820	& 'x(i,k,iq,ieau)=',ieau1,iso_eau, &
2821	& x(i,k,iq,ieau1),x(i,k,iq,iso_eau)
2822	write(,) 'x(i,k,iq,:)=',x(i,k,iq,:)
2823	stop
2824	endif !if (x(ieau1,i,k)/x(iso_eau,i,k).gt.0.1) then
2825	endif
2826	enddo !do k=1,m
2827	enddo !do i=1,n
2828	enddo ! do iq=1,nq
2829
2830	endif !if (option_traceurs.eq.17) then
2831
2832	end subroutine iso_verif_tag17_q_deltaD_vect_ret3D
2833
2834
2835	#endif
2836	! endif ISOTRAC
2837
2838	END MODULE isotopes_verif_mod
2839
2840	#endif
2841	! endif ISOVERIF
2842

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

Download in other formats:

Original Format