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

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

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

trunk/libf/phylmd/Conflx/flxflux.f90 revision 71 by guez, Mon Jul 8 18:12:18 2013 UTC trunk/phylmd/Conflx/flxflux.f revision 254 by guez, Mon Feb 5 10:39:38 2018 UTC
# 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 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)
52      REAL ztmsmlt, zdelta, zqsat      REAL ztmsmlt, zqsat
53    
54      !jq The variable maxpdmfdp(klon) has been introduced by Olivier Boucher      !jq The variable maxpdmfdp(klon) has been introduced by Olivier Boucher
55      !jq 14/11/00 to fix the problem with the negative precipitation.      !jq 14/11/00 to fix the problem with the negative precipitation.
# 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 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 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
163                  zdelta=MAX(0., SIGN(1., RTT-ztmsmlt))                  zqsat = R2ES * FOEEW(ztmsmlt, RTT >= ztmsmlt) / pap(i, k)
                 zqsat = R2ES * FOEEW(ztmsmlt, zdelta) / pap(i, k)  
164                  zqsat = MIN(0.5, zqsat)                  zqsat = MIN(0.5, zqsat)
165                  zqsat = zqsat / (1. - RETV * zqsat)                  zqsat = zqsat / (1. - RETV * zqsat)
166                  pqsen(i, k) = zqsat                  pqsen(i, k) = zqsat
# Line 169  contains Line 168  contains
168               IF (pten(i, k) > RTT) THEN               IF (pten(i, k) > RTT) THEN
169                  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) &
170                       + pdpmel(i, k)                       + pdpmel(i, k)
171                  pmflxs(i, k+1)=pmflxs(i, k)-pdpmel(i, k)                  pmflxs(i, k + 1)=pmflxs(i, k)-pdpmel(i, k)
172               ELSE               ELSE
173                  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)
174                  pmflxr(i, k+1)=pmflxr(i, k)                  pmflxr(i, k + 1)=pmflxr(i, k)
175               ENDIF               ENDIF
176               ! si la precipitation est negative, on ajuste le plux du               ! si la precipitation est negative, on ajuste le plux du
177               ! panache descendant pour eliminer la negativite               ! panache descendant pour eliminer la negativite
178               IF ((pmflxr(i, k+1)+pmflxs(i, k+1)) < 0.0) THEN               IF ((pmflxr(i, k + 1) + pmflxs(i, k + 1)) < 0.0) THEN
179                  pdmfdp(i, k) = -pmflxr(i, k)-pmflxs(i, k)-pdmfup(i, k)                  pdmfdp(i, k) = -pmflxr(i, k)-pmflxs(i, k)-pdmfup(i, k)
180                  pmflxr(i, k+1) = 0.0                  pmflxr(i, k + 1) = 0.0
181                  pmflxs(i, k+1) = 0.0                  pmflxs(i, k + 1) = 0.0
182                  pdpmel(i, k) = 0.0                  pdpmel(i, k) = 0.0
183               ENDIF               ENDIF
184            ENDIF            ENDIF
# Line 201  contains Line 200  contains
200      DO k = 1, klev      DO k = 1, klev
201         DO kp = k, klev         DO kp = k, klev
202            DO i = 1, klon            DO i = 1, klon
203               maxpdmfdp(i, k)=maxpdmfdp(i, k)+pdmfdp(i, kp)               maxpdmfdp(i, k)=maxpdmfdp(i, k) + pdmfdp(i, kp)
204            ENDDO            ENDDO
205         ENDDO         ENDDO
206      ENDDO      ENDDO
# Line 228  contains Line 227  contains
227                  zdrfl=MAX(zdrfl, &                  zdrfl=MAX(zdrfl, &
228                       MIN(-pmflxr(i, k)-pmflxs(i, k)-maxpdmfdp(i, k), 0.0))                       MIN(-pmflxr(i, k)-pmflxs(i, k)-maxpdmfdp(i, k), 0.0))
229    
230                  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))
231                  IF (pten(i, k) > RTT) THEN                  IF (pten(i, k) > RTT) THEN
232                     zpdr = pdmfdp(i, k)                     zpdr = pdmfdp(i, k)
233                     zpds = 0.0                     zpds = 0.0
# Line 236  contains Line 235  contains
235                     zpdr = 0.0                     zpdr = 0.0
236                     zpds = pdmfdp(i, k)                     zpds = pdmfdp(i, k)
237                  ENDIF                  ENDIF
238                  pmflxr(i, k+1) = pmflxr(i, k) + zpdr + pdpmel(i, k) &                  pmflxr(i, k + 1) = pmflxr(i, k) + zpdr + pdpmel(i, k) &
239                       + zdrfl*pmflxr(i, k)*zdenom                       + zdrfl*pmflxr(i, k)*zdenom
240                  pmflxs(i, k+1) = pmflxs(i, k) + zpds - pdpmel(i, k) &                  pmflxs(i, k + 1) = pmflxs(i, k) + zpds - pdpmel(i, k) &
241                       + zdrfl*pmflxs(i, k)*zdenom                       + zdrfl*pmflxs(i, k)*zdenom
242                  pdmfup(i, k) = pdmfup(i, k) + zdrfl                  pdmfup(i, k) = pdmfup(i, k) + zdrfl
243               ELSE               ELSE
244                  pmflxr(i, k+1) = 0.0                  pmflxr(i, k + 1) = 0.0
245                  pmflxs(i, k+1) = 0.0                  pmflxs(i, k + 1) = 0.0
246                  pdmfdp(i, k) = 0.0                  pdmfdp(i, k) = 0.0
247                  pdpmel(i, k) = 0.0                  pdpmel(i, k) = 0.0
248               ENDIF               ENDIF
# Line 254  contains Line 253  contains
253      ENDDO      ENDDO
254    
255      DO i = 1, klon      DO i = 1, klon
256         prfl(i) = pmflxr(i, klev+1)         prfl(i) = pmflxr(i, klev + 1)
257         psfl(i) = pmflxs(i, klev+1)         psfl(i) = pmflxs(i, klev + 1)
258      end DO      end DO
259    
260      RETURN      RETURN
Legend:
Removed from v.71  
changed lines
  Added in v.254
  ViewVC Help
Powered by ViewVC 1.1.21