Context Navigation

← Previous Revision
Latest Revision
Next Revision →
Normal
Revision Log

cv_driver.F90 @ 4003

Last change on this file since 4003 was 3331, checked in by acozic, 6 years ago
Add modification for isotopes
Property svn:executable set to ``*
File size: 44.8 KB

Rev	Line
[3331]	1
	2	! $Header$
	3
	4	SUBROUTINE cv_driver(len, nd, ndp1, ntra, iflag_con, t1, q1, qs1, u1, v1, &
	5	tra1, p1, ph1, iflag1, ft1, fq1, fu1, fv1, ftra1, precip1, vprecip1, &
	6	cbmf1, sig1, w01, icb1, inb1, delt, ma1, upwd1, dnwd1, dnwd01, qcondc1, &
	7	wd1, cape1, da1, phi1, mp1, phi21, d1a1, dam1, sij1, clw1, elij1, & !
	8	! RomP
	9	evap1, ep1, epmlmmm1, eplamm1, & ! RomP
	10	wdtraina1, wdtrainm1, & ! RomP
	11	epmax_diag1 & ! epmax_cape
	12	#ifdef ISO
	13	& ,xt1,fxt1,xtprecip1,xtvprecip1 &
	14	#ifdef DIAGISO
	15	& , water1,xtwater1,qp1,xtp1,xtevap1 &
	16	& , xtclw1 ! juste diagnostique
	17	& , wdtrain1,xtwdtrain1,tp1 &
	18	& , taux_cond_conv1 &
	19	& , fq_detrainement1,fq_ddft1,fq_fluxmasse1,fq_evapprecip1 &
	20	& , fxt_detrainement1,fxt_ddft1,fxt_fluxmasse1 &
	21	& , fxt_evapprecip1,Mi1,Amp_diag1,tg_save1 &
	22	& , f_detrainement1,q_detrainement1,xt_detrainement1 &
	23	#endif
	24	#endif
	25	& )
	26
	27	USE dimphy
	28	#ifdef ISO
	29	USE infotrac_phy, ONLY: ntraciso,use_iso,niso,index_trac,ntraceurs_zone
	30	USE isotopes_mod, ONLY: iso_eau,iso_HDO,ridicule,bidouille_anti_divergence
	31	#ifdef ISOVERIF
	32	use isotopes_verif_mod, ONLY: errmax,errmaxrel,Tmin_verif,deltalim, &
	33	iso_verif_egalite_choix,iso_verif_aberrant_choix, &
	34	iso_verif_aberrant, iso_verif_positif,iso_verif_positif_nostop
	35	#endif
	36	#ifdef ISOTRAC
	37	use isotrac_mod, only: option_traceurs,izone_ddft,izone_revap, &
	38	& izone_poubelle, index_zone,option_tmin,izone_cond
	39	#ifdef ISOVERIF
	40	USE isotopes_verif_mod, ONLY: iso_verif_traceur,iso_verif_traceur_justmass, &
	41	& iso_verif_trac_masse_vect
	42	use isotrac_routines_mod, ONLY: iso_verif_traceur_pbidouille
	43	#endif
	44	#endif
	45	#endif
	46	IMPLICIT NONE
	47
	48	! .............................START PROLOGUE............................
	49
	50
	51	! All argument names (except len,nd,ntra,nloc,delt and the flags) have a
	52	! "1" appended.
	53	! The "1" is removed for the corresponding compressed (local) variables.
	54
	55	! PARAMETERS:
	56	! Name Type Usage Description
	57	! ---------- ---------- ------- ----------------------------
	58
	59	! len Integer Input first (i) dimension
	60	! nd Integer Input vertical (k) dimension
	61	! ndp1 Integer Input nd + 1
	62	! ntra Integer Input number of tracors
	63	! iflag_con Integer Input version of convect (3/4)
	64	! t1 Real Input temperature
	65	! q1 Real Input specific hum
	66	! qs1 Real Input sat specific hum
	67	! u1 Real Input u-wind
	68	! v1 Real Input v-wind
	69	! tra1 Real Input tracors
	70	! p1 Real Input full level pressure
	71	! ph1 Real Input half level pressure
	72	! iflag1 Integer Output flag for Emanuel conditions
	73	! ft1 Real Output temp tend
	74	! fq1 Real Output spec hum tend
	75	! fu1 Real Output u-wind tend
	76	! fv1 Real Output v-wind tend
	77	! ftra1 Real Output tracor tend
	78	! precip1 Real Output precipitation
	79	! VPrecip1 Real Output vertical profile of
	80	! precipitations
	81	! cbmf1 Real Output cloud base mass flux
	82	! sig1 Real In/Out section adiabatic updraft
	83	! w01 Real In/Out vertical velocity within adiab
	84	! updraft
	85	! delt Real Input time step
	86	! Ma1 Real Output mass flux adiabatic updraft
	87	! upwd1 Real Output total upward mass flux
	88	! (adiab+mixed)
	89	! dnwd1 Real Output saturated downward mass flux
	90	! (mixed)
	91	! dnwd01 Real Output unsaturated downward mass flux
	92	! qcondc1 Real Output in-cld mixing ratio of
	93	! condensed water
	94	! wd1 Real Output downdraft velocity scale for
	95	! sfc fluxes
	96	! cape1 Real Output CAPE
	97
	98	! wdtrainA1 Real Output precipitation detrained from
	99	! adiabatic draught;
	100	! used in tracer transport (cvltr)
	101	! wdtrainM1 Real Output precipitation detrained from mixed
	102	! draughts;
	103	! used in tracer transport (cvltr)
	104	! da1 Real Output used in tracer transport (cvltr)
	105	! phi1 Real Output used in tracer transport (cvltr)
	106	! mp1 Real Output used in tracer transport (cvltr)
	107
	108	! phi21 Real Output used in tracer transport (cvltr)
	109
	110	! d1a1 Real Output used in tracer transport (cvltr)
	111	! dam1 Real Output used in tracer transport (cvltr)
	112
	113	! evap1 Real Output
	114	! ep1 Real Output
	115	! sij1 Real Output
	116	! elij1 Real Output
	117
	118	! S. Bony, Mar 2002:
	119	! * Several modules corresponding to different physical processes
	120	! * Several versions of convect may be used:
	121	! - iflag_con=3: version lmd (previously named convect3)
	122	! - iflag_con=4: version 4.3b (vect. version, previously convect1/2)
	123	! + tard: - iflag_con=5: version lmd with ice (previously named convectg)
	124	! S. Bony, Oct 2002:
	125	! * Vectorization of convect3 (ie version lmd)
	126
	127	! ..............................END PROLOGUE.............................
	128
	129
	130	! Input
	131	INTEGER len
	132	INTEGER nd
	133	INTEGER ndp1
	134	INTEGER noff
	135	INTEGER iflag_con
	136	INTEGER ntra
	137	REAL delt
	138	REAL t1(len, nd)
	139	REAL q1(len, nd)
	140	REAL qs1(len, nd)
	141	REAL u1(len, nd)
	142	REAL v1(len, nd)
	143	REAL tra1(len, nd, ntra)
	144	REAL p1(len, nd)
	145	REAL ph1(len, ndp1)
	146
	147	! Output
	148	INTEGER iflag1(len)
	149	REAL ft1(len, nd)
	150	REAL fq1(len, nd)
	151	REAL fu1(len, nd)
	152	REAL fv1(len, nd)
	153	REAL ftra1(len, nd, ntra)
	154	REAL precip1(len)
	155	REAL cbmf1(len)
	156	REAL sig1(klon, klev)
	157	REAL w01(klon, klev)
	158	REAL vprecip1(len, nd+1)
	159	REAL evap1(len, nd) !RomP
	160	REAL ep1(len, nd) !RomP
	161	REAL ma1(len, nd)
	162	REAL upwd1(len, nd)
	163	REAL dnwd1(len, nd)
	164	REAL dnwd01(len, nd)
	165
	166	REAL qcondc1(len, nd) ! cld
	167	REAL wd1(len) ! gust
	168	REAL cape1(len)
	169
	170	! RomP >>>
	171	REAL wdtraina1(len, nd), wdtrainm1(len, nd)
	172	REAL sij1(len, nd, nd), elij1(len, nd, nd)
	173	REAL da1(len, nd), phi1(len, nd, nd), mp1(len, nd)
	174
	175	REAL phi21(len, nd, nd)
	176	REAL d1a1(len, nd), dam1(len, nd)
	177	REAL epmlmmm1(len, nd, nd), eplamm1(len, nd)
	178	! RomP <<<
	179	REAL epmax_diag1 (len) ! epmax_cape
	180
	181
	182	#ifdef ISO
	183	!integer niso
	184	real xt1(ntraciso,len,nd)
	185	real fxt1(ntraciso,len,nd)
	186	real xtprecip1(ntraciso,len)
	187	real xtvprecip1(ntraciso,len,nd+1)
	188	#ifdef DIAGISO
	189	real water1(len,nd)
	190	real xtwater1(niso,len,nd)
	191	real qp1(len,nd),xtp1(ntraciso,len,nd)
	192	real xtevap1(niso,len,nd)
	193	real wdtrain1(len,nd)
	194	real xtwdtrain1(niso,len,nd)
	195	real taux_cond_conv1(len,nd)
	196	real epmax_diag1(len)
	197	real fq_detrainement1(len,nd)
	198	real f_detrainement1(len,nd)
	199	real q_detrainement1(len,nd)
	200	real fq_ddft1(len,nd)
	201	real fq_fluxmasse1(len,nd)
	202	real Amp_diag1(len,nd)
	203	! real tg_save1(len,nd)
	204	real fq_evapprecip1(len,nd)
	205	real fxt_detrainement1(niso,len,nd)
	206	real xt_detrainement1(niso,len,nd)
	207	real fxt_ddft1(niso,len,nd)
	208	real fxt_fluxmasse1(niso,len,nd)
	209	real fxt_evapprecip1(niso,len,nd)
	210	real Mi1(len,nd)
	211	! real mentbas1(len,nd)
	212	! real qentbas1(len,nd), xtentbas1(niso,len,nd)
	213	#endif
	214	#ifdef ISOVERIF
	215	real deltaD
	216	#endif
	217	#endif
	218
	219	! -------------------------------------------------------------------
	220	! Original Prologue by Kerry Emanuel.
	221	! -------------------------------------------------------------------
	222	! --- ARGUMENTS
	223	! -------------------------------------------------------------------
	224	! --- On input:
	225
	226	! t: Array of absolute temperature (K) of dimension ND, with first
	227	! index corresponding to lowest model level. Note that this array
	228	! will be altered by the subroutine if dry convective adjustment
	229	! occurs and if IPBL is not equal to 0.
	230
	231	! q: Array of specific humidity (gm/gm) of dimension ND, with first
	232	! index corresponding to lowest model level. Must be defined
	233	! at same grid levels as T. Note that this array will be altered
	234	! if dry convective adjustment occurs and if IPBL is not equal to 0.
	235
	236	! qs: Array of saturation specific humidity of dimension ND, with first
	237	! index corresponding to lowest model level. Must be defined
	238	! at same grid levels as T. Note that this array will be altered
	239	! if dry convective adjustment occurs and if IPBL is not equal to 0.
	240
	241	! u: Array of zonal wind velocity (m/s) of dimension ND, witth first
	242	! index corresponding with the lowest model level. Defined at
	243	! same levels as T. Note that this array will be altered if
	244	! dry convective adjustment occurs and if IPBL is not equal to 0.
	245
	246	! v: Same as u but for meridional velocity.
	247
	248	! tra: Array of passive tracer mixing ratio, of dimensions (ND,NTRA),
	249	! where NTRA is the number of different tracers. If no
	250	! convective tracer transport is needed, define a dummy
	251	! input array of dimension (ND,1). Tracers are defined at
	252	! same vertical levels as T. Note that this array will be altered
	253	! if dry convective adjustment occurs and if IPBL is not equal to 0.
	254
	255	! p: Array of pressure (mb) of dimension ND, with first
	256	! index corresponding to lowest model level. Must be defined
	257	! at same grid levels as T.
	258
	259	! ph: Array of pressure (mb) of dimension ND+1, with first index
	260	! corresponding to lowest level. These pressures are defined at
	261	! levels intermediate between those of P, T, Q and QS. The first
	262	! value of PH should be greater than (i.e. at a lower level than)
	263	! the first value of the array P.
	264
	265	! nl: The maximum number of levels to which convection can penetrate, plus
	266	! 1.
	267	! NL MUST be less than or equal to ND-1.
	268
	269	! delt: The model time step (sec) between calls to CONVECT
	270
	271	! ----------------------------------------------------------------------------
	272	! --- On Output:
	273
	274	! iflag: An output integer whose value denotes the following:
	275	! VALUE INTERPRETATION
	276	! ----- --------------
	277	! 0 Moist convection occurs.
	278	! 1 Moist convection occurs, but a CFL condition
	279	! on the subsidence warming is violated. This
	280	! does not cause the scheme to terminate.
	281	! 2 Moist convection, but no precip because ep(inb) lt 0.0001
	282	! 3 No moist convection because new cbmf is 0 and old cbmf is 0.
	283	! 4 No moist convection; atmosphere is not
	284	! unstable
	285	! 6 No moist convection because ihmin le minorig.
	286	! 7 No moist convection because unreasonable
	287	! parcel level temperature or specific humidity.
	288	! 8 No moist convection: lifted condensation
	289	! level is above the 200 mb level.
	290	! 9 No moist convection: cloud base is higher
	291	! then the level NL-1.
	292
	293	! ft: Array of temperature tendency (K/s) of dimension ND, defined at
	294	! same
	295	! grid levels as T, Q, QS and P.
	296
	297	! fq: Array of specific humidity tendencies ((gm/gm)/s) of dimension ND,
	298	! defined at same grid levels as T, Q, QS and P.
	299
	300	! fu: Array of forcing of zonal velocity (m/s^2) of dimension ND,
	301	! defined at same grid levels as T.
	302
	303	! fv: Same as FU, but for forcing of meridional velocity.
	304
	305	! ftra: Array of forcing of tracer content, in tracer mixing ratio per
	306	! second, defined at same levels as T. Dimensioned (ND,NTRA).
	307
	308	! precip: Scalar convective precipitation rate (mm/day).
	309
	310	! VPrecip: Vertical profile of convective precipitation (kg/m2/s).
	311
	312	! wd: A convective downdraft velocity scale. For use in surface
	313	! flux parameterizations. See convect.ps file for details.
	314
	315	! tprime: A convective downdraft temperature perturbation scale (K).
	316	! For use in surface flux parameterizations. See convect.ps
	317	! file for details.
	318
	319	! qprime: A convective downdraft specific humidity
	320	! perturbation scale (gm/gm).
	321	! For use in surface flux parameterizations. See convect.ps
	322	! file for details.
	323
	324	! cbmf: The cloud base mass flux ((kg/m**2)/s). THIS SCALAR VALUE MUST
	325	! BE STORED BY THE CALLING PROGRAM AND RETURNED TO CONVECT AT
	326	! ITS NEXT CALL. That is, the value of CBMF must be "remembered"
	327	! by the calling program between calls to CONVECT.
	328
	329	! det: Array of detrainment mass flux of dimension ND.
	330
	331	! -------------------------------------------------------------------
	332
	333	! Local arrays
	334
	335
	336	INTEGER i, k, n, il, j
	337	INTEGER icbmax
	338	INTEGER nk1(klon)
	339	INTEGER icb1(klon)
	340	INTEGER inb1(klon)
	341	INTEGER icbs1(klon)
	342
	343	REAL plcl1(klon)
	344	REAL tnk1(klon)
	345	REAL qnk1(klon)
	346	REAL gznk1(klon)
	347	REAL pnk1(klon)
	348	REAL qsnk1(klon)
	349	REAL pbase1(klon)
	350	REAL buoybase1(klon)
	351
	352	REAL lv1(klon, klev)
	353	REAL cpn1(klon, klev)
	354	REAL tv1(klon, klev)
	355	REAL gz1(klon, klev)
	356	REAL hm1(klon, klev)
	357	REAL h1(klon, klev)
	358	REAL tp1(klon, klev)
	359	REAL tvp1(klon, klev)
	360	REAL clw1(klon, klev)
	361	REAL th1(klon, klev)
	362
	363	#ifdef ISO
	364	integer ixt
	365	real xtclw1(ntraciso,klon,klev)
	366	real tg_save1(klon,klev)
	367	REAL xtnk1(ntraciso,klon)
	368	#endif
	369
	370	INTEGER ncum
	371
	372	! (local) compressed fields:
	373
	374	! ym integer nloc
	375	! ym parameter (nloc=klon) ! pour l'instant
	376	#define nloc klon
	377	INTEGER idcum(nloc)
	378	INTEGER iflag(nloc), nk(nloc), icb(nloc)
	379	INTEGER nent(nloc, klev)
	380	INTEGER icbs(nloc)
	381	INTEGER inb(nloc), inbis(nloc)
	382
	383	REAL cbmf(nloc), plcl(nloc), tnk(nloc), qnk(nloc), gznk(nloc)
	384	REAL t(nloc, klev), q(nloc, klev), qs(nloc, klev)
	385	REAL u(nloc, klev), v(nloc, klev)
	386	REAL gz(nloc, klev), h(nloc, klev), lv(nloc, klev), cpn(nloc, klev)
	387	REAL p(nloc, klev), ph(nloc, klev+1), tv(nloc, klev), tp(nloc, klev)
	388	REAL clw(nloc, klev)
	389	REAL dph(nloc, klev)
	390	REAL pbase(nloc), buoybase(nloc), th(nloc, klev)
	391	REAL tvp(nloc, klev)
	392	REAL sig(nloc, klev), w0(nloc, klev)
	393	REAL hp(nloc, klev), ep(nloc, klev), sigp(nloc, klev)
	394	REAL frac(nloc), buoy(nloc, klev)
	395	REAL cape(nloc)
	396	REAL m(nloc, klev), ment(nloc, klev, klev), qent(nloc, klev, klev)
	397	REAL uent(nloc, klev, klev), vent(nloc, klev, klev)
	398	REAL ments(nloc, klev, klev), qents(nloc, klev, klev)
	399	REAL sij(nloc, klev, klev), elij(nloc, klev, klev)
	400	REAL qp(nloc, klev), up(nloc, klev), vp(nloc, klev)
	401	REAL wt(nloc, klev), water(nloc, klev), evap(nloc, klev)
	402	REAL b(nloc, klev), ft(nloc, klev), fq(nloc, klev)
	403	REAL fu(nloc, klev), fv(nloc, klev)
	404	REAL upwd(nloc, klev), dnwd(nloc, klev), dnwd0(nloc, klev)
	405	REAL ma(nloc, klev), mike(nloc, klev), tls(nloc, klev)
	406	REAL tps(nloc, klev), qprime(nloc), tprime(nloc)
	407	REAL precip(nloc)
	408	REAL vprecip(nloc, klev+1)
	409	REAL tra(nloc, klev, ntra), trap(nloc, klev, ntra)
	410	REAL ftra(nloc, klev, ntra), traent(nloc, klev, klev, ntra)
	411	REAL qcondc(nloc, klev) ! cld
	412	REAL wd(nloc) ! gust
	413
	414	! RomP >>>
	415	REAL da(nloc, klev), phi(nloc, klev, klev), mp(nloc, klev)
	416	REAL epmlmmm(nloc, klev, klev), eplamm(nloc, klev)
	417	REAL phi2(nloc, klev, klev)
	418	REAL d1a(nloc, klev), dam(nloc, klev)
	419	REAL wdtraina(nloc, klev), wdtrainm(nloc, klev)
	420	REAL sigd(nloc)
	421	! RomP <<<
	422	REAL epmax_diag(nloc) ! epmax_cape
	423	#ifdef ISO
	424	real xt(ntraciso,nloc,klev)
	425	real xtnk(ntraciso,nloc)
	426	real xtclw(ntraciso,nloc,klev)
	427	real xtp(ntraciso,nloc,klev)
	428	real xtent(ntraciso,nloc,klev,klev)
	429	real xtelij(ntraciso,nloc,klev,klev)
	430	! real xtep(ntraciso,nloc,klev) ! le 7 mai: on supprime xtep
	431	real xtwater(ntraciso,nloc,klev)
	432	real xtevap(ntraciso,nloc,klev)
	433	real fxt(ntraciso,nloc,klev)
	434	real xtprecip(ntraciso,nloc)
	435	real tg_save(nloc,klev) ! températures de condensation
	436	real xtvprecip(ntraciso,nloc,klev+1)
	437	#ifdef DIAGISO
	438	real wdtrain(nloc,klev)
	439	real xtwdtrain(niso,nloc,klev)
	440	real taux_cond_conv(nloc,klev)
	441	real epmax_diag(nloc)
	442	real fxt_detrainement(niso,nloc,klev)
	443	real fxt_fluxmasse(niso,nloc,klev)
	444	real fxt_evapprecip(niso,nloc,klev)
	445	real fxt_ddft(niso,nloc,klev)
	446	real fq_detrainement(nloc,klev)
	447	real f_detrainement(nloc,klev)
	448	real q_detrainement(nloc,klev)
	449	real xt_detrainement(niso,nloc,klev)
	450	real fq_fluxmasse(nloc,klev)
	451	real Amp_diag(nloc,klev)
	452	real fq_evapprecip(nloc,klev)
	453	real fq_ddft(nloc,klev)
	454	! real Mi(nloc,klev) déjà sorti dans cv3_yield: m
	455	! real mentbas(nloc,klev): déjà sortie: ment
	456	! real qentbas(nloc,klev): déjà sortie: qent
	457	#endif
	458	#ifdef ISOTRAC
	459	integer iiso,ixt_ddft,ixt_poubelle,ixt_revap
	460	integer izone
	461	!#ifdef ISOVERIF
	462	! integer iso_verif_positif_nostop
	463	!#endif
	464	#endif
	465	#endif
	466
	467
	468	#ifdef ISO
	469	! verif
	470	#ifdef ISOVERIF
	471	write(,) 'cv_driver 391: ENTREE dans cv_driver'
	472	! write(,) 'nloc=',nloc
	473	if (use_iso(iso_eau)) then
	474	do k = 1, klev
	475	do i = 1, nloc
	476	call iso_verif_egalite_choix(xt1(iso_eau,i,k),q1(i,k), &
	477	& 'cv_driver 343',errmax,errmaxrel)
	478	enddo
	479	enddo
	480	endif !if (use_iso(iso_eau)) then
	481	if (use_iso(iso_HDO)) then
	482	do k = 1, klev
	483	do i = 1, nloc
	484	if (q1(i,k).gt.ridicule) then
	485	call iso_verif_aberrant(xt1(iso_hdo,i,k)/q1(i,k), &
	486	& 'cv_driver 362')
	487	endif !if (q1(i,k).gt.ridicule) then
	488	enddo
	489	enddo
	490	endif !if (use_iso(iso_eau)) then
	491	#ifdef ISOTRAC
	492	do k = 1, klev
	493	do i = 1, klon
	494	call iso_verif_traceur(xt1(1,i,k),'cv_driver 413')
	495	enddo
	496	enddo
	497	#endif
	498	#endif
	499	! end verif
	500	#endif
	501
	502
	503	nent(:, :) = 0
	504	! -------------------------------------------------------------------
	505	! --- SET CONSTANTS AND PARAMETERS
	506	! -------------------------------------------------------------------
	507	! print *, '-> cv_driver' !jyg
	508	! -- set simulation flags:
	509	! (common cvflag)
	510
	511	CALL cv_flag(0)
	512
	513	! -- set thermodynamical constants:
	514	! (common cvthermo)
	515
	516	CALL cv_thermo(iflag_con)
	517
	518	! -- set convect parameters
	519
	520	! includes microphysical parameters and parameters that
	521	! control the rate of approach to quasi-equilibrium)
	522	! (common cvparam)
	523
	524
	525	IF (iflag_con==30) THEN
	526	CALL cv30_param(nd, delt)
	527	END IF
	528
	529	IF (iflag_con==4) THEN
	530	CALL cv_param(nd)
	531	#ifdef ISO
	532	write(,) 'cv_driver 454: isos pas prévus ici'
	533	stop
	534	#endif
	535	END IF
	536
	537	! ---------------------------------------------------------------------
	538	! --- INITIALIZE OUTPUT ARRAYS AND PARAMETERS
	539	! ---------------------------------------------------------------------
	540
	541	ft1(:, :) = 0.0
	542	fq1(:, :) = 0.0
	543	fu1(:, :) = 0.0
	544	fv1(:, :) = 0.0
	545	tvp1(:, :) = 0.0
	546	tp1(:, :) = 0.0
	547	clw1(:, :) = 0.0
	548	! ym
	549	clw(:, :) = 0.0
	550	gz1(:, :) = 0.
	551	vprecip1(:, :) = 0.
	552	ma1(:, :) = 0.0
	553	upwd1(:, :) = 0.0
	554	dnwd1(:, :) = 0.0
	555	dnwd01(:, :) = 0.0
	556	qcondc1(:, :) = 0.0
	557
	558	ftra1(:, :, :) = 0.0
	559
	560	elij1(:, :, :) = 0.0
	561	sij1(:, :, :) = 0.0
	562
	563	precip1(:) = 0.0
	564	iflag1(:) = 0
	565	wd1(:) = 0.0
	566	cape1(:) = 0.0
	567	epmax_diag1(:) = 0.0 ! epmax_cape
	568
	569
	570	#ifdef ISOVERIF
	571	#ifdef ISOTRAC
	572	do k=1,klev
	573	do i=1,klon
	574	call iso_verif_traceur(xt1(1,i,k),'cv_driver 510')
	575	enddo
	576	enddo
	577	#endif
	578	#endif
	579
	580	#ifdef ISO
	581	fxt1(:,:,:)=0.0
	582	xtclw1(:,:,:)=0.0
	583	xtclw(:,:,:)=0.0
	584	xtvprecip1(:,:,:) = 0.
	585	tg_save1(:,:) = 0.
	586	#ifdef DIAGISO
	587	do k=1,nd
	588	do i=1,len
	589	do ixt=1,niso
	590	xtwater1(ixt,i,k)=0.0
	591	xtwdtrain1(ixt,i,k)=0.0
	592	fxt_detrainement1(ixt,i,k)=0.0
	593	xt_detrainement1(ixt,i,k)=0.0
	594	fxt_ddft1(ixt,i,k)=0.0
	595	fxt_fluxmasse1(ixt,i,k)=0.0
	596	fxt_evapprecip1(ixt,i,k)=0.0
	597	xtp1(ixt,i,k)=0.0
	598	xtevap1(ixt,i,k)=0.0
	599	! xtentbas(ixt,i,k)=0.0
	600	enddo
	601	#ifdef ISOTRAC
	602	do ixt=1+niso,ntraciso
	603	xtp1(ixt,i,k)=0.0
	604	enddo !do ixt=1+niso,ntraciso
	605	#endif
	606	evap1(i,k)=0.0
	607	wdtrain1(i,k)=0.0
	608	taux_cond_conv1(i,k)=0.0
	609	water1(i,k)=0.0
	610	Mp1(i,k)=0.0
	611	qp1(i,k)=0.0
	612	fq_detrainement1(i,k)=0.0
	613	fq_ddft1(i,k)=0.0
	614	fq_fluxmasse1(i,k)=0.0
	615	Amp_diag1(i,k)=0.0
	616	tg_save1(i,k)=t1(i,k)
	617	fq_evapprecip1(i,k)=0.0
	618	Mi1(i,k)=0.0
	619	! qentbas1(i,k)=0.0
	620	! mentbas1(i,k)=0.0
	621	enddo !do i=1,len
	622	enddo !do k=1,nd
	623	#endif
	624	#endif
	625
	626	IF (iflag_con==30) THEN
	627	DO il = 1, len
	628	sig1(il, nd) = sig1(il, nd) + 1.
	629	sig1(il, nd) = amin1(sig1(il,nd), 12.1)
	630	END DO
	631	END IF
	632
	633	! RomP >>>
	634	wdtraina1(:, :) = 0.
	635	wdtrainm1(:, :) = 0.
	636	da1(:, :) = 0.
	637	phi1(:, :, :) = 0.
	638	epmlmmm1(:, :, :) = 0.
	639	eplamm1(:, :) = 0.
	640	mp1(:, :) = 0.
	641	evap1(:, :) = 0.
	642	ep1(:, :) = 0.
	643	sij1(:, :, :) = 0.
	644	elij1(:, :, :) = 0.
	645	phi21(:, :, :) = 0.
	646	d1a1(:, :) = 0.
	647	dam1(:, :) = 0.
	648	! RomP <<<
	649
	650	! --------------------------------------------------------------------
	651	! --- CALCULATE ARRAYS OF GEOPOTENTIAL, HEAT CAPACITY & STATIC ENERGY
	652	! --------------------------------------------------------------------
	653
	654	IF (iflag_con==30) THEN
	655
	656	! print*,'Emanuel version 30 '
	657	CALL cv30_prelim(len, nd, ndp1, t1, q1, p1, ph1 & ! nd->na
	658	, lv1, cpn1, tv1, gz1, h1, hm1, th1)
	659	END IF
	660
	661	IF (iflag_con==4) THEN
	662	CALL cv_prelim(len, nd, ndp1, t1, q1, p1, ph1, lv1, cpn1, tv1, gz1, h1, &
	663	hm1)
	664	END IF
	665
	666	! --------------------------------------------------------------------
	667	! --- CONVECTIVE FEED
	668	! --------------------------------------------------------------------
	669
	670	IF (iflag_con==30) THEN
	671	CALL cv30_feed(len, nd, t1, q1, qs1, p1, ph1, hm1, gz1 & !
	672	! nd->na
	673	, nk1, icb1, icbmax, iflag1, tnk1, qnk1, gznk1, plcl1 &
	674	#ifdef ISO
	675	,xt1,xtnk1 &
	676	#endif
	677	)
	678	END IF
	679
	680	IF (iflag_con==4) THEN
	681	CALL cv_feed(len, nd, t1, q1, qs1, p1, hm1, gz1, nk1, icb1, icbmax, &
	682	iflag1, tnk1, qnk1, gznk1, plcl1)
	683	END IF
	684
	685	! --------------------------------------------------------------------
	686	! --- UNDILUTE (ADIABATIC) UPDRAFT / 1st part
	687	! (up through ICB for convect4, up through ICB+1 for convect3)
	688	! Calculates the lifted parcel virtual temperature at nk, the
	689	! actual temperature, and the adiabatic liquid water content.
	690	! --------------------------------------------------------------------
	691
	692	IF (iflag_con==30) THEN
	693
	694	#ifdef ISOVERIF
	695	write(,) 'cv_driver 593: avant cv3_undilute1'
	696	do k=1,klev
	697	do i=1,klon
	698	if (use_iso(iso_HDO)) then
	699	if (q1(i,k).gt.ridicule) then
	700	call iso_verif_aberrant(xt1(iso_hdo,i,k)/q1(i,k), &
	701	& 'cv_driver 502')
	702	endif ! if (q1(i,k).gt.ridicule) then
	703	endif !if (use_iso(iso_HDO)) then
	704	#ifdef ISOTRAC
	705	call iso_verif_traceur(xt1(1,i,k),'cv_driver 601')
	706	#endif
	707	enddo
	708	enddo
	709	#endif
	710
	711
	712	CALL cv30_undilute1(len, nd, t1, q1, qs1, gz1, plcl1, p1, nk1, icb1 & ! nd->na
	713	, tp1, tvp1, clw1, icbs1 &
	714	#ifdef ISO
	715	& ,xt1,xtclw1,tg_save1 &
	716	#endif
	717	& )
	718
	719
	720	#ifdef ISO
	721	!c--debug
	722	#ifdef ISOVERIF
	723	write(,) 'cv_driver 621: après cv3_undilute1'
	724	do k = 1, klev
	725	do i = 1, klon
	726	if (use_iso(iso_eau)) then
	727	call iso_verif_egalite_choix(xtclw1(iso_eau,i,k),clw1(i,k), &
	728	& 'undil1',errmax,errmaxrel)
	729	call iso_verif_egalite_choix(xt1(iso_eau,i,k),q1(i,k), &
	730	& 'undil1',errmax,errmaxrel)
	731	endif !if (use_iso(iso_eau)) then
	732	#ifdef ISOTRAC
	733	call iso_verif_traceur(xt1(1,i,k),'cv_driver 623')
	734	#endif
	735	enddo
	736	enddo
	737	#endif
	738	!write(,) 'SORTIE DE CV3_UNDILUTE1'
	739	#endif
	740
	741	END IF
	742
	743	IF (iflag_con==4) THEN
	744	CALL cv_undilute1(len, nd, t1, q1, qs1, gz1, p1, nk1, icb1, icbmax, tp1, &
	745	tvp1, clw1)
	746	END IF
	747
	748	! -------------------------------------------------------------------
	749	! --- TRIGGERING
	750	! -------------------------------------------------------------------
	751
	752	IF (iflag_con==30) THEN
	753	CALL cv30_trigger(len, nd, icb1, plcl1, p1, th1, tv1, tvp1 & !
	754	! nd->na
	755	, pbase1, buoybase1, iflag1, sig1, w01)
	756	END IF
	757
	758	IF (iflag_con==4) THEN
	759	CALL cv_trigger(len, nd, icb1, cbmf1, tv1, tvp1, iflag1)
	760	END IF
	761
	762	! =====================================================================
	763	! --- IF THIS POINT IS REACHED, MOIST CONVECTIVE ADJUSTMENT IS NECESSARY
	764	! =====================================================================
	765
	766	ncum = 0
	767	DO i = 1, len
	768	IF (iflag1(i)==0) THEN
	769	ncum = ncum + 1
	770	idcum(ncum) = i
	771	END IF
	772	END DO
	773
	774	! print*,'cv_driver : klon, ncum = ',len,ncum
	775
	776	IF (ncum>0) THEN
	777
	778	! ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
	779	! --- COMPRESS THE FIELDS
	780	! (-> vectorization over convective gridpoints)
	781	! ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
	782
	783	IF (iflag_con==30) THEN
	784	#ifdef ISO
	785	#ifdef ISOVERIF
	786	write(,) 'cv_driver 771: tg_save1(1,1)=',tg_save1(1,1)
	787	write(,) 'xt1(iso_eau,1,1),q1(1,1)=',xt1(iso_eau,1,1),q1(1,1)
	788	!write(,) 'xt1(iso_eau,14,1),q1(14,1)=',xt1(iso_eau,14,1),q1(14,1)
	789	write(,) 'iso_eau,use_iso=',iso_eau,use_iso
	790	do k = 1, klev
	791	do i = 1, nloc
	792	if (use_iso(iso_eau)) then
	793	call iso_verif_egalite_choix(xtclw1(iso_eau,i,k),clw1(i,k), &
	794	& 'cv_driver 541a',errmax,errmaxrel)
	795	call iso_verif_egalite_choix(xt1(iso_eau,i,k),q1(i,k), &
	796	& 'cv_driver 541b',errmax,errmaxrel)
	797	endif ! if (use_iso(iso_eau)) then
	798	#ifdef ISOTRAC
	799	call iso_verif_traceur(xt1(1,i,k),'cv_driver 689')
	800	#endif
	801	enddo
	802	enddo
	803	#endif
	804	#endif
	805
	806	CALL cv30_compress(len, nloc, ncum, nd, ntra, iflag1, nk1, icb1, icbs1, &
	807	plcl1, tnk1, qnk1, gznk1, pbase1, buoybase1, t1, q1, qs1, u1, v1, &
	808	gz1, th1, tra1, h1, lv1, cpn1, p1, ph1, tv1, tp1, tvp1, clw1, sig1, &
	809	w01, iflag, nk, icb, icbs, plcl, tnk, qnk, gznk, pbase, buoybase, t, &
	810	q, qs, u, v, gz, th, tra, h, lv, cpn, p, ph, tv, tp, tvp, clw, sig, &
	811	w0 &
	812	#ifdef ISO
	813	& ,xtnk1,xt1,xtclw1,tg_save1 &
	814	& ,xtnk,xt,xtclw,tg_save &
	815	#endif
	816	& )
	817
	818	#ifdef ISO
	819	#ifdef ISOVERIF
	820	write(,) 'cv_driver 720: après cv3_compress'
	821	write(,) 'tg_save(1,1)=',tg_save(1,1)
	822	do k = 1, klev
	823	do i = 1, ncum
	824	if (use_iso(iso_eau)) then
	825	call iso_verif_egalite_choix(xtclw(iso_eau,i,k),clw(i,k), &
	826	& 'cv_driver 598',errmax,errmaxrel)
	827	call iso_verif_egalite_choix(xt(iso_eau,i,k),q(i,k), &
	828	& 'cv_driver 600',errmax,errmaxrel)
	829	endif ! if (use_iso(iso_eau)) then
	830	if (use_iso(iso_HDO)) then
	831	call iso_verif_aberrant_choix( &
	832	& xt(iso_HDO,i,k),q(i,k), &
	833	& ridicule,deltalim,'cv_driver 735, apres compress')
	834	endif !if (use_iso(iso_HDO)) then
	835	#ifdef ISOTRAC
	836	call iso_verif_traceur(xt(1,i,k),'cv_driver 726')
	837	#endif
	838	call iso_verif_positif(tg_save(i,k)-Tmin_verif, &
	839	& 'cv_driver 806')
	840	enddo
	841	enddo
	842	if (use_iso(iso_eau)) then
	843	do i = 1, ncum
	844	call iso_verif_egalite_choix(xtnk(iso_eau,i),qnk(i), &
	845	& 'cv_driver 834',errmax,errmaxrel)
	846	enddo
	847	endif !if (use_iso(iso_eau)) then
	848	#endif
	849	#endif
	850
	851	END IF
	852
	853	IF (iflag_con==4) THEN
	854	CALL cv_compress(len, nloc, ncum, nd, iflag1, nk1, icb1, cbmf1, plcl1, &
	855	tnk1, qnk1, gznk1, t1, q1, qs1, u1, v1, gz1, h1, lv1, cpn1, p1, ph1, &
	856	tv1, tp1, tvp1, clw1, iflag, nk, icb, cbmf, plcl, tnk, qnk, gznk, t, &
	857	q, qs, u, v, gz, h, lv, cpn, p, ph, tv, tp, tvp, clw, dph)
	858	END IF
	859
	860	! -------------------------------------------------------------------
	861	! --- UNDILUTE (ADIABATIC) UPDRAFT / second part :
	862	! --- FIND THE REST OF THE LIFTED PARCEL TEMPERATURES
	863	! --- &
	864	! --- COMPUTE THE PRECIPITATION EFFICIENCIES AND THE
	865	! --- FRACTION OF PRECIPITATION FALLING OUTSIDE OF CLOUD
	866	! --- &
	867	! --- FIND THE LEVEL OF NEUTRAL BUOYANCY
	868	! -------------------------------------------------------------------
	869
	870	IF (iflag_con==30) THEN
	871	CALL cv30_undilute2(nloc, ncum, nd, icb, icbs, nk & !na->nd
	872	, tnk, qnk, gznk, t, q, qs, gz, p, h, tv, lv, pbase, buoybase, plcl, &
	873	inb, tp, tvp, clw, hp, ep, sigp, buoy &
	874	#ifdef ISO
	875	& ,xtnk,xt,xtclw,tg_save &
	876	#endif
	877	& )
	878
	879	#ifdef ISO
	880	#ifdef ISOVERIF
	881	write(,) 'cv_driver 863: apres call cv30_undilute2'
	882	write(,) 'tg_save(1,1)=',tg_save(1,1)
	883	do k = 1, klev
	884	do i = 1, ncum
	885	if (use_iso(iso_eau)) then
	886	call iso_verif_egalite_choix(xtclw(iso_eau,i,k),clw(i,k), &
	887	& 'cv_driver 650',errmax,errmaxrel)
	888	call iso_verif_egalite_choix(xt(iso_eau,i,k),q(i,k), &
	889	& 'cv_driver 652',errmax,errmaxrel)
	890	endif ! if (use_iso(iso_eau)) then
	891	if (use_iso(iso_HDO)) then
	892	call iso_verif_aberrant_choix( &
	893	& xt(iso_HDO,i,k),q(i,k), &
	894	& ridicule,deltalim,'cv_driver 794, apres undilute2')
	895	endif !if (use_iso(iso_HDO)) then
	896	call iso_verif_positif(tg_save(i,k)-Tmin_verif, &
	897	& 'cv_driver 859')
	898	#ifdef ISOTRAC
	899	call iso_verif_traceur(xt(1,i,k),'cv_driver 780')
	900	call iso_verif_traceur(xtclw(1,i,k),'cv_driver 781')
	901	#endif
	902	enddo
	903	enddo
	904	#endif
	905	!write(,) 'SORTIE CV3_UNDILUTE2'
	906	#endif
	907	END IF
	908
	909	IF (iflag_con==4) THEN
	910	CALL cv_undilute2(nloc, ncum, nd, icb, nk, tnk, qnk, gznk, t, q, qs, &
	911	gz, p, dph, h, tv, lv, inb, inbis, tp, tvp, clw, hp, ep, sigp, frac)
	912	END IF
	913
	914	! -------------------------------------------------------------------
	915	! --- CLOSURE
	916	! -------------------------------------------------------------------
	917
	918	IF (iflag_con==30) THEN
	919	CALL cv30_closure(nloc, ncum, nd, icb, inb & ! na->nd
	920	, pbase, p, ph, tv, buoy, sig, w0, cape, m)
	921
	922	! epmax_cape
	923	call cv30_epmax_fn_cape(nloc,ncum,nd &
	924	,cape,ep,hp,icb,inb,clw,nk,t,h,lv &
	925	,epmax_diag)
	926	! on écrase ep et recalcule hp
	927	END IF
	928
	929	IF (iflag_con==4) THEN
	930	CALL cv_closure(nloc, ncum, nd, nk, icb, tv, tvp, p, ph, dph, plcl, &
	931	cpn, iflag, cbmf)
	932	END IF
	933
	934
	935	! -------------------------------------------------------------------
	936	! --- MIXING
	937	! -------------------------------------------------------------------
	938
	939	IF (iflag_con==30) THEN
	940	CALL cv30_mixing(nloc, ncum, nd, nd, ntra, icb, nk, inb & !
	941	! na->nd
	942	, ph, t, q, qs, u, v, tra, h, lv, qnk, hp, tv, tvp, ep, clw, m, sig, &
	943	ment, qent, uent, vent, sij, elij, ments, qents, traent &
	944	#ifdef ISO
	945	& ,xt,xtnk,xtclw &
	946	& ,xtent,xtelij,tg_save &
	947	#endif
	948	& )
	949
	950
	951	#ifdef ISO
	952	#ifdef ISOVERIF
	953	write(,) 'cv_driver 837: après cv3_mixing'
	954	do k = 1, klev
	955	do j = 1, klev
	956	do i = 1, ncum
	957	if (use_iso(iso_eau)) then
	958	call iso_verif_egalite_choix(xtelij(iso_eau,i,j,k), &
	959	& elij(i,j,k),'cv_driver 881',errmax,errmaxrel)
	960	call iso_verif_egalite_choix(xtent(iso_eau,i,j,k), &
	961	& qent(i,j,k),'cv_driver 882',errmax,errmaxrel)
	962	endif ! if (use_iso(iso_eau)) then
	963	#ifdef ISOTRAC
	964	call iso_verif_traceur_justmass(xtent(1,i,j,k), &
	965	& 'cv_driver 846')
	966	call iso_verif_traceur_justmass(xtelij(1,i,j,k), &
	967	& 'cv_driver 847')
	968	! on ne vérfier pas le deltaD ici car peut dépasser le seuil
	969	! raisonable pour températures très froides.
	970	#endif
	971	enddo
	972	enddo
	973	enddo !do k = 1, klev
	974	do k = 1, klev
	975	do i = 1, ncum
	976	if (use_iso(iso_eau)) then
	977	call iso_verif_egalite_choix(xt(iso_eau,i,k),q(i,k), &
	978	& 'cv_driver 709',errmax,errmaxrel)
	979	endif ! if (use_iso(iso_eau)) then
	980	#ifdef ISOTRAC
	981	call iso_verif_traceur(xt(1,i,k),'cv_driver 856')
	982	if (option_tmin.eq.1) then
	983	if (iso_verif_positif_nostop(xtclw(index_trac( &
	984	& izone_cond,iso_eau),i,k)-xtclw(iso_eau,i,k) &
	985	& ,'cv_driver 909').eq.1) then
	986	write(,) 'i,k=',i,k
	987	write(,) 'xtclw=',xtclw(:,i,k)
	988	stop
	989	endif !if (iso_verif_positif_nostop(xtclw(index_trac(
	990	endif !if ((option_traceurs.eq.17).or.
	991	#endif
	992	#ifdef DIAGISO
	993	call iso_verif_positif(tg_save(i,k)-50.0,'cv_driver 926')
	994	#endif
	995	enddo
	996	enddo !do k = 1, klev
	997
	998	#endif
	999	#endif
	1000
	1001	END IF
	1002
	1003	IF (iflag_con==4) THEN
	1004	CALL cv_mixing(nloc, ncum, nd, icb, nk, inb, inbis, ph, t, q, qs, u, v, &
	1005	h, lv, qnk, hp, tv, tvp, ep, clw, cbmf, m, ment, qent, uent, vent, &
	1006	nent, sij, elij)
	1007	END IF
	1008
	1009	! -------------------------------------------------------------------
	1010	! --- UNSATURATED (PRECIPITATING) DOWNDRAFTS
	1011	! -------------------------------------------------------------------
	1012
	1013	IF (iflag_con==30) THEN
	1014
	1015	#ifdef ISO
	1016	#ifdef ISOVERIF
	1017	do k = 1, klev
	1018	do i = 1, ncum
	1019	if (use_iso(iso_eau)) then
	1020	call iso_verif_egalite_choix(xt(iso_eau,i,k),q(i,k), &
	1021	& 'cv_driver 753',errmax,errmaxrel)
	1022	endif ! if (use_iso(iso_eau)) then
	1023	#ifdef ISOTRAC
	1024	call iso_verif_traceur(xt(1,i,k),'cv_driver 885')
	1025	#endif
	1026	enddo
	1027	enddo !do k = 1, klev
	1028	#endif
	1029	#endif
	1030
	1031	! RomP >>>
	1032	CALL cv30_unsat(nloc, ncum, nd, nd, ntra, icb, inb & ! na->nd
	1033	, t, q, qs, gz, u, v, tra, p, ph, th, tv, lv, cpn, ep, sigp, clw, m, &
	1034	ment, elij, delt, plcl, mp, qp, up, vp, trap, wt, water, evap, b, &
	1035	wdtraina, wdtrainm &
	1036	#ifdef ISO
	1037	& ,xt,xtclw,xtelij &
	1038	& ,xtp,xtwater,xtevap &
	1039	#ifdef DIAGISO
	1040	& ,wdtrain,xtwdtrain,taux_cond_conv &
	1041	#endif
	1042	#endif
	1043	& )
	1044	! RomP <<<
	1045
	1046	#ifdef ISO
	1047	! write(,) 'klev=',klev
	1048	#ifdef ISOVERIF
	1049	write(,) 'cv_driver 930: après cv3_unsat'
	1050	do k = 1, klev
	1051	do i = 1, ncum
	1052	if (use_iso(iso_eau)) then
	1053	call iso_verif_egalite_choix(xt(iso_eau,i,k),q(i,k), &
	1054	& 'cv_driver 778',errmax,errmaxrel)
	1055	call iso_verif_egalite_choix(xtp(iso_eau,i,k), &
	1056	& qp(i,k),'cv_driver 780',errmax,errmaxrel)
	1057	call iso_verif_egalite_choix( &
	1058	& xtwater(iso_eau,i,k),water(i,k), &
	1059	& 'cv_driver 782',errmax,errmaxrel)
	1060	call iso_verif_egalite_choix(xtevap(iso_eau,i,k), &
	1061	& evap(i,k),'cv_driver 784',errmax,errmaxrel)
	1062	endif ! if (use_iso(iso_eau)) then
	1063	#ifdef ISOTRAC
	1064	call iso_verif_traceur(xt(1,i,k),'cv_driver 939')
	1065	call iso_verif_traceur(xtp(1,i,k),'cv_driver 940')
	1066	call iso_verif_traceur(xtwater(1,i,k),'cv_driver 941')
	1067	call iso_verif_traceur_justmass(xtevap(1,i,k), &
	1068	& 'cv_driver 942')
	1069	if (bidouille_anti_divergence) then
	1070	call iso_verif_traceur_pbidouille( &
	1071	& xtp(1,i,k),'cv_driver 956')
	1072	call iso_verif_traceur_pbidouille( &
	1073	& xtwater(1,i,k),'cv_driver 958')
	1074	endif
	1075	#endif
	1076	enddo !do i = 1, ncum
	1077	enddo !do k = 1, klev
	1078	#endif
	1079	#endif
	1080
	1081	END IF
	1082
	1083	IF (iflag_con==4) THEN
	1084	CALL cv_unsat(nloc, ncum, nd, inb, t, q, qs, gz, u, v, p, ph, h, lv, &
	1085	ep, sigp, clw, m, ment, elij, iflag, mp, qp, up, vp, wt, water, evap)
	1086	END IF
	1087
	1088	#ifdef ISO
	1089	#ifdef ISOTRAC
	1090	if (option_traceurs.eq.6) then
	1091	! on colorie les ddfts en rouge, le reste est en blanc.
	1092	do k = 1, klev
	1093	do i = 1, ncum
	1094	do iiso=1,niso
	1095	ixt_ddft=index_trac(izone_ddft,iiso)
	1096	ixt_poubelle=index_trac(izone_poubelle,iiso)
	1097	xtp(ixt_ddft,i,k)=xtp(ixt_ddft,i,k) &
	1098	& +xtp(ixt_poubelle,i,k)
	1099	xtp(ixt_poubelle,i,k)=0.0
	1100	enddo !do iiso=1,niso
	1101	#ifdef ISOVERIF
	1102	call iso_verif_traceur(xtp(1,i,k),'cv_driver 990')
	1103	#endif
	1104	enddo !do i = 1, ncum
	1105	enddo !do k = 1, klev
	1106	else if (option_traceurs.eq.19) then
	1107	! on colorie les ddfts, mais on sauve la revap
	1108	do k = 1, klev
	1109	do i = 1, ncum
	1110	do izone=1,ntraceurs_zone
	1111	if (izone.eq.izone_ddft) then
	1112	do iiso=1,niso
	1113	ixt_ddft=index_trac(izone,iiso)
	1114	ixt_revap=index_trac(izone_revap,iiso)
	1115	xtp(ixt_ddft,i,k)=xtp(iiso,i,k)-xtp(ixt_revap,i,k)
	1116	enddo !do iiso=1,niso
	1117	elseif (izone.eq.izone_ddft) then
	1118	! rien à faire
	1119	else !if (izone.eq.izone_ddft) then
	1120	do iiso=1,niso
	1121	ixt=index_trac(izone,iiso)
	1122	xtp(ixt,i,k)=0.0
	1123	enddo !do iiso=1,niso
	1124	endif !if (izone.eq.izone_ddft) then
	1125	enddo !do izone=1,ntraceurs_zone
	1126	#ifdef ISOVERIF
	1127	call iso_verif_traceur(xtp(1,i,k),'cv_driver 1059')
	1128	#endif
	1129	enddo !do i = 1, ncum
	1130	enddo !do k = 1, klev
	1131	endif !if (option_traceurs.eq.6) then
	1132	#endif
	1133	#endif
	1134	! -------------------------------------------------------------------
	1135	! --- YIELD
	1136	! (tendencies, precipitation, variables of interface with other
	1137	! processes, etc)
	1138	! -------------------------------------------------------------------
	1139
	1140	IF (iflag_con==30) THEN
	1141	CALL cv30_yield(nloc, ncum, nd, nd, ntra & ! na->nd
	1142	, icb, inb, delt, t, q, u, v, tra, gz, p, ph, h, hp, lv, cpn, th, ep, &
	1143	clw, m, tp, mp, qp, up, vp, trap, wt, water, evap, b, ment, qent, &
	1144	uent, vent, nent, elij, traent, sig, tv, tvp, iflag, precip, vprecip, &
	1145	ft, fq, fu, fv, ftra, upwd, dnwd, dnwd0, ma, mike, tls, tps, qcondc, &
	1146	wd &
	1147	#ifdef ISO
	1148	& ,xt,xtclw,xtp,xtwater,xtevap &
	1149	& ,xtent,xtelij,xtprecip,fxt,xtVPrecip &
	1150	#ifdef DIAGISO
	1151	& ,fq_detrainement,fq_ddft,fq_fluxmasse,fq_evapprecip &
	1152	& ,fxt_detrainement,fxt_ddft,fxt_fluxmasse,fxt_evapprecip &
	1153	& ,Amp_diag &
	1154	& ,f_detrainement,q_detrainement,xt_detrainement &
	1155	#endif
	1156	#endif
	1157	& )
	1158
	1159	#ifdef ISOVERIF
	1160	DO k = 1, nd
	1161	DO i = 1, ncum
	1162	if (use_iso(iso_eau)) then
	1163	call iso_verif_egalite_choix(fxt(iso_eau,i,k), &
	1164	& fq(i,k),'cv_driver 1086',errmax,errmaxrel)
	1165	endif !if (use_iso(iso_HDO)) then
	1166	if (use_iso(iso_HDO)) then
	1167	if (q(i,k).gt.ridicule) then
	1168	call iso_verif_aberrant( &
	1169	& (xt(iso_HDO,i,k)+delt*fxt(iso_HDO,i,k)) &
	1170	& /(q(i,k)+delt*fq(i,k)),'cv_driver 855')
	1171	endif
	1172	endif
	1173	#ifdef ISOTRAC
	1174	call iso_verif_traceur(xt(1,i,k),'cv_driver 1008')
	1175	#endif
	1176	#ifdef DIAGISO
	1177	call iso_verif_positif(tg_save(i,k)-50.0,'cv_driver 1024')
	1178	#endif
	1179	enddo
	1180	enddo
	1181	#endif
	1182
	1183	END IF
	1184
	1185	IF (iflag_con==4) THEN
	1186	CALL cv_yield(nloc, ncum, nd, nk, icb, inb, delt, t, q, u, v, gz, p, &
	1187	ph, h, hp, lv, cpn, ep, clw, frac, m, mp, qp, up, vp, wt, water, &
	1188	evap, ment, qent, uent, vent, nent, elij, tv, tvp, iflag, wd, qprime, &
	1189	tprime, precip, cbmf, ft, fq, fu, fv, ma, qcondc)
	1190	END IF
	1191
	1192	! ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
	1193	! --- passive tracers
	1194	! ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
	1195
	1196	IF (iflag_con==30) THEN
	1197	! RomP >>>
	1198	CALL cv30_tracer(nloc, len, ncum, nd, nd, ment, sij, da, phi, phi2, &
	1199	d1a, dam, ep, vprecip, elij, clw, epmlmmm, eplamm, icb, inb)
	1200	! RomP <<<
	1201	END IF
	1202
	1203	! ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
	1204	! --- UNCOMPRESS THE FIELDS
	1205	! ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
	1206	! set iflag1 =42 for non convective points
	1207	DO i = 1, len
	1208	iflag1(i) = 42
	1209	END DO
	1210
	1211	IF (iflag_con==30) THEN
	1212	CALL cv30_uncompress(nloc, len, ncum, nd, ntra, idcum, iflag, precip, &
	1213	vprecip, evap, ep, sig, w0 & !RomP
	1214	, ft, fq, fu, fv, ftra, inb, ma, upwd, dnwd, dnwd0, qcondc, wd, cape, &
	1215	da, phi, mp, phi2, d1a, dam, sij & !RomP
	1216	, elij, clw, epmlmmm, eplamm & !RomP
	1217	, wdtraina, wdtrainm,epmax_diag & !RomP
	1218	, iflag1, precip1, vprecip1, evap1, ep1, sig1, w01 & !RomP
	1219	, ft1, fq1, fu1, fv1, ftra1, inb1, ma1, upwd1, dnwd1, dnwd01, &
	1220	qcondc1, wd1, cape1, da1, phi1, mp1, phi21, d1a1, dam1, sij1 & !RomP
	1221	, elij1, clw1, epmlmmm1, eplamm1 & !RomP
	1222	, wdtraina1, wdtrainm1,epmax_diag1 & !RomP
	1223	#ifdef ISO
	1224	& ,xtprecip,fxt,xtVPrecip &
	1225	& ,xtprecip1,fxt1,xtVPrecip1 &
	1226	#ifdef DIAGISO
	1227	& , water,xtwater,qp,xtp,xtevap &
	1228	& , xtclw &
	1229	& , wdtrain,xtwdtrain,taux_cond_conv &
	1230	& , fq_detrainement,fq_ddft,fq_fluxmasse,fq_evapprecip &
	1231	& , fxt_detrainement,fxt_ddft,fxt_fluxmasse &
	1232	& , fxt_evapprecip,m,Amp_diag,tg_save,epmax_diag &
	1233	& , f_detrainement,q_detrainement,xt_detrainement &
	1234	! : , ment,qent,xtent
	1235	& , water1,xtwater1,qp1,xtp1,xtevap1 &
	1236	& , xtclw1 &
	1237	& , wdtrain1,xtwdtrain1,taux_cond_conv1 &
	1238	& , fq_detrainement1,fq_ddft1,fq_fluxmasse1,fq_evapprecip1 &
	1239	& , fxt_detrainement1,fxt_ddft1,fxt_fluxmasse1 &
	1240	& , fxt_evapprecip1,Mi1,Amp_diag1,tg_save1,epmax_diag1 &
	1241	& , f_detrainement1,q_detrainement1,xt_detrainement1 &
	1242	#endif
	1243	#endif
	1244	& )
	1245
	1246	#ifdef ISO
	1247	#ifdef ISOVERIF
	1248	DO k = 1, nd
	1249	DO i = 1, len
	1250	if (use_iso(iso_eau)) then
	1251	call iso_verif_egalite_choix(fxt1(iso_eau,i,k), &
	1252	& fq1(i,k),'cv_driver 1170',errmax,errmaxrel)
	1253	endif !if (use_iso(iso_HDO)) then
	1254	if (use_iso(iso_HDO)) then
	1255	if (q1(i,k).gt.ridicule) then
	1256	call iso_verif_aberrant( &
	1257	& (xt1(iso_HDO,i,k)+delt*fxt1(iso_HDO,i,k)) &
	1258	& /(q1(i,k)+delt*fq1(i,k)),'cv_driver 2554')
	1259	endif
	1260	endif
	1261	#ifdef DIAGISO
	1262	call iso_verif_positif(tg_save1(i,k)-50.0,'cv_driver 1221')
	1263	#endif
	1264	enddo !DO i = 1, len
	1265	enddo !DO k = 1, nd
	1266	#ifdef ISOTRAC
	1267	call iso_verif_trac_masse_vect(fxt1,len,nd, &
	1268	& 'cv_driver 1200',errmax,errmaxrel)
	1269	#endif
	1270	#endif
	1271	#endif
	1272
	1273	END IF
	1274
	1275	IF (iflag_con==4) THEN
	1276	CALL cv_uncompress(nloc, len, ncum, nd, idcum, iflag, precip, cbmf, ft, &
	1277	fq, fu, fv, ma, qcondc, iflag1, precip1, cbmf1, ft1, fq1, fu1, fv1, &
	1278	ma1, qcondc1)
	1279	END IF
	1280
	1281	END IF ! ncum>0
	1282
	1283	! print *, 'fin cv_driver ->' !jyg
	1284	RETURN
	1285	END SUBROUTINE cv_driver
	1286
	1287	! ==================================================================
	1288	SUBROUTINE cv_flag(iflag_ice_thermo)
	1289	IMPLICIT NONE
	1290
	1291	! Argument : iflag_ice_thermo : ice thermodynamics is taken into account if
	1292	! iflag_ice_thermo >=1
	1293	INTEGER iflag_ice_thermo
	1294
	1295	include "cvflag.h"
	1296
	1297	! -- si .TRUE., on rend la gravite plus explicite et eventuellement
	1298	! differente de 10.0 dans convect3:
	1299	cvflag_grav = .TRUE.
	1300	cvflag_ice = iflag_ice_thermo >= 1
	1301
	1302	RETURN
	1303	END SUBROUTINE cv_flag
	1304
	1305	! ==================================================================
	1306	SUBROUTINE cv_thermo(iflag_con)
	1307	IMPLICIT NONE
	1308
	1309	! -------------------------------------------------------------
	1310	! Set thermodynamical constants for convectL
	1311	! -------------------------------------------------------------
	1312
	1313	include "YOMCST.h"
	1314	include "cvthermo.h"
	1315
	1316	INTEGER iflag_con
	1317
	1318
	1319	! original set from convect:
	1320	IF (iflag_con==4) THEN
	1321	cpd = 1005.7
	1322	cpv = 1870.0
	1323	cl = 4190.0
	1324	rrv = 461.5
	1325	rrd = 287.04
	1326	lv0 = 2.501E6
	1327	g = 9.8
	1328	t0 = 273.15
	1329	grav = g
	1330	ELSE
	1331
	1332	! constants consistent with LMDZ:
	1333	cpd = rcpd
	1334	cpv = rcpv
	1335	cl = rcw
	1336	ci = rcs
	1337	rrv = rv
	1338	rrd = rd
	1339	lv0 = rlvtt
	1340	lf0 = rlstt - rlvtt
	1341	g = rg ! not used in convect3
	1342	! ori t0 = RTT
	1343	t0 = 273.15 ! convect3 (RTT=273.16)
	1344	! maf grav= 10. ! implicitely or explicitely used in convect3
	1345	grav = g ! implicitely or explicitely used in convect3
	1346	END IF
	1347
	1348	rowl = 1000.0 !(a quelle variable de YOMCST cela correspond-il?)
	1349
	1350	clmcpv = cl - cpv
	1351	clmcpd = cl - cpd
	1352	clmci = cl - ci
	1353	cpdmcp = cpd - cpv
	1354	cpvmcpd = cpv - cpd
	1355	cpvmcl = cl - cpv ! for convect3
	1356	eps = rrd/rrv
	1357	epsi = 1.0/eps
	1358	epsim1 = epsi - 1.0
	1359	! ginv=1.0/g
	1360	ginv = 1.0/grav
	1361	hrd = 0.5*rrd
	1362
	1363	RETURN
	1364	END SUBROUTINE cv_thermo

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

Download in other formats:

Original Format