Context Navigation

cva_driver.F90 @ 5453

Last change on this file since 5453 was 3798, checked in by lguez, 4 years ago
Sync latest trunk changes to Ocean_skin
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: 51.6 KB

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

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

Download in other formats:

Original Format