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

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

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

revision 70 by guez, Mon Jun 24 15:39:52 2013 UTC revision 71 by guez, Mon Jul 8 18:12:18 2013 UTC
# Line 4  module flxmain_m Line 4  module flxmain_m
4    
5  contains  contains
6    
7    SUBROUTINE flxmain(dtime, pt, pqen, pqsen, pqhfl, pap, paph, pgeo, ldland, &    SUBROUTINE flxmain(dtime, ten, qen, qsen, pqhfl, pap, paph, pgeo, ldland, &
8         ptte, pqte, pvervel, prsfc, pssfc, kcbot, kctop, kdtop, pmfu, pmfd, &         ptte, pqte, pvervel, prsfc, pssfc, kcbot, kctop, kdtop, mfu, mfd, &
9         pen_u, pde_u, pen_d, pde_d, dt_con, dq_con, pmflxr, pmflxs)         pen_u, pde_u, pen_d, pde_d, dt_con, dq_con, pmflxr, pmflxs)
10    
11      USE dimphy, ONLY: klev, klon      USE dimphy, ONLY: klev, klon
12      use flxasc_m, only: flxasc      use flxasc_m, only: flxasc
13        use flxdtdq_m, only: flxdtdq
14      use flxflux_m, only: flxflux      use flxflux_m, only: flxflux
15      use flxini_m, only: flxini      use flxini_m, only: flxini
16      USE suphec_m, ONLY: rcpd, retv, rg, rlvtt      USE suphec_m, ONLY: rcpd, retv, rg, rlvtt
# Line 17  contains Line 18  contains
18      USE yoethf_m, ONLY: r4les, r5les      USE yoethf_m, ONLY: r4les, r5les
19    
20      REAL, intent(in):: dtime      REAL, intent(in):: dtime
21      REAL, intent(in):: pt(klon, klev)      REAL, intent(in):: ten(klon, klev)
22      real pqen(klon, klev)      real, intent(in):: qen(klon, klev)
23      real, intent(inout):: pqsen(klon, klev)      real, intent(inout):: qsen(klon, klev)
24      REAL, intent(in):: pqhfl(klon)      REAL, intent(in):: pqhfl(klon)
25      real pap(klon, klev), paph(klon, klev+1)      real pap(klon, klev), paph(klon, klev+1)
26      REAL, intent(in):: pgeo(klon, klev)      REAL, intent(in):: pgeo(klon, klev)
# Line 30  contains Line 31  contains
31      REAL prsfc(klon), pssfc(klon)      REAL prsfc(klon), pssfc(klon)
32      INTEGER kcbot(klon), kctop(klon)      INTEGER kcbot(klon), kctop(klon)
33      INTEGER kdtop(klon)      INTEGER kdtop(klon)
34      REAL pmfu(klon, klev)      REAL, intent(out):: mfu(klon, klev)
35      real pmfd(klon, klev)      real, intent(out):: mfd(klon, klev)
36      REAL pen_u(klon, klev), pde_u(klon, klev)      REAL pen_u(klon, klev), pde_u(klon, klev)
37      REAL pen_d(klon, klev), pde_d(klon, klev)      REAL pen_d(klon, klev), pde_d(klon, klev)
38      REAL dt_con(klon, klev), dq_con(klon, klev)      REAL dt_con(klon, klev), dq_con(klon, klev)
# Line 46  contains Line 47  contains
47    
48      REAL ztenh(klon, klev), zqenh(klon, klev), zqsenh(klon, klev)      REAL ztenh(klon, klev), zqenh(klon, klev), zqsenh(klon, klev)
49      REAL zgeoh(klon, klev)      REAL zgeoh(klon, klev)
50      REAL zmfub(klon), zmfub1(klon)      REAL mfub(klon), mfub1(klon)
51      REAL zmfus(klon, klev), zmfuq(klon, klev), zmful(klon, klev)      REAL mfus(klon, klev), mfuq(klon, klev), mful(klon, klev)
52      REAL zdmfup(klon, klev), zdpmel(klon, klev)      REAL zdmfup(klon, klev), zdpmel(klon, klev)
53      REAL zentr(klon), zhcbase(klon)      REAL zentr(klon), zhcbase(klon)
54      REAL zdqpbl(klon), zdqcv(klon), zdhpbl(klon)      REAL zdqpbl(klon), zdqcv(klon), zdhpbl(klon)
# Line 85  contains Line 86  contains
86    
87      ! initialiser les variables et faire l'interpolation verticale      ! initialiser les variables et faire l'interpolation verticale
88    
89      CALL flxini(pt, pqen, pqsen, pgeo, paph, zgeoh, ztenh, zqenh, zqsenh, &      CALL flxini(ten, qen, qsen, pgeo, paph, zgeoh, ztenh, zqenh, zqsenh, &
90           ptu, pqu, ptd, pqd, pmfd, zmfds, zmfdq, zdmfdp, pmfu, zmfus, zmfuq, &           ptu, pqu, ptd, pqd, mfd, zmfds, zmfdq, zdmfdp, mfu, mfus, mfuq, &
91           zdmfup, zdpmel, plu, plude, ilab, pen_u, pde_u, pen_d, pde_d)           zdmfup, zdpmel, plu, plude, ilab, pen_u, pde_u, pen_d, pde_d)
92    
93      ! determiner les valeurs au niveau de base de la tour convective      ! determiner les valeurs au niveau de base de la tour convective
# Line 134  contains Line 135  contains
135         zqumqe=pqu(i, ikb)+plu(i, ikb)-zqenh(i, ikb)         zqumqe=pqu(i, ikb)+plu(i, ikb)-zqenh(i, ikb)
136         zdqmin=MAX(0.01*zqenh(i, ikb), 1.E-10)         zdqmin=MAX(0.01*zqenh(i, ikb), 1.E-10)
137         IF (zdqpbl(i) > 0..AND.zqumqe > zdqmin.AND.ldcum(i)) THEN         IF (zdqpbl(i) > 0..AND.zqumqe > zdqmin.AND.ldcum(i)) THEN
138            zmfub(i) = zdqpbl(i)/(RG*MAX(zqumqe, zdqmin))            mfub(i) = zdqpbl(i)/(RG*MAX(zqumqe, zdqmin))
139         ELSE         ELSE
140            zmfub(i) = 0.01            mfub(i) = 0.01
141            ldcum(i)=.FALSE.            ldcum(i)=.FALSE.
142         ENDIF         ENDIF
143         IF (ktype(i) == 2) THEN         IF (ktype(i) == 2) THEN
144            zdh = RCPD*(ptu(i, ikb)-ztenh(i, ikb)) + RLVTT*zqumqe            zdh = RCPD*(ptu(i, ikb)-ztenh(i, ikb)) + RLVTT*zqumqe
145            zdh = RG * MAX(zdh, 1.0E5*zdqmin)            zdh = RG * MAX(zdh, 1.0E5*zdqmin)
146            IF (zdhpbl(i) > 0..AND.ldcum(i))zmfub(i)=zdhpbl(i)/zdh            IF (zdhpbl(i) > 0..AND.ldcum(i))mfub(i)=zdhpbl(i)/zdh
147         ENDIF         ENDIF
148         zmfmax = (paph(i, ikb)-paph(i, ikb-1)) / (RG*dtime)         zmfmax = (paph(i, ikb)-paph(i, ikb-1)) / (RG*dtime)
149         zmfub(i) = MIN(zmfub(i), zmfmax)         mfub(i) = MIN(mfub(i), zmfmax)
150         zentr(i) = ENTRSCV         zentr(i) = ENTRSCV
151         IF (ktype(i) == 1) zentr(i) = ENTRPEN         IF (ktype(i) == 1) zentr(i) = ENTRPEN
152      ENDDO      ENDDO
# Line 177  contains Line 178  contains
178    
179      ! (B) calculer le panache ascendant      ! (B) calculer le panache ascendant
180    
181      CALL flxasc(dtime, ztenh, zqenh, pt, pqen, pqsen, pgeo, zgeoh, pap, &      CALL flxasc(dtime, ztenh, zqenh, ten, qen, qsen, pgeo, zgeoh, pap, &
182           paph, pqte, pvervel, ldland, ldcum, ktype, ilab, ptu, pqu, plu, &           paph, pqte, pvervel, ldland, ldcum, ktype, ilab, ptu, pqu, plu, &
183           pmfu, zmfub, zentr, zmfus, zmfuq, zmful, plude, zdmfup, kcbot, &           mfu, mfub, zentr, mfus, mfuq, mful, plude, zdmfup, kcbot, &
184           kctop, ictop0, kcum, pen_u, pde_u)           kctop, ictop0, kcum, pen_u, pde_u)
185    
186      IF (kcum /= 0) then      kcum_not_zero: IF (kcum /= 0) then
187         ! verifier l'epaisseur de la convection et changer eventuellement         ! verifier l'epaisseur de la convection et changer eventuellement
188         ! le taux d'entrainement/detrainement         ! le taux d'entrainement/detrainement
189    
# Line 207  contains Line 208  contains
208    
209            ! determiner le LFS (level of free sinking: niveau de plonge libre)            ! determiner le LFS (level of free sinking: niveau de plonge libre)
210            CALL flxdlfs(ztenh, zqenh, zgeoh, paph, ptu, pqu, &            CALL flxdlfs(ztenh, zqenh, zgeoh, paph, ptu, pqu, &
211                 ldcum, kcbot, kctop, zmfub, zrfl, &                 ldcum, kcbot, kctop, mfub, zrfl, &
212                 ptd, pqd, &                 ptd, pqd, &
213                 pmfd, zmfds, zmfdq, zdmfdp, &                 mfd, zmfds, zmfdq, zdmfdp, &
214                 kdtop, lddraf)                 kdtop, lddraf)
215    
216            ! calculer le panache descendant            ! calculer le panache descendant
217            CALL flxddraf(ztenh, zqenh, &            CALL flxddraf(ztenh, zqenh, &
218                 zgeoh, paph, zrfl, &                 zgeoh, paph, zrfl, &
219                 ptd, pqd, &                 ptd, pqd, &
220                 pmfd, zmfds, zmfdq, zdmfdp, &                 mfd, zmfds, zmfdq, zdmfdp, &
221                 lddraf, pen_d, pde_d)                 lddraf, pen_d, pde_d)
222    
223            ! calculer de nouveau le flux de masse entrant a travers la base            ! calculer de nouveau le flux de masse entrant a travers la base
# Line 225  contains Line 226  contains
226            DO i = 1, klon            DO i = 1, klon
227               IF (lddraf(i)) THEN               IF (lddraf(i)) THEN
228                  ikb = kcbot(i)                  ikb = kcbot(i)
229                  llo1 = PMFD(i, ikb) < 0.                  llo1 = MFD(i, ikb) < 0.
230                  zeps = 0.                  zeps = 0.
231                  IF (llo1) zeps = CMFDEPS                  IF (llo1) zeps = CMFDEPS
232                  zqumqe = pqu(i, ikb)+plu(i, ikb)- &                  zqumqe = pqu(i, ikb)+plu(i, ikb)- &
# Line 233  contains Line 234  contains
234                  zdqmin = MAX(0.01*zqenh(i, ikb), 1.E-10)                  zdqmin = MAX(0.01*zqenh(i, ikb), 1.E-10)
235                  zmfmax = (paph(i, ikb)-paph(i, ikb-1)) / (RG*dtime)                  zmfmax = (paph(i, ikb)-paph(i, ikb-1)) / (RG*dtime)
236                  IF (zdqpbl(i) > 0..AND.zqumqe > zdqmin.AND.ldcum(i) &                  IF (zdqpbl(i) > 0..AND.zqumqe > zdqmin.AND.ldcum(i) &
237                       .AND.zmfub(i) < zmfmax) THEN                       .AND.mfub(i) < zmfmax) THEN
238                     zmfub1(i) = zdqpbl(i) / (RG*MAX(zqumqe, zdqmin))                     mfub1(i) = zdqpbl(i) / (RG*MAX(zqumqe, zdqmin))
239                  ELSE                  ELSE
240                     zmfub1(i) = zmfub(i)                     mfub1(i) = mfub(i)
241                  ENDIF                  ENDIF
242                  IF (ktype(i) == 2) THEN                  IF (ktype(i) == 2) THEN
243                     zdh = RCPD*(ptu(i, ikb)-zeps*ptd(i, ikb)- &                     zdh = RCPD*(ptu(i, ikb)-zeps*ptd(i, ikb)- &
244                          (1.-zeps)*ztenh(i, ikb))+RLVTT*zqumqe                          (1.-zeps)*ztenh(i, ikb))+RLVTT*zqumqe
245                     zdh = RG * MAX(zdh, 1.0E5*zdqmin)                     zdh = RG * MAX(zdh, 1.0E5*zdqmin)
246                     IF (zdhpbl(i) > 0..AND.ldcum(i))zmfub1(i)=zdhpbl(i)/zdh                     IF (zdhpbl(i) > 0..AND.ldcum(i))mfub1(i)=zdhpbl(i)/zdh
247                  ENDIF                  ENDIF
248                  IF (.NOT. ((ktype(i) == 1 .OR. ktype(i) == 2) .AND. &                  IF (.NOT. ((ktype(i) == 1 .OR. ktype(i) == 2) .AND. &
249                       ABS(zmfub1(i)-zmfub(i)) < 0.2*zmfub(i))) &                       ABS(mfub1(i)-mfub(i)) < 0.2*mfub(i))) &
250                       zmfub1(i) = zmfub(i)                       mfub1(i) = mfub(i)
251               ENDIF               ENDIF
252            ENDDO            ENDDO
253            DO k = 1, klev            DO k = 1, klev
254               DO i = 1, klon               DO i = 1, klon
255                  IF (lddraf(i)) THEN                  IF (lddraf(i)) THEN
256                     zfac = zmfub1(i)/MAX(zmfub(i), 1.E-10)                     zfac = mfub1(i)/MAX(mfub(i), 1.E-10)
257                     pmfd(i, k) = pmfd(i, k)*zfac                     mfd(i, k) = mfd(i, k)*zfac
258                     zmfds(i, k) = zmfds(i, k)*zfac                     zmfds(i, k) = zmfds(i, k)*zfac
259                     zmfdq(i, k) = zmfdq(i, k)*zfac                     zmfdq(i, k) = zmfdq(i, k)*zfac
260                     zdmfdp(i, k) = zdmfdp(i, k)*zfac                     zdmfdp(i, k) = zdmfdp(i, k)*zfac
# Line 263  contains Line 264  contains
264               ENDDO               ENDDO
265            ENDDO            ENDDO
266            DO i = 1, klon            DO i = 1, klon
267               IF (lddraf(i)) zmfub(i)=zmfub1(i)               IF (lddraf(i)) mfub(i)=mfub1(i)
268            ENDDO            ENDDO
269         ENDIF ! fin de test sur lmfdd         ENDIF ! fin de test sur lmfdd
270    
271         ! calculer de nouveau le panache ascendant         ! calculer de nouveau le panache ascendant
272    
273         CALL flxasc(dtime, ztenh, zqenh, pt, pqen, pqsen, pgeo, zgeoh, pap, &         CALL flxasc(dtime, ztenh, zqenh, ten, qen, qsen, pgeo, zgeoh, pap, &
274              paph, pqte, pvervel, ldland, ldcum, ktype, ilab, ptu, pqu, plu, &              paph, pqte, pvervel, ldland, ldcum, ktype, ilab, ptu, pqu, plu, &
275              pmfu, zmfub, zentr, zmfus, zmfuq, zmful, plude, zdmfup, kcbot, &              mfu, mfub, zentr, mfus, mfuq, mful, plude, zdmfup, kcbot, &
276              kctop, ictop0, kcum, pen_u, pde_u)              kctop, ictop0, kcum, pen_u, pde_u)
277    
278         ! Déterminer les flux convectifs en forme finale, ainsi que la         ! Déterminer les flux convectifs en forme finale, ainsi que la
279         ! quantité des précipitations         ! quantité des précipitations
280    
281         CALL flxflux(dtime, pqen, pqsen, ztenh, zqenh, pap, paph, &         CALL flxflux(dtime, qen, qsen, ztenh, zqenh, pap, paph, &
282              ldland, zgeoh, kcbot, kctop, lddraf, kdtop, ktype, ldcum, &              ldland, zgeoh, kcbot, kctop, lddraf, kdtop, ktype, ldcum, &
283              pmfu, pmfd, zmfus, zmfds, zmfuq, zmfdq, zmful, plude, &              mfu, mfd, mfus, zmfds, mfuq, zmfdq, mful, plude, &
284              zdmfup, zdmfdp, pt, prsfc, pssfc, zdpmel, itopm2, &              zdmfup, zdmfdp, ten, prsfc, pssfc, zdpmel, itopm2, &
285              pmflxr, pmflxs)              pmflxr, pmflxs)
286    
287         ! calculer les tendances pour T et Q         ! calculer les tendances pour T et Q
288    
289         CALL flxdtdq(itopm2, paph, ldcum, pt, zmfus, zmfds, zmfuq, zmfdq, &         CALL flxdtdq(itopm2, paph, ldcum, ten, mfus, zmfds, mfuq, zmfdq, &
290              zmful, zdmfup, zdmfdp, zdpmel, dt_con, dq_con)              mful, zdmfup, zdmfdp, zdpmel, dt_con, dq_con)
291      end IF      end IF kcum_not_zero
292    
293    END SUBROUTINE flxmain    END SUBROUTINE flxmain
294    
Legend:
Removed from v.70  
changed lines
  Added in v.71
  ViewVC Help
Powered by ViewVC 1.1.21