Context Navigation

cva_driver.F90 @ 354

Last change on this file since 354 was 265, checked in by lfita, 10 years ago
Adding control error values on convection, since with this it has ran!!!
File size: 46.7 KB

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

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

Download in other formats:

Original Format