Context Navigation

cva_driver.F90 @ 3752

Last change on this file since 3752 was 3709, checked in by adurocher, 4 years ago
Add cv3p_mixing_new for optimization
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: 57.7 KB

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

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

Download in other formats:

Original Format