Context Navigation

cva_driver.F90 @ 2428

Last change on this file since 2428 was 2420, checked in by crio, 9 years ago
Nouvelle option d'epluchage de l'ascendance adiabatique dans le schema d'Emanuel: epluchage fonction de B/w2 au lieu de w. S'active avec iflag_mix_adiab=1 (valeur par defaut iflag_mix_adiab=0). Fonctionne avec iflag_mix=0 et iflag_mix=1. Correction de bugs dans le schema de convection pour le calcul de inb, cape et buoy (sous le meme flag pour l'instant). New option for the erosion of the adiabatic ascent in the Emanuel scheme: erosion function of B/w2 instead of w. Activated by iflag_mix_adiab=1 (standard value iflag_mix_adiab=0). Should work with iflag_mix=0 and iflag_mix=1. Various bug corrections in the convection scheme for the computation of inb, cape, buoy (protected by the same flag for now).
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.5 KB

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

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

Download in other formats:

Original Format