/[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 49 by guez, Wed Aug 24 11:43:14 2011 UTC trunk/Sources/phylmd/concvl.f revision 180 by guez, Tue Mar 15 17:07:47 2016 UTC
# Line 4  module concvl_m Line 4  module concvl_m
4    
5  contains  contains
6    
7    SUBROUTINE concvl(iflag_con, dtime, paprs, pplay, t, q, u, v, tra, &    SUBROUTINE concvl(dtime, paprs, play, t, q, u, v, sig1, w01, d_t, d_q, d_u, &
8         ntra, work1, work2, d_t, d_q, d_u, d_v, d_tra, rain, snow, kbas, &         d_v, rain, snow_con, kbas, itop_con, upwd, dnwd, dnwd0, ma, cape, &
9         ktop, upwd, dnwd, dnwdbis, ma, cape, tvp, iflag, pbase, bbase, &         iflag, qcondc, wd, pmflxr, da, phi, mp)
10         dtvpdt1, dtvpdq1, dplcldt, dplcldr, qcondc, wd, pmflxr, pmflxs, &  
11         da, phi, mp)      ! From phylmd/concvl.F, version 1.3, 2005/04/15 12:36:17
12        ! Author: Z. X. Li (LMD/CNRS)
13      ! From phylmd/concvl.F, version 1.3 2005/04/15 12:36:17      ! Date: 1993 August 18
14      ! Author: Z.X. Li (LMD/CNRS)      ! Objet : schéma de convection d'Emanuel (1991), interface
15      ! date: 1993/08/18      ! (driver commun aux versions 3 et 4)
16      ! Objet: schéma de convection de Emanuel (1991) interface  
17        use cv_driver_m, only: cv_driver
18      USE dimens_m, ONLY : nqmx      USE dimphy, ONLY: klev, klon
19      USE dimphy, ONLY : klev, klon      USE fcttre, ONLY: foeew
20      USE suphec_m, ONLY : retv, rtt      USE suphec_m, ONLY: retv, rtt
21      USE yoethf_m, ONLY : r2es      USE yoethf_m, ONLY: r2es
22      USE fcttre, ONLY : foeew  
23        REAL, INTENT (IN):: dtime ! pas d'integration (s)
24      ! Arguments:      REAL, INTENT (IN):: paprs(klon, klev + 1)
25      ! dtime--input-R-pas d'integration (s)      REAL, INTENT (IN):: play(klon, klev)
26      ! s-------input-R-la valeur "s" pour chaque couche      REAL, intent(in):: t(klon, klev)
27      ! sigs----input-R-la valeur "sigma" de chaque couche      real, intent(in):: q(klon, klev) ! vapeur d'eau (en kg / kg)
28      ! sig-----input-R-la valeur de "sigma" pour chaque niveau      real, INTENT (IN):: u(klon, klev), v(klon, klev)
29      ! psolpa--input-R-la pression au sol (en Pa)      REAL, intent(inout):: sig1(klon, klev), w01(klon, klev)
30      ! pskapa--input-R-exponentiel kappa de psolpa      REAL, intent(out):: d_t(klon, klev)
31      ! h-------input-R-enthalpie potentielle (Cp*T/P**kappa)      REAL, intent(out):: d_q(klon, klev) ! increment de la vapeur d'eau
32      ! q-------input-R-vapeur d'eau (en kg/kg)      REAL, intent(out):: d_u(klon, klev), d_v(klon, klev)
33        REAL, intent(out):: rain(klon) ! pluie (mm / s)
34      ! work*: input et output: deux variables de travail,      REAL, intent(out):: snow_con(klon) ! neige (mm / s)
35      !                            on peut les mettre a 0 au debut      INTEGER, intent(out):: kbas(klon)
36      ! ALE-----input-R-energie disponible pour soulevement      integer itop_con(klon)
37    
38      ! d_h-----output-R-increment de l'enthalpie potentielle (h)      REAL, intent(out):: upwd(klon, klev)
39      ! d_q-----output-R-increment de la vapeur d'eau      ! saturated updraft mass flux (kg / m2 / s)
40      ! rain----output-R-la pluie (mm/s)  
41      ! snow----output-R-la neige (mm/s)      real, intent(out):: dnwd(klon, klev)
42      ! upwd----output-R-saturated updraft mass flux (kg/m**2/s)      ! saturated downdraft mass flux (kg / m2 / s)
43      ! dnwd----output-R-saturated downdraft mass flux (kg/m**2/s)  
44      ! dnwd0---output-R-unsaturated downdraft mass flux (kg/m**2/s)      real, intent(out):: dnwd0(klon, klev)
45      ! Cape----output-R-CAPE (J/kg)      ! unsaturated downdraft mass flux (kg / m2 / s)
46      ! Tvp-----output-R-Temperature virtuelle d'une parcelle soulevee  
47      !                  adiabatiquement a partir du niveau 1 (K)      REAL ma(klon, klev)
48      ! deltapb-output-R-distance entre LCL et base de la colonne (<0 ;      real cape(klon) ! output (J / kg)
     !  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)  
49      INTEGER iflag(klon)      INTEGER iflag(klon)
     REAL pbase(klon), bbase(klon)  
     REAL dtvpdt1(klon, klev), dtvpdq1(klon, klev)  
     REAL dplcldt(klon), dplcldr(klon)  
50      REAL qcondc(klon, klev)      REAL qcondc(klon, klev)
51      REAL wd(klon)      REAL wd(klon)
52        REAL pmflxr(klon, klev + 1)
53        REAL, intent(inout):: da(klon, klev), phi(klon, klev, klev), mp(klon, klev)
54    
55      REAL zx_t, zdelta, zx_qs, zcor      ! Local:
56        REAL zx_qs, cor
57      INTEGER i, k, itra      INTEGER i, k
58      REAL qs(klon, klev)      REAL qs(klon, klev)
59      REAL cbmf(klon)      REAL, save:: cbmf(klon)
60      SAVE cbmf      INTEGER:: ifrst = 0
     INTEGER ifrst  
     SAVE ifrst  
     DATA ifrst/0/  
61    
62      !-----------------------------------------------------------------      !-----------------------------------------------------------------
63    
64      snow(:) = 0      snow_con = 0.
65    
66      IF (ifrst==0) THEN      IF (ifrst == 0) THEN
67         ifrst = 1         ifrst = 1
68         DO i = 1, klon         cbmf = 0.
           cbmf(i) = 0.  
        END DO  
69      END IF      END IF
70    
     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  
   
71      DO k = 1, klev      DO k = 1, klev
72         DO i = 1, klon         DO i = 1, klon
73            em_p(i, k) = pplay(i, k)/100.0            zx_qs = min(0.5, r2es * foeew(t(i, k), rtt >= t(i, k)) / play(i, k))
74         END DO            cor = 1. / (1. - retv * zx_qs)
75      END DO            qs(i, k) = zx_qs * cor
   
   
     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  
76         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.  
77      END DO      END DO
78    
79      DO k = 1, klev      CALL cv_driver(t, q, qs, u, v, play / 100., paprs / 100., iflag, d_t, &
80         DO i = 1, klon           d_q, d_u, d_v, rain, pmflxr, cbmf, sig1, w01, kbas, itop_con, dtime, &
81            d_t(i, k) = dtime*d_t(i, k)           ma, upwd, dnwd, dnwd0, qcondc, wd, cape, da, phi, mp)
82            d_q(i, k) = dtime*d_q(i, k)  
83            d_u(i, k) = dtime*d_u(i, k)      rain = rain / 86400.
84            d_v(i, k) = dtime*d_v(i, k)      d_t = dtime * d_t
85         END DO      d_q = dtime * d_q
86      END DO      d_u = dtime * d_u
87      DO itra = 1, ntra      d_v = dtime * d_v
        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  
88    
89    END SUBROUTINE concvl    END SUBROUTINE concvl
90    
Legend:
Removed from v.49  
changed lines
  Added in v.180
  ViewVC Help
Powered by ViewVC 1.1.21