/[lmdze]/trunk/Sources/phylmd/Conflx/flxasc.f
ViewVC logotype

Diff of /trunk/Sources/phylmd/Conflx/flxasc.f

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

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