Context Navigation

cva_driver.f90 @ 5523

Last change on this file since 5523 was 5491, checked in by jyg, 2 weeks ago

New outputs :

+ coef_clos = [conv mass flux given by Alp closure]/[conv mass flux given by Emanuel scheme closure]
+ coef_clos_eff = effective coefficient used in the convective scheme.

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.5 KB

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

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

Download in other formats:

Original Format