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

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

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

revision 77 by guez, Fri Nov 15 18:45:49 2013 UTC revision 78 by guez, Wed Feb 5 17:51:07 2014 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)
# 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
# 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.77  
changed lines
  Added in v.78
  ViewVC Help
Powered by ViewVC 1.1.21