Context Navigation

cva_driver.F90 @ 2256

Last change on this file since 2256 was 2255, checked in by jyg, 10 years ago
Changes to pbl_surface and other routines concerning split/no-split. + pbl_surface_mod.F90: call cdrag for (w) region. + phyredem.F90: write wake_delta_pbl_TKE. + phys_output_write_mod.F90: control output of wake_delta_pbl_TKE by IF(iflag_pbl_split>=1). + lmdz1d.F90: initialize wake_delta_pbl_TKE=0. + phys_output_ctrlout_mod.F90: suppression of accents in some variable attributes. + cva_driver.F90: suppression of a print introduced in version 2253.
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.1 KB

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

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

Download in other formats:

Original Format