/[lmdze]/trunk/phylmd/conema3.f90
ViewVC logotype

Annotation of /trunk/phylmd/conema3.f90

Parent Directory Parent Directory | Revision Log Revision Log


Revision 52 - (hide annotations)
Fri Sep 23 12:28:01 2011 UTC (12 years, 8 months ago) by guez
Original Path: trunk/libf/phylmd/conema3.f90
File size: 11261 byte(s)
Split "conflx.f" into single-procedure files in directory "Conflx".

Split "cv_routines.f" into single-procedure files in directory
"CV_routines". Made module "cvparam" from included file
"cvparam.h". No included file other than "netcdf.inc" left in LMDZE.

1 guez 52 SUBROUTINE conema3 (dtime,paprs,pplay,t,q,u,v,tra,ntra, &
2     work1,work2,d_t,d_q,d_u,d_v,d_tra, &
3     rain, snow, kbas, ktop, &
4     upwd,dnwd,dnwdbis,bas,top,Ma,cape,tvp,rflag, &
5     pbase,bbase,dtvpdt1,dtvpdq1,dplcldt,dplcldr, &
6     qcond_incld)
7 guez 3
8 guez 52 ! From LMDZ4/libf/phylmd/conema3.F,v 1.1.1.1 2004/05/19 12:53:09
9 guez 3
10 guez 52 use dimens_m
11     use dimphy
12     use SUPHEC_M
13     use conema3_m
14     use yoethf_m
15     use fcttre
16     IMPLICIT none
17     !======================================================================
18     ! Auteur(s): Z.X. Li (LMD/CNRS) date: 19930818
19     ! Objet: schema de convection de Emanuel (1991) interface
20     ! Mai 1998: Interface modifiee pour implementation dans LMDZ
21     !======================================================================
22     ! Arguments:
23     ! dtime---input-R-pas d'integration (s)
24     ! paprs---input-R-pression inter-couches (Pa)
25     ! pplay---input-R-pression au milieu des couches (Pa)
26     ! t-------input-R-temperature (K)
27     ! q-------input-R-humidite specifique (kg/kg)
28     ! u-------input-R-vitesse du vent zonal (m/s)
29     ! v-------input-R-vitesse duvent meridien (m/s)
30     ! tra-----input-R-tableau de rapport de melange des traceurs
31     ! work*: input et output: deux variables de travail,
32     ! on peut les mettre a 0 au debut
33     !
34     ! d_t-----output-R-increment de la temperature
35     ! d_q-----output-R-increment de la vapeur d'eau
36     ! d_u-----output-R-increment de la vitesse zonale
37     ! d_v-----output-R-increment de la vitesse meridienne
38     ! d_tra---output-R-increment du contenu en traceurs
39     ! rain----output-R-la pluie (mm/s)
40     ! snow----output-R-la neige (mm/s)
41     ! kbas----output-R-bas du nuage (integer)
42     ! ktop----output-R-haut du nuage (integer)
43     ! upwd----output-R-saturated updraft mass flux (kg/m**2/s)
44     ! dnwd----output-R-saturated downdraft mass flux (kg/m**2/s)
45     ! dnwdbis-output-R-unsaturated downdraft mass flux (kg/m**2/s)
46     ! bas-----output-R-bas du nuage (real)
47     ! top-----output-R-haut du nuage (real)
48     ! Ma------output-R-flux ascendant non dilue (kg/m**2/s)
49     ! cape----output-R-CAPE
50     ! tvp-----output-R-virtual temperature of the lifted parcel
51     ! rflag---output-R-flag sur le fonctionnement de convect
52     ! pbase---output-R-pression a la base du nuage (Pa)
53     ! bbase---output-R-buoyancy a la base du nuage (K)
54     ! dtvpdt1-output-R-derivative of parcel virtual temp wrt T1
55     ! dtvpdq1-output-R-derivative of parcel virtual temp wrt Q1
56     ! dplcldt-output-R-derivative of the PCP pressure wrt T1
57     ! dplcldr-output-R-derivative of the PCP pressure wrt Q1
58     !======================================================================
59     !
60     INTEGER i, l,m,itra
61     INTEGER ntra,ntrac !number of tracers; if no tracer transport
62     ! is needed, set ntra = 1 (or 0)
63     PARAMETER (ntrac=nqmx-2)
64     REAL, intent(in):: dtime
65     !
66     REAL d_t2(klon,klev), d_q2(klon,klev) ! sbl
67     REAL d_u2(klon,klev), d_v2(klon,klev) ! sbl
68     REAL em_d_t2(klev), em_d_q2(klev) ! sbl
69     REAL em_d_u2(klev), em_d_v2(klev) ! sbl
70     !
71     REAL, intent(in):: paprs(klon,klev+1)
72     real, intent(in):: pplay(klon,klev)
73     REAL, intent(in):: t(klon,klev)
74     real q(klon,klev), d_t(klon,klev), d_q(klon,klev)
75     REAL u(klon,klev), v(klon,klev)
76     real, intent(in):: tra(klon,klev,ntra)
77     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 guez 3
88 guez 52 REAL wd(klon)
89     REAL qcond_incld(klon,klev)
90     !
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 guez 3
109 guez 52 REAL em_wd
110     REAL em_qcond(klev)
111     REAL em_qcondc(klev)
112     !
113     REAL zx_t, zx_qs, zdelta, zcor
114     INTEGER iflag
115     REAL sigsum
116     !cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
117     ! VARIABLES A SORTIR
118     !ccccccccccccccccccccccccccccccccccccccccccccccccc
119 guez 3
120 guez 52 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 guez 3
137 guez 52 ! -- sb: pour schema nuages:
138 guez 3
139 guez 52 integer iflagcon
140     integer em_ifc(klev)
141 guez 3
142 guez 52 real em_pradj
143     real em_cldf(klev), em_cldq(klev)
144     real em_ftadj(klev), em_fradj(klev)
145 guez 3
146 guez 52 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 guez 3
151 guez 52 ! sb --
152 guez 3
153 guez 52 !cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
154     !
155 guez 3
156 guez 52 qcond_incld(:,:) = 0.
157     !
158     !$$$ print*,'debut conema'
159 guez 3
160 guez 52 DO i = 1, klon
161     DO l = 1, klev+1
162     em_ph(l) = paprs(i,l) / 100.0
163     ENDDO
164     !
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     !$$$ print*,'em_t',em_t
175     !$$$ print*,'em_q',em_q
176     !$$$ print*,'em_qs',em_qs
177     !$$$ print*,'em_u',em_u
178     !$$$ print*,'em_v',em_v
179     !$$$ print*,'em_tra',em_tra
180     !$$$ print*,'em_p',em_p
181 guez 3
182    
183 guez 52 !
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     !$$$ 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     !$$$ print*,'em_qs',em_qs
193     !
194     em_work1(l) = work1(i,l)
195     em_work2(l) = work2(i,l)
196     emMke(l)=0
197     ! emMa(l)=0
198     ! 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     !
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     ! ajout SB:
213     bas = 1
214     top = 1
215    
216    
217     ! sb3d write(*,1792) (em_work1(m),m=1,klev)
218     1792 format('sig avant convect ',/,10(1X,E13.5))
219     !
220     ! sb d write(*,1793) (em_work2(m),m=1,klev)
221     1793 format('w avant convect ',/,10(1X,E13.5))
222    
223     !$$$ print*,'avant convect'
224     !cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
225     !
226    
227     ! 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, &
238     em_d_t2,em_d_q2,em_d_u2,em_d_v2,em_wd,em_qcond,em_qcondc)!sbl
239     ! print*,'apres convect '
240     !
241     !cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
242     !
243     ! -- sb: Appel schema statistique de nuages couple a la convection
244     ! (Bony et Emanuel 2001):
245    
246     ! -- creer cvthermo.h qui contiendra les cstes thermo de LMDZ:
247    
248     iflagcon = 3
249     ! CALL cv_thermo(iflagcon)
250    
251     ! -- 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     ! sb --
263     !
264     ! 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 guez 3 enddo
274 guez 52 endif
275     ! fin SB
276     !
277     ! If sig has been set to zero, then set Ma to zero
278     !
279     sigsum = 0.
280     do k = 1,klev
281 guez 3 sigsum = sigsum + em_work1(k)
282 guez 52 enddo
283     if (sigsum .eq. 0.0) then
284 guez 3 do k = 1,klev
285 guez 52 emMa(k) = 0.
286 guez 3 enddo
287 guez 52 endif
288     !
289     ! sb3d print*,'i, iflag=',i,iflag
290     !
291     !cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
292     !
293     ! SORTIE DES ICB ET INB
294     ! en fait inb et icb correspondent au niveau ou se trouve
295     ! le nuage,le numero d'interface
296     !ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
297 guez 3
298 guez 52 ! 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 guez 3
306 guez 52 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     ! SB kbas(i) = em_bas
314     ! 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 guez 3
323 guez 52 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 guez 3
340 guez 52 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     end DO
347 guez 3
348 guez 52 ! On calcule une eau liquide diagnostique en fonction de la
349     ! 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     l.ge.kbas(i).and.l.le.ktop(i)) then
355     qcond_incld(i,l)=rain(i)*8.e4 &
356     /(pplay(i,kbas(i))-pplay(i,ktop(i)))
357     ! 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     END SUBROUTINE conema3

  ViewVC Help
Powered by ViewVC 1.1.21