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

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

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

trunk/libf/phylmd/Conflx/flxflux.f90 revision 70 by guez, Mon Jun 24 15:39:52 2013 UTC trunk/phylmd/Conflx/flxflux.f90 revision 78 by guez, Wed Feb 5 17:51:07 2014 UTC
# Line 5  module flxflux_m Line 5  module flxflux_m
5  contains  contains
6    
7    SUBROUTINE flxflux(pdtime, pqen, pqsen, ptenh, pqenh, pap, paph, ldland, &    SUBROUTINE flxflux(pdtime, pqen, pqsen, ptenh, pqenh, pap, paph, ldland, &
8         pgeoh, kcbot, kctop, lddraf, kdtop, ktype, ldcum, pmfu, pmfd, pmfus, &         pgeoh, kcbot, kctop, lddraf, kdtop, ktype, ldcum, mfu, pmfd, mfus, &
9         pmfds, pmfuq, pmfdq, pmful, plude, pdmfup, pdmfdp, pten, prfl, psfl, &         pmfds, mfuq, pmfdq, mful, plude, pdmfup, pdmfdp, pten, prfl, psfl, &
10         pdpmel, ktopm2, pmflxr, pmflxs)         pdpmel, ktopm2, pmflxr, pmflxs)
11    
12      ! This routine does the final calculation of convective fluxes in      ! This routine does the final calculation of convective fluxes in
# Line 22  contains Line 22  contains
22      real, intent(inout):: pqsen(klon, klev)      real, intent(inout):: pqsen(klon, klev)
23      REAL, intent(in):: ptenh(klon, klev)      REAL, intent(in):: ptenh(klon, klev)
24      REAL, intent(in):: pqenh(klon, klev)      REAL, intent(in):: pqenh(klon, klev)
25      REAL pap(klon, klev)      REAL, intent(in):: pap(klon, klev)
26      REAL paph(klon, klev+1)      REAL, intent(in):: paph(klon, klev + 1)
27      LOGICAL ldland(klon)      LOGICAL ldland(klon)
28      real pgeoh(klon, klev)      real pgeoh(klon, klev)
29      INTEGER, intent(in):: kcbot(klon), kctop(klon)      INTEGER, intent(in):: kcbot(klon), kctop(klon)
# Line 31  contains Line 31  contains
31      INTEGER kdtop(klon)      INTEGER kdtop(klon)
32      INTEGER, intent(inout):: ktype(klon)      INTEGER, intent(inout):: ktype(klon)
33      LOGICAL, intent(in):: ldcum(klon)      LOGICAL, intent(in):: ldcum(klon)
34      REAL pmfu(klon, klev)      REAL mfu(klon, klev)
35      REAL pmfd(klon, klev)      REAL pmfd(klon, klev)
36      real pmfus(klon, klev)      real, intent(inout):: mfus(klon, klev)
37      real pmfds(klon, klev)      real pmfds(klon, klev)
38      REAL pmfuq(klon, klev)      REAL mfuq(klon, klev)
39      REAL pmfdq(klon, klev)      REAL pmfdq(klon, klev)
40      real pmful(klon, klev)      real mful(klon, klev)
41      REAL plude(klon, klev)      REAL plude(klon, klev)
42      REAL pdmfup(klon, klev)      REAL pdmfup(klon, klev)
43      REAL pdmfdp(klon, klev)      REAL pdmfdp(klon, klev)
# Line 45  contains Line 45  contains
45      REAL prfl(klon), psfl(klon)      REAL prfl(klon), psfl(klon)
46      real pdpmel(klon, klev)      real pdpmel(klon, klev)
47      INTEGER, intent(out):: ktopm2      INTEGER, intent(out):: ktopm2
48      REAL pmflxr(klon, klev+1), pmflxs(klon, klev+1)      REAL pmflxr(klon, klev + 1), pmflxs(klon, klev + 1)
49    
50      ! Local:      ! Local:
51      REAL cevapcu(klev)      REAL cevapcu(klev)
# Line 66  contains Line 66  contains
66    
67      DO k=1, klev      DO k=1, klev
68         CEVAPCU(k)=1.93E-6*261.*SQRT(1.E3/(38.3*0.293) &         CEVAPCU(k)=1.93E-6*261.*SQRT(1.E3/(38.3*0.293) &
69              *SQRT(0.5*(paph(1, k)+paph(1, k+1))/paph(1, klev+1))) * 0.5/RG              *SQRT(0.5*(paph(1, k) + paph(1, k + 1))/paph(1, klev + 1))) * 0.5/RG
70      end DO      end DO
71    
72      ! SPECIFY CONSTANTS      ! SPECIFY CONSTANTS
# Line 88  contains Line 88  contains
88      DO k = ktopm2, klev      DO k = ktopm2, klev
89         DO i = 1, klon         DO i = 1, klon
90            IF (ldcum(i) .AND. k >= kctop(i) - 1) THEN            IF (ldcum(i) .AND. k >= kctop(i) - 1) THEN
91               pmfus(i, k) = pmfus(i, k) &               mfus(i, k) = mfus(i, k) &
92                    - pmfu(i, k) * (RCPD * ptenh(i, k) + pgeoh(i, k))                    - mfu(i, k) * (RCPD * ptenh(i, k) + pgeoh(i, k))
93               pmfuq(i, k)=pmfuq(i, k)-pmfu(i, k)*pqenh(i, k)               mfuq(i, k)=mfuq(i, k)-mfu(i, k)*pqenh(i, k)
94               zdp = 1.5E4               zdp = 1.5E4
95               IF (ldland(i)) zdp = 3.E4               IF (ldland(i)) zdp = 3.E4
96    
# Line 104  contains Line 104  contains
104    
105               IF (lddraf(i).AND.k >= kdtop(i)) THEN               IF (lddraf(i).AND.k >= kdtop(i)) THEN
106                  pmfds(i, k)=pmfds(i, k)-pmfd(i, k)* &                  pmfds(i, k)=pmfds(i, k)-pmfd(i, k)* &
107                       (RCPD*ptenh(i, k)+pgeoh(i, k))                       (RCPD*ptenh(i, k) + pgeoh(i, k))
108                  pmfdq(i, k)=pmfdq(i, k)-pmfd(i, k)*pqenh(i, k)                  pmfdq(i, k)=pmfdq(i, k)-pmfd(i, k)*pqenh(i, k)
109               ELSE               ELSE
110                  pmfd(i, k)=0.                  pmfd(i, k)=0.
# Line 113  contains Line 113  contains
113                  pdmfdp(i, k-1)=0.                  pdmfdp(i, k-1)=0.
114               END IF               END IF
115            ELSE            ELSE
116               pmfu(i, k)=0.               mfu(i, k)=0.
117               pmfus(i, k)=0.               mfus(i, k)=0.
118               pmfuq(i, k)=0.               mfuq(i, k)=0.
119               pmful(i, k)=0.               mful(i, k)=0.
120               pdmfup(i, k-1)=0.               pdmfup(i, k-1)=0.
121               plude(i, k-1)=0.               plude(i, k-1)=0.
122               pmfd(i, k)=0.               pmfd(i, k)=0.
# Line 134  contains Line 134  contains
134               zzp = ((paph(i, klev + 1) - paph(i, k)) &               zzp = ((paph(i, klev + 1) - paph(i, k)) &
135                    / (paph(i, klev + 1) - paph(i, ikb)))                    / (paph(i, klev + 1) - paph(i, ikb)))
136               IF (ktype(i) == 3) zzp = zzp**2               IF (ktype(i) == 3) zzp = zzp**2
137               pmfu(i, k)=pmfu(i, ikb)*zzp               mfu(i, k)=mfu(i, ikb)*zzp
138               pmfus(i, k)=pmfus(i, ikb)*zzp               mfus(i, k)=mfus(i, ikb)*zzp
139               pmfuq(i, k)=pmfuq(i, ikb)*zzp               mfuq(i, k)=mfuq(i, ikb)*zzp
140               pmful(i, k)=pmful(i, ikb)*zzp               mful(i, k)=mful(i, ikb)*zzp
141            ENDIF            ENDIF
142         end DO         end DO
143      end DO      end DO
# Line 146  contains Line 146  contains
146      ! CALCULATE MELTING OF SNOW      ! CALCULATE MELTING OF SNOW
147      ! CALCULATE EVAPORATION OF PRECIP      ! CALCULATE EVAPORATION OF PRECIP
148    
149      DO k = 1, klev+1      DO k = 1, klev + 1
150         DO i = 1, klon         DO i = 1, klon
151            pmflxr(i, k) = 0.0            pmflxr(i, k) = 0.0
152            pmflxs(i, k) = 0.0            pmflxs(i, k) = 0.0
# Line 156  contains Line 156  contains
156         DO i = 1, klon         DO i = 1, klon
157            IF (ldcum(i)) THEN            IF (ldcum(i)) THEN
158               IF (pmflxs(i, k) > 0.0 .AND. pten(i, k) > ztmelp2) THEN               IF (pmflxs(i, k) > 0.0 .AND. pten(i, k) > ztmelp2) THEN
159                  zfac=zcons1*(paph(i, k+1)-paph(i, k))                  zfac=zcons1*(paph(i, k + 1)-paph(i, k))
160                  zsnmlt=MIN(pmflxs(i, k), zfac*(pten(i, k)-ztmelp2))                  zsnmlt=MIN(pmflxs(i, k), zfac*(pten(i, k)-ztmelp2))
161                  pdpmel(i, k)=zsnmlt                  pdpmel(i, k)=zsnmlt
162                  ztmsmlt=pten(i, k)-zsnmlt/zfac                  ztmsmlt=pten(i, k)-zsnmlt/zfac
# Line 169  contains Line 169  contains
169               IF (pten(i, k) > RTT) THEN               IF (pten(i, k) > RTT) THEN
170                  pmflxr(i, k + 1) = pmflxr(i, k) + pdmfup(i, k) + pdmfdp(i, k) &                  pmflxr(i, k + 1) = pmflxr(i, k) + pdmfup(i, k) + pdmfdp(i, k) &
171                       + pdpmel(i, k)                       + pdpmel(i, k)
172                  pmflxs(i, k+1)=pmflxs(i, k)-pdpmel(i, k)                  pmflxs(i, k + 1)=pmflxs(i, k)-pdpmel(i, k)
173               ELSE               ELSE
174                  pmflxs(i, k+1)=pmflxs(i, k)+pdmfup(i, k)+pdmfdp(i, k)                  pmflxs(i, k + 1)=pmflxs(i, k) + pdmfup(i, k) + pdmfdp(i, k)
175                  pmflxr(i, k+1)=pmflxr(i, k)                  pmflxr(i, k + 1)=pmflxr(i, k)
176               ENDIF               ENDIF
177               ! si la precipitation est negative, on ajuste le plux du               ! si la precipitation est negative, on ajuste le plux du
178               ! panache descendant pour eliminer la negativite               ! panache descendant pour eliminer la negativite
179               IF ((pmflxr(i, k+1)+pmflxs(i, k+1)) < 0.0) THEN               IF ((pmflxr(i, k + 1) + pmflxs(i, k + 1)) < 0.0) THEN
180                  pdmfdp(i, k) = -pmflxr(i, k)-pmflxs(i, k)-pdmfup(i, k)                  pdmfdp(i, k) = -pmflxr(i, k)-pmflxs(i, k)-pdmfup(i, k)
181                  pmflxr(i, k+1) = 0.0                  pmflxr(i, k + 1) = 0.0
182                  pmflxs(i, k+1) = 0.0                  pmflxs(i, k + 1) = 0.0
183                  pdpmel(i, k) = 0.0                  pdpmel(i, k) = 0.0
184               ENDIF               ENDIF
185            ENDIF            ENDIF
# Line 201  contains Line 201  contains
201      DO k = 1, klev      DO k = 1, klev
202         DO kp = k, klev         DO kp = k, klev
203            DO i = 1, klon            DO i = 1, klon
204               maxpdmfdp(i, k)=maxpdmfdp(i, k)+pdmfdp(i, kp)               maxpdmfdp(i, k)=maxpdmfdp(i, k) + pdmfdp(i, kp)
205            ENDDO            ENDDO
206         ENDDO         ENDDO
207      ENDDO      ENDDO
# Line 228  contains Line 228  contains
228                  zdrfl=MAX(zdrfl, &                  zdrfl=MAX(zdrfl, &
229                       MIN(-pmflxr(i, k)-pmflxs(i, k)-maxpdmfdp(i, k), 0.0))                       MIN(-pmflxr(i, k)-pmflxs(i, k)-maxpdmfdp(i, k), 0.0))
230    
231                  zdenom=1.0/MAX(1.0E-20, pmflxr(i, k)+pmflxs(i, k))                  zdenom=1.0/MAX(1.0E-20, pmflxr(i, k) + pmflxs(i, k))
232                  IF (pten(i, k) > RTT) THEN                  IF (pten(i, k) > RTT) THEN
233                     zpdr = pdmfdp(i, k)                     zpdr = pdmfdp(i, k)
234                     zpds = 0.0                     zpds = 0.0
# Line 236  contains Line 236  contains
236                     zpdr = 0.0                     zpdr = 0.0
237                     zpds = pdmfdp(i, k)                     zpds = pdmfdp(i, k)
238                  ENDIF                  ENDIF
239                  pmflxr(i, k+1) = pmflxr(i, k) + zpdr + pdpmel(i, k) &                  pmflxr(i, k + 1) = pmflxr(i, k) + zpdr + pdpmel(i, k) &
240                       + zdrfl*pmflxr(i, k)*zdenom                       + zdrfl*pmflxr(i, k)*zdenom
241                  pmflxs(i, k+1) = pmflxs(i, k) + zpds - pdpmel(i, k) &                  pmflxs(i, k + 1) = pmflxs(i, k) + zpds - pdpmel(i, k) &
242                       + zdrfl*pmflxs(i, k)*zdenom                       + zdrfl*pmflxs(i, k)*zdenom
243                  pdmfup(i, k) = pdmfup(i, k) + zdrfl                  pdmfup(i, k) = pdmfup(i, k) + zdrfl
244               ELSE               ELSE
245                  pmflxr(i, k+1) = 0.0                  pmflxr(i, k + 1) = 0.0
246                  pmflxs(i, k+1) = 0.0                  pmflxs(i, k + 1) = 0.0
247                  pdmfdp(i, k) = 0.0                  pdmfdp(i, k) = 0.0
248                  pdpmel(i, k) = 0.0                  pdpmel(i, k) = 0.0
249               ENDIF               ENDIF
# Line 254  contains Line 254  contains
254      ENDDO      ENDDO
255    
256      DO i = 1, klon      DO i = 1, klon
257         prfl(i) = pmflxr(i, klev+1)         prfl(i) = pmflxr(i, klev + 1)
258         psfl(i) = pmflxs(i, klev+1)         psfl(i) = pmflxs(i, klev + 1)
259      end DO      end DO
260    
261      RETURN      RETURN
Legend:
Removed from v.70  
changed lines
  Added in v.78
  ViewVC Help
Powered by ViewVC 1.1.21