Context Navigation

cva_driver.F @ 3603

Last change on this file since 3603 was 1299, checked in by Laurent Fairhead, 15 years ago

Nettoyage general pour se rapprocher des normes et éviter des erreurs a la
compilation:

tous les FLOAT() sont remplacés par des REAL()
tous les STOP dans phylmd sont remplacés par des appels à abort_gcm
le common control défini dans le fichier control.h est remplacé par le module control_mod pour éviter des messages sur l'alignement des variables dans les déclarations
des $Header$ remplacés par des $Id$ pour svn

Quelques remplacements à faire ont pu m'échapper

General cleanup of the code to try and adhere to norms and to prevent some
compilation errors:

all FLOAT() instructions have been replaced by REAL() instructions
all STOP instructions in phylmd have been replaced by calls to abort_gcm
the common block control defined in the control.h file has been replaced by the control_mod to prevent compilation warnings on the alignement of declared variables
$Header$ replaced by $Id$ for svn

Some changes which should have been made might have escaped me

Property svn:eol-style set to native
Property svn:keywords set to Author Date Id Revision

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

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

Download in other formats:

Original Format