Context Navigation

isotopes_verif_mod.F90 @ 3956

Last change on this file since 3956 was 3927, checked in by Laurent Fairhead, 3 years ago
Initial import of the physics wih isotopes from Camille Risi CR
Property svn:executable set to ``*
File size: 82.9 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	subroutine iso_verif_trac17_q_deltaD(x,err_msg)
2126	use isotrac_mod, only: nzone_temp,option_traceurs
2127	USE infotrac_phy, ONLY: ntraciso
2128	implicit none
2129
2130	! inputs
2131	real x(ntraciso)
2132	character() err_msg
2133	! local
2134	integer iso_verif_tag17_q_deltaD_chns
2135
2136	if ((option_traceurs.eq.17).or. &
2137	& (option_traceurs.eq.18)) then
2138	if (nzone_temp.ge.5) then
2139	if (iso_verif_tag17_q_deltaD_chns(x,err_msg).eq.1) then
2140	stop
2141	endif
2142	endif
2143	endif !if (option_traceurs.eq.17) then
2144
2145	end subroutine iso_verif_trac17_q_deltaD
2146
2147	subroutine iso_verif_traceur(x,err_msg)
2148	USE infotrac_phy, ONLY: ntraciso
2149	use isotrac_mod, only: ridicule_trac
2150	implicit none
2151	! vérifier des choses sur les traceurs
2152	! * toutes les zones donne t l'istope total
2153	! * pas de deltaD aberrant
2154
2155	! on prend les valeurs pas défaut pour
2156	! errmax,errmaxrel,ridicule_trac,deltalimtrac
2157
2158	! inputs
2159	real x(ntraciso)
2160	character() err_msg ! message d''erreur à afficher
2161
2162	! locals
2163	!integer iso_verif_traceur_choix_nostop
2164
2165	if (iso_verif_traceur_choix_nostop(x,err_msg, &
2166	& errmax,errmaxrel,ridicule_trac,deltalimtrac) &
2167	& .eq.1) then
2168	stop
2169	endif
2170
2171	end subroutine iso_verif_traceur
2172
2173
2174	subroutine iso_verif_traceur_retourne3D(x,n1,n2,n3, &
2175	& i1,i2,i3,err_msg)
2176	USE infotrac_phy, ONLY: ntraciso
2177	use isotrac_mod, only: ridicule_trac
2178
2179	implicit none
2180	! vérifier des choses sur les traceurs
2181	! * toutes les zones donne t l'istope total
2182	! * pas de deltaD aberrant
2183
2184	! on prend les valeurs pas défaut pour
2185	! errmax,errmaxrel,ridicule_trac,deltalimtrac
2186
2187	! inputs
2188	integer n1,n2,n3
2189	real x(n1,n2,n3,ntraciso)
2190	character() err_msg ! message d''erreur à afficher
2191	integer i1,i2,i3
2192
2193	! locals
2194	!integer iso_verif_traceur_choix_nostop
2195	real xiso(ntraciso)
2196
2197	call select_dim4_from4D(n1,n2,n3,ntraciso, &
2198	& x,xiso,i1,i2,i3)
2199	if (iso_verif_traceur_choix_nostop(xiso,err_msg, &
2200	& errmax,errmaxrel,ridicule_trac,deltalimtrac) &
2201	& .eq.1) then
2202	stop
2203	endif
2204
2205	end subroutine iso_verif_traceur_retourne3D
2206
2207	subroutine iso_verif_traceur_retourne4D(x,n1,n2,n3,n4, &
2208	& i1,i2,i3,i4,err_msg)
2209	USE infotrac_phy, ONLY: ntraciso
2210	use isotrac_mod, only: ridicule_trac
2211
2212	implicit none
2213	! vérifier des choses sur les traceurs
2214	! * toutes les zones donne t l'istope total
2215	! * pas de deltaD aberrant
2216
2217	! on prend les valeurs pas défaut pour
2218	! errmax,errmaxrel,ridicule_trac,deltalimtrac
2219
2220	! inputs
2221	integer n1,n2,n3,n4
2222	real x(n1,n2,n3,n4,ntraciso)
2223	character() err_msg ! message d''erreur à afficher
2224	integer i1,i2,i3,i4
2225
2226	! locals
2227	!integer iso_verif_traceur_choix_nostop
2228	real xiso(ntraciso)
2229
2230	call select_dim5_from5D(n1,n2,n3,n4,ntraciso, &
2231	& x,xiso,i1,i2,i3,i4)
2232	if (iso_verif_traceur_choix_nostop(xiso,err_msg, &
2233	& errmax,errmaxrel,ridicule_trac,deltalimtrac) &
2234	& .eq.1) then
2235	stop
2236	endif
2237
2238	end subroutine iso_verif_traceur_retourne4D
2239
2240
2241	subroutine iso_verif_traceur_retourne2D(x,n1,n2, &
2242	& i1,i2,err_msg)
2243	USE infotrac_phy, ONLY: ntraciso
2244	use isotrac_mod, only: ridicule_trac
2245	implicit none
2246	! vérifier des choses sur les traceurs
2247	! * toutes les zones donne t l'istope total
2248	! * pas de deltaD aberrant
2249
2250	! on prend les valeurs pas défaut pour
2251	! errmax,errmaxrel,ridicule_trac,deltalimtrac
2252
2253	! inputs
2254	integer n1,n2
2255	real x(n1,n2,ntraciso)
2256	character() err_msg ! message d''erreur à afficher
2257	integer i1,i2
2258
2259	! locals
2260	!integer iso_verif_traceur_choix_nostop
2261	real xiso(ntraciso)
2262
2263	call select_dim3_from3D(n1,n2,ntraciso, &
2264	& x,xiso,i1,i2)
2265	if (iso_verif_traceur_choix_nostop(xiso,err_msg, &
2266	& errmax,errmaxrel,ridicule_trac,deltalimtrac) &
2267	& .eq.1) then
2268	stop
2269	endif
2270
2271	end subroutine iso_verif_traceur_retourne2D
2272
2273	subroutine iso_verif_traceur_vect(x,n,m,err_msg)
2274	USE infotrac_phy, ONLY: ntraciso
2275	USE isotopes_mod, ONLY: iso_HDO
2276	implicit none
2277	! vérifier des choses sur les traceurs
2278	! * toutes les zones donne t l'istope total
2279	! * pas de deltaD aberrant
2280
2281	! on prend les valeurs pas défaut pour
2282	! errmax,errmaxrel,ridicule_trac,deltalimtrac
2283
2284	! inputs
2285	integer n,m
2286	real x(ntraciso,n,m)
2287	character() err_msg ! message d''erreur à afficher
2288
2289	! locals
2290	logical iso_verif_traceur_nostop
2291	integer i,j,ixt,iiso,izone,ieau
2292	integer ifaux,jfaux,ixtfaux
2293
2294	call iso_verif_traceur_noNaN_vect(x,n,m,err_msg)
2295
2296	! verif masse: iso_verif_tracm_choix_nostop
2297	call iso_verif_trac_masse_vect(x,n,m,err_msg,errmax,errmaxrel)
2298
2299	! verif deltaD: iso_verif_tracdD_choix_nostop
2300	if (iso_HDO.gt.0) then
2301	call iso_verif_tracdd_vect(x,n,m,err_msg)
2302	endif !if (iso_HDO.gt.0) then
2303
2304	! verif pas aberramment negatif: iso_verif_tracpos_choix_nostop
2305	call iso_verif_tracpos_vect(x,n,m,err_msg,1e-5)
2306
2307	end subroutine iso_verif_traceur_vect
2308
2309	subroutine iso_verif_tracnps_vect(x,n,m,err_msg)
2310	USE infotrac_phy, ONLY: ntraciso
2311	USE isotopes_mod, ONLY: iso_HDO
2312	implicit none
2313	! vérifier des choses sur les traceurs
2314	! * toutes les zones donne t l'istope total
2315	! * pas de deltaD aberrant
2316
2317	! on prend les valeurs pas défaut pour
2318	! errmax,errmaxrel,ridicule_trac,deltalimtrac
2319
2320	! inputs
2321	integer n,m
2322	real x(ntraciso,n,m)
2323	character() err_msg ! message d''erreur à afficher
2324
2325	! locals
2326	logical iso_verif_traceur_nostop
2327	integer i,j,ixt,iiso,izone,ieau
2328	integer ifaux,jfaux,ixtfaux
2329
2330	call iso_verif_traceur_noNaN_vect(x,n,m,err_msg)
2331
2332	! verif masse: iso_verif_tracm_choix_nostop
2333	call iso_verif_trac_masse_vect(x,n,m,err_msg,errmax,errmaxrel)
2334
2335	! verif deltaD: iso_verif_tracdD_choix_nostop
2336	if (iso_HDO.gt.0) then
2337	call iso_verif_tracdd_vect(x,n,m,err_msg)
2338	endif !if (iso_HDO.gt.0) then
2339
2340	end subroutine iso_verif_tracnps_vect
2341
2342
2343	subroutine iso_verif_traceur_noNaN_vect(x,n,m,err_msg)
2344	USE infotrac_phy, ONLY: ntraciso,niso
2345	implicit none
2346
2347	! inputs
2348	integer n,m
2349	real x(ntraciso,n,m)
2350	character() err_msg ! message d''erreur à afficher
2351
2352	! locals
2353	logical iso_verif_traceur_nostop
2354	integer i,j,ixt,iiso
2355	integer ifaux,jfaux,ixtfaux
2356
2357
2358	iso_verif_traceur_nostop=.false.
2359	! verif noNaN: iso_verif_traceur_noNaN_nostop
2360	do j=1,m
2361	do i=1,n
2362	do ixt=niso+1,ntraciso
2363	if ((x(ixt,i,j).gt.-borne).and.(x(ixt,i,j).lt.borne)) then
2364	else !if ((x.gt.-borne).and.(x.lt.borne)) then
2365	iso_verif_traceur_nostop=.true.
2366	ifaux=i
2367	jfaux=i
2368	endif !if ((x.gt.-borne).and.(x.lt.borne)) then
2369	enddo !do ixt=niso+1,ntraciso
2370	enddo ! do i=1,n
2371	enddo ! do j=1,m
2372
2373
2374	if (iso_verif_traceur_nostop) then
2375	write(,) 'erreur detectée par iso_verif_nonNAN ', &
2376	& 'dans iso_verif_traceur_vect'
2377	write(,) ''
2378	write(,) err_msg
2379	write(,) 'x=',x(:,ifaux,jfaux)
2380	stop
2381	endif
2382
2383	end subroutine iso_verif_traceur_noNaN_vect
2384
2385
2386	subroutine iso_verif_trac_masse_vect(x,n,m,err_msg, &
2387	& errmax,errmaxrel)
2388	USE infotrac_phy, ONLY: index_trac,ntraciso,niso
2389	use isotopes_mod, only: striso
2390	use isotrac_mod, only: ntraceurs_zone
2391	implicit none
2392
2393	! inputs
2394	integer n,m
2395	real x(ntraciso,n,m)
2396	character() err_msg ! message d''erreur à afficher
2397	real errmax,errmaxrel
2398
2399	! locals
2400	logical iso_verif_traceur_nostop
2401	integer i,j,ixt,iiso,izone
2402	integer ifaux,jfaux,ixtfaux
2403	real xtractot(n,m)
2404	real xiiso(n,m)
2405
2406	do iiso=1,niso
2407	do j=1,m
2408	do i=1,n
2409	xtractot(i,j)=0.0
2410	xiiso(i,j)=x(iiso,i,j)
2411	do izone=1,ntraceurs_zone
2412	ixt=index_trac(izone,iiso)
2413	xtractot(i,j)=xtractot(i,j)+x(ixt,i,j)
2414	enddo !do izone=1,ntraceurs_zone
2415	enddo !do i=1,n
2416	enddo !do j=1,m
2417
2418
2419	call iso_verif_egalite_std_vect( &
2420	& xtractot,xiiso, &
2421	& err_msg//', verif trac egalite, iso '//striso(iiso), &
2422	& n,m,errmax,errmaxrel)
2423	enddo !do iiso=1,niso
2424
2425	end subroutine iso_verif_trac_masse_vect
2426
2427	subroutine iso_verif_tracdd_vect(x,n,m,err_msg)
2428	use infotrac_phy, only: index_trac,ntraciso,niso
2429	use isotopes_mod, only: iso_HDO,iso_eau
2430	use isotrac_mod, only: strtrac,ntraceurs_zone
2431	implicit none
2432
2433	! inputs
2434	integer n,m
2435	real x(ntraciso,n,m)
2436	character() err_msg ! message d''erreur à afficher
2437
2438	! locals
2439	integer i,j,iiso,izone,ieau,ixt
2440	real xiiso(niso,n,m)
2441	real xeau(n,m)
2442	integer lnblnk
2443
2444	if (iso_HDO.gt.0) then
2445	do izone=1,ntraceurs_zone
2446	ieau=index_trac(izone,iso_eau)
2447	do iiso=1,niso
2448	ixt=index_trac(izone,iiso)
2449	do j=1,m
2450	do i=1,n
2451	xiiso(iiso,i,j)=x(ixt,i,j)
2452	enddo !do i=1,n
2453	enddo !do j=1,m
2454	enddo !do iiso=1,niso
2455
2456	do j=1,m
2457	do i=1,n
2458	xeau(i,j)=x(ieau,i,j)
2459	enddo !do i=1,n
2460	enddo !do j=1,m
2461
2462	call iso_verif_aberrant_vect2Dch( &
2463	& xiiso,xeau,err_msg//strtrac(izone),niso,n,m, &
2464	& deltalimtrac)
2465	enddo !do izone=1,ntraceurs_zone
2466	endif !if (iso_HDO.gt.0) then
2467
2468	end subroutine iso_verif_tracdd_vect
2469
2470	subroutine iso_verif_tracpos_vect(x,n,m,err_msg,seuil)
2471	USE infotrac_phy, ONLY: ntraciso,niso
2472	implicit none
2473
2474	! inputs
2475	integer n,m
2476	real x(ntraciso,n,m)
2477	character() err_msg ! message d''erreur à afficher
2478	real seuil
2479
2480	! locals
2481	integer i,j,ixt
2482	logical iso_verif_traceur_nostop
2483	integer ifaux,jfaux,ixtfaux
2484
2485	iso_verif_traceur_nostop=.false.
2486	do j=1,m
2487	do i=1,n
2488	do ixt=niso+1,ntraciso
2489	if (x(ixt,i,j).lt.-seuil) then
2490	ifaux=i
2491	jfaux=j
2492	ixtfaux=ixt
2493	iso_verif_traceur_nostop=.true.
2494	endif
2495	enddo !do ixt=niso+1,ntraciso
2496	enddo !do i=1,n
2497	enddo !do j=1,m
2498
2499	if (iso_verif_traceur_nostop) then
2500	write(,) 'erreur detectée par verif positif ', &
2501	& 'dans iso_verif_traceur_vect'
2502	write(,) ''
2503	write(,) err_msg
2504	write(,) 'x=',x(:,ifaux,jfaux)
2505	stop
2506	endif
2507
2508	end subroutine iso_verif_tracpos_vect
2509
2510
2511
2512	subroutine iso_verif_tracnps(x,err_msg)
2513	USE infotrac_phy, ONLY: ntraciso
2514	use isotrac_mod, only: ridicule_trac
2515
2516	implicit none
2517	! vérifier des choses sur les traceurs
2518	! * toutes les zones donne t l'istope total
2519	! * pas de deltaD aberrant
2520
2521	! on prend les valeurs pas défaut pour
2522	! errmax,errmaxrel,ridicule_trac,deltalimtrac
2523
2524	! inputs
2525	real x(ntraciso)
2526	character() err_msg ! message d''erreur à afficher
2527
2528	! locals
2529	!integer iso_verif_tracnps_choix_nostop
2530
2531	if (iso_verif_tracnps_choix_nostop(x,err_msg, &
2532	& errmax,errmaxrel,ridicule_trac,deltalimtrac) &
2533	& .eq.1) then
2534	stop
2535	endif
2536
2537	end subroutine iso_verif_tracnps
2538
2539	subroutine iso_verif_tracpos_choix(x,err_msg,seuil)
2540	USE infotrac_phy, ONLY: ntraciso
2541	implicit none
2542	! vérifier des choses sur les traceurs
2543	! * toutes les zones donne t l'istope total
2544	! * pas de deltaD aberrant
2545
2546	! on prend les valeurs pas défaut pour
2547	! errmax,errmaxrel,ridicule_trac,deltalimtrac
2548
2549	! inputs
2550	real x(ntraciso)
2551	character() err_msg ! message d''erreur à afficher
2552	real seuil
2553
2554	! locals
2555	!integer iso_verif_tracpos_choix_nostop
2556
2557	if (iso_verif_tracpos_choix_nostop(x,err_msg,seuil) &
2558	& .eq.1) then
2559	stop
2560	endif
2561
2562	end subroutine iso_verif_tracpos_choix
2563
2564	subroutine iso_verif_traceur_choix(x,err_msg, &
2565	& errmax,errmaxrel,ridicule_trac_loc,deltalimtrac)
2566	USE infotrac_phy, ONLY: ntraciso
2567	implicit none
2568	! vérifier des choses sur les traceurs
2569	! * toutes les zones donne t l'istope total
2570	! * pas de deltaD aberrant
2571
2572	! inputs
2573	real x(ntraciso)
2574	character() err_msg ! message d''erreur à afficher
2575	real errmax,errmaxrel,ridicule_trac_loc,deltalimtrac
2576
2577	! locals
2578	!integer iso_verif_traceur_choix_nostop
2579
2580	if (iso_verif_traceur_choix_nostop(x,err_msg, &
2581	& errmax,errmaxrel,ridicule_trac_loc,deltalimtrac) &
2582	& .eq.1) then
2583	stop
2584	endif
2585
2586	end subroutine iso_verif_traceur_choix
2587
2588	function iso_verif_traceur_nostop(x,err_msg)
2589	USE infotrac_phy, ONLY: ntraciso
2590	use isotrac_mod, only: ridicule_trac
2591	!use isotopes_verif, only: errmax,errmaxrel,deltalimtrac
2592	implicit none
2593	! vérifier des choses sur les traceurs
2594	! * toutes les zones donne t l'istope total
2595	! * pas de deltaD aberrant
2596
2597	! on prend les valeurs pas défaut pour
2598	! errmax,errmaxrel,ridicule_trac,deltalimtrac
2599
2600	! inputs
2601	real x(ntraciso)
2602	character() err_msg ! message d''erreur à afficher
2603
2604	! output
2605	integer iso_verif_traceur_nostop
2606
2607	! locals
2608	!integer iso_verif_traceur_choix_nostop
2609
2610	iso_verif_traceur_nostop= &
2611	& iso_verif_traceur_choix_nostop(x,err_msg, &
2612	& errmax,errmaxrel,ridicule_trac,deltalimtrac)
2613
2614	end function iso_verif_traceur_nostop
2615
2616
2617	subroutine iso_verif_traceur_justmass(x,err_msg)
2618	USE infotrac_phy, ONLY: ntraciso
2619	implicit none
2620	! on vérifie que noNaN et masse
2621
2622	! on prend les valeurs pas défaut pour
2623	! errmax,errmaxrel,ridicule_trac,deltalimtrac
2624
2625	! inputs
2626	real x(ntraciso)
2627	character() err_msg ! message d''erreur à afficher
2628
2629	! locals
2630	!integer iso_verif_traceur_noNaN_nostop
2631	!integer iso_verif_tracm_choix_nostop
2632
2633	! verif noNaN
2634	if (iso_verif_traceur_noNaN_nostop(x,err_msg).eq.1) then
2635	stop
2636	endif
2637
2638	! verif masse
2639	if (iso_verif_tracm_choix_nostop(x,err_msg, &
2640	& errmax,errmaxrel).eq.1) then
2641	stop
2642	endif
2643
2644	end subroutine iso_verif_traceur_justmass
2645
2646	function iso_verif_traceur_jm_nostop(x,err_msg)
2647	USE infotrac_phy, ONLY: ntraciso
2648	implicit none
2649	! on vérifie que noNaN et masse
2650
2651	! on prend les valeurs pas défaut pour
2652	! errmax,errmaxrel,ridicule_trac,deltalimtrac
2653
2654	! inputs
2655	real x(ntraciso)
2656	character() err_msg ! message d''erreur à afficher
2657
2658	! output
2659	integer iso_verif_traceur_jm_nostop
2660
2661	! locals
2662	! integer iso_verif_traceur_noNaN_nostop
2663	!integer iso_verif_tracm_choix_nostop
2664
2665	iso_verif_traceur_jm_nostop=0
2666	! ! verif noNaN
2667	! if (iso_verif_traceur_noNaN_nostop(x,err_msg).eq.1) then
2668	! iso_verif_traceur_jm_nostop=1
2669	! endif
2670
2671	! verif masse
2672	if (iso_verif_tracm_choix_nostop(x,err_msg, &
2673	& errmax,errmaxrel).eq.1) then
2674	iso_verif_traceur_jm_nostop=1
2675	endif
2676
2677	end function iso_verif_traceur_jm_nostop
2678
2679	function iso_verif_tag17_q_deltaD_chns(x,err_msg)
2680	USE infotrac_phy, ONLY: index_trac,ntraciso
2681	use isotopes_mod, ONLY: iso_HDO,iso_eau,ridicule
2682	use isotrac_mod, only: nzone_temp,option_traceurs
2683	implicit none
2684
2685	! inputs
2686	real x(ntraciso)
2687	character() err_msg
2688	! output
2689	integer iso_verif_tag17_q_deltaD_chns
2690	! locals
2691	!integer iso_verif_positif_nostop
2692	!real deltaD
2693	integer ieau,ixt,ieau1
2694
2695	iso_verif_tag17_q_deltaD_chns=0
2696
2697	if ((option_traceurs.eq.17).or. &
2698	& (option_traceurs.eq.18)) then
2699	! verifier que deltaD du tag de la couche la plus haute <
2700	! 200 permil, et vérifier que son q est inférieur à
2701	ieau=index_trac(nzone_temp,iso_eau)
2702	ixt=index_trac(nzone_temp,iso_HDO)
2703
2704	if (x(ieau).gt.ridicule) then
2705	if (iso_verif_positif_nostop(-200.0-deltaD(x(ixt)/x(ieau)), &
2706	& err_msg//': deltaDt05 trop fort').eq.1) then
2707	write(,) 'x=',x
2708	iso_verif_tag17_q_deltaD_chns=1
2709	endif !if (iso_verif_positif_nostop(-200.0-deltaD(x(ixt),x(ieau)),
2710	endif !if (x(ieau).gt.ridicule) then
2711
2712	if (iso_verif_positif_nostop(2.0e-3-x(ieau), &
2713	& err_msg//': qt05 trop fort').eq.1) then
2714	write(,) 'x=',x
2715	iso_verif_tag17_q_deltaD_chns=1
2716	endif !if (iso_verif_positif_nostop(1.0e-3-x(ieau),
2717
2718	! on vérifie que si q est petit, alors qt01 fait moins de 10%
2719	if (x(iso_eau).lt.2.0e-3) then
2720	ieau1= index_trac(1,iso_eau)
2721	if (iso_verif_positif_nostop(0.1-(x(ieau1)/x(iso_eau)), &
2722	& err_msg//': qt01 trop abondant').eq.1) then
2723	write(,) 'x=',x
2724	iso_verif_tag17_q_deltaD_chns=1
2725	endif ! if (iso_verif_positif(0.1-(x(ixt)/x(ieau)),
2726	endif !if (x(ieau).lt.2.0e-3) then
2727
2728	endif !if (option_traceurs.eq.17) then
2729
2730	end function iso_verif_tag17_q_deltaD_chns
2731
2732	subroutine iso_verif_tag17_q_deltaD_vect(x,n,m,err_msg)
2733	USE infotrac_phy, ONLY: index_trac,ntraciso
2734	USE isotopes_mod, ONLY: tnat,iso_eau, ridicule,iso_HDO
2735	use isotrac_mod, only: option_traceurs,nzone_temp
2736	implicit none
2737
2738	! inputs
2739	integer n,m
2740	real x(ntraciso,n,m)
2741	character() err_msg
2742
2743	! locals
2744	!integer iso_verif_positif_nostop
2745	!real deltaD
2746	integer ieau,ixt,ieau1
2747	integer i,k
2748
2749	if ((option_traceurs.eq.17).or. &
2750	& (option_traceurs.eq.18)) then
2751	! verifier que deltaD du tag de la couche la plus haute <
2752	! 200 permil, et vérifier que son q est inférieur à
2753	ieau=index_trac(nzone_temp,iso_eau)
2754	ixt=index_trac(nzone_temp,iso_HDO)
2755	ieau1=index_trac(1,iso_eau)
2756	do i=1,n
2757	do k=1,m
2758	if (x(ieau,i,k).gt.ridicule) then
2759	if ((x(ixt,i,k)/x(ieau,i,k)/tnat(iso_HDO)-1)*1000 &
2760	& .gt.-200.0) then
2761	write(,) err_msg,', vect:deltaDt05 trop fort'
2762	write(,) 'i,k=',i,k
2763	write(,) 'x(:,i,k)=',x(:,i,k)
2764	stop
2765	endif !if (iso_verif_positif_nostop(-200.0-deltaD(x(ixt),x(ieau)),
2766	endif !if (x(ieau).gt.ridicule) then
2767	if (x(ieau,i,k).gt.2.0e-3) then
2768	write(,) err_msg,', vect:qt05 trop fort'
2769	write(,) 'i,k=',i,k
2770	write(,) 'x(:,i,k)=',x(:,i,k)
2771	stop
2772	endif !if (iso_verif_positif_nostop(1.0e-3-x(ieau),
2773	if (x(iso_eau,i,k).lt.2.0e-3) then
2774	if (x(ieau1,i,k)/x(iso_eau,i,k).gt.0.1) then
2775	write(,) err_msg,', vect: qt01 trop abondant'
2776	write(,) 'i,k=',i,k
2777	write(,) 'ieau1,iso_eau,x(ieau1,i,k),', &
2778	& 'x(iso_eau,i,k)=',ieau1,iso_eau, &
2779	& x(ieau1,i,k),x(iso_eau,i,k)
2780	write(,) 'x(:,i,k)=',x(:,i,k)
2781	stop
2782	endif !if (x(ieau1,i,k)/x(iso_eau,i,k).gt.0.1) then
2783	endif
2784	enddo !do k=1,m
2785	enddo !do i=1,n
2786
2787	endif !if (option_traceurs.eq.17) then
2788
2789	end subroutine iso_verif_tag17_q_deltaD_vect
2790
2791
2792	subroutine iso_verif_tag17_q_deltaD_vect_ret3D(x,n,m,nq,err_msg)
2793	USE infotrac_phy, ONLY: index_trac,ntraciso
2794	USE isotopes_mod, ONLY: tnat,iso_eau,iso_HDO,ridicule
2795	use isotrac_mod, only: option_traceurs,nzone_temp
2796	implicit none
2797
2798	! inputs
2799	integer n,m,nq
2800	real x(n,m,nq,ntraciso)
2801	character() err_msg
2802
2803	! locals
2804	!integer iso_verif_positif_nostop
2805	!real deltaD
2806	integer ieau,ixt,ieau1
2807	integer i,k,iq
2808
2809	if ((option_traceurs.eq.17).or. &
2810	& (option_traceurs.eq.18)) then
2811	! verifier que deltaD du tag de la couche la plus haute <
2812	! 200 permil, et vérifier que son q est inférieur à
2813	ieau=index_trac(nzone_temp,iso_eau)
2814	ixt=index_trac(nzone_temp,iso_HDO)
2815	ieau1=index_trac(1,iso_eau)
2816	do iq=1,nq
2817	do i=1,n
2818	do k=1,m
2819	if (x(i,k,iq,ieau).gt.ridicule) then
2820	if ((x(i,k,iq,ixt)/x(i,k,iq,ieau)/tnat(iso_HDO)-1)*1000 &
2821	& .gt.-200.0) then
2822	write(,) err_msg,', vect:deltaDt05 trop fort'
2823	write(,) 'i,k=',i,k
2824	write(,) 'x(i,k,iq,:)=',x(i,k,iq,:)
2825	stop
2826	endif !if (iso_verif_positif_nostop(-200.0-deltaD(x(ixt),x(ieau)),
2827	endif !if (x(ieau).gt.ridicule) then
2828	if (x(i,k,iq,ieau).gt.2.0e-3) then
2829	write(,) err_msg,', vect:qt05 trop fort'
2830	write(,) 'i,k=',i,k
2831	write(,) 'x(i,k,iq,:)=',x(i,k,iq,:)
2832	stop
2833	endif !if (iso_verif_positif_nostop(1.0e-3-x(ieau),
2834	if (x(i,k,iq,iso_eau).lt.2.0e-3) then
2835	if (x(i,k,iq,ieau1)/x(i,k,iq,iso_eau).gt.0.1) then
2836	write(,) err_msg,', vect: qt01 trop abondant'
2837	write(,) 'i,k=',i,k
2838	write(,) 'ieau1,iso_eau,x(i,k,iq,ieau1),', &
2839	& 'x(i,k,iq,ieau)=',ieau1,iso_eau, &
2840	& x(i,k,iq,ieau1),x(i,k,iq,iso_eau)
2841	write(,) 'x(i,k,iq,:)=',x(i,k,iq,:)
2842	stop
2843	endif !if (x(ieau1,i,k)/x(iso_eau,i,k).gt.0.1) then
2844	endif
2845	enddo !do k=1,m
2846	enddo !do i=1,n
2847	enddo ! do iq=1,nq
2848
2849	endif !if (option_traceurs.eq.17) then
2850
2851	end subroutine iso_verif_tag17_q_deltaD_vect_ret3D
2852
2853
2854	#endif
2855	! endif ISOTRAC
2856
2857	END MODULE isotopes_verif_mod
2858
2859	#endif
2860	! endif ISOVERIF
2861

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

Download in other formats:

Original Format