Context Navigation

cva_driver.f90 @ 5705

Last change on this file since 5705 was 5699, checked in by yann meurdesoif, 8 months ago
Convection GPU porting : remove zilch function (set to 0 flattened array) or similar... YM
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: 53.9 KB

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

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

Download in other formats:

Original Format