/[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

trunk/libf/phylmd/concvl.f revision 3 by guez, Wed Feb 27 13:16:39 2008 UTC trunk/libf/phylmd/concvl.f90 revision 52 by guez, Fri Sep 23 12:28:01 2011 UTC
# Line 1  Line 1 
1  !  module concvl_m
2  ! $Header: /home/cvsroot/LMDZ4/libf/phylmd/concvl.F,v 1.3 2005/04/15 12:36:17 lmdzadmin Exp $  
3  !    IMPLICIT NONE
4        SUBROUTINE concvl (iflag_con,dtime,paprs,pplay,t,q,u,v,tra,ntra,  
5       .             work1,work2,d_t,d_q,d_u,d_v,d_tra,  contains
6       .             rain, snow, kbas, ktop,  
7       .             upwd,dnwd,dnwdbis,Ma,cape,tvp,iflag,    SUBROUTINE concvl(iflag_con, dtime, paprs, pplay, t, q, u, v, tra, &
8       .             pbase,bbase,dtvpdt1,dtvpdq1,dplcldt,dplcldr,         ntra, work1, work2, d_t, d_q, d_u, d_v, d_tra, rain, snow, kbas, &
9       .             qcondc,wd,         ktop, upwd, dnwd, dnwdbis, ma, cape, tvp, iflag, pbase, bbase, &
10       .             pmflxr,pmflxs,         dtvpdt1, dtvpdq1, dplcldt, dplcldr, qcondc, wd, pmflxr, pmflxs, &
11       .             da,phi,mp)         da, phi, mp)
12    
13  c      ! From phylmd/concvl.F, version 1.3 2005/04/15 12:36:17
14        use dimens_m      ! Author: Z.X. Li (LMD/CNRS)
15        use dimphy      ! date: 1993/08/18
16        use YOMCST      ! Objet: schéma de convection de Emanuel (1991) interface
17        use yoethf  
18        use fcttre      USE dimens_m, ONLY : nqmx
19        IMPLICIT none      USE dimphy, ONLY : klev, klon
20  c======================================================================      USE suphec_m, ONLY : retv, rtt
21  c Auteur(s): Z.X. Li (LMD/CNRS) date: 19930818      USE yoethf_m, ONLY : r2es
22  c Objet: schema de convection de Emanuel (1991) interface      USE fcttre, ONLY : foeew
23  c======================================================================      use cv_driver_m, only: cv_driver
24  c Arguments:  
25  c dtime--input-R-pas d'integration (s)      ! Arguments:
26  c s-------input-R-la valeur "s" pour chaque couche      ! dtime--input-R-pas d'integration (s)
27  c sigs----input-R-la valeur "sigma" de chaque couche      ! s-------input-R-la valeur "s" pour chaque couche
28  c sig-----input-R-la valeur de "sigma" pour chaque niveau      ! sigs----input-R-la valeur "sigma" de chaque couche
29  c psolpa--input-R-la pression au sol (en Pa)      ! sig-----input-R-la valeur de "sigma" pour chaque niveau
30  C pskapa--input-R-exponentiel kappa de psolpa      ! psolpa--input-R-la pression au sol (en Pa)
31  c h-------input-R-enthalpie potentielle (Cp*T/P**kappa)      ! pskapa--input-R-exponentiel kappa de psolpa
32  c q-------input-R-vapeur d'eau (en kg/kg)      ! h-------input-R-enthalpie potentielle (Cp*T/P**kappa)
33  c      ! q-------input-R-vapeur d'eau (en kg/kg)
34  c work*: input et output: deux variables de travail,  
35  c                            on peut les mettre a 0 au debut      ! work*: input et output: deux variables de travail,
36  c ALE-----input-R-energie disponible pour soulevement      !                            on peut les mettre a 0 au debut
37  c      ! ALE-----input-R-energie disponible pour soulevement
38  C d_h-----output-R-increment de l'enthalpie potentielle (h)  
39  c d_q-----output-R-increment de la vapeur d'eau      ! d_h-----output-R-increment de l'enthalpie potentielle (h)
40  c rain----output-R-la pluie (mm/s)      ! d_q-----output-R-increment de la vapeur d'eau
41  c snow----output-R-la neige (mm/s)      ! rain----output-R-la pluie (mm/s)
42  c upwd----output-R-saturated updraft mass flux (kg/m**2/s)      ! snow----output-R-la neige (mm/s)
43  c dnwd----output-R-saturated downdraft mass flux (kg/m**2/s)      ! upwd----output-R-saturated updraft mass flux (kg/m**2/s)
44  c dnwd0---output-R-unsaturated downdraft mass flux (kg/m**2/s)      ! dnwd----output-R-saturated downdraft mass flux (kg/m**2/s)
45  c Cape----output-R-CAPE (J/kg)      ! dnwd0---output-R-unsaturated downdraft mass flux (kg/m**2/s)
46  c Tvp-----output-R-Temperature virtuelle d'une parcelle soulevee      ! Cape----output-R-CAPE (J/kg)
47  c                  adiabatiquement a partir du niveau 1 (K)      ! Tvp-----output-R-Temperature virtuelle d'une parcelle soulevee
48  c deltapb-output-R-distance entre LCL et base de la colonne (<0 ; Pa)      !                  adiabatiquement a partir du niveau 1 (K)
49  c Ice_flag-input-L-TRUE->prise en compte de la thermodynamique de la glace      ! deltapb-output-R-distance entre LCL et base de la colonne (<0 ;
50  c======================================================================      !  Pa)
51  c      ! Ice_flag-input-L-TRUE->prise en compte de la thermodynamique de
52  c      !  la glace
53        integer NTRAC  
54        PARAMETER (NTRAC=nqmx-2)      INTEGER ntrac
55  c      PARAMETER (ntrac=nqmx-2)
56         INTEGER iflag_con  
57  c      INTEGER, INTENT (IN) :: iflag_con
58         REAL dtime  
59         real, intent(in):: paprs(klon,klev+1)      REAL, INTENT (IN) :: dtime
60         real pplay(klon,klev)      REAL, INTENT (IN) :: paprs(klon, klev+1)
61         REAL t(klon,klev),q(klon,klev),u(klon,klev),v(klon,klev)      REAL, INTENT (IN) :: pplay(klon, klev)
62         REAL tra(klon,klev,ntrac)      REAL, intent(in):: t(klon, klev)
63         INTEGER ntra      real q(klon, klev), u(klon, klev), v(klon, klev)
64         REAL work1(klon,klev),work2(klon,klev)      REAL, INTENT (IN):: tra(klon, klev, ntrac)
65         REAL pmflxr(klon,klev+1),pmflxs(klon,klev+1)      INTEGER ntra
66  c      REAL work1(klon, klev), work2(klon, klev)
67         REAL d_t(klon,klev),d_q(klon,klev),d_u(klon,klev),d_v(klon,klev)      REAL pmflxr(klon, klev+1), pmflxs(klon, klev+1)
68         REAL d_tra(klon,klev,ntrac)  
69         REAL rain(klon),snow(klon)      REAL d_t(klon, klev), d_q(klon, klev), d_u(klon, klev), d_v(klon, &
70  c           klev)
71         INTEGER kbas(klon),ktop(klon)      REAL d_tra(klon, klev, ntrac)
72         REAL em_ph(klon,klev+1),em_p(klon,klev)      REAL rain(klon), snow(klon)
73         REAL upwd(klon,klev),dnwd(klon,klev),dnwdbis(klon,klev)  
74         REAL Ma(klon,klev),cape(klon),tvp(klon,klev)      INTEGER kbas(klon), ktop(klon)
75         real da(klon,klev),phi(klon,klev,klev),mp(klon,klev)      REAL em_ph(klon, klev+1), em_p(klon, klev)
76         INTEGER iflag(klon)      REAL upwd(klon, klev), dnwd(klon, klev), dnwdbis(klon, klev)
77         REAL rflag(klon)      REAL ma(klon, klev), cape(klon), tvp(klon, klev)
78         REAL pbase(klon),bbase(klon)      REAL da(klon, klev), phi(klon, klev, klev), mp(klon, klev)
79         REAL dtvpdt1(klon,klev),dtvpdq1(klon,klev)      INTEGER iflag(klon)
80         REAL dplcldt(klon),dplcldr(klon)      REAL pbase(klon), bbase(klon)
81         REAL qcondc(klon,klev)      REAL dtvpdt1(klon, klev), dtvpdq1(klon, klev)
82         REAL wd(klon)      REAL dplcldt(klon), dplcldr(klon)
83  c      REAL qcondc(klon, klev)
84         REAL zx_t,zdelta,zx_qs,zcor      REAL wd(klon)
85  c  
86         INTEGER noff, minorig      REAL zx_t, zdelta, zx_qs, zcor
87         INTEGER i,k,itra  
88         REAL qs(klon,klev)      INTEGER i, k, itra
89         REAL cbmf(klon)      REAL qs(klon, klev)
90         SAVE cbmf      REAL cbmf(klon)
91         INTEGER ifrst      SAVE cbmf
92         SAVE ifrst      INTEGER ifrst
93         DATA ifrst /0/      SAVE ifrst
94  c      DATA ifrst/0/
95  c  
96  cym      !-----------------------------------------------------------------
97        snow(:)=0  
98              snow(:) = 0
99        IF (ifrst .EQ. 0) THEN  
100           ifrst = 1      IF (ifrst==0) THEN
101           DO i = 1, klon         ifrst = 1
102           DO i = 1, klon
103            cbmf(i) = 0.            cbmf(i) = 0.
104           ENDDO         END DO
105        ENDIF      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        DO k = 1, klev+1  end module concvl_m
          DO i=1,klon  
          em_ph(i,k) = paprs(i,k) / 100.0  
          pmflxs(i,k)=0.  
       ENDDO  
       ENDDO  
 c  
       DO k = 1, klev  
          DO i=1,klon  
          em_p(i,k) = pplay(i,k) / 100.0  
       ENDDO  
       ENDDO  
   
 c  
       if (iflag_con .eq. 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  
         ENDDO  
       ENDDO  
       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  
         ENDDO  
       ENDDO  
       endif ! iflag_con  
 c  
 C------------------------------------------------------------------  
   
 C Main driver for convection:  
 C               iflag_con = 3  -> equivalent to convect3  
 C               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)  
   
 C------------------------------------------------------------------  
   
       DO i = 1,klon  
         rain(i) = rain(i)/86400.  
         rflag(i)=iflag(i)  
       ENDDO  
   
       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)  
         ENDDO  
       ENDDO  
        DO itra = 1,ntra  
         DO k = 1, klev  
          DO i = 1, klon  
             d_tra(i,k,itra) =dtime*d_tra(i,k,itra)  
          ENDDO  
         ENDDO  
        ENDDO  
 c les traceurs ne sont pas mis dans cette version de convect4:  
       if (iflag_con.eq.4) then  
        DO itra = 1,ntra  
         DO k = 1, klev  
          DO i = 1, klon  
             d_tra(i,k,itra) = 0.  
          ENDDO  
         ENDDO  
        ENDDO  
       endif  
   
       RETURN  
       END  
   
Legend:
Removed from v.3  
changed lines
  Added in v.52
  ViewVC Help
Powered by ViewVC 1.1.21