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

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

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

revision 52 by guez, Fri Sep 23 12:28:01 2011 UTC revision 62 by guez, Thu Jul 26 14:37:37 2012 UTC
# Line 1  Line 1 
1  SUBROUTINE conflx (dtime,pres_h,pres_f, &  module conflx_m
      t, q, con_t, con_q, pqhfl, w, &  
      d_t, d_q, rain, snow, &  
      pmfu, pmfd, pen_u, pde_u, pen_d, pde_d, &  
      kcbot, kctop, kdtop, pmflxr, pmflxs)  
   
   ! From LMDZ4/libf/phylmd/conflx.F,v 1.1.1.1 2004/05/19 12:53:08  
   
   use dimens_m  
   use dimphy  
   use SUPHEC_M  
   use yoethf_m  
   use fcttre  
2    
3    IMPLICIT none    IMPLICIT none
   !======================================================================  
   ! Auteur(s): Z.X. Li (LMD/CNRS) date: 19941014  
   ! Objet: Schema flux de masse pour la convection  
   !        (schema de Tiedtke avec qqs modifications mineures)  
   ! Dec.97: Prise en compte des modifications introduites par  
   !         Olivier Boucher et Alexandre Armengaud pour melange  
   !         et lessivage des traceurs passifs.  
   !======================================================================  
   ! Entree:  
   REAL, intent(in):: dtime            ! pas d'integration (s)  
   REAL, intent(in):: pres_h(klon,klev+1) ! pression half-level (Pa)  
   REAL, intent(in):: pres_f(klon,klev)! pression full-level (Pa)  
   REAL, intent(in):: t(klon,klev)     ! temperature (K)  
   REAL q(klon,klev)     ! humidite specifique (g/g)  
   REAL w(klon,klev)     ! vitesse verticale (Pa/s)  
   REAL con_t(klon,klev) ! convergence de temperature (K/s)  
   REAL con_q(klon,klev) ! convergence de l'eau vapeur (g/g/s)  
   REAL pqhfl(klon)      ! evaporation (negative vers haut) mm/s  
   ! Sortie:  
   REAL d_t(klon,klev)   ! incrementation de temperature  
   REAL d_q(klon,klev)   ! incrementation d'humidite  
   REAL pmfu(klon,klev)  ! flux masse (kg/m2/s) panache ascendant  
   REAL pmfd(klon,klev)  ! flux masse (kg/m2/s) panache descendant  
   REAL pen_u(klon,klev)  
   REAL pen_d(klon,klev)  
   REAL pde_u(klon,klev)  
   REAL pde_d(klon,klev)  
   REAL rain(klon)       ! pluie (mm/s)  
   REAL snow(klon)       ! neige (mm/s)  
   REAL pmflxr(klon,klev+1)  
   REAL pmflxs(klon,klev+1)  
   INTEGER kcbot(klon)  ! niveau du bas de la convection  
   INTEGER kctop(klon)  ! niveau du haut de la convection  
   INTEGER kdtop(klon)  ! niveau du haut des downdrafts  
   ! Local:  
   REAL pt(klon,klev)  
   REAL pq(klon,klev)  
   REAL pqs(klon,klev)  
   REAL pvervel(klon,klev)  
   LOGICAL land(klon)  
   !  
   REAL d_t_bis(klon,klev)  
   REAL d_q_bis(klon,klev)  
   REAL paprs(klon,klev+1)  
   REAL paprsf(klon,klev)  
   REAL zgeom(klon,klev)  
   REAL zcvgq(klon,klev)  
   REAL zcvgt(klon,klev)  
   !AA  
   REAL zmfu(klon,klev)  
   REAL zmfd(klon,klev)  
   REAL zen_u(klon,klev)  
   REAL zen_d(klon,klev)  
   REAL zde_u(klon,klev)  
   REAL zde_d(klon,klev)  
   REAL zmflxr(klon,klev+1)  
   REAL zmflxs(klon,klev+1)  
   !AA  
   
   !  
   INTEGER i, k  
   REAL zdelta, zqsat  
   !  
   !  
   ! initialiser les variables de sortie (pour securite)  
   DO i = 1, klon  
      rain(i) = 0.0  
      snow(i) = 0.0  
      kcbot(i) = 0  
      kctop(i) = 0  
      kdtop(i) = 0  
   ENDDO  
   DO k = 1, klev  
      DO i = 1, klon  
         d_t(i,k) = 0.0  
         d_q(i,k) = 0.0  
         pmfu(i,k) = 0.0  
         pmfd(i,k) = 0.0  
         pen_u(i,k) = 0.0  
         pde_u(i,k) = 0.0  
         pen_d(i,k) = 0.0  
         pde_d(i,k) = 0.0  
         zmfu(i,k) = 0.0  
         zmfd(i,k) = 0.0  
         zen_u(i,k) = 0.0  
         zde_u(i,k) = 0.0  
         zen_d(i,k) = 0.0  
         zde_d(i,k) = 0.0  
      ENDDO  
   ENDDO  
   DO k = 1, klev+1  
      DO i = 1, klon  
         zmflxr(i,k) = 0.0  
         zmflxs(i,k) = 0.0  
      ENDDO  
   ENDDO  
   !  
   ! calculer la nature du sol (pour l'instant, ocean partout)  
   DO i = 1, klon  
      land(i) = .FALSE.  
   ENDDO  
   !  
   ! preparer les variables d'entree (attention: l'ordre des niveaux  
   ! verticaux augmente du haut vers le bas)  
   DO k = 1, klev  
      DO i = 1, klon  
         pt(i,k) = t(i,klev-k+1)  
         pq(i,k) = q(i,klev-k+1)  
         paprsf(i,k) = pres_f(i,klev-k+1)  
         paprs(i,k) = pres_h(i,klev+1-k+1)  
         pvervel(i,k) = w(i,klev+1-k)  
         zcvgt(i,k) = con_t(i,klev-k+1)  
         zcvgq(i,k) = con_q(i,klev-k+1)  
         !  
         zdelta=MAX(0.,SIGN(1.,RTT-pt(i,k)))  
         zqsat=R2ES*FOEEW ( pt(i,k), zdelta ) / paprsf(i,k)  
         zqsat=MIN(0.5,zqsat)  
         zqsat=zqsat/(1.-RETV  *zqsat)  
         pqs(i,k) = zqsat  
      ENDDO  
   ENDDO  
   DO i = 1, klon  
      paprs(i,klev+1) = pres_h(i,1)  
      zgeom(i,klev) = RD * pt(i,klev) &  
           / (0.5*(paprs(i,klev+1)+paprsf(i,klev))) &  
           * (paprs(i,klev+1)-paprsf(i,klev))  
   ENDDO  
   DO k = klev-1, 1, -1  
      DO i = 1, klon  
         zgeom(i,k) = zgeom(i,k+1) &  
              + RD * 0.5*(pt(i,k+1)+pt(i,k)) / paprs(i,k+1) &  
              * (paprsf(i,k+1)-paprsf(i,k))  
      ENDDO  
   ENDDO  
   !  
   ! appeler la routine principale  
   !  
   CALL flxmain(dtime, pt, pq, pqs, pqhfl, &  
        paprsf, paprs, zgeom, land, zcvgt, zcvgq, pvervel, &  
        rain, snow, kcbot, kctop, kdtop, &  
        zmfu, zmfd, zen_u, zde_u, zen_d, zde_d, &  
        d_t_bis, d_q_bis, zmflxr, zmflxs)  
   !  
   !AA--------------------------------------------------------  
   !AA rem : De la meme facon que l'on effectue le reindicage  
   !AA       pour la temperature t et le champ q  
   !AA       on reindice les flux necessaires a la convection  
   !AA       des traceurs  
   !AA--------------------------------------------------------  
   DO k = 1, klev  
      DO i = 1, klon  
         d_q(i,klev+1-k) = dtime*d_q_bis(i,k)  
         d_t(i,klev+1-k) = dtime*d_t_bis(i,k)  
      ENDDO  
   ENDDO  
   !  
   DO i = 1, klon  
      pmfu(i,1)= 0.  
      pmfd(i,1)= 0.  
      pen_d(i,1)= 0.  
      pde_d(i,1)= 0.  
   ENDDO  
   
   DO k = 2, klev  
      DO i = 1, klon  
         pmfu(i,klev+2-k)= zmfu(i,k)  
         pmfd(i,klev+2-k)= zmfd(i,k)  
      ENDDO  
   ENDDO  
   !  
   DO k = 1, klev  
      DO i = 1, klon  
         pen_u(i,klev+1-k)=  zen_u(i,k)  
         pde_u(i,klev+1-k)=  zde_u(i,k)  
      ENDDO  
   ENDDO  
   !  
   DO k = 1, klev-1  
      DO i = 1, klon  
         pen_d(i,klev+1-k)= -zen_d(i,k+1)  
         pde_d(i,klev+1-k)= -zde_d(i,k+1)  
      ENDDO  
   ENDDO  
   
   DO k = 1, klev+1  
      DO i = 1, klon  
         pmflxr(i,klev+2-k)= zmflxr(i,k)  
         pmflxs(i,klev+2-k)= zmflxs(i,k)  
      ENDDO  
   ENDDO  
4    
5  END SUBROUTINE conflx  contains
6    
7      SUBROUTINE conflx (dtime, pres_h, pres_f, t, q, con_t, con_q, pqhfl, w, &
8           d_t, d_q, rain, snow, pmfu, pmfd, pen_u, pde_u, pen_d, pde_d, kcbot, &
9           kctop, kdtop, pmflxr, pmflxs)
10    
11        ! From LMDZ4/libf/phylmd/conflx.F, version 1.1.1.1 2004/05/19 12:53:08
12    
13        ! Author: Z. X. Li (LMD/CNRS)
14        ! date: 1994/10/14
15    
16        ! Objet: schéma flux de masse pour la convection (schéma de
17        ! Tiedtke avec quelques modifications mineures)
18    
19        ! Décembre 1997 : prise en compte des modifications introduites
20        ! par Olivier Boucher et Alexandre Armengaud pour mélange et
21        ! lessivage des traceurs passifs.
22    
23        use flxmain_m, only: flxmain
24        USE dimphy, ONLY: klev, klon
25        USE suphec_m, ONLY: rd, retv, rtt
26        USE yoethf_m, ONLY: r2es
27        USE fcttre, ONLY: foeew
28    
29        ! Entree:
30        REAL, intent(in):: dtime            ! pas d'integration (s)
31        REAL, intent(in):: pres_h(klon, klev+1) ! pression half-level (Pa)
32        REAL, intent(in):: pres_f(klon, klev)! pression full-level (Pa)
33        REAL, intent(in):: t(klon, klev)     ! temperature (K)
34        REAL q(klon, klev)     ! humidite specifique (g/g)
35        REAL w(klon, klev)     ! vitesse verticale (Pa/s)
36        REAL con_t(klon, klev) ! convergence de temperature (K/s)
37        REAL con_q(klon, klev) ! convergence de l'eau vapeur (g/g/s)
38        REAL pqhfl(klon)      ! evaporation (negative vers haut) mm/s
39    
40        ! Sortie:
41        REAL d_t(klon, klev)   ! incrementation de temperature
42        REAL d_q(klon, klev)   ! incrementation d'humidite
43    
44        REAL, intent(out):: pmfu(:, :) ! (klon, klev)
45        ! flux masse (kg/m2/s) panache ascendant
46        
47        REAL, intent(out):: pmfd(:, :) ! (klon, klev)
48        ! flux masse (kg/m2/s) panache descendant
49    
50        REAL pen_u(klon, klev)
51        REAL pen_d(klon, klev)
52        REAL pde_u(klon, klev)
53        REAL pde_d(klon, klev)
54        REAL rain(klon)       ! pluie (mm/s)
55        REAL snow(klon)       ! neige (mm/s)
56        REAL pmflxr(klon, klev+1)
57        REAL pmflxs(klon, klev+1)
58        INTEGER kcbot(klon)  ! niveau du bas de la convection
59        INTEGER kctop(klon)  ! niveau du haut de la convection
60        INTEGER kdtop(klon)  ! niveau du haut des downdrafts
61    
62        ! Local:
63    
64        REAL pt(klon, klev)
65        REAL pq(klon, klev)
66        REAL pqs(klon, klev)
67        REAL pvervel(klon, klev)
68        LOGICAL land(klon)
69    
70        REAL d_t_bis(klon, klev)
71        REAL d_q_bis(klon, klev)
72        REAL paprs(klon, klev+1)
73        REAL paprsf(klon, klev)
74        REAL zgeom(klon, klev)
75        REAL zcvgq(klon, klev)
76        REAL zcvgt(klon, klev)
77    
78        REAL zmfu(klon, klev)
79        REAL zmfd(klon, klev)
80        REAL zen_u(klon, klev)
81        REAL zen_d(klon, klev)
82        REAL zde_u(klon, klev)
83        REAL zde_d(klon, klev)
84        REAL zmflxr(klon, klev+1)
85        REAL zmflxs(klon, klev+1)
86    
87        INTEGER i, k
88        REAL zdelta, zqsat
89    
90        !--------------------------------------------------------------------
91    
92        ! initialiser les variables de sortie (pour securite)
93        DO i = 1, klon
94           rain(i) = 0.0
95           snow(i) = 0.0
96           kcbot(i) = 0
97           kctop(i) = 0
98           kdtop(i) = 0
99        ENDDO
100        DO k = 1, klev
101           DO i = 1, klon
102              d_t(i, k) = 0.0
103              d_q(i, k) = 0.0
104              pmfu(i, k) = 0.0
105              pmfd(i, k) = 0.0
106              pen_u(i, k) = 0.0
107              pde_u(i, k) = 0.0
108              pen_d(i, k) = 0.0
109              pde_d(i, k) = 0.0
110              zmfu(i, k) = 0.0
111              zmfd(i, k) = 0.0
112              zen_u(i, k) = 0.0
113              zde_u(i, k) = 0.0
114              zen_d(i, k) = 0.0
115              zde_d(i, k) = 0.0
116           ENDDO
117        ENDDO
118        DO k = 1, klev+1
119           DO i = 1, klon
120              zmflxr(i, k) = 0.0
121              zmflxs(i, k) = 0.0
122           ENDDO
123        ENDDO
124    
125        ! calculer la nature du sol (pour l'instant, ocean partout)
126        DO i = 1, klon
127           land(i) = .FALSE.
128        ENDDO
129    
130        ! preparer les variables d'entree (attention: l'ordre des niveaux
131        ! verticaux augmente du haut vers le bas)
132        DO k = 1, klev
133           DO i = 1, klon
134              pt(i, k) = t(i, klev-k+1)
135              pq(i, k) = q(i, klev-k+1)
136              paprsf(i, k) = pres_f(i, klev-k+1)
137              paprs(i, k) = pres_h(i, klev+1-k+1)
138              pvervel(i, k) = w(i, klev+1-k)
139              zcvgt(i, k) = con_t(i, klev-k+1)
140              zcvgq(i, k) = con_q(i, klev-k+1)
141    
142              zdelta=MAX(0., SIGN(1., RTT-pt(i, k)))
143              zqsat=R2ES*FOEEW ( pt(i, k), zdelta ) / paprsf(i, k)
144              zqsat=MIN(0.5, zqsat)
145              zqsat=zqsat/(1.-RETV  *zqsat)
146              pqs(i, k) = zqsat
147           ENDDO
148        ENDDO
149        DO i = 1, klon
150           paprs(i, klev+1) = pres_h(i, 1)
151           zgeom(i, klev) = RD * pt(i, klev) &
152                / (0.5*(paprs(i, klev+1)+paprsf(i, klev))) &
153                * (paprs(i, klev+1)-paprsf(i, klev))
154        ENDDO
155        DO k = klev-1, 1, -1
156           DO i = 1, klon
157              zgeom(i, k) = zgeom(i, k+1) &
158                   + RD * 0.5*(pt(i, k+1)+pt(i, k)) / paprs(i, k+1) &
159                   * (paprsf(i, k+1)-paprsf(i, k))
160           ENDDO
161        ENDDO
162    
163        ! appeler la routine principale
164    
165        CALL flxmain(dtime, pt, pq, pqs, pqhfl, paprsf, paprs, zgeom, land, &
166             zcvgt, zcvgq, pvervel, rain, snow, kcbot, kctop, kdtop, zmfu, zmfd, &
167             zen_u, zde_u, zen_d, zde_d, d_t_bis, d_q_bis, zmflxr, zmflxs)
168    
169        ! De la même façon que l'on effectue le réindiçage pour la
170        ! température t et le champ q, on réindice les flux nécessaires à
171        ! la convection des traceurs.
172        DO k = 1, klev
173           DO i = 1, klon
174              d_q(i, klev+1-k) = dtime*d_q_bis(i, k)
175              d_t(i, klev+1-k) = dtime*d_t_bis(i, k)
176           ENDDO
177        ENDDO
178    
179        DO i = 1, klon
180           pmfu(i, 1)= 0.
181           pmfd(i, 1)= 0.
182           pen_d(i, 1)= 0.
183           pde_d(i, 1)= 0.
184        ENDDO
185    
186        DO k = 2, klev
187           DO i = 1, klon
188              pmfu(i, klev+2-k)= zmfu(i, k)
189              pmfd(i, klev+2-k)= zmfd(i, k)
190           ENDDO
191        ENDDO
192    
193        DO k = 1, klev
194           DO i = 1, klon
195              pen_u(i, klev+1-k)=  zen_u(i, k)
196              pde_u(i, klev+1-k)=  zde_u(i, k)
197           ENDDO
198        ENDDO
199    
200        DO k = 1, klev-1
201           DO i = 1, klon
202              pen_d(i, klev+1-k)= -zen_d(i, k+1)
203              pde_d(i, klev+1-k)= -zde_d(i, k+1)
204           ENDDO
205        ENDDO
206    
207        DO k = 1, klev+1
208           DO i = 1, klon
209              pmflxr(i, klev+2-k)= zmflxr(i, k)
210              pmflxs(i, klev+2-k)= zmflxs(i, k)
211           ENDDO
212        ENDDO
213    
214      END SUBROUTINE conflx
215    
216    end module conflx_m

Legend:
Removed from v.52  
changed lines
  Added in v.62

  ViewVC Help
Powered by ViewVC 1.1.21