Context Navigation

cva_driver.F90 @ 3747

Last change on this file since 3747 was 3605, checked in by lguez, 5 years ago
Merge revisions 3427:3600 of trunk into branch `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.3 KB

Line
1
2	! $Id: cva_driver.F90 3605 2019-11-21 15:43:45Z lguez $
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	!
364
365	! ft: Array of temperature tendency (K/s) of dimension ND, defined at same
366	! grid levels as T, Q, QS and P.
367
368	! fq: Array of specific humidity tendencies ((gm/gm)/s) of dimension ND,
369	! defined at same grid levels as T, Q, QS and P.
370
371	! fu: Array of forcing of zonal velocity (m/s^2) of dimension ND,
372	! defined at same grid levels as T.
373
374	! fv: Same as FU, but for forcing of meridional velocity.
375
376	! ftra: Array of forcing of tracer content, in tracer mixing ratio per
377	! second, defined at same levels as T. Dimensioned (ND,NTRA).
378
379	! precip: Scalar convective precipitation rate (mm/day).
380
381	! wd: A convective downdraft velocity scale. For use in surface
382	! flux parameterizations. See convect.ps file for details.
383
384	! tprime: A convective downdraft temperature perturbation scale (K).
385	! For use in surface flux parameterizations. See convect.ps
386	! file for details.
387
388	! qprime: A convective downdraft specific humidity
389	! perturbation scale (gm/gm).
390	! For use in surface flux parameterizations. See convect.ps
391	! file for details.
392
393	! cbmf: The cloud base mass flux ((kg/m**2)/s). THIS SCALAR VALUE MUST
394	! BE STORED BY THE CALLING PROGRAM AND RETURNED TO CONVECT AT
395	! ITS NEXT CALL. That is, the value of CBMF must be "remembered"
396	! by the calling program between calls to CONVECT.
397
398	! det: Array of detrainment mass flux of dimension ND.
399	! -------------------------------------------------------------------
400
401	! Local (non compressed) arrays
402
403
404	INTEGER i, k, il
405	INTEGER nword1, nword2, nword3, nword4
406	INTEGER icbmax
407	INTEGER nk1(len)
408	INTEGER icb1(len)
409	INTEGER icbs1(len)
410
411	LOGICAL ok_inhib ! True => possible inhibition of convection by dryness
412	LOGICAL, SAVE :: debut = .TRUE.
413	!$OMP THREADPRIVATE(debut)
414
415	REAL coef_convective(len) ! = 1 for convective points, = 0 otherwise
416	REAL tnk1(len)
417	REAL thnk1(len)
418	REAL qnk1(len)
419	REAL gznk1(len)
420	REAL qsnk1(len)
421	REAL unk1(len)
422	REAL vnk1(len)
423	REAL cpnk1(len)
424	REAL hnk1(len)
425	REAL pbase1(len)
426	REAL buoybase1(len)
427
428	REAL lf1(len, nd), lf1_wake(len, nd)
429	REAL lv1(len, nd), lv1_wake(len, nd)
430	REAL cpn1(len, nd), cpn1_wake(len, nd)
431	REAL tv1(len, nd), tv1_wake(len, nd)
432	REAL gz1(len, nd), gz1_wake(len, nd)
433	REAL hm1(len, nd)
434	REAL h1(len, nd), h1_wake(len, nd)
435	REAL tp1(len, nd)
436	REAL th1(len, nd), th1_wake(len, nd)
437
438	REAL bid(len, nd) ! dummy array
439
440	INTEGER ncum
441
442	REAL p1feed1(len) ! pressure at lower bound of feeding layer
443	REAL p2feed1(len) ! pressure at upper bound of feeding layer
444	!JYG,RL
445	!! real wghti1(len,nd) ! weights of the feeding layers
446	!JYG,RL
447
448	! (local) compressed fields:
449
450
451	INTEGER idcum(nloc)
452	!jyg<
453	LOGICAL compress ! True if compression occurs
454	!>jyg
455	INTEGER iflag(nloc), nk(nloc), icb(nloc)
456	INTEGER nent(nloc, nd)
457	INTEGER icbs(nloc)
458	INTEGER inb(nloc), inbis(nloc)
459
460	REAL cbmf(nloc), plcl(nloc), plfc(nloc), wbeff(nloc)
461	REAL t(nloc, nd), q(nloc, nd), qs(nloc, nd)
462	REAL t_wake(nloc, nd), q_wake(nloc, nd), qs_wake(nloc, nd)
463	REAL s_wake(nloc)
464	REAL u(nloc, nd), v(nloc, nd)
465	REAL gz(nloc, nd), h(nloc, nd)
466	REAL h_wake(nloc, nd)
467	REAL lv(nloc, nd), lf(nloc, nd), cpn(nloc, nd)
468	REAL lv_wake(nloc, nd), lf_wake(nloc, nd), cpn_wake(nloc, nd)
469	REAL p(nloc, nd), ph(nloc, nd+1), tv(nloc, nd), tp(nloc, nd)
470	REAL tv_wake(nloc, nd)
471	REAL clw(nloc, nd)
472	REAL, DIMENSION(nloc, nd) :: qta, qpreca !!jygprl
473	REAL dph(nloc, nd)
474	REAL pbase(nloc), buoybase(nloc), th(nloc, nd)
475	REAL th_wake(nloc, nd)
476	REAL tvp(nloc, nd)
477	REAL sig(nloc, nd), w0(nloc, nd), ptop2(nloc)
478	REAL hp(nloc, nd), ep(nloc, nd), sigp(nloc, nd)
479	REAL buoy(nloc, nd)
480	REAL cape(nloc)
481	REAL cin(nloc)
482	REAL m(nloc, nd)
483	REAL mm(nloc, nd)
484	REAL ment(nloc, nd, nd), sigij(nloc, nd, nd)
485	REAL qent(nloc, nd, nd)
486	REAL hent(nloc, nd, nd)
487	REAL uent(nloc, nd, nd), vent(nloc, nd, nd)
488	REAL ments(nloc, nd, nd), qents(nloc, nd, nd)
489	REAL elij(nloc, nd, nd)
490	REAL supmax(nloc, nd)
491	REAL Ale(nloc), Alp(nloc), coef_clos(nloc)
492	REAL omega(nloc,nd)
493	REAL sigd(nloc)
494	! real mp(nloc,nd), qp(nloc,nd), up(nloc,nd), vp(nloc,nd)
495	! real wt(nloc,nd), water(nloc,nd), evap(nloc,nd), ice(nloc,nd)
496	! real b(nloc,nd), sigd(nloc)
497	! save mp,qp,up,vp,wt,water,evap,b
498	REAL, DIMENSION(len,nd) :: mp, qp, up, vp
499	REAL, DIMENSION(len,nd) :: wt, water, evap
500	REAL, DIMENSION(len,nd) :: ice, fondue, b
501	REAL, DIMENSION(len,nd) :: frac_a, frac_s, faci !!jygprl
502	REAL ft(nloc, nd), fq(nloc, nd)
503	REAL ftd(nloc, nd), fqd(nloc, nd)
504	REAL fu(nloc, nd), fv(nloc, nd)
505	REAL upwd(nloc, nd), dnwd(nloc, nd), dnwd0(nloc, nd)
506	REAL ma(nloc, nd), mip(nloc, nd)
507	!! REAL tls(nloc, nd), tps(nloc, nd) ! unused . jyg
508	REAL qprime(nloc), tprime(nloc)
509	REAL precip(nloc)
510	! real Vprecip(nloc,nd)
511	REAL vprecip(nloc, nd+1)
512	REAL vprecipi(nloc, nd+1)
513	REAL tra(nloc, nd, ntra), trap(nloc, nd, ntra)
514	REAL ftra(nloc, nd, ntra), traent(nloc, nd, nd, ntra)
515	REAL qcondc(nloc, nd) ! cld
516	REAL wd(nloc) ! gust
517	REAL Plim1(nloc), plim2(nloc)
518	REAL asupmax(nloc, nd)
519	REAL supmax0(nloc)
520	REAL asupmaxmin(nloc)
521
522	REAL tnk(nloc), qnk(nloc), gznk(nloc)
523	REAL wghti(nloc, nd)
524	REAL hnk(nloc), unk(nloc), vnk(nloc)
525
526	REAL qtc(nloc, nd) ! cld
527	REAL sigt(nloc, nd) ! cld
528
529	! RomP >>>
530	REAL wdtrainA(nloc, nd), wdtrainS(nloc, nd), wdtrainM(nloc, nd) !!jygprl
531	REAL da(len, nd), phi(len, nd, nd)
532	REAL epmlmMm(nloc, nd, nd), eplaMm(nloc, nd)
533	REAL phi2(len, nd, nd)
534	REAL d1a(len, nd), dam(len, nd)
535	! RomP <<<
536	REAL epmax_diag(nloc) ! epmax_cape
537
538	CHARACTER (LEN=20) :: modname = 'cva_driver'
539	CHARACTER (LEN=80) :: abort_message
540
541	INTEGER,SAVE :: igout=1
542	!$OMP THREADPRIVATE(igout)
543
544
545	! print *, 't1, t1_wake ',(k,t1(1,k),t1_wake(1,k),k=1,nd)
546	! print *, 'q1, q1_wake ',(k,q1(1,k),q1_wake(1,k),k=1,nd)
547
548	! -------------------------------------------------------------------
549	! --- SET CONSTANTS AND PARAMETERS
550	! -------------------------------------------------------------------
551
552	! -- set simulation flags:
553	! (common cvflag)
554
555	CALL cv_flag(iflag_ice_thermo)
556
557	! -- set thermodynamical constants:
558	! (common cvthermo)
559
560	CALL cv_thermo(iflag_con)
561
562	! -- set convect parameters
563
564	! includes microphysical parameters and parameters that
565	! control the rate of approach to quasi-equilibrium)
566	! (common cvparam)
567
568	IF (iflag_con==3) THEN
569	CALL cv3_param(nd, k_upper, delt)
570
571	END IF
572
573	IF (iflag_con==4) THEN
574	CALL cv_param(nd)
575	END IF
576
577	! ---------------------------------------------------------------------
578	! --- INITIALIZE OUTPUT ARRAYS AND PARAMETERS
579	! ---------------------------------------------------------------------
580	nword1 = len
581	nword2 = len*nd
582	nword3 = lenndntra
583	nword4 = lenndnd
584
585	iflag1(:) = 0
586	ktop1(:) = 0
587	kbas1(:) = 0
588	ft1(:, :) = 0.0
589	fq1(:, :) = 0.0
590	fu1(:, :) = 0.0
591	fv1(:, :) = 0.0
592	ftra1(:, :, :) = 0.
593	precip1(:) = 0.
594	cbmf1(:) = 0.
595	plcl1(:) = 0.
596	plfc1(:) = 0.
597	wbeff1(:) = 0.
598	ptop21(:) = 0.
599	sigd1(:) = 0.
600	ma1(:, :) = 0.
601	mip1(:, :) = 0.
602	vprecip1(:, :) = 0.
603	vprecipi1(:, :) = 0.
604	upwd1(:, :) = 0.
605	dnwd1(:, :) = 0.
606	dnwd01(:, :) = 0.
607	qcondc1(:, :) = 0.
608	wd1(:) = 0.
609	cape1(:) = 0.
610	cin1(:) = 0.
611	tvp1(:, :) = 0.
612	ftd1(:, :) = 0.
613	fqd1(:, :) = 0.
614	Plim11(:) = 0.
615	Plim21(:) = 0.
616	asupmax1(:, :) = 0.
617	supmax01(:) = 0.
618	asupmaxmin1(:) = 0.
619
620	tvp(:, :) = 0. !ym missing init, need to have a look by developpers
621	tv(:, :) = 0. !ym missing init, need to have a look by developpers
622
623	DO il = 1, len
624	cin1(il) = -100000.
625	cape1(il) = -1.
626	END DO
627
628	!! IF (iflag_con==3) THEN
629	!! DO il = 1, len
630	!! sig1(il, nd) = sig1(il, nd) + 1.
631	!! sig1(il, nd) = amin1(sig1(il,nd), 12.1)
632	!! END DO
633	!! END IF
634
635	IF (iflag_con==3) THEN
636	CALL cv3_incrcount(len,nd,delt,sig1)
637	END IF ! (iflag_con==3)
638
639	! RomP >>>
640	sigt1(:, :) = 0.
641	qtc1(:, :) = 0.
642	wdtrainA1(:, :) = 0.
643	wdtrainS1(:, :) = 0.
644	wdtrainM1(:, :) = 0.
645	da1(:, :) = 0.
646	phi1(:, :, :) = 0.
647	epmlmMm1(:, :, :) = 0.
648	eplaMm1(:, :) = 0.
649	mp1(:, :) = 0.
650	evap1(:, :) = 0.
651	ep1(:, :) = 0.
652	sigij1(:, :, :) = 0.
653	elij1(:, :, :) = 0.
654	qta1(:,:) = 0.
655	clw1(:,:) = 0.
656	wghti1(:,:) = 0.
657	phi21(:, :, :) = 0.
658	d1a1(:, :) = 0.
659	dam1(:, :) = 0.
660	! RomP <<<
661	! ---------------------------------------------------------------------
662	! --- INITIALIZE LOCAL ARRAYS AND PARAMETERS
663	! ---------------------------------------------------------------------
664
665	DO il = 1, nloc
666	coef_clos(il) = 1.
667	END DO
668
669	! --------------------------------------------------------------------
670	! --- CALCULATE ARRAYS OF GEOPOTENTIAL, HEAT CAPACITY & STATIC ENERGY
671	! --------------------------------------------------------------------
672
673	IF (iflag_con==3) THEN
674
675	IF (debut) THEN
676	PRINT *, 'Emanuel version 3 nouvelle'
677	END IF
678	! print*,'t1, q1 ',t1,q1
679	if (prt_level >= 9) &
680	PRINT *, 'cva_driver -> cv3_prelim'
681	CALL cv3_prelim(len, nd, ndp1, t1, q1, p1, ph1, & ! nd->na
682	lv1, lf1, cpn1, tv1, gz1, h1, hm1, th1)
683
684
685	if (prt_level >= 9) &
686	PRINT *, 'cva_driver -> cv3_prelim'
687	CALL cv3_prelim(len, nd, ndp1, t1_wake, q1_wake, p1, ph1, & ! nd->na
688	lv1_wake, lf1_wake, cpn1_wake, tv1_wake, gz1_wake, &
689	h1_wake, bid, th1_wake)
690
691	END IF
692
693	IF (iflag_con==4) THEN
694	PRINT *, 'Emanuel version 4 '
695	if (prt_level >= 9) &
696	PRINT *, 'cva_driver -> cv_prelim'
697	CALL cv_prelim(len, nd, ndp1, t1, q1, p1, ph1, &
698	lv1, cpn1, tv1, gz1, h1, hm1)
699	END IF
700
701	! --------------------------------------------------------------------
702	! --- CONVECTIVE FEED
703	! --------------------------------------------------------------------
704
705	! compute feeding layer potential temperature and mixing ratio :
706
707	! get bounds of feeding layer
708
709	! test niveaux couche alimentation KE
710	IF (sig1feed1==sig2feed1) THEN
711	WRITE (lunout, *) 'impossible de choisir sig1feed=sig2feed'
712	WRITE (lunout, *) 'changer la valeur de sig2feed dans physiq.def'
713	abort_message = ''
714	CALL abort_physic(modname, abort_message, 1)
715	END IF
716
717	DO i = 1, len
718	p1feed1(i) = sig1feed1*ph1(i, 1)
719	p2feed1(i) = sig2feed1*ph1(i, 1)
720	!test maf
721	! p1feed1(i)=ph1(i,1)
722	! p2feed1(i)=ph1(i,2)
723	! p2feed1(i)=ph1(i,3)
724	!testCR: on prend la couche alim des thermiques
725	! p2feed1(i)=ph1(i,lalim_conv1(i)+1)
726	! print*,'lentr=',lentr(i),ph1(i,lentr(i)+1),ph1(i,2)
727	END DO
728
729	IF (iflag_con==3) THEN
730	END IF
731	DO i = 1, len
732	! print*,'avant cv3_feed Plim',p1feed1(i),p2feed1(i)
733	END DO
734	IF (iflag_con==3) THEN
735
736	! print*, 'IFLAG1 avant cv3_feed'
737	! print*,'len,nd',len,nd
738	! write(*,'(64i1)') iflag1(2:len-1)
739
740	if (prt_level >= 9) &
741	PRINT *, 'cva_driver -> cv3_feed'
742	CALL cv3_feed(len, nd, ok_conserv_q, & ! nd->na
743	t1, q1, u1, v1, p1, ph1, h1, gz1, &
744	p1feed1, p2feed1, wght1, &
745	wghti1, tnk1, thnk1, qnk1, qsnk1, unk1, vnk1, &
746	cpnk1, hnk1, nk1, icb1, icbmax, iflag1, gznk1, plcl1)
747	END IF
748
749	! print*, 'IFLAG1 apres cv3_feed'
750	! print*,'len,nd',len,nd
751	! write(*,'(64i1)') iflag1(2:len-1)
752
753	IF (iflag_con==4) THEN
754	if (prt_level >= 9) &
755	PRINT *, 'cva_driver -> cv_feed'
756	CALL cv_feed(len, nd, t1, q1, qs1, p1, hm1, gz1, &
757	nk1, icb1, icbmax, iflag1, tnk1, qnk1, gznk1, plcl1)
758	END IF
759
760	! print *, 'cv3_feed-> iflag1, plcl1 ',iflag1(1),plcl1(1)
761
762	! --------------------------------------------------------------------
763	! --- UNDILUTE (ADIABATIC) UPDRAFT / 1st part
764	! (up through ICB for convect4, up through ICB+1 for convect3)
765	! Calculates the lifted parcel virtual temperature at nk, the
766	! actual temperature, and the adiabatic liquid water content.
767	! --------------------------------------------------------------------
768
769	IF (iflag_con==3) THEN
770
771	if (prt_level >= 9) &
772	PRINT *, 'cva_driver -> cv3_undilute1'
773	CALL cv3_undilute1(len, nd, t1, qs1, gz1, plcl1, p1, icb1, tnk1, qnk1, & ! nd->na
774	gznk1, tp1, tvp1, clw1, icbs1)
775	END IF
776
777
778	IF (iflag_con==4) THEN
779	if (prt_level >= 9) &
780	PRINT *, 'cva_driver -> cv_undilute1'
781	CALL cv_undilute1(len, nd, t1, q1, qs1, gz1, p1, nk1, icb1, icbmax, &
782	tp1, tvp1, clw1)
783	END IF
784
785	! -------------------------------------------------------------------
786	! --- TRIGGERING
787	! -------------------------------------------------------------------
788
789	! print *,' avant triggering, iflag_con ',iflag_con
790
791	IF (iflag_con==3) THEN
792
793	if (prt_level >= 9) &
794	PRINT *, 'cva_driver -> cv3_trigger'
795	CALL cv3_trigger(len, nd, icb1, plcl1, p1, th1, tv1, tvp1, thnk1, & ! nd->na
796	pbase1, buoybase1, iflag1, sig1, w01)
797
798
799	! print*, 'IFLAG1 apres cv3_triger'
800	! print*,'len,nd',len,nd
801	! write(*,'(64i1)') iflag1(2:len-1)
802
803	! call dump2d(iim,jjm-1,sig1(2)
804	END IF
805
806	IF (iflag_con==4) THEN
807	if (prt_level >= 9) &
808	PRINT *, 'cva_driver -> cv_trigger'
809	CALL cv_trigger(len, nd, icb1, cbmf1, tv1, tvp1, iflag1)
810	END IF
811
812
813	! =====================================================================
814	! --- IF THIS POINT IS REACHED, MOIST CONVECTIVE ADJUSTMENT IS NECESSARY
815	! =====================================================================
816
817	! Determine the number "ncum" of convective gridpoints, the list "idcum" of convective
818	! gridpoints and the weights "coef_convective" (= 1. for convective gridpoints and = 0.
819	! elsewhere).
820	ncum = 0
821	coef_convective(:) = 0.
822	DO i = 1, len
823	IF (iflag1(i)==0) THEN
824	coef_convective(i) = 1.
825	ncum = ncum + 1
826	idcum(ncum) = i
827	END IF
828	END DO
829
830	! print*,'len, ncum = ',len,ncum
831
832	IF (ncum>0) THEN
833
834	! ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
835	! --- COMPRESS THE FIELDS
836	! (-> vectorization over convective gridpoints)
837	! ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
838
839	IF (iflag_con==3) THEN
840	! print*,'ncum tv1 ',ncum,tv1
841	! print*,'tvp1 ',tvp1
842	!jyg<
843	! If the fraction of convective points is larger than comp_threshold, then compression
844	! is assumed useless.
845	!
846	compress = ncum .lt. len*comp_threshold
847	!
848	IF (.not. compress) THEN
849	DO i = 1,len
850	idcum(i) = i
851	ENDDO
852	ENDIF
853	!
854	!>jyg
855	if (prt_level >= 9) &
856	PRINT *, 'cva_driver -> cv3a_compress'
857	CALL cv3a_compress(len, nloc, ncum, nd, ntra, compress, &
858	iflag1, nk1, icb1, icbs1, &
859	plcl1, tnk1, qnk1, gznk1, hnk1, unk1, vnk1, &
860	wghti1, pbase1, buoybase1, &
861	t1, q1, qs1, t1_wake, q1_wake, qs1_wake, s1_wake, &
862	u1, v1, gz1, th1, th1_wake, &
863	tra1, &
864	h1, lv1, lf1, cpn1, p1, ph1, tv1, tp1, tvp1, clw1, &
865	h1_wake, lv1_wake, lf1_wake, cpn1_wake, tv1_wake, &
866	sig1, w01, ptop21, &
867	Ale1, Alp1, omega1, &
868	iflag, nk, icb, icbs, &
869	plcl, tnk, qnk, gznk, hnk, unk, vnk, &
870	wghti, pbase, buoybase, &
871	t, q, qs, t_wake, q_wake, qs_wake, s_wake, &
872	u, v, gz, th, th_wake, &
873	tra, &
874	h, lv, lf, cpn, p, ph, tv, tp, tvp, clw, &
875	h_wake, lv_wake, lf_wake, cpn_wake, tv_wake, &
876	sig, w0, ptop2, &
877	Ale, Alp, omega)
878
879	! print*,'tv ',tv
880	! print*,'tvp ',tvp
881
882	END IF
883
884	IF (iflag_con==4) THEN
885	if (prt_level >= 9) &
886	PRINT *, 'cva_driver -> cv_compress'
887	CALL cv_compress(len, nloc, ncum, nd, &
888	iflag1, nk1, icb1, &
889	cbmf1, plcl1, tnk1, qnk1, gznk1, &
890	t1, q1, qs1, u1, v1, gz1, &
891	h1, lv1, cpn1, p1, ph1, tv1, tp1, tvp1, clw1, &
892	iflag, nk, icb, &
893	cbmf, plcl, tnk, qnk, gznk, &
894	t, q, qs, u, v, gz, h, lv, cpn, p, ph, tv, tp, tvp, clw, &
895	dph)
896	END IF
897
898	! -------------------------------------------------------------------
899	! --- UNDILUTE (ADIABATIC) UPDRAFT / second part :
900	! --- FIND THE REST OF THE LIFTED PARCEL TEMPERATURES
901	! --- &
902	! --- COMPUTE THE PRECIPITATION EFFICIENCIES AND THE
903	! --- FRACTION OF PRECIPITATION FALLING OUTSIDE OF CLOUD
904	! --- &
905	! --- FIND THE LEVEL OF NEUTRAL BUOYANCY
906	! -------------------------------------------------------------------
907
908	IF (iflag_con==3) THEN
909	if (prt_level >= 9) &
910	PRINT *, 'cva_driver -> cv3_undilute2'
911	CALL cv3_undilute2(nloc, ncum, nd, iflag, icb, icbs, nk, & !na->nd
912	tnk, qnk, gznk, hnk, t, q, qs, gz, &
913	p, ph, h, tv, lv, lf, pbase, buoybase, plcl, &
914	inb, tp, tvp, clw, hp, ep, sigp, buoy, &
915	frac_a, frac_s, qpreca, qta) !!jygprl
916	END IF
917
918	IF (iflag_con==4) THEN
919	if (prt_level >= 9) &
920	PRINT *, 'cva_driver -> cv_undilute2'
921	CALL cv_undilute2(nloc, ncum, nd, icb, nk, &
922	tnk, qnk, gznk, t, q, qs, gz, &
923	p, dph, h, tv, lv, &
924	inb, inbis, tp, tvp, clw, hp, ep, sigp, frac_s)
925	END IF
926
927	! epmax_cape
928	! on recalcule ep et hp
929	if (prt_level >= 9) &
930	PRINT *, 'cva_driver -> cv3_epmax_cape'
931	call cv3_epmax_fn_cape(nloc,ncum,nd &
932	, ep,hp,icb,inb,clw,nk,t,h,hnk,lv,lf,frac_s &
933	, pbase, p, ph, tv, buoy, sig, w0,iflag &
934	, epmax_diag)
935
936	! -------------------------------------------------------------------
937	! --- MIXING(1) (if iflag_mix .ge. 1)
938	! -------------------------------------------------------------------
939	IF (iflag_con==3) THEN
940	! IF ((iflag_ice_thermo==1) .AND. (iflag_mix/=0)) THEN
941	! WRITE (, ) ' iflag_ice_thermo==1 requires iflag_mix==0', ' but iflag_mix=', iflag_mix, &
942	! '. Might as well stop here.'
943	! STOP
944	! END IF
945	IF (iflag_mix>=1) THEN
946	CALL zilch(supmax, nloc*nd)
947	if (prt_level >= 9) &
948	PRINT *, 'cva_driver -> cv3p_mixing'
949	CALL cv3p_mixing(nloc, ncum, nd, nd, ntra, icb, nk, inb, & ! na->nd
950	!! ph, t, q, qs, u, v, tra, h, lv, lf, frac, qnk, &
951	ph, t, q, qs, u, v, tra, h, lv, lf, frac_s, qta, & !!jygprl
952	unk, vnk, hp, tv, tvp, ep, clw, sig, &
953	ment, qent, hent, uent, vent, nent, &
954	sigij, elij, supmax, ments, qents, traent)
955	! print*, 'cv3p_mixing-> supmax ', (supmax(1,k), k=1,nd)
956
957	ELSE
958	CALL zilch(supmax, nloc*nd)
959	END IF
960	END IF
961	! -------------------------------------------------------------------
962	! --- CLOSURE
963	! -------------------------------------------------------------------
964
965
966	IF (iflag_con==3) THEN
967	IF (iflag_clos==0) THEN
968	if (prt_level >= 9) &
969	PRINT *, 'cva_driver -> cv3_closure'
970	CALL cv3_closure(nloc, ncum, nd, icb, inb, & ! na->nd
971	pbase, p, ph, tv, buoy, &
972	sig, w0, cape, m, iflag)
973	END IF ! iflag_clos==0
974
975	ok_inhib = iflag_mix == 2
976
977	IF (iflag_clos==1) THEN
978	PRINT *, ' pas d appel cv3p_closure'
979	! c CALL cv3p_closure(nloc,ncum,nd,icb,inb ! na->nd
980	! c : ,pbase,plcl,p,ph,tv,tvp,buoy
981	! c : ,supmax
982	! c o ,sig,w0,ptop2,cape,cin,m)
983	END IF ! iflag_clos==1
984
985	IF (iflag_clos==2) THEN
986	if (prt_level >= 9) &
987	PRINT *, 'cva_driver -> cv3p1_closure'
988	CALL cv3p1_closure(nloc, ncum, nd, icb, inb, & ! na->nd
989	pbase, plcl, p, ph, tv, tvp, buoy, &
990	supmax, ok_inhib, Ale, Alp, omega, &
991	sig, w0, ptop2, cape, cin, m, iflag, coef_clos, &
992	Plim1, plim2, asupmax, supmax0, &
993	asupmaxmin, cbmf, plfc, wbeff)
994	if (prt_level >= 10) &
995	PRINT *, 'cv3p1_closure-> plfc,wbeff ', plfc(1), wbeff(1)
996	END IF ! iflag_clos==2
997
998	IF (iflag_clos==3) THEN
999	if (prt_level >= 9) &
1000	PRINT *, 'cva_driver -> cv3p2_closure'
1001	CALL cv3p2_closure(nloc, ncum, nd, icb, inb, & ! na->nd
1002	pbase, plcl, p, ph, tv, tvp, buoy, &
1003	supmax, ok_inhib, Ale, Alp, omega, &
1004	sig, w0, ptop2, cape, cin, m, iflag, coef_clos, &
1005	Plim1, plim2, asupmax, supmax0, &
1006	asupmaxmin, cbmf, plfc, wbeff)
1007	if (prt_level >= 10) &
1008	PRINT *, 'cv3p2_closure-> plfc,wbeff ', plfc(1), wbeff(1)
1009	END IF ! iflag_clos==3
1010	END IF ! iflag_con==3
1011
1012	IF (iflag_con==4) THEN
1013	if (prt_level >= 9) &
1014	PRINT *, 'cva_driver -> cv_closure'
1015	CALL cv_closure(nloc, ncum, nd, nk, icb, &
1016	tv, tvp, p, ph, dph, plcl, cpn, &
1017	iflag, cbmf)
1018	END IF
1019
1020	! print *,'cv_closure-> cape ',cape(1)
1021
1022	! -------------------------------------------------------------------
1023	! --- MIXING(2)
1024	! -------------------------------------------------------------------
1025
1026	IF (iflag_con==3) THEN
1027	IF (iflag_mix==0) THEN
1028	if (prt_level >= 9) &
1029	PRINT *, 'cva_driver -> cv3_mixing'
1030	CALL cv3_mixing(nloc, ncum, nd, nd, ntra, icb, nk, inb, & ! na->nd
1031	ph, t, q, qs, u, v, tra, h, lv, lf, frac_s, qnk, &
1032	unk, vnk, hp, tv, tvp, ep, clw, m, sig, &
1033	ment, qent, uent, vent, nent, sigij, elij, ments, qents, traent)
1034	CALL zilch(hent, nlocndnd)
1035	ELSE
1036	!!jyg: Essais absurde pour voir
1037	!! mm(:,1) = 0.
1038	!! DO i = 2,nd
1039	!! mm(:,i) = m(:,i)*(1.-qta(:,i-1))
1040	!! ENDDO
1041	mm(:,:) = m(:,:)
1042	CALL cv3_mixscale(nloc, ncum, nd, ment, mm)
1043	IF (debut) THEN
1044	PRINT *, ' cv3_mixscale-> '
1045	END IF !(debut) THEN
1046	END IF
1047	END IF
1048
1049	IF (iflag_con==4) THEN
1050	if (prt_level >= 9) &
1051	PRINT *, 'cva_driver -> cv_mixing'
1052	CALL cv_mixing(nloc, ncum, nd, icb, nk, inb, inbis, &
1053	ph, t, q, qs, u, v, h, lv, qnk, &
1054	hp, tv, tvp, ep, clw, cbmf, &
1055	m, ment, qent, uent, vent, nent, sigij, elij)
1056	END IF
1057
1058	IF (debut) THEN
1059	PRINT *, ' cv_mixing ->'
1060	END IF !(debut) THEN
1061	! do i = 1,nd
1062	! print*,'cv_mixing-> i,ment ',i,(ment(1,i,j),j=1,nd)
1063	! enddo
1064
1065	! -------------------------------------------------------------------
1066	! --- UNSATURATED (PRECIPITATING) DOWNDRAFTS
1067	! -------------------------------------------------------------------
1068	IF (iflag_con==3) THEN
1069	IF (debut) THEN
1070	PRINT *, ' cva_driver -> cv3_unsat '
1071	END IF !(debut) THEN
1072
1073	if (prt_level >= 9) &
1074	PRINT *, 'cva_driver -> cv3_unsat'
1075	CALL cv3_unsat(nloc, ncum, nd, nd, ntra, icb, inb, iflag, & ! na->nd
1076	t_wake, q_wake, qs_wake, gz, u, v, tra, p, ph, &
1077	th_wake, tv_wake, lv_wake, lf_wake, cpn_wake, &
1078	ep, sigp, clw, frac_s, qpreca, frac_a, qta, & !!jygprl
1079	m, ment, elij, delt, plcl, coef_clos, &
1080	mp, qp, up, vp, trap, wt, water, evap, fondue, ice, &
1081	faci, b, sigd, &
1082	!! wdtrainA, wdtrainM) ! RomP
1083	wdtrainA, wdtrainS, wdtrainM) !!jygprl
1084	!
1085	IF (prt_level >= 10) THEN
1086	Print *, 'cva_driver after cv3_unsat:mp , water, ice, evap, fondue '
1087	DO k = 1,nd
1088	write (6, '(i4,5(1x,e13.6))'), &
1089	k, mp(igout,k), water(igout,k), ice(igout,k), &
1090	evap(igout,k), fondue(igout,k)
1091	ENDDO
1092	Print *, 'cva_driver after cv3_unsat: wdtrainA, wdtrainS, wdtrainM ' !!jygprl
1093	DO k = 1,nd
1094	write (6, '(i4,3(1x,e13.6))'), &
1095	k, wdtrainA(igout,k), wdtrainS(igout,k), wdtrainM(igout,k) !!jygprl
1096	ENDDO
1097	ENDIF
1098	!
1099	END IF !(iflag_con==3)
1100
1101	IF (iflag_con==4) THEN
1102	if (prt_level >= 9) &
1103	PRINT *, 'cva_driver -> cv_unsat'
1104	CALL cv_unsat(nloc, ncum, nd, inb, t, q, qs, gz, u, v, p, ph, &
1105	h, lv, ep, sigp, clw, m, ment, elij, &
1106	iflag, mp, qp, up, vp, wt, water, evap)
1107	END IF
1108
1109	IF (debut) THEN
1110	PRINT *, 'cv_unsat-> '
1111	END IF !(debut) THEN
1112
1113	! print *,'cv_unsat-> mp ',mp
1114	! print *,'cv_unsat-> water ',water
1115	! -------------------------------------------------------------------
1116	! --- YIELD
1117	! (tendencies, precipitation, variables of interface with other
1118	! processes, etc)
1119	! -------------------------------------------------------------------
1120
1121	IF (iflag_con==3) THEN
1122
1123	if (prt_level >= 9) &
1124	PRINT *, 'cva_driver -> cv3_yield'
1125	CALL cv3_yield(nloc, ncum, nd, nd, ntra, ok_conserv_q, & ! na->nd
1126	icb, inb, delt, &
1127	t, q, t_wake, q_wake, s_wake, u, v, tra, &
1128	gz, p, ph, h, hp, lv, lf, cpn, th, th_wake, &
1129	ep, clw, qpreca, m, tp, mp, qp, up, vp, trap, &
1130	wt, water, ice, evap, fondue, faci, b, sigd, &
1131	ment, qent, hent, iflag_mix, uent, vent, &
1132	nent, elij, traent, sig, &
1133	tv, tvp, wghti, &
1134	iflag, precip, Vprecip, Vprecipi, ft, fq, fu, fv, ftra, & ! jyg
1135	cbmf, upwd, dnwd, dnwd0, ma, mip, &
1136	!! tls, tps, & ! useless . jyg
1137	qcondc, wd, &
1138	!! ftd, fqd, qnk, qtc, sigt, tau_cld_cv, coefw_cld_cv)
1139	ftd, fqd, qta, qtc, sigt, tau_cld_cv, coefw_cld_cv) !!jygprl
1140	!
1141	! Test conseravtion de l'eau
1142	!
1143	IF (debut) THEN
1144	PRINT *, ' cv3_yield -> fqd(1) = ', fqd(igout, 1)
1145	END IF !(debut) THEN
1146	!
1147	IF (prt_level >= 10) THEN
1148	Print *, 'cva_driver after cv3_yield:ft(1) , ftd(1) ', &
1149	ft(igout,1), ftd(igout,1)
1150	Print *, 'cva_driver after cv3_yield:fq(1) , fqd(1) ', &
1151	fq(igout,1), fqd(igout,1)
1152	ENDIF
1153	!
1154	END IF
1155
1156	IF (iflag_con==4) THEN
1157	if (prt_level >= 9) &
1158	PRINT *, 'cva_driver -> cv_yield'
1159	CALL cv_yield(nloc, ncum, nd, nk, icb, inb, delt, &
1160	t, q, u, v, &
1161	gz, p, ph, h, hp, lv, cpn, &
1162	ep, clw, frac_s, m, mp, qp, up, vp, &
1163	wt, water, evap, &
1164	ment, qent, uent, vent, nent, elij, &
1165	tv, tvp, &
1166	iflag, wd, qprime, tprime, &
1167	precip, cbmf, ft, fq, fu, fv, ma, qcondc)
1168	END IF
1169
1170	!AC!
1171	!^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
1172	!--- passive tracers
1173	!^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
1174
1175	IF (iflag_con==3) THEN
1176	!RomP >>>
1177	if (prt_level >= 9) &
1178	PRINT *, 'cva_driver -> cv3_tracer'
1179	CALL cv3_tracer(nloc, len, ncum, nd, nd, &
1180	ment, sigij, da, phi, phi2, d1a, dam, &
1181	ep, vprecip, elij, clw, epmlmMm, eplaMm, &
1182	icb, inb)
1183	!RomP <<<
1184	END IF
1185
1186	!AC!
1187
1188	! ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
1189	! --- UNCOMPRESS THE FIELDS
1190	! ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
1191
1192
1193	IF (iflag_con==3) THEN
1194	if (prt_level >= 9) &
1195	PRINT *, 'cva_driver -> cv3a_uncompress'
1196	CALL cv3a_uncompress(nloc, len, ncum, nd, ntra, idcum, compress, &
1197	iflag, icb, inb, &
1198	precip, cbmf, plcl, plfc, wbeff, sig, w0, ptop2, &
1199	ft, fq, fu, fv, ftra, &
1200	sigd, ma, mip, vprecip, vprecipi, upwd, dnwd, dnwd0, &
1201	qcondc, wd, cape, cin, &
1202	tvp, &
1203	ftd, fqd, &
1204	Plim1, plim2, asupmax, supmax0, &
1205	asupmaxmin, &
1206	da, phi, mp, phi2, d1a, dam, sigij, & ! RomP
1207	qta, clw, elij, evap, ep, epmlmMm, eplaMm, & ! RomP
1208	wdtrainA, wdtrainS, wdtrainM, & ! RomP
1209	qtc, sigt, epmax_diag, & ! epmax_cape
1210	iflag1, kbas1, ktop1, &
1211	precip1, cbmf1, plcl1, plfc1, wbeff1, sig1, w01, ptop21, &
1212	ft1, fq1, fu1, fv1, ftra1, &
1213	sigd1, ma1, mip1, vprecip1, vprecipi1, upwd1, dnwd1, dnwd01, &
1214	qcondc1, wd1, cape1, cin1, &
1215	tvp1, &
1216	ftd1, fqd1, &
1217	Plim11, plim21, asupmax1, supmax01, &
1218	asupmaxmin1, &
1219	da1, phi1, mp1, phi21, d1a1, dam1, sigij1, & ! RomP
1220	qta1, clw1, elij1, evap1, ep1, epmlmMm1, eplaMm1, & ! RomP
1221	wdtrainA1, wdtrainS1, wdtrainM1, & ! RomP
1222	qtc1, sigt1, epmax_diag1) ! epmax_cape
1223	!
1224	IF (prt_level >= 10) THEN
1225	Print *, 'cva_driver after cv3_uncompress:ft1(1) , ftd1(1) ', &
1226	ft1(igout,1), ftd1(igout,1)
1227	Print *, 'cva_driver after cv3_uncompress:fq1(1) , fqd1(1) ', &
1228	fq1(igout,1), fqd1(igout,1)
1229	ENDIF
1230	!
1231	END IF
1232
1233	IF (iflag_con==4) THEN
1234	if (prt_level >= 9) &
1235	PRINT *, 'cva_driver -> cv_uncompress'
1236	CALL cv_uncompress(nloc, len, ncum, nd, idcum, &
1237	iflag, &
1238	precip, cbmf, &
1239	ft, fq, fu, fv, &
1240	ma, qcondc, &
1241	iflag1, &
1242	precip1,cbmf1, &
1243	ft1, fq1, fu1, fv1, &
1244	ma1, qcondc1)
1245	END IF
1246
1247	END IF ! ncum>0
1248
1249	!
1250	! In order take into account the possibility of changing the compression,
1251	! reset m, sig and w0 to zero for non-convective points.
1252	DO k = 1,nd-1
1253	sig1(:, k) = sig1(:, k)*coef_convective(:)
1254	w01(:, k) = w01(:, k)*coef_convective(:)
1255	ENDDO
1256
1257	IF (debut) THEN
1258	PRINT *, ' cv_uncompress -> '
1259	debut = .FALSE.
1260	END IF !(debut) THEN
1261
1262
1263	RETURN
1264	END SUBROUTINE cva_driver

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

Download in other formats:

Original Format