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

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

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

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