/[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 52 by guez, Fri Sep 23 12:28:01 2011 UTC trunk/phylmd/concvl.f revision 254 by guez, Mon Feb 5 10:39:38 2018 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(paprs, play, t, q, u, v, sig1, w01, d_t, d_q, d_u, d_v, &
8         ntra, work1, work2, d_t, d_q, d_u, d_v, d_tra, rain, snow, kbas, &         rain, kbas, itop_con, upwd, dnwd, ma, cape, iflag, qcondc, pmflxr, da, &
9         ktop, upwd, dnwd, dnwdbis, ma, cape, tvp, iflag, pbase, bbase, &         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
     ! date: 1993/08/18  
     ! Objet: schéma de convection de Emanuel (1991) interface  
   
     USE dimens_m, ONLY : nqmx  
     USE dimphy, ONLY : klev, klon  
     USE suphec_m, ONLY : retv, rtt  
     USE yoethf_m, ONLY : r2es  
     USE fcttre, ONLY : foeew  
     use cv_driver_m, only: cv_driver  
15    
16      ! Arguments:      use comconst, only: dtphys
17      ! dtime--input-R-pas d'integration (s)      use cv_driver_m, only: cv_driver
18      ! s-------input-R-la valeur "s" pour chaque couche      USE dimphy, ONLY: klev, klon
19      ! sigs----input-R-la valeur "sigma" de chaque couche      USE fcttre, ONLY: foeew
20      ! sig-----input-R-la valeur de "sigma" pour chaque niveau      USE suphec_m, ONLY: retv, rtt
21      ! psolpa--input-R-la pression au sol (en Pa)      USE yoethf_m, ONLY: r2es
22      ! pskapa--input-R-exponentiel kappa de psolpa  
23      ! h-------input-R-enthalpie potentielle (Cp*T/P**kappa)      REAL, INTENT (IN):: paprs(klon, klev + 1)
24      ! q-------input-R-vapeur d'eau (en kg/kg)      REAL, INTENT (IN):: play(klon, klev)
25        REAL, intent(in):: t(klon, klev) ! temperature (K)
26      ! work*: input et output: deux variables de travail,      real, intent(in):: q(klon, klev) ! fraction massique de vapeur d'eau
27      !                            on peut les mettre a 0 au debut      real, INTENT (IN):: u(klon, klev), v(klon, klev)
28      ! ALE-----input-R-energie disponible pour soulevement      REAL, intent(inout):: sig1(klon, klev), w01(klon, klev)
29        REAL, intent(out):: d_t(klon, klev)
30      ! d_h-----output-R-increment de l'enthalpie potentielle (h)      REAL, intent(out):: d_q(klon, klev) ! increment de la vapeur d'eau
31      ! d_q-----output-R-increment de la vapeur d'eau      REAL, intent(out):: d_u(klon, klev), d_v(klon, klev)
32      ! rain----output-R-la pluie (mm/s)      REAL, intent(out):: rain(klon) ! pluie (mm / s)
33      ! snow----output-R-la neige (mm/s)      INTEGER, intent(out):: kbas(klon)
34      ! upwd----output-R-saturated updraft mass flux (kg/m**2/s)      integer, intent(inout):: itop_con(klon)
35      ! dnwd----output-R-saturated downdraft mass flux (kg/m**2/s)  
36      ! dnwd0---output-R-unsaturated downdraft mass flux (kg/m**2/s)      REAL, intent(out):: upwd(klon, klev)
37      ! Cape----output-R-CAPE (J/kg)      ! saturated updraft mass flux (kg / m2 / s)
38      ! Tvp-----output-R-Temperature virtuelle d'une parcelle soulevee  
39      !                  adiabatiquement a partir du niveau 1 (K)      real, intent(out):: dnwd(klon, klev)
40      ! deltapb-output-R-distance entre LCL et base de la colonne (<0 ;      ! saturated downdraft mass flux (kg / m2 / s)
41      !  Pa)  
42      ! Ice_flag-input-L-TRUE->prise en compte de la thermodynamique de      REAL ma(klon, klev)
43      !  la glace      real cape(klon) ! output (J / kg)
44        INTEGER, intent(out):: iflag(klon)
     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, intent(in):: t(klon, klev)  
     real 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)  
45      REAL qcondc(klon, klev)      REAL qcondc(klon, klev)
46      REAL wd(klon)      REAL pmflxr(klon, klev + 1)
47        REAL, intent(out):: da(:, :) ! (klon, klev)
48      REAL zx_t, zdelta, zx_qs, zcor      REAL, intent(out):: phi(:, :, :) ! (klon, klev, klev)
49    
50      INTEGER i, k, itra      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 cbmf(klon)  
     SAVE cbmf  
     INTEGER ifrst  
     SAVE ifrst  
     DATA 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         END DO            cor = 1. / (1. - retv * zx_qs)
65      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  
66         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.  
67      END DO      END DO
68    
69      DO k = 1, klev      CALL cv_driver(t, q, qs, u, v, play / 100., paprs / 100., iflag, d_t, &
70         DO i = 1, klon           d_q, d_u, d_v, rain, pmflxr, sig1, w01, kbas, itop_con, ma, upwd, &
71            d_t(i, k) = dtime*d_t(i, k)           dnwd, qcondc, cape, da, phi, mp)
72            d_q(i, k) = dtime*d_q(i, k)      rain = rain / 86400.
73            d_u(i, k) = dtime*d_u(i, k)      d_t = dtphys * d_t
74            d_v(i, k) = dtime*d_v(i, k)      d_q = dtphys * d_q
75         END DO      d_u = dtphys * d_u
76      END DO      d_v = dtphys * d_v
     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.52  
changed lines
  Added in v.254
  ViewVC Help
Powered by ViewVC 1.1.21