/[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

trunk/libf/phylmd/Conflx/flxasc.f90 revision 52 by guez, Fri Sep 23 12:28:01 2011 UTC trunk/phylmd/Conflx/flxasc.f revision 82 by guez, Wed Mar 5 14:57:53 2014 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, intent(in):: pap(klon, klev), paph(klon, klev+1)
28        REAL plude(klon,klev)      REAL, intent(in):: pqte(klon, klev)
29        REAL pmfu(klon,klev), pmfus(klon,klev)      REAL, intent(in):: pvervel(klon, klev) ! vitesse verticale en Pa/s
30        REAL pmfuq(klon,klev), pmful(klon,klev)      LOGICAL, intent(in):: 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      real fact
63        ENDIF  
64        ENDDO      !----------------------------------------------------------------------
65        ENDDO  
66  !----------------------------------------------------------------------      ztglace = RTT - 13.
67  ! SET DEFAULT VALUES  
68  !----------------------------------------------------------------------      ! Chercher le niveau où la vitesse verticale est maximale :
69        DO i = 1, klon  
70           IF (.NOT.ldcum(i)) ktype(i)=0      DO i = 1, klon
71        ENDDO         klwmin(i) = klev
72  !         zwmax(i) = 0.0
73        DO k=1,klev      ENDDO
74        DO i = 1, klon  
75           plu(i,k)=0.      DO k = klev, 3, -1
76           pmfu(i,k)=0.         DO i = 1, klon
77           pmfus(i,k)=0.            IF (pvervel(i, k) < zwmax(i)) THEN
78           pmfuq(i,k)=0.               zwmax(i) = pvervel(i, k)
79           pmful(i,k)=0.               klwmin(i) = k
80           plude(i,k)=0.            ENDIF
81           pdmfup(i,k)=0.         ENDDO
82           IF(.NOT.ldcum(i).OR.ktype(i).EQ.3) klab(i,k)=0      ENDDO
83           IF(.NOT.ldcum(i).AND.paph(i,k).LT.4.E4) kctop0(i)=k  
84        ENDDO      ! Set default values:
85        ENDDO  
86  !      DO i = 1, klon
87        DO i = 1, klon         IF (.NOT. ldcum(i)) ktype(i)=0
88        IF (ldland(i)) THEN      ENDDO
89           zdland(i)=3.0E4  
90           zdphi=pgeoh(i,kctop0(i))-pgeoh(i,kcbot(i))      DO k=1, klev
91           IF (ptu(i,kctop0(i)).GE.ztglace) zdland(i)=zdphi         DO i = 1, klon
92           zdland(i)=MAX(3.0E4,zdland(i))            plu(i, k)=0.
93           zdland(i)=MIN(5.0E4,zdland(i))            pmfu(i, k)=0.
94        ENDIF            pmfus(i, k)=0.
95        ENDDO            pmfuq(i, k)=0.
96  !            pmful(i, k)=0.
97  ! Initialiser les valeurs au niveau d'ascendance            plude(i, k)=0.
98  !            pdmfup(i, k)=0.
99        DO i = 1, klon            IF (.NOT. ldcum(i) .OR. ktype(i) == 3) klab(i, k)=0
100           kctop(i) = klev-1            IF (.NOT. ldcum(i) .AND. paph(i, k) < 4e4) kctop0(i) = k
101           IF (.NOT.ldcum(i)) THEN         ENDDO
102              kcbot(i) = klev-1      ENDDO
103              pmfub(i) = 0.  
104              pqu(i,klev) = 0.      DO i = 1, klon
105           ENDIF         IF (ldland(i)) THEN
106           pmfu(i,klev) = pmfub(i)            zdland(i)=3.0E4
107           pmfus(i,klev) = pmfub(i)*(RCPD*ptu(i,klev)+pgeoh(i,klev))            zdphi=pgeoh(i, kctop0(i))-pgeoh(i, kcbot(i))
108           pmfuq(i,klev) = pmfub(i)*pqu(i,klev)            IF (ptu(i, kctop0(i)) >= ztglace) zdland(i)=zdphi
109        ENDDO            zdland(i)=MAX(3.0E4, zdland(i))
110  !            zdland(i)=MIN(5.0E4, zdland(i))
111        DO i = 1, klon         ENDIF
112           ldcum(i) = .FALSE.      ENDDO
113        ENDDO  
114  !----------------------------------------------------------------------      ! Initialiser les valeurs au niveau d'ascendance
115  !  DO ASCENT: SUBCLOUD LAYER (klab=1) ,CLOUDS (klab=2)  
116  !  BY DOING FIRST DRY-ADIABATIC ASCENT AND THEN      DO i = 1, klon
117  !  BY ADJUSTING T,Q AND L ACCORDINGLY IN *flxadjtq*,         kctop(i) = klev-1
118  !  THEN CHECK FOR BUOYANCY AND SET FLAGS ACCORDINGLY         IF (.NOT. ldcum(i)) THEN
119  !----------------------------------------------------------------------            kcbot(i) = klev-1
120        DO 480 k = klev-1,3,-1            pmfub(i) = 0.
121  !            pqu(i, klev) = 0.
122        IF (LMFMID .AND. k.LT.klev-1 .AND. k.GT.klev/2) THEN         ENDIF
123           DO i = 1, klon         pmfu(i, klev) = pmfub(i)
124           IF (.NOT.ldcum(i) .AND. klab(i,k+1).EQ.0 .AND. &         pmfus(i, klev) = pmfub(i) * (RCPD * ptu(i, klev)+pgeoh(i, klev))
125               pqen(i,k).GT.0.9*pqsen(i,k)) THEN         pmfuq(i, klev) = pmfub(i) * pqu(i, klev)
126              ptu(i,k+1) = pten(i,k) +(pgeo(i,k)-pgeoh(i,k+1))/RCPD      ENDDO
127              pqu(i,k+1) = pqen(i,k)  
128              plu(i,k+1) = 0.0      DO i = 1, klon
129              zzzmb = MAX(CMFCMIN, -pvervel(i,k)/RG)         ldcum(i) = .FALSE.
130              zmfmax = (paph(i,k)-paph(i,k-1))/(RG*pdtime)      ENDDO
131              pmfub(i) = MIN(zzzmb,zmfmax)  
132              pmfu(i,k+1) = pmfub(i)      ! Do ascent: subcloud layer (klab=1), clouds (klab=2) by doing
133              pmfus(i,k+1) = pmfub(i)*(RCPD*ptu(i,k+1)+pgeoh(i,k+1))      ! first dry-adiabatic ascent and then by adjusting t, q and l
134              pmfuq(i,k+1) = pmfub(i)*pqu(i,k+1)      ! accordingly in flxadjtq, then check for buoyancy and set flags
135              pmful(i,k+1) = 0.0      ! accordingly.
136              pdmfup(i,k+1) = 0.0  
137              kcbot(i) = k      DO k = klev - 1, 3, -1
138              klab(i,k+1) = 1         IF (LMFMID .AND. k < klev - 1 .AND. k > klev / 2) THEN
139              ktype(i) = 3            DO i = 1, klon
140              pentr(i) = ENTRMID               IF (.NOT. ldcum(i) .AND. klab(i, k + 1) == 0 .AND. &
141           ENDIF                    pqen(i, k) > 0.9 * pqsen(i, k)) THEN
142           ENDDO                  ptu(i, k+1) = pten(i, k) +(pgeo(i, k)-pgeoh(i, k+1))/RCPD
143        ENDIF                  pqu(i, k+1) = pqen(i, k)
144  !                  plu(i, k+1) = 0.0
145        is = 0                  zzzmb = MAX(CMFCMIN, -pvervel(i, k)/RG)
146        DO i = 1, klon                  zmfmax = (paph(i, k) - paph(i, k-1)) / (RG * pdtime)
147           is = is + klab(i,k+1)                  pmfub(i) = MIN(zzzmb, zmfmax)
148           IF (klab(i,k+1) .EQ. 0) klab(i,k) = 0                  pmfu(i, k+1) = pmfub(i)
149           llflag(i) = .FALSE.                  pmfus(i, k+1) = pmfub(i) * (RCPD * ptu(i, k+1)+pgeoh(i, k+1))
150           IF (klab(i,k+1) .GT. 0) llflag(i) = .TRUE.                  pmfuq(i, k+1) = pmfub(i) * pqu(i, k+1)
151        ENDDO                  pmful(i, k+1) = 0.0
152        IF (is .EQ. 0) GOTO 480                  pdmfup(i, k+1) = 0.0
153  !                  kcbot(i) = k
154  ! calculer le taux d'entrainement et de detrainement                  klab(i, k+1) = 1
155  !                  ktype(i) = 3
156        DO i = 1, klon                  pentr(i) = ENTRMID
157           pen_u(i,k) = 0.0               ENDIF
158           pde_u(i,k) = 0.0            ENDDO
159           zrho(i)=paph(i,k+1)/(RD*ptenh(i,k+1))         ENDIF
160           zpbot(i)=paph(i,kcbot(i))  
161           zptop(i)=paph(i,kctop0(i))         is = 0
162        ENDDO         DO i = 1, klon
163  !            is = is + klab(i, k+1)
164        DO 125 i = 1, klon            IF (klab(i, k+1) == 0) klab(i, k) = 0
165        IF(ldcum(i)) THEN            llflag(i) = .FALSE.
166           zdprho=(paph(i,k+1)-paph(i,k))/(RG*zrho(i))            IF (klab(i, k+1) > 0) llflag(i) = .TRUE.
167           zentr=pentr(i)*pmfu(i,k+1)*zdprho         ENDDO
168           llo1=k.LT.kcbot(i)         IF (is == 0) cycle
169           IF(llo1) pde_u(i,k)=zentr  
170           zpmid=0.5*(zpbot(i)+zptop(i))         ! Calculer le taux d'entraînement et de détraînement :
171           llo2=llo1.AND.ktype(i).EQ.2.AND. &  
172                (zpbot(i)-paph(i,k).LT.0.2E5.OR. &         DO i = 1, klon
173                 paph(i,k).GT.zpmid)            pen_u(i, k) = 0.0
174           IF(llo2) pen_u(i,k)=zentr            pde_u(i, k) = 0.0
175           llo2=llo1.AND.(ktype(i).EQ.1.OR.ktype(i).EQ.3).AND. &            zrho(i) = paph(i, k + 1) / (RD * ptenh(i, k + 1))
176                (k.GE.MAX(klwmin(i),kctop0(i)+2).OR.pap(i,k).GT.zpmid)            zpbot(i) = paph(i, kcbot(i))
177           IF(llo2) pen_u(i,k)=zentr            zptop(i) = paph(i, kctop0(i))
178           llo1=pen_u(i,k).GT.0..AND.(ktype(i).EQ.1.OR.ktype(i).EQ.2)         ENDDO
179           IF(llo1) THEN  
180              zentr=zentr*(1.+3.*(1.-MIN(1.,(zpbot(i)-pap(i,k))/1.5E4)))         DO i = 1, klon
181              pen_u(i,k)=pen_u(i,k)*(1.+3.*(1.-MIN(1., &            IF (ldcum(i)) THEN
182                         (zpbot(i)-pap(i,k))/1.5E4)))               zdprho = (paph(i, k + 1) - paph(i, k)) / (RG * zrho(i))
183              pde_u(i,k)=pde_u(i,k)*(1.+3.*(1.-MIN(1., &               zentr=pentr(i) * pmfu(i, k+1) * zdprho
184                         (zpbot(i)-pap(i,k))/1.5E4)))               llo1=k < kcbot(i)
185           ENDIF               IF (llo1) pde_u(i, k)=zentr
186           IF(llo2.AND.pqenh(i,k+1).GT.1.E-5) &               zpmid=0.5 * (zpbot(i)+zptop(i))
187           pen_u(i,k)=zentr+MAX(pqte(i,k),0.)/pqenh(i,k+1)* &               llo2 = llo1 .AND. ktype(i) == 2 &
188                      zrho(i)*zdprho                    .AND. (zpbot(i) - paph(i, k) < 0.2E5 .OR. 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  !                  fact = 1. + 3. * (1. - MIN(1., (zpbot(i) - pap(i, k)) / 1.5E4))
196        DO 420 i = 1, klon                  zentr = zentr * fact
197        IF (llflag(i)) THEN                  pen_u(i, k)=pen_u(i, k) * fact
198           IF (k.LT.kcbot(i)) THEN                  pde_u(i, k)=pde_u(i, k) * fact
199              zmftest = pmfu(i,k+1)+pen_u(i,k)-pde_u(i,k)               ENDIF
200              zmfmax = MIN(zmftest,(paph(i,k)-paph(i,k-1))/(RG*pdtime))               IF (llo2 .AND. pqenh(i, k+1) > 1e-5) &
201              pen_u(i,k)=MAX(pen_u(i,k)-MAX(0.0,zmftest-zmfmax),0.0)                    pen_u(i, k)=zentr+MAX(pqte(i, k), 0.)/pqenh(i, k+1) * &
202           ENDIF                    zrho(i) * zdprho
203           pde_u(i,k)=MIN(pde_u(i,k),0.75*pmfu(i,k+1))            ENDIF
204  ! calculer le flux de masse du niveau k a partir de celui du k+1         end DO
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         ! Do adiabatic ascent for entraining/detraining plume
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)         DO i = 1, klon
209           zscde=(RCPD*ptu(i,k+1)+pgeoh(i,k+1))*pde_u(i,k)            IF (llflag(i)) THEN
210           zqude=pqu(i,k+1)*pde_u(i,k)               IF (k < kcbot(i)) THEN
211           plude(i,k)=plu(i,k+1)*pde_u(i,k)                  zmftest = pmfu(i, k+1)+pen_u(i, k)-pde_u(i, k)
212           zmfusk=pmfus(i,k+1)+zseen-zscde                  zmfmax = MIN(zmftest, &
213           zmfuqk=pmfuq(i,k+1)+zqeen-zqude                       (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.
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  !      end DO
277        ldcum(1)=ldcum(1)  
278  !      ! Determine convective fluxes above non-buoyancy level (note:
279        is = 0      ! cloud variables like t, q and l are not affected by detrainment
280        DO i = 1, klon      ! and are already known from previous calculations above).
281           if (ldcum(i)) is = is + 1  
282        ENDDO      DO i = 1, klon
283        kcum = is         IF (kctop(i) == klev-1) ldcum(i) = .FALSE.
284        IF (is.EQ.0) GOTO 800         kcbot(i) = MAX(kcbot(i), kctop(i))
285  !      ENDDO
286        DO 530 i = 1, klon  
287        IF (ldcum(i)) THEN      ldcum(1)=ldcum(1)
288           k=kctop(i)-1  
289           pde_u(i,k)=(1.-CMFCTOP)*pmfu(i,k+1)      is = 0
290           plude(i,k)=pde_u(i,k)*plu(i,k+1)      DO i = 1, klon
291           pmfu(i,k)=pmfu(i,k+1)-pde_u(i,k)         if (ldcum(i)) is = is + 1
292           zlnew=plu(i,k)      ENDDO
293           pdmfup(i,k)=MAX(0.,(plu(i,k)-zlnew)*pmfu(i,k))      kcum = is
294           plu(i,k)=zlnew      IF (is /= 0) then
295           pmfus(i,k)=(RCPD*ptu(i,k)+pgeoh(i,k))*pmfu(i,k)         DO i = 1, klon
296           pmfuq(i,k)=pqu(i,k)*pmfu(i,k)            IF (ldcum(i)) THEN
297           pmful(i,k)=plu(i,k)*pmfu(i,k)               k=kctop(i)-1
298           plude(i,k-1)=pmful(i,k)               pde_u(i, k)=(1.-CMFCTOP) * pmfu(i, k+1)
299        ENDIF               plude(i, k)=pde_u(i, k) * plu(i, k+1)
300    530 CONTINUE               pmfu(i, k)=pmfu(i, k+1)-pde_u(i, k)
301  !               zlnew=plu(i, k)
302    800 CONTINUE               pdmfup(i, k)=MAX(0., (plu(i, k)-zlnew) * pmfu(i, k))
303        RETURN               plu(i, k)=zlnew
304        END               pmfus(i, k)=(RCPD * ptu(i, k)+pgeoh(i, k)) * pmfu(i, k)
305                 pmfuq(i, k)=pqu(i, k) * pmfu(i, k)
306                 pmful(i, k)=plu(i, k) * pmfu(i, k)
307                 plude(i, k-1)=pmful(i, k)
308              ENDIF
309           end DO
310        end IF
311    
312      END SUBROUTINE flxasc
313    
314    end module flxasc_m
Legend:
Removed from v.52  
changed lines
  Added in v.82
  ViewVC Help
Powered by ViewVC 1.1.21