/[lmdze]/trunk/libf/phylmd/conema3.f
ViewVC logotype

Annotation of /trunk/libf/phylmd/conema3.f

Parent Directory Parent Directory | Revision Log Revision Log


Revision 17 - (hide annotations)
Tue Aug 5 13:31:32 2008 UTC (15 years, 10 months ago) by guez
File size: 11441 byte(s)
Created rule for "compare_sampl_*" files in
"Documentation/Manuel_LMDZE.texfol/Graphiques/GNUmakefile".

Extracted "qcheck", "radiornpb", "minmaxqfi" into separate files.

Read pressure coordinate of ozone coefficients once per run instead of
every day.

Added some "intent" attributes.

Added argument "nq" to "ini_histday". Replaced calls to "gr_fi_ecrit"
by calls to "gr_phy_write_2d". "Sigma_O3_Royer" is written to
"histday.nc" only if "nq >= 4". Moved "ini_histrac" to module
"ini_hist".

Compute "zmasse" in "physiq", pass it to "phytrac".

Removed computations of "pftsol*" and "ppsrf*" in "phytrac".

Do not use variable "rg" from module "YOMCST" in "TLIFT".

1 guez 3 !
2     ! $Header: /home/cvsroot/LMDZ4/libf/phylmd/conema3.F,v 1.1.1.1 2004/05/19 12:53:09 lmdzadmin Exp $
3     !
4     SUBROUTINE conema3 (dtime,paprs,pplay,t,q,u,v,tra,ntra,
5     . work1,work2,d_t,d_q,d_u,d_v,d_tra,
6     . rain, snow, kbas, ktop,
7     . upwd,dnwd,dnwdbis,bas,top,Ma,cape,tvp,rflag,
8     . pbase,bbase,dtvpdt1,dtvpdq1,dplcldt,dplcldr,
9     . qcond_incld)
10    
11     use dimens_m
12     use dimphy
13     use YOMCST
14     use conema3_m
15     use yoethf
16     use fcttre
17     IMPLICIT none
18     c======================================================================
19     c Auteur(s): Z.X. Li (LMD/CNRS) date: 19930818
20     c Objet: schema de convection de Emanuel (1991) interface
21     c Mai 1998: Interface modifiee pour implementation dans LMDZ
22     c======================================================================
23     c Arguments:
24     c dtime---input-R-pas d'integration (s)
25     c paprs---input-R-pression inter-couches (Pa)
26     c pplay---input-R-pression au milieu des couches (Pa)
27     c t-------input-R-temperature (K)
28     c q-------input-R-humidite specifique (kg/kg)
29     c u-------input-R-vitesse du vent zonal (m/s)
30     c v-------input-R-vitesse duvent meridien (m/s)
31     c tra-----input-R-tableau de rapport de melange des traceurs
32     c work*: input et output: deux variables de travail,
33     c on peut les mettre a 0 au debut
34     c
35     C d_t-----output-R-increment de la temperature
36     c d_q-----output-R-increment de la vapeur d'eau
37     c d_u-----output-R-increment de la vitesse zonale
38     c d_v-----output-R-increment de la vitesse meridienne
39     c d_tra---output-R-increment du contenu en traceurs
40     c rain----output-R-la pluie (mm/s)
41     c snow----output-R-la neige (mm/s)
42     c kbas----output-R-bas du nuage (integer)
43     c ktop----output-R-haut du nuage (integer)
44     c upwd----output-R-saturated updraft mass flux (kg/m**2/s)
45     c dnwd----output-R-saturated downdraft mass flux (kg/m**2/s)
46     c dnwdbis-output-R-unsaturated downdraft mass flux (kg/m**2/s)
47     c bas-----output-R-bas du nuage (real)
48     c top-----output-R-haut du nuage (real)
49     c Ma------output-R-flux ascendant non dilue (kg/m**2/s)
50     c cape----output-R-CAPE
51     c tvp-----output-R-virtual temperature of the lifted parcel
52     c rflag---output-R-flag sur le fonctionnement de convect
53     c pbase---output-R-pression a la base du nuage (Pa)
54     c bbase---output-R-buoyancy a la base du nuage (K)
55     c dtvpdt1-output-R-derivative of parcel virtual temp wrt T1
56     c dtvpdq1-output-R-derivative of parcel virtual temp wrt Q1
57     c dplcldt-output-R-derivative of the PCP pressure wrt T1
58     c dplcldr-output-R-derivative of the PCP pressure wrt Q1
59     c======================================================================
60     c
61     INTEGER i, l,m,itra
62     INTEGER ntra,ntrac !number of tracers; if no tracer transport
63     ! is needed, set ntra = 1 (or 0)
64     PARAMETER (ntrac=nqmx-2)
65 guez 12 REAL, intent(in):: dtime
66 guez 3 c
67     REAL d_t2(klon,klev), d_q2(klon,klev) ! sbl
68     REAL d_u2(klon,klev), d_v2(klon,klev) ! sbl
69     REAL em_d_t2(klev), em_d_q2(klev) ! sbl
70     REAL em_d_u2(klev), em_d_v2(klev) ! sbl
71     c
72     REAL, intent(in):: paprs(klon,klev+1)
73 guez 10 real, intent(in):: pplay(klon,klev)
74 guez 3 REAL t(klon,klev), q(klon,klev), d_t(klon,klev), d_q(klon,klev)
75 guez 17 REAL u(klon,klev), v(klon,klev)
76     real, intent(in):: tra(klon,klev,ntra)
77 guez 3 REAL d_u(klon,klev), d_v(klon,klev), d_tra(klon,klev,ntra)
78     REAL work1(klon,klev), work2(klon,klev)
79     REAL upwd(klon,klev), dnwd(klon,klev), dnwdbis(klon,klev)
80     REAL rain(klon)
81     REAL snow(klon)
82     REAL cape(klon), tvp(klon,klev), rflag(klon)
83     REAL pbase(klon), bbase(klon)
84     REAL dtvpdt1(klon,klev), dtvpdq1(klon,klev)
85     REAL dplcldt(klon), dplcldr(klon)
86     INTEGER kbas(klon), ktop(klon)
87    
88     REAL wd(klon)
89     REAL qcond_incld(klon,klev)
90     c
91     REAL em_t(klev)
92     REAL em_q(klev)
93     REAL em_qs(klev)
94     REAL em_u(klev), em_v(klev), em_tra(klev,ntrac)
95     REAL em_ph(klev+1), em_p(klev)
96     REAL em_work1(klev), em_work2(klev)
97     REAL em_precip, em_d_t(klev), em_d_q(klev)
98     REAL em_d_u(klev), em_d_v(klev), em_d_tra(klev,ntrac)
99     REAL em_upwd(klev), em_dnwd(klev), em_dnwdbis(klev)
100     REAL em_dtvpdt1(klev), em_dtvpdq1(klev)
101     REAL em_dplcldt, em_dplcldr
102     SAVE em_t,em_q, em_qs, em_ph, em_p, em_work1, em_work2
103     SAVE em_u,em_v, em_tra
104     SAVE em_d_u,em_d_v, em_d_tra
105     SAVE em_precip, em_d_t, em_d_q, em_upwd, em_dnwd, em_dnwdbis
106     INTEGER em_bas, em_top
107     SAVE em_bas, em_top
108    
109     REAL em_wd
110     REAL em_qcond(klev)
111     REAL em_qcondc(klev)
112     c
113     REAL zx_t, zx_qs, zdelta, zcor
114     INTEGER iflag
115     REAL sigsum
116     ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
117     c VARIABLES A SORTIR
118     cccccccccccccccccccccccccccccccccccccccccccccccccc
119    
120     REAL emmip(klev) !variation de flux ascnon dilue i et i+1
121     SAVE emmip
122     real emMke(klev)
123     save emMke
124     real top
125     real bas
126     real emMa(klev)
127     save emMa
128     real Ma(klon,klev)
129     real Ment(klev,klev)
130     real Qent(klev,klev)
131     real TPS(klev),TLS(klev)
132     real SIJ(klev,klev)
133     real em_CAPE, em_TVP(klev)
134     real em_pbase, em_bbase
135     integer iw,j,k,ix,iy
136    
137     c -- sb: pour schema nuages:
138    
139     integer iflagcon
140     integer em_ifc(klev)
141    
142     real em_pradj
143     real em_cldf(klev), em_cldq(klev)
144     real em_ftadj(klev), em_fradj(klev)
145    
146     integer ifc(klon,klev)
147     real pradj(klon)
148     real cldf(klon,klev), cldq(klon,klev)
149     real ftadj(klon,klev), fqadj(klon,klev)
150    
151     c sb --
152    
153     ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
154     c
155    
156     qcond_incld(:,:) = 0.
157     c
158     c$$$ print*,'debut conema'
159    
160     DO 999 i = 1, klon
161     DO l = 1, klev+1
162     em_ph(l) = paprs(i,l) / 100.0
163     ENDDO
164     c
165     DO l = 1, klev
166     em_p(l) = pplay(i,l) / 100.0
167     em_t(l) = t(i,l)
168     em_q(l) = q(i,l)
169     em_u(l) = u(i,l)
170     em_v(l) = v(i,l)
171     do itra = 1, ntra
172     em_tra(l,itra) = tra(i,l,itra)
173     enddo
174     c$$$ print*,'em_t',em_t
175     c$$$ print*,'em_q',em_q
176     c$$$ print*,'em_qs',em_qs
177     c$$$ print*,'em_u',em_u
178     c$$$ print*,'em_v',em_v
179     c$$$ print*,'em_tra',em_tra
180     c$$$ print*,'em_p',em_p
181    
182    
183     c
184     zx_t = em_t(l)
185     zdelta=MAX(0.,SIGN(1.,rtt-zx_t))
186     zx_qs= r2es * FOEEW(zx_t,zdelta)/em_p(l)/100.0
187     zx_qs=MIN(0.5,zx_qs)
188     c$$$ print*,'zx_qs',zx_qs
189     zcor=1./(1.-retv*zx_qs)
190     zx_qs=zx_qs*zcor
191     em_qs(l) = zx_qs
192     c$$$ print*,'em_qs',em_qs
193     c
194     em_work1(l) = work1(i,l)
195     em_work2(l) = work2(i,l)
196     emMke(l)=0
197     c emMa(l)=0
198     c Ma(i,l)=0
199    
200     em_dtvpdt1(l) = 0.
201     em_dtvpdq1(l) = 0.
202     dtvpdt1(i,l) = 0.
203     dtvpdq1(i,l) = 0.
204     ENDDO
205     c
206     em_dplcldt = 0.
207     em_dplcldr = 0.
208     rain(i) = 0.0
209     snow(i) = 0.0
210     kbas(i) = 1
211     ktop(i) = 1
212     c ajout SB:
213     bas = 1
214     top = 1
215    
216    
217     c sb3d write(*,1792) (em_work1(m),m=1,klev)
218     1792 format('sig avant convect ',/,10(1X,E13.5))
219     c
220     c sb d write(*,1793) (em_work2(m),m=1,klev)
221     1793 format('w avant convect ',/,10(1X,E13.5))
222    
223     c$$$ print*,'avant convect'
224     ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
225     c
226    
227     c print*,'avant convect i=',i
228     CALL convect3(dtime,epmax,ok_adj_ema,
229     . em_t, em_q, em_qs,em_u ,em_v ,
230     . em_tra, em_p, em_ph,
231     . klev, klev+1, klev-1,ntra, dtime, iflag,
232     . em_d_t, em_d_q,em_d_u,em_d_v,
233     . em_d_tra, em_precip,
234     . em_bas, em_top,em_upwd, em_dnwd, em_dnwdbis,
235     . em_work1, em_work2,emmip,emMke,emMa,Ment,
236     . Qent,TPS,TLS,SIJ,em_CAPE,em_TVP,em_pbase,em_bbase,
237     . em_dtvpdt1,em_dtvpdq1,em_dplcldt,em_dplcldr, ! sbl
238     . em_d_t2,em_d_q2,em_d_u2,em_d_v2,em_wd,em_qcond,em_qcondc)!sbl
239     c print*,'apres convect '
240     c
241     ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
242     c
243     c -- sb: Appel schema statistique de nuages couple a la convection
244     c (Bony et Emanuel 2001):
245    
246     c -- creer cvthermo.h qui contiendra les cstes thermo de LMDZ:
247    
248     iflagcon = 3
249     c CALL cv_thermo(iflagcon)
250    
251     c -- appel schema de nuages:
252    
253     do k = 1, klev
254     cldf(i,k) = em_cldf(k) ! cloud fraction (0-1)
255     cldq(i,k) = em_cldq(k) ! in-cloud water content (kg/kg)
256     ftadj(i,k) = em_ftadj(k) ! (dT/dt)_{LS adj} (K/s)
257     fqadj(i,k) = em_fradj(k) ! (dq/dt)_{LS adj} (kg/kg/s)
258     ifc(i,k) = em_ifc(k) ! flag convergence clouds_gno (1 ou 2)
259     enddo
260     pradj(i) = em_pradj ! precip from LS supersat adj (mm/day)
261    
262     c sb --
263     c
264     c SB:
265     if (iflag.ne.1 .and. iflag.ne.4) then
266     em_CAPE = 0.
267     do l = 1, klev
268     em_upwd(l) = 0.
269     em_dnwd(l) = 0.
270     em_dnwdbis(l) = 0.
271     emMa(l) = 0.
272     em_TVP(l) = 0.
273     enddo
274     endif
275     c fin SB
276     c
277     c If sig has been set to zero, then set Ma to zero
278     c
279     sigsum = 0.
280     do k = 1,klev
281     sigsum = sigsum + em_work1(k)
282     enddo
283     if (sigsum .eq. 0.0) then
284     do k = 1,klev
285     emMa(k) = 0.
286     enddo
287     endif
288     c
289     c sb3d print*,'i, iflag=',i,iflag
290     c
291     ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
292     c
293     c SORTIE DES ICB ET INB
294     c en fait inb et icb correspondent au niveau ou se trouve
295     c le nuage,le numero d'interface
296     cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
297    
298     c modif SB:
299     if (iflag.EQ.1 .or. iflag.EQ.4) then
300     top=em_top
301     bas=em_bas
302     kbas(i) = em_bas
303     ktop(i) = em_top
304     endif
305    
306     pbase(i) = em_pbase
307     bbase(i) = em_bbase
308     rain(i) = em_precip/ 86400.0
309     snow(i) = 0.0
310     cape(i) = em_CAPE
311     wd(i) = em_wd
312     rflag(i) = float(iflag)
313     c SB kbas(i) = em_bas
314     c SB ktop(i) = em_top
315     dplcldt(i) = em_dplcldt
316     dplcldr(i) = em_dplcldr
317     DO l = 1, klev
318     d_t2(i,l) = dtime * em_d_t2(l)
319     d_q2(i,l) = dtime * em_d_q2(l)
320     d_u2(i,l) = dtime * em_d_u2(l)
321     d_v2(i,l) = dtime * em_d_v2(l)
322    
323     d_t(i,l) = dtime * em_d_t(l)
324     d_q(i,l) = dtime * em_d_q(l)
325     d_u(i,l) = dtime * em_d_u(l)
326     d_v(i,l) = dtime * em_d_v(l)
327     do itra = 1, ntra
328     d_tra(i,l,itra) = dtime * em_d_tra(l,itra)
329     enddo
330     upwd(i,l) = em_upwd(l)
331     dnwd(i,l) = em_dnwd(l)
332     dnwdbis(i,l) = em_dnwdbis(l)
333     work1(i,l) = em_work1(l)
334     work2(i,l) = em_work2(l)
335     Ma(i,l)=emMa(l)
336     tvp(i,l)=em_TVP(l)
337     dtvpdt1(i,l) = em_dtvpdt1(l)
338     dtvpdq1(i,l) = em_dtvpdq1(l)
339    
340     if (iflag_clw.eq.0) then
341     qcond_incld(i,l) = em_qcondc(l)
342     else if (iflag_clw.eq.1) then
343     qcond_incld(i,l) = em_qcond(l)
344     endif
345     ENDDO
346     999 CONTINUE
347    
348     c On calcule une eau liquide diagnostique en fonction de la
349     c precip.
350     if ( iflag_clw.eq.2 ) then
351     do l=1,klev
352     do i=1,klon
353     if (ktop(i)-kbas(i).gt.0.and.
354     s l.ge.kbas(i).and.l.le.ktop(i)) then
355     qcond_incld(i,l)=rain(i)*8.e4
356     s /(pplay(i,kbas(i))-pplay(i,ktop(i)))
357     c s **2
358     else
359     qcond_incld(i,l)=0.
360     endif
361     enddo
362     print*,'l=',l,', qcond_incld=',qcond_incld(1,l)
363     enddo
364     endif
365    
366    
367     RETURN
368     END
369    

  ViewVC Help
Powered by ViewVC 1.1.21