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