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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 10 - (show annotations)
Fri Apr 18 14:45:53 2008 UTC (16 years ago) by guez
Original Path: trunk/libf/phylmd/concvl.f
File size: 5887 byte(s)
Added NetCDF directory "/home/guez/include" in "g95.mk" and
"nag_tools.mk".

Added some "intent" attributes in "PVtheta", "advtrac", "caladvtrac",
"calfis", "diagedyn", "dissip", "vlspltqs", "aeropt", "ajsec",
"calltherm", "clmain", "cltrac", "cltracrn", "concvl", "conema3",
"conflx", "fisrtilp", "newmicro", "nuage", "diagcld1", "diagcld2",
"drag_noro", "lift_noro", "SUGWD", "physiq", "phytrac", "radlwsw", "thermcell".

Removed the case "ierr == 0" in "abort_gcm"; moved call to "histclo"
and messages for end of run from "abort_gcm" to "gcm"; replaced call
to "abort_gcm" in "leapfrog" by exit from outer loop.

In "calfis": removed argument "pp" and variable "unskap"; changed
"pksurcp" from scalar to rank 2; use "pressure_var"; rewrote
computation of "zplev", "zplay", "ztfi", "pcvgt" using "dyn_phy";
added computation of "pls".

Removed unused variable in "dynredem0".

In "exner_hyb": changed "dellta" from scalar to rank 1; replaced call
to "ssum" by call to "sum"; removed variables "xpn" and "xps";
replaced some loops by array expressions.

In "leapfrog": use "pressure_var"; deleted variables "p", "longcles".

Converted common blocks "YOECUMF", "YOEGWD" to modules.

Removed argument "pplay" in "cvltr", "diagetpq", "nflxtr".

Created module "raddimlw" from include file "raddimlw.h".

Corrected call to "new_unit" in "test_disvert".

1 !
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, intent(in):: 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