Context Navigation

isotopes_verif_mod.F90 @ 5327

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

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

Download in other formats:

Original Format