Context Navigation

cva_driver.F90 @ 5437

Last change on this file since 5437 was 3406, checked in by jghattas, 6 years ago
Added all modifications in the model code that were used for the simulations with DYANMICO during the Grand Challeng 2018. Modifications done by Y. Meurdesoif, L. Fairhead and A.K. Traore
Property copyright set to Name of program: LMDZ Creation date: 1984 Version: LMDZ5 License: CeCILL version 2 Holder: Laboratoire de m\'et\'eorologie dynamique, CNRS, UMR 8539 See the license file in the root directory Property svn:eol-style set to `native` Property svn:keywords set to `Author Date Id Revision`
File size: 49.8 KB

Rev	Line
[1992]	1
[1403]	2	! $Id: cva_driver.F90 3406 2018-10-23 09:16:41Z evignon $
[1774]	3
[2259]	4	SUBROUTINE cva_driver(len, nd, ndp1, ntra, nloc, k_upper, &
[2007]	5	iflag_con, iflag_mix, iflag_ice_thermo, iflag_clos, ok_conserv_q, &
[2253]	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
[2007]	9	u1, v1, tra1, &
	10	p1, ph1, &
[2201]	11	Ale1, Alp1, omega1, &
[2007]	12	sig1feed1, sig2feed1, wght1, &
	13	iflag1, ft1, fq1, fu1, fv1, ftra1, &
	14	precip1, kbas1, ktop1, &
	15	cbmf1, plcl1, plfc1, wbeff1, &
	16	sig1, w01, & !input/output
	17	ptop21, sigd1, &
[2306]	18	ma1, mip1, Vprecip1, Vprecipi1, upwd1, dnwd1, dnwd01, & ! jyg
[2007]	19	qcondc1, wd1, &
	20	cape1, cin1, tvp1, &
	21	ftd1, fqd1, &
	22	Plim11, Plim21, asupmax1, supmax01, asupmaxmin1, &
[2253]	23	lalim_conv1, &
[2007]	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	clw1, elij1, evap1, ep1, epmlmMm1, eplaMm1, & ! RomP, RL
[2207]	28	wdtrainA1, wdtrainM1, qtc1, sigt1, tau_cld_cv, &
[2481]	29	coefw_cld_cv, & ! RomP, AJ
	30	epmax_diag1) ! epmax_cape
[2007]	31	! **************************************************************
	32	! *
	33	! CV_DRIVER *
	34	! *
	35	! *
	36	! written by : Sandrine Bony-Lena , 17/05/2003, 11.19.41 *
	37	! modified by : *
	38	! **************************************************************
	39	! **************************************************************
[1403]	40
[2311]	41	USE print_control_mod, ONLY: prt_level, lunout
[2902]	42	USE add_phys_tend_mod, ONLY: fl_cor_ebil
[1992]	43	IMPLICIT NONE
[879]	44
[2007]	45	! .............................START PROLOGUE............................
[879]	46
	47
[2007]	48	! All argument names (except len,nd,ntra,nloc,delt and the flags) have a "1" appended.
	49	! The "1" is removed for the corresponding compressed variables.
	50	! PARAMETERS:
	51	! Name Type Usage Description
	52	! ---------- ---------- ------- ----------------------------
[879]	53
[2007]	54	! len Integer Input first (i) dimension
	55	! nd Integer Input vertical (k) dimension
	56	! ndp1 Integer Input nd + 1
	57	! ntra Integer Input number of tracors
[2259]	58	! nloc Integer Input dimension of arrays for compressed fields
	59	! k_upper Integer Input upmost level for vertical loops
[2007]	60	! iflag_con Integer Input version of convect (3/4)
	61	! iflag_mix Integer Input version of mixing (0/1/2)
	62	! iflag_ice_thermo Integer Input accounting for ice thermodynamics (0/1)
	63	! iflag_clos Integer Input version of closure (0/1)
[2205]	64	! tau_cld_cv Real Input characteristic time of dissipation of mixing fluxes
	65	! coefw_cld_cv Real Input coefficient for updraft velocity in convection
[2007]	66	! ok_conserv_q Logical Input when true corrections for water conservation are swtiched on
	67	! delt Real Input time step
[2253]	68	! comp_threshold Real Input threshold on the fraction of convective points below which
	69	! fields are compressed
[2007]	70	! t1 Real Input temperature (sat draught envt)
	71	! q1 Real Input specific hum (sat draught envt)
	72	! qs1 Real Input sat specific hum (sat draught envt)
	73	! t1_wake Real Input temperature (unsat draught envt)
	74	! q1_wake Real Input specific hum(unsat draught envt)
	75	! qs1_wake Real Input sat specific hum(unsat draughts envt)
	76	! s1_wake Real Input fractionnal area covered by wakes
	77	! u1 Real Input u-wind
	78	! v1 Real Input v-wind
	79	! tra1 Real Input tracors
	80	! p1 Real Input full level pressure
	81	! ph1 Real Input half level pressure
	82	! ALE1 Real Input Available lifting Energy
	83	! ALP1 Real Input Available lifting Power
	84	! sig1feed1 Real Input sigma coord at lower bound of feeding layer
	85	! sig2feed1 Real Input sigma coord at upper bound of feeding layer
	86	! wght1 Real Input weight density determining the feeding mixture
	87	! iflag1 Integer Output flag for Emanuel conditions
	88	! ft1 Real Output temp tend
	89	! fq1 Real Output spec hum tend
	90	! fu1 Real Output u-wind tend
	91	! fv1 Real Output v-wind tend
	92	! ftra1 Real Output tracor tend
	93	! precip1 Real Output precipitation
	94	! kbas1 Integer Output cloud base level
	95	! ktop1 Integer Output cloud top level
	96	! cbmf1 Real Output cloud base mass flux
	97	! sig1 Real In/Out section adiabatic updraft
	98	! w01 Real In/Out vertical velocity within adiab updraft
	99	! ptop21 Real In/Out top of entraining zone
	100	! Ma1 Real Output mass flux adiabatic updraft
	101	! mip1 Real Output mass flux shed by the adiabatic updraft
[2306]	102	! Vprecip1 Real Output vertical profile of total precipitation
	103	! Vprecipi1 Real Output vertical profile of ice precipitation
[2007]	104	! upwd1 Real Output total upward mass flux (adiab+mixed)
	105	! dnwd1 Real Output saturated downward mass flux (mixed)
	106	! dnwd01 Real Output unsaturated downward mass flux
	107	! qcondc1 Real Output in-cld mixing ratio of condensed water
	108	! wd1 Real Output downdraft velocity scale for sfc fluxes
	109	! cape1 Real Output CAPE
	110	! cin1 Real Output CIN
	111	! tvp1 Real Output adiab lifted parcell virt temp
	112	! ftd1 Real Output precip temp tend
	113	! fqt1 Real Output precip spec hum tend
	114	! Plim11 Real Output
	115	! Plim21 Real Output
	116	! asupmax1 Real Output
	117	! supmax01 Real Output
	118	! asupmaxmin1 Real Output
[879]	119
[2007]	120	! ftd1 Real Output Array of temperature tendency due to precipitations (K/s) of dimension ND,
	121	! defined at same grid levels as T, Q, QS and P.
[879]	122
[2007]	123	! fqd1 Real Output Array of specific humidity tendencies due to precipitations ((gm/gm)/s)
	124	! of dimension ND, defined at same grid levels as T, Q, QS and P.
[879]	125
[2007]	126	! wdtrainA1 Real Output precipitation detrained from adiabatic draught;
	127	! used in tracer transport (cvltr)
	128	! wdtrainM1 Real Output precipitation detrained from mixed draughts;
	129	! used in tracer transport (cvltr)
	130	! da1 Real Output used in tracer transport (cvltr)
	131	! phi1 Real Output used in tracer transport (cvltr)
	132	! mp1 Real Output used in tracer transport (cvltr)
[2207]	133	! qtc1 Real Output specific humidity in convection
	134	! sigt1 Real Output surface fraction in adiabatic updrafts
[2007]	135	! phi21 Real Output used in tracer transport (cvltr)
	136
	137	! d1a1 Real Output used in tracer transport (cvltr)
	138	! dam1 Real Output used in tracer transport (cvltr)
	139
	140	! epmlmMm1 Real Output used in tracer transport (cvltr)
	141	! eplaMm1 Real Output used in tracer transport (cvltr)
	142
	143	! evap1 Real Output
	144	! ep1 Real Output
	145	! sigij1 Real Output used in tracer transport (cvltr)
[2628]	146	! clw1 Real Output condensed water content of the adiabatic updraught
[2007]	147	! elij1 Real Output
	148	! wghti1 Real Output final weight of the feeding layers,
	149	! used in tracer transport (cvltr)
[879]	150
	151
[2007]	152	! S. Bony, Mar 2002:
	153	! * Several modules corresponding to different physical processes
	154	! * Several versions of convect may be used:
	155	! - iflag_con=3: version lmd (previously named convect3)
	156	! - iflag_con=4: version 4.3b (vect. version, previously convect1/2)
	157	! + tard: - iflag_con=5: version lmd with ice (previously named convectg)
	158	! S. Bony, Oct 2002:
	159	! * Vectorization of convect3 (ie version lmd)
[879]	160
[2007]	161	! ..............................END PROLOGUE.............................
[879]	162
	163
	164
[2007]	165	! Input
[2253]	166	INTEGER, INTENT (IN) :: len
	167	INTEGER, INTENT (IN) :: nd
	168	INTEGER, INTENT (IN) :: ndp1
	169	INTEGER, INTENT (IN) :: ntra
[2853]	170	INTEGER, INTENT(IN) :: nloc ! (nloc=len) pour l'instant
[2259]	171	INTEGER, INTENT (IN) :: k_upper
[2253]	172	INTEGER, INTENT (IN) :: iflag_con
	173	INTEGER, INTENT (IN) :: iflag_mix
	174	INTEGER, INTENT (IN) :: iflag_ice_thermo
	175	INTEGER, INTENT (IN) :: iflag_clos
	176	LOGICAL, INTENT (IN) :: ok_conserv_q
	177	REAL, INTENT (IN) :: tau_cld_cv
	178	REAL, INTENT (IN) :: coefw_cld_cv
	179	REAL, INTENT (IN) :: delt
	180	REAL, INTENT (IN) :: comp_threshold
	181	REAL, DIMENSION (len, nd), INTENT (IN) :: t1
	182	REAL, DIMENSION (len, nd), INTENT (IN) :: q1
	183	REAL, DIMENSION (len, nd), INTENT (IN) :: qs1
	184	REAL, DIMENSION (len, nd), INTENT (IN) :: t1_wake
	185	REAL, DIMENSION (len, nd), INTENT (IN) :: q1_wake
	186	REAL, DIMENSION (len, nd), INTENT (IN) :: qs1_wake
	187	REAL, DIMENSION (len), INTENT (IN) :: s1_wake
	188	REAL, DIMENSION (len, nd), INTENT (IN) :: u1
	189	REAL, DIMENSION (len, nd), INTENT (IN) :: v1
	190	REAL, DIMENSION (len, nd, ntra), INTENT (IN) :: tra1
	191	REAL, DIMENSION (len, nd), INTENT (IN) :: p1
	192	REAL, DIMENSION (len, ndp1), INTENT (IN) :: ph1
	193	REAL, DIMENSION (len), INTENT (IN) :: Ale1
	194	REAL, DIMENSION (len), INTENT (IN) :: Alp1
	195	REAL, DIMENSION (len, nd), INTENT (IN) :: omega1
	196	REAL, INTENT (IN) :: sig1feed1 ! pressure at lower bound of feeding layer
	197	REAL, INTENT (IN) :: sig2feed1 ! pressure at upper bound of feeding layer
	198	REAL, DIMENSION (nd), INTENT (IN) :: wght1 ! weight density determining the feeding mixture
	199	INTEGER, DIMENSION (len), INTENT (IN) :: lalim_conv1
[879]	200
[2253]	201	! Input/Output
	202	REAL, DIMENSION (len, nd), INTENT (INOUT) :: sig1
	203	REAL, DIMENSION (len, nd), INTENT (INOUT) :: w01
	204
[2007]	205	! Output
[2253]	206	INTEGER, DIMENSION (len), INTENT (OUT) :: iflag1
	207	REAL, DIMENSION (len, nd), INTENT (OUT) :: ft1
	208	REAL, DIMENSION (len, nd), INTENT (OUT) :: fq1
	209	REAL, DIMENSION (len, nd), INTENT (OUT) :: fu1
	210	REAL, DIMENSION (len, nd), INTENT (OUT) :: fv1
	211	REAL, DIMENSION (len, nd, ntra), INTENT (OUT) :: ftra1
	212	REAL, DIMENSION (len), INTENT (OUT) :: precip1
	213	INTEGER, DIMENSION (len), INTENT (OUT) :: kbas1
	214	INTEGER, DIMENSION (len), INTENT (OUT) :: ktop1
	215	REAL, DIMENSION (len), INTENT (OUT) :: cbmf1
	216	REAL, DIMENSION (len), INTENT (OUT) :: plcl1
	217	REAL, DIMENSION (len), INTENT (OUT) :: plfc1
	218	REAL, DIMENSION (len), INTENT (OUT) :: wbeff1
	219	REAL, DIMENSION (len), INTENT (OUT) :: ptop21
	220	REAL, DIMENSION (len), INTENT (OUT) :: sigd1
[2853]	221	REAL, DIMENSION (len, nd), INTENT (OUT) :: ma1 ! adiab. asc. mass flux (staggered grid)
	222	REAL, DIMENSION (len, nd), INTENT (OUT) :: mip1 ! mass flux shed from adiab. ascent (extensive)
[2007]	223	! real Vprecip1(len,nd)
[2853]	224	REAL, DIMENSION (len, ndp1), INTENT (OUT) :: vprecip1 ! tot precipitation flux (staggered grid)
	225	REAL, DIMENSION (len, ndp1), INTENT (OUT) :: vprecipi1 ! ice precipitation flux (staggered grid)
	226	REAL, DIMENSION (len, nd), INTENT (OUT) :: upwd1 ! upwd sat. mass flux (staggered grid)
	227	REAL, DIMENSION (len, nd), INTENT (OUT) :: dnwd1 ! dnwd sat. mass flux (staggered grid)
	228	REAL, DIMENSION (len, nd), INTENT (OUT) :: dnwd01 ! unsat. mass flux (staggered grid)
	229	REAL, DIMENSION (len, nd), INTENT (OUT) :: qcondc1 ! max cloud condensate (intensive) ! cld
[2253]	230	REAL, DIMENSION (len), INTENT (OUT) :: wd1 ! gust
	231	REAL, DIMENSION (len), INTENT (OUT) :: cape1
	232	REAL, DIMENSION (len), INTENT (OUT) :: cin1
[2853]	233	REAL, DIMENSION (len, nd), INTENT (OUT) :: tvp1 ! Virt. temp. in the adiab. ascent
[879]	234
[2007]	235	!AC!
	236	!! real da1(len,nd),phi1(len,nd,nd)
	237	!! real da(len,nd),phi(len,nd,nd)
	238	!AC!
[2853]	239	REAL, DIMENSION (len, nd), INTENT (OUT) :: ftd1 ! Temp. tendency due to the sole unsat. drafts
	240	REAL, DIMENSION (len, nd), INTENT (OUT) :: fqd1 ! Moist. tendency due to the sole unsat. drafts
[2253]	241	REAL, DIMENSION (len), INTENT (OUT) :: Plim11
	242	REAL, DIMENSION (len), INTENT (OUT) :: Plim21
[2853]	243	REAL, DIMENSION (len, nd), INTENT (OUT) :: asupmax1 ! Highest mixing fraction of mixed updraughts
[2253]	244	REAL, DIMENSION (len), INTENT (OUT) :: supmax01
	245	REAL, DIMENSION (len), INTENT (OUT) :: asupmaxmin1
[2853]	246	REAL, DIMENSION (len, nd), INTENT (OUT) :: qtc1 ! in cloud water content (intensive) ! cld
	247	REAL, DIMENSION (len, nd), INTENT (OUT) :: sigt1 ! fract. cloud area (intensive) ! cld
[2207]	248
[2007]	249	! RomP >>>
[2853]	250	REAL, DIMENSION (len, nd), INTENT (OUT) :: wdtrainA1, wdtrainM1 ! precipitation sources (extensive)
	251	REAL, DIMENSION (len, nd), INTENT (OUT) :: mp1 ! unsat. mass flux (staggered grid)
	252	REAL, DIMENSION (len, nd), INTENT (OUT) :: da1 ! detrained mass flux of adiab. asc. air (extensive)
	253	REAL, DIMENSION (len, nd, nd), INTENT (OUT) :: phi1 ! mass flux of envt. air in mixed draughts (extensive)
	254	REAL, DIMENSION (len, nd, nd), INTENT (OUT) :: epmlmMm1 ! (extensive)
	255	REAL, DIMENSION (len, nd), INTENT (OUT) :: eplaMm1 ! (extensive)
	256	REAL, DIMENSION (len, nd), INTENT (OUT) :: evap1 ! evaporation rate in precip. downdraft. (intensive)
	257	REAL, DIMENSION (len, nd), INTENT (OUT) :: ep1
	258	REAL, DIMENSION (len, nd, nd), INTENT (OUT) :: sigij1 ! mass fraction of env. air in mixed draughts (intensive)
	259	REAL, DIMENSION (len, nd, nd), INTENT (OUT) :: elij1! cond. water per unit mass of mixed draughts (intensive)
	260	REAL, DIMENSION (len, nd), INTENT (OUT) :: clw1 ! cond. water per unit mass of the adiab. asc. (intensive)
[2007]	261	!JYG,RL
[2853]	262	REAL, DIMENSION (len, nd), INTENT (OUT) :: wghti1 ! final weight of the feeding layers (extensive)
[2007]	263	!JYG,RL
[2853]	264	REAL, DIMENSION (len, nd, nd), INTENT (OUT) :: phi21 ! (extensive)
	265	REAL, DIMENSION (len, nd), INTENT (OUT) :: d1a1 ! (extensive)
	266	REAL, DIMENSION (len, nd), INTENT (OUT) :: dam1 ! (extensive)
[2007]	267	! RomP <<<
[2481]	268	REAL, DIMENSION (len ), INTENT (OUT) :: epmax_diag1
[879]	269
[2007]	270	! -------------------------------------------------------------------
	271	! Prolog by Kerry Emanuel.
	272	! -------------------------------------------------------------------
	273	! --- ARGUMENTS
	274	! -------------------------------------------------------------------
	275	! --- On input:
[879]	276
[2007]	277	! t: Array of absolute temperature (K) of dimension ND, with first
	278	! index corresponding to lowest model level. Note that this array
	279	! will be altered by the subroutine if dry convective adjustment
	280	! occurs and if IPBL is not equal to 0.
[879]	281
[2007]	282	! q: Array of specific humidity (gm/gm) of dimension ND, with first
	283	! index corresponding to lowest model level. Must be defined
	284	! at same grid levels as T. Note that this array will be altered
	285	! if dry convective adjustment occurs and if IPBL is not equal to 0.
[879]	286
[2007]	287	! qs: Array of saturation specific humidity of dimension ND, with first
	288	! index corresponding to lowest model level. Must be defined
	289	! at same grid levels as T. Note that this array will be altered
	290	! if dry convective adjustment occurs and if IPBL is not equal to 0.
[879]	291
[2007]	292	! t_wake: Array of absolute temperature (K), seen by unsaturated draughts,
	293	! of dimension ND, with first index corresponding to lowest model level.
[879]	294
[2007]	295	! q_wake: Array of specific humidity (gm/gm), seen by unsaturated draughts,
	296	! of dimension ND, with first index corresponding to lowest model level.
	297	! Must be defined at same grid levels as T.
[879]	298
[2007]	299	! qs_wake: Array of saturation specific humidity, seen by unsaturated draughts,
	300	! of dimension ND, with first index corresponding to lowest model level.
	301	! Must be defined at same grid levels as T.
[879]	302
[2007]	303	! s_wake: Array of fractionnal area occupied by the wakes.
[879]	304
[2007]	305	! u: Array of zonal wind velocity (m/s) of dimension ND, witth first
	306	! index corresponding with the lowest model level. Defined at
	307	! same levels as T. Note that this array will be altered if
	308	! dry convective adjustment occurs and if IPBL is not equal to 0.
[879]	309
[2007]	310	! v: Same as u but for meridional velocity.
[1146]	311
[2007]	312	! tra: Array of passive tracer mixing ratio, of dimensions (ND,NTRA),
	313	! where NTRA is the number of different tracers. If no
	314	! convective tracer transport is needed, define a dummy
	315	! input array of dimension (ND,1). Tracers are defined at
	316	! same vertical levels as T. Note that this array will be altered
	317	! if dry convective adjustment occurs and if IPBL is not equal to 0.
[879]	318
[2007]	319	! p: Array of pressure (mb) of dimension ND, with first
	320	! index corresponding to lowest model level. Must be defined
	321	! at same grid levels as T.
[879]	322
[2007]	323	! ph: Array of pressure (mb) of dimension ND+1, with first index
	324	! corresponding to lowest level. These pressures are defined at
	325	! levels intermediate between those of P, T, Q and QS. The first
	326	! value of PH should be greater than (i.e. at a lower level than)
	327	! the first value of the array P.
[879]	328
[2007]	329	! ALE: Available lifting Energy
[879]	330
[2007]	331	! ALP: Available lifting Power
[879]	332
[2007]	333	! nl: The maximum number of levels to which convection can penetrate, plus 1.
	334	! NL MUST be less than or equal to ND-1.
[879]	335
[2007]	336	! delt: The model time step (sec) between calls to CONVECT
[879]	337
[2007]	338	! ----------------------------------------------------------------------------
	339	! --- On Output:
[879]	340
[2007]	341	! iflag: An output integer whose value denotes the following:
	342	! VALUE INTERPRETATION
	343	! ----- --------------
	344	! 0 Moist convection occurs.
	345	! 1 Moist convection occurs, but a CFL condition
	346	! on the subsidence warming is violated. This
	347	! does not cause the scheme to terminate.
	348	! 2 Moist convection, but no precip because ep(inb) lt 0.0001
	349	! 3 No moist convection because new cbmf is 0 and old cbmf is 0.
	350	! 4 No moist convection; atmosphere is not
	351	! unstable
	352	! 6 No moist convection because ihmin le minorig.
	353	! 7 No moist convection because unreasonable
	354	! parcel level temperature or specific humidity.
	355	! 8 No moist convection: lifted condensation
	356	! level is above the 200 mb level.
	357	! 9 No moist convection: cloud base is higher
	358	! then the level NL-1.
[2761]	359	! 10 No moist convection: cloud top is too warm.
	360	!
[879]	361
[2007]	362	! ft: Array of temperature tendency (K/s) of dimension ND, defined at same
	363	! grid levels as T, Q, QS and P.
[1652]	364
[2007]	365	! fq: Array of specific humidity tendencies ((gm/gm)/s) of dimension ND,
	366	! defined at same grid levels as T, Q, QS and P.
[1652]	367
[2007]	368	! fu: Array of forcing of zonal velocity (m/s^2) of dimension ND,
	369	! defined at same grid levels as T.
[1652]	370
[2007]	371	! fv: Same as FU, but for forcing of meridional velocity.
[879]	372
[2007]	373	! ftra: Array of forcing of tracer content, in tracer mixing ratio per
	374	! second, defined at same levels as T. Dimensioned (ND,NTRA).
[879]	375
[2007]	376	! precip: Scalar convective precipitation rate (mm/day).
[879]	377
[2007]	378	! wd: A convective downdraft velocity scale. For use in surface
	379	! flux parameterizations. See convect.ps file for details.
[879]	380
[2007]	381	! tprime: A convective downdraft temperature perturbation scale (K).
	382	! For use in surface flux parameterizations. See convect.ps
	383	! file for details.
[879]	384
[2007]	385	! qprime: A convective downdraft specific humidity
	386	! perturbation scale (gm/gm).
	387	! For use in surface flux parameterizations. See convect.ps
	388	! file for details.
[1992]	389
[2007]	390	! cbmf: The cloud base mass flux ((kg/m**2)/s). THIS SCALAR VALUE MUST
	391	! BE STORED BY THE CALLING PROGRAM AND RETURNED TO CONVECT AT
	392	! ITS NEXT CALL. That is, the value of CBMF must be "remembered"
	393	! by the calling program between calls to CONVECT.
[1992]	394
[2007]	395	! det: Array of detrainment mass flux of dimension ND.
	396	! -------------------------------------------------------------------
[1992]	397
[2007]	398	! Local (non compressed) arrays
[1992]	399
	400
[2853]	401	INTEGER i, k, il
[1992]	402	INTEGER nword1, nword2, nword3, nword4
	403	INTEGER icbmax
[2853]	404	INTEGER nk1(len)
	405	INTEGER icb1(len)
	406	INTEGER icbs1(len)
[1992]	407
	408	LOGICAL ok_inhib ! True => possible inhibition of convection by dryness
	409	LOGICAL, SAVE :: debut = .TRUE.
[2007]	410	!$OMP THREADPRIVATE(debut)
[1992]	411
[2253]	412	REAL coef_convective(len) ! = 1 for convective points, = 0 otherwise
[2853]	413	REAL tnk1(len)
	414	REAL thnk1(len)
	415	REAL qnk1(len)
	416	REAL gznk1(len)
	417	REAL qsnk1(len)
	418	REAL unk1(len)
	419	REAL vnk1(len)
	420	REAL cpnk1(len)
	421	REAL hnk1(len)
	422	REAL pbase1(len)
	423	REAL buoybase1(len)
[1992]	424
[2853]	425	REAL lf1(len, nd), lf1_wake(len, nd)
	426	REAL lv1(len, nd), lv1_wake(len, nd)
	427	REAL cpn1(len, nd), cpn1_wake(len, nd)
	428	REAL tv1(len, nd), tv1_wake(len, nd)
	429	REAL gz1(len, nd), gz1_wake(len, nd)
	430	REAL hm1(len, nd)
	431	REAL h1(len, nd), h1_wake(len, nd)
	432	REAL tp1(len, nd)
	433	REAL th1(len, nd), th1_wake(len, nd)
[1992]	434
[2853]	435	REAL bid(len, nd) ! dummy array
[1992]	436
	437	INTEGER ncum
	438
	439	REAL p1feed1(len) ! pressure at lower bound of feeding layer
	440	REAL p2feed1(len) ! pressure at upper bound of feeding layer
[2007]	441	!JYG,RL
	442	!! real wghti1(len,nd) ! weights of the feeding layers
	443	!JYG,RL
[1992]	444
[2007]	445	! (local) compressed fields:
[1992]	446
	447
	448	INTEGER idcum(nloc)
[2253]	449	!jyg<
	450	LOGICAL compress ! True if compression occurs
	451	!>jyg
[1992]	452	INTEGER iflag(nloc), nk(nloc), icb(nloc)
[2853]	453	INTEGER nent(nloc, nd)
[1992]	454	INTEGER icbs(nloc)
	455	INTEGER inb(nloc), inbis(nloc)
	456
	457	REAL cbmf(nloc), plcl(nloc), plfc(nloc), wbeff(nloc)
[2853]	458	REAL t(nloc, nd), q(nloc, nd), qs(nloc, nd)
	459	REAL t_wake(nloc, nd), q_wake(nloc, nd), qs_wake(nloc, nd)
[1992]	460	REAL s_wake(nloc)
[2853]	461	REAL u(nloc, nd), v(nloc, nd)
	462	REAL gz(nloc, nd), h(nloc, nd)
	463	REAL h_wake(nloc, nd)
	464	REAL lv(nloc, nd), lf(nloc, nd), cpn(nloc, nd)
	465	REAL lv_wake(nloc, nd), lf_wake(nloc, nd), cpn_wake(nloc, nd)
	466	REAL p(nloc, nd), ph(nloc, nd+1), tv(nloc, nd), tp(nloc, nd)
	467	REAL tv_wake(nloc, nd)
	468	REAL clw(nloc, nd)
	469	REAL dph(nloc, nd)
	470	REAL pbase(nloc), buoybase(nloc), th(nloc, nd)
	471	REAL th_wake(nloc, nd)
	472	REAL tvp(nloc, nd)
	473	REAL sig(nloc, nd), w0(nloc, nd), ptop2(nloc)
	474	REAL hp(nloc, nd), ep(nloc, nd), sigp(nloc, nd)
	475	REAL buoy(nloc, nd)
[1992]	476	REAL cape(nloc)
	477	REAL cin(nloc)
[2853]	478	REAL m(nloc, nd)
	479	REAL ment(nloc, nd, nd), sigij(nloc, nd, nd)
	480	REAL qent(nloc, nd, nd)
	481	REAL hent(nloc, nd, nd)
	482	REAL uent(nloc, nd, nd), vent(nloc, nd, nd)
	483	REAL ments(nloc, nd, nd), qents(nloc, nd, nd)
	484	REAL elij(nloc, nd, nd)
	485	REAL supmax(nloc, nd)
[2007]	486	REAL Ale(nloc), Alp(nloc), coef_clos(nloc)
[2853]	487	REAL omega(nloc,nd)
[1992]	488	REAL sigd(nloc)
[2853]	489	! real mp(nloc,nd), qp(nloc,nd), up(nloc,nd), vp(nloc,nd)
	490	! real wt(nloc,nd), water(nloc,nd), evap(nloc,nd), ice(nloc,nd)
	491	! real b(nloc,nd), sigd(nloc)
[2007]	492	! save mp,qp,up,vp,wt,water,evap,b
[2853]	493	REAL, DIMENSION(len,nd) :: mp, qp, up, vp
	494	REAL, DIMENSION(len,nd) :: wt, water, evap
	495	REAL, DIMENSION(len,nd) :: ice, fondue, b
	496	REAL, DIMENSION(len,nd) :: frac, faci
	497	REAL ft(nloc, nd), fq(nloc, nd)
	498	REAL ftd(nloc, nd), fqd(nloc, nd)
	499	REAL fu(nloc, nd), fv(nloc, nd)
	500	REAL upwd(nloc, nd), dnwd(nloc, nd), dnwd0(nloc, nd)
	501	REAL ma(nloc, nd), mip(nloc, nd)
	502	!! REAL tls(nloc, nd), tps(nloc, nd) ! unused . jyg
[2259]	503	REAL qprime(nloc), tprime(nloc)
[1992]	504	REAL precip(nloc)
[2853]	505	! real Vprecip(nloc,nd)
	506	REAL vprecip(nloc, nd+1)
	507	REAL vprecipi(nloc, nd+1)
	508	REAL tra(nloc, nd, ntra), trap(nloc, nd, ntra)
	509	REAL ftra(nloc, nd, ntra), traent(nloc, nd, nd, ntra)
	510	REAL qcondc(nloc, nd) ! cld
[2007]	511	REAL wd(nloc) ! gust
	512	REAL Plim1(nloc), plim2(nloc)
[2853]	513	REAL asupmax(nloc, nd)
[1992]	514	REAL supmax0(nloc)
	515	REAL asupmaxmin(nloc)
	516
	517	REAL tnk(nloc), qnk(nloc), gznk(nloc)
	518	REAL wghti(nloc, nd)
	519	REAL hnk(nloc), unk(nloc), vnk(nloc)
	520
[2853]	521	REAL qtc(nloc, nd) ! cld
	522	REAL sigt(nloc, nd) ! cld
[2207]	523
[2007]	524	! RomP >>>
[2853]	525	REAL wdtrainA(nloc, nd), wdtrainM(nloc, nd)
[1992]	526	REAL da(len, nd), phi(len, nd, nd)
[2853]	527	REAL epmlmMm(nloc, nd, nd), eplaMm(nloc, nd)
[1992]	528	REAL phi2(len, nd, nd)
	529	REAL d1a(len, nd), dam(len, nd)
[2007]	530	! RomP <<<
[2481]	531	REAL epmax_diag(nloc) ! epmax_cape
[1992]	532
	533	CHARACTER (LEN=20) :: modname = 'cva_driver'
	534	CHARACTER (LEN=80) :: abort_message
	535
[2374]	536	INTEGER,SAVE :: igout=1
	537	!$OMP THREADPRIVATE(igout)
[1992]	538
[2374]	539
[2853]	540	! print *, 't1, t1_wake ',(k,t1(1,k),t1_wake(1,k),k=1,nd)
	541	! print *, 'q1, q1_wake ',(k,q1(1,k),q1_wake(1,k),k=1,nd)
[1992]	542
[2007]	543	! -------------------------------------------------------------------
	544	! --- SET CONSTANTS AND PARAMETERS
	545	! -------------------------------------------------------------------
[1992]	546
[2007]	547	! -- set simulation flags:
	548	! (common cvflag)
[1992]	549
	550	CALL cv_flag(iflag_ice_thermo)
	551
[2007]	552	! -- set thermodynamical constants:
	553	! (common cvthermo)
[1992]	554
	555	CALL cv_thermo(iflag_con)
	556
[2007]	557	! -- set convect parameters
[1992]	558
[2007]	559	! includes microphysical parameters and parameters that
	560	! control the rate of approach to quasi-equilibrium)
	561	! (common cvparam)
[1992]	562
	563	IF (iflag_con==3) THEN
[2259]	564	CALL cv3_param(nd, k_upper, delt)
[1992]	565
	566	END IF
	567
	568	IF (iflag_con==4) THEN
	569	CALL cv_param(nd)
	570	END IF
	571
[2007]	572	! ---------------------------------------------------------------------
	573	! --- INITIALIZE OUTPUT ARRAYS AND PARAMETERS
	574	! ---------------------------------------------------------------------
[1992]	575	nword1 = len
	576	nword2 = len*nd
	577	nword3 = lenndntra
	578	nword4 = lenndnd
	579
	580	iflag1(:) = 0
	581	ktop1(:) = 0
	582	kbas1(:) = 0
	583	ft1(:, :) = 0.0
	584	fq1(:, :) = 0.0
	585	fu1(:, :) = 0.0
	586	fv1(:, :) = 0.0
	587	ftra1(:, :, :) = 0.
	588	precip1(:) = 0.
	589	cbmf1(:) = 0.
[2393]	590	plcl1(:) = 0.
	591	plfc1(:) = 0.
	592	wbeff1(:) = 0.
[1992]	593	ptop21(:) = 0.
	594	sigd1(:) = 0.
	595	ma1(:, :) = 0.
	596	mip1(:, :) = 0.
	597	vprecip1(:, :) = 0.
[2306]	598	vprecipi1(:, :) = 0.
[1992]	599	upwd1(:, :) = 0.
	600	dnwd1(:, :) = 0.
	601	dnwd01(:, :) = 0.
	602	qcondc1(:, :) = 0.
	603	wd1(:) = 0.
	604	cape1(:) = 0.
	605	cin1(:) = 0.
	606	tvp1(:, :) = 0.
	607	ftd1(:, :) = 0.
	608	fqd1(:, :) = 0.
[2007]	609	Plim11(:) = 0.
	610	Plim21(:) = 0.
[1992]	611	asupmax1(:, :) = 0.
	612	supmax01(:) = 0.
	613	asupmaxmin1(:) = 0.
	614
[3406]	615	tvp(:, :) = 0. !ym missing init, need to have a look by developpers
	616	tv(:, :) = 0. !ym missing init, need to have a look by developpers
	617
[1992]	618	DO il = 1, len
	619	cin1(il) = -100000.
	620	cape1(il) = -1.
	621	END DO
	622
[2398]	623	!! IF (iflag_con==3) THEN
	624	!! DO il = 1, len
	625	!! sig1(il, nd) = sig1(il, nd) + 1.
	626	!! sig1(il, nd) = amin1(sig1(il,nd), 12.1)
	627	!! END DO
	628	!! END IF
	629
[1992]	630	IF (iflag_con==3) THEN
[2398]	631	CALL cv3_incrcount(len,nd,delt,sig1)
	632	END IF ! (iflag_con==3)
[1992]	633
[2007]	634	! RomP >>>
[2207]	635	sigt1(:, :) = 0.
	636	qtc1(:, :) = 0.
[2007]	637	wdtrainA1(:, :) = 0.
	638	wdtrainM1(:, :) = 0.
[1992]	639	da1(:, :) = 0.
	640	phi1(:, :, :) = 0.
[2007]	641	epmlmMm1(:, :, :) = 0.
	642	eplaMm1(:, :) = 0.
[1992]	643	mp1(:, :) = 0.
	644	evap1(:, :) = 0.
	645	ep1(:, :) = 0.
	646	sigij1(:, :, :) = 0.
	647	elij1(:, :, :) = 0.
[2628]	648	clw1(:,:) = 0.
[2393]	649	wghti1(:,:) = 0.
[1992]	650	phi21(:, :, :) = 0.
	651	d1a1(:, :) = 0.
	652	dam1(:, :) = 0.
[2007]	653	! RomP <<<
	654	! ---------------------------------------------------------------------
	655	! --- INITIALIZE LOCAL ARRAYS AND PARAMETERS
	656	! ---------------------------------------------------------------------
[1992]	657
	658	DO il = 1, nloc
	659	coef_clos(il) = 1.
	660	END DO
	661
[2007]	662	! --------------------------------------------------------------------
	663	! --- CALCULATE ARRAYS OF GEOPOTENTIAL, HEAT CAPACITY & STATIC ENERGY
	664	! --------------------------------------------------------------------
[1992]	665
	666	IF (iflag_con==3) THEN
	667
	668	IF (debut) THEN
	669	PRINT *, 'Emanuel version 3 nouvelle'
	670	END IF
[2007]	671	! print*,'t1, q1 ',t1,q1
[2638]	672	if (prt_level >= 9) &
	673	PRINT *, 'cva_driver -> cv3_prelim'
[2007]	674	CALL cv3_prelim(len, nd, ndp1, t1, q1, p1, ph1, & ! nd->na
	675	lv1, lf1, cpn1, tv1, gz1, h1, hm1, th1)
[1992]	676
	677
[2638]	678	if (prt_level >= 9) &
	679	PRINT *, 'cva_driver -> cv3_prelim'
[2007]	680	CALL cv3_prelim(len, nd, ndp1, t1_wake, q1_wake, p1, ph1, & ! nd->na
	681	lv1_wake, lf1_wake, cpn1_wake, tv1_wake, gz1_wake, &
	682	h1_wake, bid, th1_wake)
[1992]	683
	684	END IF
	685
	686	IF (iflag_con==4) THEN
	687	PRINT *, 'Emanuel version 4 '
[2638]	688	if (prt_level >= 9) &
	689	PRINT *, 'cva_driver -> cv_prelim'
[2007]	690	CALL cv_prelim(len, nd, ndp1, t1, q1, p1, ph1, &
	691	lv1, cpn1, tv1, gz1, h1, hm1)
[1992]	692	END IF
	693
[2007]	694	! --------------------------------------------------------------------
	695	! --- CONVECTIVE FEED
	696	! --------------------------------------------------------------------
[1992]	697
[2007]	698	! compute feeding layer potential temperature and mixing ratio :
[1992]	699
[2007]	700	! get bounds of feeding layer
[1992]	701
[2007]	702	! test niveaux couche alimentation KE
[1992]	703	IF (sig1feed1==sig2feed1) THEN
	704	WRITE (lunout, *) 'impossible de choisir sig1feed=sig2feed'
	705	WRITE (lunout, *) 'changer la valeur de sig2feed dans physiq.def'
	706	abort_message = ''
[2311]	707	CALL abort_physic(modname, abort_message, 1)
[1992]	708	END IF
	709
	710	DO i = 1, len
	711	p1feed1(i) = sig1feed1*ph1(i, 1)
	712	p2feed1(i) = sig2feed1*ph1(i, 1)
[2007]	713	!test maf
	714	! p1feed1(i)=ph1(i,1)
	715	! p2feed1(i)=ph1(i,2)
	716	! p2feed1(i)=ph1(i,3)
	717	!testCR: on prend la couche alim des thermiques
[2253]	718	! p2feed1(i)=ph1(i,lalim_conv1(i)+1)
[2007]	719	! print*,'lentr=',lentr(i),ph1(i,lentr(i)+1),ph1(i,2)
[1992]	720	END DO
	721
	722	IF (iflag_con==3) THEN
	723	END IF
	724	DO i = 1, len
[2007]	725	! print*,'avant cv3_feed Plim',p1feed1(i),p2feed1(i)
[1992]	726	END DO
	727	IF (iflag_con==3) THEN
	728
[2007]	729	! print*, 'IFLAG1 avant cv3_feed'
	730	! print*,'len,nd',len,nd
[2853]	731	! write(*,'(64i1)') iflag1(2:len-1)
[1992]	732
[2638]	733	if (prt_level >= 9) &
	734	PRINT *, 'cva_driver -> cv3_feed'
[2007]	735	CALL cv3_feed(len, nd, ok_conserv_q, & ! nd->na
[2902]	736	t1, q1, u1, v1, p1, ph1, h1, gz1, &
[2007]	737	p1feed1, p2feed1, wght1, &
	738	wghti1, tnk1, thnk1, qnk1, qsnk1, unk1, vnk1, &
	739	cpnk1, hnk1, nk1, icb1, icbmax, iflag1, gznk1, plcl1)
[1992]	740	END IF
	741
[2007]	742	! print*, 'IFLAG1 apres cv3_feed'
	743	! print*,'len,nd',len,nd
[2853]	744	! write(*,'(64i1)') iflag1(2:len-1)
[1992]	745
	746	IF (iflag_con==4) THEN
[2638]	747	if (prt_level >= 9) &
	748	PRINT *, 'cva_driver -> cv_feed'
[2007]	749	CALL cv_feed(len, nd, t1, q1, qs1, p1, hm1, gz1, &
	750	nk1, icb1, icbmax, iflag1, tnk1, qnk1, gznk1, plcl1)
[1992]	751	END IF
	752
[2007]	753	! print *, 'cv3_feed-> iflag1, plcl1 ',iflag1(1),plcl1(1)
[1992]	754
[2007]	755	! --------------------------------------------------------------------
	756	! --- UNDILUTE (ADIABATIC) UPDRAFT / 1st part
	757	! (up through ICB for convect4, up through ICB+1 for convect3)
	758	! Calculates the lifted parcel virtual temperature at nk, the
	759	! actual temperature, and the adiabatic liquid water content.
	760	! --------------------------------------------------------------------
[1992]	761
	762	IF (iflag_con==3) THEN
	763
[2638]	764	if (prt_level >= 9) &
	765	PRINT *, 'cva_driver -> cv3_undilute1'
[2007]	766	CALL cv3_undilute1(len, nd, t1, qs1, gz1, plcl1, p1, icb1, tnk1, qnk1, & ! nd->na
	767	gznk1, tp1, tvp1, clw1, icbs1)
[1992]	768	END IF
	769
	770
	771	IF (iflag_con==4) THEN
[2638]	772	if (prt_level >= 9) &
	773	PRINT *, 'cva_driver -> cv_undilute1'
[2007]	774	CALL cv_undilute1(len, nd, t1, q1, qs1, gz1, p1, nk1, icb1, icbmax, &
	775	tp1, tvp1, clw1)
[1992]	776	END IF
	777
[2007]	778	! -------------------------------------------------------------------
	779	! --- TRIGGERING
	780	! -------------------------------------------------------------------
[1992]	781
[2007]	782	! print *,' avant triggering, iflag_con ',iflag_con
[1992]	783
	784	IF (iflag_con==3) THEN
	785
[2638]	786	if (prt_level >= 9) &
	787	PRINT *, 'cva_driver -> cv3_trigger'
[2007]	788	CALL cv3_trigger(len, nd, icb1, plcl1, p1, th1, tv1, tvp1, thnk1, & ! nd->na
	789	pbase1, buoybase1, iflag1, sig1, w01)
[1992]	790
	791
[2007]	792	! print*, 'IFLAG1 apres cv3_triger'
	793	! print*,'len,nd',len,nd
[2853]	794	! write(*,'(64i1)') iflag1(2:len-1)
[1992]	795
[2007]	796	! call dump2d(iim,jjm-1,sig1(2)
[1992]	797	END IF
	798
	799	IF (iflag_con==4) THEN
[2638]	800	if (prt_level >= 9) &
	801	PRINT *, 'cva_driver -> cv_trigger'
[1992]	802	CALL cv_trigger(len, nd, icb1, cbmf1, tv1, tvp1, iflag1)
	803	END IF
	804
	805
[2007]	806	! =====================================================================
	807	! --- IF THIS POINT IS REACHED, MOIST CONVECTIVE ADJUSTMENT IS NECESSARY
	808	! =====================================================================
[1992]	809
[2253]	810	! Determine the number "ncum" of convective gridpoints, the list "idcum" of convective
	811	! gridpoints and the weights "coef_convective" (= 1. for convective gridpoints and = 0.
	812	! elsewhere).
[1992]	813	ncum = 0
[2253]	814	coef_convective(:) = 0.
[1992]	815	DO i = 1, len
	816	IF (iflag1(i)==0) THEN
[2253]	817	coef_convective(i) = 1.
[1992]	818	ncum = ncum + 1
	819	idcum(ncum) = i
	820	END IF
	821	END DO
	822
[2853]	823	! print*,'len, ncum = ',len,ncum
[1992]	824
	825	IF (ncum>0) THEN
	826
[2007]	827	! ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
	828	! --- COMPRESS THE FIELDS
	829	! (-> vectorization over convective gridpoints)
	830	! ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
[1992]	831
	832	IF (iflag_con==3) THEN
[2007]	833	! print*,'ncum tv1 ',ncum,tv1
	834	! print*,'tvp1 ',tvp1
[2253]	835	!jyg<
	836	! If the fraction of convective points is larger than comp_threshold, then compression
	837	! is assumed useless.
	838	!
	839	compress = ncum .lt. len*comp_threshold
	840	!
	841	IF (.not. compress) THEN
	842	DO i = 1,len
	843	idcum(i) = i
	844	ENDDO
	845	ENDIF
	846	!
	847	!>jyg
[2638]	848	if (prt_level >= 9) &
	849	PRINT *, 'cva_driver -> cv3a_compress'
[2253]	850	CALL cv3a_compress(len, nloc, ncum, nd, ntra, compress, &
[2007]	851	iflag1, nk1, icb1, icbs1, &
	852	plcl1, tnk1, qnk1, gznk1, hnk1, unk1, vnk1, &
	853	wghti1, pbase1, buoybase1, &
	854	t1, q1, qs1, t1_wake, q1_wake, qs1_wake, s1_wake, &
	855	u1, v1, gz1, th1, th1_wake, &
	856	tra1, &
	857	h1, lv1, lf1, cpn1, p1, ph1, tv1, tp1, tvp1, clw1, &
	858	h1_wake, lv1_wake, lf1_wake, cpn1_wake, tv1_wake, &
	859	sig1, w01, ptop21, &
[2201]	860	Ale1, Alp1, omega1, &
[2007]	861	iflag, nk, icb, icbs, &
	862	plcl, tnk, qnk, gznk, hnk, unk, vnk, &
	863	wghti, pbase, buoybase, &
	864	t, q, qs, t_wake, q_wake, qs_wake, s_wake, &
	865	u, v, gz, th, th_wake, &
	866	tra, &
	867	h, lv, lf, cpn, p, ph, tv, tp, tvp, clw, &
	868	h_wake, lv_wake, lf_wake, cpn_wake, tv_wake, &
	869	sig, w0, ptop2, &
[2201]	870	Ale, Alp, omega)
[1992]	871
[2007]	872	! print*,'tv ',tv
	873	! print*,'tvp ',tvp
[1992]	874
	875	END IF
	876
	877	IF (iflag_con==4) THEN
[2638]	878	if (prt_level >= 9) &
	879	PRINT *, 'cva_driver -> cv_compress'
[2007]	880	CALL cv_compress(len, nloc, ncum, nd, &
	881	iflag1, nk1, icb1, &
	882	cbmf1, plcl1, tnk1, qnk1, gznk1, &
	883	t1, q1, qs1, u1, v1, gz1, &
	884	h1, lv1, cpn1, p1, ph1, tv1, tp1, tvp1, clw1, &
	885	iflag, nk, icb, &
	886	cbmf, plcl, tnk, qnk, gznk, &
	887	t, q, qs, u, v, gz, h, lv, cpn, p, ph, tv, tp, tvp, clw, &
	888	dph)
[1992]	889	END IF
	890
[2007]	891	! -------------------------------------------------------------------
	892	! --- UNDILUTE (ADIABATIC) UPDRAFT / second part :
	893	! --- FIND THE REST OF THE LIFTED PARCEL TEMPERATURES
	894	! --- &
	895	! --- COMPUTE THE PRECIPITATION EFFICIENCIES AND THE
	896	! --- FRACTION OF PRECIPITATION FALLING OUTSIDE OF CLOUD
	897	! --- &
	898	! --- FIND THE LEVEL OF NEUTRAL BUOYANCY
	899	! -------------------------------------------------------------------
[1992]	900
	901	IF (iflag_con==3) THEN
[2638]	902	if (prt_level >= 9) &
	903	PRINT *, 'cva_driver -> cv3_undilute2'
[2761]	904	CALL cv3_undilute2(nloc, ncum, nd, iflag, icb, icbs, nk, & !na->nd
[2007]	905	tnk, qnk, gznk, hnk, t, q, qs, gz, &
[2420]	906	p, ph, h, tv, lv, lf, pbase, buoybase, plcl, &
[2007]	907	inb, tp, tvp, clw, hp, ep, sigp, buoy, &
	908	frac)
[1992]	909	END IF
	910
	911	IF (iflag_con==4) THEN
[2638]	912	if (prt_level >= 9) &
	913	PRINT *, 'cva_driver -> cv_undilute2'
[2007]	914	CALL cv_undilute2(nloc, ncum, nd, icb, nk, &
	915	tnk, qnk, gznk, t, q, qs, gz, &
	916	p, dph, h, tv, lv, &
	917	inb, inbis, tp, tvp, clw, hp, ep, sigp, frac)
[1992]	918	END IF
	919
[2481]	920	! epmax_cape
	921	! on recalcule ep et hp
[2638]	922	if (prt_level >= 9) &
	923	PRINT *, 'cva_driver -> cv3_epmax_cape'
[2481]	924	call cv3_epmax_fn_cape(nloc,ncum,nd &
	925	, ep,hp,icb,inb,clw,nk,t,h,hnk,lv,lf,frac &
	926	, pbase, p, ph, tv, buoy, sig, w0,iflag &
	927	, epmax_diag)
	928
[2007]	929	! -------------------------------------------------------------------
	930	! --- MIXING(1) (if iflag_mix .ge. 1)
	931	! -------------------------------------------------------------------
[1992]	932	IF (iflag_con==3) THEN
[2407]	933	! IF ((iflag_ice_thermo==1) .AND. (iflag_mix/=0)) THEN
	934	! WRITE (, ) ' iflag_ice_thermo==1 requires iflag_mix==0', ' but iflag_mix=', iflag_mix, &
	935	! '. Might as well stop here.'
	936	! STOP
	937	! END IF
[1992]	938	IF (iflag_mix>=1) THEN
[2853]	939	CALL zilch(supmax, nloc*nd)
[2638]	940	if (prt_level >= 9) &
	941	PRINT *, 'cva_driver -> cv3p_mixing'
[2007]	942	CALL cv3p_mixing(nloc, ncum, nd, nd, ntra, icb, nk, inb, & ! na->nd
[2397]	943	ph, t, q, qs, u, v, tra, h, lv, lf, frac, qnk, &
[2007]	944	unk, vnk, hp, tv, tvp, ep, clw, sig, &
	945	ment, qent, hent, uent, vent, nent, &
	946	sigij, elij, supmax, ments, qents, traent)
	947	! print*, 'cv3p_mixing-> supmax ', (supmax(1,k), k=1,nd)
[1992]	948
	949	ELSE
[2853]	950	CALL zilch(supmax, nloc*nd)
[1992]	951	END IF
	952	END IF
[2007]	953	! -------------------------------------------------------------------
	954	! --- CLOSURE
	955	! -------------------------------------------------------------------
[1992]	956
	957
	958	IF (iflag_con==3) THEN
	959	IF (iflag_clos==0) THEN
[2638]	960	if (prt_level >= 9) &
	961	PRINT *, 'cva_driver -> cv3_closure'
[2007]	962	CALL cv3_closure(nloc, ncum, nd, icb, inb, & ! na->nd
	963	pbase, p, ph, tv, buoy, &
	964	sig, w0, cape, m, iflag)
[2374]	965	END IF ! iflag_clos==0
[1992]	966
	967	ok_inhib = iflag_mix == 2
	968
	969	IF (iflag_clos==1) THEN
	970	PRINT *, ' pas d appel cv3p_closure'
[2007]	971	! c CALL cv3p_closure(nloc,ncum,nd,icb,inb ! na->nd
	972	! c : ,pbase,plcl,p,ph,tv,tvp,buoy
	973	! c : ,supmax
	974	! c o ,sig,w0,ptop2,cape,cin,m)
[2374]	975	END IF ! iflag_clos==1
	976
[1992]	977	IF (iflag_clos==2) THEN
[2638]	978	if (prt_level >= 9) &
	979	PRINT *, 'cva_driver -> cv3p1_closure'
[2007]	980	CALL cv3p1_closure(nloc, ncum, nd, icb, inb, & ! na->nd
	981	pbase, plcl, p, ph, tv, tvp, buoy, &
[2201]	982	supmax, ok_inhib, Ale, Alp, omega, &
[2007]	983	sig, w0, ptop2, cape, cin, m, iflag, coef_clos, &
	984	Plim1, plim2, asupmax, supmax0, &
	985	asupmaxmin, cbmf, plfc, wbeff)
[2079]	986	if (prt_level >= 10) &
	987	PRINT *, 'cv3p1_closure-> plfc,wbeff ', plfc(1), wbeff(1)
[2374]	988	END IF ! iflag_clos==2
[1992]	989
[2374]	990	IF (iflag_clos==3) THEN
[2638]	991	if (prt_level >= 9) &
	992	PRINT *, 'cva_driver -> cv3p2_closure'
[2374]	993	CALL cv3p2_closure(nloc, ncum, nd, icb, inb, & ! na->nd
	994	pbase, plcl, p, ph, tv, tvp, buoy, &
	995	supmax, ok_inhib, Ale, Alp, omega, &
	996	sig, w0, ptop2, cape, cin, m, iflag, coef_clos, &
	997	Plim1, plim2, asupmax, supmax0, &
	998	asupmaxmin, cbmf, plfc, wbeff)
	999	if (prt_level >= 10) &
	1000	PRINT *, 'cv3p2_closure-> plfc,wbeff ', plfc(1), wbeff(1)
	1001	END IF ! iflag_clos==3
	1002	END IF ! iflag_con==3
	1003
[1992]	1004	IF (iflag_con==4) THEN
[2638]	1005	if (prt_level >= 9) &
	1006	PRINT *, 'cva_driver -> cv_closure'
[2007]	1007	CALL cv_closure(nloc, ncum, nd, nk, icb, &
	1008	tv, tvp, p, ph, dph, plcl, cpn, &
	1009	iflag, cbmf)
[1992]	1010	END IF
	1011
[2007]	1012	! print *,'cv_closure-> cape ',cape(1)
[1992]	1013
[2007]	1014	! -------------------------------------------------------------------
	1015	! --- MIXING(2)
	1016	! -------------------------------------------------------------------
[1992]	1017
	1018	IF (iflag_con==3) THEN
	1019	IF (iflag_mix==0) THEN
[2638]	1020	if (prt_level >= 9) &
	1021	PRINT *, 'cva_driver -> cv3_mixing'
[2007]	1022	CALL cv3_mixing(nloc, ncum, nd, nd, ntra, icb, nk, inb, & ! na->nd
	1023	ph, t, q, qs, u, v, tra, h, lv, lf, frac, qnk, &
	1024	unk, vnk, hp, tv, tvp, ep, clw, m, sig, &
	1025	ment, qent, uent, vent, nent, sigij, elij, ments, qents, traent)
[2853]	1026	CALL zilch(hent, nlocndnd)
[1992]	1027	ELSE
	1028	CALL cv3_mixscale(nloc, ncum, nd, ment, m)
	1029	IF (debut) THEN
	1030	PRINT *, ' cv3_mixscale-> '
	1031	END IF !(debut) THEN
	1032	END IF
	1033	END IF
	1034
	1035	IF (iflag_con==4) THEN
[2638]	1036	if (prt_level >= 9) &
	1037	PRINT *, 'cva_driver -> cv_mixing'
[2007]	1038	CALL cv_mixing(nloc, ncum, nd, icb, nk, inb, inbis, &
	1039	ph, t, q, qs, u, v, h, lv, qnk, &
	1040	hp, tv, tvp, ep, clw, cbmf, &
	1041	m, ment, qent, uent, vent, nent, sigij, elij)
	1042	END IF
[1992]	1043
	1044	IF (debut) THEN
	1045	PRINT *, ' cv_mixing ->'
	1046	END IF !(debut) THEN
[2393]	1047	! do i = 1,nd
	1048	! print*,'cv_mixing-> i,ment ',i,(ment(1,i,j),j=1,nd)
[2007]	1049	! enddo
[1992]	1050
[2007]	1051	! -------------------------------------------------------------------
	1052	! --- UNSATURATED (PRECIPITATING) DOWNDRAFTS
	1053	! -------------------------------------------------------------------
[1992]	1054	IF (iflag_con==3) THEN
	1055	IF (debut) THEN
	1056	PRINT *, ' cva_driver -> cv3_unsat '
	1057	END IF !(debut) THEN
	1058
[2638]	1059	if (prt_level >= 9) &
	1060	PRINT *, 'cva_driver -> cv3_unsat'
[2007]	1061	CALL cv3_unsat(nloc, ncum, nd, nd, ntra, icb, inb, iflag, & ! na->nd
	1062	t_wake, q_wake, qs_wake, gz, u, v, tra, p, ph, &
	1063	th_wake, tv_wake, lv_wake, lf_wake, cpn_wake, &
	1064	ep, sigp, clw, &
	1065	m, ment, elij, delt, plcl, coef_clos, &
	1066	mp, qp, up, vp, trap, wt, water, evap, fondue, ice, &
	1067	faci, b, sigd, &
	1068	wdtrainA, wdtrainM) ! RomP
[2374]	1069	!
	1070	IF (prt_level >= 10) THEN
	1071	Print *, 'cva_driver after cv3_unsat:mp , water, ice, evap, fondue '
	1072	DO k = 1,nd
	1073	write (6, '(i4,5(1x,e13.6))'), &
[2654]	1074	k, mp(igout,k), water(igout,k), ice(igout,k), &
	1075	evap(igout,k), fondue(igout,k)
[2374]	1076	ENDDO
	1077	Print *, 'cva_driver after cv3_unsat: wdtrainA, wdtrainM '
	1078	DO k = 1,nd
	1079	write (6, '(i4,2(1x,e13.6))'), &
[2654]	1080	k, wdtrainA(igout,k), wdtrainM(igout,k)
[2374]	1081	ENDDO
	1082	ENDIF
	1083	!
	1084	END IF !(iflag_con==3)
[1992]	1085
	1086	IF (iflag_con==4) THEN
[2638]	1087	if (prt_level >= 9) &
	1088	PRINT *, 'cva_driver -> cv_unsat'
[2007]	1089	CALL cv_unsat(nloc, ncum, nd, inb, t, q, qs, gz, u, v, p, ph, &
	1090	h, lv, ep, sigp, clw, m, ment, elij, &
	1091	iflag, mp, qp, up, vp, wt, water, evap)
[1992]	1092	END IF
	1093
	1094	IF (debut) THEN
	1095	PRINT *, 'cv_unsat-> '
	1096	END IF !(debut) THEN
	1097
[2007]	1098	! print *,'cv_unsat-> mp ',mp
	1099	! print *,'cv_unsat-> water ',water
	1100	! -------------------------------------------------------------------
	1101	! --- YIELD
	1102	! (tendencies, precipitation, variables of interface with other
	1103	! processes, etc)
	1104	! -------------------------------------------------------------------
[1992]	1105
	1106	IF (iflag_con==3) THEN
	1107
[2638]	1108	if (prt_level >= 9) &
	1109	PRINT *, 'cva_driver -> cv3_yield'
[2007]	1110	CALL cv3_yield(nloc, ncum, nd, nd, ntra, ok_conserv_q, & ! na->nd
	1111	icb, inb, delt, &
	1112	t, q, t_wake, q_wake, s_wake, u, v, tra, &
	1113	gz, p, ph, h, hp, lv, lf, cpn, th, th_wake, &
	1114	ep, clw, m, tp, mp, qp, up, vp, trap, &
	1115	wt, water, ice, evap, fondue, faci, b, sigd, &
	1116	ment, qent, hent, iflag_mix, uent, vent, &
	1117	nent, elij, traent, sig, &
	1118	tv, tvp, wghti, &
[2306]	1119	iflag, precip, Vprecip, Vprecipi, ft, fq, fu, fv, ftra, & ! jyg
[2007]	1120	cbmf, upwd, dnwd, dnwd0, ma, mip, &
[2259]	1121	!! tls, tps, & ! useless . jyg
	1122	qcondc, wd, &
[2205]	1123	ftd, fqd, qnk, qtc, sigt, tau_cld_cv, coefw_cld_cv)
[2374]	1124	!
	1125	IF (debut) THEN
[2654]	1126	PRINT *, ' cv3_yield -> fqd(1) = ', fqd(igout, 1)
[2374]	1127	END IF !(debut) THEN
	1128	!
	1129	IF (prt_level >= 10) THEN
	1130	Print *, 'cva_driver after cv3_yield:ft(1) , ftd(1) ', &
[2654]	1131	ft(igout,1), ftd(igout,1)
[2374]	1132	Print *, 'cva_driver after cv3_yield:fq(1) , fqd(1) ', &
[2654]	1133	fq(igout,1), fqd(igout,1)
[2374]	1134	ENDIF
	1135	!
[1992]	1136	END IF
	1137
	1138	IF (iflag_con==4) THEN
[2638]	1139	if (prt_level >= 9) &
	1140	PRINT *, 'cva_driver -> cv_yield'
[2007]	1141	CALL cv_yield(nloc, ncum, nd, nk, icb, inb, delt, &
	1142	t, q, u, v, &
	1143	gz, p, ph, h, hp, lv, cpn, &
	1144	ep, clw, frac, m, mp, qp, up, vp, &
	1145	wt, water, evap, &
	1146	ment, qent, uent, vent, nent, elij, &
	1147	tv, tvp, &
	1148	iflag, wd, qprime, tprime, &
	1149	precip, cbmf, ft, fq, fu, fv, ma, qcondc)
[1992]	1150	END IF
	1151
[2007]	1152	!AC!
	1153	!^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
	1154	!--- passive tracers
	1155	!^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
[1992]	1156
	1157	IF (iflag_con==3) THEN
[2007]	1158	!RomP >>>
[2638]	1159	if (prt_level >= 9) &
	1160	PRINT *, 'cva_driver -> cv3_tracer'
[2007]	1161	CALL cv3_tracer(nloc, len, ncum, nd, nd, &
	1162	ment, sigij, da, phi, phi2, d1a, dam, &
	1163	ep, vprecip, elij, clw, epmlmMm, eplaMm, &
	1164	icb, inb)
	1165	!RomP <<<
[1992]	1166	END IF
	1167
[2007]	1168	!AC!
[1992]	1169
[2007]	1170	! ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
	1171	! --- UNCOMPRESS THE FIELDS
	1172	! ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
[1992]	1173
	1174
	1175	IF (iflag_con==3) THEN
[2638]	1176	if (prt_level >= 9) &
	1177	PRINT *, 'cva_driver -> cv3a_uncompress'
[2253]	1178	CALL cv3a_uncompress(nloc, len, ncum, nd, ntra, idcum, compress, &
[2007]	1179	iflag, icb, inb, &
	1180	precip, cbmf, plcl, plfc, wbeff, sig, w0, ptop2, &
	1181	ft, fq, fu, fv, ftra, &
[2306]	1182	sigd, ma, mip, vprecip, vprecipi, upwd, dnwd, dnwd0, &
[2007]	1183	qcondc, wd, cape, cin, &
	1184	tvp, &
	1185	ftd, fqd, &
	1186	Plim1, plim2, asupmax, supmax0, &
	1187	asupmaxmin, &
	1188	da, phi, mp, phi2, d1a, dam, sigij, & ! RomP
	1189	clw, elij, evap, ep, epmlmMm, eplaMm, & ! RomP
	1190	wdtrainA, wdtrainM, & ! RomP
[2481]	1191	qtc, sigt, epmax_diag, & ! epmax_cape
[2007]	1192	iflag1, kbas1, ktop1, &
	1193	precip1, cbmf1, plcl1, plfc1, wbeff1, sig1, w01, ptop21, &
	1194	ft1, fq1, fu1, fv1, ftra1, &
[2306]	1195	sigd1, ma1, mip1, vprecip1, vprecipi1, upwd1, dnwd1, dnwd01, &
[2007]	1196	qcondc1, wd1, cape1, cin1, &
	1197	tvp1, &
	1198	ftd1, fqd1, &
	1199	Plim11, plim21, asupmax1, supmax01, &
	1200	asupmaxmin1, &
	1201	da1, phi1, mp1, phi21, d1a1, dam1, sigij1, & ! RomP
	1202	clw1, elij1, evap1, ep1, epmlmMm1, eplaMm1, & ! RomP
[2207]	1203	wdtrainA1, wdtrainM1, & ! RomP
[2481]	1204	qtc1, sigt1, epmax_diag1) ! epmax_cape
[1992]	1205	END IF
	1206
	1207	IF (iflag_con==4) THEN
[2638]	1208	if (prt_level >= 9) &
	1209	PRINT *, 'cva_driver -> cv_uncompress'
[2007]	1210	CALL cv_uncompress(nloc, len, ncum, nd, idcum, &
	1211	iflag, &
	1212	precip, cbmf, &
	1213	ft, fq, fu, fv, &
	1214	ma, qcondc, &
	1215	iflag1, &
	1216	precip1,cbmf1, &
	1217	ft1, fq1, fu1, fv1, &
	1218	ma1, qcondc1)
[1992]	1219	END IF
	1220
	1221	END IF ! ncum>0
	1222
[2253]	1223	!
	1224	! In order take into account the possibility of changing the compression,
	1225	! reset m, sig and w0 to zero for non-convective points.
	1226	DO k = 1,nd-1
	1227	sig1(:, k) = sig1(:, k)*coef_convective(:)
	1228	w01(:, k) = w01(:, k)*coef_convective(:)
	1229	ENDDO
	1230
[1992]	1231	IF (debut) THEN
[2255]	1232	PRINT *, ' cv_uncompress -> '
[1992]	1233	debut = .FALSE.
[2007]	1234	END IF !(debut) THEN
[1992]	1235
[2007]	1236
[1992]	1237	RETURN
	1238	END SUBROUTINE cva_driver

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

Download in other formats:

Original Format