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

Diff of /trunk/phylmd/concvl.f

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

trunk/libf/phylmd/concvl.f90 revision 13 by guez, Fri Jul 25 19:59:34 2008 UTC trunk/phylmd/concvl.f revision 91 by guez, Wed Mar 26 17:18:58 2014 UTC
# Line 1  Line 1 
1  SUBROUTINE concvl(iflag_con,dtime,paprs,pplay,t,q,u,v,tra,ntra,work1, &  module concvl_m
      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 yomcst  
   USE yoethf  
   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 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(dtime, paprs, play, t, q, u, v, tra, sig1, w01, &
8           d_t, d_q, d_u, d_v, d_tra, rain, snow, kbas, ktop, upwd, dnwd, dnwd0, &
9           ma, cape, tvp, iflag, pbase, bbase, dtvpdt1, dtvpdq1, dplcldt, &
10           dplcldr, qcondc, wd, pmflxr, pmflxs, da, phi, mp, ntra)
11    
12        ! From phylmd/concvl.F, version 1.3 2005/04/15 12:36:17
13        ! Author: Z. X. Li (LMD/CNRS)
14        ! Date: 1993/08/18
15        ! Objet : schéma de convection d'Emanuel (1991), interface
16        ! (driver commun aux versions 3 et 4)
17    
18        use clesphys2, only: iflag_con
19        use cv_driver_m, only: cv_driver
20        USE dimens_m, ONLY: nqmx
21        USE dimphy, ONLY: klev, klon
22        USE fcttre, ONLY: foeew
23        USE suphec_m, ONLY: retv, rtt
24        USE yoethf_m, ONLY: r2es
25    
26        INTEGER, PARAMETER:: ntrac = nqmx - 2
27    
28        REAL, INTENT (IN):: dtime ! pas d'integration (s)
29        REAL, INTENT (IN):: paprs(klon, klev+1)
30        REAL, INTENT (IN):: play(klon, klev)
31        REAL, intent(in):: t(klon, klev)
32        real q(klon, klev) ! input vapeur d'eau (en kg/kg)
33        real, INTENT (IN):: u(klon, klev), v(klon, klev)
34        REAL, INTENT (IN):: tra(klon, klev, ntrac)
35        INTEGER, intent(in):: ntra ! number of tracers
36        REAL, intent(inout):: sig1(klon, klev), w01(klon, klev)
37        REAL pmflxr(klon, klev+1), pmflxs(klon, klev+1)
38    
39        REAL d_t(klon, klev), d_q(klon, klev), d_u(klon, klev), d_v(klon, &
40             klev)
41        ! d_q-----output-R-increment de la vapeur d'eau
42        REAL d_tra(klon, klev, ntrac)
43        REAL rain(klon), snow(klon)
44        ! rain----output-R-la pluie (mm/s)
45        ! snow----output-R-la neige (mm/s)
46    
47        INTEGER kbas(klon), ktop(klon)
48        REAL em_ph(klon, klev+1), em_p(klon, klev)
49    
50        REAL, intent(out):: upwd(klon, klev)
51        ! saturated updraft mass flux (kg/m**2/s)
52    
53        real, intent(out):: dnwd(klon, klev)
54        ! saturated downdraft mass flux (kg/m**2/s)
55    
56        real, intent(out):: dnwd0(klon, klev)
57        ! unsaturated downdraft mass flux (kg/m**2/s)
58    
59        REAL ma(klon, klev), cape(klon), tvp(klon, klev)
60        ! Cape----output-R-CAPE (J/kg)
61        ! Tvp-----output-R-Temperature virtuelle d'une parcelle soulevee
62        !                  adiabatiquement a partir du niveau 1 (K)
63        REAL da(klon, klev), phi(klon, klev, klev), mp(klon, klev)
64        INTEGER iflag(klon)
65        REAL pbase(klon), bbase(klon)
66        REAL dtvpdt1(klon, klev), dtvpdq1(klon, klev)
67        REAL dplcldt(klon), dplcldr(klon)
68        REAL qcondc(klon, klev)
69        REAL wd(klon)
70    
71        REAL zx_t, zdelta, zx_qs, zcor
72    
73        INTEGER i, k, itra
74        REAL qs(klon, klev)
75        REAL, save:: cbmf(klon)
76        INTEGER:: ifrst = 0
77    
78        !-----------------------------------------------------------------
79    
80        snow = 0
81    
82        IF (ifrst==0) THEN
83           ifrst = 1
84           DO i = 1, klon
85              cbmf(i) = 0.
86           END DO
87        END IF
88    
89        DO k = 1, klev + 1
90           DO i = 1, klon
91              em_ph(i, k) = paprs(i, k)/100.0
92              pmflxs(i, k) = 0.
93           END DO
94        END DO
95    
96        DO k = 1, klev
97           DO i = 1, klon
98              em_p(i, k) = play(i, k)/100.0
99           END DO
100        END DO
101    
102    
103        IF (iflag_con==4) THEN
104           DO k = 1, klev
105              DO i = 1, klon
106                 zx_t = t(i, k)
107                 zdelta = max(0., sign(1., rtt-zx_t))
108                 zx_qs = min(0.5, r2es*foeew(zx_t, zdelta)/em_p(i, k)/100.0)
109                 zcor = 1./(1.-retv*zx_qs)
110                 qs(i, k) = zx_qs*zcor
111              END DO
112           END DO
113        ELSE
114           ! iflag_con=3 (modif de puristes qui fait la diffce pour la
115           ! convergence numerique)
116           DO k = 1, klev
117              DO i = 1, klon
118                 zx_t = t(i, k)
119                 zdelta = max(0., sign(1., rtt-zx_t))
120                 zx_qs = r2es*foeew(zx_t, zdelta)/em_p(i, k)/100.0
121                 zx_qs = min(0.5, zx_qs)
122                 zcor = 1./(1.-retv*zx_qs)
123                 zx_qs = zx_qs*zcor
124                 qs(i, k) = zx_qs
125              END DO
126           END DO
127        END IF
128    
129        CALL cv_driver(klon, klev, klev+1, ntra, t, q, qs, u, v, tra, em_p, &
130             em_ph, iflag, d_t, d_q, d_u, d_v, d_tra, rain, pmflxr, cbmf, sig1, &
131             w01, kbas, ktop, dtime, ma, upwd, dnwd, dnwd0, qcondc, wd, cape, &
132             da, phi, mp)
133    
134        DO i = 1, klon
135           rain(i) = rain(i)/86400.
136        END DO
137    
138        DO k = 1, klev
139           DO i = 1, klon
140              d_t(i, k) = dtime*d_t(i, k)
141              d_q(i, k) = dtime*d_q(i, k)
142              d_u(i, k) = dtime*d_u(i, k)
143              d_v(i, k) = dtime*d_v(i, k)
144           END DO
145        END DO
146        DO itra = 1, ntra
147           DO k = 1, klev
148              DO i = 1, klon
149                 d_tra(i, k, itra) = dtime*d_tra(i, k, itra)
150              END DO
151           END DO
152        END DO
153        ! les traceurs ne sont pas mis dans cette version de convect4:
154        IF (iflag_con==4) THEN
155           DO itra = 1, ntra
156              DO k = 1, klev
157                 DO i = 1, klon
158                    d_tra(i, k, itra) = 0.
159                 END DO
160              END DO
161           END DO
162        END IF
163    
164      END SUBROUTINE concvl
165    
166    end module concvl_m
Legend:
Removed from v.13  
changed lines
  Added in v.91
  ViewVC Help
Powered by ViewVC 1.1.21