Context Navigation

isotopes_verif_mod.F90 @ 5435

Last change on this file since 5435 was 5202, checked in by Laurent Fairhead, 3 months ago
Updating cirrus branch to trunk revision 5171
Property svn:executable set to ``*
File size: 79.7 KB

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

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

Download in other formats:

Original Format