Context Navigation

cva_driver.F90 @ 2306

Last change on this file since 2306 was 2306, checked in by jyg, 9 years ago
Improved diagnostics: pmflxr and pmflxs are now the true vertical profiles of liquid and solid convective precipitation (previously they where merely diagnosed through a test on temperature). The convective scheme internal variable for ice precipitation is Vprecipi.
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: 44.7 KB

Line
1
2	! $Id: cva_driver.F90 2306 2015-06-23 09:33:09Z jyg $
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	IMPLICIT NONE
42
43	! .............................START PROLOGUE............................
44
45
46	! All argument names (except len,nd,ntra,nloc,delt and the flags) have a "1" appended.
47	! The "1" is removed for the corresponding compressed variables.
48	! PARAMETERS:
49	! Name Type Usage Description
50	! ---------- ---------- ------- ----------------------------
51
52	! len Integer Input first (i) dimension
53	! nd Integer Input vertical (k) dimension
54	! ndp1 Integer Input nd + 1
55	! ntra Integer Input number of tracors
56	! nloc Integer Input dimension of arrays for compressed fields
57	! k_upper Integer Input upmost level for vertical loops
58	! iflag_con Integer Input version of convect (3/4)
59	! iflag_mix Integer Input version of mixing (0/1/2)
60	! iflag_ice_thermo Integer Input accounting for ice thermodynamics (0/1)
61	! iflag_clos Integer Input version of closure (0/1)
62	! tau_cld_cv Real Input characteristic time of dissipation of mixing fluxes
63	! coefw_cld_cv Real Input coefficient for updraft velocity in convection
64	! ok_conserv_q Logical Input when true corrections for water conservation are swtiched on
65	! delt Real Input time step
66	! comp_threshold Real Input threshold on the fraction of convective points below which
67	! fields are compressed
68	! t1 Real Input temperature (sat draught envt)
69	! q1 Real Input specific hum (sat draught envt)
70	! qs1 Real Input sat specific hum (sat draught envt)
71	! t1_wake Real Input temperature (unsat draught envt)
72	! q1_wake Real Input specific hum(unsat draught envt)
73	! qs1_wake Real Input sat specific hum(unsat draughts envt)
74	! s1_wake Real Input fractionnal area covered by wakes
75	! u1 Real Input u-wind
76	! v1 Real Input v-wind
77	! tra1 Real Input tracors
78	! p1 Real Input full level pressure
79	! ph1 Real Input half level pressure
80	! ALE1 Real Input Available lifting Energy
81	! ALP1 Real Input Available lifting Power
82	! sig1feed1 Real Input sigma coord at lower bound of feeding layer
83	! sig2feed1 Real Input sigma coord at upper bound of feeding layer
84	! wght1 Real Input weight density determining the feeding mixture
85	! iflag1 Integer Output flag for Emanuel conditions
86	! ft1 Real Output temp tend
87	! fq1 Real Output spec hum tend
88	! fu1 Real Output u-wind tend
89	! fv1 Real Output v-wind tend
90	! ftra1 Real Output tracor tend
91	! precip1 Real Output precipitation
92	! kbas1 Integer Output cloud base level
93	! ktop1 Integer Output cloud top level
94	! cbmf1 Real Output cloud base mass flux
95	! sig1 Real In/Out section adiabatic updraft
96	! w01 Real In/Out vertical velocity within adiab updraft
97	! ptop21 Real In/Out top of entraining zone
98	! Ma1 Real Output mass flux adiabatic updraft
99	! mip1 Real Output mass flux shed by the adiabatic updraft
100	! Vprecip1 Real Output vertical profile of total precipitation
101	! Vprecipi1 Real Output vertical profile of ice precipitation
102	! upwd1 Real Output total upward mass flux (adiab+mixed)
103	! dnwd1 Real Output saturated downward mass flux (mixed)
104	! dnwd01 Real Output unsaturated downward mass flux
105	! qcondc1 Real Output in-cld mixing ratio of condensed water
106	! wd1 Real Output downdraft velocity scale for sfc fluxes
107	! cape1 Real Output CAPE
108	! cin1 Real Output CIN
109	! tvp1 Real Output adiab lifted parcell virt temp
110	! ftd1 Real Output precip temp tend
111	! fqt1 Real Output precip spec hum tend
112	! Plim11 Real Output
113	! Plim21 Real Output
114	! asupmax1 Real Output
115	! supmax01 Real Output
116	! asupmaxmin1 Real Output
117
118	! ftd1 Real Output Array of temperature tendency due to precipitations (K/s) of dimension ND,
119	! defined at same grid levels as T, Q, QS and P.
120
121	! fqd1 Real Output Array of specific humidity tendencies due to precipitations ((gm/gm)/s)
122	! of dimension ND, defined at same grid levels as T, Q, QS and P.
123
124	! wdtrainA1 Real Output precipitation detrained from adiabatic draught;
125	! used in tracer transport (cvltr)
126	! wdtrainM1 Real Output precipitation detrained from mixed draughts;
127	! used in tracer transport (cvltr)
128	! da1 Real Output used in tracer transport (cvltr)
129	! phi1 Real Output used in tracer transport (cvltr)
130	! mp1 Real Output used in tracer transport (cvltr)
131	! qtc1 Real Output specific humidity in convection
132	! sigt1 Real Output surface fraction in adiabatic updrafts
133	! phi21 Real Output used in tracer transport (cvltr)
134
135	! d1a1 Real Output used in tracer transport (cvltr)
136	! dam1 Real Output used in tracer transport (cvltr)
137
138	! epmlmMm1 Real Output used in tracer transport (cvltr)
139	! eplaMm1 Real Output used in tracer transport (cvltr)
140
141	! evap1 Real Output
142	! ep1 Real Output
143	! sigij1 Real Output used in tracer transport (cvltr)
144	! elij1 Real Output
145	! wghti1 Real Output final weight of the feeding layers,
146	! used in tracer transport (cvltr)
147
148
149	! S. Bony, Mar 2002:
150	! * Several modules corresponding to different physical processes
151	! * Several versions of convect may be used:
152	! - iflag_con=3: version lmd (previously named convect3)
153	! - iflag_con=4: version 4.3b (vect. version, previously convect1/2)
154	! + tard: - iflag_con=5: version lmd with ice (previously named convectg)
155	! S. Bony, Oct 2002:
156	! * Vectorization of convect3 (ie version lmd)
157
158	! ..............................END PROLOGUE.............................
159
160
161	include "dimensions.h"
162	!!!!!#include "dimphy.h"
163	include 'iniprint.h'
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	!JYG,RL
258	REAL, DIMENSION (len, nd), INTENT (OUT) :: wghti1 ! final weight of the feeding layers
259	!JYG,RL
260	REAL, DIMENSION (len, nd, nd), INTENT (OUT) :: phi21
261	REAL, DIMENSION (len, nd), INTENT (OUT) :: d1a1, dam1
262	! RomP <<<
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
529	LOGICAL, SAVE :: first = .TRUE.
530	!$OMP THREADPRIVATE(first)
531	CHARACTER (LEN=20) :: modname = 'cva_driver'
532	CHARACTER (LEN=80) :: abort_message
533
534
535	! print *, 't1, t1_wake ',(k,t1(1,k),t1_wake(1,k),k=1,klev)
536	! print *, 'q1, q1_wake ',(k,q1(1,k),q1_wake(1,k),k=1,klev)
537
538	! -------------------------------------------------------------------
539	! --- SET CONSTANTS AND PARAMETERS
540	! -------------------------------------------------------------------
541
542	IF (first) THEN
543	ALLOCATE (mp(nloc,klev), qp(nloc,klev), up(nloc,klev))
544	ALLOCATE (vp(nloc,klev), wt(nloc,klev), water(nloc,klev))
545	ALLOCATE (ice(nloc,klev), fondue(nloc,klev))
546	ALLOCATE (evap(nloc,klev), b(nloc,klev))
547	ALLOCATE (frac(nloc,klev), faci(nloc,klev))
548	first = .FALSE.
549	END IF
550	! -- set simulation flags:
551	! (common cvflag)
552
553	CALL cv_flag(iflag_ice_thermo)
554
555	! -- set thermodynamical constants:
556	! (common cvthermo)
557
558	CALL cv_thermo(iflag_con)
559
560	! -- set convect parameters
561
562	! includes microphysical parameters and parameters that
563	! control the rate of approach to quasi-equilibrium)
564	! (common cvparam)
565
566	IF (iflag_con==3) THEN
567	CALL cv3_param(nd, k_upper, delt)
568
569	END IF
570
571	IF (iflag_con==4) THEN
572	CALL cv_param(nd)
573	END IF
574
575	! ---------------------------------------------------------------------
576	! --- INITIALIZE OUTPUT ARRAYS AND PARAMETERS
577	! ---------------------------------------------------------------------
578	nword1 = len
579	nword2 = len*nd
580	nword3 = lenndntra
581	nword4 = lenndnd
582
583	iflag1(:) = 0
584	ktop1(:) = 0
585	kbas1(:) = 0
586	ft1(:, :) = 0.0
587	fq1(:, :) = 0.0
588	fu1(:, :) = 0.0
589	fv1(:, :) = 0.0
590	ftra1(:, :, :) = 0.
591	precip1(:) = 0.
592	cbmf1(:) = 0.
593	ptop21(:) = 0.
594	sigd1(:) = 0.
595	ma1(:, :) = 0.
596	mip1(:, :) = 0.
597	vprecip1(:, :) = 0.
598	vprecipi1(:, :) = 0.
599	upwd1(:, :) = 0.
600	dnwd1(:, :) = 0.
601	dnwd01(:, :) = 0.
602	qcondc1(:, :) = 0.
603	wd1(:) = 0.
604	cape1(:) = 0.
605	cin1(:) = 0.
606	tvp1(:, :) = 0.
607	ftd1(:, :) = 0.
608	fqd1(:, :) = 0.
609	Plim11(:) = 0.
610	Plim21(:) = 0.
611	asupmax1(:, :) = 0.
612	supmax01(:) = 0.
613	asupmaxmin1(:) = 0.
614
615	DO il = 1, len
616	cin1(il) = -100000.
617	cape1(il) = -1.
618	END DO
619
620	IF (iflag_con==3) THEN
621	DO il = 1, len
622	sig1(il, nd) = sig1(il, nd) + 1.
623	sig1(il, nd) = amin1(sig1(il,nd), 12.1)
624	END DO
625	END IF
626
627	! RomP >>>
628	sigt1(:, :) = 0.
629	qtc1(:, :) = 0.
630	wdtrainA1(:, :) = 0.
631	wdtrainM1(:, :) = 0.
632	da1(:, :) = 0.
633	phi1(:, :, :) = 0.
634	epmlmMm1(:, :, :) = 0.
635	eplaMm1(:, :) = 0.
636	mp1(:, :) = 0.
637	evap1(:, :) = 0.
638	ep1(:, :) = 0.
639	sigij1(:, :, :) = 0.
640	elij1(:, :, :) = 0.
641	phi21(:, :, :) = 0.
642	d1a1(:, :) = 0.
643	dam1(:, :) = 0.
644	! RomP <<<
645	! ---------------------------------------------------------------------
646	! --- INITIALIZE LOCAL ARRAYS AND PARAMETERS
647	! ---------------------------------------------------------------------
648
649	DO il = 1, nloc
650	coef_clos(il) = 1.
651	END DO
652
653	! --------------------------------------------------------------------
654	! --- CALCULATE ARRAYS OF GEOPOTENTIAL, HEAT CAPACITY & STATIC ENERGY
655	! --------------------------------------------------------------------
656
657	IF (iflag_con==3) THEN
658
659	IF (debut) THEN
660	PRINT *, 'Emanuel version 3 nouvelle'
661	END IF
662	! print*,'t1, q1 ',t1,q1
663	CALL cv3_prelim(len, nd, ndp1, t1, q1, p1, ph1, & ! nd->na
664	lv1, lf1, cpn1, tv1, gz1, h1, hm1, th1)
665
666
667	CALL cv3_prelim(len, nd, ndp1, t1_wake, q1_wake, p1, ph1, & ! nd->na
668	lv1_wake, lf1_wake, cpn1_wake, tv1_wake, gz1_wake, &
669	h1_wake, bid, th1_wake)
670
671	END IF
672
673	IF (iflag_con==4) THEN
674	PRINT *, 'Emanuel version 4 '
675	CALL cv_prelim(len, nd, ndp1, t1, q1, p1, ph1, &
676	lv1, cpn1, tv1, gz1, h1, hm1)
677	END IF
678
679	! --------------------------------------------------------------------
680	! --- CONVECTIVE FEED
681	! --------------------------------------------------------------------
682
683	! compute feeding layer potential temperature and mixing ratio :
684
685	! get bounds of feeding layer
686
687	! test niveaux couche alimentation KE
688	IF (sig1feed1==sig2feed1) THEN
689	WRITE (lunout, *) 'impossible de choisir sig1feed=sig2feed'
690	WRITE (lunout, *) 'changer la valeur de sig2feed dans physiq.def'
691	abort_message = ''
692	CALL abort_gcm(modname, abort_message, 1)
693	END IF
694
695	DO i = 1, len
696	p1feed1(i) = sig1feed1*ph1(i, 1)
697	p2feed1(i) = sig2feed1*ph1(i, 1)
698	!test maf
699	! p1feed1(i)=ph1(i,1)
700	! p2feed1(i)=ph1(i,2)
701	! p2feed1(i)=ph1(i,3)
702	!testCR: on prend la couche alim des thermiques
703	! p2feed1(i)=ph1(i,lalim_conv1(i)+1)
704	! print*,'lentr=',lentr(i),ph1(i,lentr(i)+1),ph1(i,2)
705	END DO
706
707	IF (iflag_con==3) THEN
708	END IF
709	DO i = 1, len
710	! print*,'avant cv3_feed Plim',p1feed1(i),p2feed1(i)
711	END DO
712	IF (iflag_con==3) THEN
713
714	! print*, 'IFLAG1 avant cv3_feed'
715	! print*,'len,nd',len,nd
716	! write(*,'(64i1)') iflag1(2:klon-1)
717
718	CALL cv3_feed(len, nd, ok_conserv_q, & ! nd->na
719	t1, q1, u1, v1, p1, ph1, hm1, gz1, &
720	p1feed1, p2feed1, wght1, &
721	wghti1, tnk1, thnk1, qnk1, qsnk1, unk1, vnk1, &
722	cpnk1, hnk1, nk1, icb1, icbmax, iflag1, gznk1, plcl1)
723	END IF
724
725	! print*, 'IFLAG1 apres cv3_feed'
726	! print*,'len,nd',len,nd
727	! write(*,'(64i1)') iflag1(2:klon-1)
728
729	IF (iflag_con==4) THEN
730	CALL cv_feed(len, nd, t1, q1, qs1, p1, hm1, gz1, &
731	nk1, icb1, icbmax, iflag1, tnk1, qnk1, gznk1, plcl1)
732	END IF
733
734	! print *, 'cv3_feed-> iflag1, plcl1 ',iflag1(1),plcl1(1)
735
736	! --------------------------------------------------------------------
737	! --- UNDILUTE (ADIABATIC) UPDRAFT / 1st part
738	! (up through ICB for convect4, up through ICB+1 for convect3)
739	! Calculates the lifted parcel virtual temperature at nk, the
740	! actual temperature, and the adiabatic liquid water content.
741	! --------------------------------------------------------------------
742
743	IF (iflag_con==3) THEN
744
745	CALL cv3_undilute1(len, nd, t1, qs1, gz1, plcl1, p1, icb1, tnk1, qnk1, & ! nd->na
746	gznk1, tp1, tvp1, clw1, icbs1)
747	END IF
748
749
750	IF (iflag_con==4) THEN
751	CALL cv_undilute1(len, nd, t1, q1, qs1, gz1, p1, nk1, icb1, icbmax, &
752	tp1, tvp1, clw1)
753	END IF
754
755	! -------------------------------------------------------------------
756	! --- TRIGGERING
757	! -------------------------------------------------------------------
758
759	! print *,' avant triggering, iflag_con ',iflag_con
760
761	IF (iflag_con==3) THEN
762
763	CALL cv3_trigger(len, nd, icb1, plcl1, p1, th1, tv1, tvp1, thnk1, & ! nd->na
764	pbase1, buoybase1, iflag1, sig1, w01)
765
766
767	! print*, 'IFLAG1 apres cv3_triger'
768	! print*,'len,nd',len,nd
769	! write(*,'(64i1)') iflag1(2:klon-1)
770
771	! call dump2d(iim,jjm-1,sig1(2)
772	END IF
773
774	IF (iflag_con==4) THEN
775	CALL cv_trigger(len, nd, icb1, cbmf1, tv1, tvp1, iflag1)
776	END IF
777
778
779	! =====================================================================
780	! --- IF THIS POINT IS REACHED, MOIST CONVECTIVE ADJUSTMENT IS NECESSARY
781	! =====================================================================
782
783	! Determine the number "ncum" of convective gridpoints, the list "idcum" of convective
784	! gridpoints and the weights "coef_convective" (= 1. for convective gridpoints and = 0.
785	! elsewhere).
786	ncum = 0
787	coef_convective(:) = 0.
788	DO i = 1, len
789	IF (iflag1(i)==0) THEN
790	coef_convective(i) = 1.
791	ncum = ncum + 1
792	idcum(ncum) = i
793	END IF
794	END DO
795
796	! print*,'klon, ncum = ',len,ncum
797
798	IF (ncum>0) THEN
799
800	! ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
801	! --- COMPRESS THE FIELDS
802	! (-> vectorization over convective gridpoints)
803	! ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
804
805	IF (iflag_con==3) THEN
806	! print*,'ncum tv1 ',ncum,tv1
807	! print*,'tvp1 ',tvp1
808	!jyg<
809	! If the fraction of convective points is larger than comp_threshold, then compression
810	! is assumed useless.
811	!
812	compress = ncum .lt. len*comp_threshold
813	!
814	IF (.not. compress) THEN
815	DO i = 1,len
816	idcum(i) = i
817	ENDDO
818	ENDIF
819	!
820	!>jyg
821	CALL cv3a_compress(len, nloc, ncum, nd, ntra, compress, &
822	iflag1, nk1, icb1, icbs1, &
823	plcl1, tnk1, qnk1, gznk1, hnk1, unk1, vnk1, &
824	wghti1, pbase1, buoybase1, &
825	t1, q1, qs1, t1_wake, q1_wake, qs1_wake, s1_wake, &
826	u1, v1, gz1, th1, th1_wake, &
827	tra1, &
828	h1, lv1, lf1, cpn1, p1, ph1, tv1, tp1, tvp1, clw1, &
829	h1_wake, lv1_wake, lf1_wake, cpn1_wake, tv1_wake, &
830	sig1, w01, ptop21, &
831	Ale1, Alp1, omega1, &
832	iflag, nk, icb, icbs, &
833	plcl, tnk, qnk, gznk, hnk, unk, vnk, &
834	wghti, pbase, buoybase, &
835	t, q, qs, t_wake, q_wake, qs_wake, s_wake, &
836	u, v, gz, th, th_wake, &
837	tra, &
838	h, lv, lf, cpn, p, ph, tv, tp, tvp, clw, &
839	h_wake, lv_wake, lf_wake, cpn_wake, tv_wake, &
840	sig, w0, ptop2, &
841	Ale, Alp, omega)
842
843	! print*,'tv ',tv
844	! print*,'tvp ',tvp
845
846	END IF
847
848	IF (iflag_con==4) THEN
849	CALL cv_compress(len, nloc, ncum, nd, &
850	iflag1, nk1, icb1, &
851	cbmf1, plcl1, tnk1, qnk1, gznk1, &
852	t1, q1, qs1, u1, v1, gz1, &
853	h1, lv1, cpn1, p1, ph1, tv1, tp1, tvp1, clw1, &
854	iflag, nk, icb, &
855	cbmf, plcl, tnk, qnk, gznk, &
856	t, q, qs, u, v, gz, h, lv, cpn, p, ph, tv, tp, tvp, clw, &
857	dph)
858	END IF
859
860	! -------------------------------------------------------------------
861	! --- UNDILUTE (ADIABATIC) UPDRAFT / second part :
862	! --- FIND THE REST OF THE LIFTED PARCEL TEMPERATURES
863	! --- &
864	! --- COMPUTE THE PRECIPITATION EFFICIENCIES AND THE
865	! --- FRACTION OF PRECIPITATION FALLING OUTSIDE OF CLOUD
866	! --- &
867	! --- FIND THE LEVEL OF NEUTRAL BUOYANCY
868	! -------------------------------------------------------------------
869
870	IF (iflag_con==3) THEN
871	CALL cv3_undilute2(nloc, ncum, nd, icb, icbs, nk, & !na->nd
872	tnk, qnk, gznk, hnk, t, q, qs, gz, &
873	p, h, tv, lv, lf, pbase, buoybase, plcl, &
874	inb, tp, tvp, clw, hp, ep, sigp, buoy, &
875	frac)
876	END IF
877
878	IF (iflag_con==4) THEN
879	CALL cv_undilute2(nloc, ncum, nd, icb, nk, &
880	tnk, qnk, gznk, t, q, qs, gz, &
881	p, dph, h, tv, lv, &
882	inb, inbis, tp, tvp, clw, hp, ep, sigp, frac)
883	END IF
884
885	! -------------------------------------------------------------------
886	! --- MIXING(1) (if iflag_mix .ge. 1)
887	! -------------------------------------------------------------------
888	IF (iflag_con==3) THEN
889	IF ((iflag_ice_thermo==1) .AND. (iflag_mix/=0)) THEN
890	WRITE (, ) ' iflag_ice_thermo==1 requires iflag_mix==0', ' but iflag_mix=', iflag_mix, &
891	'. Might as well stop here.'
892	STOP
893	END IF
894	IF (iflag_mix>=1) THEN
895	CALL zilch(supmax, nloc*klev)
896	CALL cv3p_mixing(nloc, ncum, nd, nd, ntra, icb, nk, inb, & ! na->nd
897	ph, t, q, qs, u, v, tra, h, lv, qnk, &
898	unk, vnk, hp, tv, tvp, ep, clw, sig, &
899	ment, qent, hent, uent, vent, nent, &
900	sigij, elij, supmax, ments, qents, traent)
901	! print*, 'cv3p_mixing-> supmax ', (supmax(1,k), k=1,nd)
902
903	ELSE
904	CALL zilch(supmax, nloc*klev)
905	END IF
906	END IF
907	! -------------------------------------------------------------------
908	! --- CLOSURE
909	! -------------------------------------------------------------------
910
911
912	IF (iflag_con==3) THEN
913	IF (iflag_clos==0) THEN
914	CALL cv3_closure(nloc, ncum, nd, icb, inb, & ! na->nd
915	pbase, p, ph, tv, buoy, &
916	sig, w0, cape, m, iflag)
917	END IF
918
919	ok_inhib = iflag_mix == 2
920
921	IF (iflag_clos==1) THEN
922	PRINT *, ' pas d appel cv3p_closure'
923	! c CALL cv3p_closure(nloc,ncum,nd,icb,inb ! na->nd
924	! c : ,pbase,plcl,p,ph,tv,tvp,buoy
925	! c : ,supmax
926	! c o ,sig,w0,ptop2,cape,cin,m)
927	END IF
928	IF (iflag_clos==2) THEN
929	CALL cv3p1_closure(nloc, ncum, nd, icb, inb, & ! na->nd
930	pbase, plcl, p, ph, tv, tvp, buoy, &
931	supmax, ok_inhib, Ale, Alp, omega, &
932	sig, w0, ptop2, cape, cin, m, iflag, coef_clos, &
933	Plim1, plim2, asupmax, supmax0, &
934	asupmaxmin, cbmf, plfc, wbeff)
935	if (prt_level >= 10) &
936	PRINT *, 'cv3p1_closure-> plfc,wbeff ', plfc(1), wbeff(1)
937	END IF
938	END IF ! iflag_con.eq.3
939
940	IF (iflag_con==4) THEN
941	CALL cv_closure(nloc, ncum, nd, nk, icb, &
942	tv, tvp, p, ph, dph, plcl, cpn, &
943	iflag, cbmf)
944	END IF
945
946	! print *,'cv_closure-> cape ',cape(1)
947
948	! -------------------------------------------------------------------
949	! --- MIXING(2)
950	! -------------------------------------------------------------------
951
952	IF (iflag_con==3) THEN
953	IF (iflag_mix==0) THEN
954	CALL cv3_mixing(nloc, ncum, nd, nd, ntra, icb, nk, inb, & ! na->nd
955	ph, t, q, qs, u, v, tra, h, lv, lf, frac, qnk, &
956	unk, vnk, hp, tv, tvp, ep, clw, m, sig, &
957	ment, qent, uent, vent, nent, sigij, elij, ments, qents, traent)
958	CALL zilch(hent, nlocklevklev)
959	ELSE
960	CALL cv3_mixscale(nloc, ncum, nd, ment, m)
961	IF (debut) THEN
962	PRINT *, ' cv3_mixscale-> '
963	END IF !(debut) THEN
964	END IF
965	END IF
966
967	IF (iflag_con==4) THEN
968	CALL cv_mixing(nloc, ncum, nd, icb, nk, inb, inbis, &
969	ph, t, q, qs, u, v, h, lv, qnk, &
970	hp, tv, tvp, ep, clw, cbmf, &
971	m, ment, qent, uent, vent, nent, sigij, elij)
972	END IF
973
974	IF (debut) THEN
975	PRINT *, ' cv_mixing ->'
976	END IF !(debut) THEN
977	! do i = 1,klev
978	! print*,'cv_mixing-> i,ment ',i,(ment(1,i,j),j=1,klev)
979	! enddo
980
981	! -------------------------------------------------------------------
982	! --- UNSATURATED (PRECIPITATING) DOWNDRAFTS
983	! -------------------------------------------------------------------
984	IF (iflag_con==3) THEN
985	IF (debut) THEN
986	PRINT *, ' cva_driver -> cv3_unsat '
987	END IF !(debut) THEN
988
989	CALL cv3_unsat(nloc, ncum, nd, nd, ntra, icb, inb, iflag, & ! na->nd
990	t_wake, q_wake, qs_wake, gz, u, v, tra, p, ph, &
991	th_wake, tv_wake, lv_wake, lf_wake, cpn_wake, &
992	ep, sigp, clw, &
993	m, ment, elij, delt, plcl, coef_clos, &
994	mp, qp, up, vp, trap, wt, water, evap, fondue, ice, &
995	faci, b, sigd, &
996	wdtrainA, wdtrainM) ! RomP
997	END IF
998
999	IF (iflag_con==4) THEN
1000	CALL cv_unsat(nloc, ncum, nd, inb, t, q, qs, gz, u, v, p, ph, &
1001	h, lv, ep, sigp, clw, m, ment, elij, &
1002	iflag, mp, qp, up, vp, wt, water, evap)
1003	END IF
1004
1005	IF (debut) THEN
1006	PRINT *, 'cv_unsat-> '
1007	END IF !(debut) THEN
1008
1009	! print *,'cv_unsat-> mp ',mp
1010	! print *,'cv_unsat-> water ',water
1011	! -------------------------------------------------------------------
1012	! --- YIELD
1013	! (tendencies, precipitation, variables of interface with other
1014	! processes, etc)
1015	! -------------------------------------------------------------------
1016
1017	IF (iflag_con==3) THEN
1018
1019	CALL cv3_yield(nloc, ncum, nd, nd, ntra, ok_conserv_q, & ! na->nd
1020	icb, inb, delt, &
1021	t, q, t_wake, q_wake, s_wake, u, v, tra, &
1022	gz, p, ph, h, hp, lv, lf, cpn, th, th_wake, &
1023	ep, clw, m, tp, mp, qp, up, vp, trap, &
1024	wt, water, ice, evap, fondue, faci, b, sigd, &
1025	ment, qent, hent, iflag_mix, uent, vent, &
1026	nent, elij, traent, sig, &
1027	tv, tvp, wghti, &
1028	iflag, precip, Vprecip, Vprecipi, ft, fq, fu, fv, ftra, & ! jyg
1029	cbmf, upwd, dnwd, dnwd0, ma, mip, &
1030	!! tls, tps, & ! useless . jyg
1031	qcondc, wd, &
1032	ftd, fqd, qnk, qtc, sigt, tau_cld_cv, coefw_cld_cv)
1033	END IF
1034
1035	IF (debut) THEN
1036	PRINT *, ' cv3_yield -> fqd(1) = ', fqd(1, 1)
1037	END IF !(debut) THEN
1038
1039	IF (iflag_con==4) THEN
1040	CALL cv_yield(nloc, ncum, nd, nk, icb, inb, delt, &
1041	t, q, u, v, &
1042	gz, p, ph, h, hp, lv, cpn, &
1043	ep, clw, frac, m, mp, qp, up, vp, &
1044	wt, water, evap, &
1045	ment, qent, uent, vent, nent, elij, &
1046	tv, tvp, &
1047	iflag, wd, qprime, tprime, &
1048	precip, cbmf, ft, fq, fu, fv, ma, qcondc)
1049	END IF
1050
1051	!AC!
1052	!^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
1053	!--- passive tracers
1054	!^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
1055
1056	IF (iflag_con==3) THEN
1057	!RomP >>>
1058	CALL cv3_tracer(nloc, len, ncum, nd, nd, &
1059	ment, sigij, da, phi, phi2, d1a, dam, &
1060	ep, vprecip, elij, clw, epmlmMm, eplaMm, &
1061	icb, inb)
1062	!RomP <<<
1063	END IF
1064
1065	!AC!
1066
1067	! ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
1068	! --- UNCOMPRESS THE FIELDS
1069	! ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
1070
1071
1072	IF (iflag_con==3) THEN
1073	CALL cv3a_uncompress(nloc, len, ncum, nd, ntra, idcum, compress, &
1074	iflag, icb, inb, &
1075	precip, cbmf, plcl, plfc, wbeff, sig, w0, ptop2, &
1076	ft, fq, fu, fv, ftra, &
1077	sigd, ma, mip, vprecip, vprecipi, upwd, dnwd, dnwd0, &
1078	qcondc, wd, cape, cin, &
1079	tvp, &
1080	ftd, fqd, &
1081	Plim1, plim2, asupmax, supmax0, &
1082	asupmaxmin, &
1083	da, phi, mp, phi2, d1a, dam, sigij, & ! RomP
1084	clw, elij, evap, ep, epmlmMm, eplaMm, & ! RomP
1085	wdtrainA, wdtrainM, & ! RomP
1086	qtc, sigt, &
1087	iflag1, kbas1, ktop1, &
1088	precip1, cbmf1, plcl1, plfc1, wbeff1, sig1, w01, ptop21, &
1089	ft1, fq1, fu1, fv1, ftra1, &
1090	sigd1, ma1, mip1, vprecip1, vprecipi1, upwd1, dnwd1, dnwd01, &
1091	qcondc1, wd1, cape1, cin1, &
1092	tvp1, &
1093	ftd1, fqd1, &
1094	Plim11, plim21, asupmax1, supmax01, &
1095	asupmaxmin1, &
1096	da1, phi1, mp1, phi21, d1a1, dam1, sigij1, & ! RomP
1097	clw1, elij1, evap1, ep1, epmlmMm1, eplaMm1, & ! RomP
1098	wdtrainA1, wdtrainM1, & ! RomP
1099	qtc1, sigt1)
1100	END IF
1101
1102	IF (iflag_con==4) THEN
1103	CALL cv_uncompress(nloc, len, ncum, nd, idcum, &
1104	iflag, &
1105	precip, cbmf, &
1106	ft, fq, fu, fv, &
1107	ma, qcondc, &
1108	iflag1, &
1109	precip1,cbmf1, &
1110	ft1, fq1, fu1, fv1, &
1111	ma1, qcondc1)
1112	END IF
1113
1114	END IF ! ncum>0
1115
1116	!
1117	! In order take into account the possibility of changing the compression,
1118	! reset m, sig and w0 to zero for non-convective points.
1119	DO k = 1,nd-1
1120	sig1(:, k) = sig1(:, k)*coef_convective(:)
1121	w01(:, k) = w01(:, k)*coef_convective(:)
1122	ENDDO
1123
1124	IF (debut) THEN
1125	PRINT *, ' cv_uncompress -> '
1126	debut = .FALSE.
1127	END IF !(debut) THEN
1128
1129
1130	RETURN
1131	END SUBROUTINE cva_driver

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

Download in other formats:

Original Format