/[lmdze]/trunk/libf/phylmd/concvl.f90
ViewVC logotype

Diff of /trunk/libf/phylmd/concvl.f90

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 46 by guez, Thu Jan 6 17:52:19 2011 UTC revision 47 by guez, Fri Jul 1 15:00:48 2011 UTC
# Line 1  Line 1 
1  SUBROUTINE concvl(iflag_con, dtime, paprs, pplay, t, q, u, v, tra,&  module concvl_m
      ntra, work1, work2, d_t, d_q, d_u, d_v, d_tra, rain, snow, kbas,&  
      ktop, upwd, dnwd, dnwdbis, ma, cape, tvp, iflag, pbase, bbase,&  
      dtvpdt1, dtvpdq1, dplcldt, dplcldr, qcondc, wd, pmflxr, pmflxs,&  
      da, phi, mp)  
   
   ! From phylmd/concvl.F, v 1.3 2005/04/15 12:36:17  
   ! Auteur(s): Z.X. Li (LMD/CNRS) date: 19930818  
   ! Objet: schema de convection de Emanuel (1991) interface  
   
   USE dimens_m  
   USE dimphy  
   USE suphec_m  
   USE yoethf_m  
   USE fcttre  
2    
3    IMPLICIT NONE    IMPLICIT NONE
4    
5    ! Arguments:  contains
   ! dtime--input-R-pas d'integration (s)  
   ! s-------input-R-la valeur "s" pour chaque couche  
   ! sigs----input-R-la valeur "sigma" de chaque couche  
   ! sig-----input-R-la valeur de "sigma" pour chaque niveau  
   ! psolpa--input-R-la pression au sol (en Pa)  
   ! pskapa--input-R-exponentiel kappa de psolpa  
   ! h-------input-R-enthalpie potentielle (Cp*T/P**kappa)  
   ! q-------input-R-vapeur d'eau (en kg/kg)  
   
   ! 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)  
   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)  
   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)  
   
   REAL zx_t, zdelta, zx_qs, zcor  
   
   INTEGER i, k, itra  
   REAL qs(klon, klev)  
   REAL cbmf(klon)  
   SAVE cbmf  
   INTEGER ifrst  
   SAVE ifrst  
   DATA ifrst/0/  
   
   !-----------------------------------------------------------------  
   
   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  
   
   DO k = 1, klev  
      DO i = 1, klon  
         em_p(i, k) = pplay(i, k)/100.0  
      END DO  
   END DO  
   
   
   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  
      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  
6    
7  END SUBROUTINE concvl    SUBROUTINE concvl(iflag_con, dtime, paprs, pplay, t, q, u, v, tra, &
8           ntra, work1, work2, d_t, d_q, d_u, d_v, d_tra, rain, snow, kbas, &
9           ktop, upwd, dnwd, dnwdbis, ma, cape, tvp, iflag, pbase, bbase, &
10           dtvpdt1, dtvpdq1, dplcldt, dplcldr, qcondc, wd, pmflxr, pmflxs, &
11           da, phi, mp)
12    
13        ! From phylmd/concvl.F, version 1.3 2005/04/15 12:36:17
14        ! Author: Z.X. Li (LMD/CNRS)
15        ! date: 1993/08/18
16        ! Objet: schema de convection de Emanuel (1991) interface
17    
18        USE dimens_m, ONLY : nqmx
19        USE dimphy, ONLY : klev, klon
20        USE suphec_m, ONLY : retv, rtt
21        USE yoethf_m, ONLY : r2es
22        USE fcttre, ONLY : foeew
23    
24        ! Arguments:
25        ! dtime--input-R-pas d'integration (s)
26        ! s-------input-R-la valeur "s" pour chaque couche
27        ! sigs----input-R-la valeur "sigma" de chaque couche
28        ! sig-----input-R-la valeur de "sigma" pour chaque niveau
29        ! psolpa--input-R-la pression au sol (en Pa)
30        ! pskapa--input-R-exponentiel kappa de psolpa
31        ! h-------input-R-enthalpie potentielle (Cp*T/P**kappa)
32        ! q-------input-R-vapeur d'eau (en kg/kg)
33    
34        ! work*: input et output: deux variables de travail,
35        !                            on peut les mettre a 0 au debut
36        ! ALE-----input-R-energie disponible pour soulevement
37    
38        ! d_h-----output-R-increment de l'enthalpie potentielle (h)
39        ! d_q-----output-R-increment de la vapeur d'eau
40        ! rain----output-R-la pluie (mm/s)
41        ! snow----output-R-la neige (mm/s)
42        ! upwd----output-R-saturated updraft mass flux (kg/m**2/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)
45        ! Cape----output-R-CAPE (J/kg)
46        ! Tvp-----output-R-Temperature virtuelle d'une parcelle soulevee
47        !                  adiabatiquement a partir du niveau 1 (K)
48        ! deltapb-output-R-distance entre LCL et base de la colonne (<0 ;
49        !  Pa)
50        ! Ice_flag-input-L-TRUE->prise en compte de la thermodynamique de
51        !  la glace
52    
53        INTEGER ntrac
54        PARAMETER (ntrac=nqmx-2)
55    
56        INTEGER, INTENT (IN) :: iflag_con
57    
58        REAL, INTENT (IN) :: dtime
59        REAL, INTENT (IN) :: paprs(klon, klev+1)
60        REAL, INTENT (IN) :: pplay(klon, klev)
61        REAL t(klon, klev), q(klon, klev), u(klon, klev), v(klon, klev)
62        REAL, INTENT (IN):: tra(klon, klev, ntrac)
63        INTEGER ntra
64        REAL work1(klon, klev), work2(klon, klev)
65        REAL pmflxr(klon, klev+1), pmflxs(klon, klev+1)
66    
67        REAL d_t(klon, klev), d_q(klon, klev), d_u(klon, klev), d_v(klon, &
68             klev)
69        REAL d_tra(klon, klev, ntrac)
70        REAL rain(klon), snow(klon)
71    
72        INTEGER kbas(klon), ktop(klon)
73        REAL em_ph(klon, klev+1), em_p(klon, klev)
74        REAL upwd(klon, klev), dnwd(klon, klev), dnwdbis(klon, klev)
75        REAL ma(klon, klev), cape(klon), tvp(klon, klev)
76        REAL da(klon, klev), phi(klon, klev, klev), mp(klon, klev)
77        INTEGER iflag(klon)
78        REAL pbase(klon), bbase(klon)
79        REAL dtvpdt1(klon, klev), dtvpdq1(klon, klev)
80        REAL dplcldt(klon), dplcldr(klon)
81        REAL qcondc(klon, klev)
82        REAL wd(klon)
83    
84        REAL zx_t, zdelta, zx_qs, zcor
85    
86        INTEGER i, k, itra
87        REAL qs(klon, klev)
88        REAL cbmf(klon)
89        SAVE cbmf
90        INTEGER ifrst
91        SAVE ifrst
92        DATA ifrst/0/
93    
94        !-----------------------------------------------------------------
95    
96        snow(:) = 0
97    
98        IF (ifrst==0) THEN
99           ifrst = 1
100           DO i = 1, klon
101              cbmf(i) = 0.
102           END DO
103        END IF
104    
105        DO k = 1, klev + 1
106           DO i = 1, klon
107              em_ph(i, k) = paprs(i, k)/100.0
108              pmflxs(i, k) = 0.
109           END DO
110        END DO
111    
112        DO k = 1, klev
113           DO i = 1, klon
114              em_p(i, k) = pplay(i, k)/100.0
115           END DO
116        END DO
117    
118    
119        IF (iflag_con==4) THEN
120           DO k = 1, klev
121              DO i = 1, klon
122                 zx_t = t(i, k)
123                 zdelta = max(0., sign(1., rtt-zx_t))
124                 zx_qs = min(0.5, r2es*foeew(zx_t, zdelta)/em_p(i, k)/100.0)
125                 zcor = 1./(1.-retv*zx_qs)
126                 qs(i, k) = zx_qs*zcor
127              END DO
128           END DO
129        ELSE
130           ! iflag_con=3 (modif de puristes qui fait la diffce pour la
131           ! convergence numerique)
132           DO k = 1, klev
133              DO i = 1, klon
134                 zx_t = t(i, k)
135                 zdelta = max(0., sign(1., rtt-zx_t))
136                 zx_qs = r2es*foeew(zx_t, zdelta)/em_p(i, k)/100.0
137                 zx_qs = min(0.5, zx_qs)
138                 zcor = 1./(1.-retv*zx_qs)
139                 zx_qs = zx_qs*zcor
140                 qs(i, k) = zx_qs
141              END DO
142           END DO
143        END IF
144    
145        ! Main driver for convection:
146        !           iflag_con = 3  -> equivalent to convect3
147        !           iflag_con = 4  -> equivalent to convect1/2
148    
149        CALL cv_driver(klon, klev, klev+1, ntra, iflag_con, t, q, qs, u, v, &
150             tra, em_p, em_ph, iflag, d_t, d_q, d_u, d_v, d_tra, rain, &
151             pmflxr, cbmf, work1, work2, kbas, ktop, dtime, ma, upwd, dnwd, &
152             dnwdbis, qcondc, wd, cape, da, phi, mp)
153    
154        DO i = 1, klon
155           rain(i) = rain(i)/86400.
156        END DO
157    
158        DO k = 1, klev
159           DO i = 1, klon
160              d_t(i, k) = dtime*d_t(i, k)
161              d_q(i, k) = dtime*d_q(i, k)
162              d_u(i, k) = dtime*d_u(i, k)
163              d_v(i, k) = dtime*d_v(i, k)
164           END DO
165        END DO
166        DO itra = 1, ntra
167           DO k = 1, klev
168              DO i = 1, klon
169                 d_tra(i, k, itra) = dtime*d_tra(i, k, itra)
170              END DO
171           END DO
172        END DO
173        ! les traceurs ne sont pas mis dans cette version de convect4:
174        IF (iflag_con==4) THEN
175           DO itra = 1, ntra
176              DO k = 1, klev
177                 DO i = 1, klon
178                    d_tra(i, k, itra) = 0.
179                 END DO
180              END DO
181           END DO
182        END IF
183    
184      END SUBROUTINE concvl
185    
186    end module concvl_m
Legend:
Removed from v.46  
changed lines
  Added in v.47
  ViewVC Help
Powered by ViewVC 1.1.21