/[lmdze]/trunk/phylmd/concvl.f
ViewVC logotype

Diff of /trunk/phylmd/concvl.f

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

revision 38 by guez, Thu Jan 6 17:52:19 2011 UTC revision 62 by guez, Thu Jul 26 14:37:37 2012 UTC
# Line 1  Line 1 
1  SUBROUTINE concvl(iflag_con, dtime, paprs, pplay, t, q, u, v, tra,&  module concvl_m
      ntra, work1, work2, d_t, d_q, d_u, d_v, d_tra, rain, snow, kbas,&  
      ktop, upwd, dnwd, dnwdbis, ma, cape, tvp, iflag, pbase, bbase,&  
      dtvpdt1, dtvpdq1, dplcldt, dplcldr, qcondc, wd, pmflxr, pmflxs,&  
      da, phi, mp)  
   
   ! From phylmd/concvl.F, v 1.3 2005/04/15 12:36:17  
   ! Auteur(s): Z.X. Li (LMD/CNRS) date: 19930818  
   ! Objet: schema de convection de Emanuel (1991) interface  
   
   USE dimens_m  
   USE dimphy  
   USE suphec_m  
   USE yoethf_m  
   USE fcttre  
2    
3    IMPLICIT NONE    IMPLICIT NONE
4    
5    ! Arguments:  contains
   ! dtime--input-R-pas d'integration (s)  
   ! s-------input-R-la valeur "s" pour chaque couche  
   ! sigs----input-R-la valeur "sigma" de chaque couche  
   ! sig-----input-R-la valeur de "sigma" pour chaque niveau  
   ! psolpa--input-R-la pression au sol (en Pa)  
   ! pskapa--input-R-exponentiel kappa de psolpa  
   ! h-------input-R-enthalpie potentielle (Cp*T/P**kappa)  
   ! q-------input-R-vapeur d'eau (en kg/kg)  
   
   ! work*: input et output: deux variables de travail,  
   !                            on peut les mettre a 0 au debut  
   ! ALE-----input-R-energie disponible pour soulevement  
   
   ! d_h-----output-R-increment de l'enthalpie potentielle (h)  
   ! d_q-----output-R-increment de la vapeur d'eau  
   ! rain----output-R-la pluie (mm/s)  
   ! snow----output-R-la neige (mm/s)  
   ! upwd----output-R-saturated updraft mass flux (kg/m**2/s)  
   ! dnwd----output-R-saturated downdraft mass flux (kg/m**2/s)  
   ! dnwd0---output-R-unsaturated downdraft mass flux (kg/m**2/s)  
   ! Cape----output-R-CAPE (J/kg)  
   ! Tvp-----output-R-Temperature virtuelle d'une parcelle soulevee  
   !                  adiabatiquement a partir du niveau 1 (K)  
   ! deltapb-output-R-distance entre LCL et base de la colonne (<0 ;  
   !  Pa)  
   ! Ice_flag-input-L-TRUE->prise en compte de la thermodynamique de  
   !  la glace  
   
   INTEGER ntrac  
   PARAMETER (ntrac=nqmx-2)  
   
   INTEGER, INTENT (IN) :: iflag_con  
   
   REAL, INTENT (IN) :: dtime  
   REAL, INTENT (IN) :: paprs(klon, klev+1)  
   REAL, INTENT (IN) :: pplay(klon, klev)  
   REAL t(klon, klev), q(klon, klev), u(klon, klev), v(klon, klev)  
   REAL, INTENT (IN):: tra(klon, klev, ntrac)  
   INTEGER ntra  
   REAL work1(klon, klev), work2(klon, klev)  
   REAL pmflxr(klon, klev+1), pmflxs(klon, klev+1)  
   
   REAL d_t(klon, klev), d_q(klon, klev), d_u(klon, klev), d_v(klon,&  
        klev)  
   REAL d_tra(klon, klev, ntrac)  
   REAL rain(klon), snow(klon)  
   
   INTEGER kbas(klon), ktop(klon)  
   REAL em_ph(klon, klev+1), em_p(klon, klev)  
   REAL upwd(klon, klev), dnwd(klon, klev), dnwdbis(klon, klev)  
   REAL ma(klon, klev), cape(klon), tvp(klon, klev)  
   REAL da(klon, klev), phi(klon, klev, klev), mp(klon, klev)  
   INTEGER iflag(klon)  
   REAL pbase(klon), bbase(klon)  
   REAL dtvpdt1(klon, klev), dtvpdq1(klon, klev)  
   REAL dplcldt(klon), dplcldr(klon)  
   REAL qcondc(klon, klev)  
   REAL wd(klon)  
   
   REAL zx_t, zdelta, zx_qs, zcor  
   
   INTEGER i, k, itra  
   REAL qs(klon, klev)  
   REAL cbmf(klon)  
   SAVE cbmf  
   INTEGER ifrst  
   SAVE ifrst  
   DATA ifrst/0/  
   
   !-----------------------------------------------------------------  
   
   snow(:) = 0  
   
   IF (ifrst==0) THEN  
      ifrst = 1  
      DO i = 1, klon  
         cbmf(i) = 0.  
      END DO  
   END IF  
   
   DO k = 1, klev + 1  
      DO i = 1, klon  
         em_ph(i, k) = paprs(i, k)/100.0  
         pmflxs(i, k) = 0.  
      END DO  
   END DO  
   
   DO k = 1, klev  
      DO i = 1, klon  
         em_p(i, k) = pplay(i, k)/100.0  
      END DO  
   END DO  
   
   
   IF (iflag_con==4) THEN  
      DO k = 1, klev  
         DO i = 1, klon  
            zx_t = t(i, k)  
            zdelta = max(0., sign(1., rtt-zx_t))  
            zx_qs = min(0.5, r2es*foeew(zx_t, zdelta)/em_p(i, k)/100.0)  
            zcor = 1./(1.-retv*zx_qs)  
            qs(i, k) = zx_qs*zcor  
         END DO  
      END DO  
   ELSE  
      ! iflag_con=3 (modif de puristes qui fait la diffce pour la  
      ! convergence numerique)  
      DO k = 1, klev  
         DO i = 1, klon  
            zx_t = t(i, k)  
            zdelta = max(0., sign(1., rtt-zx_t))  
            zx_qs = r2es*foeew(zx_t, zdelta)/em_p(i, k)/100.0  
            zx_qs = min(0.5, zx_qs)  
            zcor = 1./(1.-retv*zx_qs)  
            zx_qs = zx_qs*zcor  
            qs(i, k) = zx_qs  
         END DO  
      END DO  
   END IF  
   
   ! Main driver for convection:  
   !             iflag_con = 3  -> equivalent to convect3  
   !             iflag_con = 4  -> equivalent to convect1/2  
   
   CALL cv_driver(klon, klev, klev+1, ntra, iflag_con, t, q, qs, u, v,&  
        tra, em_p, em_ph, iflag, d_t, d_q, d_u, d_v, d_tra, rain,&  
        pmflxr, cbmf, work1, work2, kbas, ktop, dtime, ma, upwd, dnwd,&  
        dnwdbis, qcondc, wd, cape, da, phi, mp)  
   
   DO i = 1, klon  
      rain(i) = rain(i)/86400.  
   END DO  
   
   DO k = 1, klev  
      DO i = 1, klon  
         d_t(i, k) = dtime*d_t(i, k)  
         d_q(i, k) = dtime*d_q(i, k)  
         d_u(i, k) = dtime*d_u(i, k)  
         d_v(i, k) = dtime*d_v(i, k)  
      END DO  
   END DO  
   DO itra = 1, ntra  
      DO k = 1, klev  
         DO i = 1, klon  
            d_tra(i, k, itra) = dtime*d_tra(i, k, itra)  
         END DO  
      END DO  
   END DO  
   ! les traceurs ne sont pas mis dans cette version de convect4:  
   IF (iflag_con==4) THEN  
      DO itra = 1, ntra  
         DO k = 1, klev  
            DO i = 1, klon  
               d_tra(i, k, itra) = 0.  
            END DO  
         END DO  
      END DO  
   END IF  
6    
7  END SUBROUTINE concvl    SUBROUTINE concvl(iflag_con, dtime, paprs, pplay, t, q, u, v, tra, &
8           ntra, work1, work2, d_t, d_q, d_u, d_v, d_tra, rain, snow, kbas, &
9           ktop, upwd, dnwd, dnwd0, ma, cape, tvp, iflag, pbase, bbase, &
10           dtvpdt1, dtvpdq1, dplcldt, dplcldr, qcondc, wd, pmflxr, pmflxs, &
11           da, phi, mp)
12    
13        ! From phylmd/concvl.F, version 1.3 2005/04/15 12:36:17
14        ! Author: Z. X. Li (LMD/CNRS)
15        ! date: 1993/08/18
16        ! Objet : schéma de convection d'Emanuel (1991), interface
17    
18        USE dimens_m, ONLY : nqmx
19        USE dimphy, ONLY : klev, klon
20        USE suphec_m, ONLY : retv, rtt
21        USE yoethf_m, ONLY : r2es
22        USE fcttre, ONLY : foeew
23        use cv_driver_m, only: cv_driver
24    
25        INTEGER, PARAMETER:: ntrac = nqmx - 2
26    
27        INTEGER, INTENT (IN) :: iflag_con
28        REAL, INTENT (IN) :: dtime ! pas d'integration (s)
29        REAL, INTENT (IN) :: paprs(klon, klev+1)
30        REAL, INTENT (IN) :: pplay(klon, klev)
31        REAL, intent(in):: t(klon, klev)
32        real q(klon, klev), u(klon, klev), v(klon, klev)
33        ! q-------input-R-vapeur d'eau (en kg/kg)
34        REAL, INTENT (IN):: tra(klon, klev, ntrac)
35        INTEGER ntra
36        REAL work1(klon, klev), work2(klon, klev)
37        ! work*: input et output: deux variables de travail,
38        !                            on peut les mettre a 0 au debut
39        REAL pmflxr(klon, klev+1), pmflxs(klon, klev+1)
40    
41        REAL d_t(klon, klev), d_q(klon, klev), d_u(klon, klev), d_v(klon, &
42             klev)
43        ! d_q-----output-R-increment de la vapeur d'eau
44        REAL d_tra(klon, klev, ntrac)
45        REAL rain(klon), snow(klon)
46        ! rain----output-R-la pluie (mm/s)
47        ! snow----output-R-la neige (mm/s)
48    
49        INTEGER kbas(klon), ktop(klon)
50        REAL em_ph(klon, klev+1), em_p(klon, klev)
51    
52        REAL, intent(out):: upwd(klon, klev)
53        ! saturated updraft mass flux (kg/m**2/s)
54    
55        real, intent(out):: dnwd(klon, klev)
56        ! saturated downdraft mass flux (kg/m**2/s)
57    
58        real, intent(out):: dnwd0(klon, klev)
59        ! unsaturated downdraft mass flux (kg/m**2/s)
60    
61        REAL ma(klon, klev), cape(klon), tvp(klon, klev)
62        ! Cape----output-R-CAPE (J/kg)
63        ! Tvp-----output-R-Temperature virtuelle d'une parcelle soulevee
64        !                  adiabatiquement a partir du niveau 1 (K)
65        REAL da(klon, klev), phi(klon, klev, klev), mp(klon, klev)
66        INTEGER iflag(klon)
67        REAL pbase(klon), bbase(klon)
68        REAL dtvpdt1(klon, klev), dtvpdq1(klon, klev)
69        REAL dplcldt(klon), dplcldr(klon)
70        REAL qcondc(klon, klev)
71        REAL wd(klon)
72    
73        REAL zx_t, zdelta, zx_qs, zcor
74    
75        INTEGER i, k, itra
76        REAL qs(klon, klev)
77        REAL, save:: cbmf(klon)
78        INTEGER:: ifrst = 0
79    
80        !-----------------------------------------------------------------
81    
82        snow = 0
83    
84        IF (ifrst==0) THEN
85           ifrst = 1
86           DO i = 1, klon
87              cbmf(i) = 0.
88           END DO
89        END IF
90    
91        DO k = 1, klev + 1
92           DO i = 1, klon
93              em_ph(i, k) = paprs(i, k)/100.0
94              pmflxs(i, k) = 0.
95           END DO
96        END DO
97    
98        DO k = 1, klev
99           DO i = 1, klon
100              em_p(i, k) = pplay(i, k)/100.0
101           END DO
102        END DO
103    
104    
105        IF (iflag_con==4) THEN
106           DO k = 1, klev
107              DO i = 1, klon
108                 zx_t = t(i, k)
109                 zdelta = max(0., sign(1., rtt-zx_t))
110                 zx_qs = min(0.5, r2es*foeew(zx_t, zdelta)/em_p(i, k)/100.0)
111                 zcor = 1./(1.-retv*zx_qs)
112                 qs(i, k) = zx_qs*zcor
113              END DO
114           END DO
115        ELSE
116           ! iflag_con=3 (modif de puristes qui fait la diffce pour la
117           ! convergence numerique)
118           DO k = 1, klev
119              DO i = 1, klon
120                 zx_t = t(i, k)
121                 zdelta = max(0., sign(1., rtt-zx_t))
122                 zx_qs = r2es*foeew(zx_t, zdelta)/em_p(i, k)/100.0
123                 zx_qs = min(0.5, zx_qs)
124                 zcor = 1./(1.-retv*zx_qs)
125                 zx_qs = zx_qs*zcor
126                 qs(i, k) = zx_qs
127              END DO
128           END DO
129        END IF
130    
131        ! Main driver for convection:
132        !           iflag_con = 3  -> equivalent to convect3
133        !           iflag_con = 4  -> equivalent to convect1/2
134    
135        CALL cv_driver(klon, klev, klev+1, ntra, iflag_con, t, q, qs, u, v, tra, &
136             em_p, em_ph, iflag, d_t, d_q, d_u, d_v, d_tra, rain, pmflxr, cbmf, &
137             work1, work2, kbas, ktop, dtime, ma, upwd, dnwd, dnwd0, qcondc, &
138             wd, cape, da, phi, mp)
139    
140        DO i = 1, klon
141           rain(i) = rain(i)/86400.
142        END DO
143    
144        DO k = 1, klev
145           DO i = 1, klon
146              d_t(i, k) = dtime*d_t(i, k)
147              d_q(i, k) = dtime*d_q(i, k)
148              d_u(i, k) = dtime*d_u(i, k)
149              d_v(i, k) = dtime*d_v(i, k)
150           END DO
151        END DO
152        DO itra = 1, ntra
153           DO k = 1, klev
154              DO i = 1, klon
155                 d_tra(i, k, itra) = dtime*d_tra(i, k, itra)
156              END DO
157           END DO
158        END DO
159        ! les traceurs ne sont pas mis dans cette version de convect4:
160        IF (iflag_con==4) THEN
161           DO itra = 1, ntra
162              DO k = 1, klev
163                 DO i = 1, klon
164                    d_tra(i, k, itra) = 0.
165                 END DO
166              END DO
167           END DO
168        END IF
169    
170      END SUBROUTINE concvl
171    
172    end module concvl_m
Legend:
Removed from v.38  
changed lines
  Added in v.62
  ViewVC Help
Powered by ViewVC 1.1.21