Context Navigation

isotopes_verif_mod.F90 @ 4143

Last change on this file since 4143 was 4143, checked in by dcugnet, 2 years ago
Some variables are renamed or replaced by direct equivalents: iso_indnum -> tracers(:)%iso_iName niso_possibles -> niso iqiso -> iqIsoPha ; index_trac -> itZonIso ok_iso_verif -> isoCheck ntraceurs_zone -> nzone ; ntraciso -> ntiso qperemin -> min_qparent ; masseqmin -> min_qmass ; ratiomin -> min_ratio Some renamed variables are only aliased with the older name (using USE <module>, ONLY: <oldName> => <newName>) in routines where they are repeated many times. Few hard-coded indexes are now computed (examples: ilic, iso, ivap, irneb, iq_vap, iq_liq, iso_H2O, iso_HDO, iso_HTO, iso_O17, iso_O18). The IF(isoCheck) test is now embedded in the check_isotopes_seq and check_isotopes_loc routines (lighter calling).
Property svn:executable set to ``*
File size: 79.7 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
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 isotrac_mod, only: index_iso,strtrac,index_zone
1942	use isotopes_mod, only: striso
1943	implicit none
1944
1945	! inputs
1946	real x(ntraciso)
1947	character() err_msg ! message d''erreur à afficher
1948	real seuil
1949
1950	! output
1951	integer iso_verif_tracpos_choix_nostop
1952
1953	! locals
1954	integer lnblnk
1955	integer iiso,ixt
1956	!integer iso_verif_positif_choix_nostop
1957
1958	iso_verif_tracpos_choix_nostop=0
1959
1960	do ixt=niso+1,ntraciso
1961	iiso=index_iso(ixt)
1962	if (iso_verif_positif_choix_nostop(x(ixt),seuil,err_msg// &
1963	& ', verif positif, iso'//striso(iiso) &
1964	& //strtrac(index_zone(ixt))).eq.1) then
1965	iso_verif_tracpos_choix_nostop=1
1966	endif
1967	enddo
1968
1969	end function iso_verif_tracpos_choix_nostop
1970
1971
1972	function iso_verif_traceur_noNaN_nostop(x,err_msg)
1973	use isotrac_mod, only: index_iso
1974	use isotopes_mod, only: striso
1975	implicit none
1976
1977	! on vérifie juste que pas NaN
1978	! inputs
1979	real x(ntraciso)
1980	character() err_msg ! message d''erreur à afficher
1981
1982	! output
1983	integer iso_verif_traceur_noNaN_nostop
1984
1985	! locals
1986	integer lnblnk
1987	integer iiso,ixt
1988	!integer iso_verif_nonaN_nostop
1989
1990	iso_verif_traceur_noNaN_nostop=0
1991
1992	do ixt=niso+1,ntraciso
1993	iiso=index_iso(ixt)
1994	! write(,) 'iso_verif_traceurs 154: iiso,ixt=',iiso,ixt
1995	if (iso_verif_noNaN_nostop(x(ixt),err_msg// &
1996	& ', verif trac no NaN, iso'//striso(iiso)) &
1997	& .eq.1) then
1998	iso_verif_traceur_noNaN_nostop=1
1999	endif
2000	enddo
2001
2002	end function iso_verif_traceur_noNaN_nostop
2003
2004	function iso_verif_tracm_choix_nostop(x,err_msg, &
2005	& errmaxin,errmaxrelin)
2006
2007	use isotopes_mod, ONLY: ridicule,striso
2008	! on vérifie juste bilan de masse
2009	implicit none
2010
2011	! inputs
2012	real x(ntraciso)
2013	character() err_msg ! message d''erreur à afficher
2014	real errmaxin,errmaxrelin
2015
2016	! output
2017	integer iso_verif_tracm_choix_nostop
2018
2019	! locals
2020	!integer iso_verif_egalite_choix_nostop
2021	integer iiso,izone,ixt
2022	real xtractot
2023
2024	iso_verif_tracm_choix_nostop=0
2025
2026	do iiso=1,niso
2027
2028	xtractot=0.0
2029	do izone=1,nzone
2030	ixt=itZonIso(izone,iiso)
2031	xtractot=xtractot+x(ixt)
2032	enddo
2033
2034	if (iso_verif_egalite_choix_nostop(xtractot,x(iiso), &
2035	& err_msg//', verif trac egalite, iso '//striso(iiso), &
2036	& errmaxin,errmaxrelin).eq.1) then
2037	write(,) 'iso_verif_traceur 202: x=',x
2038	! write(,) 'xtractot=',xtractot
2039	iso_verif_tracm_choix_nostop=1
2040	endif
2041
2042	! verif ajoutée le 19 fev 2011
2043	if ((abs(xtractot).lt.ridicule**2).and. &
2044	& (abs(x(iiso)).gt.ridicule)) then
2045	write(,) err_msg,', verif masse traceurs, iso ', &
2046	& striso(iiso)
2047	write(,) 'iso_verif_traceur 209: x=',x
2048	! iso_verif_tracm_choix_nostop=1
2049	endif
2050
2051	enddo !do iiso=1,ntraceurs_iso
2052
2053	end function iso_verif_tracm_choix_nostop
2054
2055	function iso_verif_tracdD_choix_nostop(x,err_msg, &
2056	& ridicule_trac,deltalimtrac)
2057
2058	USE isotopes_mod, ONLY: iso_eau, iso_HDO
2059	use isotrac_mod, only: strtrac
2060	! on vérifie juste deltaD
2061	implicit none
2062
2063	! inputs
2064	real x(ntraciso)
2065	character() err_msg ! message d''erreur à afficher
2066	real ridicule_trac,deltalimtrac
2067
2068	! output
2069	integer iso_verif_tracdD_choix_nostop
2070
2071	! locals
2072	integer izone,ieau,ixt
2073	!integer iso_verif_aberrant_choix_nostop
2074
2075	iso_verif_tracdD_choix_nostop=0
2076
2077	if ((iso_eau.gt.0).and.(iso_HDO.gt.0)) then
2078	do izone=1,nzone
2079	ieau=itZonIso(izone,iso_eau)
2080	ixt=itZonIso(izone,iso_HDO)
2081
2082	if (iso_verif_aberrant_choix_nostop(x(ixt),x(ieau), &
2083	& ridicule_trac,deltalimtrac,err_msg// &
2084	& ', verif trac no aberrant zone '//strtrac(izone)) &
2085	& .eq.1) then
2086	iso_verif_tracdD_choix_nostop=1
2087	endif
2088	! if (x(ieau).gt.ridicule) then
2089	! call iso_verif_aberrant(x(ixt)/x(ieau),
2090	! : err_msg//', verif trac no aberrant zone '
2091	! : //strtrac(izone))
2092	! endif
2093	enddo !do izone=1,nzone
2094	endif ! if ((iso_eau.gt.0).and.(iso_HDO.gt.0)) then
2095
2096	end function iso_verif_tracdD_choix_nostop
2097
2098	INTEGER FUNCTION iso_verif_tag17_q_deltaD_chns(x,err_msg) RESULT(res)
2099	USE isotopes_mod, ONLY: iso_HDO, iso_eau, ridicule
2100	USE isotrac_mod, ONLY: nzone_temp, option_traceurs
2101	IMPLICIT NONE
2102	REAL, INTENT(IN) :: x(ntraciso)
2103	CHARACTER(LEN=*), INTENT(IN) :: err_msg
2104	INTEGER :: ieau, ixt, ieau1
2105	res = 0
2106	IF(ALL([17,18]/=option_traceurs)) RETURN
2107	!--- Check whether * deltaD(highest tagging layer) < 200 permil
2108	! * q <
2109	ieau=itZonIso(nzone_temp,iso_eau)
2110	ixt=itZonIso(nzone_temp,iso_HDO)
2111	IF(x(ieau)>ridicule) THEN
2112	IF(iso_verif_positif_nostop(-200.0-deltaD(x(ixt)/x(ieau)), err_msg//': deltaDt05 trop fort')==1) THEN
2113	res=1; write(,) 'x=',x
2114	END IF
2115	END IF
2116	IF(iso_verif_positif_nostop(2.0e-3-x(ieau),err_msg//': qt05 trop fort')==1) THEN
2117	res=1; write(,) 'x=',x
2118	END IF
2119	!--- Check whether q is small ; then, qt01 < 10%
2120	IF(x(iso_eau)<2.0e-3) THEN
2121	ieau1= itZonIso(1,iso_eau)
2122	IF(iso_verif_positif_nostop(0.1-(x(ieau1)/x(iso_eau)),err_msg//': qt01 trop abondant')==1) THEN
2123	res=1; write(,) 'x=',x
2124	END IF
2125	END IF
2126	END FUNCTION iso_verif_tag17_q_deltaD_chns
2127
2128	SUBROUTINE iso_verif_trac17_q_deltaD(x,err_msg)
2129	USE isotrac_mod, ONLY: nzone_temp, option_traceurs
2130	IMPLICIT NONE
2131	REAL, INTENT(IN) :: x(ntraciso)
2132	CHARACTER(LEN=*), INTENT(IN) :: err_msg
2133	IF(ALL([17,18]/=option_traceurs)) RETURN
2134	IF(nzone_temp>=5) THEN
2135	IF(iso_verif_tag17_q_deltaD_chns(x,err_msg)==1) STOP
2136	END IF
2137	END SUBROUTINE iso_verif_trac17_q_deltaD
2138
2139	subroutine iso_verif_traceur(x,err_msg)
2140	use isotrac_mod, only: ridicule_trac
2141	implicit none
2142	! vérifier des choses sur les traceurs
2143	! * toutes les zones donne t l'istope total
2144	! * pas de deltaD aberrant
2145
2146	! on prend les valeurs pas défaut pour
2147	! errmax,errmaxrel,ridicule_trac,deltalimtrac
2148
2149	! inputs
2150	real x(ntraciso)
2151	character() err_msg ! message d''erreur à afficher
2152
2153	! locals
2154	!integer iso_verif_traceur_choix_nostop
2155
2156	if (iso_verif_traceur_choix_nostop(x,err_msg, &
2157	& errmax,errmaxrel,ridicule_trac,deltalimtrac) &
2158	& .eq.1) then
2159	stop
2160	endif
2161
2162	end subroutine iso_verif_traceur
2163
2164
2165	subroutine iso_verif_traceur_retourne3D(x,n1,n2,n3, &
2166	& i1,i2,i3,err_msg)
2167	use isotrac_mod, only: ridicule_trac
2168
2169	implicit none
2170	! vérifier des choses sur les traceurs
2171	! * toutes les zones donne t l'istope total
2172	! * pas de deltaD aberrant
2173
2174	! on prend les valeurs pas défaut pour
2175	! errmax,errmaxrel,ridicule_trac,deltalimtrac
2176
2177	! inputs
2178	integer n1,n2,n3
2179	real x(n1,n2,n3,ntraciso)
2180	character() err_msg ! message d''erreur à afficher
2181	integer i1,i2,i3
2182
2183	! locals
2184	!integer iso_verif_traceur_choix_nostop
2185	real xiso(ntraciso)
2186
2187	call select_dim4_from4D(n1,n2,n3,ntraciso, &
2188	& x,xiso,i1,i2,i3)
2189	if (iso_verif_traceur_choix_nostop(xiso,err_msg, &
2190	& errmax,errmaxrel,ridicule_trac,deltalimtrac) &
2191	& .eq.1) then
2192	stop
2193	endif
2194
2195	end subroutine iso_verif_traceur_retourne3D
2196
2197	subroutine iso_verif_traceur_retourne4D(x,n1,n2,n3,n4, &
2198	& i1,i2,i3,i4,err_msg)
2199	use isotrac_mod, only: ridicule_trac
2200
2201	implicit none
2202	! vérifier des choses sur les traceurs
2203	! * toutes les zones donne t l'istope total
2204	! * pas de deltaD aberrant
2205
2206	! on prend les valeurs pas défaut pour
2207	! errmax,errmaxrel,ridicule_trac,deltalimtrac
2208
2209	! inputs
2210	integer n1,n2,n3,n4
2211	real x(n1,n2,n3,n4,ntraciso)
2212	character() err_msg ! message d''erreur à afficher
2213	integer i1,i2,i3,i4
2214
2215	! locals
2216	!integer iso_verif_traceur_choix_nostop
2217	real xiso(ntraciso)
2218
2219	call select_dim5_from5D(n1,n2,n3,n4,ntraciso, &
2220	& x,xiso,i1,i2,i3,i4)
2221	if (iso_verif_traceur_choix_nostop(xiso,err_msg, &
2222	& errmax,errmaxrel,ridicule_trac,deltalimtrac) &
2223	& .eq.1) then
2224	stop
2225	endif
2226
2227	end subroutine iso_verif_traceur_retourne4D
2228
2229
2230	subroutine iso_verif_traceur_retourne2D(x,n1,n2, &
2231	& i1,i2,err_msg)
2232	use isotrac_mod, only: ridicule_trac
2233	implicit none
2234	! vérifier des choses sur les traceurs
2235	! * toutes les zones donne t l'istope total
2236	! * pas de deltaD aberrant
2237
2238	! on prend les valeurs pas défaut pour
2239	! errmax,errmaxrel,ridicule_trac,deltalimtrac
2240
2241	! inputs
2242	integer n1,n2
2243	real x(n1,n2,ntraciso)
2244	character() err_msg ! message d''erreur à afficher
2245	integer i1,i2
2246
2247	! locals
2248	!integer iso_verif_traceur_choix_nostop
2249	real xiso(ntraciso)
2250
2251	call select_dim3_from3D(n1,n2,ntraciso, &
2252	& x,xiso,i1,i2)
2253	if (iso_verif_traceur_choix_nostop(xiso,err_msg, &
2254	& errmax,errmaxrel,ridicule_trac,deltalimtrac) &
2255	& .eq.1) then
2256	stop
2257	endif
2258
2259	end subroutine iso_verif_traceur_retourne2D
2260
2261	subroutine iso_verif_traceur_vect(x,n,m,err_msg)
2262	USE isotopes_mod, ONLY: iso_HDO
2263	implicit none
2264	! vérifier des choses sur les traceurs
2265	! * toutes les zones donne t l'istope total
2266	! * pas de deltaD aberrant
2267
2268	! on prend les valeurs pas défaut pour
2269	! errmax,errmaxrel,ridicule_trac,deltalimtrac
2270
2271	! inputs
2272	integer n,m
2273	real x(ntraciso,n,m)
2274	character() err_msg ! message d''erreur à afficher
2275
2276	! locals
2277	logical iso_verif_traceur_nostop
2278	integer i,j,ixt,iiso,izone,ieau
2279	integer ifaux,jfaux,ixtfaux
2280
2281	call iso_verif_traceur_noNaN_vect(x,n,m,err_msg)
2282
2283	! verif masse: iso_verif_tracm_choix_nostop
2284	call iso_verif_trac_masse_vect(x,n,m,err_msg,errmax,errmaxrel)
2285
2286	! verif deltaD: iso_verif_tracdD_choix_nostop
2287	if (iso_HDO.gt.0) then
2288	call iso_verif_tracdd_vect(x,n,m,err_msg)
2289	endif !if (iso_HDO.gt.0) then
2290
2291	! verif pas aberramment negatif: iso_verif_tracpos_choix_nostop
2292	call iso_verif_tracpos_vect(x,n,m,err_msg,1e-5)
2293
2294	end subroutine iso_verif_traceur_vect
2295
2296	subroutine iso_verif_tracnps_vect(x,n,m,err_msg)
2297	USE isotopes_mod, ONLY: iso_HDO
2298	implicit none
2299	! vérifier des choses sur les traceurs
2300	! * toutes les zones donne t l'istope total
2301	! * pas de deltaD aberrant
2302
2303	! on prend les valeurs pas défaut pour
2304	! errmax,errmaxrel,ridicule_trac,deltalimtrac
2305
2306	! inputs
2307	integer n,m
2308	real x(ntraciso,n,m)
2309	character() err_msg ! message d''erreur à afficher
2310
2311	! locals
2312	logical iso_verif_traceur_nostop
2313	integer i,j,ixt,iiso,izone,ieau
2314	integer ifaux,jfaux,ixtfaux
2315
2316	call iso_verif_traceur_noNaN_vect(x,n,m,err_msg)
2317
2318	! verif masse: iso_verif_tracm_choix_nostop
2319	call iso_verif_trac_masse_vect(x,n,m,err_msg,errmax,errmaxrel)
2320
2321	! verif deltaD: iso_verif_tracdD_choix_nostop
2322	if (iso_HDO.gt.0) then
2323	call iso_verif_tracdd_vect(x,n,m,err_msg)
2324	endif !if (iso_HDO.gt.0) then
2325
2326	end subroutine iso_verif_tracnps_vect
2327
2328
2329	subroutine iso_verif_traceur_noNaN_vect(x,n,m,err_msg)
2330	implicit none
2331
2332	! inputs
2333	integer n,m
2334	real x(ntraciso,n,m)
2335	character() err_msg ! message d''erreur à afficher
2336
2337	! locals
2338	logical iso_verif_traceur_nostop
2339	integer i,j,ixt,iiso
2340	integer ifaux,jfaux,ixtfaux
2341
2342
2343	iso_verif_traceur_nostop=.false.
2344	! verif noNaN: iso_verif_traceur_noNaN_nostop
2345	do j=1,m
2346	do i=1,n
2347	do ixt=niso+1,ntraciso
2348	if ((x(ixt,i,j).gt.-borne).and.(x(ixt,i,j).lt.borne)) then
2349	else !if ((x.gt.-borne).and.(x.lt.borne)) then
2350	iso_verif_traceur_nostop=.true.
2351	ifaux=i
2352	jfaux=i
2353	endif !if ((x.gt.-borne).and.(x.lt.borne)) then
2354	enddo !do ixt=niso+1,ntraciso
2355	enddo ! do i=1,n
2356	enddo ! do j=1,m
2357
2358
2359	if (iso_verif_traceur_nostop) then
2360	write(,) 'erreur detectée par iso_verif_nonNAN ', &
2361	& 'dans iso_verif_traceur_vect'
2362	write(,) ''
2363	write(,) err_msg
2364	write(,) 'x=',x(:,ifaux,jfaux)
2365	stop
2366	endif
2367
2368	end subroutine iso_verif_traceur_noNaN_vect
2369
2370
2371	subroutine iso_verif_trac_masse_vect(x,n,m,err_msg, &
2372	& errmax,errmaxrel)
2373	use isotopes_mod, only: striso
2374	implicit none
2375
2376	! inputs
2377	integer n,m
2378	real x(ntraciso,n,m)
2379	character() err_msg ! message d''erreur à afficher
2380	real errmax,errmaxrel
2381
2382	! locals
2383	logical iso_verif_traceur_nostop
2384	integer i,j,ixt,iiso,izone
2385	integer ifaux,jfaux,ixtfaux
2386	real xtractot(n,m)
2387	real xiiso(n,m)
2388
2389	do iiso=1,niso
2390	do j=1,m
2391	do i=1,n
2392	xtractot(i,j)=0.0
2393	xiiso(i,j)=x(iiso,i,j)
2394	do izone=1,nzone
2395	ixt=itZonIso(izone,iiso)
2396	xtractot(i,j)=xtractot(i,j)+x(ixt,i,j)
2397	enddo !do izone=1,nzone
2398	enddo !do i=1,n
2399	enddo !do j=1,m
2400
2401
2402	call iso_verif_egalite_std_vect( &
2403	& xtractot,xiiso, &
2404	& err_msg//', verif trac egalite, iso '//striso(iiso), &
2405	& n,m,errmax,errmaxrel)
2406	enddo !do iiso=1,niso
2407
2408	end subroutine iso_verif_trac_masse_vect
2409
2410	subroutine iso_verif_tracdd_vect(x,n,m,err_msg)
2411	use isotopes_mod, only: iso_HDO,iso_eau
2412	use isotrac_mod, only: strtrac
2413	implicit none
2414
2415	! inputs
2416	integer n,m
2417	real x(ntraciso,n,m)
2418	character() err_msg ! message d''erreur à afficher
2419
2420	! locals
2421	integer i,j,iiso,izone,ieau,ixt
2422	real xiiso(niso,n,m)
2423	real xeau(n,m)
2424	integer lnblnk
2425
2426	if (iso_HDO.gt.0) then
2427	do izone=1,nzone
2428	ieau=itZonIso(izone,iso_eau)
2429	do iiso=1,niso
2430	ixt=itZonIso(izone,iiso)
2431	do j=1,m
2432	do i=1,n
2433	xiiso(iiso,i,j)=x(ixt,i,j)
2434	enddo !do i=1,n
2435	enddo !do j=1,m
2436	enddo !do iiso=1,niso
2437
2438	do j=1,m
2439	do i=1,n
2440	xeau(i,j)=x(ieau,i,j)
2441	enddo !do i=1,n
2442	enddo !do j=1,m
2443
2444	call iso_verif_aberrant_vect2Dch( &
2445	& xiiso,xeau,err_msg//strtrac(izone),niso,n,m, &
2446	& deltalimtrac)
2447	enddo !do izone=1,nzone
2448	endif !if (iso_HDO.gt.0) then
2449
2450	end subroutine iso_verif_tracdd_vect
2451
2452	subroutine iso_verif_tracpos_vect(x,n,m,err_msg,seuil)
2453	implicit none
2454
2455	! inputs
2456	integer n,m
2457	real x(ntraciso,n,m)
2458	character() err_msg ! message d''erreur à afficher
2459	real seuil
2460
2461	! locals
2462	integer i,j,ixt
2463	logical iso_verif_traceur_nostop
2464	integer ifaux,jfaux,ixtfaux
2465
2466	iso_verif_traceur_nostop=.false.
2467	do j=1,m
2468	do i=1,n
2469	do ixt=niso+1,ntraciso
2470	if (x(ixt,i,j).lt.-seuil) then
2471	ifaux=i
2472	jfaux=j
2473	ixtfaux=ixt
2474	iso_verif_traceur_nostop=.true.
2475	endif
2476	enddo !do ixt=niso+1,ntraciso
2477	enddo !do i=1,n
2478	enddo !do j=1,m
2479
2480	if (iso_verif_traceur_nostop) then
2481	write(,) 'erreur detectée par verif positif ', &
2482	& 'dans iso_verif_traceur_vect'
2483	write(,) ''
2484	write(,) err_msg
2485	write(,) 'x=',x(:,ifaux,jfaux)
2486	stop
2487	endif
2488
2489	end subroutine iso_verif_tracpos_vect
2490
2491
2492
2493	subroutine iso_verif_tracnps(x,err_msg)
2494	use isotrac_mod, only: ridicule_trac
2495
2496	implicit none
2497	! vérifier des choses sur les traceurs
2498	! * toutes les zones donne t l'istope total
2499	! * pas de deltaD aberrant
2500
2501	! on prend les valeurs pas défaut pour
2502	! errmax,errmaxrel,ridicule_trac,deltalimtrac
2503
2504	! inputs
2505	real x(ntraciso)
2506	character() err_msg ! message d''erreur à afficher
2507
2508	! locals
2509	!integer iso_verif_tracnps_choix_nostop
2510
2511	if (iso_verif_tracnps_choix_nostop(x,err_msg, &
2512	& errmax,errmaxrel,ridicule_trac,deltalimtrac) &
2513	& .eq.1) then
2514	stop
2515	endif
2516
2517	end subroutine iso_verif_tracnps
2518
2519	subroutine iso_verif_tracpos_choix(x,err_msg,seuil)
2520	implicit none
2521	! vérifier des choses sur les traceurs
2522	! * toutes les zones donne t l'istope total
2523	! * pas de deltaD aberrant
2524
2525	! on prend les valeurs pas défaut pour
2526	! errmax,errmaxrel,ridicule_trac,deltalimtrac
2527
2528	! inputs
2529	real x(ntraciso)
2530	character() err_msg ! message d''erreur à afficher
2531	real seuil
2532
2533	! locals
2534	!integer iso_verif_tracpos_choix_nostop
2535
2536	if (iso_verif_tracpos_choix_nostop(x,err_msg,seuil) &
2537	& .eq.1) then
2538	stop
2539	endif
2540
2541	end subroutine iso_verif_tracpos_choix
2542
2543	subroutine iso_verif_traceur_choix(x,err_msg, &
2544	& errmax,errmaxrel,ridicule_trac_loc,deltalimtrac)
2545	implicit none
2546	! vérifier des choses sur les traceurs
2547	! * toutes les zones donne t l'istope total
2548	! * pas de deltaD aberrant
2549
2550	! inputs
2551	real x(ntraciso)
2552	character() err_msg ! message d''erreur à afficher
2553	real errmax,errmaxrel,ridicule_trac_loc,deltalimtrac
2554
2555	! locals
2556	!integer iso_verif_traceur_choix_nostop
2557
2558	if (iso_verif_traceur_choix_nostop(x,err_msg, &
2559	& errmax,errmaxrel,ridicule_trac_loc,deltalimtrac) &
2560	& .eq.1) then
2561	stop
2562	endif
2563
2564	end subroutine iso_verif_traceur_choix
2565
2566	function iso_verif_traceur_nostop(x,err_msg)
2567	use isotrac_mod, only: ridicule_trac
2568	!use isotopes_verif, only: errmax,errmaxrel,deltalimtrac
2569	implicit none
2570	! vérifier des choses sur les traceurs
2571	! * toutes les zones donne t l'istope total
2572	! * pas de deltaD aberrant
2573
2574	! on prend les valeurs pas défaut pour
2575	! errmax,errmaxrel,ridicule_trac,deltalimtrac
2576
2577	! inputs
2578	real x(ntraciso)
2579	character() err_msg ! message d''erreur à afficher
2580
2581	! output
2582	integer iso_verif_traceur_nostop
2583
2584	! locals
2585	!integer iso_verif_traceur_choix_nostop
2586
2587	iso_verif_traceur_nostop= &
2588	& iso_verif_traceur_choix_nostop(x,err_msg, &
2589	& errmax,errmaxrel,ridicule_trac,deltalimtrac)
2590
2591	end function iso_verif_traceur_nostop
2592
2593
2594	subroutine iso_verif_traceur_justmass(x,err_msg)
2595	implicit none
2596	! on vérifie que noNaN et masse
2597
2598	! on prend les valeurs pas défaut pour
2599	! errmax,errmaxrel,ridicule_trac,deltalimtrac
2600
2601	! inputs
2602	real x(ntraciso)
2603	character() err_msg ! message d''erreur à afficher
2604
2605	! locals
2606	!integer iso_verif_traceur_noNaN_nostop
2607	!integer iso_verif_tracm_choix_nostop
2608
2609	! verif noNaN
2610	if (iso_verif_traceur_noNaN_nostop(x,err_msg).eq.1) then
2611	stop
2612	endif
2613
2614	! verif masse
2615	if (iso_verif_tracm_choix_nostop(x,err_msg, &
2616	& errmax,errmaxrel).eq.1) then
2617	stop
2618	endif
2619
2620	end subroutine iso_verif_traceur_justmass
2621
2622	function iso_verif_traceur_jm_nostop(x,err_msg)
2623	implicit none
2624	! on vérifie que noNaN et masse
2625
2626	! on prend les valeurs pas défaut pour
2627	! errmax,errmaxrel,ridicule_trac,deltalimtrac
2628
2629	! inputs
2630	real x(ntraciso)
2631	character() err_msg ! message d''erreur à afficher
2632
2633	! output
2634	integer iso_verif_traceur_jm_nostop
2635
2636	! locals
2637	! integer iso_verif_traceur_noNaN_nostop
2638	!integer iso_verif_tracm_choix_nostop
2639
2640	iso_verif_traceur_jm_nostop=0
2641	! ! verif noNaN
2642	! if (iso_verif_traceur_noNaN_nostop(x,err_msg).eq.1) then
2643	! iso_verif_traceur_jm_nostop=1
2644	! endif
2645
2646	! verif masse
2647	if (iso_verif_tracm_choix_nostop(x,err_msg, &
2648	& errmax,errmaxrel).eq.1) then
2649	iso_verif_traceur_jm_nostop=1
2650	endif
2651
2652	end function iso_verif_traceur_jm_nostop
2653
2654	subroutine iso_verif_tag17_q_deltaD_vect(x,n,m,err_msg)
2655	USE isotopes_mod, ONLY: tnat,iso_eau, ridicule,iso_HDO
2656	use isotrac_mod, only: option_traceurs,nzone_temp
2657	implicit none
2658
2659	! inputs
2660	integer n,m
2661	real x(ntraciso,n,m)
2662	character() err_msg
2663
2664	! locals
2665	!integer iso_verif_positif_nostop
2666	!real deltaD
2667	integer ieau,ixt,ieau1
2668	integer i,k
2669
2670	if ((option_traceurs.eq.17).or. &
2671	& (option_traceurs.eq.18)) then
2672	! verifier que deltaD du tag de la couche la plus haute <
2673	! 200 permil, et vérifier que son q est inférieur à
2674	ieau=itZonIso(nzone_temp,iso_eau)
2675	ixt=itZonIso(nzone_temp,iso_HDO)
2676	ieau1=itZonIso(1,iso_eau)
2677	do i=1,n
2678	do k=1,m
2679	if (x(ieau,i,k).gt.ridicule) then
2680	if ((x(ixt,i,k)/x(ieau,i,k)/tnat(iso_HDO)-1)*1000 &
2681	& .gt.-200.0) then
2682	write(,) err_msg,', vect:deltaDt05 trop fort'
2683	write(,) 'i,k=',i,k
2684	write(,) 'x(:,i,k)=',x(:,i,k)
2685	stop
2686	endif !if (iso_verif_positif_nostop(-200.0-deltaD(x(ixt),x(ieau)),
2687	endif !if (x(ieau).gt.ridicule) then
2688	if (x(ieau,i,k).gt.2.0e-3) then
2689	write(,) err_msg,', vect:qt05 trop fort'
2690	write(,) 'i,k=',i,k
2691	write(,) 'x(:,i,k)=',x(:,i,k)
2692	stop
2693	endif !if (iso_verif_positif_nostop(1.0e-3-x(ieau),
2694	if (x(iso_eau,i,k).lt.2.0e-3) then
2695	if (x(ieau1,i,k)/x(iso_eau,i,k).gt.0.1) then
2696	write(,) err_msg,', vect: qt01 trop abondant'
2697	write(,) 'i,k=',i,k
2698	write(,) 'ieau1,iso_eau,x(ieau1,i,k),', &
2699	& 'x(iso_eau,i,k)=',ieau1,iso_eau, &
2700	& x(ieau1,i,k),x(iso_eau,i,k)
2701	write(,) 'x(:,i,k)=',x(:,i,k)
2702	stop
2703	endif !if (x(ieau1,i,k)/x(iso_eau,i,k).gt.0.1) then
2704	endif
2705	enddo !do k=1,m
2706	enddo !do i=1,n
2707
2708	endif !if (option_traceurs.eq.17) then
2709
2710	end subroutine iso_verif_tag17_q_deltaD_vect
2711
2712
2713	subroutine iso_verif_tag17_q_deltaD_vect_ret3D(x,n,m,nq,err_msg)
2714	USE isotopes_mod, ONLY: tnat,iso_eau,iso_HDO,ridicule
2715	use isotrac_mod, only: option_traceurs,nzone_temp
2716	implicit none
2717
2718	! inputs
2719	integer n,m,nq
2720	real x(n,m,nq,ntraciso)
2721	character() err_msg
2722
2723	! locals
2724	!integer iso_verif_positif_nostop
2725	!real deltaD
2726	integer ieau,ixt,ieau1
2727	integer i,k,iq
2728
2729	if ((option_traceurs.eq.17).or. &
2730	& (option_traceurs.eq.18)) then
2731	! verifier que deltaD du tag de la couche la plus haute <
2732	! 200 permil, et vérifier que son q est inférieur à
2733	ieau=itZonIso(nzone_temp,iso_eau)
2734	ixt=itZonIso(nzone_temp,iso_HDO)
2735	ieau1=itZonIso(1,iso_eau)
2736	do iq=1,nq
2737	do i=1,n
2738	do k=1,m
2739	if (x(i,k,iq,ieau).gt.ridicule) then
2740	if ((x(i,k,iq,ixt)/x(i,k,iq,ieau)/tnat(iso_HDO)-1)*1000 &
2741	& .gt.-200.0) then
2742	write(,) err_msg,', vect:deltaDt05 trop fort'
2743	write(,) 'i,k=',i,k
2744	write(,) 'x(i,k,iq,:)=',x(i,k,iq,:)
2745	stop
2746	endif !if (iso_verif_positif_nostop(-200.0-deltaD(x(ixt),x(ieau)),
2747	endif !if (x(ieau).gt.ridicule) then
2748	if (x(i,k,iq,ieau).gt.2.0e-3) then
2749	write(,) err_msg,', vect:qt05 trop fort'
2750	write(,) 'i,k=',i,k
2751	write(,) 'x(i,k,iq,:)=',x(i,k,iq,:)
2752	stop
2753	endif !if (iso_verif_positif_nostop(1.0e-3-x(ieau),
2754	if (x(i,k,iq,iso_eau).lt.2.0e-3) then
2755	if (x(i,k,iq,ieau1)/x(i,k,iq,iso_eau).gt.0.1) then
2756	write(,) err_msg,', vect: qt01 trop abondant'
2757	write(,) 'i,k=',i,k
2758	write(,) 'ieau1,iso_eau,x(i,k,iq,ieau1),', &
2759	& 'x(i,k,iq,ieau)=',ieau1,iso_eau, &
2760	& x(i,k,iq,ieau1),x(i,k,iq,iso_eau)
2761	write(,) 'x(i,k,iq,:)=',x(i,k,iq,:)
2762	stop
2763	endif !if (x(ieau1,i,k)/x(iso_eau,i,k).gt.0.1) then
2764	endif
2765	enddo !do k=1,m
2766	enddo !do i=1,n
2767	enddo ! do iq=1,nq
2768
2769	endif !if (option_traceurs.eq.17) then
2770
2771	end subroutine iso_verif_tag17_q_deltaD_vect_ret3D
2772
2773
2774	#endif
2775	! endif ISOTRAC
2776
2777	END MODULE isotopes_verif_mod
2778
2779	#endif
2780	! endif ISOVERIF
2781

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

Download in other formats:

Original Format