/[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/Sources/phylmd/concvl.f revision 183 by guez, Wed Mar 16 14:42:58 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, kbas, itop_con, upwd, dnwd, dnwd0, ma, cape, iflag, qcondc, &
9         ktop, upwd, dnwd, dnwdbis, ma, cape, tvp, iflag, pbase, bbase, &         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
     ! 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 cv_driver_m, only: cv_driver
17      ! dtime--input-R-pas d'integration (s)      USE dimphy, ONLY: klev, klon
18      ! s-------input-R-la valeur "s" pour chaque couche      USE fcttre, ONLY: foeew
19      ! sigs----input-R-la valeur "sigma" de chaque couche      USE suphec_m, ONLY: retv, rtt
20      ! sig-----input-R-la valeur de "sigma" pour chaque niveau      USE yoethf_m, ONLY: r2es
21      ! psolpa--input-R-la pression au sol (en Pa)  
22      ! pskapa--input-R-exponentiel kappa de psolpa      REAL, INTENT (IN):: dtime ! pas d'integration (s)
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)
   
     ! 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)  
25      REAL, intent(in):: t(klon, klev)      REAL, intent(in):: t(klon, klev)
26      real q(klon, klev), u(klon, klev), v(klon, klev)      real, intent(in):: q(klon, klev) ! vapeur d'eau (en kg / kg)
27      REAL, INTENT (IN):: tra(klon, klev, ntrac)      real, INTENT (IN):: u(klon, klev), v(klon, klev)
28      INTEGER ntra      REAL, intent(inout):: sig1(klon, klev), w01(klon, klev)
29      REAL work1(klon, klev), work2(klon, klev)      REAL, intent(out):: d_t(klon, klev)
30      REAL pmflxr(klon, klev+1), pmflxs(klon, klev+1)      REAL, intent(out):: d_q(klon, klev) ! increment de la vapeur d'eau
31        REAL, intent(out):: d_u(klon, klev), d_v(klon, klev)
32      REAL d_t(klon, klev), d_q(klon, klev), d_u(klon, klev), d_v(klon, &      REAL, intent(out):: rain(klon) ! pluie (mm / s)
33           klev)      INTEGER, intent(out):: kbas(klon)
34      REAL d_tra(klon, klev, ntrac)      integer, intent(inout):: itop_con(klon)
35      REAL rain(klon), snow(klon)  
36        REAL, intent(out):: upwd(klon, klev)
37      INTEGER kbas(klon), ktop(klon)      ! saturated updraft mass flux (kg / m2 / s)
38      REAL em_ph(klon, klev+1), em_p(klon, klev)  
39      REAL upwd(klon, klev), dnwd(klon, klev), dnwdbis(klon, klev)      real, intent(out):: dnwd(klon, klev)
40      REAL ma(klon, klev), cape(klon), tvp(klon, klev)      ! saturated downdraft mass flux (kg / m2 / s)
41      REAL da(klon, klev), phi(klon, klev, klev), mp(klon, klev)  
42        real, intent(out):: dnwd0(klon, klev)
43        ! unsaturated downdraft mass flux (kg / m2 / s)
44    
45        REAL ma(klon, klev)
46        real cape(klon) ! output (J / kg)
47      INTEGER iflag(klon)      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 wd(klon)
50        REAL pmflxr(klon, klev + 1)
51        REAL, intent(inout):: da(klon, klev), phi(klon, klev, klev), mp(klon, klev)
52    
53      REAL zx_t, zdelta, zx_qs, zcor      ! Local:
54        REAL zx_qs, cor
55      INTEGER i, k, itra      INTEGER i, k
56      REAL qs(klon, klev)      REAL qs(klon, klev)
     REAL cbmf(klon)  
     SAVE cbmf  
     INTEGER ifrst  
     SAVE ifrst  
     DATA ifrst/0/  
57    
58      !-----------------------------------------------------------------      !-----------------------------------------------------------------
59    
     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  
   
60      DO k = 1, klev      DO k = 1, klev
61         DO i = 1, klon         DO i = 1, klon
62            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))
63              cor = 1. / (1. - retv * zx_qs)
64              qs(i, k) = zx_qs * cor
65         END DO         END DO
66      END DO      END DO
67    
68        CALL cv_driver(t, q, qs, u, v, play / 100., paprs / 100., iflag, d_t, &
69      IF (iflag_con==4) THEN           d_q, d_u, d_v, rain, pmflxr, sig1, w01, kbas, itop_con, dtime, ma, &
70         DO k = 1, klev           upwd, dnwd, dnwd0, qcondc, wd, cape, da, phi, mp)
71            DO i = 1, klon  
72               zx_t = t(i, k)      rain = rain / 86400.
73               zdelta = max(0., sign(1., rtt-zx_t))      d_t = dtime * d_t
74               zx_qs = min(0.5, r2es*foeew(zx_t, zdelta)/em_p(i, k)/100.0)      d_q = dtime * d_q
75               zcor = 1./(1.-retv*zx_qs)      d_u = dtime * d_u
76               qs(i, k) = zx_qs*zcor      d_v = dtime * d_v
           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  
77    
78    END SUBROUTINE concvl    END SUBROUTINE concvl
79    

Legend:
Removed from v.52  
changed lines
  Added in v.183

  ViewVC Help
Powered by ViewVC 1.1.21