Context Navigation

cva_driver.F90 @ 2793

Last change on this file since 2793 was 2761, checked in by jyg, 8 years ago

Two options introduced concerning deep convection
and wakes:

+ deep convection is allowed only when top
temperature is lower than t_top_max.
(Default: t_top_max=1000.).
+ wake number per unit area may now be
different over ocean and over land:
wdens_ref_o and wdens_ref_l.
(Default is:wdens_ref_o=8.e-12,
wdens_ref_l=8.e-12)

Property copyright set to
Name of program: LMDZ
Creation date: 1984
Version: LMDZ5
License: CeCILL version 2
Holder: Laboratoire de m\'et\'eorologie dynamique, CNRS, UMR 8539
See the license file in the root directory
Property svn:eol-style set to native
Property svn:keywords set to Author Date Id Revision

File size: 49.2 KB

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

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

Download in other formats:

Original Format