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

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

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.f revision 254 by guez, Mon Feb 5 10:39:38 2018 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 flxbase_m, only: flxbase
14        use flxddraf_m, only: flxddraf
15        use flxdlfs_m, only: flxdlfs
16        use flxdtdq_m, only: flxdtdq
17      use flxflux_m, only: flxflux      use flxflux_m, only: flxflux
18      use flxini_m, only: flxini      use flxini_m, only: flxini
19      USE suphec_m, ONLY: rcpd, retv, rg, rlvtt      USE suphec_m, ONLY: rcpd, retv, rg, rlvtt
# Line 17  contains Line 21  contains
21      USE yoethf_m, ONLY: r4les, r5les      USE yoethf_m, ONLY: r4les, r5les
22    
23      REAL, intent(in):: dtime      REAL, intent(in):: dtime
24      REAL, intent(in):: pt(klon, klev)      REAL, intent(in):: ten(klon, klev)
25      real pqen(klon, klev)      real, intent(in):: qen(klon, klev)
26      real, intent(inout):: pqsen(klon, klev)      real, intent(inout):: qsen(klon, klev)
27      REAL, intent(in):: pqhfl(klon)      REAL, intent(in):: pqhfl(klon)
28      real pap(klon, klev), paph(klon, klev+1)      real, intent(in):: pap(klon, klev)
29        real, intent(in):: paph(klon, klev + 1) ! pression aux demi-niveaux
30      REAL, intent(in):: pgeo(klon, klev)      REAL, intent(in):: pgeo(klon, klev)
31      LOGICAL ldland(klon)      LOGICAL ldland(klon)
32      REAL ptte(klon, klev)      REAL ptte(klon, klev)
# Line 30  contains Line 35  contains
35      REAL prsfc(klon), pssfc(klon)      REAL prsfc(klon), pssfc(klon)
36      INTEGER kcbot(klon), kctop(klon)      INTEGER kcbot(klon), kctop(klon)
37      INTEGER kdtop(klon)      INTEGER kdtop(klon)
38      REAL pmfu(klon, klev)      REAL, intent(out):: mfu(klon, klev)
39      real pmfd(klon, klev)      real, intent(out):: mfd(klon, klev)
40      REAL pen_u(klon, klev), pde_u(klon, klev)      REAL pen_u(klon, klev), pde_u(klon, klev)
41      REAL pen_d(klon, klev), pde_d(klon, klev)      REAL pen_d(klon, klev), pde_d(klon, klev)
42      REAL dt_con(klon, klev), dq_con(klon, klev)      REAL dt_con(klon, klev), dq_con(klon, klev)
43      REAL pmflxr(klon, klev+1)      REAL pmflxr(klon, klev + 1)
44      REAL pmflxs(klon, klev+1)      REAL pmflxs(klon, klev + 1)
45    
46      ! Local:      ! Local:
47      REAL ptu(klon, klev), pqu(klon, klev), plu(klon, klev)      REAL ptu(klon, klev), pqu(klon, klev), plu(klon, klev)
# Line 46  contains Line 51  contains
51    
52      REAL ztenh(klon, klev), zqenh(klon, klev), zqsenh(klon, klev)      REAL ztenh(klon, klev), zqenh(klon, klev), zqsenh(klon, klev)
53      REAL zgeoh(klon, klev)      REAL zgeoh(klon, klev)
54      REAL zmfub(klon), zmfub1(klon)      REAL mfub(klon), mfub1(klon)
55      REAL zmfus(klon, klev), zmfuq(klon, klev), zmful(klon, klev)      REAL mfus(klon, klev), mfuq(klon, klev), mful(klon, klev)
56      REAL zdmfup(klon, klev), zdpmel(klon, klev)      REAL zdmfup(klon, klev), zdpmel(klon, klev)
57      REAL zentr(klon), zhcbase(klon)      REAL zentr(klon), zhcbase(klon)
58      REAL zdqpbl(klon), zdqcv(klon), zdhpbl(klon)      REAL zdqpbl(klon), zdqcv(klon), zdhpbl(klon)
# Line 73  contains Line 78  contains
78         firstcal = .FALSE.         firstcal = .FALSE.
79      ENDIF      ENDIF
80    
81      DO i = 1, klon      ldcum = .FALSE.
82         ldcum(i) = .FALSE.      dt_con = 0.
83      ENDDO      dq_con = 0.
84      DO k = 1, klev  
85         DO i = 1, klon      ! Initialiser les variables et faire l'interpolation verticale :
86            dt_con(i, k) = 0.0      CALL flxini(ten, qen, qsen, pgeo, paph, zgeoh, ztenh, zqenh, zqsenh, &
87            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, &  
88           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)
89    
90      ! determiner les valeurs au niveau de base de la tour convective      ! Déterminer les valeurs au niveau de base de la tour convective :
91        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  
92    
93      k=1      ! Calculer la convergence totale de l'humidité et celle en
94      DO i = 1, klon      ! provenance de la couche limite, plus précisément, la convergence
95         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
96         zdhpbl(i) = 0.0      ! dernière convergence est comparée avec l'&vaporation obtenue
97         zdqpbl(i) = 0.0      ! dans la couche limite pour déterminer le type de la convection.
98      ENDDO  
99        zdqcv = pqte(:, 1) * (paph(:, 2) - paph(:, 1))
100        zdhpbl = 0.
101        zdqpbl = 0.
102    
103      DO k=2, klev      DO k=2, klev
104         DO i = 1, klon         DO i = 1, klon
105            zdqcv(i)=zdqcv(i)+pqte(i, k)*(paph(i, k+1)-paph(i, k))            zdqcv(i)=zdqcv(i) + pqte(i, k)*(paph(i, k + 1)-paph(i, k))
106            IF (k.GE.kcbot(i)) THEN            IF (k.GE.kcbot(i)) THEN
107               zdqpbl(i)=zdqpbl(i)+pqte(i, k)*(paph(i, k+1)-paph(i, k))               zdqpbl(i)=zdqpbl(i) + pqte(i, k)*(paph(i, k + 1)-paph(i, k))
108               zdhpbl(i)=zdhpbl(i)+(RCPD*ptte(i, k)+RLVTT*pqte(i, k)) &               zdhpbl(i)=zdhpbl(i) + (RCPD*ptte(i, k) + RLVTT*pqte(i, k)) &
109                    *(paph(i, k+1)-paph(i, k))                    *(paph(i, k + 1)-paph(i, k))
110            ENDIF            ENDIF
111         ENDDO         ENDDO
112      ENDDO      ENDDO
# Line 131  contains Line 124  contains
124    
125      DO i = 1, klon      DO i = 1, klon
126         ikb=kcbot(i)         ikb=kcbot(i)
127         zqumqe=pqu(i, ikb)+plu(i, ikb)-zqenh(i, ikb)         zqumqe=pqu(i, ikb) + plu(i, ikb)-zqenh(i, ikb)
128         zdqmin=MAX(0.01*zqenh(i, ikb), 1.E-10)         zdqmin=MAX(0.01*zqenh(i, ikb), 1.E-10)
129         IF (zdqpbl(i) > 0..AND.zqumqe > zdqmin.AND.ldcum(i)) THEN         IF (zdqpbl(i) > 0..AND.zqumqe > zdqmin.AND.ldcum(i)) THEN
130            zmfub(i) = zdqpbl(i)/(RG*MAX(zqumqe, zdqmin))            mfub(i) = zdqpbl(i)/(RG*MAX(zqumqe, zdqmin))
131         ELSE         ELSE
132            zmfub(i) = 0.01            mfub(i) = 0.01
133            ldcum(i)=.FALSE.            ldcum(i)=.FALSE.
134         ENDIF         ENDIF
135         IF (ktype(i) == 2) THEN         IF (ktype(i) == 2) THEN
136            zdh = RCPD*(ptu(i, ikb)-ztenh(i, ikb)) + RLVTT*zqumqe            zdh = RCPD*(ptu(i, ikb)-ztenh(i, ikb)) + RLVTT*zqumqe
137            zdh = RG * MAX(zdh, 1.0E5*zdqmin)            zdh = RG * MAX(zdh, 1.0E5*zdqmin)
138            IF (zdhpbl(i) > 0..AND.ldcum(i))zmfub(i)=zdhpbl(i)/zdh            IF (zdhpbl(i) > 0..AND.ldcum(i))mfub(i)=zdhpbl(i)/zdh
139         ENDIF         ENDIF
140         zmfmax = (paph(i, ikb)-paph(i, ikb-1)) / (RG*dtime)         zmfmax = (paph(i, ikb)-paph(i, ikb-1)) / (RG*dtime)
141         zmfub(i) = MIN(zmfub(i), zmfmax)         mfub(i) = MIN(mfub(i), zmfmax)
142         zentr(i) = ENTRSCV         zentr(i) = ENTRSCV
143         IF (ktype(i) == 1) zentr(i) = ENTRPEN         IF (ktype(i) == 1) zentr(i) = ENTRPEN
144      ENDDO      ENDDO
# Line 158  contains Line 151  contains
151    
152      DO i = 1, klon      DO i = 1, klon
153         ikb=kcbot(i)         ikb=kcbot(i)
154         zhcbase(i)=RCPD*ptu(i, ikb)+zgeoh(i, ikb)+RLVTT*pqu(i, ikb)         zhcbase(i)=RCPD*ptu(i, ikb) + zgeoh(i, ikb) + RLVTT*pqu(i, ikb)
155         ictop0(i)=kcbot(i)-1         ictop0(i)=kcbot(i)-1
156      ENDDO      ENDDO
157    
158      zalvdcp=RLVTT/RCPD      zalvdcp=RLVTT/RCPD
159      DO k=klev-1, 3, -1      DO k=klev-1, 3, -1
160         DO i = 1, klon         DO i = 1, klon
161            zhsat=RCPD*ztenh(i, k)+zgeoh(i, k)+RLVTT*zqsenh(i, k)            zhsat=RCPD*ztenh(i, k) + zgeoh(i, k) + RLVTT*zqsenh(i, k)
162            zgam=R5LES*zalvdcp*zqsenh(i, k)/ &            zgam=R5LES*zalvdcp*zqsenh(i, k)/ &
163                 ((1.-RETV *zqsenh(i, k))*(ztenh(i, k)-R4LES)**2)                 ((1.-RETV *zqsenh(i, k))*(ztenh(i, k)-R4LES)**2)
164            zzz=RCPD*ztenh(i, k)*0.608            zzz=RCPD*ztenh(i, k)*0.608
165            zhhat=zhsat-(zzz+zgam*zzz)/(1.+zgam*zzz/RLVTT)* &            zhhat=zhsat-(zzz + zgam*zzz)/(1. + zgam*zzz/RLVTT)* &
166                 MAX(zqsenh(i, k)-zqenh(i, k), 0.)                 MAX(zqsenh(i, k)-zqenh(i, k), 0.)
167            IF(k < ictop0(i).AND.zhcbase(i) > zhhat) ictop0(i)=k            IF(k < ictop0(i).AND.zhcbase(i) > zhhat) ictop0(i)=k
168         ENDDO         ENDDO
# Line 177  contains Line 170  contains
170    
171      ! (B) calculer le panache ascendant      ! (B) calculer le panache ascendant
172    
173      CALL flxasc(dtime, ztenh, zqenh, pt, pqen, pqsen, pgeo, zgeoh, pap, &      CALL flxasc(dtime, ztenh, zqenh, ten, qen, qsen, pgeo, zgeoh, pap, &
174           paph, pqte, pvervel, ldland, ldcum, ktype, ilab, ptu, pqu, plu, &           paph, pqte, pvervel, ldland, ldcum, ktype, ilab, ptu, pqu, plu, &
175           pmfu, zmfub, zentr, zmfus, zmfuq, zmful, plude, zdmfup, kcbot, &           mfu, mfub, zentr, mfus, mfuq, mful, plude, zdmfup, kcbot, &
176           kctop, ictop0, kcum, pen_u, pde_u)           kctop, ictop0, kcum, pen_u, pde_u)
177    
178      IF (kcum /= 0) then      kcum_not_zero: IF (kcum /= 0) then
179         ! verifier l'epaisseur de la convection et changer eventuellement         ! verifier l'epaisseur de la convection et changer eventuellement
180         ! le taux d'entrainement/detrainement         ! le taux d'entrainement/detrainement
181    
# Line 193  contains Line 186  contains
186            IF(ktype(i) == 2) zentr(i)=ENTRSCV            IF(ktype(i) == 2) zentr(i)=ENTRSCV
187         ENDDO         ENDDO
188    
189         IF (lmfdd) THEN ! si l'on considere le panache descendant         downdraft: IF (lmfdd) THEN
190              ! si l'on considere le panache descendant
191            ! calculer la precipitation issue du panache ascendant pour            ! calculer la precipitation issue du panache ascendant pour
192            ! determiner l'existence du panache descendant dans la convection            ! determiner l'existence du panache descendant dans la convection
193            DO i = 1, klon            DO i = 1, klon
# Line 201  contains Line 195  contains
195            ENDDO            ENDDO
196            DO k=2, klev            DO k=2, klev
197               DO i = 1, klon               DO i = 1, klon
198                  zrfl(i)=zrfl(i)+zdmfup(i, k)                  zrfl(i)=zrfl(i) + zdmfup(i, k)
199               ENDDO               ENDDO
200            ENDDO            ENDDO
201    
202            ! determiner le LFS (level of free sinking: niveau de plonge libre)            ! determiner le LFS (level of free sinking: niveau de plonge libre)
203            CALL flxdlfs(ztenh, zqenh, zgeoh, paph, ptu, pqu, &            CALL flxdlfs(ztenh, zqenh, zgeoh, paph, ptu, pqu, ldcum, kcbot, &
204                 ldcum, kcbot, kctop, zmfub, zrfl, &                 kctop, mfub, zrfl, ptd, pqd, mfd, zmfds, zmfdq, zdmfdp, kdtop, &
205                 ptd, pqd, &                 lddraf)
                pmfd, zmfds, zmfdq, zdmfdp, &  
                kdtop, lddraf)  
206    
207            ! calculer le panache descendant            ! calculer le panache descendant
208            CALL flxddraf(ztenh, zqenh, &            CALL flxddraf(ztenh, zqenh, zgeoh, paph, zrfl, ptd, pqd, mfd, &
209                 zgeoh, paph, zrfl, &                 zmfds, zmfdq, zdmfdp, lddraf, pen_d, pde_d)
                ptd, pqd, &  
                pmfd, zmfds, zmfdq, zdmfdp, &  
                lddraf, pen_d, pde_d)  
210    
211            ! calculer de nouveau le flux de masse entrant a travers la base            ! calculer de nouveau le flux de masse entrant a travers la base
212            ! de la convection, sachant qu'il a ete modifie par le panache            ! de la convection, sachant qu'il a ete modifie par le panache
# Line 225  contains Line 214  contains
214            DO i = 1, klon            DO i = 1, klon
215               IF (lddraf(i)) THEN               IF (lddraf(i)) THEN
216                  ikb = kcbot(i)                  ikb = kcbot(i)
217                  llo1 = PMFD(i, ikb) < 0.                  llo1 = MFD(i, ikb) < 0.
218                  zeps = 0.                  zeps = 0.
219                  IF (llo1) zeps = CMFDEPS                  IF (llo1) zeps = CMFDEPS
220                  zqumqe = pqu(i, ikb)+plu(i, ikb)- &                  zqumqe = pqu(i, ikb) + plu(i, ikb)- &
221                       zeps*pqd(i, ikb)-(1.-zeps)*zqenh(i, ikb)                       zeps*pqd(i, ikb)-(1.-zeps)*zqenh(i, ikb)
222                  zdqmin = MAX(0.01*zqenh(i, ikb), 1.E-10)                  zdqmin = MAX(0.01*zqenh(i, ikb), 1.E-10)
223                  zmfmax = (paph(i, ikb)-paph(i, ikb-1)) / (RG*dtime)                  zmfmax = (paph(i, ikb)-paph(i, ikb-1)) / (RG*dtime)
224                  IF (zdqpbl(i) > 0..AND.zqumqe > zdqmin.AND.ldcum(i) &                  IF (zdqpbl(i) > 0..AND.zqumqe > zdqmin.AND.ldcum(i) &
225                       .AND.zmfub(i) < zmfmax) THEN                       .AND.mfub(i) < zmfmax) THEN
226                     zmfub1(i) = zdqpbl(i) / (RG*MAX(zqumqe, zdqmin))                     mfub1(i) = zdqpbl(i) / (RG*MAX(zqumqe, zdqmin))
227                  ELSE                  ELSE
228                     zmfub1(i) = zmfub(i)                     mfub1(i) = mfub(i)
229                  ENDIF                  ENDIF
230                  IF (ktype(i) == 2) THEN                  IF (ktype(i) == 2) THEN
231                     zdh = RCPD*(ptu(i, ikb)-zeps*ptd(i, ikb)- &                     zdh = RCPD*(ptu(i, ikb)-zeps*ptd(i, ikb)- &
232                          (1.-zeps)*ztenh(i, ikb))+RLVTT*zqumqe                          (1.-zeps)*ztenh(i, ikb)) + RLVTT*zqumqe
233                     zdh = RG * MAX(zdh, 1.0E5*zdqmin)                     zdh = RG * MAX(zdh, 1.0E5*zdqmin)
234                     IF (zdhpbl(i) > 0..AND.ldcum(i))zmfub1(i)=zdhpbl(i)/zdh                     IF (zdhpbl(i) > 0..AND.ldcum(i))mfub1(i)=zdhpbl(i)/zdh
235                  ENDIF                  ENDIF
236                  IF (.NOT. ((ktype(i) == 1 .OR. ktype(i) == 2) .AND. &                  IF (.NOT. ((ktype(i) == 1 .OR. ktype(i) == 2) .AND. &
237                       ABS(zmfub1(i)-zmfub(i)) < 0.2*zmfub(i))) &                       ABS(mfub1(i)-mfub(i)) < 0.2*mfub(i))) &
238                       zmfub1(i) = zmfub(i)                       mfub1(i) = mfub(i)
239               ENDIF               ENDIF
240            ENDDO            ENDDO
241            DO k = 1, klev            DO k = 1, klev
242               DO i = 1, klon               DO i = 1, klon
243                  IF (lddraf(i)) THEN                  IF (lddraf(i)) THEN
244                     zfac = zmfub1(i)/MAX(zmfub(i), 1.E-10)                     zfac = mfub1(i)/MAX(mfub(i), 1.E-10)
245                     pmfd(i, k) = pmfd(i, k)*zfac                     mfd(i, k) = mfd(i, k)*zfac
246                     zmfds(i, k) = zmfds(i, k)*zfac                     zmfds(i, k) = zmfds(i, k)*zfac
247                     zmfdq(i, k) = zmfdq(i, k)*zfac                     zmfdq(i, k) = zmfdq(i, k)*zfac
248                     zdmfdp(i, k) = zdmfdp(i, k)*zfac                     zdmfdp(i, k) = zdmfdp(i, k)*zfac
# Line 263  contains Line 252  contains
252               ENDDO               ENDDO
253            ENDDO            ENDDO
254            DO i = 1, klon            DO i = 1, klon
255               IF (lddraf(i)) zmfub(i)=zmfub1(i)               IF (lddraf(i)) mfub(i)=mfub1(i)
256            ENDDO            ENDDO
257         ENDIF ! fin de test sur lmfdd         ENDIF downdraft
258    
259         ! calculer de nouveau le panache ascendant         ! calculer de nouveau le panache ascendant
260    
261         CALL flxasc(dtime, ztenh, zqenh, pt, pqen, pqsen, pgeo, zgeoh, pap, &         CALL flxasc(dtime, ztenh, zqenh, ten, qen, qsen, pgeo, zgeoh, pap, &
262              paph, pqte, pvervel, ldland, ldcum, ktype, ilab, ptu, pqu, plu, &              paph, pqte, pvervel, ldland, ldcum, ktype, ilab, ptu, pqu, plu, &
263              pmfu, zmfub, zentr, zmfus, zmfuq, zmful, plude, zdmfup, kcbot, &              mfu, mfub, zentr, mfus, mfuq, mful, plude, zdmfup, kcbot, &
264              kctop, ictop0, kcum, pen_u, pde_u)              kctop, ictop0, kcum, pen_u, pde_u)
265    
266         ! Déterminer les flux convectifs en forme finale, ainsi que la         ! Déterminer les flux convectifs en forme finale, ainsi que la
267         ! quantité des précipitations         ! quantité des précipitations
268    
269         CALL flxflux(dtime, pqen, pqsen, ztenh, zqenh, pap, paph, &         CALL flxflux(dtime, qen, qsen, ztenh, zqenh, pap, paph, &
270              ldland, zgeoh, kcbot, kctop, lddraf, kdtop, ktype, ldcum, &              ldland, zgeoh, kcbot, kctop, lddraf, kdtop, ktype, ldcum, &
271              pmfu, pmfd, zmfus, zmfds, zmfuq, zmfdq, zmful, plude, &              mfu, mfd, mfus, zmfds, mfuq, zmfdq, mful, plude, &
272              zdmfup, zdmfdp, pt, prsfc, pssfc, zdpmel, itopm2, &              zdmfup, zdmfdp, ten, prsfc, pssfc, zdpmel, itopm2, &
273              pmflxr, pmflxs)              pmflxr, pmflxs)
274    
275         ! calculer les tendances pour T et Q         ! calculer les tendances pour T et Q
276    
277         CALL flxdtdq(itopm2, paph, ldcum, pt, zmfus, zmfds, zmfuq, zmfdq, &         CALL flxdtdq(itopm2, paph, ldcum, ten, mfus, zmfds, mfuq, zmfdq, &
278              zmful, zdmfup, zdmfdp, zdpmel, dt_con, dq_con)              mful, zdmfup, zdmfdp, zdpmel, dt_con, dq_con)
279      end IF      end IF kcum_not_zero
280    
281    END SUBROUTINE flxmain    END SUBROUTINE flxmain
282    
Legend:
Removed from v.70  
changed lines
  Added in v.254
  ViewVC Help
Powered by ViewVC 1.1.21