Context Navigation

cva_driver.F @ 1

Last change on this file since 1 was 1, checked in by emillour, 14 years ago
Import initial LMDZ5
File size: 34.5 KB

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

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

Download in other formats:

Original Format