Context Navigation

cva_driver.f90 @ 5424

Last change on this file since 5424 was 5279, checked in by abarral, 2 months ago
fix: comma before i/o item
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: 52.1 KB

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

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

Download in other formats:

Original Format