Context Navigation

isotopes_verif_mod.F90 @ 5116

Last change on this file since 5116 was 5116, checked in by abarral, 2 months ago
rename modules properly lmdz_* move ismin, ismax, minmax into new lmdz_libmath.f90 (lint) uppercase fortran keywords
Property svn:executable set to ``*
File size: 79.1 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 lmdz_ioipsl_getin_p, 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	END IF
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	END IF
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
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
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
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
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
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
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	#ifdef ISOVERIF
489	#else
490	WRITE(,) 'err_msg=',err_msg,': pourquoi verif?'
491	stop
492	#endif
493
494
495	END SUBROUTINE iso_verif_aberrant_o17
496
497	!*******************
498
499	function iso_verif_aberrant_o17_nostop(R17,R18,err_msg)
500	USE isotopes_mod, ONLY: tnat,iso_O17,iso_O18
501	IMPLICIT NONE
502	! si l'O17-excess est aberrant, on affiche un message
503	! d'erreur et renvoit 1
504
505	! input:
506	real R17,R18
507	character() err_msg ! message d''erreur à afficher
508	!local
509	!real o17excess
510	! output
511	integer iso_verif_aberrant_o17_nostop
512
513	if (O17_verif) THEN
514	iso_verif_aberrant_o17_nostop=0
515	if ((o17excess(R17,R18).gt.o17excess_haut).or. &
516	(o17excess(R17,R18).lt.o17excess_bas)) THEN
517	WRITE(,) 'erreur detectee par iso_verif_aberrant_O17:'
518	WRITE(,) err_msg
519	WRITE(,) 'o17excess=',o17excess(R17,R18)
520	WRITE(,) 'deltaO17=',(R17/tnat(iso_o17)-1.0)*1000.0
521	WRITE(,) 'deltaO18=',(R18/tnat(iso_O18)-1.0)*1000.0
522	! attention, vérifier que la ligne suivante est bien activée
523	iso_verif_aberrant_o17_nostop=1
524	endif
525
526	endif !if (O17_verif) THEN
527	#ifdef ISOVERIF
528	#else
529	WRITE(,) 'err_msg=',err_msg,': pourquoi verif?'
530	stop
531	#endif
532
533
534	END FUNCTION iso_verif_aberrant_o17_nostop
535
536
537	!************************************
538
539	SUBROUTINE iso_verif_noNaN(x,err_msg)
540	IMPLICIT NONE
541	! si x est NaN, on affiche message
542	! d'erreur et stoppe
543
544	! input:
545	real x
546	character() err_msg ! message d''erreur à afficher
547
548	! locals
549	!integer iso_verif_noNAN_nostop
550
551	if (iso_verif_noNAN_nostop(x,err_msg).eq.1) THEN
552	stop
553	endif
554	#ifdef ISOVERIF
555	#else
556	WRITE(,) 'err_msg iso443=',err_msg,': pourquoi verif?'
557	stop
558	#endif
559
560	END SUBROUTINE iso_verif_noNaN
561
562	!************************************
563
564	function iso_verif_noNaN_nostop(x,err_msg)
565	IMPLICIT NONE
566	! si x est NaN, on affiche message
567	! d'erreur et return 1 si erreur
568
569	! input:
570	real x
571	character() err_msg ! message d''erreur à afficher
572
573	! output
574	integer iso_verif_noNAN_nostop
575
576	if ((x.gt.-borne).and.(x.lt.borne)) THEN
577	iso_verif_noNAN_nostop=0
578	else
579	WRITE(,) 'erreur detectee par iso_verif_nonNAN:'
580	WRITE(,) err_msg
581	WRITE(,) 'x=',x
582	iso_verif_noNAN_nostop=1
583	endif
584
585	#ifdef ISOVERIF
586	#else
587	WRITE(,) 'err_msg iso 482=',err_msg,': pourquoi verif?'
588	stop
589	#endif
590
591
592	END FUNCTION iso_verif_noNaN_nostop
593
594	SUBROUTINE iso_verif_noNaN_vect2D(x,err_msg,ni,n,m)
595	IMPLICIT NONE
596	! si x est NaN, on affiche message
597	! d'erreur et return 1 si erreur
598
599	! input:
600	integer n,m,ni
601	real x(ni,n,m)
602	character() err_msg ! message d''erreur à afficher
603
604	! output
605
606	! locals
607	integer i,j,ixt
608
609	do i=1,n
610	do j=1,m
611	do ixt=1,ni
612	if ((x(ixt,i,j).gt.-borne).and. &
613	(x(ixt,i,j).lt.borne)) THEN
614	else !if ((x(ixt,i,j).gt.-borne).and.
615	WRITE(,) 'erreur detectee par iso_verif_nonNAN:'
616	WRITE(,) err_msg
617	WRITE(,) 'x,ixt,i,j=',x(ixt,i,j),ixt,i,j
618	stop
619	endif !if ((x(ixt,i,j).gt.-borne).and.
620	enddo !do ixt=1,ni
621	enddo !do j=1,m
622	enddo !do i=1,n
623
624	#ifdef ISOVERIF
625	#else
626	WRITE(,) 'err_msg iso525=',err_msg,': pourquoi verif?'
627	stop
628	#endif
629
630	END SUBROUTINE iso_verif_noNaN_vect2D
631
632
633	SUBROUTINE iso_verif_noNaN_vect1D(x,err_msg,ni,n)
634	IMPLICIT NONE
635	! si x est NaN, on affiche message
636	! d'erreur et return 1 si erreur
637
638	! input:
639	integer n,ni
640	real x(ni,n)
641	character() err_msg ! message d''erreur à afficher
642
643	! output
644
645	! locals
646	integer i,ixt
647
648	do i=1,n
649	do ixt=1,ni
650	if ((x(ixt,i).gt.-borne).and. &
651	(x(ixt,i).lt.borne)) THEN
652	else !if ((x(ixt,i,j).gt.-borne).and.
653	WRITE(,) 'erreur detectee par iso_verif_nonNAN:'
654	WRITE(,) err_msg
655	WRITE(,) 'x,ixt,i=',x(ixt,i),ixt,i
656	stop
657	endif !if ((x(ixt,i,j).gt.-borne).and.
658	enddo !do ixt=1,ni
659	enddo !do i=1,n
660
661	#ifdef ISOVERIF
662	#else
663	WRITE(,) 'err_msg iso525=',err_msg,': pourquoi verif?'
664	stop
665	#endif
666
667	END SUBROUTINE iso_verif_noNaN_vect1D
668
669
670
671	!************************
672	SUBROUTINE iso_verif_egalite_choix(a,b,err_msg,erabs,errel)
673	IMPLICIT NONE
674	! compare a et b. Si pas egal, on affiche message
675	! d'erreur et stoppe
676	! pour egalite, on verifie erreur absolue et arreur relative
677
678	! input:
679	real a, b
680	real erabs,errel !erreur absolue et relative
681	character() err_msg ! message d''erreur à afficher
682
683	! locals
684	!integer iso_verif_egalite_choix_nostop
685
686	if (iso_verif_egalite_choix_nostop( &
687	a,b,err_msg,erabs,errel).eq.1) THEN
688	stop
689	endif
690
691	#ifdef ISOVERIF
692	#else
693	WRITE(,) 'err_msg=',err_msg,': pourquoi verif?'
694	stop
695	#endif
696
697	END SUBROUTINE iso_verif_egalite_choix
698
699	!************************
700	function iso_verif_egalite_choix_nostop &
701	(a,b,err_msg,erabs,errel)
702	IMPLICIT NONE
703	! compare a et b. Si pas egal, on affiche message
704	! d'erreur et stoppe
705	! pour egalite, on verifie erreur absolue et arreur relative
706
707	! input:
708	real a, b
709	real erabs,errel !erreur absolue et relative
710	character() err_msg ! message d''erreur à afficher
711
712	! output
713	integer iso_verif_egalite_choix_nostop
714	! locals
715	!integer iso_verif_noNaN_nostop
716
717	iso_verif_egalite_choix_nostop=0
718
719	#ifdef ISOVERIF
720	if (iso_verif_noNaN_nostop(a,err_msg).eq.1) THEN
721	WRITE(,) 'a=',a
722	iso_verif_egalite_choix_nostop=1
723	endif
724	if (iso_verif_noNaN_nostop(b,err_msg).eq.1) THEN
725	WRITE(,) 'b=',b
726	iso_verif_egalite_choix_nostop=1
727	endif
728	#endif
729
730	if (abs(a-b).gt.erabs) THEN
731	if (abs((a-b)/max(max(abs(b),abs(a)),1e-18)) &
732	.gt.errel) THEN
733	WRITE(,) 'erreur detectee par iso_verif_egalite:'
734	WRITE(,) err_msg
735	WRITE(,) 'a=',a
736	WRITE(,) 'b=',b
737	WRITE(,) 'erabs,errel=',erabs,errel
738	iso_verif_egalite_choix_nostop=1
739	! stop
740	endif
741	endif
742
743	#ifdef ISOVERIF
744	#else
745	WRITE(,) 'err_msg=',err_msg,': pourquoi verif?'
746	stop
747	#endif
748
749
750	END FUNCTION iso_verif_egalite_choix_nostop
751
752
753
754	!******************
755	SUBROUTINE iso_verif_positif(x,err_msg)
756	use isotopes_mod, ONLY: ridicule
757	IMPLICIT NONE
758	! si x<0, on plante.
759	! si très limite, on le met à 0.
760
761	! input:
762	real x
763	character() err_msg ! message d''erreur à afficher
764
765	! locals
766	!integer iso_verif_positif_choix_nostop
767
768	if (iso_verif_positif_choix_nostop(x,ridicule,err_msg) &
769	.eq.1) THEN
770	stop
771	endif
772
773	#ifdef ISOVERIF
774	#else
775	WRITE(,) 'iso_verif 637: err_msg=',err_msg, &
776	': pourquoi verif?'
777	stop
778	#endif
779
780	END SUBROUTINE iso_verif_positif
781
782	!******************
783	SUBROUTINE iso_verif_positif_vect(x,n,err_msg)
784	use isotopes_mod, ONLY: ridicule
785	IMPLICIT NONE
786	! si x<0, on plante.
787
788	! input:
789	integer n
790	real x(n)
791	character() err_msg ! message d''erreur à afficher
792
793	! locals
794	integer i
795	integer iso_verif_positif_nostop
796	integer ifaux
797
798	iso_verif_positif_nostop=0
799	do i=1,n
800	if (x(i).lt.-ridicule) THEN
801	iso_verif_positif_nostop=1
802	ifaux=i
803	endif
804	enddo
805	if (iso_verif_positif_nostop.eq.1) THEN
806	WRITE(,) 'erreur detectee par iso_verif_positif_vect:'
807	WRITE(,) err_msg
808	WRITE(,) 'i,x=',ifaux,x(ifaux)
809	stop
810	endif
811
812	END SUBROUTINE iso_verif_positif_vect
813
814	SUBROUTINE iso_verif_positif_choix_vect(x,n,ridic,err_msg)
815	IMPLICIT NONE
816	! si x<0, on plante.
817
818	! input:
819	integer n
820	real x(n)
821	real ridic
822	character() err_msg ! message d''erreur à afficher
823	! locals
824	integer i
825	integer iso_verif_positif_nostop
826	integer ifaux
827
828	iso_verif_positif_nostop=0
829	do i=1,n
830	if (x(i).lt.-ridic) THEN
831	iso_verif_positif_nostop=1
832	ifaux=i
833	endif
834	enddo
835	if (iso_verif_positif_nostop.eq.1) THEN
836	WRITE(,) 'erreur detectee par iso_verif_positif_choix_vect:'
837	WRITE(,) err_msg
838	WRITE(,) 'i,x=',ifaux,x(ifaux)
839	stop
840	endif
841
842	END SUBROUTINE iso_verif_positif_choix_vect
843
844
845	!******************
846	SUBROUTINE iso_verif_positif_strict(x,err_msg)
847	IMPLICIT NONE
848	! si x<0, on plante.
849	! si très limite, on le met à 0.
850
851	! input:
852	real x
853	character() err_msg ! message d''erreur à afficher
854
855	! locals
856	!integer iso_verif_positif_strict_nostop
857
858	if (iso_verif_positif_strict_nostop(x,err_msg) &
859	.eq.1) THEN
860	stop
861	endif
862
863	END SUBROUTINE iso_verif_positif_strict
864
865	!******************
866
867	function iso_verif_positif_strict_nostop(x,err_msg)
868	IMPLICIT NONE
869	! si x<0, on plante.
870	! si très limite, on le met à 0.
871
872	! input:
873	real x
874	character() err_msg ! message d''erreur à afficher*
875
876	! output
877	integer iso_verif_positif_strict_nostop
878
879	if (x.gt.0.0) THEN
880	iso_verif_positif_strict_nostop=0
881	else
882	WRITE(,) 'erreur detectee par iso_verif_positif_strict:'
883	WRITE(,) err_msg
884	WRITE(,) 'x=',x
885	iso_verif_positif_strict_nostop=1
886	! stop
887	endif
888
889
890	END FUNCTION iso_verif_positif_strict_nostop
891
892	!******************
893
894	SUBROUTINE iso_verif_positif_choix(x,ridic,err_msg)
895	IMPLICIT NONE
896	! si x<0, on plante.
897	! si très limite, on le met à 0.
898
899	! input:
900	real x
901	real ridic
902	character() err_msg ! message d''erreur à afficher
903
904	! locals
905	!integer iso_verif_positif_choix_nostop
906
907	if (iso_verif_positif_choix_nostop(x,ridic,err_msg) &
908	.eq.1) THEN
909	stop
910	endif
911
912	#ifdef ISOVERIF
913	#else
914	WRITE(,) 'iso_verif 801: err_msg=',err_msg, &
915	': pourquoi verif?'
916	stop
917	#endif
918
919	END SUBROUTINE iso_verif_positif_choix
920
921	!******************
922	function iso_verif_positif_nostop(x,err_msg)
923	use isotopes_mod, ONLY: ridicule
924	IMPLICIT NONE
925	! si x<0, on plante.
926	! si très limite, on le met à 0.
927
928	! input:
929	real x
930	character() err_msg ! message d''erreur à afficher
931
932	! output
933	integer iso_verif_positif_nostop
934
935	! locals
936	!integer iso_verif_positif_choix_nostop
937
938	iso_verif_positif_nostop=iso_verif_positif_choix_nostop &
939	(x,ridicule,err_msg)
940
941	#ifdef ISOVERIF
942	#else
943	WRITE(,) 'iso_verif 837: err_msg=',err_msg, &
944	': pourquoi verif?'
945	stop
946
947	#endif
948
949
950	END FUNCTION iso_verif_positif_nostop
951
952	!******************
953	function iso_verif_positif_choix_nostop(x,ridic,err_msg)
954	IMPLICIT NONE
955	! si x<0, on plante.
956	! si très limite, on le met à 0.
957
958	! input:
959	real x
960	real ridic
961	character() err_msg ! message d''erreur à afficher
962
963	! output
964	integer iso_verif_positif_choix_nostop
965
966	if (x.lt.-ridic) THEN
967	WRITE(,) 'erreur detectee par iso_verif_positif_nostop:'
968	WRITE(,) err_msg
969	WRITE(,) 'x=',x
970	iso_verif_positif_choix_nostop=1
971	else
972	! x=max(x,0.0)
973	iso_verif_positif_choix_nostop=0
974	endif
975
976	#ifdef ISOVERIF
977	#else
978	WRITE(,) 'iso_verif 877: err_msg=',err_msg, &
979	': pourquoi verif?'
980	stop
981	#endif
982
983
984	END FUNCTION iso_verif_positif_choix_nostop
985
986
987	!**************
988
989
990	SUBROUTINE iso_verif_O18_aberrant(Rd,Ro,err_msg)
991	IMPLICIT NONE
992
993	! vérifie que:
994	! 1) deltaD et deltaO18 dans bonne gamme
995	! 2) dexcess dans bonne gamme
996	! input:
997	real Rd,Ro
998	character() err_msg ! message d''erreur à afficher
999
1000	! local
1001	!integer iso_verif_O18_aberrant_nostop
1002
1003	if (iso_verif_O18_aberrant_nostop(Rd,Ro,err_msg).eq.1) THEN
1004	stop
1005	endif
1006
1007	END SUBROUTINE iso_verif_O18_aberrant
1008
1009	function iso_verif_O18_aberrant_nostop(Rd,Ro,err_msg)
1010	USE isotopes_mod, ONLY: tnat, iso_HDO, iso_O18
1011	IMPLICIT NONE
1012
1013	! vérifie que:
1014	! 1) deltaD et deltaO18 dans bonne gamme
1015	! 2) dexcess dans bonne gamme
1016
1017	! input:
1018	real Rd,Ro
1019	character() err_msg ! message d''erreur à afficher
1020
1021	! outputs
1022	integer iso_verif_O18_aberrant_nostop
1023
1024	!locals
1025	real deltaD,deltao,dexcess
1026
1027	deltaD=(Rd/tnat(iso_hdo)-1)*1000
1028	deltao=(Ro/tnat(iso_O18)-1)*1000
1029	dexcess=deltaD-8*deltao
1030
1031	iso_verif_O18_aberrant_nostop=0
1032	if ((deltaD.lt.deltaDmin).or.(deltao.lt.deltaDmin/2.0).or. &
1033	(deltaD.gt.deltalim).or.(deltao.gt.deltalim/8.0).or. &
1034	((deltaD.gt.-500.0).and.((dexcess.lt.dexcess_min) &
1035	.or.(dexcess.gt.dexcess_max)))) THEN
1036	WRITE(,) 'erreur detectee par iso_verif_O18_aberrant:'
1037	WRITE(,) err_msg
1038	WRITE(,) 'delta180=',deltao
1039	WRITE(,) 'deltaD=',deltaD
1040	WRITE(,) 'Dexcess=',dexcess
1041	WRITE(,) 'tnat=',tnat
1042	! stop
1043	iso_verif_O18_aberrant_nostop=1
1044	endif
1045
1046	#ifdef ISOVERIF
1047	#else
1048	WRITE(,) 'err_msg=',err_msg,': pourquoi verif?'
1049	stop
1050	#endif
1051
1052
1053	END FUNCTION iso_verif_O18_aberrant_nostop
1054
1055
1056	! **********
1057	function deltaD(R)
1058	USE isotopes_mod, ONLY: tnat,iso_HDO
1059	IMPLICIT NONE
1060	real R,deltaD
1061
1062
1063	if (iso_HDO.gt.0) THEN
1064	deltaD=(R/tnat(iso_HDO)-1)*1000.0
1065	else
1066	WRITE(,) 'iso_verif_egalite>deltaD 260: iso_HDO.gt.0=', &
1067	iso_HDO.gt.0
1068	endif
1069
1070	END FUNCTION deltaD
1071
1072	! **********
1073	function deltaO(R)
1074	USE isotopes_mod, ONLY: tnat,iso_O18
1075	IMPLICIT NONE
1076	real R,deltaO
1077
1078	if (iso_O18.gt.0) THEN
1079	deltaO=(R/tnat(iso_O18)-1)*1000.0
1080	else
1081	WRITE(,) 'iso_verif_egalite>deltaO18 260: iso_O18.gt.0=', &
1082	iso_O18.gt.0
1083	endif
1084
1085	END FUNCTION deltaO
1086
1087	! **********
1088	function dexcess(RD,RO)
1089	USE isotopes_mod, ONLY: tnat,iso_O18,iso_HDO
1090	IMPLICIT NONE
1091	real RD,RO,deltaD,deltaO,dexcess
1092
1093	if ((iso_O18.gt.0).and.(iso_HDO.gt.0)) THEN
1094	deltaD=(RD/tnat(iso_HDO)-1)*1000.0
1095	deltaO=(RO/tnat(iso_O18)-1)*1000.0
1096	dexcess=deltaD-8*deltaO
1097	else
1098	WRITE(,) 'iso_verif_egalite 1109: iso_O18,iso_HDO=',iso_O18,iso_HDO
1099	endif
1100
1101	END FUNCTION dexcess
1102
1103
1104	! **********
1105	function delta_all(R,ixt)
1106	USE isotopes_mod, ONLY: tnat
1107	IMPLICIT NONE
1108	real R,delta_all
1109	integer ixt
1110
1111	delta_all=(R/tnat(ixt)-1)*1000.0
1112
1113	END FUNCTION delta_all
1114
1115	! **********
1116	function delta_to_R(delta,ixt)
1117	USE isotopes_mod, ONLY: tnat
1118	IMPLICIT NONE
1119	real delta,delta_to_R
1120	integer ixt
1121
1122	delta_to_R=(delta/1000.0+1.0)*tnat(ixt)
1123
1124	END FUNCTION delta_to_R
1125
1126	! **********
1127	function o17excess(R17,R18)
1128	USE isotopes_mod, ONLY: tnat,iso_O18,iso_O17
1129	IMPLICIT NONE
1130	real R17,R18,o17excess
1131
1132	if ((iso_O17.gt.0).and.(iso_O18.gt.0)) THEN
1133	o17excess=1e6*(log(R17/tnat(iso_o17)) &
1134	-0.528*log(R18/tnat(iso_O18)))
1135	! WRITE(,) 'o17excess=',o17excess
1136	else
1137	WRITE(,) 'iso_verif_egalite>deltaD 260: iso_O17.gt.0,18=', &
1138	iso_O17.gt.0,iso_O18.gt.0
1139	endif
1140
1141	END FUNCTION o17excess
1142
1143	! ****************
1144
1145	SUBROUTINE iso_verif_egalite_vect2D( &
1146	xt,q,err_msg,ni,n,m)
1147
1148	USE isotopes_mod, ONLY: iso_eau
1149	IMPLICIT NONE
1150
1151	! inputs
1152	integer n,m,ni
1153	real q(n,m)
1154	real xt(ni,n,m)
1155	character() err_msg
1156
1157	! locals
1158	integer iso_verif_egalite_nostop_loc
1159	integer i,j,ixt
1160	integer ifaux,jfaux
1161
1162	!WRITE(,) 'iso_verif_egalite_vect2D 1099 tmp: q(2,1),xt(iso_eau,2,1)=',q(2,1),xt(iso_eau,2,1)
1163	!WRITE(,) 'ni,n,m=',ni,n,m,errmax,errmaxrel
1164	if (iso_eau.gt.0) THEN
1165	iso_verif_egalite_nostop_loc=0
1166	do i=1,n
1167	do j=1,m
1168	if (abs(q(i,j)-xt(iso_eau,i,j)).gt.errmax) THEN
1169	if (abs((q(i,j)-xt(iso_eau,i,j))/ &
1170	max(max(abs(q(i,j)),abs(xt(iso_eau,i,j))),1e-18)) &
1171	.gt.errmaxrel) THEN
1172	iso_verif_egalite_nostop_loc=1
1173	ifaux=i
1174	jfaux=j
1175	endif
1176	endif
1177	enddo !do j=1,m
1178	enddo !do i=1,n
1179
1180	if (iso_verif_egalite_nostop_loc.eq.1) THEN
1181	WRITE(,) 'erreur detectee par iso_verif_egalite_vect2D:'
1182	WRITE(,) err_msg
1183	WRITE(,) 'i,j=',ifaux,jfaux
1184	WRITE(,) 'xt,q=',xt(iso_eau,ifaux,jfaux),q(ifaux,jfaux)
1185	stop
1186	endif
1187	endif
1188
1189	#ifdef ISOVERIF
1190	CALL iso_verif_noNaN_vect2D(xt,err_msg,ni,n,m)
1191	#endif
1192
1193
1194	END SUBROUTINE iso_verif_egalite_vect2D
1195
1196	SUBROUTINE iso_verif_egalite_vect1D( &
1197	xt,q,err_msg,ni,n)
1198
1199	USE isotopes_mod, ONLY: iso_eau
1200	IMPLICIT NONE
1201
1202	! inputs
1203	integer n,ni
1204	real q(n)
1205	real xt(ni,n)
1206	character() err_msg
1207
1208	! locals
1209	integer iso_verif_egalite_nostop_loc
1210	integer i
1211	integer ifaux
1212
1213	if (iso_eau.gt.0) THEN
1214	iso_verif_egalite_nostop_loc=0
1215	do i=1,n
1216	if (abs(q(i)-xt(iso_eau,i)).gt.errmax) THEN
1217	if (abs((q(i)-xt(iso_eau,i))/ &
1218	max(max(abs(q(i)),abs(xt(iso_eau,i))),1e-18)) &
1219	.gt.errmaxrel) THEN
1220	iso_verif_egalite_nostop_loc=1
1221	ifaux=i
1222	endif !if (abs((q(i)-xt(iso_eau,i))/
1223	endif !if (abs(q(i)-xt(iso_eau,i)).gt.errmax) THEN
1224	enddo !do i=1,n
1225
1226	if (iso_verif_egalite_nostop_loc.eq.1) THEN
1227	WRITE(,) 'erreur detectee par iso_verif_egalite_vect2D:'
1228	WRITE(,) err_msg
1229	WRITE(,) 'i=',ifaux
1230	WRITE(,) 'xt,q=',xt(iso_eau,ifaux),q(ifaux)
1231	stop
1232	endif !if (iso_verif_egalite_nostop.eq.1) THEN
1233	endif !if (iso_eau.gt.0) THEN
1234	END SUBROUTINE iso_verif_egalite_vect1D
1235
1236	SUBROUTINE iso_verif_egalite_std_vect( &
1237	a,b,err_msg,n,m,errmax,errmaxrel)
1238
1239	IMPLICIT NONE
1240
1241	! inputs
1242	integer n,m,ni
1243	real a(n,m)
1244	real b(n,m)
1245	character() err_msg
1246	real errmax,errmaxrel
1247
1248	! locals
1249	integer iso_verif_egalite_nostop_loc
1250	integer i,j
1251	integer ifaux,jfaux
1252
1253	iso_verif_egalite_nostop_loc=0
1254	do i=1,n
1255	do j=1,m
1256	if (abs(a(i,j)-b(i,j)).gt.errmax) THEN
1257	if (abs((a(i,j)-b(i,j))/ &
1258	max(max(abs(a(i,j)),abs(b(i,j))),1e-18)) &
1259	.gt.errmaxrel) THEN
1260	iso_verif_egalite_nostop_loc=1
1261	ifaux=i
1262	jfaux=j
1263	endif
1264	endif
1265	enddo !do j=1,m
1266	enddo !do i=1,n
1267
1268	if (iso_verif_egalite_nostop_loc.eq.1) THEN
1269	WRITE(,) 'erreur detectee par iso_verif_egalite_vect2D:'
1270	WRITE(,) err_msg
1271	WRITE(,) 'i,j=',ifaux,jfaux
1272	WRITE(,) 'a,b=',a(ifaux,jfaux),b(ifaux,jfaux)
1273	stop
1274	endif
1275
1276
1277	END SUBROUTINE iso_verif_egalite_std_vect
1278
1279	SUBROUTINE iso_verif_aberrant_vect2D( &
1280	xt,q,err_msg,ni,n,m)
1281	use isotopes_mod, ONLY: ridicule,tnat,iso_HDO
1282	IMPLICIT NONE
1283
1284	! inputs
1285	integer n,m,ni
1286	real q(n,m)
1287	real xt(ni,n,m)
1288	character() err_msg
1289
1290	! locals
1291	integer iso_verif_aberrant_nostop_loc
1292	integer i,j
1293	integer ifaux,jfaux
1294	!real deltaD
1295
1296	if (iso_HDO.gt.0) THEN
1297	iso_verif_aberrant_nostop_loc=0
1298	do i=1,n
1299	do j=1,m
1300	if (q(i,j).gt.ridicule) THEN
1301	if (((xt(iso_HDO,i,j)/q(i,j)/tnat(iso_HDO)-1)*1000.0 &
1302	.gt.deltalim).or. &
1303	((xt(iso_HDO,i,j)/q(i,j)/tnat(iso_HDO)-1)*1000.0 &
1304	.lt.-borne)) THEN
1305	iso_verif_aberrant_nostop_loc=1
1306	ifaux=i
1307	jfaux=j
1308	endif
1309	endif
1310	enddo !do j=1,m
1311	enddo !do i=1,n
1312
1313	if (iso_verif_aberrant_nostop_loc.eq.1) THEN
1314	WRITE(,) 'erreur detectee par iso_verif_aberrant_vect2D:'
1315	WRITE(,) err_msg
1316	WRITE(,) 'i,j=',ifaux,jfaux
1317	WRITE(,) 'deltaD=',deltaD(xt(iso_HDO,ifaux,jfaux) &
1318	/q(ifaux,jfaux))
1319	WRITE(,) 'xt(:,ifaux,jfaux)=',xt(:,ifaux,jfaux)
1320	stop
1321	endif
1322	endif !if (iso_HDO.gt.0) THEN
1323	END SUBROUTINE iso_verif_aberrant_vect2D
1324
1325	SUBROUTINE iso_verif_aberrant_enc_vect2D( &
1326	xt,q,err_msg,ni,n,m)
1327
1328	use isotopes_mod, ONLY: ridicule,tnat,iso_HDO
1329	IMPLICIT NONE
1330
1331	! inputs
1332	integer n,m,ni
1333	real q(n,m)
1334	real xt(ni,n,m)
1335	character() err_msg
1336
1337	! locals
1338	integer iso_verif_aberrant_nostop_loc
1339	integer i,j
1340	integer ifaux,jfaux
1341	!real deltaD
1342
1343	if (iso_HDO.gt.0) THEN
1344	iso_verif_aberrant_nostop_loc=0
1345	do i=1,n
1346	do j=1,m
1347	if (q(i,j).gt.ridicule) THEN
1348	if (((xt(iso_HDO,i,j)/q(i,j)/tnat(iso_HDO)-1)*1000.0 &
1349	.gt.deltalim).or. &
1350	((xt(iso_HDO,i,j)/q(i,j)/tnat(iso_HDO)-1)*1000.0 &
1351	.lt.deltaDmin).or. &
1352	(xt(iso_HDO,i,j).lt.-borne).or. &
1353	(xt(iso_HDO,i,j).gt.borne)) THEN
1354	iso_verif_aberrant_nostop_loc=1
1355	ifaux=i
1356	jfaux=j
1357	endif
1358	endif
1359	enddo !do j=1,m
1360	enddo !do i=1,n
1361
1362	if (iso_verif_aberrant_nostop_loc.eq.1) THEN
1363	WRITE(,) 'erreur detectee par ', &
1364	'iso_verif_aberrant_enc_vect2D:'
1365	WRITE(,) err_msg
1366	WRITE(,) 'i,j=',ifaux,jfaux
1367	WRITE(,) 'deltaD=',deltaD(xt(iso_HDO,ifaux,jfaux) &
1368	/q(ifaux,jfaux))
1369	WRITE(,) 'xt(:,ifaux,jfaux)=',xt(:,ifaux,jfaux)
1370	WRITE(,) 'q(ifaux,jfaux)=',q(ifaux,jfaux)
1371	CALL abort_physic('isotopes_verif_mod','iso_verif_aberrant_enc_vect2D',1)
1372	endif
1373	endif !if (iso_HDO.gt.0) THEN
1374	END SUBROUTINE iso_verif_aberrant_enc_vect2D
1375
1376
1377	SUBROUTINE iso_verif_aberrant_enc_vect2D_ns( &
1378	xt,q,err_msg,ni,n,m)
1379
1380	use isotopes_mod, ONLY: ridicule,tnat,iso_HDO
1381	IMPLICIT NONE
1382
1383	! inputs
1384	integer n,m,ni
1385	real q(n,m)
1386	real xt(ni,n,m)
1387	character() err_msg
1388
1389	! locals
1390	integer iso_verif_aberrant_nostop_loc
1391	integer i,j
1392	integer ifaux,jfaux
1393	!real deltaD
1394
1395	if (iso_HDO.gt.0) THEN
1396	iso_verif_aberrant_nostop_loc=0
1397	do i=1,n
1398	do j=1,m
1399	if (q(i,j).gt.ridicule) THEN
1400	if (((xt(iso_HDO,i,j)/q(i,j)/tnat(iso_HDO)-1)*1000.0 &
1401	.gt.deltalim).or. &
1402	((xt(iso_HDO,i,j)/q(i,j)/tnat(iso_HDO)-1)*1000.0 &
1403	.lt.deltaDmin)) THEN
1404	iso_verif_aberrant_nostop_loc=1
1405	ifaux=i
1406	jfaux=j
1407	endif
1408	endif
1409	enddo !do j=1,m
1410	enddo !do i=1,n
1411
1412	if (iso_verif_aberrant_nostop_loc.eq.1) THEN
1413	WRITE(,) 'erreur detectee par ', &
1414	'iso_verif_aberrant_vect2D_ns:'
1415	WRITE(,) err_msg
1416	WRITE(,) 'i,j=',ifaux,jfaux
1417	WRITE(,) 'deltaD=',deltaD(xt(iso_HDO,ifaux,jfaux) &
1418	/q(ifaux,jfaux))
1419	WRITE(,) 'xt(:,ifaux,jfaux)=',xt(:,ifaux,jfaux)
1420	! stop
1421	endif
1422	endif !if (iso_HDO.gt.0) THEN
1423	END SUBROUTINE iso_verif_aberrant_enc_vect2D_ns
1424
1425
1426	SUBROUTINE iso_verif_aberrant_vect2Dch( &
1427	xt,q,err_msg,ni,n,m,deltaDmax)
1428
1429	use isotopes_mod, ONLY: ridicule,tnat,iso_HDO
1430	IMPLICIT NONE
1431
1432
1433	! inputs
1434	integer n,m,ni
1435	real q(n,m)
1436	real xt(ni,n,m)
1437	character() err_msg
1438	real deltaDmax
1439
1440	! locals
1441	integer iso_verif_aberrant_nostop_loc
1442	integer i,j
1443	integer ifaux,jfaux
1444	!real deltaD
1445
1446	if (iso_HDO.gt.0) THEN
1447	iso_verif_aberrant_nostop_loc=0
1448	do i=1,n
1449	do j=1,m
1450	if (q(i,j).gt.ridicule) THEN
1451	if (((xt(iso_HDO,i,j)/q(i,j)/tnat(iso_HDO)-1)*1000.0 &
1452	.gt.deltaDmax).or. &
1453	((xt(iso_HDO,i,j)/q(i,j)/tnat(iso_HDO)-1)*1000.0 &
1454	.lt.-borne)) THEN
1455	iso_verif_aberrant_nostop_loc=1
1456	ifaux=i
1457	jfaux=j
1458	endif
1459	endif
1460	enddo !do j=1,m
1461	enddo !do i=1,n
1462
1463	if (iso_verif_aberrant_nostop_loc.eq.1) THEN
1464	WRITE(,) 'erreur detectee par iso_verif_aberrant_vect2D:'
1465	WRITE(,) err_msg
1466	WRITE(,) 'i,j=',ifaux,jfaux
1467	WRITE(,) 'deltaD=',deltaD(xt(iso_HDO,ifaux,jfaux) &
1468	/q(ifaux,jfaux))
1469	WRITE(,) 'xt(:,ifaux,jfaux)=',xt(:,ifaux,jfaux)
1470	stop
1471	endif
1472	endif !if (iso_HDO.gt.0) THEN
1473	END SUBROUTINE iso_verif_aberrant_vect2Dch
1474
1475	SUBROUTINE iso_verif_O18_aberrant_enc_vect2D( &
1476	xt,q,err_msg,ni,n,m)
1477
1478	use isotopes_mod, ONLY: ridicule,tnat,iso_HDO,iso_O18
1479	IMPLICIT NONE
1480
1481	! inputs
1482	integer n,m,ni
1483	real q(n,m)
1484	real xt(ni,n,m)
1485	character() err_msg
1486
1487	! locals
1488	integer iso_verif_aberrant_nostop_loc
1489	integer i,j
1490	integer ifaux,jfaux
1491	real deltaDloc,deltaoloc,dexcessloc
1492
1493	if ((iso_HDO.gt.0).and.(iso_O18.gt.0)) THEN
1494	iso_verif_aberrant_nostop_loc=0
1495	do i=1,n
1496	do j=1,m
1497	if (q(i,j).gt.ridicule) THEN
1498	deltaDloc=(xt(iso_HDO,i,j)/q(i,j)/tnat(iso_hdo)-1)*1000
1499	deltaoloc=(xt(iso_O18,i,j)/q(i,j)/tnat(iso_O18)-1)*1000
1500	dexcessloc=deltaDloc-8*deltaoloc
1501	if ((deltaDloc.lt.deltaDmin).or.(deltaoloc.lt.deltaDmin/2.0).or. &
1502	(deltaDloc.gt.deltalim).or.(deltaoloc.gt.deltalim/8.0).or. &
1503	((deltaDloc.gt.-500.0).and.((dexcessloc.lt.dexcess_min) &
1504	.or.(dexcessloc.gt.dexcess_max)))) THEN
1505	iso_verif_aberrant_nostop_loc=1
1506	ifaux=i
1507	jfaux=j
1508	WRITE(,) 'deltaD,deltao,dexcess=',deltaDloc,deltaoloc,dexcessloc
1509	endif
1510	endif
1511	enddo !do j=1,m
1512	enddo !do i=1,n
1513
1514	if (iso_verif_aberrant_nostop_loc.eq.1) THEN
1515	WRITE(,) 'erreur detectee par ', &
1516	'iso_verif_aberrant_enc_vect2D:'
1517	WRITE(,) err_msg
1518	WRITE(,) 'i,j=',ifaux,jfaux
1519	WRITE(,) 'xt(:,ifaux,jfaux)=',xt(:,ifaux,jfaux)
1520	WRITE(,) 'q(ifaux,jfaux)=',q(ifaux,jfaux)
1521	CALL abort_physic('isotopes_verif_mod','iso_verif_aberrant_enc_vect2D',1)
1522	endif
1523	endif !if (iso_HDO.gt.0) THEN
1524	END SUBROUTINE iso_verif_O18_aberrant_enc_vect2D
1525
1526
1527	SUBROUTINE select_dim23_from4D(n1,n2,n3,n4, &
1528	var,vec,i1,i4)
1529	IMPLICIT NONE
1530
1531	! inputs
1532	integer n1,n2,n3,n4
1533	real var(n1,n2,n3,n4)
1534	integer i1,i4
1535	! outputs
1536	real vec(n2,n3)
1537	! locals
1538	integer i2,i3
1539
1540	do i2=1,n2
1541	do i3=1,n3
1542	vec(i2,i3)=var(i1,i2,i3,i4)
1543	enddo
1544	enddo
1545
1546
1547	END SUBROUTINE select_dim23_from4D
1548
1549
1550	SUBROUTINE select_dim4_from4D(ntime,nlev,nlat,nlon, &
1551	var,vec,itime,ilev,ilat)
1552	IMPLICIT NONE
1553
1554	! inputs
1555	integer ntime,nlev,nlat,nlon
1556	real var(ntime,nlev,nlat,nlon)
1557	integer itime,ilev,ilat
1558	! outputs
1559	real vec(nlon)
1560	! locals
1561	integer ilon
1562
1563	do ilon=1,nlon
1564	vec(ilon)=var(itime,ilev,ilat,ilon)
1565	enddo
1566
1567
1568	END SUBROUTINE select_dim4_from4D
1569
1570	SUBROUTINE select_dim5_from5D(n1,n2,n3,n4,n5, &
1571	var,vec,i1,i2,i3,i4)
1572	IMPLICIT NONE
1573
1574	! inputs
1575	integer n1,n2,n3,n4,n5
1576	real var(n1,n2,n3,n4,n5)
1577	integer i1,i2,i3,i4
1578	! outputs
1579	real vec(n5)
1580	! locals
1581	integer i5
1582
1583	do i5=1,n5
1584	vec(i5)=var(i1,i2,i3,i4,i5)
1585	enddo
1586
1587	END SUBROUTINE select_dim5_from5D
1588
1589
1590	SUBROUTINE select_dim3_from3D(ntime,nlat,nlon, &
1591	var,vec,itime,ilat)
1592	IMPLICIT NONE
1593
1594	! inputs
1595	integer ntime,nlat,nlon
1596	real var(ntime,nlat,nlon)
1597	integer itime,ilat
1598	! outputs
1599	real vec(nlon)
1600	! locals
1601	integer ilon
1602
1603	do ilon=1,nlon
1604	vec(ilon)=var(itime,ilat,ilon)
1605	enddo
1606
1607	END SUBROUTINE select_dim3_from3D
1608
1609
1610	SUBROUTINE select_dim23_from3D(n1,n2,n3, &
1611	var,vec,i1)
1612	IMPLICIT NONE
1613
1614	! inputs
1615	integer n1,n2,n3
1616	real var(n1,n2,n3)
1617	integer i1
1618	! outputs
1619	real vec(n2,n3)
1620	! locals
1621	integer i2,i3
1622
1623	do i2=1,n2
1624	do i3=1,n3
1625	vec(i2,i3)=var(i1,i2,i3)
1626	enddo
1627	enddo
1628
1629	END SUBROUTINE select_dim23_from3D
1630
1631	SUBROUTINE putinto_dim23_from4D(n1,n2,n3,n4, &
1632	var,vec,i1,i4)
1633	IMPLICIT NONE
1634
1635	! inputs
1636	integer n1,n2,n3,n4
1637	real vec(n2,n3)
1638	integer i1,i4
1639	! inout
1640	real var(n1,n2,n3,n4)
1641	! locals
1642	integer i2,i3
1643
1644	do i2=1,n2
1645	do i3=1,n3
1646	var(i1,i2,i3,i4)=vec(i2,i3)
1647	enddo
1648	enddo
1649
1650	END SUBROUTINE putinto_dim23_from4D
1651
1652
1653	SUBROUTINE putinto_dim12_from4D(n1,n2,n3,n4, &
1654	var,vec,i3,i4)
1655	IMPLICIT NONE
1656
1657	! inputs
1658	integer n1,n2,n3,n4
1659	real vec(n1,n2)
1660	integer i3,i4
1661	! inout
1662	real var(n1,n2,n3,n4)
1663	! locals
1664	integer i1,i2
1665
1666	do i1=1,n1
1667	do i2=1,n2
1668	var(i1,i2,i3,i4)=vec(i1,i2)
1669	enddo
1670	enddo
1671
1672	END SUBROUTINE putinto_dim12_from4D
1673
1674	SUBROUTINE putinto_dim23_from3D(n1,n2,n3, &
1675	var,vec,i1)
1676	IMPLICIT NONE
1677
1678	! inputs
1679	integer n1,n2,n3
1680	real vec(n2,n3)
1681	integer i1
1682	! inout
1683	real var(n1,n2,n3)
1684	! locals
1685	integer i2,i3
1686
1687	do i2=1,n2
1688	do i3=1,n3
1689	var(i1,i2,i3)=vec(i2,i3)
1690	enddo
1691	enddo
1692
1693	END SUBROUTINE putinto_dim23_from3D
1694
1695
1696
1697	SUBROUTINE iso_verif_noNaN_par2D(x,err_msg,ni,n,m,ib,ie)
1698	IMPLICIT NONE
1699	! si x est NaN, on affiche message
1700	! d'erreur et return 1 si erreur
1701
1702	! input:
1703	integer n,m,ni,ib,ie
1704	real x(ni,n,m)
1705	character() err_msg ! message d''erreur à afficher
1706
1707	! output
1708
1709	! locals
1710	integer i,j,ixt
1711
1712	do i=ib,ie
1713	do j=1,m
1714	do ixt=1,ni
1715	if ((x(ixt,i,j).gt.-borne).and. &
1716	(x(ixt,i,j).lt.borne)) THEN
1717	else !if ((x(ixt,i,j).gt.-borne).and.
1718	WRITE(,) 'erreur detectee par iso_verif_nonNAN:'
1719	WRITE(,) err_msg
1720	WRITE(,) 'x,ixt,i,j=',x(ixt,i,j),ixt,i,j
1721	stop
1722	endif !if ((x(ixt,i,j).gt.-borne).and.
1723	enddo !do ixt=1,ni
1724	enddo !do j=1,m
1725	enddo !do i=1,n
1726
1727	#ifdef ISOVERIF
1728	#else
1729	WRITE(,) 'err_msg iso1772=',err_msg,': pourquoi verif?'
1730	stop
1731	#endif
1732
1733
1734	END SUBROUTINE iso_verif_noNaN_par2D
1735
1736
1737	SUBROUTINE iso_verif_aberrant_enc_par2D( &
1738	xt,q,err_msg,ni,n,m,ib,ie)
1739
1740	use isotopes_mod, ONLY: ridicule,tnat,iso_HDO
1741	IMPLICIT NONE
1742
1743	! inputs
1744	integer n,m,ni,ib,ie
1745	real q(n,m)
1746	real xt(ni,n,m)
1747	character() err_msg
1748
1749	! locals
1750	integer iso_verif_aberrant_nostop_loc
1751	integer i,j
1752	integer ifaux,jfaux
1753	!real deltaD
1754
1755	if (iso_HDO.gt.0) THEN
1756	iso_verif_aberrant_nostop_loc=0
1757	do i=ib,ie
1758	do j=1,m
1759	if (q(i,j).gt.ridicule) THEN
1760	if (((xt(iso_HDO,i,j)/q(i,j)/tnat(iso_HDO)-1)*1000.0 &
1761	.gt.deltalim).or. &
1762	((xt(iso_HDO,i,j)/q(i,j)/tnat(iso_HDO)-1)*1000.0 &
1763	.lt.deltaDmin)) THEN
1764	iso_verif_aberrant_nostop_loc=1
1765	ifaux=i
1766	jfaux=j
1767	endif
1768	endif
1769	enddo !do j=1,m
1770	enddo !do i=1,n
1771
1772	if (iso_verif_aberrant_nostop_loc.eq.1) THEN
1773	WRITE(,) 'erreur detectee par iso_verif_aberrant_par2D:'
1774	WRITE(,) err_msg
1775	WRITE(,) 'i,j=',ifaux,jfaux
1776	WRITE(,) 'deltaD=',deltaD(xt(iso_HDO,ifaux,jfaux) &
1777	/q(ifaux,jfaux))
1778	WRITE(,) 'xt(:,ifaux,jfaux)=',xt(:,ifaux,jfaux)
1779	WRITE(,) 'q(ifaux,jfaux)=',q(ifaux,jfaux)
1780	stop
1781	endif
1782	endif !if (iso_HDO.gt.0) THEN
1783	END SUBROUTINE iso_verif_aberrant_enc_par2D
1784
1785
1786	SUBROUTINE iso_verif_egalite_par2D( &
1787	xt,q,err_msg,ni,n,m,ib,ie)
1788
1789	USE isotopes_mod, ONLY: iso_eau
1790	IMPLICIT NONE
1791
1792	! inputs
1793	integer n,m,ni,ib,ie
1794	real q(n,m)
1795	real xt(ni,n,m)
1796	character() err_msg
1797
1798	! locals
1799	integer iso_verif_egalite_nostop_loc
1800	integer i,j
1801	integer ifaux,jfaux
1802
1803	if (iso_eau.gt.0) THEN
1804	iso_verif_egalite_nostop_loc=0
1805	do i=ib,ie
1806	do j=1,m
1807	if (abs(q(i,j)-xt(iso_eau,i,j)).gt.errmax) THEN
1808	if (abs((q(i,j)-xt(iso_eau,i,j))/ &
1809	max(max(abs(q(i,j)),abs(xt(iso_eau,i,j))),1e-18)) &
1810	.gt.errmaxrel) THEN
1811	iso_verif_egalite_nostop_loc=1
1812	ifaux=i
1813	jfaux=j
1814	endif
1815	endif
1816	enddo !do j=1,m
1817	enddo !do i=1,n
1818
1819	if (iso_verif_egalite_nostop_loc.eq.1) THEN
1820	WRITE(,) 'erreur detectee par iso_verif_egalite_vect2D:'
1821	WRITE(,) err_msg
1822	WRITE(,) 'i,j=',ifaux,jfaux
1823	WRITE(,) 'xt,q=',xt(iso_eau,ifaux,jfaux),q(ifaux,jfaux)
1824	stop
1825	endif
1826	endif
1827
1828	END SUBROUTINE iso_verif_egalite_par2D
1829
1830	#ifdef ISOTRAC
1831
1832	function iso_verif_traceur_choix_nostop(x,err_msg, &
1833	errmax,errmaxrel,ridicule_trac,deltalimtrac)
1834	use isotopes_mod, ONLY: iso_HDO
1835	IMPLICIT NONE
1836	! vérifier des choses sur les traceurs
1837	! * toutes les zones donne t l'istope total
1838	! * pas de deltaD aberrant
1839
1840	! inputs
1841	real x(ntraciso)
1842	character() err_msg ! message d''erreur à afficher
1843	real errmax,errmaxrel,ridicule_trac,deltalimtrac
1844
1845	! output
1846	integer iso_verif_traceur_choix_nostop
1847
1848	! locals
1849	!integer iso_verif_traceur_noNaN_nostop
1850	!integer iso_verif_tracm_choix_nostop
1851	!integer iso_verif_tracdD_choix_nostop
1852	!integer iso_verif_tracpos_choix_nostop
1853
1854	iso_verif_traceur_choix_nostop=0
1855
1856	! verif noNaN
1857	if (iso_verif_traceur_noNaN_nostop(x,err_msg).eq.1) THEN
1858	iso_verif_traceur_choix_nostop=1
1859	endif
1860
1861	! verif masse
1862	if (iso_verif_tracm_choix_nostop(x,err_msg, &
1863	errmax,errmaxrel).eq.1) THEN
1864	iso_verif_traceur_choix_nostop=1
1865	endif
1866
1867	! verif deltaD
1868	if (iso_HDO.gt.0) THEN
1869	if (iso_verif_tracdD_choix_nostop(x,err_msg, &
1870	ridicule_trac,deltalimtrac).eq.1) THEN
1871	iso_verif_traceur_choix_nostop=1
1872	endif
1873	endif !if (iso_HDO.gt.0) THEN
1874	! verif pas aberramment negatif
1875	if (iso_verif_tracpos_choix_nostop(x,err_msg, &
1876	1e-5).eq.1) THEN
1877	iso_verif_traceur_choix_nostop=1
1878	endif
1879
1880	END FUNCTION iso_verif_traceur_choix_nostop
1881
1882	function iso_verif_tracnps_choix_nostop(x,err_msg, &
1883	errmax,errmaxrel,ridicule_trac,deltalimtrac)
1884	USE isotopes_mod, ONLY: iso_HDO
1885	IMPLICIT NONE
1886	! vérifier des choses sur les traceurs
1887	! * toutes les zones donne t l'istope total
1888	! * pas de deltaD aberrant
1889	! on ne vérfie pas la positivité
1890
1891	! inputs
1892	real x(ntraciso)
1893	character() err_msg ! message d''erreur à afficher
1894	real errmax,errmaxrel,ridicule_trac,deltalimtrac
1895
1896	! output
1897	integer iso_verif_tracnps_choix_nostop
1898
1899	! locals
1900	!integer iso_verif_traceur_noNaN_nostop
1901	!integer iso_verif_tracm_choix_nostop
1902	!integer iso_verif_tracdD_choix_nostop
1903
1904	iso_verif_tracnps_choix_nostop=0
1905
1906	! verif noNaN
1907	if (iso_verif_traceur_noNaN_nostop(x,err_msg).eq.1) THEN
1908	iso_verif_tracnps_choix_nostop=1
1909	endif
1910
1911	! verif masse
1912	if (iso_verif_tracm_choix_nostop(x,err_msg, &
1913	errmax,errmaxrel).eq.1) THEN
1914	iso_verif_tracnps_choix_nostop=1
1915	endif
1916
1917	! verif deltaD
1918	if (iso_HDO.gt.0) THEN
1919	if (iso_verif_tracdD_choix_nostop(x,err_msg, &
1920	ridicule_trac,deltalimtrac).eq.1) THEN
1921	iso_verif_tracnps_choix_nostop=1
1922	endif
1923	endif ! if (iso_HDO.gt.0) THEN
1924	END FUNCTION iso_verif_tracnps_choix_nostop
1925
1926	function iso_verif_tracpos_choix_nostop(x,err_msg,seuil)
1927	use isotopes_mod, ONLY: isoName
1928	IMPLICIT NONE
1929
1930	! inputs
1931	real x(ntraciso)
1932	character() err_msg ! message d''erreur à afficher
1933	real seuil
1934
1935	! output
1936	integer iso_verif_tracpos_choix_nostop
1937
1938	! locals
1939	integer lnblnk
1940	integer iiso,ixt
1941	!integer iso_verif_positif_choix_nostop
1942
1943	iso_verif_tracpos_choix_nostop=0
1944
1945	do ixt=niso+1,ntraciso
1946	if (iso_verif_positif_choix_nostop(x(ixt),seuil,err_msg// &
1947	', verif positif, iso'//TRIM(isoName(ixt))).eq.1) THEN
1948	iso_verif_tracpos_choix_nostop=1
1949	endif
1950	enddo
1951
1952	END FUNCTION iso_verif_tracpos_choix_nostop
1953
1954
1955	function iso_verif_traceur_noNaN_nostop(x,err_msg)
1956	use isotopes_mod, ONLY: isoName
1957	IMPLICIT NONE
1958
1959	! on vérifie juste que pas NaN
1960	! inputs
1961	real x(ntraciso)
1962	character() err_msg ! message d''erreur à afficher
1963
1964	! output
1965	integer iso_verif_traceur_noNaN_nostop
1966
1967	! locals
1968	integer lnblnk
1969	integer iiso,ixt
1970	!integer iso_verif_nonaN_nostop
1971
1972	iso_verif_traceur_noNaN_nostop=0
1973
1974	do ixt=niso+1,ntraciso
1975	! WRITE(,) 'iso_verif_traceurs 154: iiso,ixt=',iiso,ixt
1976	if (iso_verif_noNaN_nostop(x(ixt),err_msg// &
1977	', verif trac no NaN, iso'//TRIM(isoName(ixt))) &
1978	.eq.1) THEN
1979	iso_verif_traceur_noNaN_nostop=1
1980	endif
1981	enddo
1982
1983	END FUNCTION iso_verif_traceur_noNaN_nostop
1984
1985	function iso_verif_tracm_choix_nostop(x,err_msg, &
1986	errmaxin,errmaxrelin)
1987
1988	use isotopes_mod, ONLY: ridicule,isoName
1989	! on vérifie juste bilan de masse
1990	IMPLICIT NONE
1991
1992	! inputs
1993	real x(ntraciso)
1994	character() err_msg ! message d''erreur à afficher
1995	real errmaxin,errmaxrelin
1996
1997	! output
1998	integer iso_verif_tracm_choix_nostop
1999
2000	! locals
2001	!integer iso_verif_egalite_choix_nostop
2002	integer iiso,izone,ixt
2003	real xtractot
2004
2005	iso_verif_tracm_choix_nostop=0
2006
2007	do iiso=1,niso
2008
2009	xtractot=0.0
2010	do izone=1,nzone
2011	ixt=itZonIso(izone,iiso)
2012	xtractot=xtractot+x(ixt)
2013	enddo
2014
2015	if (iso_verif_egalite_choix_nostop(xtractot,x(iiso), &
2016	err_msg//', verif trac egalite1, iso '// &
2017	TRIM(isoName(iiso)), &
2018	errmaxin,errmaxrelin).eq.1) THEN
2019	WRITE(,) 'iso_verif_traceur 202: x=',x
2020	! WRITE(,) 'xtractot=',xtractot
2021	do izone=1,nzone
2022	ixt=itZonIso(izone,iiso)
2023	WRITE(,) 'izone,iiso,ixt=',izone,iiso,ixt
2024	enddo
2025	iso_verif_tracm_choix_nostop=1
2026	endif
2027
2028	! verif ajoutée le 19 fev 2011
2029	if ((abs(xtractot).lt.ridicule**2).and. &
2030	(abs(x(iiso)).gt.ridicule)) THEN
2031	WRITE(,) err_msg,', verif masse traceurs, iso ', &
2032	TRIM(isoName(iiso))
2033	WRITE(,) 'iso_verif_traceur 209: x=',x
2034	! iso_verif_tracm_choix_nostop=1
2035	endif
2036
2037	enddo !do iiso=1,ntraceurs_iso
2038
2039	END FUNCTION iso_verif_tracm_choix_nostop
2040
2041	function iso_verif_tracdD_choix_nostop(x,err_msg, &
2042	ridicule_trac,deltalimtrac)
2043
2044	USE isotopes_mod, ONLY: iso_eau, iso_HDO
2045	use isotrac_mod, ONLY: strtrac
2046	! on vérifie juste deltaD
2047	IMPLICIT NONE
2048
2049	! inputs
2050	real x(ntraciso)
2051	character() err_msg ! message d''erreur à afficher
2052	real ridicule_trac,deltalimtrac
2053
2054	! output
2055	integer iso_verif_tracdD_choix_nostop
2056
2057	! locals
2058	integer izone,ieau,ixt
2059	!integer iso_verif_aberrant_choix_nostop
2060
2061	iso_verif_tracdD_choix_nostop=0
2062
2063	if ((iso_eau.gt.0).and.(iso_HDO.gt.0)) THEN
2064	do izone=1,nzone
2065	ieau=itZonIso(izone,iso_eau)
2066	ixt=itZonIso(izone,iso_HDO)
2067
2068	if (iso_verif_aberrant_choix_nostop(x(ixt),x(ieau), &
2069	ridicule_trac,deltalimtrac,err_msg// &
2070	', verif trac no aberrant zone '//strtrac(izone)) &
2071	.eq.1) THEN
2072	iso_verif_tracdD_choix_nostop=1
2073	endif
2074	! if (x(ieau).gt.ridicule) THEN
2075	! CALL iso_verif_aberrant(x(ixt)/x(ieau),
2076	! : err_msg//', verif trac no aberrant zone '
2077	! : //strtrac(izone))
2078	! endif
2079	enddo !do izone=1,nzone
2080	endif ! if ((iso_eau.gt.0).and.(iso_HDO.gt.0)) THEN
2081	END FUNCTION iso_verif_tracdD_choix_nostop
2082
2083	INTEGER FUNCTION iso_verif_tag17_q_deltaD_chns(x,err_msg) RESULT(res)
2084	USE isotopes_mod, ONLY: iso_HDO, iso_eau, ridicule
2085	USE isotrac_mod, ONLY: nzone_temp, option_traceurs
2086	IMPLICIT NONE
2087	REAL, INTENT(IN) :: x(ntraciso)
2088	CHARACTER(LEN=*), INTENT(IN) :: err_msg
2089	INTEGER :: ieau, ixt, ieau1
2090	res = 0
2091	IF(ALL([17,18]/=option_traceurs)) RETURN
2092	!--- Check whether * deltaD(highest tagging layer) < 200 permil
2093	! * q <
2094	ieau=itZonIso(nzone_temp,iso_eau)
2095	ixt=itZonIso(nzone_temp,iso_HDO)
2096	IF(x(ieau)>ridicule) THEN
2097	IF(iso_verif_positif_nostop(-200.0-deltaD(x(ixt)/x(ieau)), err_msg//': deltaDt05 trop fort')==1) THEN
2098	res=1; WRITE(,) 'x=',x
2099	END IF
2100	END IF
2101	IF(iso_verif_positif_nostop(2.0e-3-x(ieau),err_msg//': qt05 trop fort')==1) THEN
2102	res=1; WRITE(,) 'x=',x
2103	END IF
2104	!--- Check whether q is small ; then, qt01 < 10%
2105	IF(x(iso_eau)<2.0e-3) THEN
2106	ieau1= itZonIso(1,iso_eau)
2107	IF(iso_verif_positif_nostop(0.1-(x(ieau1)/x(iso_eau)),err_msg//': qt01 trop abondant')==1) THEN
2108	res=1; WRITE(,) 'x=',x
2109	END IF
2110	END IF
2111	END FUNCTION iso_verif_tag17_q_deltaD_chns
2112
2113	SUBROUTINE iso_verif_trac17_q_deltaD(x,err_msg)
2114	USE isotrac_mod, ONLY: nzone_temp, option_traceurs
2115	IMPLICIT NONE
2116	REAL, INTENT(IN) :: x(ntraciso)
2117	CHARACTER(LEN=*), INTENT(IN) :: err_msg
2118	IF(ALL([17,18]/=option_traceurs)) RETURN
2119	IF(nzone_temp>=5) THEN
2120	IF(iso_verif_tag17_q_deltaD_chns(x,err_msg)==1) STOP
2121	END IF
2122	END SUBROUTINE iso_verif_trac17_q_deltaD
2123
2124	SUBROUTINE iso_verif_traceur(x,err_msg)
2125	use isotrac_mod, ONLY: ridicule_trac
2126	IMPLICIT NONE
2127	! vérifier des choses sur les traceurs
2128	! * toutes les zones donne t l'istope total
2129	! * pas de deltaD aberrant
2130
2131	! on prend les valeurs pas défaut pour
2132	! errmax,errmaxrel,ridicule_trac,deltalimtrac
2133
2134	! inputs
2135	real x(ntraciso)
2136	character() err_msg ! message d''erreur à afficher
2137
2138	! locals
2139	!integer iso_verif_traceur_choix_nostop
2140
2141	if (iso_verif_traceur_choix_nostop(x,err_msg, &
2142	errmax,errmaxrel,ridicule_trac,deltalimtrac) &
2143	.eq.1) THEN
2144	stop
2145	endif
2146
2147	END SUBROUTINE iso_verif_traceur
2148
2149
2150	SUBROUTINE iso_verif_traceur_retourne3D(x,n1,n2,n3, &
2151	i1,i2,i3,err_msg)
2152	use isotrac_mod, ONLY: ridicule_trac
2153
2154	IMPLICIT NONE
2155	! vérifier des choses sur les traceurs
2156	! * toutes les zones donne t l'istope total
2157	! * pas de deltaD aberrant
2158
2159	! on prend les valeurs pas défaut pour
2160	! errmax,errmaxrel,ridicule_trac,deltalimtrac
2161
2162	! inputs
2163	integer n1,n2,n3
2164	real x(n1,n2,n3,ntraciso)
2165	character() err_msg ! message d''erreur à afficher
2166	integer i1,i2,i3
2167
2168	! locals
2169	!integer iso_verif_traceur_choix_nostop
2170	real xiso(ntraciso)
2171
2172	CALL select_dim4_from4D(n1,n2,n3,ntraciso, &
2173	x,xiso,i1,i2,i3)
2174	if (iso_verif_traceur_choix_nostop(xiso,err_msg, &
2175	errmax,errmaxrel,ridicule_trac,deltalimtrac) &
2176	.eq.1) THEN
2177	stop
2178	endif
2179
2180	END SUBROUTINE iso_verif_traceur_retourne3D
2181
2182	SUBROUTINE iso_verif_traceur_retourne4D(x,n1,n2,n3,n4, &
2183	i1,i2,i3,i4,err_msg)
2184	use isotrac_mod, ONLY: ridicule_trac
2185
2186	IMPLICIT NONE
2187	! vérifier des choses sur les traceurs
2188	! * toutes les zones donne t l'istope total
2189	! * pas de deltaD aberrant
2190
2191	! on prend les valeurs pas défaut pour
2192	! errmax,errmaxrel,ridicule_trac,deltalimtrac
2193
2194	! inputs
2195	integer n1,n2,n3,n4
2196	real x(n1,n2,n3,n4,ntraciso)
2197	character() err_msg ! message d''erreur à afficher
2198	integer i1,i2,i3,i4
2199
2200	! locals
2201	!integer iso_verif_traceur_choix_nostop
2202	real xiso(ntraciso)
2203
2204	CALL select_dim5_from5D(n1,n2,n3,n4,ntraciso, &
2205	x,xiso,i1,i2,i3,i4)
2206	if (iso_verif_traceur_choix_nostop(xiso,err_msg, &
2207	errmax,errmaxrel,ridicule_trac,deltalimtrac) &
2208	.eq.1) THEN
2209	stop
2210	endif
2211
2212	END SUBROUTINE iso_verif_traceur_retourne4D
2213
2214
2215	SUBROUTINE iso_verif_traceur_retourne2D(x,n1,n2, &
2216	i1,i2,err_msg)
2217	use isotrac_mod, ONLY: ridicule_trac
2218	IMPLICIT NONE
2219	! vérifier des choses sur les traceurs
2220	! * toutes les zones donne t l'istope total
2221	! * pas de deltaD aberrant
2222
2223	! on prend les valeurs pas défaut pour
2224	! errmax,errmaxrel,ridicule_trac,deltalimtrac
2225
2226	! inputs
2227	integer n1,n2
2228	real x(n1,n2,ntraciso)
2229	character() err_msg ! message d''erreur à afficher
2230	integer i1,i2
2231
2232	! locals
2233	!integer iso_verif_traceur_choix_nostop
2234	real xiso(ntraciso)
2235
2236	CALL select_dim3_from3D(n1,n2,ntraciso, &
2237	x,xiso,i1,i2)
2238	if (iso_verif_traceur_choix_nostop(xiso,err_msg, &
2239	errmax,errmaxrel,ridicule_trac,deltalimtrac) &
2240	.eq.1) THEN
2241	stop
2242	endif
2243
2244	END SUBROUTINE iso_verif_traceur_retourne2D
2245
2246	SUBROUTINE iso_verif_traceur_vect(x,n,m,err_msg)
2247	USE isotopes_mod, ONLY: iso_HDO
2248	IMPLICIT NONE
2249	! vérifier des choses sur les traceurs
2250	! * toutes les zones donne t l'istope total
2251	! * pas de deltaD aberrant
2252
2253	! on prend les valeurs pas défaut pour
2254	! errmax,errmaxrel,ridicule_trac,deltalimtrac
2255
2256	! inputs
2257	integer n,m
2258	real x(ntraciso,n,m)
2259	character() err_msg ! message d''erreur à afficher
2260
2261	! locals
2262	logical iso_verif_traceur_nostop
2263	integer i,j,ixt,iiso,izone,ieau
2264	integer ifaux,jfaux,ixtfaux
2265
2266	CALL iso_verif_traceur_noNaN_vect(x,n,m,err_msg)
2267
2268	! verif masse: iso_verif_tracm_choix_nostop
2269	CALL iso_verif_trac_masse_vect(x,n,m,err_msg,errmax,errmaxrel)
2270
2271	! verif deltaD: iso_verif_tracdD_choix_nostop
2272	if (iso_HDO.gt.0) THEN
2273	CALL iso_verif_tracdd_vect(x,n,m,err_msg)
2274	endif !if (iso_HDO.gt.0) THEN
2275	! verif pas aberramment negatif: iso_verif_tracpos_choix_nostop
2276	CALL iso_verif_tracpos_vect(x,n,m,err_msg,1e-5)
2277
2278	END SUBROUTINE iso_verif_traceur_vect
2279
2280	SUBROUTINE iso_verif_tracnps_vect(x,n,m,err_msg)
2281	USE isotopes_mod, ONLY: iso_HDO
2282	IMPLICIT NONE
2283	! vérifier des choses sur les traceurs
2284	! * toutes les zones donne t l'istope total
2285	! * pas de deltaD aberrant
2286
2287	! on prend les valeurs pas défaut pour
2288	! errmax,errmaxrel,ridicule_trac,deltalimtrac
2289
2290	! inputs
2291	integer n,m
2292	real x(ntraciso,n,m)
2293	character() err_msg ! message d''erreur à afficher
2294
2295	! locals
2296	logical iso_verif_traceur_nostop
2297	integer i,j,ixt,iiso,izone,ieau
2298	integer ifaux,jfaux,ixtfaux
2299
2300	CALL iso_verif_traceur_noNaN_vect(x,n,m,err_msg)
2301
2302	! verif masse: iso_verif_tracm_choix_nostop
2303	CALL iso_verif_trac_masse_vect(x,n,m,err_msg,errmax,errmaxrel)
2304
2305	! verif deltaD: iso_verif_tracdD_choix_nostop
2306	if (iso_HDO.gt.0) THEN
2307	CALL iso_verif_tracdd_vect(x,n,m,err_msg)
2308	endif !if (iso_HDO.gt.0) THEN
2309	END SUBROUTINE iso_verif_tracnps_vect
2310
2311
2312	SUBROUTINE iso_verif_traceur_noNaN_vect(x,n,m,err_msg)
2313	IMPLICIT NONE
2314
2315	! inputs
2316	integer n,m
2317	real x(ntraciso,n,m)
2318	character() err_msg ! message d''erreur à afficher
2319
2320	! locals
2321	logical iso_verif_traceur_nostop
2322	integer i,j,ixt,iiso
2323	integer ifaux,jfaux,ixtfaux
2324
2325
2326	iso_verif_traceur_nostop=.FALSE.
2327	! verif noNaN: iso_verif_traceur_noNaN_nostop
2328	do j=1,m
2329	do i=1,n
2330	do ixt=niso+1,ntraciso
2331	if ((x(ixt,i,j).gt.-borne).and.(x(ixt,i,j).lt.borne)) THEN
2332	else !if ((x.gt.-borne).and.(x.lt.borne)) THEN
2333	iso_verif_traceur_nostop=.TRUE.
2334	ifaux=i
2335	jfaux=i
2336	endif !if ((x.gt.-borne).and.(x.lt.borne)) THEN
2337	enddo !do ixt=niso+1,ntraciso
2338	enddo ! do i=1,n
2339	enddo ! do j=1,m
2340
2341
2342	if (iso_verif_traceur_nostop) THEN
2343	WRITE(,) 'erreur detectée par iso_verif_nonNAN ', &
2344	'dans iso_verif_traceur_vect'
2345	WRITE(,) ''
2346	WRITE(,) err_msg
2347	WRITE(,) 'x=',x(:,ifaux,jfaux)
2348	stop
2349	endif
2350
2351	END SUBROUTINE iso_verif_traceur_noNaN_vect
2352
2353
2354	SUBROUTINE iso_verif_trac_masse_vect(x,n,m,err_msg, &
2355	errmax,errmaxrel)
2356	use isotopes_mod, ONLY: isoName
2357	IMPLICIT NONE
2358
2359	! inputs
2360	integer n,m
2361	real x(ntraciso,n,m)
2362	character() err_msg ! message d''erreur à afficher
2363	real errmax,errmaxrel
2364
2365	! locals
2366	logical iso_verif_traceur_nostop
2367	integer i,j,ixt,iiso,izone
2368	integer ifaux,jfaux,ixtfaux
2369	real xtractot(n,m)
2370	real xiiso(n,m)
2371
2372	do iiso=1,niso
2373	do j=1,m
2374	do i=1,n
2375	xtractot(i,j)=0.0
2376	xiiso(i,j)=x(iiso,i,j)
2377	do izone=1,nzone
2378	ixt=itZonIso(izone,iiso)
2379	xtractot(i,j)=xtractot(i,j)+x(ixt,i,j)
2380	enddo !do izone=1,nzone
2381	enddo !do i=1,n
2382	enddo !do j=1,m
2383
2384
2385	CALL iso_verif_egalite_std_vect( &
2386	xtractot,xiiso, &
2387	err_msg//', verif trac egalite2, iso ' &
2388	//TRIM(isoName(iiso)), &
2389	n,m,errmax,errmaxrel)
2390	enddo !do iiso=1,niso
2391
2392	END SUBROUTINE iso_verif_trac_masse_vect
2393
2394	SUBROUTINE iso_verif_tracdd_vect(x,n,m,err_msg)
2395	use isotopes_mod, ONLY: iso_HDO,iso_eau
2396	use isotrac_mod, ONLY: strtrac
2397	IMPLICIT NONE
2398
2399	! inputs
2400	integer n,m
2401	real x(ntraciso,n,m)
2402	character() err_msg ! message d''erreur à afficher
2403
2404	! locals
2405	integer i,j,iiso,izone,ieau,ixt
2406	real xiiso(niso,n,m)
2407	real xeau(n,m)
2408	integer lnblnk
2409
2410	if (iso_HDO.gt.0) THEN
2411	do izone=1,nzone
2412	ieau=itZonIso(izone,iso_eau)
2413	do iiso=1,niso
2414	ixt=itZonIso(izone,iiso)
2415	do j=1,m
2416	do i=1,n
2417	xiiso(iiso,i,j)=x(ixt,i,j)
2418	enddo !do i=1,n
2419	enddo !do j=1,m
2420	enddo !do iiso=1,niso
2421
2422	do j=1,m
2423	do i=1,n
2424	xeau(i,j)=x(ieau,i,j)
2425	enddo !do i=1,n
2426	enddo !do j=1,m
2427
2428	CALL iso_verif_aberrant_vect2Dch( &
2429	xiiso,xeau,err_msg//strtrac(izone),niso,n,m, &
2430	deltalimtrac)
2431	enddo !do izone=1,nzone
2432	endif !if (iso_HDO.gt.0) THEN
2433	END SUBROUTINE iso_verif_tracdd_vect
2434
2435	SUBROUTINE iso_verif_tracpos_vect(x,n,m,err_msg,seuil)
2436	IMPLICIT NONE
2437
2438	! inputs
2439	integer n,m
2440	real x(ntraciso,n,m)
2441	character() err_msg ! message d''erreur à afficher
2442	real seuil
2443
2444	! locals
2445	integer i,j,ixt
2446	logical iso_verif_traceur_nostop
2447	integer ifaux,jfaux,ixtfaux
2448
2449	iso_verif_traceur_nostop=.FALSE.
2450	do j=1,m
2451	do i=1,n
2452	do ixt=niso+1,ntraciso
2453	if (x(ixt,i,j).lt.-seuil) THEN
2454	ifaux=i
2455	jfaux=j
2456	ixtfaux=ixt
2457	iso_verif_traceur_nostop=.TRUE.
2458	endif
2459	enddo !do ixt=niso+1,ntraciso
2460	enddo !do i=1,n
2461	enddo !do j=1,m
2462
2463	if (iso_verif_traceur_nostop) THEN
2464	WRITE(,) 'erreur detectée par verif positif ', &
2465	'dans iso_verif_traceur_vect'
2466	WRITE(,) ''
2467	WRITE(,) err_msg
2468	WRITE(,) 'x=',x(:,ifaux,jfaux)
2469	stop
2470	endif
2471
2472	END SUBROUTINE iso_verif_tracpos_vect
2473
2474
2475
2476	SUBROUTINE iso_verif_tracnps(x,err_msg)
2477	use isotrac_mod, ONLY: ridicule_trac
2478
2479	IMPLICIT NONE
2480	! vérifier des choses sur les traceurs
2481	! * toutes les zones donne t l'istope total
2482	! * pas de deltaD aberrant
2483
2484	! on prend les valeurs pas défaut pour
2485	! errmax,errmaxrel,ridicule_trac,deltalimtrac
2486
2487	! inputs
2488	real x(ntraciso)
2489	character() err_msg ! message d''erreur à afficher
2490
2491	! locals
2492	!integer iso_verif_tracnps_choix_nostop
2493
2494	if (iso_verif_tracnps_choix_nostop(x,err_msg, &
2495	errmax,errmaxrel,ridicule_trac,deltalimtrac) &
2496	.eq.1) THEN
2497	stop
2498	endif
2499
2500	END SUBROUTINE iso_verif_tracnps
2501
2502	SUBROUTINE iso_verif_tracpos_choix(x,err_msg,seuil)
2503	IMPLICIT NONE
2504	! vérifier des choses sur les traceurs
2505	! * toutes les zones donne t l'istope total
2506	! * pas de deltaD aberrant
2507
2508	! on prend les valeurs pas défaut pour
2509	! errmax,errmaxrel,ridicule_trac,deltalimtrac
2510
2511	! inputs
2512	real x(ntraciso)
2513	character() err_msg ! message d''erreur à afficher
2514	real seuil
2515
2516	! locals
2517	!integer iso_verif_tracpos_choix_nostop
2518
2519	if (iso_verif_tracpos_choix_nostop(x,err_msg,seuil) &
2520	.eq.1) THEN
2521	stop
2522	endif
2523
2524	END SUBROUTINE iso_verif_tracpos_choix
2525
2526	SUBROUTINE iso_verif_traceur_choix(x,err_msg, &
2527	errmax,errmaxrel,ridicule_trac_loc,deltalimtrac)
2528	IMPLICIT NONE
2529	! vérifier des choses sur les traceurs
2530	! * toutes les zones donne t l'istope total
2531	! * pas de deltaD aberrant
2532
2533	! inputs
2534	real x(ntraciso)
2535	character() err_msg ! message d''erreur à afficher
2536	real errmax,errmaxrel,ridicule_trac_loc,deltalimtrac
2537
2538	! locals
2539	!integer iso_verif_traceur_choix_nostop
2540
2541	if (iso_verif_traceur_choix_nostop(x,err_msg, &
2542	errmax,errmaxrel,ridicule_trac_loc,deltalimtrac) &
2543	.eq.1) THEN
2544	stop
2545	endif
2546
2547	END SUBROUTINE iso_verif_traceur_choix
2548
2549	function iso_verif_traceur_nostop(x,err_msg)
2550	use isotrac_mod, ONLY: ridicule_trac
2551	!use isotopes_verif, ONLY: errmax,errmaxrel,deltalimtrac
2552	IMPLICIT NONE
2553	! vérifier des choses sur les traceurs
2554	! * toutes les zones donne t l'istope total
2555	! * pas de deltaD aberrant
2556
2557	! on prend les valeurs pas défaut pour
2558	! errmax,errmaxrel,ridicule_trac,deltalimtrac
2559
2560	! inputs
2561	real x(ntraciso)
2562	character() err_msg ! message d''erreur à afficher
2563
2564	! output
2565	integer iso_verif_traceur_nostop
2566
2567	! locals
2568	!integer iso_verif_traceur_choix_nostop
2569
2570	iso_verif_traceur_nostop= &
2571	iso_verif_traceur_choix_nostop(x,err_msg, &
2572	errmax,errmaxrel,ridicule_trac,deltalimtrac)
2573
2574	END FUNCTION iso_verif_traceur_nostop
2575
2576
2577	SUBROUTINE iso_verif_traceur_justmass(x,err_msg)
2578	IMPLICIT NONE
2579	! on vérifie que noNaN et masse
2580
2581	! on prend les valeurs pas défaut pour
2582	! errmax,errmaxrel,ridicule_trac,deltalimtrac
2583
2584	! inputs
2585	real x(ntraciso)
2586	character() err_msg ! message d''erreur à afficher
2587
2588	! locals
2589	!integer iso_verif_traceur_noNaN_nostop
2590	!integer iso_verif_tracm_choix_nostop
2591
2592	! verif noNaN
2593	if (iso_verif_traceur_noNaN_nostop(x,err_msg).eq.1) THEN
2594	stop
2595	endif
2596
2597	! verif masse
2598	if (iso_verif_tracm_choix_nostop(x,err_msg, &
2599	errmax,errmaxrel).eq.1) THEN
2600	stop
2601	endif
2602
2603	END SUBROUTINE iso_verif_traceur_justmass
2604
2605	function iso_verif_traceur_jm_nostop(x,err_msg)
2606	IMPLICIT NONE
2607	! on vérifie que noNaN et masse
2608
2609	! on prend les valeurs pas défaut pour
2610	! errmax,errmaxrel,ridicule_trac,deltalimtrac
2611
2612	! inputs
2613	real x(ntraciso)
2614	character() err_msg ! message d''erreur à afficher
2615
2616	! output
2617	integer iso_verif_traceur_jm_nostop
2618
2619	! locals
2620	! integer iso_verif_traceur_noNaN_nostop
2621	!integer iso_verif_tracm_choix_nostop
2622
2623	iso_verif_traceur_jm_nostop=0
2624	! ! verif noNaN
2625	! if (iso_verif_traceur_noNaN_nostop(x,err_msg).eq.1) THEN
2626	! iso_verif_traceur_jm_nostop=1
2627	! endif
2628
2629	! verif masse
2630	if (iso_verif_tracm_choix_nostop(x,err_msg, &
2631	errmax,errmaxrel).eq.1) THEN
2632	iso_verif_traceur_jm_nostop=1
2633	endif
2634
2635	END FUNCTION iso_verif_traceur_jm_nostop
2636
2637	SUBROUTINE iso_verif_tag17_q_deltaD_vect(x,n,m,err_msg)
2638	USE isotopes_mod, ONLY: tnat,iso_eau, ridicule,iso_HDO
2639	use isotrac_mod, ONLY: option_traceurs,nzone_temp
2640	IMPLICIT NONE
2641
2642	! inputs
2643	integer n,m
2644	real x(ntraciso,n,m)
2645	character() err_msg
2646
2647	! locals
2648	!integer iso_verif_positif_nostop
2649	!real deltaD
2650	integer ieau,ixt,ieau1
2651	integer i,k
2652
2653	if ((option_traceurs.eq.17).or. &
2654	(option_traceurs.eq.18)) THEN
2655	! verifier que deltaD du tag de la couche la plus haute <
2656	! 200 permil, et vérifier que son q est inférieur à
2657	ieau=itZonIso(nzone_temp,iso_eau)
2658	ixt=itZonIso(nzone_temp,iso_HDO)
2659	ieau1=itZonIso(1,iso_eau)
2660	do i=1,n
2661	do k=1,m
2662	if (x(ieau,i,k).gt.ridicule) THEN
2663	if ((x(ixt,i,k)/x(ieau,i,k)/tnat(iso_HDO)-1)*1000 &
2664	.gt.-200.0) THEN
2665	WRITE(,) err_msg,', vect:deltaDt05 trop fort'
2666	WRITE(,) 'i,k=',i,k
2667	WRITE(,) 'x(:,i,k)=',x(:,i,k)
2668	stop
2669	endif !if (iso_verif_positif_nostop(-200.0-deltaD(x(ixt),x(ieau)),
2670	endif !if (x(ieau).gt.ridicule) THEN
2671	if (x(ieau,i,k).gt.2.0e-3) THEN
2672	WRITE(,) err_msg,', vect:qt05 trop fort'
2673	WRITE(,) 'i,k=',i,k
2674	WRITE(,) 'x(:,i,k)=',x(:,i,k)
2675	stop
2676	endif !if (iso_verif_positif_nostop(1.0e-3-x(ieau),
2677	if (x(iso_eau,i,k).lt.2.0e-3) THEN
2678	if (x(ieau1,i,k)/x(iso_eau,i,k).gt.0.1) THEN
2679	WRITE(,) err_msg,', vect: qt01 trop abondant'
2680	WRITE(,) 'i,k=',i,k
2681	WRITE(,) 'ieau1,iso_eau,x(ieau1,i,k),', &
2682	'x(iso_eau,i,k)=',ieau1,iso_eau, &
2683	x(ieau1,i,k),x(iso_eau,i,k)
2684	WRITE(,) 'x(:,i,k)=',x(:,i,k)
2685	stop
2686	endif !if (x(ieau1,i,k)/x(iso_eau,i,k).gt.0.1) THEN
2687	endif
2688	enddo !do k=1,m
2689	enddo !do i=1,n
2690
2691	endif !if (option_traceurs.eq.17) THEN
2692	END SUBROUTINE iso_verif_tag17_q_deltaD_vect
2693
2694
2695	SUBROUTINE iso_verif_tag17_q_deltaD_vect_ret3D(x,n,m,nq,err_msg)
2696	USE isotopes_mod, ONLY: tnat,iso_eau,iso_HDO,ridicule
2697	use isotrac_mod, ONLY: option_traceurs,nzone_temp
2698	IMPLICIT NONE
2699
2700	! inputs
2701	integer n,m,nq
2702	real x(n,m,nq,ntraciso)
2703	character() err_msg
2704
2705	! locals
2706	!integer iso_verif_positif_nostop
2707	!real deltaD
2708	integer ieau,ixt,ieau1
2709	integer i,k,iq
2710
2711	if ((option_traceurs.eq.17).or. &
2712	(option_traceurs.eq.18)) THEN
2713	! verifier que deltaD du tag de la couche la plus haute <
2714	! 200 permil, et vérifier que son q est inférieur à
2715	ieau=itZonIso(nzone_temp,iso_eau)
2716	ixt=itZonIso(nzone_temp,iso_HDO)
2717	ieau1=itZonIso(1,iso_eau)
2718	do iq=1,nq
2719	do i=1,n
2720	do k=1,m
2721	if (x(i,k,iq,ieau).gt.ridicule) THEN
2722	if ((x(i,k,iq,ixt)/x(i,k,iq,ieau)/tnat(iso_HDO)-1)*1000 &
2723	.gt.-200.0) THEN
2724	WRITE(,) err_msg,', vect:deltaDt05 trop fort'
2725	WRITE(,) 'i,k=',i,k
2726	WRITE(,) 'x(i,k,iq,:)=',x(i,k,iq,:)
2727	stop
2728	endif !if (iso_verif_positif_nostop(-200.0-deltaD(x(ixt),x(ieau)),
2729	endif !if (x(ieau).gt.ridicule) THEN
2730	if (x(i,k,iq,ieau).gt.2.0e-3) THEN
2731	WRITE(,) err_msg,', vect:qt05 trop fort'
2732	WRITE(,) 'i,k=',i,k
2733	WRITE(,) 'x(i,k,iq,:)=',x(i,k,iq,:)
2734	stop
2735	endif !if (iso_verif_positif_nostop(1.0e-3-x(ieau),
2736	if (x(i,k,iq,iso_eau).lt.2.0e-3) THEN
2737	if (x(i,k,iq,ieau1)/x(i,k,iq,iso_eau).gt.0.1) THEN
2738	WRITE(,) err_msg,', vect: qt01 trop abondant'
2739	WRITE(,) 'i,k=',i,k
2740	WRITE(,) 'ieau1,iso_eau,x(i,k,iq,ieau1),', &
2741	'x(i,k,iq,ieau)=',ieau1,iso_eau, &
2742	x(i,k,iq,ieau1),x(i,k,iq,iso_eau)
2743	WRITE(,) 'x(i,k,iq,:)=',x(i,k,iq,:)
2744	stop
2745	endif !if (x(ieau1,i,k)/x(iso_eau,i,k).gt.0.1) THEN
2746	endif
2747	enddo !do k=1,m
2748	enddo !do i=1,n
2749	enddo ! do iq=1,nq
2750
2751	endif !if (option_traceurs.eq.17) THEN
2752	END SUBROUTINE iso_verif_tag17_q_deltaD_vect_ret3D
2753
2754
2755	#endif
2756	! endif ISOTRAC
2757
2758	END MODULE isotopes_verif_mod
2759
2760	#endif
2761	! endif ISOVERIF
2762

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

Download in other formats:

Original Format