Context Navigation

cva_driver.F90 @ 1992

Last change on this file since 1992 was 1992, checked in by lguez, 11 years ago

Converted to free source form files in libf/phylmd which were still in
fixed source form. The conversion was done using the polish mode of
the NAG Fortran Compiler.

In addition to converting to free source form, the processing of the
files also:

-- indented the code (including comments);

-- set Fortran keywords to uppercase, and set all other identifiers
to lower case;

-- added qualifiers to end statements (for example "end subroutine
conflx", instead of "end");

-- changed the terminating statements of all DO loops so that each
loop ends with an ENDDO statement (instead of a labeled continue).

-- replaced #include by include.

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: 35.5 KB

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

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

Download in other formats:

Original Format