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

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

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

trunk/libf/phylmd/Conflx/flxmain.f90 revision 70 by guez, Mon Jun 24 15:39:52 2013 UTC trunk/phylmd/Conflx/flxmain.f90 revision 76 by guez, Fri Nov 15 18:45:49 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 73  contains Line 74  contains
74         firstcal = .FALSE.         firstcal = .FALSE.
75      ENDIF      ENDIF
76    
77      DO i = 1, klon      ldcum = .FALSE.
78         ldcum(i) = .FALSE.      dt_con = 0.
79      ENDDO      dq_con = 0.
80      DO k = 1, klev  
81         DO i = 1, klon      ! Initialiser les variables et faire l'interpolation verticale :
82            dt_con(i, k) = 0.0      CALL flxini(ten, qen, qsen, pgeo, paph, zgeoh, ztenh, zqenh, zqsenh, &
83            dq_con(i, k) = 0.0           ptu, pqu, ptd, pqd, mfd, zmfds, zmfdq, zdmfdp, mfu, mfus, mfuq, &
        ENDDO  
     ENDDO  
   
     ! initialiser les variables et faire l'interpolation verticale  
   
     CALL flxini(pt, pqen, pqsen, pgeo, paph, zgeoh, ztenh, zqenh, zqsenh, &  
          ptu, pqu, ptd, pqd, pmfd, zmfds, zmfdq, zdmfdp, pmfu, zmfus, zmfuq, &  
84           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)
85    
86      ! determiner les valeurs au niveau de base de la tour convective      ! Déterminer les valeurs au niveau de base de la tour convective :
87        CALL flxbase(ztenh, zqenh, zgeoh, paph, ptu, pqu, plu, ldcum, kcbot, ilab)
     CALL flxbase(ztenh, zqenh, zgeoh, paph, &  
          ptu, pqu, plu, ldcum, kcbot, ilab)  
   
     ! calculer la convergence totale de l'humidite et celle en provenance  
     ! de la couche limite, plus precisement, la convergence integree entre  
     ! le sol et la base de la convection. Cette derniere convergence est  
     ! comparee avec l'evaporation obtenue dans la couche limite pour  
     ! determiner le type de la convection  
88    
89      k=1      ! Calculer la convergence totale de l'humidité et celle en
90      DO i = 1, klon      ! provenance de la couche limite, plus précisément, la convergence
91         zdqcv(i) = pqte(i, k)*(paph(i, k+1)-paph(i, k))      ! intégrée entre le sol et la base de la convection. Cette
92         zdhpbl(i) = 0.0      ! dernière convergence est comparée avec l'&vaporation obtenue
93         zdqpbl(i) = 0.0      ! dans la couche limite pour déterminer le type de la convection.
94      ENDDO  
95        zdqcv = pqte(:, 1) * (paph(:, 2) - paph(:, 1))
96        zdhpbl = 0.
97        zdqpbl = 0.
98    
99      DO k=2, klev      DO k=2, klev
100         DO i = 1, klon         DO i = 1, klon
# Line 134  contains Line 123  contains
123         zqumqe=pqu(i, ikb)+plu(i, ikb)-zqenh(i, ikb)         zqumqe=pqu(i, ikb)+plu(i, ikb)-zqenh(i, ikb)
124         zdqmin=MAX(0.01*zqenh(i, ikb), 1.E-10)         zdqmin=MAX(0.01*zqenh(i, ikb), 1.E-10)
125         IF (zdqpbl(i) > 0..AND.zqumqe > zdqmin.AND.ldcum(i)) THEN         IF (zdqpbl(i) > 0..AND.zqumqe > zdqmin.AND.ldcum(i)) THEN
126            zmfub(i) = zdqpbl(i)/(RG*MAX(zqumqe, zdqmin))            mfub(i) = zdqpbl(i)/(RG*MAX(zqumqe, zdqmin))
127         ELSE         ELSE
128            zmfub(i) = 0.01            mfub(i) = 0.01
129            ldcum(i)=.FALSE.            ldcum(i)=.FALSE.
130         ENDIF         ENDIF
131         IF (ktype(i) == 2) THEN         IF (ktype(i) == 2) THEN
132            zdh = RCPD*(ptu(i, ikb)-ztenh(i, ikb)) + RLVTT*zqumqe            zdh = RCPD*(ptu(i, ikb)-ztenh(i, ikb)) + RLVTT*zqumqe
133            zdh = RG * MAX(zdh, 1.0E5*zdqmin)            zdh = RG * MAX(zdh, 1.0E5*zdqmin)
134            IF (zdhpbl(i) > 0..AND.ldcum(i))zmfub(i)=zdhpbl(i)/zdh            IF (zdhpbl(i) > 0..AND.ldcum(i))mfub(i)=zdhpbl(i)/zdh
135         ENDIF         ENDIF
136         zmfmax = (paph(i, ikb)-paph(i, ikb-1)) / (RG*dtime)         zmfmax = (paph(i, ikb)-paph(i, ikb-1)) / (RG*dtime)
137         zmfub(i) = MIN(zmfub(i), zmfmax)         mfub(i) = MIN(mfub(i), zmfmax)
138         zentr(i) = ENTRSCV         zentr(i) = ENTRSCV
139         IF (ktype(i) == 1) zentr(i) = ENTRPEN         IF (ktype(i) == 1) zentr(i) = ENTRPEN
140      ENDDO      ENDDO
# Line 177  contains Line 166  contains
166    
167      ! (B) calculer le panache ascendant      ! (B) calculer le panache ascendant
168    
169      CALL flxasc(dtime, ztenh, zqenh, pt, pqen, pqsen, pgeo, zgeoh, pap, &      CALL flxasc(dtime, ztenh, zqenh, ten, qen, qsen, pgeo, zgeoh, pap, &
170           paph, pqte, pvervel, ldland, ldcum, ktype, ilab, ptu, pqu, plu, &           paph, pqte, pvervel, ldland, ldcum, ktype, ilab, ptu, pqu, plu, &
171           pmfu, zmfub, zentr, zmfus, zmfuq, zmful, plude, zdmfup, kcbot, &           mfu, mfub, zentr, mfus, mfuq, mful, plude, zdmfup, kcbot, &
172           kctop, ictop0, kcum, pen_u, pde_u)           kctop, ictop0, kcum, pen_u, pde_u)
173    
174      IF (kcum /= 0) then      kcum_not_zero: IF (kcum /= 0) then
175         ! verifier l'epaisseur de la convection et changer eventuellement         ! verifier l'epaisseur de la convection et changer eventuellement
176         ! le taux d'entrainement/detrainement         ! le taux d'entrainement/detrainement
177    
# Line 193  contains Line 182  contains
182            IF(ktype(i) == 2) zentr(i)=ENTRSCV            IF(ktype(i) == 2) zentr(i)=ENTRSCV
183         ENDDO         ENDDO
184    
185         IF (lmfdd) THEN ! si l'on considere le panache descendant         downdraft: IF (lmfdd) THEN
186              ! si l'on considere le panache descendant
187            ! calculer la precipitation issue du panache ascendant pour            ! calculer la precipitation issue du panache ascendant pour
188            ! determiner l'existence du panache descendant dans la convection            ! determiner l'existence du panache descendant dans la convection
189            DO i = 1, klon            DO i = 1, klon
# Line 207  contains Line 197  contains
197    
198            ! determiner le LFS (level of free sinking: niveau de plonge libre)            ! determiner le LFS (level of free sinking: niveau de plonge libre)
199            CALL flxdlfs(ztenh, zqenh, zgeoh, paph, ptu, pqu, &            CALL flxdlfs(ztenh, zqenh, zgeoh, paph, ptu, pqu, &
200                 ldcum, kcbot, kctop, zmfub, zrfl, &                 ldcum, kcbot, kctop, mfub, zrfl, &
201                 ptd, pqd, &                 ptd, pqd, &
202                 pmfd, zmfds, zmfdq, zdmfdp, &                 mfd, zmfds, zmfdq, zdmfdp, &
203                 kdtop, lddraf)                 kdtop, lddraf)
204    
205            ! calculer le panache descendant            ! calculer le panache descendant
206            CALL flxddraf(ztenh, zqenh, &            CALL flxddraf(ztenh, zqenh, &
207                 zgeoh, paph, zrfl, &                 zgeoh, paph, zrfl, &
208                 ptd, pqd, &                 ptd, pqd, &
209                 pmfd, zmfds, zmfdq, zdmfdp, &                 mfd, zmfds, zmfdq, zdmfdp, &
210                 lddraf, pen_d, pde_d)                 lddraf, pen_d, pde_d)
211    
212            ! 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 215  contains
215            DO i = 1, klon            DO i = 1, klon
216               IF (lddraf(i)) THEN               IF (lddraf(i)) THEN
217                  ikb = kcbot(i)                  ikb = kcbot(i)
218                  llo1 = PMFD(i, ikb) < 0.                  llo1 = MFD(i, ikb) < 0.
219                  zeps = 0.                  zeps = 0.
220                  IF (llo1) zeps = CMFDEPS                  IF (llo1) zeps = CMFDEPS
221                  zqumqe = pqu(i, ikb)+plu(i, ikb)- &                  zqumqe = pqu(i, ikb)+plu(i, ikb)- &
# Line 233  contains Line 223  contains
223                  zdqmin = MAX(0.01*zqenh(i, ikb), 1.E-10)                  zdqmin = MAX(0.01*zqenh(i, ikb), 1.E-10)
224                  zmfmax = (paph(i, ikb)-paph(i, ikb-1)) / (RG*dtime)                  zmfmax = (paph(i, ikb)-paph(i, ikb-1)) / (RG*dtime)
225                  IF (zdqpbl(i) > 0..AND.zqumqe > zdqmin.AND.ldcum(i) &                  IF (zdqpbl(i) > 0..AND.zqumqe > zdqmin.AND.ldcum(i) &
226                       .AND.zmfub(i) < zmfmax) THEN                       .AND.mfub(i) < zmfmax) THEN
227                     zmfub1(i) = zdqpbl(i) / (RG*MAX(zqumqe, zdqmin))                     mfub1(i) = zdqpbl(i) / (RG*MAX(zqumqe, zdqmin))
228                  ELSE                  ELSE
229                     zmfub1(i) = zmfub(i)                     mfub1(i) = mfub(i)
230                  ENDIF                  ENDIF
231                  IF (ktype(i) == 2) THEN                  IF (ktype(i) == 2) THEN
232                     zdh = RCPD*(ptu(i, ikb)-zeps*ptd(i, ikb)- &                     zdh = RCPD*(ptu(i, ikb)-zeps*ptd(i, ikb)- &
233                          (1.-zeps)*ztenh(i, ikb))+RLVTT*zqumqe                          (1.-zeps)*ztenh(i, ikb))+RLVTT*zqumqe
234                     zdh = RG * MAX(zdh, 1.0E5*zdqmin)                     zdh = RG * MAX(zdh, 1.0E5*zdqmin)
235                     IF (zdhpbl(i) > 0..AND.ldcum(i))zmfub1(i)=zdhpbl(i)/zdh                     IF (zdhpbl(i) > 0..AND.ldcum(i))mfub1(i)=zdhpbl(i)/zdh
236                  ENDIF                  ENDIF
237                  IF (.NOT. ((ktype(i) == 1 .OR. ktype(i) == 2) .AND. &                  IF (.NOT. ((ktype(i) == 1 .OR. ktype(i) == 2) .AND. &
238                       ABS(zmfub1(i)-zmfub(i)) < 0.2*zmfub(i))) &                       ABS(mfub1(i)-mfub(i)) < 0.2*mfub(i))) &
239                       zmfub1(i) = zmfub(i)                       mfub1(i) = mfub(i)
240               ENDIF               ENDIF
241            ENDDO            ENDDO
242            DO k = 1, klev            DO k = 1, klev
243               DO i = 1, klon               DO i = 1, klon
244                  IF (lddraf(i)) THEN                  IF (lddraf(i)) THEN
245                     zfac = zmfub1(i)/MAX(zmfub(i), 1.E-10)                     zfac = mfub1(i)/MAX(mfub(i), 1.E-10)
246                     pmfd(i, k) = pmfd(i, k)*zfac                     mfd(i, k) = mfd(i, k)*zfac
247                     zmfds(i, k) = zmfds(i, k)*zfac                     zmfds(i, k) = zmfds(i, k)*zfac
248                     zmfdq(i, k) = zmfdq(i, k)*zfac                     zmfdq(i, k) = zmfdq(i, k)*zfac
249                     zdmfdp(i, k) = zdmfdp(i, k)*zfac                     zdmfdp(i, k) = zdmfdp(i, k)*zfac
# Line 263  contains Line 253  contains
253               ENDDO               ENDDO
254            ENDDO            ENDDO
255            DO i = 1, klon            DO i = 1, klon
256               IF (lddraf(i)) zmfub(i)=zmfub1(i)               IF (lddraf(i)) mfub(i)=mfub1(i)
257            ENDDO            ENDDO
258         ENDIF ! fin de test sur lmfdd         ENDIF downdraft
259    
260         ! calculer de nouveau le panache ascendant         ! calculer de nouveau le panache ascendant
261    
262         CALL flxasc(dtime, ztenh, zqenh, pt, pqen, pqsen, pgeo, zgeoh, pap, &         CALL flxasc(dtime, ztenh, zqenh, ten, qen, qsen, pgeo, zgeoh, pap, &
263              paph, pqte, pvervel, ldland, ldcum, ktype, ilab, ptu, pqu, plu, &              paph, pqte, pvervel, ldland, ldcum, ktype, ilab, ptu, pqu, plu, &
264              pmfu, zmfub, zentr, zmfus, zmfuq, zmful, plude, zdmfup, kcbot, &              mfu, mfub, zentr, mfus, mfuq, mful, plude, zdmfup, kcbot, &
265              kctop, ictop0, kcum, pen_u, pde_u)              kctop, ictop0, kcum, pen_u, pde_u)
266    
267         ! Déterminer les flux convectifs en forme finale, ainsi que la         ! Déterminer les flux convectifs en forme finale, ainsi que la
268         ! quantité des précipitations         ! quantité des précipitations
269    
270         CALL flxflux(dtime, pqen, pqsen, ztenh, zqenh, pap, paph, &         CALL flxflux(dtime, qen, qsen, ztenh, zqenh, pap, paph, &
271              ldland, zgeoh, kcbot, kctop, lddraf, kdtop, ktype, ldcum, &              ldland, zgeoh, kcbot, kctop, lddraf, kdtop, ktype, ldcum, &
272              pmfu, pmfd, zmfus, zmfds, zmfuq, zmfdq, zmful, plude, &              mfu, mfd, mfus, zmfds, mfuq, zmfdq, mful, plude, &
273              zdmfup, zdmfdp, pt, prsfc, pssfc, zdpmel, itopm2, &              zdmfup, zdmfdp, ten, prsfc, pssfc, zdpmel, itopm2, &
274              pmflxr, pmflxs)              pmflxr, pmflxs)
275    
276         ! calculer les tendances pour T et Q         ! calculer les tendances pour T et Q
277    
278         CALL flxdtdq(itopm2, paph, ldcum, pt, zmfus, zmfds, zmfuq, zmfdq, &         CALL flxdtdq(itopm2, paph, ldcum, ten, mfus, zmfds, mfuq, zmfdq, &
279              zmful, zdmfup, zdmfdp, zdpmel, dt_con, dq_con)              mful, zdmfup, zdmfdp, zdpmel, dt_con, dq_con)
280      end IF      end IF kcum_not_zero
281    
282    END SUBROUTINE flxmain    END SUBROUTINE flxmain
283    
Legend:
Removed from v.70  
changed lines
  Added in v.76
  ViewVC Help
Powered by ViewVC 1.1.21