/[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 69 by guez, Mon Feb 18 16:33:12 2013 UTC trunk/Sources/phylmd/concvl.f revision 205 by guez, Tue Jun 21 15:16:03 2016 UTC
# Line 4  module concvl_m Line 4  module concvl_m
4    
5  contains  contains
6    
7    SUBROUTINE concvl(dtime, paprs, pplay, t, q, u, v, tra, work1, work2, &    SUBROUTINE concvl(paprs, play, t, q, u, v, sig1, w01, d_t, d_q, d_u, &
8         d_t, d_q, d_u, d_v, d_tra, rain, snow, kbas, ktop, upwd, dnwd, dnwd0, &         d_v, rain, kbas, itop_con, upwd, dnwd, dnwd0, ma, cape, iflag, qcondc, &
9         ma, cape, tvp, iflag, pbase, bbase, dtvpdt1, dtvpdq1, dplcldt, &         pmflxr, da, phi, mp)
        dplcldr, qcondc, wd, pmflxr, pmflxs, da, phi, mp, ntra)  
10    
11      ! From phylmd/concvl.F, version 1.3 2005/04/15 12:36:17      ! From phylmd/concvl.F, version 1.3, 2005/04/15 12:36:17
12      ! Author: Z. X. Li (LMD/CNRS)      ! Author: Z. X. Li (LMD/CNRS)
13      ! Date: 1993/08/18      ! Date: 1993 August 18
14      ! Objet : schéma de convection d'Emanuel (1991), interface      ! Objet : schéma de convection d'Emanuel (1991), interface
     ! (driver commun aux versions 3 et 4)  
15    
16      use clesphys2, only: iflag_con      use comconst, only: dtphys
17      use cv_driver_m, only: cv_driver      use cv_driver_m, only: cv_driver
     USE dimens_m, ONLY: nqmx  
18      USE dimphy, ONLY: klev, klon      USE dimphy, ONLY: klev, klon
19      USE fcttre, ONLY: foeew      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    
23      INTEGER, PARAMETER:: ntrac = nqmx - 2      REAL, INTENT (IN):: paprs(klon, klev + 1)
24        REAL, INTENT (IN):: play(klon, klev)
25      REAL, INTENT (IN):: dtime ! pas d'integration (s)      REAL, intent(in):: t(klon, klev) ! temperature (K)
26      REAL, INTENT (IN):: paprs(klon, klev+1)      real, intent(in):: q(klon, klev) ! fraction massique de vapeur d'eau
27      REAL, INTENT (IN):: pplay(klon, klev)      real, INTENT (IN):: u(klon, klev), v(klon, klev)
28      REAL, intent(in):: t(klon, klev)      REAL, intent(inout):: sig1(klon, klev), w01(klon, klev)
29      real q(klon, klev) ! input vapeur d'eau (en kg/kg)      REAL, intent(out):: d_t(klon, klev)
30      real u(klon, klev), v(klon, klev)      REAL, intent(out):: d_q(klon, klev) ! increment de la vapeur d'eau
31      REAL, INTENT (IN):: tra(klon, klev, ntrac)      REAL, intent(out):: d_u(klon, klev), d_v(klon, klev)
32      INTEGER, intent(in):: ntra ! number of tracers      REAL, intent(out):: rain(klon) ! pluie (mm / s)
33      REAL work1(klon, klev), work2(klon, klev)      INTEGER, intent(out):: kbas(klon)
34      ! work*: input et output: deux variables de travail,      integer, intent(inout):: itop_con(klon)
     !                            on peut les mettre a 0 au debut  
     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)  
     ! d_q-----output-R-increment de la vapeur d'eau  
     REAL d_tra(klon, klev, ntrac)  
     REAL rain(klon), snow(klon)  
     ! rain----output-R-la pluie (mm/s)  
     ! snow----output-R-la neige (mm/s)  
   
     INTEGER kbas(klon), ktop(klon)  
     REAL em_ph(klon, klev+1), em_p(klon, klev)  
35    
36      REAL, intent(out):: upwd(klon, klev)      REAL, intent(out):: upwd(klon, klev)
37      ! saturated updraft mass flux (kg/m**2/s)      ! saturated updraft mass flux (kg / m2 / s)
38    
39      real, intent(out):: dnwd(klon, klev)      real, intent(out):: dnwd(klon, klev)
40      ! saturated downdraft mass flux (kg/m**2/s)      ! saturated downdraft mass flux (kg / m2 / s)
41    
42      real, intent(out):: dnwd0(klon, klev)      real, intent(out):: dnwd0(klon, klev)
43      ! unsaturated downdraft mass flux (kg/m**2/s)      ! unsaturated downdraft mass flux, in kg m-2 s-1
44    
45      REAL ma(klon, klev), cape(klon), tvp(klon, klev)      REAL ma(klon, klev)
46      ! Cape----output-R-CAPE (J/kg)      real cape(klon) ! output (J / kg)
47      ! Tvp-----output-R-Temperature virtuelle d'une parcelle soulevee      INTEGER, intent(out):: iflag(klon)
     !                  adiabatiquement a partir du niveau 1 (K)  
     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)  
48      REAL qcondc(klon, klev)      REAL qcondc(klon, klev)
49      REAL wd(klon)      REAL pmflxr(klon, klev + 1)
50        REAL, intent(out):: da(:, :) ! (klon, klev)
51      REAL zx_t, zdelta, zx_qs, zcor      REAL, intent(out):: phi(:, :, :) ! (klon, klev, klev)
52    
53      INTEGER i, k, itra      REAL, intent(out):: mp(:, :) ! (klon, klev) Mass flux of the
54        ! unsaturated downdraft, defined positive downward, in kg m-2
55        ! s-1. M_p in Emanuel (1991 928).
56    
57        ! Local:
58        REAL zx_qs, cor
59        INTEGER i, k
60      REAL qs(klon, klev)      REAL qs(klon, klev)
     REAL, save:: cbmf(klon)  
     INTEGER:: ifrst = 0  
61    
62      !-----------------------------------------------------------------      !-----------------------------------------------------------------
63    
     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  
   
64      DO k = 1, klev      DO k = 1, klev
65         DO i = 1, klon         DO i = 1, klon
66            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))
67         END DO            cor = 1. / (1. - retv * zx_qs)
68      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  
69         END DO         END DO
     END IF  
   
     CALL cv_driver(klon, klev, klev+1, ntra, 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, dnwd0, qcondc, wd, cape, &  
          da, phi, mp)  
   
     DO i = 1, klon  
        rain(i) = rain(i)/86400.  
70      END DO      END DO
71    
72      DO k = 1, klev      CALL cv_driver(t, q, qs, u, v, play / 100., paprs / 100., iflag, d_t, &
73         DO i = 1, klon           d_q, d_u, d_v, rain, pmflxr, sig1, w01, kbas, itop_con, ma, upwd, &
74            d_t(i, k) = dtime*d_t(i, k)           dnwd, qcondc, cape, da, phi, mp)
75            d_q(i, k) = dtime*d_q(i, k)      dnwd0 = - mp
76            d_u(i, k) = dtime*d_u(i, k)      rain = rain / 86400.
77            d_v(i, k) = dtime*d_v(i, k)      d_t = dtphys * d_t
78         END DO      d_q = dtphys * d_q
79      END DO      d_u = dtphys * d_u
80      DO itra = 1, ntra      d_v = dtphys * 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  
81    
82    END SUBROUTINE concvl    END SUBROUTINE concvl
83    
Legend:
Removed from v.69  
changed lines
  Added in v.205
  ViewVC Help
Powered by ViewVC 1.1.21