/[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/phylmd/concvl.f revision 266 by guez, Thu Apr 19 17:54:55 2018 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, d_v, &
8         d_t, d_q, d_u, d_v, d_tra, rain, snow, kbas, ktop, upwd, dnwd, dnwd0, &         rain, kbas, itop_con, upwd, dnwd, ma, cape, iflag, qcondc, pmflxr, da, &
9         ma, cape, tvp, iflag, pbase, bbase, dtvpdt1, dtvpdq1, dplcldt, &         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)
   
     real, intent(out):: dnwd0(klon, klev)  
     ! unsaturated downdraft mass flux (kg/m**2/s)  
   
     REAL ma(klon, klev), cape(klon), tvp(klon, klev)  
     ! Cape----output-R-CAPE (J/kg)  
     ! Tvp-----output-R-Temperature virtuelle d'une parcelle soulevee  
     !                  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)  
     REAL qcondc(klon, klev)  
     REAL wd(klon)  
41    
42      REAL zx_t, zdelta, zx_qs, zcor      REAL ma(klon, klev)
43        real cape(klon) ! output (J / kg)
44      INTEGER i, k, itra      INTEGER, intent(out):: iflag(klon)
45        REAL, intent(out):: qcondc(klon, klev) ! in-cloud water content
46        REAL pmflxr(klon, klev + 1)
47        REAL, intent(out):: da(:, :) ! (klon, klev)
48        REAL, intent(out):: phi(:, :, :) ! (klon, klev, klev)
49    
50        REAL, intent(out):: mp(:, :) ! (klon, klev) Mass flux of the
51        ! unsaturated downdraft, defined positive downward, in kg m-2
52        ! s-1. M_p in Emanuel (1991 928).
53    
54        ! Local:
55        REAL zx_qs, cor
56        INTEGER i, k
57      REAL qs(klon, klev)      REAL qs(klon, klev)
     REAL, save:: cbmf(klon)  
     INTEGER:: ifrst = 0  
58    
59      !-----------------------------------------------------------------      !-----------------------------------------------------------------
60    
     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  
   
61      DO k = 1, klev      DO k = 1, klev
62         DO i = 1, klon         DO i = 1, klon
63            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))
64              cor = 1. / (1. - retv * zx_qs)
65              qs(i, k) = zx_qs * cor
66         END DO         END DO
67      END DO      END DO
68    
69        CALL cv_driver(t, q, qs, u, v, play / 100., paprs / 100., iflag, d_t, &
70      IF (iflag_con==4) THEN           d_q, d_u, d_v, rain, pmflxr, sig1, w01, kbas, itop_con, ma, upwd, &
71         DO k = 1, klev           dnwd, qcondc, cape, da, phi, mp)
72            DO i = 1, klon      rain = rain / 86400.
73               zx_t = t(i, k)      d_t = dtphys * d_t
74               zdelta = max(0., sign(1., rtt-zx_t))      d_q = dtphys * d_q
75               zx_qs = min(0.5, r2es*foeew(zx_t, zdelta)/em_p(i, k)/100.0)      d_u = dtphys * d_u
76               zcor = 1./(1.-retv*zx_qs)      d_v = dtphys * d_v
              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  
   
     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.  
     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  
77    
78    END SUBROUTINE concvl    END SUBROUTINE concvl
79    
Legend:
Removed from v.69  
changed lines
  Added in v.266
  ViewVC Help
Powered by ViewVC 1.1.21