/[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

trunk/libf/phylmd/Conflx/conflx.f90 revision 52 by guez, Fri Sep 23 12:28:01 2011 UTC trunk/phylmd/Conflx/conflx.f revision 82 by guez, Wed Mar 5 14:57:53 2014 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, qhfl, w, &
8           d_t, d_q, rain, snow, mfu, mfd, 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 en 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 le mélange et le
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        REAL, intent(in):: dtime ! pas d'integration (s)
30        REAL, intent(in):: pres_h(:, :) ! (klon, klev + 1) pression half-level (Pa)
31        REAL, intent(in):: pres_f(:, :) ! (klon, klev) pression full-level (Pa)
32        REAL, intent(in):: t(:, :) ! (klon, klev) temperature (K)
33        REAL, intent(in):: q(:, :) ! (klon, klev) humidité spécifique (no dimension)
34    
35        REAL, intent(in):: con_t(:, :)
36        ! (klon, klev) convergence de temperature (K/s)
37    
38        REAL, intent(in):: con_q(:, :)
39        ! (klon, klev) convergence de l'eau vapeur (g/g/s)
40    
41        REAL, intent(in):: qhfl(:) ! (klon) evaporation (negative vers haut) mm/s
42        REAL, intent(in):: w(:, :) ! (klon, klev) vitesse verticale (Pa/s)
43    
44        REAL, intent(out):: d_t(:, :) ! (klon, klev) incrementation de temperature
45        REAL, intent(out):: d_q(:, :) ! (klon, klev) incrementation d'humidite
46        REAL, intent(out):: rain(:) ! (klon) pluie (mm/s)
47        REAL, intent(out):: snow(:) ! (klon) neige (mm/s)
48    
49        REAL, intent(out):: mfu(:, :) ! (klon, klev)
50        ! flux de masse (kg/m2/s) panache ascendant
51    
52        REAL, intent(out):: mfd(:, :) ! (klon, klev)
53        ! flux de masse (kg/m2/s) panache descendant
54    
55        REAL, intent(out):: pen_u(:, :) ! (klon, klev)
56        REAL, intent(out):: pde_u(:, :) ! (klon, klev)
57        REAL, intent(out):: pen_d(:, :) ! (klon, klev)
58        REAL, intent(out):: pde_d(:, :) ! (klon, klev)
59        INTEGER, intent(out):: kcbot(:) ! (klon) niveau du bas de la convection
60        INTEGER, intent(out):: kctop(:) ! (klon) niveau du haut de la convection
61        INTEGER, intent(out):: kdtop(:) ! (klon) niveau du haut des downdrafts
62        REAL, intent(out):: pmflxr(:, :) ! (klon, klev + 1)
63        REAL, intent(out):: pmflxs(:, :) ! (klon, klev + 1)
64    
65        ! Local:
66    
67        REAL qsen(klon, klev)
68        REAL pvervel(klon, klev)
69        LOGICAL land(klon)
70    
71        REAL d_t_bis(klon, klev)
72        REAL d_q_bis(klon, klev)
73        REAL paprs(klon, klev + 1)
74        REAL paprsf(klon, klev)
75        REAL zgeom(klon, klev)
76        REAL zcvgq(klon, klev)
77        REAL zcvgt(klon, klev)
78    
79        REAL zen_u(klon, klev)
80        REAL zen_d(klon, klev)
81        REAL zde_u(klon, klev)
82        REAL zde_d(klon, klev)
83        REAL zmflxr(klon, klev + 1)
84        REAL zmflxs(klon, klev + 1)
85    
86        INTEGER i, k
87        REAL zqsat
88    
89        !--------------------------------------------------------------------
90    
91        ! Initialiser les variables de sortie (pour securité):
92        rain = 0.
93        snow = 0.
94        kcbot = 0
95        kctop = 0
96        kdtop = 0
97        d_t = 0.
98        d_q = 0.
99    
100        zen_u = 0.
101        zde_u = 0.
102        zen_d = 0.
103        zde_d = 0.
104        zmflxr = 0.
105        zmflxs = 0.
106    
107        ! Calculer la nature du sol (pour l'instant, océan partout):
108        land = .FALSE.
109    
110        ! Préparer les variables d'entrée (attention: l'indice des niveaux
111        ! verticaux augmente du haut vers le bas) :
112        DO k = 1, klev
113           DO i = 1, klon
114              paprsf(i, k) = pres_f(i, klev-k + 1)
115              paprs(i, k) = pres_h(i, klev + 1-k + 1)
116              pvervel(i, k) = w(i, klev + 1-k)
117              zcvgt(i, k) = con_t(i, klev-k + 1)
118              zcvgq(i, k) = con_q(i, klev-k + 1)
119    
120              zqsat = MIN(0.5, R2ES * FOEEW(t(i, k), &
121                   merge(0., 1., rtt < t(i, k))) / paprsf(i, k))
122              qsen(i, k) = zqsat / (1. - RETV * zqsat)
123           ENDDO
124        ENDDO
125        DO i = 1, klon
126           paprs(i, klev + 1) = pres_h(i, 1)
127           zgeom(i, klev) = RD * t(i, klev) &
128                / (0.5*(paprs(i, klev + 1) + paprsf(i, klev))) &
129                * (paprs(i, klev + 1)-paprsf(i, klev))
130        ENDDO
131        DO k = klev-1, 1, -1
132           DO i = 1, klon
133              zgeom(i, k) = zgeom(i, k + 1) &
134                   + RD * 0.5*(t(i, k + 1) + t(i, k)) / paprs(i, k + 1) &
135                   * (paprsf(i, k + 1)-paprsf(i, k))
136           ENDDO
137        ENDDO
138    
139        ! Appeler la routine principale :
140        CALL flxmain(dtime, t, q, qsen, qhfl, paprsf, paprs, zgeom, land, &
141             zcvgt, zcvgq, pvervel, rain, snow, kcbot, kctop, kdtop, mfu, mfd, &
142             zen_u, zde_u, zen_d, zde_d, d_t_bis, d_q_bis, zmflxr, zmflxs)
143    
144        ! De la même façon que l'on effectue le réindiçage pour la
145        ! température t et le champ q, on réindice les flux nécessaires à
146        ! la convection des traceurs.
147        DO k = 1, klev
148           DO i = 1, klon
149              d_q(i, klev + 1-k) = dtime*d_q_bis(i, k)
150              d_t(i, klev + 1-k) = dtime*d_t_bis(i, k)
151           ENDDO
152        ENDDO
153    
154        mfu = eoshift(mfu, shift=1, dim=2)
155        mfd = eoshift(mfd, shift=1, dim=2)
156        pen_d(:, 1)= 0.
157        pde_d(:, 1)= 0.
158    
159        DO k = 1, klev
160           DO i = 1, klon
161              pen_u(i, klev + 1-k)= zen_u(i, k)
162              pde_u(i, klev + 1-k)= zde_u(i, k)
163           ENDDO
164        ENDDO
165    
166        DO k = 1, klev-1
167           DO i = 1, klon
168              pen_d(i, klev + 1-k)= -zen_d(i, k + 1)
169              pde_d(i, klev + 1-k)= -zde_d(i, k + 1)
170           ENDDO
171        ENDDO
172    
173        DO k = 1, klev + 1
174           DO i = 1, klon
175              pmflxr(i, klev + 2-k)= zmflxr(i, k)
176              pmflxs(i, klev + 2-k)= zmflxs(i, k)
177           ENDDO
178        ENDDO
179    
180      END SUBROUTINE conflx
181    
182    end module conflx_m
Legend:
Removed from v.52  
changed lines
  Added in v.82
  ViewVC Help
Powered by ViewVC 1.1.21