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