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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 3 - (hide annotations)
Wed Feb 27 13:16:39 2008 UTC (16 years, 2 months ago) by guez
Original Path: trunk/libf/phylmd/concvl.f
File size: 5873 byte(s)
Initial import
1 guez 3 !
2     ! $Header: /home/cvsroot/LMDZ4/libf/phylmd/concvl.F,v 1.3 2005/04/15 12:36:17 lmdzadmin Exp $
3     !
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,
6     . rain, snow, kbas, ktop,
7     . upwd,dnwd,dnwdbis,Ma,cape,tvp,iflag,
8     . pbase,bbase,dtvpdt1,dtvpdq1,dplcldt,dplcldr,
9     . qcondc,wd,
10     . pmflxr,pmflxs,
11     . da,phi,mp)
12    
13     c
14     use dimens_m
15     use dimphy
16     use YOMCST
17     use yoethf
18     use fcttre
19     IMPLICIT none
20     c======================================================================
21     c Auteur(s): Z.X. Li (LMD/CNRS) date: 19930818
22     c Objet: schema de convection de Emanuel (1991) interface
23     c======================================================================
24     c Arguments:
25     c dtime--input-R-pas d'integration (s)
26     c s-------input-R-la valeur "s" pour chaque couche
27     c sigs----input-R-la valeur "sigma" de chaque couche
28     c sig-----input-R-la valeur de "sigma" pour chaque niveau
29     c psolpa--input-R-la pression au sol (en Pa)
30     C pskapa--input-R-exponentiel kappa de psolpa
31     c h-------input-R-enthalpie potentielle (Cp*T/P**kappa)
32     c q-------input-R-vapeur d'eau (en kg/kg)
33     c
34     c work*: input et output: deux variables de travail,
35     c on peut les mettre a 0 au debut
36     c ALE-----input-R-energie disponible pour soulevement
37     c
38     C d_h-----output-R-increment de l'enthalpie potentielle (h)
39     c d_q-----output-R-increment de la vapeur d'eau
40     c rain----output-R-la pluie (mm/s)
41     c snow----output-R-la neige (mm/s)
42     c upwd----output-R-saturated updraft mass flux (kg/m**2/s)
43     c dnwd----output-R-saturated downdraft mass flux (kg/m**2/s)
44     c dnwd0---output-R-unsaturated downdraft mass flux (kg/m**2/s)
45     c Cape----output-R-CAPE (J/kg)
46     c Tvp-----output-R-Temperature virtuelle d'une parcelle soulevee
47     c adiabatiquement a partir du niveau 1 (K)
48     c deltapb-output-R-distance entre LCL et base de la colonne (<0 ; Pa)
49     c Ice_flag-input-L-TRUE->prise en compte de la thermodynamique de la glace
50     c======================================================================
51     c
52     c
53     integer NTRAC
54     PARAMETER (NTRAC=nqmx-2)
55     c
56     INTEGER iflag_con
57     c
58     REAL dtime
59     real, intent(in):: paprs(klon,klev+1)
60     real pplay(klon,klev)
61     REAL t(klon,klev),q(klon,klev),u(klon,klev),v(klon,klev)
62     REAL 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     c
67     REAL d_t(klon,klev),d_q(klon,klev),d_u(klon,klev),d_v(klon,klev)
68     REAL d_tra(klon,klev,ntrac)
69     REAL rain(klon),snow(klon)
70     c
71     INTEGER kbas(klon),ktop(klon)
72     REAL em_ph(klon,klev+1),em_p(klon,klev)
73     REAL upwd(klon,klev),dnwd(klon,klev),dnwdbis(klon,klev)
74     REAL Ma(klon,klev),cape(klon),tvp(klon,klev)
75     real da(klon,klev),phi(klon,klev,klev),mp(klon,klev)
76     INTEGER iflag(klon)
77     REAL rflag(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     c
84     REAL zx_t,zdelta,zx_qs,zcor
85     c
86     INTEGER noff, minorig
87     INTEGER i,k,itra
88     REAL qs(klon,klev)
89     REAL cbmf(klon)
90     SAVE cbmf
91     INTEGER ifrst
92     SAVE ifrst
93     DATA ifrst /0/
94     c
95     c
96     cym
97     snow(:)=0
98    
99     IF (ifrst .EQ. 0) THEN
100     ifrst = 1
101     DO i = 1, klon
102     cbmf(i) = 0.
103     ENDDO
104     ENDIF
105    
106     DO k = 1, klev+1
107     DO i=1,klon
108     em_ph(i,k) = paprs(i,k) / 100.0
109     pmflxs(i,k)=0.
110     ENDDO
111     ENDDO
112     c
113     DO k = 1, klev
114     DO i=1,klon
115     em_p(i,k) = pplay(i,k) / 100.0
116     ENDDO
117     ENDDO
118    
119     c
120     if (iflag_con .eq. 4) then
121     DO k = 1, klev
122     DO i = 1, klon
123     zx_t = t(i,k)
124     zdelta=MAX(0.,SIGN(1.,rtt-zx_t))
125     zx_qs= MIN(0.5 , r2es * FOEEW(zx_t,zdelta)/em_p(i,k)/100.0)
126     zcor=1./(1.-retv*zx_qs)
127     qs(i,k)=zx_qs*zcor
128     ENDDO
129     ENDDO
130     else ! iflag_con=3 (modif de puristes qui fait la diffce pour la convergence numerique)
131     DO k = 1, klev
132     DO i = 1, klon
133     zx_t = t(i,k)
134     zdelta=MAX(0.,SIGN(1.,rtt-zx_t))
135     zx_qs= r2es * FOEEW(zx_t,zdelta)/em_p(i,k)/100.0
136     zx_qs= MIN(0.5,zx_qs)
137     zcor=1./(1.-retv*zx_qs)
138     zx_qs=zx_qs*zcor
139     qs(i,k)=zx_qs
140     ENDDO
141     ENDDO
142     endif ! iflag_con
143     c
144     C------------------------------------------------------------------
145    
146     C Main driver for convection:
147     C iflag_con = 3 -> equivalent to convect3
148     C iflag_con = 4 -> equivalent to convect1/2
149    
150     CALL cv_driver(klon,klev,klev+1,ntra,iflag_con,
151     : t,q,qs,u,v,tra,
152     $ em_p,em_ph,iflag,
153     $ d_t,d_q,d_u,d_v,d_tra,rain,
154     $ pmflxr,cbmf,work1,work2,
155     $ kbas,ktop,
156     $ dtime,Ma,upwd,dnwd,dnwdbis,qcondc,wd,cape,
157     $ da,phi,mp)
158    
159     C------------------------------------------------------------------
160    
161     DO i = 1,klon
162     rain(i) = rain(i)/86400.
163     rflag(i)=iflag(i)
164     ENDDO
165    
166     DO k = 1, klev
167     DO i = 1, klon
168     d_t(i,k) = dtime*d_t(i,k)
169     d_q(i,k) = dtime*d_q(i,k)
170     d_u(i,k) = dtime*d_u(i,k)
171     d_v(i,k) = dtime*d_v(i,k)
172     ENDDO
173     ENDDO
174     DO itra = 1,ntra
175     DO k = 1, klev
176     DO i = 1, klon
177     d_tra(i,k,itra) =dtime*d_tra(i,k,itra)
178     ENDDO
179     ENDDO
180     ENDDO
181     c les traceurs ne sont pas mis dans cette version de convect4:
182     if (iflag_con.eq.4) then
183     DO itra = 1,ntra
184     DO k = 1, klev
185     DO i = 1, klon
186     d_tra(i,k,itra) = 0.
187     ENDDO
188     ENDDO
189     ENDDO
190     endif
191    
192     RETURN
193     END
194    

  ViewVC Help
Powered by ViewVC 1.1.21