Context Navigation

cva_driver.F @ 3289

Last change on this file since 3289 was 973, checked in by lmdzadmin, 16 years ago
Initialisations : concvl, cv3_routines, cva_driver, physiq Correction bug i0 + ajout tests : cv3p1_closure Ajout sorties : ale, alp, cin, wape Ajout variables wake : phyetat0, phyredem IM
Property svn:eol-style set to `native` Property svn:keywords set to `Author Date Id Revision`
File size: 33.7 KB

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

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

Download in other formats:

Original Format