Context Navigation

cva_driver.F90 @ 2492

Last change on this file since 2492 was 2481, checked in by fhourdin, 9 years ago
Introduction d'une dependance epmax=f(Cape) sur proposition de Camille Risi
Property copyright set to Name of program: LMDZ Creation date: 1984 Version: LMDZ5 License: CeCILL version 2 Holder: Laboratoire de m\'et\'eorologie dynamique, CNRS, UMR 8539 See the license file in the root directory Property svn:eol-style set to `native` Property svn:keywords set to `Author Date Id Revision`
File size: 46.9 KB

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

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

Download in other formats:

Original Format