Context Navigation

cva_driver.F90 @ 5214

Last change on this file since 5214 was 5160, checked in by abarral, 3 months ago
Put .h into modules
Property svn:keywords set to `Id`
File size: 70.2 KB

Rev	Line
[3927]	1
[4004]	2	! $Id: cva_driver.F90 5160 2024-08-03 12:56:58Z dcugnet $
[3927]	3
	4	SUBROUTINE cva_driver(len, nd, ndp1, ntra, nloc, k_upper, &
	5	iflag_con, iflag_mix, iflag_ice_thermo, iflag_clos, ok_conserv_q, &
	6	!! delt, t1, q1, qs1, t1_wake, q1_wake, qs1_wake, s1_wake, & ! jyg
	7	delt, comp_threshold, & ! jyg
	8	t1, q1, qs1, t1_wake, q1_wake, qs1_wake, s1_wake, & ! jyg
	9	u1, v1, tra1, &
	10	p1, ph1, &
	11	Ale1, Alp1, omega1, &
	12	sig1feed1, sig2feed1, wght1, &
[4613]	13	iflag1, ft1, fq1, fqcomp1, fu1, fv1, ftra1, &
[3927]	14	precip1, kbas1, ktop1, &
	15	cbmf1, plcl1, plfc1, wbeff1, &
	16	sig1, w01, & !input/output
	17	ptop21, sigd1, &
	18	ma1, mip1, Vprecip1, Vprecipi1, upwd1, dnwd1, dnwd01, & ! jyg
	19	qcondc1, wd1, &
	20	cape1, cin1, tvp1, &
	21	ftd1, fqd1, &
	22	Plim11, Plim21, asupmax1, supmax01, asupmaxmin1, &
	23	lalim_conv1, &
	24	!! da1,phi1,mp1,phi21,d1a1,dam1,sigij1,clw1, & ! RomP
	25	!! elij1,evap1,ep1,epmlmMm1,eplaMm1, & ! RomP
	26	da1, phi1, mp1, phi21, d1a1, dam1, sigij1, wghti1, & ! RomP, RL
	27	qta1, clw1, elij1, evap1, ep1, epmlmMm1, eplaMm1, & ! RomP, RL
[4613]	28	wdtrainA1, wdtrainS1, wdtrainM1, qtc1, sigt1, detrain1, tau_cld_cv, & !!jygprl
[3927]	29	coefw_cld_cv, & ! RomP, AJ
	30	epmax_diag1 & ! epmax_cape
	31	#ifdef ISO
[5087]	32	,xt1,xt1_wake,fxt1, xtprecip1 &
	33	,xtVprecip1,xtVprecipi1 &
	34	,xtclw1,fxtd1,xtevap1,xtwdtrainA1 &
[3927]	35	#ifdef DIAGISO
[5087]	36	, water1,xtwater1,qp1,xtp1 &
	37	, fq_detrainement1,fq_ddft1,fq_fluxmasse1,fq_evapprecip1 &
	38	, fxt_detrainement1,fxt_ddft1,fxt_fluxmasse1,fxt_evapprecip1 &
	39	, f_detrainement1,q_detrainement1,xt_detrainement1 &
[3927]	40	#endif
	41	#endif
[5087]	42	) ! epmax_cape
[3927]	43	! **************************************************************
	44	! *
	45	! CV_DRIVER *
	46	! *
	47	! *
	48	! written by : Sandrine Bony-Lena , 17/05/2003, 11.19.41 *
	49	! modified by : *
	50	! **************************************************************
	51	! **************************************************************
	52
[5112]	53	USE lmdz_print_control, ONLY: prt_level, lunout
[3927]	54	USE add_phys_tend_mod, ONLY: fl_cor_ebil
[5132]	55	USE lmdz_abort_physic, ONLY: abort_physic
[3927]	56	#ifdef ISO
[4143]	57	USE infotrac_phy, ONLY: ntraciso=>ntiso,niso,niso,itZonIso,nzone
[4033]	58	USE isotopes_mod, ONLY: iso_eau,iso_HDO,iso_O18,ridicule,bidouille_anti_divergence
[3927]	59	#ifdef ISOVERIF
[5117]	60	USE isotopes_verif_mod
[3927]	61	!, ONLY: errmax,errmaxrel,Tmin_verif,deltalim, &
	62	!& iso_verif_egalite_choix,iso_verif_aberrant_choix,iso_verif_aberrant, &
	63	!& iso_verif_egalite,iso_verif_noNaN,iso_verif_positif_nostop,iso_verif_noNaN_nostop
	64	#endif
	65	#ifdef ISOTRAC
[5117]	66	USE isotrac_mod, ONLY: option_traceurs,izone_ddft,izone_revap, &
[3927]	67	& izone_poubelle, index_zone,option_tmin,izone_cond
	68	#ifdef ISOVERIF
	69	USE isotopes_verif_mod, ONLY: iso_verif_traceur,iso_verif_traceur_justmass, &
	70	& iso_verif_trac_masse_vect
[5117]	71	USE isotrac_routines_mod, ONLY: iso_verif_traceur_pbidouille
[3927]	72	#endif
	73	#endif
	74	#endif
[5142]	75	USE lmdz_cv, ONLY: cv_param, cv_prelim, cv_feed, cv_undilute1, cv_trigger, cv_compress, &
	76	cv_undilute2, cv_closure, cv_mixing, cv_unsat, cv_yield, cv_uncompress
	77
[3927]	78	IMPLICIT NONE
	79
	80	! .............................START PROLOGUE............................
	81
	82
	83	! All argument names (except len,nd,ntra,nloc,delt and the flags) have a "1" appended.
	84	! The "1" is removed for the corresponding compressed variables.
	85	! PARAMETERS:
	86	! Name Type Usage Description
	87	! ---------- ---------- ------- ----------------------------
	88
	89	! len Integer Input first (i) dimension
	90	! nd Integer Input vertical (k) dimension
	91	! ndp1 Integer Input nd + 1
	92	! ntra Integer Input number of tracors
	93	! nloc Integer Input dimension of arrays for compressed fields
[4613]	94	! fqcomp1 Real Output spec hum tend (only mixed draughts)
[3927]	95	! k_upper Integer Input upmost level for vertical loops
	96	! iflag_con Integer Input version of convect (3/4)
	97	! iflag_mix Integer Input version of mixing (0/1/2)
	98	! iflag_ice_thermo Integer Input accounting for ice thermodynamics (0/1)
	99	! iflag_clos Integer Input version of closure (0/1)
	100	! tau_cld_cv Real Input characteristic time of dissipation of mixing fluxes
	101	! coefw_cld_cv Real Input coefficient for updraft velocity in convection
	102	! ok_conserv_q Logical Input when true corrections for water conservation are swtiched on
	103	! delt Real Input time step
	104	! comp_threshold Real Input threshold on the fraction of convective points below which
	105	! fields are compressed
	106	! t1 Real Input temperature (sat draught envt)
	107	! q1 Real Input specific hum (sat draught envt)
	108	! qs1 Real Input sat specific hum (sat draught envt)
	109	! t1_wake Real Input temperature (unsat draught envt)
	110	! q1_wake Real Input specific hum(unsat draught envt)
	111	! qs1_wake Real Input sat specific hum(unsat draughts envt)
	112	! s1_wake Real Input fractionnal area covered by wakes
	113	! u1 Real Input u-wind
	114	! v1 Real Input v-wind
	115	! tra1 Real Input tracors
	116	! p1 Real Input full level pressure
	117	! ph1 Real Input half level pressure
	118	! ALE1 Real Input Available lifting Energy
	119	! ALP1 Real Input Available lifting Power
	120	! sig1feed1 Real Input sigma coord at lower bound of feeding layer
	121	! sig2feed1 Real Input sigma coord at upper bound of feeding layer
	122	! wght1 Real Input weight density determining the feeding mixture
	123	! iflag1 Integer Output flag for Emanuel conditions
	124	! ft1 Real Output temp tend
	125	! fq1 Real Output spec hum tend
	126	! fu1 Real Output u-wind tend
	127	! fv1 Real Output v-wind tend
	128	! ftra1 Real Output tracor tend
	129	! precip1 Real Output precipitation
	130	! kbas1 Integer Output cloud base level
	131	! ktop1 Integer Output cloud top level
	132	! cbmf1 Real Output cloud base mass flux
	133	! sig1 Real In/Out section adiabatic updraft
	134	! w01 Real In/Out vertical velocity within adiab updraft
	135	! ptop21 Real In/Out top of entraining zone
	136	! Ma1 Real Output mass flux adiabatic updraft
	137	! mip1 Real Output mass flux shed by the adiabatic updraft
	138	! Vprecip1 Real Output vertical profile of total precipitation
	139	! Vprecipi1 Real Output vertical profile of ice precipitation
	140	! upwd1 Real Output total upward mass flux (adiab+mixed)
	141	! dnwd1 Real Output saturated downward mass flux (mixed)
[4613]	142	! detrain1 Real Output detrainment terme klein
[3927]	143	! dnwd01 Real Output unsaturated downward mass flux
	144	! qcondc1 Real Output in-cld mixing ratio of condensed water
	145	! wd1 Real Output downdraft velocity scale for sfc fluxes
	146	! cape1 Real Output CAPE
	147	! cin1 Real Output CIN
	148	! tvp1 Real Output adiab lifted parcell virt temp
	149	! ftd1 Real Output precip temp tend
	150	! fqt1 Real Output precip spec hum tend
	151	! Plim11 Real Output
	152	! Plim21 Real Output
	153	! asupmax1 Real Output
	154	! supmax01 Real Output
	155	! asupmaxmin1 Real Output
	156
	157	! ftd1 Real Output Array of temperature tendency due to precipitations (K/s) of dimension ND,
	158	! defined at same grid levels as T, Q, QS and P.
	159
	160	! fqd1 Real Output Array of specific humidity tendencies due to precipitations ((gm/gm)/s)
	161	! of dimension ND, defined at same grid levels as T, Q, QS and P.
	162
	163	! wdtrainA1 Real Output precipitation ejected from adiabatic draught;
	164	! should be used in tracer transport (cvltr)
	165	! wdtrainS1 Real Output precipitation detrained from shedding of adiabatic draught;
	166	! used in tracer transport (cvltr)
	167	! wdtrainM1 Real Output precipitation detrained from mixed draughts;
	168	! used in tracer transport (cvltr)
	169	! da1 Real Output used in tracer transport (cvltr)
	170	! phi1 Real Output used in tracer transport (cvltr)
	171	! mp1 Real Output used in tracer transport (cvltr)
	172	! qtc1 Real Output specific humidity in convection
	173	! sigt1 Real Output surface fraction in adiabatic updrafts
	174	! phi21 Real Output used in tracer transport (cvltr)
	175
	176	! d1a1 Real Output used in tracer transport (cvltr)
	177	! dam1 Real Output used in tracer transport (cvltr)
	178
	179	! epmlmMm1 Real Output used in tracer transport (cvltr)
	180	! eplaMm1 Real Output used in tracer transport (cvltr)
	181
	182	! evap1 Real Output
	183	! ep1 Real Output
	184	! sigij1 Real Output used in tracer transport (cvltr)
	185	! clw1 Real Output condensed water content of the adiabatic updraught
	186	! elij1 Real Output
	187	! wghti1 Real Output final weight of the feeding layers,
	188	! used in tracer transport (cvltr)
	189
	190
	191	! S. Bony, Mar 2002:
	192	! * Several modules corresponding to different physical processes
	193	! * Several versions of convect may be used:
	194	! - iflag_con=3: version lmd (previously named convect3)
	195	! - iflag_con=4: version 4.3b (vect. version, previously convect1/2)
	196	! + tard: - iflag_con=5: version lmd with ice (previously named convectg)
	197	! S. Bony, Oct 2002:
	198	! * Vectorization of convect3 (ie version lmd)
	199
	200	! ..............................END PROLOGUE.............................
	201
	202
	203
	204	! Input
	205	INTEGER, INTENT (IN) :: len
	206	INTEGER, INTENT (IN) :: nd
	207	INTEGER, INTENT (IN) :: ndp1
	208	INTEGER, INTENT (IN) :: ntra
	209	INTEGER, INTENT(IN) :: nloc ! (nloc=len) pour l'instant
	210	INTEGER, INTENT (IN) :: k_upper
	211	INTEGER, INTENT (IN) :: iflag_con
	212	INTEGER, INTENT (IN) :: iflag_mix
	213	INTEGER, INTENT (IN) :: iflag_ice_thermo
	214	INTEGER, INTENT (IN) :: iflag_clos
	215	LOGICAL, INTENT (IN) :: ok_conserv_q
	216	REAL, INTENT (IN) :: tau_cld_cv
[4613]	217	REAL, DIMENSION (len, nd), INTENT (OUT) :: fqcomp1
[3927]	218	REAL, INTENT (IN) :: coefw_cld_cv
	219	REAL, INTENT (IN) :: delt
	220	REAL, INTENT (IN) :: comp_threshold
	221	REAL, DIMENSION (len, nd), INTENT (IN) :: t1
	222	REAL, DIMENSION (len, nd), INTENT (IN) :: q1
	223	REAL, DIMENSION (len, nd), INTENT (IN) :: qs1
	224	REAL, DIMENSION (len, nd), INTENT (IN) :: t1_wake
	225	REAL, DIMENSION (len, nd), INTENT (IN) :: q1_wake
	226	REAL, DIMENSION (len, nd), INTENT (IN) :: qs1_wake
	227	REAL, DIMENSION (len), INTENT (IN) :: s1_wake
	228	REAL, DIMENSION (len, nd), INTENT (IN) :: u1
	229	REAL, DIMENSION (len, nd), INTENT (IN) :: v1
	230	REAL, DIMENSION (len, nd, ntra), INTENT (IN) :: tra1
	231	REAL, DIMENSION (len, nd), INTENT (IN) :: p1
	232	REAL, DIMENSION (len, ndp1), INTENT (IN) :: ph1
	233	REAL, DIMENSION (len), INTENT (IN) :: Ale1
	234	REAL, DIMENSION (len), INTENT (IN) :: Alp1
	235	REAL, DIMENSION (len, nd), INTENT (IN) :: omega1
	236	REAL, INTENT (IN) :: sig1feed1 ! pressure at lower bound of feeding layer
	237	REAL, INTENT (IN) :: sig2feed1 ! pressure at upper bound of feeding layer
	238	REAL, DIMENSION (nd), INTENT (IN) :: wght1 ! weight density determining the feeding mixture
	239	INTEGER, DIMENSION (len), INTENT (IN) :: lalim_conv1
	240
	241	! Input/Output
	242	REAL, DIMENSION (len, nd), INTENT (INOUT) :: sig1
	243	REAL, DIMENSION (len, nd), INTENT (INOUT) :: w01
	244
	245	! Output
	246	INTEGER, DIMENSION (len), INTENT (OUT) :: iflag1
	247	REAL, DIMENSION (len, nd), INTENT (OUT) :: ft1
	248	REAL, DIMENSION (len, nd), INTENT (OUT) :: fq1
	249	REAL, DIMENSION (len, nd), INTENT (OUT) :: fu1
	250	REAL, DIMENSION (len, nd), INTENT (OUT) :: fv1
	251	REAL, DIMENSION (len, nd, ntra), INTENT (OUT) :: ftra1
	252	REAL, DIMENSION (len), INTENT (OUT) :: precip1
	253	INTEGER, DIMENSION (len), INTENT (OUT) :: kbas1
	254	INTEGER, DIMENSION (len), INTENT (OUT) :: ktop1
	255	REAL, DIMENSION (len), INTENT (OUT) :: cbmf1
	256	REAL, DIMENSION (len), INTENT (OUT) :: plcl1
[4613]	257	REAL, DIMENSION (len, nd), INTENT (OUT) :: detrain1 ! detrainement term of mixed draughts in environment
[3927]	258	REAL, DIMENSION (len), INTENT (OUT) :: plfc1
	259	REAL, DIMENSION (len), INTENT (OUT) :: wbeff1
	260	REAL, DIMENSION (len), INTENT (OUT) :: ptop21
	261	REAL, DIMENSION (len), INTENT (OUT) :: sigd1
	262	REAL, DIMENSION (len, nd), INTENT (OUT) :: ma1 ! adiab. asc. mass flux (staggered grid)
	263	REAL, DIMENSION (len, nd), INTENT (OUT) :: mip1 ! mass flux shed from adiab. ascent (extensive)
	264	! real Vprecip1(len,nd)
	265	REAL, DIMENSION (len, ndp1), INTENT (OUT) :: vprecip1 ! tot precipitation flux (staggered grid)
	266	REAL, DIMENSION (len, ndp1), INTENT (OUT) :: vprecipi1 ! ice precipitation flux (staggered grid)
	267	REAL, DIMENSION (len, nd), INTENT (OUT) :: upwd1 ! upwd sat. mass flux (staggered grid)
	268	REAL, DIMENSION (len, nd), INTENT (OUT) :: dnwd1 ! dnwd sat. mass flux (staggered grid)
	269	REAL, DIMENSION (len, nd), INTENT (OUT) :: dnwd01 ! unsat. mass flux (staggered grid)
	270	REAL, DIMENSION (len, nd), INTENT (OUT) :: qcondc1 ! max cloud condensate (intensive) ! cld
	271	REAL, DIMENSION (len), INTENT (OUT) :: wd1 ! gust
	272	REAL, DIMENSION (len), INTENT (OUT) :: cape1
	273	REAL, DIMENSION (len), INTENT (OUT) :: cin1
	274	REAL, DIMENSION (len, nd), INTENT (OUT) :: tvp1 ! Virt. temp. in the adiab. ascent
	275
	276	!AC!
	277	!! real da1(len,nd),phi1(len,nd,nd)
	278	!! real da(len,nd),phi(len,nd,nd)
	279	!AC!
	280	REAL, DIMENSION (len, nd), INTENT (OUT) :: ftd1 ! Temp. tendency due to the sole unsat. drafts
	281	REAL, DIMENSION (len, nd), INTENT (OUT) :: fqd1 ! Moist. tendency due to the sole unsat. drafts
	282	REAL, DIMENSION (len), INTENT (OUT) :: Plim11
	283	REAL, DIMENSION (len), INTENT (OUT) :: Plim21
	284	REAL, DIMENSION (len, nd), INTENT (OUT) :: asupmax1 ! Highest mixing fraction of mixed updraughts
	285	REAL, DIMENSION (len), INTENT (OUT) :: supmax01
	286	REAL, DIMENSION (len), INTENT (OUT) :: asupmaxmin1
	287	REAL, DIMENSION (len, nd), INTENT (OUT) :: qtc1 ! in cloud water content (intensive) ! cld
	288	REAL, DIMENSION (len, nd), INTENT (OUT) :: sigt1 ! fract. cloud area (intensive) ! cld
	289
	290	! RomP >>>
	291	REAL, DIMENSION (len, nd), INTENT (OUT) :: wdtrainA1, wdtrainS1, wdtrainM1 ! precipitation sources (extensive)
	292	REAL, DIMENSION (len, nd), INTENT (OUT) :: mp1 ! unsat. mass flux (staggered grid)
	293	REAL, DIMENSION (len, nd), INTENT (OUT) :: da1 ! detrained mass flux of adiab. asc. air (extensive)
	294	REAL, DIMENSION (len, nd, nd), INTENT (OUT) :: phi1 ! mass flux of envt. air in mixed draughts (extensive)
	295	REAL, DIMENSION (len, nd, nd), INTENT (OUT) :: epmlmMm1 ! (extensive)
	296	REAL, DIMENSION (len, nd), INTENT (OUT) :: eplaMm1 ! (extensive)
	297	REAL, DIMENSION (len, nd), INTENT (OUT) :: evap1 ! evaporation rate in precip. downdraft. (intensive)
	298	REAL, DIMENSION (len, nd), INTENT (OUT) :: ep1
	299	REAL, DIMENSION (len, nd, nd), INTENT (OUT) :: sigij1 ! mass fraction of env. air in mixed draughts (intensive)
	300	REAL, DIMENSION (len, nd, nd), INTENT (OUT) :: elij1! cond. water per unit mass of mixed draughts (intensive)
	301	REAL, DIMENSION (len, nd), INTENT (OUT) :: qta1 ! total water per unit mass of the adiab. asc. (intensive)
	302	REAL, DIMENSION (len, nd), INTENT (OUT) :: clw1 ! cond. water per unit mass of the adiab. asc. (intensive)
	303	!JYG,RL
	304	REAL, DIMENSION (len, nd), INTENT (OUT) :: wghti1 ! final weight of the feeding layers (extensive)
	305	!JYG,RL
	306	REAL, DIMENSION (len, nd, nd), INTENT (OUT) :: phi21 ! (extensive)
	307	REAL, DIMENSION (len, nd), INTENT (OUT) :: d1a1 ! (extensive)
	308	REAL, DIMENSION (len, nd), INTENT (OUT) :: dam1 ! (extensive)
	309	! RomP <<<
	310	REAL, DIMENSION (len ), INTENT (OUT) :: epmax_diag1
	311	#ifdef ISO
[5117]	312	REAL, DIMENSION(ntraciso,len,nd), INTENT (IN) :: xt1
	313	REAL, DIMENSION(ntraciso,len,nd), INTENT (OUT) :: fxt1
	314	REAL, DIMENSION(ntraciso,len,nd), INTENT (OUT) :: xt1_wake
	315	REAL, DIMENSION(ntraciso,len), INTENT (OUT) :: xtprecip1
	316	REAL, DIMENSION(ntraciso,len,nd), INTENT (OUT) :: fxtd1
	317	REAL, DIMENSION(ntraciso,len,ndp1), INTENT (OUT) :: xtvprecip1
	318	REAL, DIMENSION(ntraciso,len,ndp1), INTENT (OUT) :: xtvprecipi1
	319	REAL, DIMENSION(ntraciso,len,nd), INTENT (OUT) :: xtwdtrainA1
	320	REAL, DIMENSION(ntraciso,len,nd), INTENT (OUT) :: xtevap1
[3927]	321	REAL, DIMENSION (ntraciso,len, nd), INTENT (OUT) :: xtclw1
	322	REAL, DIMENSION (ntraciso,len, nd, nd) :: xtelij1 ! pas besoin de le sortir?
	323	#ifdef DIAGISO
[5117]	324	REAL, DIMENSION(len,nd), INTENT (OUT) :: water1
	325	REAL, DIMENSION(ntraciso,len,nd), INTENT (OUT) :: xtwater1
	326	REAL, DIMENSION(len,nd), INTENT (OUT) :: qp1
	327	REAL, DIMENSION(ntraciso,len,nd), INTENT (OUT) :: xtp1
	328	REAL, DIMENSION(len,nd), INTENT (OUT) :: fq_detrainement1
	329	REAL, DIMENSION(len,nd), INTENT (OUT) :: fq_ddft1
	330	REAL, DIMENSION(len,nd), INTENT (OUT) :: fq_fluxmasse1
	331	REAL, DIMENSION(len,nd), INTENT (OUT) :: fq_evapprecip1
	332	REAL, DIMENSION(ntraciso,len,nd), INTENT (OUT) :: fxt_detrainement1
	333	REAL, DIMENSION(ntraciso,len,nd), INTENT (OUT) :: fxt_ddft1
	334	REAL, DIMENSION(ntraciso,len,nd), INTENT (OUT) :: fxt_fluxmasse1
	335	REAL, DIMENSION(ntraciso,len,nd), INTENT (OUT) :: fxt_evapprecip1
	336	REAL, DIMENSION(len,nd), INTENT (OUT) :: f_detrainement1
	337	REAL, DIMENSION(len,nd), INTENT (OUT) :: q_detrainement1
	338	REAL, DIMENSION(ntraciso,len,nd), INTENT (OUT) :: xt_detrainement1
[3927]	339	! real mentbas1(len,nd)
	340	! real qentbas1(len,nd), xtentbas1(niso,len,nd)
	341	#endif
	342	#endif
	343
	344
	345	! -------------------------------------------------------------------
	346	! Prolog by Kerry Emanuel.
	347	! -------------------------------------------------------------------
	348	! --- ARGUMENTS
	349	! -------------------------------------------------------------------
	350	! --- On input:
	351
	352	! t: Array of absolute temperature (K) of dimension ND, with first
	353	! index corresponding to lowest model level. Note that this array
[5103]	354	! will be altered by the SUBROUTINE if dry convective adjustment
[3927]	355	! occurs and if IPBL is not equal to 0.
	356
	357	! q: Array of specific humidity (gm/gm) of dimension ND, with first
	358	! index corresponding to lowest model level. Must be defined
	359	! at same grid levels as T. Note that this array will be altered
	360	! if dry convective adjustment occurs and if IPBL is not equal to 0.
	361
	362	! qs: Array of saturation specific humidity of dimension ND, with first
	363	! index corresponding to lowest model level. Must be defined
	364	! at same grid levels as T. Note that this array will be altered
	365	! if dry convective adjustment occurs and if IPBL is not equal to 0.
	366
	367	! t_wake: Array of absolute temperature (K), seen by unsaturated draughts,
	368	! of dimension ND, with first index corresponding to lowest model level.
	369
	370	! q_wake: Array of specific humidity (gm/gm), seen by unsaturated draughts,
	371	! of dimension ND, with first index corresponding to lowest model level.
	372	! Must be defined at same grid levels as T.
	373
	374	! qs_wake: Array of saturation specific humidity, seen by unsaturated draughts,
	375	! of dimension ND, with first index corresponding to lowest model level.
	376	! Must be defined at same grid levels as T.
	377
	378	! s_wake: Array of fractionnal area occupied by the wakes.
	379
	380	! u: Array of zonal wind velocity (m/s) of dimension ND, witth first
	381	! index corresponding with the lowest model level. Defined at
	382	! same levels as T. Note that this array will be altered if
	383	! dry convective adjustment occurs and if IPBL is not equal to 0.
	384
	385	! v: Same as u but for meridional velocity.
	386
	387	! tra: Array of passive tracer mixing ratio, of dimensions (ND,NTRA),
	388	! where NTRA is the number of different tracers. If no
	389	! convective tracer transport is needed, define a dummy
	390	! input array of dimension (ND,1). Tracers are defined at
	391	! same vertical levels as T. Note that this array will be altered
	392	! if dry convective adjustment occurs and if IPBL is not equal to 0.
	393
	394	! p: Array of pressure (mb) of dimension ND, with first
	395	! index corresponding to lowest model level. Must be defined
	396	! at same grid levels as T.
	397
	398	! ph: Array of pressure (mb) of dimension ND+1, with first index
	399	! corresponding to lowest level. These pressures are defined at
	400	! levels intermediate between those of P, T, Q and QS. The first
	401	! value of PH should be greater than (i.e. at a lower level than)
	402	! the first value of the array P.
	403
	404	! ALE: Available lifting Energy
	405
	406	! ALP: Available lifting Power
	407
	408	! nl: The maximum number of levels to which convection can penetrate, plus 1.
	409	! NL MUST be less than or equal to ND-1.
	410
	411	! delt: The model time step (sec) between calls to CONVECT
	412
	413	! ----------------------------------------------------------------------------
	414	! --- On Output:
	415
	416	! iflag: An output integer whose value denotes the following:
	417	! VALUE INTERPRETATION
	418	! ----- --------------
	419	! 0 Moist convection occurs.
	420	! 1 Moist convection occurs, but a CFL condition
	421	! on the subsidence warming is violated. This
	422	! does not cause the scheme to terminate.
	423	! 2 Moist convection, but no precip because ep(inb) lt 0.0001
	424	! 3 No moist convection because new cbmf is 0 and old cbmf is 0.
	425	! 4 No moist convection; atmosphere is not
	426	! unstable
	427	! 6 No moist convection because ihmin le minorig.
	428	! 7 No moist convection because unreasonable
	429	! parcel level temperature or specific humidity.
	430	! 8 No moist convection: lifted condensation
	431	! level is above the 200 mb level.
	432	! 9 No moist convection: cloud base is higher
	433	! then the level NL-1.
	434	! 10 No moist convection: cloud top is too warm.
	435	! 14 No moist convection; atmosphere is very
	436	! stable (=> no computation)
	437
	438	! ft: Array of temperature tendency (K/s) of dimension ND, defined at same
	439	! grid levels as T, Q, QS and P.
	440
	441	! fq: Array of specific humidity tendencies ((gm/gm)/s) of dimension ND,
	442	! defined at same grid levels as T, Q, QS and P.
	443
	444	! fu: Array of forcing of zonal velocity (m/s^2) of dimension ND,
	445	! defined at same grid levels as T.
	446
	447	! fv: Same as FU, but for forcing of meridional velocity.
	448
	449	! ftra: Array of forcing of tracer content, in tracer mixing ratio per
	450	! second, defined at same levels as T. Dimensioned (ND,NTRA).
	451
	452	! precip: Scalar convective precipitation rate (mm/day).
	453
	454	! wd: A convective downdraft velocity scale. For use in surface
	455	! flux parameterizations. See convect.ps file for details.
	456
	457	! tprime: A convective downdraft temperature perturbation scale (K).
	458	! For use in surface flux parameterizations. See convect.ps
	459	! file for details.
	460
	461	! qprime: A convective downdraft specific humidity
	462	! perturbation scale (gm/gm).
	463	! For use in surface flux parameterizations. See convect.ps
	464	! file for details.
	465
	466	! cbmf: The cloud base mass flux ((kg/m**2)/s). THIS SCALAR VALUE MUST
	467	! BE STORED BY THE CALLING PROGRAM AND RETURNED TO CONVECT AT
	468	! ITS NEXT CALL. That is, the value of CBMF must be "remembered"
	469	! by the calling program between calls to CONVECT.
	470
	471	! det: Array of detrainment mass flux of dimension ND.
	472	! -------------------------------------------------------------------
	473
	474	! Local (non compressed) arrays
	475
	476
	477	INTEGER i, k, il
	478	INTEGER nword1, nword2, nword3, nword4
	479	INTEGER icbmax
	480	INTEGER nk1(len)
	481	INTEGER icb1(len)
	482	INTEGER icbs1(len)
	483
	484	LOGICAL ok_inhib ! True => possible inhibition of convection by dryness
	485	LOGICAL, SAVE :: debut = .TRUE.
	486	!$OMP THREADPRIVATE(debut)
	487
	488	REAL coef_convective(len) ! = 1 for convective points, = 0 otherwise
	489	REAL tnk1(len)
	490	REAL thnk1(len)
	491	REAL qnk1(len)
	492	REAL gznk1(len)
	493	REAL qsnk1(len)
	494	REAL unk1(len)
	495	REAL vnk1(len)
	496	REAL cpnk1(len)
	497	REAL hnk1(len)
	498	REAL pbase1(len)
	499	REAL buoybase1(len)
	500
	501	REAL lf1(len, nd), lf1_wake(len, nd)
	502	REAL lv1(len, nd), lv1_wake(len, nd)
	503	REAL cpn1(len, nd), cpn1_wake(len, nd)
	504	REAL tv1(len, nd), tv1_wake(len, nd)
	505	REAL gz1(len, nd), gz1_wake(len, nd)
	506	REAL hm1(len, nd)
	507	REAL h1(len, nd), h1_wake(len, nd)
	508	REAL tp1(len, nd)
	509	REAL th1(len, nd), th1_wake(len, nd)
	510
	511	REAL bid(len, nd) ! dummy array
	512
	513	#ifdef ISO
[5117]	514	INTEGER ixt
	515	REAL xtnk1(ntraciso,len)
[3927]	516	#endif
	517
	518
	519	INTEGER ncum
	520
	521	REAL p1feed1(len) ! pressure at lower bound of feeding layer
	522	REAL p2feed1(len) ! pressure at upper bound of feeding layer
	523	!JYG,RL
	524	!! real wghti1(len,nd) ! weights of the feeding layers
	525	!JYG,RL
	526
	527	! (local) compressed fields:
	528
	529
	530	INTEGER idcum(nloc)
	531	!jyg<
	532	LOGICAL compress ! True if compression occurs
	533	!>jyg
	534	INTEGER iflag(nloc), nk(nloc), icb(nloc)
	535	INTEGER nent(nloc, nd)
	536	INTEGER icbs(nloc)
	537	INTEGER inb(nloc), inbis(nloc)
	538
	539	REAL cbmf(nloc), plcl(nloc), plfc(nloc), wbeff(nloc)
	540	REAL t(nloc, nd), q(nloc, nd), qs(nloc, nd)
	541	REAL t_wake(nloc, nd), q_wake(nloc, nd), qs_wake(nloc, nd)
	542	REAL s_wake(nloc)
	543	REAL u(nloc, nd), v(nloc, nd)
	544	REAL gz(nloc, nd), h(nloc, nd)
	545	REAL h_wake(nloc, nd)
	546	REAL lv(nloc, nd), lf(nloc, nd), cpn(nloc, nd)
	547	REAL lv_wake(nloc, nd), lf_wake(nloc, nd), cpn_wake(nloc, nd)
	548	REAL p(nloc, nd), ph(nloc, nd+1), tv(nloc, nd), tp(nloc, nd)
	549	REAL tv_wake(nloc, nd)
	550	REAL clw(nloc, nd)
	551	REAL, DIMENSION(nloc, nd) :: qta, qpreca !!jygprl
	552	REAL dph(nloc, nd)
	553	REAL pbase(nloc), buoybase(nloc), th(nloc, nd)
	554	REAL th_wake(nloc, nd)
	555	REAL tvp(nloc, nd)
	556	REAL sig(nloc, nd), w0(nloc, nd), ptop2(nloc)
	557	REAL hp(nloc, nd), ep(nloc, nd), sigp(nloc, nd)
	558	REAL buoy(nloc, nd)
	559	REAL cape(nloc)
	560	REAL cin(nloc)
	561	REAL m(nloc, nd)
	562	REAL mm(nloc, nd)
	563	REAL ment(nloc, nd, nd), sigij(nloc, nd, nd)
	564	REAL qent(nloc, nd, nd)
	565	REAL hent(nloc, nd, nd)
	566	REAL uent(nloc, nd, nd), vent(nloc, nd, nd)
	567	REAL ments(nloc, nd, nd), qents(nloc, nd, nd)
	568	REAL elij(nloc, nd, nd)
	569	REAL supmax(nloc, nd)
	570	REAL Ale(nloc), Alp(nloc), coef_clos(nloc)
	571	REAL omega(nloc,nd)
	572	REAL sigd(nloc)
	573	! real mp(nloc,nd), qp(nloc,nd), up(nloc,nd), vp(nloc,nd)
	574	! real wt(nloc,nd), water(nloc,nd), evap(nloc,nd), ice(nloc,nd)
	575	! real b(nloc,nd), sigd(nloc)
	576	! save mp,qp,up,vp,wt,water,evap,b
	577	REAL, DIMENSION(len,nd) :: mp, qp, up, vp
	578	REAL, DIMENSION(len,nd) :: wt, water, evap
	579	REAL, DIMENSION(len,nd) :: ice, fondue, b
	580	REAL, DIMENSION(len,nd) :: frac_a, frac_s, faci !!jygprl
[4613]	581	REAL ft(nloc, nd), fq(nloc, nd), fqcomp(nloc, nd)
[3927]	582	REAL ftd(nloc, nd), fqd(nloc, nd)
	583	REAL fu(nloc, nd), fv(nloc, nd)
	584	REAL upwd(nloc, nd), dnwd(nloc, nd), dnwd0(nloc, nd)
	585	REAL ma(nloc, nd), mip(nloc, nd)
	586	!! REAL tls(nloc, nd), tps(nloc, nd) ! unused . jyg
	587	REAL qprime(nloc), tprime(nloc)
	588	REAL precip(nloc)
	589	! real Vprecip(nloc,nd)
	590	REAL vprecip(nloc, nd+1)
	591	REAL vprecipi(nloc, nd+1)
	592	REAL tra(nloc, nd, ntra), trap(nloc, nd, ntra)
	593	REAL ftra(nloc, nd, ntra), traent(nloc, nd, nd, ntra)
	594	REAL qcondc(nloc, nd) ! cld
	595	REAL wd(nloc) ! gust
	596	REAL Plim1(nloc), plim2(nloc)
	597	REAL asupmax(nloc, nd)
	598	REAL supmax0(nloc)
	599	REAL asupmaxmin(nloc)
	600
	601	REAL tnk(nloc), qnk(nloc), gznk(nloc)
	602	REAL wghti(nloc, nd)
	603	REAL hnk(nloc), unk(nloc), vnk(nloc)
	604
	605	REAL qtc(nloc, nd) ! cld
	606	REAL sigt(nloc, nd) ! cld
[4613]	607	REAL detrain(nloc, nd) ! cld
[3927]	608
	609	! RomP >>>
	610	REAL wdtrainA(nloc, nd), wdtrainS(nloc, nd), wdtrainM(nloc, nd) !!jygprl
	611	REAL da(len, nd), phi(len, nd, nd)
	612	REAL epmlmMm(nloc, nd, nd), eplaMm(nloc, nd)
	613	REAL phi2(len, nd, nd)
	614	REAL d1a(len, nd), dam(len, nd)
	615	! RomP <<<
	616	REAL epmax_diag(nloc) ! epmax_cape
	617
	618	CHARACTER (LEN=20) :: modname = 'cva_driver'
	619	CHARACTER (LEN=80) :: abort_message
	620
	621	REAL, PARAMETER :: Cin_noconv = -100000.
	622	REAL, PARAMETER :: Cape_noconv = -1.
	623
	624	INTEGER,SAVE :: igout=1
	625	!$OMP THREADPRIVATE(igout)
	626
	627	#ifdef ISO
[5117]	628	REAL xt(ntraciso,nloc,nd)
[3927]	629	REAL, DIMENSION(ntraciso,nloc, nd) :: xtta
[5117]	630	REAL xt_wake(ntraciso,nloc,nd)
	631	REAL xtclw(ntraciso,nloc,nd)
	632	REAL xtp(ntraciso,nloc,nd)
	633	REAL xtent(ntraciso,nloc,nd,nd)
	634	REAL xtelij(ntraciso,nloc,nd,nd)
	635	REAL xtwater(ntraciso,nloc,nd)
	636	REAL xtice(ntraciso,nloc,nd)
	637	REAL xtevap(ntraciso,nloc,nd)
	638	REAL fxt(ntraciso,nloc,nd)
	639	REAL fxtd(ntraciso,nloc,nd)
	640	REAL xtprecip(ntraciso,nloc)
	641	REAL xtnk(ntraciso,nloc)
	642	REAL xtVprecip(ntraciso,nloc,nd+1)
	643	REAL xtVprecipi(ntraciso,nloc,nd+1)
	644	REAL xtwdtrainA(niso,nloc,nd)
[3927]	645	#ifdef DIAGISO
[5117]	646	REAL fxt_detrainement(niso,nloc,nd)
	647	REAL fxt_fluxmasse(niso,nloc,nd)
	648	REAL fxt_evapprecip(niso,nloc,nd)
	649	REAL fxt_ddft(niso,nloc,nd)
	650	REAL fq_detrainement(nloc,nd)
	651	REAL fq_fluxmasse(nloc,nd)
	652	REAL fq_evapprecip(nloc,nd)
	653	REAL fq_ddft(nloc,nd)
	654	REAL f_detrainement(nloc,nd)
	655	REAL q_detrainement(nloc,nd)
	656	REAL xt_detrainement(niso,nloc,nd)
[3927]	657	#endif
	658	#ifdef ISOTRAC
[5117]	659	INTEGER iiso,ixt_ddft,ixt_poubelle,ixt_revap
	660	INTEGER izone
[3927]	661	#endif
	662	#ifdef ISOVERIF
[5117]	663	INTEGER j
[3927]	664	#endif
	665	#endif
	666
	667
[5160]	668	! PRINT *, 't1, t1_wake ',(k,t1(1,k),t1_wake(1,k),k=1,nd)
	669	! PRINT *, 'q1, q1_wake ',(k,q1(1,k),q1_wake(1,k),k=1,nd)
[3927]	670
	671	! -------------------------------------------------------------------
	672	! --- SET CONSTANTS AND PARAMETERS
	673	! -------------------------------------------------------------------
	674
	675	! -- set simulation flags:
	676	! (common cvflag)
	677
	678	CALL cv_flag(iflag_ice_thermo)
	679
	680	! -- set thermodynamical constants:
	681	! (common cvthermo)
	682
	683	CALL cv_thermo(iflag_con)
	684
	685	! -- set convect parameters
	686
	687	! includes microphysical parameters and parameters that
	688	! control the rate of approach to quasi-equilibrium)
	689	! (common cvparam)
	690
	691	IF (iflag_con==3) THEN
	692	CALL cv3_param(nd, k_upper, delt)
	693
	694	END IF
	695
	696	IF (iflag_con==4) THEN
	697	CALL cv_param(nd)
	698	#ifdef ISO
	699	CALL abort_physic('cva_driver 555', 'isos pas prevus ici', 1)
	700	#endif
	701	END IF
	702
	703	! ---------------------------------------------------------------------
	704	! --- INITIALIZE OUTPUT ARRAYS AND PARAMETERS
	705	! ---------------------------------------------------------------------
	706	nword1 = len
	707	nword2 = len*nd
	708	nword3 = lenndntra
	709	nword4 = lenndnd
	710
	711	iflag1(:) = 0
	712	ktop1(:) = 0
	713	kbas1(:) = 0
	714	ft1(:, :) = 0.0
	715	fq1(:, :) = 0.0
[4613]	716	fqcomp1(:, :) = 0.0
[3927]	717	fu1(:, :) = 0.0
	718	fv1(:, :) = 0.0
	719	ftra1(:, :, :) = 0.
	720	precip1(:) = 0.
	721	cbmf1(:) = 0.
	722	plcl1(:) = 0.
	723	plfc1(:) = 0.
	724	wbeff1(:) = 0.
	725	ptop21(:) = 0.
	726	sigd1(:) = 0.
	727	ma1(:, :) = 0.
	728	mip1(:, :) = 0.
	729	vprecip1(:, :) = 0.
	730	vprecipi1(:, :) = 0.
	731	upwd1(:, :) = 0.
	732	dnwd1(:, :) = 0.
	733	dnwd01(:, :) = 0.
	734	qcondc1(:, :) = 0.
	735	wd1(:) = 0.
	736	cape1(:) = 0.
	737	cin1(:) = 0.
	738	tvp1(:, :) = 0.
	739	ftd1(:, :) = 0.
	740	fqd1(:, :) = 0.
	741	Plim11(:) = 0.
	742	Plim21(:) = 0.
	743	asupmax1(:, :) = 0.
	744	supmax01(:) = 0.
	745	asupmaxmin1(:) = 0.
	746	#ifdef ISO
	747	xtprecip1(:, :) = 0.
	748	fxt1(:,:, :) = 0.0
	749	xtvprecip1(:,:, :) = 0.
	750	xtvprecipi1(:,:, :) = 0.
	751	fxtd1(:,:, :) = 0.
	752	#endif
	753
	754	tvp(:, :) = 0. !ym missing init, need to have a look by developpers
	755	tv(:, :) = 0. !ym missing init, need to have a look by developpers
	756
	757	DO il = 1, len
	758	!! cin1(il) = -100000.
	759	!! cape1(il) = -1.
	760	cin1(il) = Cin_noconv
	761	cape1(il) = Cape_noconv
	762	END DO
	763
	764	!! IF (iflag_con==3) THEN
	765	!! DO il = 1, len
	766	!! sig1(il, nd) = sig1(il, nd) + 1.
	767	!! sig1(il, nd) = amin1(sig1(il,nd), 12.1)
	768	!! END DO
	769	!! END IF
	770
	771	IF (iflag_con==3) THEN
	772	CALL cv3_incrcount(len,nd,delt,sig1)
	773	END IF ! (iflag_con==3)
	774
	775	! RomP >>>
	776	sigt1(:, :) = 0.
[4613]	777	detrain1(:, :) = 0.
[3927]	778	qtc1(:, :) = 0.
	779	wdtrainA1(:, :) = 0.
	780	wdtrainS1(:, :) = 0.
	781	wdtrainM1(:, :) = 0.
	782	da1(:, :) = 0.
	783	phi1(:, :, :) = 0.
	784	epmlmMm1(:, :, :) = 0.
	785	eplaMm1(:, :) = 0.
	786	mp1(:, :) = 0.
	787	evap1(:, :) = 0.
	788	ep1(:, :) = 0.
	789	sigij1(:, :, :) = 0.
	790	elij1(:, :, :) = 0.
	791	qta1(:,:) = 0.
	792	clw1(:,:) = 0.
	793	wghti1(:,:) = 0.
	794	phi21(:, :, :) = 0.
	795	d1a1(:, :) = 0.
	796	dam1(:, :) = 0.
	797	m(:,:)=0. ! C Risi
	798	#ifdef ISO
	799	xtwdtrainA1(:,:, :) = 0.
	800	xtevap1(:,:, :) = 0.
	801	xtelij1(:,:, :, :) = 0.
	802	xtclw1(:,:,:) = 0.
	803	q(:,:)=0.0 ! securite pour check plus bas
	804	xt(:,:,:)=0.0 ! securite pour check plus bas
	805	q_wake(:,:)=0.0 ! securite pour check plus bas
	806	xt_wake(:,:,:)=0.0 ! securite pour check plus bas
	807	clw(:,:)=0.0 ! securite pour check plus bas
	808	xtclw(:,:,:)=0.0 ! securite pour check plus bas
	809	#endif
	810	! RomP <<<
	811	! ---------------------------------------------------------------------
	812	! --- INITIALIZE LOCAL ARRAYS AND PARAMETERS
	813	! ---------------------------------------------------------------------
	814
	815	DO il = 1, nloc
	816	coef_clos(il) = 1.
	817	END DO
	818
	819	! --------------------------------------------------------------------
	820	! --- CALCULATE ARRAYS OF GEOPOTENTIAL, HEAT CAPACITY & STATIC ENERGY
	821	! --------------------------------------------------------------------
	822
	823	IF (iflag_con==3) THEN
	824
	825	IF (debut) THEN
	826	PRINT *, 'Emanuel version 3 nouvelle'
	827	END IF
[5103]	828	! PRINT*,'t1, q1 ',t1,q1
[5117]	829	IF (prt_level >= 9) &
[3927]	830	PRINT *, 'cva_driver -> cv3_prelim'
	831	CALL cv3_prelim(len, nd, ndp1, t1, q1, p1, ph1, & ! nd->na
	832	lv1, lf1, cpn1, tv1, gz1, h1, hm1, th1)
	833
	834
[5117]	835	IF (prt_level >= 9) &
[3927]	836	PRINT *, 'cva_driver -> cv3_prelim'
	837	CALL cv3_prelim(len, nd, ndp1, t1_wake, q1_wake, p1, ph1, & ! nd->na
	838	lv1_wake, lf1_wake, cpn1_wake, tv1_wake, gz1_wake, &
	839	h1_wake, bid, th1_wake)
	840
	841	END IF
	842
	843	IF (iflag_con==4) THEN
	844	PRINT *, 'Emanuel version 4 '
[5117]	845	IF (prt_level >= 9) &
[3927]	846	PRINT *, 'cva_driver -> cv_prelim'
	847	CALL cv_prelim(len, nd, ndp1, t1, q1, p1, ph1, &
	848	lv1, cpn1, tv1, gz1, h1, hm1)
	849	END IF
	850
	851	! --------------------------------------------------------------------
	852	! --- CONVECTIVE FEED
	853	! --------------------------------------------------------------------
	854
	855	! compute feeding layer potential temperature and mixing ratio :
	856
	857	! get bounds of feeding layer
	858
	859	! test niveaux couche alimentation KE
	860	IF (sig1feed1==sig2feed1) THEN
	861	WRITE (lunout, *) 'impossible de choisir sig1feed=sig2feed'
	862	WRITE (lunout, *) 'changer la valeur de sig2feed dans physiq.def'
	863	abort_message = ''
	864	CALL abort_physic(modname, abort_message, 1)
	865	END IF
	866
	867	DO i = 1, len
	868	p1feed1(i) = sig1feed1*ph1(i, 1)
	869	p2feed1(i) = sig2feed1*ph1(i, 1)
	870	!test maf
	871	! p1feed1(i)=ph1(i,1)
	872	! p2feed1(i)=ph1(i,2)
	873	! p2feed1(i)=ph1(i,3)
	874	!testCR: on prend la couche alim des thermiques
	875	! p2feed1(i)=ph1(i,lalim_conv1(i)+1)
[5103]	876	! PRINT*,'lentr=',lentr(i),ph1(i,lentr(i)+1),ph1(i,2)
[3927]	877	END DO
	878
	879	IF (iflag_con==3) THEN
	880	END IF
	881	DO i = 1, len
[5103]	882	! PRINT*,'avant cv3_feed Plim',p1feed1(i),p2feed1(i)
[3927]	883	END DO
	884	IF (iflag_con==3) THEN
	885
[5103]	886	! PRINT*, 'IFLAG1 avant cv3_feed'
	887	! PRINT*,'len,nd',len,nd
[5116]	888	! WRITE(*,'(64i1)') iflag1(2:len-1)
[3927]	889
[5117]	890	IF (prt_level >= 9) &
[3927]	891	PRINT *, 'cva_driver -> cv3_feed'
	892	CALL cv3_feed(len, nd, ok_conserv_q, & ! nd->na
	893	t1, q1, u1, v1, p1, ph1, h1, gz1, &
	894	p1feed1, p2feed1, wght1, &
	895	wghti1, tnk1, thnk1, qnk1, qsnk1, unk1, vnk1, &
	896	cpnk1, hnk1, nk1, icb1, icbmax, iflag1, gznk1, plcl1 &
	897	#ifdef ISO
[5087]	898	,xt1,xtnk1 &
[3927]	899	#endif
[5087]	900	)
[3927]	901	END IF
	902
[5103]	903	! PRINT*, 'IFLAG1 apres cv3_feed'
	904	! PRINT*,'len,nd',len,nd
[5116]	905	! WRITE(*,'(64i1)') iflag1(2:len-1)
[3927]	906
	907	IF (iflag_con==4) THEN
[5117]	908	IF (prt_level >= 9) &
[3927]	909	PRINT *, 'cva_driver -> cv_feed'
	910	CALL cv_feed(len, nd, t1, q1, qs1, p1, hm1, gz1, &
	911	nk1, icb1, icbmax, iflag1, tnk1, qnk1, gznk1, plcl1)
	912	END IF
	913
[5160]	914	! PRINT *, 'cv3_feed-> iflag1, plcl1 ',iflag1(1),plcl1(1)
[3927]	915
	916	! --------------------------------------------------------------------
	917	! --- UNDILUTE (ADIABATIC) UPDRAFT / 1st part
	918	! (up through ICB for convect4, up through ICB+1 for convect3)
	919	! Calculates the lifted parcel virtual temperature at nk, the
	920	! actual temperature, and the adiabatic liquid water content.
	921	! --------------------------------------------------------------------
	922
	923	IF (iflag_con==3) THEN
	924
[5117]	925	IF (prt_level >= 9) &
[3927]	926	PRINT *, 'cva_driver -> cv3_undilute1'
	927
	928	#ifdef ISO
	929	#ifdef ISOVERIF
[5116]	930	WRITE(,) 'cva_driver 593: avant cv3_undilute1'
[5117]	931	IF (iso_HDO.gt.0) THEN
[5158]	932	DO k=1,nd
	933	DO i=1,len
[5117]	934	IF (q1(i,k).gt.ridicule) THEN
[5103]	935	CALL iso_verif_aberrant(xt1(iso_hdo,i,k)/q1(i,k), &
[5087]	936	'cva_driver 502')
[5116]	937	endif ! if (q1(i,k).gt.ridicule) THEN
[3927]	938	enddo !do i=1,len
	939	enddo !do k=1,nd
[5116]	940	endif !if (iso_HDO.gt.0) THEN
[5117]	941	IF (iso_eau.gt.0) THEN
[5158]	942	DO i=1,len
	943	DO k=1,nd
[5103]	944	CALL iso_verif_egalite(xt1(iso_eau,i,k),q1(i,k), &
[5087]	945	'cva_driver 764')
[5103]	946	CALL iso_verif_egalite(xt1_wake(iso_eau,i,k),q1_wake(i,k), &
[5087]	947	'cva_driver 766')
[3927]	948	enddo !do k=1,nd
[5103]	949	CALL iso_verif_egalite(xtnk1(iso_eau,i),qnk1(i), &
[5087]	950	'cva_driver 777')
[5158]	951	DO ixt=1,ntraciso
[5103]	952	CALL iso_verif_noNaN(xtnk1(ixt,i),'cva_driver 784')
[3927]	953	enddo ! do ixt=1,ntraciso
	954	enddo !do i=1,len
[5116]	955	endif !if (iso_eau.gt.0) THEN
[3927]	956	#ifdef ISOTRAC
[5158]	957	DO k=1,nd
	958	DO i=1,len
[5103]	959	CALL iso_verif_traceur(xt1(1,i,k),'cva_driver 601')
[3927]	960	enddo !do i=1,len
	961	enddo !do k=1,nd
	962	#endif
	963	#endif
	964	#endif
	965
	966	CALL cv3_undilute1(len, nd, t1, qs1, gz1, plcl1, p1, icb1, tnk1, qnk1, & ! nd->na
	967	gznk1, tp1, tvp1, clw1, icbs1 &
	968	#ifdef ISO
[5087]	969	,xtnk1,xtclw1 &
[3927]	970	#endif
[5087]	971	)
[3927]	972
	973	#ifdef ISO
	974	#ifdef ISOVERIF
[5116]	975	WRITE(,) 'cva_driver 621: apres cv3_undilute1'
[5158]	976	DO k=1,nd
	977	DO i = 1, len
[5117]	978	IF (iso_eau.gt.0) THEN
[5103]	979	CALL iso_verif_egalite_choix(xtclw1(iso_eau,i,k),clw1(i,k), &
[5087]	980	'cva_driver 798',errmax,errmaxrel)
[5103]	981	CALL iso_verif_egalite_choix(xt1(iso_eau,i,k),q1(i,k), &
[5087]	982	'cva_driver 800',errmax,errmaxrel)
[5116]	983	endif !if (iso_eau.gt.0) THEN
[5158]	984	DO ixt=1,ntraciso
[5103]	985	CALL iso_verif_noNaN(xt1(ixt,i,k),'cva_driver 815')
[3927]	986	enddo ! do ixt=1,ntraciso
	987	#ifdef ISOTRAC
[5103]	988	CALL iso_verif_traceur(xt1(1,i,k),'cva_driver 623')
[3927]	989	#endif
	990	enddo !do i = 1, len
	991	enddo !do k=1,nd
[5158]	992	DO i = 1, len
	993	DO ixt=1,ntraciso
[5103]	994	CALL iso_verif_noNaN(xtnk1(ixt,i),'cva_driver 824')
[3927]	995	enddo ! do ixt=1,ntraciso
	996	enddo !do i = 1, len
	997	#endif
[5116]	998	!WRITE(,) 'SORTIE DE CV3_UNDILUTE1'
[3927]	999	#endif
	1000
	1001	END IF
	1002
	1003
	1004	IF (iflag_con==4) THEN
[5117]	1005	IF (prt_level >= 9) &
[3927]	1006	PRINT *, 'cva_driver -> cv_undilute1'
	1007	CALL cv_undilute1(len, nd, t1, q1, qs1, gz1, p1, nk1, icb1, icbmax, &
	1008	tp1, tvp1, clw1)
	1009	END IF
	1010
	1011	! -------------------------------------------------------------------
	1012	! --- TRIGGERING
	1013	! -------------------------------------------------------------------
	1014
[5160]	1015	! PRINT *,' avant triggering, iflag_con ',iflag_con
[3927]	1016
	1017	IF (iflag_con==3) THEN
	1018
[5117]	1019	IF (prt_level >= 9) &
[3927]	1020	PRINT *, 'cva_driver -> cv3_trigger'
	1021	CALL cv3_trigger(len, nd, icb1, plcl1, p1, th1, tv1, tvp1, thnk1, & ! nd->na
	1022	pbase1, buoybase1, iflag1, sig1, w01)
	1023
	1024
[5103]	1025	! PRINT*, 'IFLAG1 apres cv3_triger'
	1026	! PRINT*,'len,nd',len,nd
[5116]	1027	! WRITE(*,'(64i1)') iflag1(2:len-1)
[3927]	1028
[5103]	1029	! CALL dump2d(iim,jjm-1,sig1(2)
[3927]	1030	END IF
	1031
	1032	IF (iflag_con==4) THEN
[5117]	1033	IF (prt_level >= 9) &
[3927]	1034	PRINT *, 'cva_driver -> cv_trigger'
	1035	CALL cv_trigger(len, nd, icb1, cbmf1, tv1, tvp1, iflag1)
	1036	END IF
	1037
	1038
	1039	! =====================================================================
	1040	! --- IF THIS POINT IS REACHED, MOIST CONVECTIVE ADJUSTMENT IS NECESSARY
	1041	! =====================================================================
	1042
	1043	! Determine the number "ncum" of convective gridpoints, the list "idcum" of convective
	1044	! gridpoints and the weights "coef_convective" (= 1. for convective gridpoints and = 0.
	1045	! elsewhere).
	1046	ncum = 0
	1047	coef_convective(:) = 0.
	1048	DO i = 1, len
	1049	IF (iflag1(i)==0) THEN
	1050	coef_convective(i) = 1.
	1051	ncum = ncum + 1
	1052	idcum(ncum) = i
	1053	END IF
	1054	END DO
	1055
[5103]	1056	! PRINT*,'len, ncum = ',len,ncum
[3927]	1057
	1058	IF (ncum>0) THEN
	1059
	1060	! ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
	1061	! --- COMPRESS THE FIELDS
	1062	! (-> vectorization over convective gridpoints)
	1063	! ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
	1064
	1065	IF (iflag_con==3) THEN
[5103]	1066	! PRINT*,'ncum tv1 ',ncum,tv1
	1067	! PRINT*,'tvp1 ',tvp1
[3927]	1068	!jyg<
	1069	! If the fraction of convective points is larger than comp_threshold, then compression
	1070	! is assumed useless.
[5099]	1071
[5082]	1072	compress = ncum < len*comp_threshold
[5099]	1073
[5117]	1074	IF (.NOT. compress) THEN
[3927]	1075	DO i = 1,len
	1076	idcum(i) = i
	1077	ENDDO
	1078	ENDIF
[5099]	1079
[3927]	1080	#ifdef ISO
	1081	#ifdef ISOVERIF
[5158]	1082	DO k=1,nd
	1083	DO i = 1, nloc
[5117]	1084	IF (iso_eau.gt.0) THEN
[5103]	1085	CALL iso_verif_egalite_choix(xtclw1(iso_eau,i,k),clw1(i,k), &
[5087]	1086	'cva_driver 541a',errmax,errmaxrel)
[5103]	1087	CALL iso_verif_egalite_choix(xt1(iso_eau,i,k),q1(i,k), &
[5087]	1088	'cva_driver 541b',errmax,errmaxrel)
[5116]	1089	endif ! if (iso_eau.gt.0) THEN
[3927]	1090	#ifdef ISOTRAC
[5103]	1091	CALL iso_verif_traceur(xt1(1,i,k),'cva_driver 689')
[3927]	1092	#endif
	1093	enddo
	1094	enddo
	1095	#endif
	1096	#endif
	1097
	1098	!>jyg
[5117]	1099	IF (prt_level >= 9) &
[3927]	1100	PRINT *, 'cva_driver -> cv3a_compress'
	1101	CALL cv3a_compress(len, nloc, ncum, nd, ntra, compress, &
	1102	iflag1, nk1, icb1, icbs1, &
	1103	plcl1, tnk1, qnk1, gznk1, hnk1, unk1, vnk1, &
	1104	wghti1, pbase1, buoybase1, &
	1105	t1, q1, qs1, t1_wake, q1_wake, qs1_wake, s1_wake, &
	1106	u1, v1, gz1, th1, th1_wake, &
	1107	tra1, &
	1108	h1, lv1, lf1, cpn1, p1, ph1, tv1, tp1, tvp1, clw1, &
	1109	h1_wake, lv1_wake, lf1_wake, cpn1_wake, tv1_wake, &
	1110	sig1, w01, ptop21, &
	1111	Ale1, Alp1, omega1, &
	1112	iflag, nk, icb, icbs, &
	1113	plcl, tnk, qnk, gznk, hnk, unk, vnk, &
	1114	wghti, pbase, buoybase, &
	1115	t, q, qs, t_wake, q_wake, qs_wake, s_wake, &
	1116	u, v, gz, th, th_wake, &
	1117	tra, &
	1118	h, lv, lf, cpn, p, ph, tv, tp, tvp, clw, &
	1119	h_wake, lv_wake, lf_wake, cpn_wake, tv_wake, &
	1120	sig, w0, ptop2, &
	1121	Ale, Alp, omega &
	1122	#ifdef ISO
[5087]	1123	,xtnk1,xt1,xt1_wake,xtclw1 &
	1124	,xtnk,xt,xt_wake,xtclw &
[3927]	1125	#endif
[5087]	1126	)
[3927]	1127
[5103]	1128	! PRINT*,'tv ',tv
	1129	! PRINT*,'tvp ',tvp
[3927]	1130
	1131	#ifdef ISO
	1132	#ifdef ISOVERIF
[5116]	1133	WRITE(,) 'cva_driver 720: apres cv3_compress'
	1134	! WRITE(,) 'len, nloc, ncum,nd=',len, nloc, ncum,nd
[5158]	1135	DO k=1,nd
	1136	DO i = 1, ncum
[5117]	1137	IF (iso_eau.gt.0) THEN
[5103]	1138	CALL iso_verif_egalite_choix(xtclw(iso_eau,i,k),clw(i,k), &
[5087]	1139	'cva_driver 598',errmax,errmaxrel)
[5103]	1140	CALL iso_verif_egalite_choix(xt(iso_eau,i,k),q(i,k), &
[5087]	1141	'cva_driver 600',errmax,errmaxrel)
[5103]	1142	CALL iso_verif_egalite_choix(xt_wake(iso_eau,i,k),q_wake(i,k), &
[5087]	1143	'cva_driver 602',errmax,errmaxrel)
[5116]	1144	endif ! if (iso_eau.gt.0) THEN
[5117]	1145	IF (iso_HDO.gt.0) THEN
[5103]	1146	CALL iso_verif_aberrant_choix( &
[5087]	1147	xt(iso_HDO,i,k),q(i,k), &
	1148	ridicule,deltalim,'cva_driver 735, apres compress')
[5116]	1149	endif !if (iso_HDO.gt.0) THEN
[3927]	1150	#ifdef ISOTRAC
[5103]	1151	CALL iso_verif_traceur(xt(1,i,k),'cva_driver 726')
[3927]	1152	#endif
	1153	enddo
	1154	enddo
[5158]	1155	DO i = 1, ncum
	1156	DO k=1,nd
[5103]	1157	CALL iso_verif_positif(q(i,k),'cva_driver 966a')
[3927]	1158	enddo !do k=1,nd
[5103]	1159	CALL iso_verif_positif(qnk(i),'cva_driver 966b')
[3927]	1160	enddo !do i = 1, ncum
[5116]	1161	! WRITE(,) 'cva_driver 1142: apres cv3_compress OK'
[3927]	1162	#endif
	1163	#endif
	1164
	1165	END IF
	1166
	1167	IF (iflag_con==4) THEN
[5117]	1168	IF (prt_level >= 9) &
[3927]	1169	PRINT *, 'cva_driver -> cv_compress'
	1170	CALL cv_compress(len, nloc, ncum, nd, &
	1171	iflag1, nk1, icb1, &
	1172	cbmf1, plcl1, tnk1, qnk1, gznk1, &
	1173	t1, q1, qs1, u1, v1, gz1, &
	1174	h1, lv1, cpn1, p1, ph1, tv1, tp1, tvp1, clw1, &
	1175	iflag, nk, icb, &
	1176	cbmf, plcl, tnk, qnk, gznk, &
	1177	t, q, qs, u, v, gz, h, lv, cpn, p, ph, tv, tp, tvp, clw, &
	1178	dph)
	1179	END IF
	1180
	1181	! -------------------------------------------------------------------
	1182	! --- UNDILUTE (ADIABATIC) UPDRAFT / second part :
	1183	! --- FIND THE REST OF THE LIFTED PARCEL TEMPERATURES
	1184	! --- &
	1185	! --- COMPUTE THE PRECIPITATION EFFICIENCIES AND THE
	1186	! --- FRACTION OF PRECIPITATION FALLING OUTSIDE OF CLOUD
	1187	! --- &
	1188	! --- FIND THE LEVEL OF NEUTRAL BUOYANCY
	1189	! -------------------------------------------------------------------
	1190
	1191	IF (iflag_con==3) THEN
[5117]	1192	IF (prt_level >= 9) &
[3927]	1193	PRINT *, 'cva_driver -> cv3_undilute2'
	1194	CALL cv3_undilute2(nloc, ncum, nd, iflag, icb, icbs, nk, & !na->nd
	1195	tnk, qnk, gznk, hnk, t, q, qs, gz, &
	1196	p, ph, h, tv, lv, lf, pbase, buoybase, plcl, &
	1197	inb, tp, tvp, clw, hp, ep, sigp, buoy, &
	1198	frac_a, frac_s, qpreca, qta & !!jygprl
	1199	#ifdef ISO
[5087]	1200	,xtnk,xt,xtclw,xtta &
[3927]	1201	#endif
[5087]	1202	)
[3927]	1203	#ifdef ISO
	1204	#ifdef ISOVERIF
[5158]	1205	DO k=1,nd
	1206	DO i = 1, ncum
[5117]	1207	IF (iso_eau.gt.0) THEN
[5103]	1208	CALL iso_verif_egalite_choix(xtclw(iso_eau,i,k),clw(i,k), &
[5087]	1209	'cva_driver 650',errmax,errmaxrel)
[5103]	1210	CALL iso_verif_egalite_choix(xtta(iso_eau,i,k),qta(i,k), &
[5087]	1211	'cva_driver 651',errmax,errmaxrel)
[5103]	1212	CALL iso_verif_egalite_choix(xt(iso_eau,i,k),q(i,k), &
[5087]	1213	'cva_driver 652',errmax,errmaxrel)
[5116]	1214	endif ! if (iso_eau.gt.0) THEN
[5117]	1215	IF (iso_HDO.gt.0) THEN
[5103]	1216	CALL iso_verif_aberrant_choix( &
[5087]	1217	xt(iso_HDO,i,k),q(i,k), &
	1218	ridicule,deltalim,'cva_driver 794, apres undilute2')
[5116]	1219	endif !if (iso_HDO.gt.0) THEN
[3927]	1220	#ifdef ISOTRAC
[5103]	1221	CALL iso_verif_traceur(xt(1,i,k),'cva_driver 780')
	1222	CALL iso_verif_traceur(xtclw(1,i,k),'cva_driver 781')
[3927]	1223	#endif
	1224	enddo
	1225	enddo !do k=1,nd
	1226	#ifdef VERIFNEGATIF
[5158]	1227	DO i = 1, ncum
	1228	DO k=1,nd
[5103]	1229	CALL iso_verif_positif(q(i,k),'cva_driver 1052')
[3927]	1230	enddo !do k=1,nd
[5103]	1231	CALL iso_verif_positif(qnk(i),'cva_driver 1054')
[3927]	1232	enddo !do i = 1, ncum
	1233	#endif
	1234	#endif
[5116]	1235	!WRITE(,) 'SORTIE CV3_UNDILUTE2'
[3927]	1236	#endif
	1237
	1238	END IF
	1239
	1240	IF (iflag_con==4) THEN
[5117]	1241	IF (prt_level >= 9) &
[3927]	1242	PRINT *, 'cva_driver -> cv_undilute2'
	1243	CALL cv_undilute2(nloc, ncum, nd, icb, nk, &
	1244	tnk, qnk, gznk, t, q, qs, gz, &
	1245	p, dph, h, tv, lv, &
	1246	inb, inbis, tp, tvp, clw, hp, ep, sigp, frac_s)
	1247	END IF
	1248
	1249	! epmax_cape
	1250	! on recalcule ep et hp
[5117]	1251	IF (prt_level >= 9) &
[3927]	1252	PRINT *, 'cva_driver -> cv3_epmax_cape'
[5103]	1253	CALL cv3_epmax_fn_cape(nloc,ncum,nd &
[3927]	1254	, ep,hp,icb,inb,clw,nk,t,h,hnk,lv,lf,frac_s &
	1255	, pbase, p, ph, tv, buoy, sig, w0,iflag &
	1256	, epmax_diag)
	1257
	1258	! -------------------------------------------------------------------
	1259	! --- MIXING(1) (if iflag_mix .ge. 1)
	1260	! -------------------------------------------------------------------
	1261	IF (iflag_con==3) THEN
	1262	! IF ((iflag_ice_thermo==1) .AND. (iflag_mix/=0)) THEN
	1263	! WRITE (, ) ' iflag_ice_thermo==1 requires iflag_mix==0', ' but iflag_mix=', iflag_mix, &
	1264	! '. Might as well stop here.'
	1265	! STOP
	1266	! END IF
	1267	IF (iflag_mix>=1) THEN
	1268	CALL zilch(supmax, nloc*nd)
[5117]	1269	IF (prt_level >= 9) &
[3927]	1270	PRINT *, 'cva_driver -> cv3p_mixing'
	1271	CALL cv3p_mixing(nloc, ncum, nd, nd, ntra, icb, nk, inb, & ! na->nd
	1272	!! ph, t, q, qs, u, v, tra, h, lv, lf, frac, qnk, &
	1273	ph, t, q, qs, u, v, tra, h, lv, lf, frac_s, qta, & !!jygprl
	1274	unk, vnk, hp, tv, tvp, ep, clw, sig, &
	1275	ment, qent, hent, uent, vent, nent, &
	1276	sigij, elij, supmax, ments, qents, traent &
	1277	#ifdef ISO
[5087]	1278	,xt,xtta,xtclw,xtent,xtelij &
[3927]	1279	#endif
[5087]	1280	)
[5103]	1281	! PRINT*, 'cv3p_mixing-> supmax ', (supmax(1,k), k=1,nd)
[3927]	1282
	1283	ELSE
	1284	CALL zilch(supmax, nloc*nd)
	1285	END IF
	1286	END IF
	1287	! -------------------------------------------------------------------
	1288	! --- CLOSURE
	1289	! -------------------------------------------------------------------
	1290
	1291
	1292	IF (iflag_con==3) THEN
	1293	IF (iflag_clos==0) THEN
[5117]	1294	IF (prt_level >= 9) &
[3927]	1295	PRINT *, 'cva_driver -> cv3_closure'
	1296	CALL cv3_closure(nloc, ncum, nd, icb, inb, & ! na->nd
	1297	pbase, p, ph, tv, buoy, &
	1298	sig, w0, cape, m, iflag)
	1299	END IF ! iflag_clos==0
	1300
	1301	ok_inhib = iflag_mix == 2
	1302
	1303	IF (iflag_clos==1) THEN
	1304	PRINT *, ' pas d appel cv3p_closure'
	1305	! c CALL cv3p_closure(nloc,ncum,nd,icb,inb ! na->nd
	1306	! c : ,pbase,plcl,p,ph,tv,tvp,buoy
	1307	! c : ,supmax
	1308	! c o ,sig,w0,ptop2,cape,cin,m)
	1309	END IF ! iflag_clos==1
	1310
	1311	IF (iflag_clos==2) THEN
[5117]	1312	IF (prt_level >= 9) &
[3927]	1313	PRINT *, 'cva_driver -> cv3p1_closure'
	1314	CALL cv3p1_closure(nloc, ncum, nd, icb, inb, & ! na->nd
	1315	pbase, plcl, p, ph, tv, tvp, buoy, &
	1316	supmax, ok_inhib, Ale, Alp, omega, &
	1317	sig, w0, ptop2, cape, cin, m, iflag, coef_clos, &
	1318	Plim1, plim2, asupmax, supmax0, &
	1319	asupmaxmin, cbmf, plfc, wbeff)
[5117]	1320	IF (prt_level >= 10) &
[3927]	1321	PRINT *, 'cv3p1_closure-> plfc,wbeff ', plfc(1), wbeff(1)
	1322	END IF ! iflag_clos==2
	1323
	1324	IF (iflag_clos==3) THEN
[5117]	1325	IF (prt_level >= 9) &
[3927]	1326	PRINT *, 'cva_driver -> cv3p2_closure'
	1327	CALL cv3p2_closure(nloc, ncum, nd, icb, inb, & ! na->nd
	1328	pbase, plcl, p, ph, tv, tvp, buoy, &
	1329	supmax, ok_inhib, Ale, Alp, omega, &
	1330	sig, w0, ptop2, cape, cin, m, iflag, coef_clos, &
	1331	Plim1, plim2, asupmax, supmax0, &
	1332	asupmaxmin, cbmf, plfc, wbeff)
[5117]	1333	IF (prt_level >= 10) &
[3927]	1334	PRINT *, 'cv3p2_closure-> plfc,wbeff ', plfc(1), wbeff(1)
	1335	END IF ! iflag_clos==3
	1336	END IF ! iflag_con==3
	1337
	1338	IF (iflag_con==4) THEN
[5117]	1339	IF (prt_level >= 9) &
[3927]	1340	PRINT *, 'cva_driver -> cv_closure'
	1341	CALL cv_closure(nloc, ncum, nd, nk, icb, &
	1342	tv, tvp, p, ph, dph, plcl, cpn, &
	1343	iflag, cbmf)
	1344	END IF
	1345
[5160]	1346	! PRINT *,'cv_closure-> cape ',cape(1)
[3927]	1347
	1348	! -------------------------------------------------------------------
	1349	! --- MIXING(2)
	1350	! -------------------------------------------------------------------
	1351
	1352	IF (iflag_con==3) THEN
	1353	IF (iflag_mix==0) THEN
[5117]	1354	IF (prt_level >= 9) &
[3927]	1355	PRINT *, 'cva_driver -> cv3_mixing'
	1356	CALL cv3_mixing(nloc, ncum, nd, nd, ntra, icb, nk, inb, & ! na->nd
	1357	ph, t, q, qs, u, v, tra, h, lv, lf, frac_s, qnk, &
	1358	unk, vnk, hp, tv, tvp, ep, clw, m, sig, &
	1359	ment, qent, uent, vent, nent, sigij, elij, ments, qents, traent &
	1360	#ifdef ISO
[5087]	1361	,xt,xtnk,xtclw &
	1362	,xtent,xtelij &
[3927]	1363	#endif
[5087]	1364	)
[3927]	1365	CALL zilch(hent, nlocndnd)
	1366
	1367	#ifdef ISO
	1368	#ifdef ISOVERIF
[5116]	1369	WRITE(,) 'cva_driver 837: apres cv3_mixing'
	1370	! WRITE(,) 'qent,xtent(1,1,1)=',qent(1,1,1),xtent(iso_eau,1,1,1)
[5158]	1371	DO k=1,nd
	1372	DO j = 1, nd
	1373	DO i = 1, ncum
[5117]	1374	IF (iso_eau.gt.0) THEN
[5103]	1375	CALL iso_verif_egalite_choix(xtelij(iso_eau,i,j,k), &
[5087]	1376	elij(i,j,k),'cva_driver 881',errmax,errmaxrel)
[5103]	1377	CALL iso_verif_egalite_choix(xtent(iso_eau,i,j,k), &
[5087]	1378	qent(i,j,k),'cva_driver 882',errmax,errmaxrel)
[5116]	1379	endif ! if (iso_eau.gt.0) THEN
[3927]	1380	#ifdef ISOTRAC
[5103]	1381	CALL iso_verif_traceur_justmass(xtent(1,i,j,k), &
[5087]	1382	'cva_driver 846')
[5103]	1383	CALL iso_verif_traceur_justmass(xtelij(1,i,j,k), &
[5087]	1384	'cva_driver 847')
[3927]	1385	! on ne vérfier pas le deltaD ici car peut dépasser le seuil
	1386	! raisonable pour températures très froides.
	1387	#endif
	1388	enddo !do i = 1, ncum
	1389	enddo !do j = 1, nd
	1390	enddo !do k=1,nd
[5158]	1391	DO k=1,nd
	1392	DO i = 1, ncum
[5117]	1393	IF (iso_eau.gt.0) THEN
[5103]	1394	CALL iso_verif_egalite_choix(xt(iso_eau,i,k),q(i,k), &
[5087]	1395	'cva_driver 709',errmax,errmaxrel)
[5116]	1396	endif ! if (iso_eau.gt.0) THEN
[3927]	1397	#ifdef ISOTRAC
[5103]	1398	CALL iso_verif_traceur(xt(1,i,k),'cva_driver 856')
[5117]	1399	IF (option_tmin.EQ.1) THEN
	1400	IF (iso_verif_positif_nostop(xtclw(itZonIso( &
[5087]	1401	izone_cond,iso_eau),i,k)-xtclw(iso_eau,i,k) &
[5117]	1402	,'cva_driver 909').EQ.1) THEN
[5116]	1403	WRITE(,) 'i,k=',i,k
	1404	WRITE(,) 'xtclw=',xtclw(:,i,k)
[3927]	1405	stop
[4143]	1406	endif !if (iso_verif_positif_nostop(xtclw(itZonIso(
[5117]	1407	endif !if ((option_traceurs.EQ.17).OR.
[3927]	1408	#endif
	1409	enddo
	1410	enddo !do k=1,nd
	1411	#endif
	1412	#endif
	1413
	1414	ELSE
	1415	!!jyg: Essais absurde pour voir
	1416	!! mm(:,1) = 0.
	1417	!! DO i = 2,nd
	1418	!! mm(:,i) = m(:,i)*(1.-qta(:,i-1))
	1419	!! ENDDO
	1420	mm(:,:) = m(:,:)
	1421	CALL cv3_mixscale(nloc, ncum, nd, ment, mm)
	1422	IF (debut) THEN
	1423	PRINT *, ' cv3_mixscale-> '
	1424	END IF !(debut) THEN
	1425	END IF
	1426	END IF
	1427
	1428	IF (iflag_con==4) THEN
[5117]	1429	IF (prt_level >= 9) &
[3927]	1430	PRINT *, 'cva_driver -> cv_mixing'
	1431	CALL cv_mixing(nloc, ncum, nd, icb, nk, inb, inbis, &
	1432	ph, t, q, qs, u, v, h, lv, qnk, &
	1433	hp, tv, tvp, ep, clw, cbmf, &
	1434	m, ment, qent, uent, vent, nent, sigij, elij)
	1435	END IF
	1436
	1437	IF (debut) THEN
	1438	PRINT *, ' cv_mixing ->'
	1439	END IF !(debut) THEN
	1440	! do i = 1,nd
[5103]	1441	! PRINT*,'cv_mixing-> i,ment ',i,(ment(1,i,j),j=1,nd)
[3927]	1442	! enddo
	1443
	1444	! -------------------------------------------------------------------
	1445	! --- UNSATURATED (PRECIPITATING) DOWNDRAFTS
	1446	! -------------------------------------------------------------------
	1447	IF (iflag_con==3) THEN
	1448	IF (debut) THEN
	1449	PRINT *, ' cva_driver -> cv3_unsat '
	1450	END IF !(debut) THEN
	1451	#ifdef ISO
	1452	#ifdef ISOVERIF
[5158]	1453	DO k=1,nd
	1454	DO i = 1, ncum
[5117]	1455	IF (iso_eau.gt.0) THEN
[5103]	1456	CALL iso_verif_egalite_choix(xt(iso_eau,i,k),q(i,k), &
[5087]	1457	'cva_driver 753a',errmax,errmaxrel)
[5103]	1458	CALL iso_verif_egalite_choix(xt_wake(iso_eau,i,k),q_wake(i,k), &
[5087]	1459	'cva_driver 753b',errmax,errmaxrel)
[5116]	1460	endif ! if (iso_eau.gt.0) THEN
[3927]	1461	#ifdef ISOTRAC
[5103]	1462	CALL iso_verif_traceur(xt(1,i,k),'cva_driver 885')
[3927]	1463	#endif
	1464	enddo
	1465	enddo !do k=1,nd
	1466	#endif
	1467	#endif
	1468
[5117]	1469	IF (prt_level >= 9) &
[3927]	1470	PRINT *, 'cva_driver -> cv3_unsat'
	1471	CALL cv3_unsat(nloc, ncum, nd, nd, ntra, icb, inb, iflag, & ! na->nd
	1472	t_wake, q_wake, qs_wake, gz, u, v, tra, p, ph, &
	1473	th_wake, tv_wake, lv_wake, lf_wake, cpn_wake, &
	1474	ep, sigp, clw, frac_s, qpreca, frac_a, qta, & !!jygprl
	1475	m, ment, elij, delt, plcl, coef_clos, &
	1476	mp, qp, up, vp, trap, wt, water, evap, fondue, ice, &
	1477	faci, b, sigd, &
	1478	!! wdtrainA, wdtrainM) ! RomP
	1479	wdtrainA, wdtrainS, wdtrainM & !!jygprl
	1480	#ifdef ISO
[5087]	1481	,xt_wake,xtclw,xtelij &
	1482	,xtp,xtwater,xtevap,xtice,xtwdtrainA &
[3927]	1483	#endif
[5087]	1484	)
[5099]	1485
[3927]	1486	IF (prt_level >= 10) THEN
	1487	Print *, 'cva_driver after cv3_unsat:mp , water, ice, evap, fondue '
	1488	DO k = 1,nd
[5136]	1489	write (6, '(i4,5(1x,e13.6))') &
[3927]	1490	k, mp(igout,k), water(igout,k), ice(igout,k), &
	1491	evap(igout,k), fondue(igout,k)
	1492	ENDDO
	1493	Print *, 'cva_driver after cv3_unsat: wdtrainA, wdtrainS, wdtrainM ' !!jygprl
	1494	DO k = 1,nd
[5136]	1495	write (6, '(i4,3(1x,e13.6))') &
[3927]	1496	k, wdtrainA(igout,k), wdtrainS(igout,k), wdtrainM(igout,k) !!jygprl
	1497	ENDDO
	1498	ENDIF
[5099]	1499
[3927]	1500	END IF !(iflag_con==3)
	1501
	1502	IF (iflag_con==4) THEN
[5117]	1503	IF (prt_level >= 9) &
[3927]	1504	PRINT *, 'cva_driver -> cv_unsat'
	1505	CALL cv_unsat(nloc, ncum, nd, inb, t, q, qs, gz, u, v, p, ph, &
	1506	h, lv, ep, sigp, clw, m, ment, elij, &
	1507	iflag, mp, qp, up, vp, wt, water, evap)
	1508	END IF
	1509
	1510	IF (debut) THEN
	1511	PRINT *, 'cv_unsat-> '
	1512	END IF !(debut) THEN
	1513
	1514	#ifdef ISO
	1515	#ifdef ISOTRAC
[5117]	1516	IF (option_traceurs.EQ.6) THEN
[3927]	1517	! on colorie les ddfts en rouge, le reste est en blanc.
[5158]	1518	DO k=1,nd
	1519	DO i = 1, ncum
	1520	DO iiso=1,niso
[4143]	1521	ixt_ddft=itZonIso(izone_ddft,iiso)
	1522	ixt_poubelle=itZonIso(izone_poubelle,iiso)
[3927]	1523	xtp(ixt_ddft,i,k)=xtp(ixt_ddft,i,k) &
[5087]	1524	+xtp(ixt_poubelle,i,k)
[3927]	1525	xtp(ixt_poubelle,i,k)=0.0
	1526	enddo !do iiso=1,niso
	1527	#ifdef ISOVERIF
[5103]	1528	CALL iso_verif_traceur(xtp(1,i,k),'cva_driver 990')
[3927]	1529	#endif
	1530	enddo !do i = 1, ncum
	1531	enddo !do k=1,nd
[5117]	1532	ELSE IF (option_traceurs.EQ.19) THEN
[3927]	1533	! on colorie les ddfts, mais on sauve la revap
[5158]	1534	DO k=1,nd
	1535	DO i = 1, ncum
	1536	DO izone=1,nzone
[5117]	1537	IF (izone.EQ.izone_ddft) THEN
[5158]	1538	DO iiso=1,niso
[4143]	1539	ixt_ddft=itZonIso(izone,iiso)
	1540	ixt_revap=itZonIso(izone_revap,iiso)
[3927]	1541	xtp(ixt_ddft,i,k)=xtp(iiso,i,k)-xtp(ixt_revap,i,k)
	1542	enddo !do iiso=1,niso
[5117]	1543	elseif (izone.EQ.izone_ddft) THEN
[3927]	1544	! rien à faire
[5117]	1545	else !if (izone.EQ.izone_ddft) THEN
[5158]	1546	DO iiso=1,niso
[4143]	1547	ixt=itZonIso(izone,iiso)
[3927]	1548	xtp(ixt,i,k)=0.0
	1549	enddo !do iiso=1,niso
[5117]	1550	endif !if (izone.EQ.izone_ddft) THEN
[4143]	1551	enddo !do izone=1,nzone
[3927]	1552	#ifdef ISOVERIF
[5103]	1553	CALL iso_verif_traceur(xtp(1,i,k),'cva_driver 1059')
[3927]	1554	#endif
	1555	enddo !do i = 1, ncum
	1556	enddo !do k=1,nd
[5117]	1557	endif !if (option_traceurs.EQ.6) THEN
[3927]	1558	#endif
	1559	#endif
	1560
[5160]	1561	! PRINT *,'cv_unsat-> mp ',mp
	1562	! PRINT *,'cv_unsat-> water ',water
[3927]	1563	! -------------------------------------------------------------------
	1564	! --- YIELD
	1565	! (tendencies, precipitation, variables of interface with other
	1566	! processes, etc)
	1567	! -------------------------------------------------------------------
	1568
	1569	IF (iflag_con==3) THEN
	1570
[5117]	1571	IF (prt_level >= 9) &
[3927]	1572	PRINT *, 'cva_driver -> cv3_yield'
[4613]	1573
[3927]	1574	CALL cv3_yield(nloc, ncum, nd, nd, ntra, ok_conserv_q, & ! na->nd
	1575	icb, inb, delt, &
	1576	t, q, t_wake, q_wake, s_wake, u, v, tra, &
	1577	gz, p, ph, h, hp, lv, lf, cpn, th, th_wake, &
	1578	ep, clw, qpreca, m, tp, mp, qp, up, vp, trap, &
	1579	wt, water, ice, evap, fondue, faci, b, sigd, &
	1580	ment, qent, hent, iflag_mix, uent, vent, &
	1581	nent, elij, traent, sig, &
	1582	tv, tvp, wghti, &
[4613]	1583	iflag, precip, Vprecip, Vprecipi, ft, fq, fqcomp, fu, fv, ftra, & ! jyg
[3927]	1584	cbmf, upwd, dnwd, dnwd0, ma, mip, &
	1585	!! tls, tps, & ! useless . jyg
	1586	qcondc, wd, &
	1587	!! ftd, fqd, qnk, qtc, sigt, tau_cld_cv, coefw_cld_cv)
[4613]	1588	ftd, fqd, qta, qtc, sigt,detrain,tau_cld_cv, coefw_cld_cv & !!jygprl
[3927]	1589	#ifdef ISO
[5087]	1590	,xt,xt_wake,xtclw,xtp,xtwater,xtice,xtevap &
	1591	,xtent,xtelij,xtprecip,fxt,fxtd,xtVprecip,xtVprecipi &
[3927]	1592	#ifdef DIAGISO
[5087]	1593	,fq_detrainement,fq_ddft,fq_fluxmasse,fq_evapprecip &
	1594	,fxt_detrainement,fxt_ddft,fxt_fluxmasse,fxt_evapprecip &
	1595	,f_detrainement,q_detrainement,xt_detrainement &
[3927]	1596	#endif
	1597	#endif
[5087]	1598	)
[5099]	1599
[3927]	1600	! Test conseravtion de l'eau
	1601
	1602	#ifdef ISOVERIF
	1603	DO k = 1, nd
	1604	DO i = 1, ncum
[5117]	1605	IF (iso_HDO.gt.0) THEN
	1606	IF (q(i,k)+delt*fq(i,k).gt.ridicule) THEN
[5103]	1607	CALL iso_verif_aberrant( &
[5087]	1608	(xt(iso_HDO,i,k)+delt*fxt(iso_HDO,i,k)) &
	1609	/(q(i,k)+delt*fq(i,k)),'cva_driver 855a')
[5117]	1610	IF (iso_O18.gt.0) THEN
[5103]	1611	CALL iso_verif_O18_aberrant( &
[5087]	1612	(xt(iso_HDO,i,k)+delt*fxt(iso_HDO,i,k)) &
	1613	/(q(i,k)+delt*fq(i,k)), &
	1614	(xt(iso_O18,i,k)+delt*fxt(iso_O18,i,k)) &
	1615	/(q(i,k)+delt*fq(i,k)),'cva_driver 855b')
[4033]	1616	endif
[3927]	1617	endif
	1618	endif
[5117]	1619	IF (iso_eau.gt.0) THEN
[5103]	1620	CALL iso_verif_egalite_choix(fxt(iso_eau,i,k), &
[5087]	1621	fq(i,k),'cva_driver 1305',errmax,errmaxrel)
[3927]	1622	endif
	1623	#ifdef ISOTRAC
[5103]	1624	CALL iso_verif_traceur(xt(1,i,k),'cva_driver 1008')
[3927]	1625	#endif
	1626	enddo
	1627	enddo
	1628	#endif
	1629	IF (debut) THEN
	1630	PRINT *, ' cv3_yield -> fqd(1) = ', fqd(igout, 1)
	1631	END IF !(debut) THEN
[5099]	1632
[3927]	1633	IF (prt_level >= 10) THEN
	1634	Print *, 'cva_driver after cv3_yield:ft(1) , ftd(1) ', &
	1635	ft(igout,1), ftd(igout,1)
	1636	Print *, 'cva_driver after cv3_yield:fq(1) , fqd(1) ', &
	1637	fq(igout,1), fqd(igout,1)
	1638	ENDIF
[5099]	1639
[3927]	1640	END IF
	1641
	1642	IF (iflag_con==4) THEN
[5117]	1643	IF (prt_level >= 9) &
[3927]	1644	PRINT *, 'cva_driver -> cv_yield'
	1645	CALL cv_yield(nloc, ncum, nd, nk, icb, inb, delt, &
	1646	t, q, u, v, &
	1647	gz, p, ph, h, hp, lv, cpn, &
	1648	ep, clw, frac_s, m, mp, qp, up, vp, &
	1649	wt, water, evap, &
	1650	ment, qent, uent, vent, nent, elij, &
	1651	tv, tvp, &
	1652	iflag, wd, qprime, tprime, &
	1653	precip, cbmf, ft, fq, fu, fv, ma, qcondc)
	1654	END IF
	1655
	1656	!AC!
	1657	!^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
	1658	!--- passive tracers
	1659	!^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
	1660
	1661	IF (iflag_con==3) THEN
	1662	!RomP >>>
[5117]	1663	IF (prt_level >= 9) &
[3927]	1664	PRINT *, 'cva_driver -> cv3_tracer'
	1665	CALL cv3_tracer(nloc, len, ncum, nd, nd, &
	1666	ment, sigij, da, phi, phi2, d1a, dam, &
	1667	ep, vprecip, elij, clw, epmlmMm, eplaMm, &
	1668	icb, inb)
	1669	!RomP <<<
	1670	END IF
	1671
	1672	!AC!
	1673
	1674	! ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
	1675	! --- UNCOMPRESS THE FIELDS
	1676	! ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
	1677
	1678
	1679	IF (iflag_con==3) THEN
[5117]	1680	IF (prt_level >= 9) &
[3927]	1681	PRINT *, 'cva_driver -> cv3a_uncompress'
	1682	CALL cv3a_uncompress(nloc, len, ncum, nd, ntra, idcum, compress, &
	1683	iflag, icb, inb, &
	1684	precip, cbmf, plcl, plfc, wbeff, sig, w0, ptop2, &
[4613]	1685	ft, fq, fqcomp, fu, fv, ftra, &
[3927]	1686	sigd, ma, mip, vprecip, vprecipi, upwd, dnwd, dnwd0, &
	1687	qcondc, wd, cape, cin, &
	1688	tvp, &
	1689	ftd, fqd, &
	1690	Plim1, plim2, asupmax, supmax0, &
	1691	asupmaxmin, &
	1692	da, phi, mp, phi2, d1a, dam, sigij, & ! RomP
	1693	qta, clw, elij, evap, ep, epmlmMm, eplaMm, & ! RomP
	1694	wdtrainA, wdtrainS, wdtrainM, & ! RomP
[4613]	1695	qtc, sigt, detrain, epmax_diag, & ! epmax_cape
[3927]	1696	iflag1, kbas1, ktop1, &
	1697	precip1, cbmf1, plcl1, plfc1, wbeff1, sig1, w01, ptop21, &
[4613]	1698	ft1, fq1, fqcomp1, fu1, fv1, ftra1, &
[3927]	1699	sigd1, ma1, mip1, vprecip1, vprecipi1, upwd1, dnwd1, dnwd01, &
	1700	qcondc1, wd1, cape1, cin1, &
	1701	tvp1, &
	1702	ftd1, fqd1, &
	1703	Plim11, plim21, asupmax1, supmax01, &
	1704	asupmaxmin1, &
	1705	da1, phi1, mp1, phi21, d1a1, dam1, sigij1, & ! RomP
	1706	qta1, clw1, elij1, evap1, ep1, epmlmMm1, eplaMm1, & ! RomP
	1707	wdtrainA1, wdtrainS1, wdtrainM1, & ! RomP
[4613]	1708	qtc1, sigt1,detrain1,epmax_diag1 & ! epmax_cape
[3927]	1709	#ifdef ISO
[5087]	1710	,xtprecip,fxt,fxtd, xtVprecip,xtVprecipi, xtclw,xtevap,xtwdtraina &
	1711	,xtprecip1,fxt1,fxtd1, xtVprecip1, xtVprecipi1, xtclw1,xtevap1,xtwdtraina1 &
[3927]	1712	#ifdef DIAGISO
[5087]	1713	, water,xtwater,qp,xtp &
	1714	, fq_detrainement,fq_ddft,fq_fluxmasse,fq_evapprecip &
	1715	, fxt_detrainement,fxt_ddft,fxt_fluxmasse, fxt_evapprecip &
	1716	, f_detrainement,q_detrainement,xt_detrainement &
	1717	, water1,xtwater1,qp1,xtp1 &
	1718	, fq_detrainement1,fq_ddft1,fq_fluxmasse1,fq_evapprecip1 &
	1719	, fxt_detrainement1,fxt_ddft1,fxt_fluxmasse1, fxt_evapprecip1 &
	1720	, f_detrainement1,q_detrainement1,xt_detrainement1 &
[3927]	1721	#endif
	1722	#endif
[5087]	1723	)
[3927]	1724
	1725
	1726	#ifdef ISOVERIF
	1727	DO k = 1, nd
	1728	DO i = 1, len
[5117]	1729	IF (iso_HDO.gt.0) THEN
	1730	IF (q1(i,k).gt.ridicule) THEN
[5103]	1731	CALL iso_verif_aberrant( &
[5087]	1732	(xt1(iso_HDO,i,k)+delt*fxt1(iso_HDO,i,k)) &
	1733	/(q1(i,k)+delt*fq1(i,k)),'cva_driver 2554')
[3927]	1734	endif
[5116]	1735	endif !if (iso_HDO.gt.0) THEN
[5117]	1736	IF (iso_eau.gt.0) THEN
[5103]	1737	CALL iso_verif_egalite_choix(fxt1(iso_eau,i,k), &
[5087]	1738	fq1(i,k),'cva_driver 1383',errmax,errmaxrel)
[3927]	1739	endif
[5158]	1740	DO ixt=1,ntraciso
[5117]	1741	IF (iso_verif_noNaN_nostop(fxtd1(ixt,i,k), &
	1742	'cva_driver 1447').EQ.1) THEN
[5116]	1743	WRITE(,) 'i,k=', i,k
[3927]	1744	stop
	1745	endif !if (iso_verif_noNaN_nostop(fxtd1(ixt,i,k),
	1746	enddo
	1747	enddo
	1748	enddo
	1749	#endif
	1750
	1751	IF (prt_level >= 10) THEN
	1752	Print *, 'cva_driver after cv3_uncompress:ft1(1) , ftd1(1) ', &
	1753	ft1(igout,1), ftd1(igout,1)
	1754	Print *, 'cva_driver after cv3_uncompress:fq1(1) , fqd1(1) ', &
	1755	fq1(igout,1), fqd1(igout,1)
	1756	ENDIF
[5099]	1757
[3927]	1758	END IF
	1759
	1760	IF (iflag_con==4) THEN
[5117]	1761	IF (prt_level >= 9) &
[3927]	1762	PRINT *, 'cva_driver -> cv_uncompress'
	1763	CALL cv_uncompress(nloc, len, ncum, nd, idcum, &
	1764	iflag, &
	1765	precip, cbmf, &
	1766	ft, fq, fu, fv, &
	1767	ma, qcondc, &
	1768	iflag1, &
	1769	precip1,cbmf1, &
	1770	ft1, fq1, fu1, fv1, &
	1771	ma1, qcondc1)
	1772	END IF
	1773
	1774	END IF ! ncum>0
[5099]	1775
	1776
[3927]	1777	DO i = 1,len
	1778	IF (iflag1(i) == 14) THEN
	1779	Cin1(i) = Cin_noconv
	1780	Cape1(i) = Cape_noconv
	1781	ENDIF
	1782	ENDDO
	1783
	1784	! In order take into account the possibility of changing the compression,
	1785	! reset m, sig and w0 to zero for non-convective points.
	1786	DO k = 1,nd-1
	1787	sig1(:, k) = sig1(:, k)*coef_convective(:)
	1788	w01(:, k) = w01(:, k)*coef_convective(:)
	1789	ENDDO
	1790
	1791	IF (debut) THEN
	1792	PRINT *, ' cv_uncompress -> '
	1793	debut = .FALSE.
	1794	END IF !(debut) THEN
	1795
	1796
[5105]	1797
[3927]	1798	END SUBROUTINE cva_driver

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

Download in other formats:

Original Format