Context Navigation

cva_driver.F90 @ 2668

Last change on this file since 2668 was 2654, checked in by jyg, 8 years ago
small bug in cva_driver.F90
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.1 KB

Line
1
2	! $Id: cva_driver.F90 2654 2016-10-07 10:51:08Z 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
356	! ft: Array of temperature tendency (K/s) of dimension ND, defined at same
357	! grid levels as T, Q, QS and P.
358
359	! fq: Array of specific humidity tendencies ((gm/gm)/s) of dimension ND,
360	! defined at same grid levels as T, Q, QS and P.
361
362	! fu: Array of forcing of zonal velocity (m/s^2) of dimension ND,
363	! defined at same grid levels as T.
364
365	! fv: Same as FU, but for forcing of meridional velocity.
366
367	! ftra: Array of forcing of tracer content, in tracer mixing ratio per
368	! second, defined at same levels as T. Dimensioned (ND,NTRA).
369
370	! precip: Scalar convective precipitation rate (mm/day).
371
372	! wd: A convective downdraft velocity scale. For use in surface
373	! flux parameterizations. See convect.ps file for details.
374
375	! tprime: A convective downdraft temperature perturbation scale (K).
376	! For use in surface flux parameterizations. See convect.ps
377	! file for details.
378
379	! qprime: A convective downdraft specific humidity
380	! perturbation scale (gm/gm).
381	! For use in surface flux parameterizations. See convect.ps
382	! file for details.
383
384	! cbmf: The cloud base mass flux ((kg/m**2)/s). THIS SCALAR VALUE MUST
385	! BE STORED BY THE CALLING PROGRAM AND RETURNED TO CONVECT AT
386	! ITS NEXT CALL. That is, the value of CBMF must be "remembered"
387	! by the calling program between calls to CONVECT.
388
389	! det: Array of detrainment mass flux of dimension ND.
390	! -------------------------------------------------------------------
391
392	! Local (non compressed) arrays
393
394
395	INTEGER i, k, n, il, j
396	INTEGER nword1, nword2, nword3, nword4
397	INTEGER icbmax
398	INTEGER nk1(klon)
399	INTEGER icb1(klon)
400	INTEGER icbs1(klon)
401
402	LOGICAL ok_inhib ! True => possible inhibition of convection by dryness
403	LOGICAL, SAVE :: debut = .TRUE.
404	!$OMP THREADPRIVATE(debut)
405
406	REAL coef_convective(len) ! = 1 for convective points, = 0 otherwise
407	REAL tnk1(klon)
408	REAL thnk1(klon)
409	REAL qnk1(klon)
410	REAL gznk1(klon)
411	REAL pnk1(klon)
412	REAL qsnk1(klon)
413	REAL unk1(klon)
414	REAL vnk1(klon)
415	REAL cpnk1(klon)
416	REAL hnk1(klon)
417	REAL pbase1(klon)
418	REAL buoybase1(klon)
419
420	REAL lf1(klon, klev), lf1_wake(klon, klev)
421	REAL lv1(klon, klev), lv1_wake(klon, klev)
422	REAL cpn1(klon, klev), cpn1_wake(klon, klev)
423	REAL tv1(klon, klev), tv1_wake(klon, klev)
424	REAL gz1(klon, klev), gz1_wake(klon, klev)
425	REAL hm1(klon, klev), hm1_wake(klon, klev)
426	REAL h1(klon, klev), h1_wake(klon, klev)
427	REAL tp1(klon, klev)
428	REAL th1(klon, klev), th1_wake(klon, klev)
429
430	REAL bid(klon, klev) ! dummy array
431
432	INTEGER ncum
433
434	INTEGER j1feed(klon)
435	INTEGER j2feed(klon)
436	REAL p1feed1(len) ! pressure at lower bound of feeding layer
437	REAL p2feed1(len) ! pressure at upper bound of feeding layer
438	!JYG,RL
439	!! real wghti1(len,nd) ! weights of the feeding layers
440	!JYG,RL
441
442	! (local) compressed fields:
443
444
445	INTEGER idcum(nloc)
446	!jyg<
447	LOGICAL compress ! True if compression occurs
448	!>jyg
449	INTEGER iflag(nloc), nk(nloc), icb(nloc)
450	INTEGER nent(nloc, klev)
451	INTEGER icbs(nloc)
452	INTEGER inb(nloc), inbis(nloc)
453
454	REAL cbmf(nloc), plcl(nloc), plfc(nloc), wbeff(nloc)
455	REAL t(nloc, klev), q(nloc, klev), qs(nloc, klev)
456	REAL t_wake(nloc, klev), q_wake(nloc, klev), qs_wake(nloc, klev)
457	REAL s_wake(nloc)
458	REAL u(nloc, klev), v(nloc, klev)
459	REAL gz(nloc, klev), h(nloc, klev), hm(nloc, klev)
460	REAL h_wake(nloc, klev), hm_wake(nloc, klev)
461	REAL lv(nloc, klev), lf(nloc, klev), cpn(nloc, klev)
462	REAL lv_wake(nloc, klev), lf_wake(nloc, klev), cpn_wake(nloc, klev)
463	REAL p(nloc, klev), ph(nloc, klev+1), tv(nloc, klev), tp(nloc, klev)
464	REAL tv_wake(nloc, klev)
465	REAL clw(nloc, klev)
466	REAL dph(nloc, klev)
467	REAL pbase(nloc), buoybase(nloc), th(nloc, klev)
468	REAL th_wake(nloc, klev)
469	REAL tvp(nloc, klev)
470	REAL sig(nloc, klev), w0(nloc, klev), ptop2(nloc)
471	REAL hp(nloc, klev), ep(nloc, klev), sigp(nloc, klev)
472	REAL buoy(nloc, klev)
473	REAL cape(nloc)
474	REAL cin(nloc)
475	REAL m(nloc, klev)
476	REAL ment(nloc, klev, klev), sigij(nloc, klev, klev)
477	REAL qent(nloc, klev, klev)
478	REAL hent(nloc, klev, klev)
479	REAL uent(nloc, klev, klev), vent(nloc, klev, klev)
480	REAL ments(nloc, klev, klev), qents(nloc, klev, klev)
481	REAL elij(nloc, klev, klev)
482	REAL supmax(nloc, klev)
483	REAL Ale(nloc), Alp(nloc), coef_clos(nloc)
484	REAL omega(nloc,klev)
485	REAL sigd(nloc)
486	! real mp(nloc,klev), qp(nloc,klev), up(nloc,klev), vp(nloc,klev)
487	! real wt(nloc,klev), water(nloc,klev), evap(nloc,klev), ice(nloc,klev)
488	! real b(nloc,klev), sigd(nloc)
489	! save mp,qp,up,vp,wt,water,evap,b
490	REAL, SAVE, ALLOCATABLE :: mp(:, :), qp(:, :), up(:, :), vp(:, :)
491	REAL, SAVE, ALLOCATABLE :: wt(:, :), water(:, :), evap(:, :)
492	REAL, SAVE, ALLOCATABLE :: ice(:, :), fondue(:, :), b(:, :)
493	REAL, SAVE, ALLOCATABLE :: frac(:, :), faci(:, :)
494	!$OMP THREADPRIVATE(mp,qp,up,vp,wt,water,evap,ice,fondue,b,frac,faci)
495	REAL ft(nloc, klev), fq(nloc, klev)
496	REAL ftd(nloc, klev), fqd(nloc, klev)
497	REAL fu(nloc, klev), fv(nloc, klev)
498	REAL upwd(nloc, klev), dnwd(nloc, klev), dnwd0(nloc, klev)
499	REAL ma(nloc, klev), mip(nloc, klev)
500	!! REAL tls(nloc, klev), tps(nloc, klev) ! unused . jyg
501	REAL qprime(nloc), tprime(nloc)
502	REAL precip(nloc)
503	! real Vprecip(nloc,klev)
504	REAL vprecip(nloc, klev+1)
505	REAL vprecipi(nloc, klev+1)
506	REAL tra(nloc, klev, ntra), trap(nloc, klev, ntra)
507	REAL ftra(nloc, klev, ntra), traent(nloc, klev, klev, ntra)
508	REAL qcondc(nloc, klev) ! cld
509	REAL wd(nloc) ! gust
510	REAL Plim1(nloc), plim2(nloc)
511	REAL asupmax(nloc, klev)
512	REAL supmax0(nloc)
513	REAL asupmaxmin(nloc)
514
515	REAL tnk(nloc), qnk(nloc), gznk(nloc)
516	REAL wghti(nloc, nd)
517	REAL hnk(nloc), unk(nloc), vnk(nloc)
518
519	REAL qtc(nloc, klev) ! cld
520	REAL sigt(nloc, klev) ! cld
521
522	! RomP >>>
523	REAL wdtrainA(nloc, klev), wdtrainM(nloc, klev)
524	REAL da(len, nd), phi(len, nd, nd)
525	REAL epmlmMm(nloc, klev, klev), eplaMm(nloc, klev)
526	REAL phi2(len, nd, nd)
527	REAL d1a(len, nd), dam(len, nd)
528	! RomP <<<
529	REAL epmax_diag(nloc) ! epmax_cape
530
531	LOGICAL, SAVE :: first = .TRUE.
532	!$OMP THREADPRIVATE(first)
533	CHARACTER (LEN=20) :: modname = 'cva_driver'
534	CHARACTER (LEN=80) :: abort_message
535
536	INTEGER,SAVE :: igout=1
537	!$OMP THREADPRIVATE(igout)
538
539
540	! print *, 't1, t1_wake ',(k,t1(1,k),t1_wake(1,k),k=1,klev)
541	! print *, 'q1, q1_wake ',(k,q1(1,k),q1_wake(1,k),k=1,klev)
542
543	! -------------------------------------------------------------------
544	! --- SET CONSTANTS AND PARAMETERS
545	! -------------------------------------------------------------------
546
547	IF (first) THEN
548	ALLOCATE (mp(nloc,klev), qp(nloc,klev), up(nloc,klev))
549	ALLOCATE (vp(nloc,klev), wt(nloc,klev), water(nloc,klev))
550	ALLOCATE (ice(nloc,klev), fondue(nloc,klev))
551	ALLOCATE (evap(nloc,klev), b(nloc,klev))
552	ALLOCATE (frac(nloc,klev), faci(nloc,klev))
553	first = .FALSE.
554	END IF
555	! -- set simulation flags:
556	! (common cvflag)
557
558	CALL cv_flag(iflag_ice_thermo)
559
560	! -- set thermodynamical constants:
561	! (common cvthermo)
562
563	CALL cv_thermo(iflag_con)
564
565	! -- set convect parameters
566
567	! includes microphysical parameters and parameters that
568	! control the rate of approach to quasi-equilibrium)
569	! (common cvparam)
570
571	IF (iflag_con==3) THEN
572	CALL cv3_param(nd, k_upper, delt)
573
574	END IF
575
576	IF (iflag_con==4) THEN
577	CALL cv_param(nd)
578	END IF
579
580	! ---------------------------------------------------------------------
581	! --- INITIALIZE OUTPUT ARRAYS AND PARAMETERS
582	! ---------------------------------------------------------------------
583	nword1 = len
584	nword2 = len*nd
585	nword3 = lenndntra
586	nword4 = lenndnd
587
588	iflag1(:) = 0
589	ktop1(:) = 0
590	kbas1(:) = 0
591	ft1(:, :) = 0.0
592	fq1(:, :) = 0.0
593	fu1(:, :) = 0.0
594	fv1(:, :) = 0.0
595	ftra1(:, :, :) = 0.
596	precip1(:) = 0.
597	cbmf1(:) = 0.
598	plcl1(:) = 0.
599	plfc1(:) = 0.
600	wbeff1(:) = 0.
601	ptop21(:) = 0.
602	sigd1(:) = 0.
603	ma1(:, :) = 0.
604	mip1(:, :) = 0.
605	vprecip1(:, :) = 0.
606	vprecipi1(:, :) = 0.
607	upwd1(:, :) = 0.
608	dnwd1(:, :) = 0.
609	dnwd01(:, :) = 0.
610	qcondc1(:, :) = 0.
611	wd1(:) = 0.
612	cape1(:) = 0.
613	cin1(:) = 0.
614	tvp1(:, :) = 0.
615	ftd1(:, :) = 0.
616	fqd1(:, :) = 0.
617	Plim11(:) = 0.
618	Plim21(:) = 0.
619	asupmax1(:, :) = 0.
620	supmax01(:) = 0.
621	asupmaxmin1(:) = 0.
622
623	DO il = 1, len
624	cin1(il) = -100000.
625	cape1(il) = -1.
626	END DO
627
628	!! IF (iflag_con==3) THEN
629	!! DO il = 1, len
630	!! sig1(il, nd) = sig1(il, nd) + 1.
631	!! sig1(il, nd) = amin1(sig1(il,nd), 12.1)
632	!! END DO
633	!! END IF
634
635	IF (iflag_con==3) THEN
636	CALL cv3_incrcount(len,nd,delt,sig1)
637	END IF ! (iflag_con==3)
638
639	! RomP >>>
640	sigt1(:, :) = 0.
641	qtc1(:, :) = 0.
642	wdtrainA1(:, :) = 0.
643	wdtrainM1(:, :) = 0.
644	da1(:, :) = 0.
645	phi1(:, :, :) = 0.
646	epmlmMm1(:, :, :) = 0.
647	eplaMm1(:, :) = 0.
648	mp1(:, :) = 0.
649	evap1(:, :) = 0.
650	ep1(:, :) = 0.
651	sigij1(:, :, :) = 0.
652	elij1(:, :, :) = 0.
653	clw1(:,:) = 0.
654	wghti1(:,:) = 0.
655	phi21(:, :, :) = 0.
656	d1a1(:, :) = 0.
657	dam1(:, :) = 0.
658	! RomP <<<
659	! ---------------------------------------------------------------------
660	! --- INITIALIZE LOCAL ARRAYS AND PARAMETERS
661	! ---------------------------------------------------------------------
662
663	DO il = 1, nloc
664	coef_clos(il) = 1.
665	END DO
666
667	! --------------------------------------------------------------------
668	! --- CALCULATE ARRAYS OF GEOPOTENTIAL, HEAT CAPACITY & STATIC ENERGY
669	! --------------------------------------------------------------------
670
671	IF (iflag_con==3) THEN
672
673	IF (debut) THEN
674	PRINT *, 'Emanuel version 3 nouvelle'
675	END IF
676	! print*,'t1, q1 ',t1,q1
677	if (prt_level >= 9) &
678	PRINT *, 'cva_driver -> cv3_prelim'
679	CALL cv3_prelim(len, nd, ndp1, t1, q1, p1, ph1, & ! nd->na
680	lv1, lf1, cpn1, tv1, gz1, h1, hm1, th1)
681
682
683	if (prt_level >= 9) &
684	PRINT *, 'cva_driver -> cv3_prelim'
685	CALL cv3_prelim(len, nd, ndp1, t1_wake, q1_wake, p1, ph1, & ! nd->na
686	lv1_wake, lf1_wake, cpn1_wake, tv1_wake, gz1_wake, &
687	h1_wake, bid, th1_wake)
688
689	END IF
690
691	IF (iflag_con==4) THEN
692	PRINT *, 'Emanuel version 4 '
693	if (prt_level >= 9) &
694	PRINT *, 'cva_driver -> cv_prelim'
695	CALL cv_prelim(len, nd, ndp1, t1, q1, p1, ph1, &
696	lv1, cpn1, tv1, gz1, h1, hm1)
697	END IF
698
699	! --------------------------------------------------------------------
700	! --- CONVECTIVE FEED
701	! --------------------------------------------------------------------
702
703	! compute feeding layer potential temperature and mixing ratio :
704
705	! get bounds of feeding layer
706
707	! test niveaux couche alimentation KE
708	IF (sig1feed1==sig2feed1) THEN
709	WRITE (lunout, *) 'impossible de choisir sig1feed=sig2feed'
710	WRITE (lunout, *) 'changer la valeur de sig2feed dans physiq.def'
711	abort_message = ''
712	CALL abort_physic(modname, abort_message, 1)
713	END IF
714
715	DO i = 1, len
716	p1feed1(i) = sig1feed1*ph1(i, 1)
717	p2feed1(i) = sig2feed1*ph1(i, 1)
718	!test maf
719	! p1feed1(i)=ph1(i,1)
720	! p2feed1(i)=ph1(i,2)
721	! p2feed1(i)=ph1(i,3)
722	!testCR: on prend la couche alim des thermiques
723	! p2feed1(i)=ph1(i,lalim_conv1(i)+1)
724	! print*,'lentr=',lentr(i),ph1(i,lentr(i)+1),ph1(i,2)
725	END DO
726
727	IF (iflag_con==3) THEN
728	END IF
729	DO i = 1, len
730	! print*,'avant cv3_feed Plim',p1feed1(i),p2feed1(i)
731	END DO
732	IF (iflag_con==3) THEN
733
734	! print*, 'IFLAG1 avant cv3_feed'
735	! print*,'len,nd',len,nd
736	! write(*,'(64i1)') iflag1(2:klon-1)
737
738	if (prt_level >= 9) &
739	PRINT *, 'cva_driver -> cv3_feed'
740	CALL cv3_feed(len, nd, ok_conserv_q, & ! nd->na
741	t1, q1, u1, v1, p1, ph1, hm1, gz1, &
742	p1feed1, p2feed1, wght1, &
743	wghti1, tnk1, thnk1, qnk1, qsnk1, unk1, vnk1, &
744	cpnk1, hnk1, nk1, icb1, icbmax, iflag1, gznk1, plcl1)
745	END IF
746
747	! print*, 'IFLAG1 apres cv3_feed'
748	! print*,'len,nd',len,nd
749	! write(*,'(64i1)') iflag1(2:klon-1)
750
751	IF (iflag_con==4) THEN
752	if (prt_level >= 9) &
753	PRINT *, 'cva_driver -> cv_feed'
754	CALL cv_feed(len, nd, t1, q1, qs1, p1, hm1, gz1, &
755	nk1, icb1, icbmax, iflag1, tnk1, qnk1, gznk1, plcl1)
756	END IF
757
758	! print *, 'cv3_feed-> iflag1, plcl1 ',iflag1(1),plcl1(1)
759
760	! --------------------------------------------------------------------
761	! --- UNDILUTE (ADIABATIC) UPDRAFT / 1st part
762	! (up through ICB for convect4, up through ICB+1 for convect3)
763	! Calculates the lifted parcel virtual temperature at nk, the
764	! actual temperature, and the adiabatic liquid water content.
765	! --------------------------------------------------------------------
766
767	IF (iflag_con==3) THEN
768
769	if (prt_level >= 9) &
770	PRINT *, 'cva_driver -> cv3_undilute1'
771	CALL cv3_undilute1(len, nd, t1, qs1, gz1, plcl1, p1, icb1, tnk1, qnk1, & ! nd->na
772	gznk1, tp1, tvp1, clw1, icbs1)
773	END IF
774
775
776	IF (iflag_con==4) THEN
777	if (prt_level >= 9) &
778	PRINT *, 'cva_driver -> cv_undilute1'
779	CALL cv_undilute1(len, nd, t1, q1, qs1, gz1, p1, nk1, icb1, icbmax, &
780	tp1, tvp1, clw1)
781	END IF
782
783	! -------------------------------------------------------------------
784	! --- TRIGGERING
785	! -------------------------------------------------------------------
786
787	! print *,' avant triggering, iflag_con ',iflag_con
788
789	IF (iflag_con==3) THEN
790
791	if (prt_level >= 9) &
792	PRINT *, 'cva_driver -> cv3_trigger'
793	CALL cv3_trigger(len, nd, icb1, plcl1, p1, th1, tv1, tvp1, thnk1, & ! nd->na
794	pbase1, buoybase1, iflag1, sig1, w01)
795
796
797	! print*, 'IFLAG1 apres cv3_triger'
798	! print*,'len,nd',len,nd
799	! write(*,'(64i1)') iflag1(2:klon-1)
800
801	! call dump2d(iim,jjm-1,sig1(2)
802	END IF
803
804	IF (iflag_con==4) THEN
805	if (prt_level >= 9) &
806	PRINT *, 'cva_driver -> cv_trigger'
807	CALL cv_trigger(len, nd, icb1, cbmf1, tv1, tvp1, iflag1)
808	END IF
809
810
811	! =====================================================================
812	! --- IF THIS POINT IS REACHED, MOIST CONVECTIVE ADJUSTMENT IS NECESSARY
813	! =====================================================================
814
815	! Determine the number "ncum" of convective gridpoints, the list "idcum" of convective
816	! gridpoints and the weights "coef_convective" (= 1. for convective gridpoints and = 0.
817	! elsewhere).
818	ncum = 0
819	coef_convective(:) = 0.
820	DO i = 1, len
821	IF (iflag1(i)==0) THEN
822	coef_convective(i) = 1.
823	ncum = ncum + 1
824	idcum(ncum) = i
825	END IF
826	END DO
827
828	! print*,'klon, ncum = ',len,ncum
829
830	IF (ncum>0) THEN
831
832	! ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
833	! --- COMPRESS THE FIELDS
834	! (-> vectorization over convective gridpoints)
835	! ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
836
837	IF (iflag_con==3) THEN
838	! print*,'ncum tv1 ',ncum,tv1
839	! print*,'tvp1 ',tvp1
840	!jyg<
841	! If the fraction of convective points is larger than comp_threshold, then compression
842	! is assumed useless.
843	!
844	compress = ncum .lt. len*comp_threshold
845	!
846	IF (.not. compress) THEN
847	DO i = 1,len
848	idcum(i) = i
849	ENDDO
850	ENDIF
851	!
852	!>jyg
853	if (prt_level >= 9) &
854	PRINT *, 'cva_driver -> cv3a_compress'
855	CALL cv3a_compress(len, nloc, ncum, nd, ntra, compress, &
856	iflag1, nk1, icb1, icbs1, &
857	plcl1, tnk1, qnk1, gznk1, hnk1, unk1, vnk1, &
858	wghti1, pbase1, buoybase1, &
859	t1, q1, qs1, t1_wake, q1_wake, qs1_wake, s1_wake, &
860	u1, v1, gz1, th1, th1_wake, &
861	tra1, &
862	h1, lv1, lf1, cpn1, p1, ph1, tv1, tp1, tvp1, clw1, &
863	h1_wake, lv1_wake, lf1_wake, cpn1_wake, tv1_wake, &
864	sig1, w01, ptop21, &
865	Ale1, Alp1, omega1, &
866	iflag, nk, icb, icbs, &
867	plcl, tnk, qnk, gznk, hnk, unk, vnk, &
868	wghti, pbase, buoybase, &
869	t, q, qs, t_wake, q_wake, qs_wake, s_wake, &
870	u, v, gz, th, th_wake, &
871	tra, &
872	h, lv, lf, cpn, p, ph, tv, tp, tvp, clw, &
873	h_wake, lv_wake, lf_wake, cpn_wake, tv_wake, &
874	sig, w0, ptop2, &
875	Ale, Alp, omega)
876
877	! print*,'tv ',tv
878	! print*,'tvp ',tvp
879
880	END IF
881
882	IF (iflag_con==4) THEN
883	if (prt_level >= 9) &
884	PRINT *, 'cva_driver -> cv_compress'
885	CALL cv_compress(len, nloc, ncum, nd, &
886	iflag1, nk1, icb1, &
887	cbmf1, plcl1, tnk1, qnk1, gznk1, &
888	t1, q1, qs1, u1, v1, gz1, &
889	h1, lv1, cpn1, p1, ph1, tv1, tp1, tvp1, clw1, &
890	iflag, nk, icb, &
891	cbmf, plcl, tnk, qnk, gznk, &
892	t, q, qs, u, v, gz, h, lv, cpn, p, ph, tv, tp, tvp, clw, &
893	dph)
894	END IF
895
896	! -------------------------------------------------------------------
897	! --- UNDILUTE (ADIABATIC) UPDRAFT / second part :
898	! --- FIND THE REST OF THE LIFTED PARCEL TEMPERATURES
899	! --- &
900	! --- COMPUTE THE PRECIPITATION EFFICIENCIES AND THE
901	! --- FRACTION OF PRECIPITATION FALLING OUTSIDE OF CLOUD
902	! --- &
903	! --- FIND THE LEVEL OF NEUTRAL BUOYANCY
904	! -------------------------------------------------------------------
905
906	IF (iflag_con==3) THEN
907	if (prt_level >= 9) &
908	PRINT *, 'cva_driver -> cv3_undilute2'
909	CALL cv3_undilute2(nloc, ncum, nd, icb, icbs, nk, & !na->nd
910	tnk, qnk, gznk, hnk, t, q, qs, gz, &
911	p, ph, h, tv, lv, lf, pbase, buoybase, plcl, &
912	inb, tp, tvp, clw, hp, ep, sigp, buoy, &
913	frac)
914	END IF
915
916	IF (iflag_con==4) THEN
917	if (prt_level >= 9) &
918	PRINT *, 'cva_driver -> cv_undilute2'
919	CALL cv_undilute2(nloc, ncum, nd, icb, nk, &
920	tnk, qnk, gznk, t, q, qs, gz, &
921	p, dph, h, tv, lv, &
922	inb, inbis, tp, tvp, clw, hp, ep, sigp, frac)
923	END IF
924
925	! epmax_cape
926	! on recalcule ep et hp
927	if (prt_level >= 9) &
928	PRINT *, 'cva_driver -> cv3_epmax_cape'
929	call cv3_epmax_fn_cape(nloc,ncum,nd &
930	, ep,hp,icb,inb,clw,nk,t,h,hnk,lv,lf,frac &
931	, pbase, p, ph, tv, buoy, sig, w0,iflag &
932	, epmax_diag)
933
934	! -------------------------------------------------------------------
935	! --- MIXING(1) (if iflag_mix .ge. 1)
936	! -------------------------------------------------------------------
937	IF (iflag_con==3) THEN
938	! IF ((iflag_ice_thermo==1) .AND. (iflag_mix/=0)) THEN
939	! WRITE (, ) ' iflag_ice_thermo==1 requires iflag_mix==0', ' but iflag_mix=', iflag_mix, &
940	! '. Might as well stop here.'
941	! STOP
942	! END IF
943	IF (iflag_mix>=1) THEN
944	CALL zilch(supmax, nloc*klev)
945	if (prt_level >= 9) &
946	PRINT *, 'cva_driver -> cv3p_mixing'
947	CALL cv3p_mixing(nloc, ncum, nd, nd, ntra, icb, nk, inb, & ! na->nd
948	ph, t, q, qs, u, v, tra, h, lv, lf, frac, qnk, &
949	unk, vnk, hp, tv, tvp, ep, clw, sig, &
950	ment, qent, hent, uent, vent, nent, &
951	sigij, elij, supmax, ments, qents, traent)
952	! print*, 'cv3p_mixing-> supmax ', (supmax(1,k), k=1,nd)
953
954	ELSE
955	CALL zilch(supmax, nloc*klev)
956	END IF
957	END IF
958	! -------------------------------------------------------------------
959	! --- CLOSURE
960	! -------------------------------------------------------------------
961
962
963	IF (iflag_con==3) THEN
964	IF (iflag_clos==0) THEN
965	if (prt_level >= 9) &
966	PRINT *, 'cva_driver -> cv3_closure'
967	CALL cv3_closure(nloc, ncum, nd, icb, inb, & ! na->nd
968	pbase, p, ph, tv, buoy, &
969	sig, w0, cape, m, iflag)
970	END IF ! iflag_clos==0
971
972	ok_inhib = iflag_mix == 2
973
974	IF (iflag_clos==1) THEN
975	PRINT *, ' pas d appel cv3p_closure'
976	! c CALL cv3p_closure(nloc,ncum,nd,icb,inb ! na->nd
977	! c : ,pbase,plcl,p,ph,tv,tvp,buoy
978	! c : ,supmax
979	! c o ,sig,w0,ptop2,cape,cin,m)
980	END IF ! iflag_clos==1
981
982	IF (iflag_clos==2) THEN
983	if (prt_level >= 9) &
984	PRINT *, 'cva_driver -> cv3p1_closure'
985	CALL cv3p1_closure(nloc, ncum, nd, icb, inb, & ! na->nd
986	pbase, plcl, p, ph, tv, tvp, buoy, &
987	supmax, ok_inhib, Ale, Alp, omega, &
988	sig, w0, ptop2, cape, cin, m, iflag, coef_clos, &
989	Plim1, plim2, asupmax, supmax0, &
990	asupmaxmin, cbmf, plfc, wbeff)
991	if (prt_level >= 10) &
992	PRINT *, 'cv3p1_closure-> plfc,wbeff ', plfc(1), wbeff(1)
993	END IF ! iflag_clos==2
994
995	IF (iflag_clos==3) THEN
996	if (prt_level >= 9) &
997	PRINT *, 'cva_driver -> cv3p2_closure'
998	CALL cv3p2_closure(nloc, ncum, nd, icb, inb, & ! na->nd
999	pbase, plcl, p, ph, tv, tvp, buoy, &
1000	supmax, ok_inhib, Ale, Alp, omega, &
1001	sig, w0, ptop2, cape, cin, m, iflag, coef_clos, &
1002	Plim1, plim2, asupmax, supmax0, &
1003	asupmaxmin, cbmf, plfc, wbeff)
1004	if (prt_level >= 10) &
1005	PRINT *, 'cv3p2_closure-> plfc,wbeff ', plfc(1), wbeff(1)
1006	END IF ! iflag_clos==3
1007	END IF ! iflag_con==3
1008
1009	IF (iflag_con==4) THEN
1010	if (prt_level >= 9) &
1011	PRINT *, 'cva_driver -> cv_closure'
1012	CALL cv_closure(nloc, ncum, nd, nk, icb, &
1013	tv, tvp, p, ph, dph, plcl, cpn, &
1014	iflag, cbmf)
1015	END IF
1016
1017	! print *,'cv_closure-> cape ',cape(1)
1018
1019	! -------------------------------------------------------------------
1020	! --- MIXING(2)
1021	! -------------------------------------------------------------------
1022
1023	IF (iflag_con==3) THEN
1024	IF (iflag_mix==0) THEN
1025	if (prt_level >= 9) &
1026	PRINT *, 'cva_driver -> cv3_mixing'
1027	CALL cv3_mixing(nloc, ncum, nd, nd, ntra, icb, nk, inb, & ! na->nd
1028	ph, t, q, qs, u, v, tra, h, lv, lf, frac, qnk, &
1029	unk, vnk, hp, tv, tvp, ep, clw, m, sig, &
1030	ment, qent, uent, vent, nent, sigij, elij, ments, qents, traent)
1031	CALL zilch(hent, nlocklevklev)
1032	ELSE
1033	CALL cv3_mixscale(nloc, ncum, nd, ment, m)
1034	IF (debut) THEN
1035	PRINT *, ' cv3_mixscale-> '
1036	END IF !(debut) THEN
1037	END IF
1038	END IF
1039
1040	IF (iflag_con==4) THEN
1041	if (prt_level >= 9) &
1042	PRINT *, 'cva_driver -> cv_mixing'
1043	CALL cv_mixing(nloc, ncum, nd, icb, nk, inb, inbis, &
1044	ph, t, q, qs, u, v, h, lv, qnk, &
1045	hp, tv, tvp, ep, clw, cbmf, &
1046	m, ment, qent, uent, vent, nent, sigij, elij)
1047	END IF
1048
1049	IF (debut) THEN
1050	PRINT *, ' cv_mixing ->'
1051	END IF !(debut) THEN
1052	! do i = 1,nd
1053	! print*,'cv_mixing-> i,ment ',i,(ment(1,i,j),j=1,nd)
1054	! enddo
1055
1056	! -------------------------------------------------------------------
1057	! --- UNSATURATED (PRECIPITATING) DOWNDRAFTS
1058	! -------------------------------------------------------------------
1059	IF (iflag_con==3) THEN
1060	IF (debut) THEN
1061	PRINT *, ' cva_driver -> cv3_unsat '
1062	END IF !(debut) THEN
1063
1064	if (prt_level >= 9) &
1065	PRINT *, 'cva_driver -> cv3_unsat'
1066	CALL cv3_unsat(nloc, ncum, nd, nd, ntra, icb, inb, iflag, & ! na->nd
1067	t_wake, q_wake, qs_wake, gz, u, v, tra, p, ph, &
1068	th_wake, tv_wake, lv_wake, lf_wake, cpn_wake, &
1069	ep, sigp, clw, &
1070	m, ment, elij, delt, plcl, coef_clos, &
1071	mp, qp, up, vp, trap, wt, water, evap, fondue, ice, &
1072	faci, b, sigd, &
1073	wdtrainA, wdtrainM) ! RomP
1074	!
1075	IF (prt_level >= 10) THEN
1076	Print *, 'cva_driver after cv3_unsat:mp , water, ice, evap, fondue '
1077	DO k = 1,nd
1078	write (6, '(i4,5(1x,e13.6))'), &
1079	k, mp(igout,k), water(igout,k), ice(igout,k), &
1080	evap(igout,k), fondue(igout,k)
1081	ENDDO
1082	Print *, 'cva_driver after cv3_unsat: wdtrainA, wdtrainM '
1083	DO k = 1,nd
1084	write (6, '(i4,2(1x,e13.6))'), &
1085	k, wdtrainA(igout,k), wdtrainM(igout,k)
1086	ENDDO
1087	ENDIF
1088	!
1089	END IF !(iflag_con==3)
1090
1091	IF (iflag_con==4) THEN
1092	if (prt_level >= 9) &
1093	PRINT *, 'cva_driver -> cv_unsat'
1094	CALL cv_unsat(nloc, ncum, nd, inb, t, q, qs, gz, u, v, p, ph, &
1095	h, lv, ep, sigp, clw, m, ment, elij, &
1096	iflag, mp, qp, up, vp, wt, water, evap)
1097	END IF
1098
1099	IF (debut) THEN
1100	PRINT *, 'cv_unsat-> '
1101	END IF !(debut) THEN
1102
1103	! print *,'cv_unsat-> mp ',mp
1104	! print *,'cv_unsat-> water ',water
1105	! -------------------------------------------------------------------
1106	! --- YIELD
1107	! (tendencies, precipitation, variables of interface with other
1108	! processes, etc)
1109	! -------------------------------------------------------------------
1110
1111	IF (iflag_con==3) THEN
1112
1113	if (prt_level >= 9) &
1114	PRINT *, 'cva_driver -> cv3_yield'
1115	CALL cv3_yield(nloc, ncum, nd, nd, ntra, ok_conserv_q, & ! na->nd
1116	icb, inb, delt, &
1117	t, q, t_wake, q_wake, s_wake, u, v, tra, &
1118	gz, p, ph, h, hp, lv, lf, cpn, th, th_wake, &
1119	ep, clw, m, tp, mp, qp, up, vp, trap, &
1120	wt, water, ice, evap, fondue, faci, b, sigd, &
1121	ment, qent, hent, iflag_mix, uent, vent, &
1122	nent, elij, traent, sig, &
1123	tv, tvp, wghti, &
1124	iflag, precip, Vprecip, Vprecipi, ft, fq, fu, fv, ftra, & ! jyg
1125	cbmf, upwd, dnwd, dnwd0, ma, mip, &
1126	!! tls, tps, & ! useless . jyg
1127	qcondc, wd, &
1128	ftd, fqd, qnk, qtc, sigt, tau_cld_cv, coefw_cld_cv)
1129	!
1130	IF (debut) THEN
1131	PRINT *, ' cv3_yield -> fqd(1) = ', fqd(igout, 1)
1132	END IF !(debut) THEN
1133	!
1134	IF (prt_level >= 10) THEN
1135	Print *, 'cva_driver after cv3_yield:ft(1) , ftd(1) ', &
1136	ft(igout,1), ftd(igout,1)
1137	Print *, 'cva_driver after cv3_yield:fq(1) , fqd(1) ', &
1138	fq(igout,1), fqd(igout,1)
1139	ENDIF
1140	!
1141	END IF
1142
1143	IF (iflag_con==4) THEN
1144	if (prt_level >= 9) &
1145	PRINT *, 'cva_driver -> cv_yield'
1146	CALL cv_yield(nloc, ncum, nd, nk, icb, inb, delt, &
1147	t, q, u, v, &
1148	gz, p, ph, h, hp, lv, cpn, &
1149	ep, clw, frac, m, mp, qp, up, vp, &
1150	wt, water, evap, &
1151	ment, qent, uent, vent, nent, elij, &
1152	tv, tvp, &
1153	iflag, wd, qprime, tprime, &
1154	precip, cbmf, ft, fq, fu, fv, ma, qcondc)
1155	END IF
1156
1157	!AC!
1158	!^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
1159	!--- passive tracers
1160	!^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
1161
1162	IF (iflag_con==3) THEN
1163	!RomP >>>
1164	if (prt_level >= 9) &
1165	PRINT *, 'cva_driver -> cv3_tracer'
1166	CALL cv3_tracer(nloc, len, ncum, nd, nd, &
1167	ment, sigij, da, phi, phi2, d1a, dam, &
1168	ep, vprecip, elij, clw, epmlmMm, eplaMm, &
1169	icb, inb)
1170	!RomP <<<
1171	END IF
1172
1173	!AC!
1174
1175	! ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
1176	! --- UNCOMPRESS THE FIELDS
1177	! ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
1178
1179
1180	IF (iflag_con==3) THEN
1181	if (prt_level >= 9) &
1182	PRINT *, 'cva_driver -> cv3a_uncompress'
1183	CALL cv3a_uncompress(nloc, len, ncum, nd, ntra, idcum, compress, &
1184	iflag, icb, inb, &
1185	precip, cbmf, plcl, plfc, wbeff, sig, w0, ptop2, &
1186	ft, fq, fu, fv, ftra, &
1187	sigd, ma, mip, vprecip, vprecipi, upwd, dnwd, dnwd0, &
1188	qcondc, wd, cape, cin, &
1189	tvp, &
1190	ftd, fqd, &
1191	Plim1, plim2, asupmax, supmax0, &
1192	asupmaxmin, &
1193	da, phi, mp, phi2, d1a, dam, sigij, & ! RomP
1194	clw, elij, evap, ep, epmlmMm, eplaMm, & ! RomP
1195	wdtrainA, wdtrainM, & ! RomP
1196	qtc, sigt, epmax_diag, & ! epmax_cape
1197	iflag1, kbas1, ktop1, &
1198	precip1, cbmf1, plcl1, plfc1, wbeff1, sig1, w01, ptop21, &
1199	ft1, fq1, fu1, fv1, ftra1, &
1200	sigd1, ma1, mip1, vprecip1, vprecipi1, upwd1, dnwd1, dnwd01, &
1201	qcondc1, wd1, cape1, cin1, &
1202	tvp1, &
1203	ftd1, fqd1, &
1204	Plim11, plim21, asupmax1, supmax01, &
1205	asupmaxmin1, &
1206	da1, phi1, mp1, phi21, d1a1, dam1, sigij1, & ! RomP
1207	clw1, elij1, evap1, ep1, epmlmMm1, eplaMm1, & ! RomP
1208	wdtrainA1, wdtrainM1, & ! RomP
1209	qtc1, sigt1, epmax_diag1) ! epmax_cape
1210	END IF
1211
1212	IF (iflag_con==4) THEN
1213	if (prt_level >= 9) &
1214	PRINT *, 'cva_driver -> cv_uncompress'
1215	CALL cv_uncompress(nloc, len, ncum, nd, idcum, &
1216	iflag, &
1217	precip, cbmf, &
1218	ft, fq, fu, fv, &
1219	ma, qcondc, &
1220	iflag1, &
1221	precip1,cbmf1, &
1222	ft1, fq1, fu1, fv1, &
1223	ma1, qcondc1)
1224	END IF
1225
1226	END IF ! ncum>0
1227
1228	!
1229	! In order take into account the possibility of changing the compression,
1230	! reset m, sig and w0 to zero for non-convective points.
1231	DO k = 1,nd-1
1232	sig1(:, k) = sig1(:, k)*coef_convective(:)
1233	w01(:, k) = w01(:, k)*coef_convective(:)
1234	ENDDO
1235
1236	IF (debut) THEN
1237	PRINT *, ' cv_uncompress -> '
1238	debut = .FALSE.
1239	END IF !(debut) THEN
1240
1241
1242	RETURN
1243	END SUBROUTINE cva_driver

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

Download in other formats:

Original Format