Context Navigation

cva_driver.F90 @ 2450

Last change on this file since 2450 was 2420, checked in by crio, 9 years ago
Nouvelle option d'epluchage de l'ascendance adiabatique dans le schema d'Emanuel: epluchage fonction de B/w2 au lieu de w. S'active avec iflag_mix_adiab=1 (valeur par defaut iflag_mix_adiab=0). Fonctionne avec iflag_mix=0 et iflag_mix=1. Correction de bugs dans le schema de convection pour le calcul de inb, cape et buoy (sous le meme flag pour l'instant). New option for the erosion of the adiabatic ascent in the Emanuel scheme: erosion function of B/w2 instead of w. Activated by iflag_mix_adiab=1 (standard value iflag_mix_adiab=0). Should work with iflag_mix=0 and iflag_mix=1. Various bug corrections in the convection scheme for the computation of inb, cape, buoy (protected by the same flag for now).
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: 46.5 KB

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

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

Download in other formats:

Original Format