Context Navigation

isotopes_verif_mod.F90 @ 5209

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

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

Download in other formats:

Original Format