/[lmdze]/trunk/libf/phylmd/Conflx/flxasc.f90
ViewVC logotype

Annotation of /trunk/libf/phylmd/Conflx/flxasc.f90

Parent Directory Parent Directory | Revision Log Revision Log


Revision 52 - (hide annotations)
Fri Sep 23 12:28:01 2011 UTC (12 years, 9 months ago) by guez
File size: 10417 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 flxasc(pdtime, ptenh, pqenh, pten, pqen, pqsen, &
2     pgeo, pgeoh, pap, paph, pqte, pvervel, &
3     ldland, ldcum, ktype, klab, ptu, pqu, plu, &
4     pmfu, pmfub, pentr, pmfus, pmfuq, &
5     pmful, plude, pdmfup, kcbot, kctop, kctop0, kcum, &
6     pen_u, pde_u)
7     use dimens_m
8     use dimphy
9     use SUPHEC_M
10     use yoethf_m
11     use yoecumf
12     IMPLICIT none
13     !----------------------------------------------------------------------
14     ! THIS ROUTINE DOES THE CALCULATIONS FOR CLOUD ASCENTS
15     ! FOR CUMULUS PARAMETERIZATION
16     !----------------------------------------------------------------------
17     !
18     REAL, intent(in):: pdtime
19     REAL pten(klon,klev), ptenh(klon,klev)
20     REAL pqen(klon,klev), pqenh(klon,klev), pqsen(klon,klev)
21     REAL pgeo(klon,klev), pgeoh(klon,klev)
22     REAL pap(klon,klev), paph(klon,klev+1)
23     REAL pqte(klon,klev)
24     REAL pvervel(klon,klev) ! vitesse verticale en Pa/s
25     !
26     REAL pmfub(klon), pentr(klon)
27     REAL ptu(klon,klev), pqu(klon,klev), plu(klon,klev)
28     REAL plude(klon,klev)
29     REAL pmfu(klon,klev), pmfus(klon,klev)
30     REAL pmfuq(klon,klev), pmful(klon,klev)
31     REAL pdmfup(klon,klev)
32     INTEGER ktype(klon), klab(klon,klev), kcbot(klon), kctop(klon)
33     INTEGER kctop0(klon)
34     LOGICAL ldland(klon), ldcum(klon)
35     !
36     REAL pen_u(klon,klev), pde_u(klon,klev)
37     REAL zqold(klon)
38     REAL zdland(klon)
39     LOGICAL llflag(klon)
40     INTEGER k, i, is, icall, kcum
41     REAL ztglace, zdphi, zqeen, zseen, zscde, zqude
42     REAL zmfusk, zmfuqk, zmfulk, zbuo, zdnoprc, zprcon, zlnew
43     !
44     REAL zpbot(klon), zptop(klon), zrho(klon)
45     REAL zdprho, zentr, zpmid, zmftest, zmfmax
46     LOGICAL llo1, llo2
47     !
48     REAL zwmax(klon), zzzmb
49     INTEGER klwmin(klon) ! level of maximum vertical velocity
50     !----------------------------------------------------------------------
51     ztglace = RTT - 13.
52     !
53     ! Chercher le niveau ou la vitesse verticale est maximale:
54     DO i = 1, klon
55     klwmin(i) = klev
56     zwmax(i) = 0.0
57     ENDDO
58     DO k = klev, 3, -1
59     DO i = 1, klon
60     IF (pvervel(i,k).LT.zwmax(i)) THEN
61     zwmax(i) = pvervel(i,k)
62     klwmin(i) = k
63     ENDIF
64     ENDDO
65     ENDDO
66     !----------------------------------------------------------------------
67     ! SET DEFAULT VALUES
68     !----------------------------------------------------------------------
69     DO i = 1, klon
70     IF (.NOT.ldcum(i)) ktype(i)=0
71     ENDDO
72     !
73     DO k=1,klev
74     DO i = 1, klon
75     plu(i,k)=0.
76     pmfu(i,k)=0.
77     pmfus(i,k)=0.
78     pmfuq(i,k)=0.
79     pmful(i,k)=0.
80     plude(i,k)=0.
81     pdmfup(i,k)=0.
82     IF(.NOT.ldcum(i).OR.ktype(i).EQ.3) klab(i,k)=0
83     IF(.NOT.ldcum(i).AND.paph(i,k).LT.4.E4) kctop0(i)=k
84     ENDDO
85     ENDDO
86     !
87     DO i = 1, klon
88     IF (ldland(i)) THEN
89     zdland(i)=3.0E4
90     zdphi=pgeoh(i,kctop0(i))-pgeoh(i,kcbot(i))
91     IF (ptu(i,kctop0(i)).GE.ztglace) zdland(i)=zdphi
92     zdland(i)=MAX(3.0E4,zdland(i))
93     zdland(i)=MIN(5.0E4,zdland(i))
94     ENDIF
95     ENDDO
96     !
97     ! Initialiser les valeurs au niveau d'ascendance
98     !
99     DO i = 1, klon
100     kctop(i) = klev-1
101     IF (.NOT.ldcum(i)) THEN
102     kcbot(i) = klev-1
103     pmfub(i) = 0.
104     pqu(i,klev) = 0.
105     ENDIF
106     pmfu(i,klev) = pmfub(i)
107     pmfus(i,klev) = pmfub(i)*(RCPD*ptu(i,klev)+pgeoh(i,klev))
108     pmfuq(i,klev) = pmfub(i)*pqu(i,klev)
109     ENDDO
110     !
111     DO i = 1, klon
112     ldcum(i) = .FALSE.
113     ENDDO
114     !----------------------------------------------------------------------
115     ! DO ASCENT: SUBCLOUD LAYER (klab=1) ,CLOUDS (klab=2)
116     ! BY DOING FIRST DRY-ADIABATIC ASCENT AND THEN
117     ! BY ADJUSTING T,Q AND L ACCORDINGLY IN *flxadjtq*,
118     ! THEN CHECK FOR BUOYANCY AND SET FLAGS ACCORDINGLY
119     !----------------------------------------------------------------------
120     DO 480 k = klev-1,3,-1
121     !
122     IF (LMFMID .AND. k.LT.klev-1 .AND. k.GT.klev/2) THEN
123     DO i = 1, klon
124     IF (.NOT.ldcum(i) .AND. klab(i,k+1).EQ.0 .AND. &
125     pqen(i,k).GT.0.9*pqsen(i,k)) THEN
126     ptu(i,k+1) = pten(i,k) +(pgeo(i,k)-pgeoh(i,k+1))/RCPD
127     pqu(i,k+1) = pqen(i,k)
128     plu(i,k+1) = 0.0
129     zzzmb = MAX(CMFCMIN, -pvervel(i,k)/RG)
130     zmfmax = (paph(i,k)-paph(i,k-1))/(RG*pdtime)
131     pmfub(i) = MIN(zzzmb,zmfmax)
132     pmfu(i,k+1) = pmfub(i)
133     pmfus(i,k+1) = pmfub(i)*(RCPD*ptu(i,k+1)+pgeoh(i,k+1))
134     pmfuq(i,k+1) = pmfub(i)*pqu(i,k+1)
135     pmful(i,k+1) = 0.0
136     pdmfup(i,k+1) = 0.0
137     kcbot(i) = k
138     klab(i,k+1) = 1
139     ktype(i) = 3
140     pentr(i) = ENTRMID
141     ENDIF
142     ENDDO
143     ENDIF
144     !
145     is = 0
146     DO i = 1, klon
147     is = is + klab(i,k+1)
148     IF (klab(i,k+1) .EQ. 0) klab(i,k) = 0
149     llflag(i) = .FALSE.
150     IF (klab(i,k+1) .GT. 0) llflag(i) = .TRUE.
151     ENDDO
152     IF (is .EQ. 0) GOTO 480
153     !
154     ! calculer le taux d'entrainement et de detrainement
155     !
156     DO i = 1, klon
157     pen_u(i,k) = 0.0
158     pde_u(i,k) = 0.0
159     zrho(i)=paph(i,k+1)/(RD*ptenh(i,k+1))
160     zpbot(i)=paph(i,kcbot(i))
161     zptop(i)=paph(i,kctop0(i))
162     ENDDO
163     !
164     DO 125 i = 1, klon
165     IF(ldcum(i)) THEN
166     zdprho=(paph(i,k+1)-paph(i,k))/(RG*zrho(i))
167     zentr=pentr(i)*pmfu(i,k+1)*zdprho
168     llo1=k.LT.kcbot(i)
169     IF(llo1) pde_u(i,k)=zentr
170     zpmid=0.5*(zpbot(i)+zptop(i))
171     llo2=llo1.AND.ktype(i).EQ.2.AND. &
172     (zpbot(i)-paph(i,k).LT.0.2E5.OR. &
173     paph(i,k).GT.zpmid)
174     IF(llo2) pen_u(i,k)=zentr
175     llo2=llo1.AND.(ktype(i).EQ.1.OR.ktype(i).EQ.3).AND. &
176     (k.GE.MAX(klwmin(i),kctop0(i)+2).OR.pap(i,k).GT.zpmid)
177     IF(llo2) pen_u(i,k)=zentr
178     llo1=pen_u(i,k).GT.0..AND.(ktype(i).EQ.1.OR.ktype(i).EQ.2)
179     IF(llo1) THEN
180     zentr=zentr*(1.+3.*(1.-MIN(1.,(zpbot(i)-pap(i,k))/1.5E4)))
181     pen_u(i,k)=pen_u(i,k)*(1.+3.*(1.-MIN(1., &
182     (zpbot(i)-pap(i,k))/1.5E4)))
183     pde_u(i,k)=pde_u(i,k)*(1.+3.*(1.-MIN(1., &
184     (zpbot(i)-pap(i,k))/1.5E4)))
185     ENDIF
186     IF(llo2.AND.pqenh(i,k+1).GT.1.E-5) &
187     pen_u(i,k)=zentr+MAX(pqte(i,k),0.)/pqenh(i,k+1)* &
188     zrho(i)*zdprho
189     ENDIF
190     125 CONTINUE
191     !
192     !----------------------------------------------------------------------
193     ! DO ADIABATIC ASCENT FOR ENTRAINING/DETRAINING PLUME
194     !----------------------------------------------------------------------
195     !
196     DO 420 i = 1, klon
197     IF (llflag(i)) THEN
198     IF (k.LT.kcbot(i)) THEN
199     zmftest = pmfu(i,k+1)+pen_u(i,k)-pde_u(i,k)
200     zmfmax = MIN(zmftest,(paph(i,k)-paph(i,k-1))/(RG*pdtime))
201     pen_u(i,k)=MAX(pen_u(i,k)-MAX(0.0,zmftest-zmfmax),0.0)
202     ENDIF
203     pde_u(i,k)=MIN(pde_u(i,k),0.75*pmfu(i,k+1))
204     ! calculer le flux de masse du niveau k a partir de celui du k+1
205     pmfu(i,k)=pmfu(i,k+1)+pen_u(i,k)-pde_u(i,k)
206     ! calculer les valeurs Su, Qu et l du niveau k dans le panache montant
207     zqeen=pqenh(i,k+1)*pen_u(i,k)
208     zseen=(RCPD*ptenh(i,k+1)+pgeoh(i,k+1))*pen_u(i,k)
209     zscde=(RCPD*ptu(i,k+1)+pgeoh(i,k+1))*pde_u(i,k)
210     zqude=pqu(i,k+1)*pde_u(i,k)
211     plude(i,k)=plu(i,k+1)*pde_u(i,k)
212     zmfusk=pmfus(i,k+1)+zseen-zscde
213     zmfuqk=pmfuq(i,k+1)+zqeen-zqude
214     zmfulk=pmful(i,k+1) -plude(i,k)
215     plu(i,k)=zmfulk*(1./MAX(CMFCMIN,pmfu(i,k)))
216     pqu(i,k)=zmfuqk*(1./MAX(CMFCMIN,pmfu(i,k)))
217     ptu(i,k)=(zmfusk*(1./MAX(CMFCMIN,pmfu(i,k)))- &
218     pgeoh(i,k))/RCPD
219     ptu(i,k)=MAX(100.,ptu(i,k))
220     ptu(i,k)=MIN(400.,ptu(i,k))
221     zqold(i)=pqu(i,k)
222     ELSE
223     zqold(i)=0.0
224     ENDIF
225     420 CONTINUE
226     !
227     !----------------------------------------------------------------------
228     ! DO CORRECTIONS FOR MOIST ASCENT BY ADJUSTING T,Q AND L
229     !----------------------------------------------------------------------
230     !
231     icall = 1
232     CALL flxadjtq(paph(1,k), ptu(1,k), pqu(1,k), llflag, icall)
233     !
234     DO 440 i = 1, klon
235     IF(llflag(i).AND.pqu(i,k).NE.zqold(i)) THEN
236     klab(i,k) = 2
237     plu(i,k) = plu(i,k)+zqold(i)-pqu(i,k)
238     zbuo = ptu(i,k)*(1.+RETV*pqu(i,k))- &
239     ptenh(i,k)*(1.+RETV*pqenh(i,k))
240     IF (klab(i,k+1).EQ.1) zbuo=zbuo+0.5
241     IF (zbuo.GT.0..AND.pmfu(i,k).GE.0.1*pmfub(i)) THEN
242     kctop(i) = k
243     ldcum(i) = .TRUE.
244     zdnoprc = 1.5E4
245     IF (ldland(i)) zdnoprc = zdland(i)
246     zprcon = CPRCON
247     IF ((zpbot(i)-paph(i,k)).LT.zdnoprc) zprcon = 0.0
248     zlnew=plu(i,k)/(1.+zprcon*(pgeoh(i,k)-pgeoh(i,k+1)))
249     pdmfup(i,k)=MAX(0.,(plu(i,k)-zlnew)*pmfu(i,k))
250     plu(i,k)=zlnew
251     ELSE
252     klab(i,k)=0
253     pmfu(i,k)=0.
254     ENDIF
255     ENDIF
256     440 CONTINUE
257     DO 455 i = 1, klon
258     IF (llflag(i)) THEN
259     pmful(i,k)=plu(i,k)*pmfu(i,k)
260     pmfus(i,k)=(RCPD*ptu(i,k)+pgeoh(i,k))*pmfu(i,k)
261     pmfuq(i,k)=pqu(i,k)*pmfu(i,k)
262     ENDIF
263     455 CONTINUE
264     !
265     480 CONTINUE
266     !----------------------------------------------------------------------
267     ! DETERMINE CONVECTIVE FLUXES ABOVE NON-BUOYANCY LEVEL
268     ! (NOTE: CLOUD VARIABLES LIKE T,Q AND L ARE NOT
269     ! AFFECTED BY DETRAINMENT AND ARE ALREADY KNOWN
270     ! FROM PREVIOUS CALCULATIONS ABOVE)
271     !----------------------------------------------------------------------
272     DO i = 1, klon
273     IF (kctop(i).EQ.klev-1) ldcum(i) = .FALSE.
274     kcbot(i) = MAX(kcbot(i),kctop(i))
275     ENDDO
276     !
277     ldcum(1)=ldcum(1)
278     !
279     is = 0
280     DO i = 1, klon
281     if (ldcum(i)) is = is + 1
282     ENDDO
283     kcum = is
284     IF (is.EQ.0) GOTO 800
285     !
286     DO 530 i = 1, klon
287     IF (ldcum(i)) THEN
288     k=kctop(i)-1
289     pde_u(i,k)=(1.-CMFCTOP)*pmfu(i,k+1)
290     plude(i,k)=pde_u(i,k)*plu(i,k+1)
291     pmfu(i,k)=pmfu(i,k+1)-pde_u(i,k)
292     zlnew=plu(i,k)
293     pdmfup(i,k)=MAX(0.,(plu(i,k)-zlnew)*pmfu(i,k))
294     plu(i,k)=zlnew
295     pmfus(i,k)=(RCPD*ptu(i,k)+pgeoh(i,k))*pmfu(i,k)
296     pmfuq(i,k)=pqu(i,k)*pmfu(i,k)
297     pmful(i,k)=plu(i,k)*pmfu(i,k)
298     plude(i,k-1)=pmful(i,k)
299     ENDIF
300     530 CONTINUE
301     !
302     800 CONTINUE
303     RETURN
304     END

  ViewVC Help
Powered by ViewVC 1.1.21