/[lmdze]/trunk/Sources/phylmd/cv_driver.f
ViewVC logotype

Contents of /trunk/Sources/phylmd/cv_driver.f

Parent Directory Parent Directory | Revision Log Revision Log


Revision 205 - (show annotations)
Tue Jun 21 15:16:03 2016 UTC (7 years, 9 months ago) by guez
File size: 10178 byte(s)
dnwd0 is just - mp. Compute it simply in concvl.

da, phi and mp were set to 0 in physiq before the call to
concvl. Clearer to set da1, phi1 and mp1 to 0 in cv_driver so they are
intent out.

qcheck was debugging, printed to standard output and was called
several times per time step of physics.

zxtsol was a duplicate of ztsol.

1 module cv_driver_m
2
3 implicit none
4
5 contains
6
7 SUBROUTINE cv_driver(t1, q1, qs1, u1, v1, p1, ph1, iflag1, ft1, fq1, fu1, &
8 fv1, precip1, VPrecip1, sig1, w01, icb1, inb1, Ma1, upwd1, dnwd1, &
9 qcondc1, cape1, da1, phi1, mp1)
10
11 ! From LMDZ4/libf/phylmd/cv_driver.F, version 1.3, 2005/04/15 12:36:17
12 ! Main driver for convection
13 ! Author: S. Bony, March 2002
14
15 ! Several modules corresponding to different physical processes
16
17 use comconst, only: dtphys
18 use cv30_closure_m, only: cv30_closure
19 use cv30_compress_m, only: cv30_compress
20 use cv30_feed_m, only: cv30_feed
21 use cv30_mixing_m, only: cv30_mixing
22 use cv30_param_m, only: cv30_param, nl
23 use cv30_prelim_m, only: cv30_prelim
24 use cv30_tracer_m, only: cv30_tracer
25 use cv30_trigger_m, only: cv30_trigger
26 use cv30_uncompress_m, only: cv30_uncompress
27 use cv30_undilute1_m, only: cv30_undilute1
28 use cv30_undilute2_m, only: cv30_undilute2
29 use cv30_unsat_m, only: cv30_unsat
30 use cv30_yield_m, only: cv30_yield
31 USE dimphy, ONLY: klev, klon
32
33 real, intent(in):: t1(klon, klev) ! temperature, in K
34 real, intent(in):: q1(klon, klev) ! specific humidity
35 real, intent(in):: qs1(klon, klev) ! saturation specific humidity
36
37 real, intent(in):: u1(klon, klev), v1(klon, klev)
38 ! zonal wind and meridional velocity (m/s)
39
40 real, intent(in):: p1(klon, klev) ! full level pressure, in hPa
41
42 real, intent(in):: ph1(klon, klev + 1)
43 ! Half level pressure, in hPa. These pressures are defined at levels
44 ! intermediate between those of P1, T1, Q1 and QS1. The first
45 ! value of PH should be greater than (i.e. at a lower level than)
46 ! the first value of the array P1.
47
48 integer, intent(out):: iflag1(:) ! (klon)
49 ! Flag for Emanuel conditions.
50
51 ! 0: Moist convection occurs.
52
53 ! 1: Moist convection occurs, but a CFL condition on the
54 ! subsidence warming is violated. This does not cause the scheme
55 ! to terminate.
56
57 ! 2: Moist convection, but no precipitation because ep(inb) < 1e-4
58
59 ! 3: No moist convection because new cbmf is 0 and old cbmf is 0.
60
61 ! 4: No moist convection; atmosphere is not unstable.
62
63 ! 6: No moist convection because ihmin <= minorig.
64
65 ! 7: No moist convection because unreasonable parcel level
66 ! temperature or specific humidity.
67
68 ! 8: No moist convection: lifted condensation level is above the
69 ! 200 mbar level.
70
71 ! 9: No moist convection: cloud base is higher than the level NL-1.
72
73 real, intent(out):: ft1(klon, klev) ! temperature tendency (K/s)
74 real, intent(out):: fq1(klon, klev) ! specific humidity tendency (s-1)
75
76 real, intent(out):: fu1(klon, klev), fv1(klon, klev)
77 ! forcing (tendency) of zonal and meridional velocity (m/s^2)
78
79 real, intent(out):: precip1(klon) ! convective precipitation rate (mm/day)
80
81 real, intent(out):: VPrecip1(klon, klev + 1)
82 ! vertical profile of convective precipitation (kg/m2/s)
83
84 real, intent(inout):: sig1(klon, klev) ! section of adiabatic updraft
85
86 real, intent(inout):: w01(klon, klev)
87 ! vertical velocity within adiabatic updraft
88
89 integer, intent(out):: icb1(klon)
90 integer, intent(inout):: inb1(klon)
91 real, intent(out):: Ma1(klon, klev) ! mass flux of adiabatic updraft
92
93 real, intent(out):: upwd1(klon, klev)
94 ! total upward mass flux (adiabatic + mixed)
95
96 real, intent(out):: dnwd1(klon, klev) ! saturated downward mass flux (mixed)
97
98 real, intent(out):: qcondc1(klon, klev)
99 ! in-cloud mixing ratio of condensed water
100
101 real, intent(out):: cape1(klon)
102 real, intent(out):: da1(:, :) ! (klon, klev)
103 real, intent(out):: phi1(:, :, :) ! (klon, klev, klev)
104
105 real, intent(out):: mp1(:, :) ! (klon, klev) Mass flux of the
106 ! unsaturated downdraft, defined positive downward, in kg m-2
107 ! s-1. M_p in Emanuel (1991 928).
108
109 ! Local:
110
111 real da(klon, klev), phi(klon, klev, klev)
112
113 real, allocatable:: mp(:, :) ! (ncum, nl) Mass flux of the
114 ! unsaturated downdraft, defined positive downward, in kg m-2
115 ! s-1. M_p in Emanuel (1991 928).
116
117 integer i, k, il
118 integer icbs1(klon)
119 real plcl1(klon)
120 real tnk1(klon)
121 real qnk1(klon)
122 real gznk1(klon)
123 real pbase1(klon)
124 real buoybase1(klon)
125
126 real lv1(klon, nl)
127 ! specific latent heat of vaporization of water, in J kg-1
128
129 real cpn1(klon, nl)
130 ! specific heat capacity at constant pressure of humid air, in J K-1 kg-1
131
132 real tv1(klon, klev)
133 real gz1(klon, klev)
134 real hm1(klon, klev)
135 real h1(klon, klev)
136 real tp1(klon, klev)
137 real tvp1(klon, klev)
138 real clw1(klon, klev)
139 real th1(klon, nl) ! potential temperature, in K
140 integer ncum
141
142 ! Compressed fields:
143 integer, allocatable:: idcum(:), iflag(:) ! (ncum)
144 integer, allocatable:: icb(:) ! (ncum)
145 integer nent(klon, klev)
146 integer icbs(klon)
147
148 integer, allocatable:: inb(:) ! (ncum)
149 ! first model level above the level of neutral buoyancy of the
150 ! parcel (1 <= inb <= nl - 1)
151
152 real, allocatable:: plcl(:) ! (ncum)
153 real tnk(klon), qnk(klon), gznk(klon)
154 real t(klon, klev), q(klon, klev), qs(klon, klev)
155 real u(klon, klev), v(klon, klev)
156 real gz(klon, klev), h(klon, klev)
157
158 real, allocatable:: lv(:, :) ! (ncum, nl)
159 ! specific latent heat of vaporization of water, in J kg-1
160
161 real, allocatable:: cpn(:, :) ! (ncum, nl)
162 ! specific heat capacity at constant pressure of humid air, in J K-1 kg-1
163
164 real p(klon, klev) ! pressure at full level, in hPa
165 real ph(klon, klev + 1), tv(klon, klev), tp(klon, klev)
166 real clw(klon, klev)
167 real pbase(klon), buoybase(klon)
168 real, allocatable:: th(:, :) ! (ncum, nl)
169 real tvp(klon, klev)
170 real sig(klon, klev), w0(klon, klev)
171 real hp(klon, klev), ep(klon, klev)
172 real buoy(klon, klev)
173 real cape(klon)
174 real m(klon, klev), ment(klon, klev, klev), qent(klon, klev, klev)
175 real uent(klon, klev, klev), vent(klon, klev, klev)
176 real ments(klon, klev, klev), qents(klon, klev, klev)
177 real sij(klon, klev, klev), elij(klon, klev, klev)
178 real qp(klon, klev), up(klon, klev), vp(klon, klev)
179 real wt(klon, klev), water(klon, klev)
180 real, allocatable:: evap(:, :) ! (ncum, nl)
181 real, allocatable:: b(:, :) ! (ncum, nl - 1)
182 real ft(klon, klev), fq(klon, klev)
183 real fu(klon, klev), fv(klon, klev)
184 real upwd(klon, klev), dnwd(klon, klev)
185 real Ma(klon, klev), mike(klon, klev), tls(klon, klev)
186 real tps(klon, klev)
187 real precip(klon)
188 real VPrecip(klon, klev + 1)
189 real qcondc(klon, klev) ! cld
190
191 !-------------------------------------------------------------------
192
193 ! SET CONSTANTS AND PARAMETERS
194 CALL cv30_param
195
196 ! INITIALIZE OUTPUT ARRAYS AND PARAMETERS
197
198 da1 = 0.
199 mp1 = 0.
200 phi1 = 0.
201
202 do k = 1, klev
203 do i = 1, klon
204 ft1(i, k) = 0.
205 fq1(i, k) = 0.
206 fu1(i, k) = 0.
207 fv1(i, k) = 0.
208 tvp1(i, k) = 0.
209 tp1(i, k) = 0.
210 clw1(i, k) = 0.
211 clw(i, k) = 0.
212 gz1(i, k) = 0.
213 VPrecip1(i, k) = 0.
214 Ma1(i, k) = 0.
215 upwd1(i, k) = 0.
216 dnwd1(i, k) = 0.
217 qcondc1(i, k) = 0.
218 end do
219 end do
220
221 precip1 = 0.
222 cape1 = 0.
223 VPrecip1(:, klev + 1) = 0.
224
225 do il = 1, klon
226 sig1(il, klev) = sig1(il, klev) + 1.
227 sig1(il, klev) = min(sig1(il, klev), 12.1)
228 enddo
229
230 CALL cv30_prelim(t1, q1, p1, ph1, lv1, cpn1, tv1, gz1, h1, hm1, th1)
231 CALL cv30_feed(t1, q1, qs1, p1, ph1, gz1, icb1, iflag1, tnk1, qnk1, &
232 gznk1, plcl1)
233 CALL cv30_undilute1(t1, q1, qs1, gz1, plcl1, p1, icb1, tp1, tvp1, clw1, &
234 icbs1)
235 CALL cv30_trigger(icb1, plcl1, p1, th1, tv1, tvp1, pbase1, buoybase1, &
236 iflag1, sig1, w01)
237
238 ncum = count(iflag1 == 0)
239
240 IF (ncum > 0) THEN
241 ! Moist convective adjustment is necessary
242 allocate(idcum(ncum), plcl(ncum), inb(ncum))
243 allocate(b(ncum, nl - 1), evap(ncum, nl), icb(ncum), iflag(ncum))
244 allocate(th(ncum, nl), lv(ncum, nl), cpn(ncum, nl), mp(ncum, nl))
245 idcum = pack((/(i, i = 1, klon)/), iflag1 == 0)
246 CALL cv30_compress(idcum, iflag1, icb1, icbs1, plcl1, tnk1, qnk1, &
247 gznk1, pbase1, buoybase1, t1, q1, qs1, u1, v1, gz1, th1, h1, lv1, &
248 cpn1, p1, ph1, tv1, tp1, tvp1, clw1, sig1, w01, icb, icbs, plcl, &
249 tnk, qnk, gznk, pbase, buoybase, t, q, qs, u, v, gz, th, h, lv, &
250 cpn, p, ph, tv, tp, tvp, clw, sig, w0)
251 CALL cv30_undilute2(icb, icbs(:ncum), tnk, qnk, gznk, t, qs, gz, p, h, &
252 tv, lv, pbase(:ncum), buoybase(:ncum), plcl, inb, tp, tvp, &
253 clw, hp, ep, buoy)
254 CALL cv30_closure(icb, inb, pbase, p, ph(:ncum, :), tv, buoy, &
255 sig, w0, cape, m)
256 CALL cv30_mixing(icb, inb, t, q, qs, u, v, h, lv, &
257 hp, ep, clw, m, sig, ment, qent, uent, vent, nent, sij, elij, &
258 ments, qents)
259 CALL cv30_unsat(icb, inb, t(:ncum, :nl), q(:ncum, :nl), &
260 qs(:ncum, :nl), gz, u(:ncum, :nl), v(:ncum, :nl), p, &
261 ph(:ncum, :), th(:ncum, :nl - 1), tv, lv, cpn, ep(:ncum, :), &
262 clw(:ncum, :), m(:ncum, :), ment(:ncum, :, :), elij(:ncum, :, :), &
263 dtphys, plcl, mp, qp(:ncum, :nl), up(:ncum, :nl), vp(:ncum, :nl), &
264 wt(:ncum, :nl), water(:ncum, :nl), evap, b)
265 CALL cv30_yield(icb, inb, dtphys, t, q, u, v, gz, p, ph, h, hp, &
266 lv, cpn, th, ep, clw, m, tp, mp, qp, up, vp(:ncum, 2:nl), &
267 wt(:ncum, :nl - 1), water(:ncum, :nl), evap, b, ment, qent, uent, &
268 vent, nent, elij, sig, tv, tvp, iflag, precip, VPrecip, ft, fq, &
269 fu, fv, upwd, dnwd, ma, mike, tls, tps, qcondc)
270 CALL cv30_tracer(klon, ncum, klev, ment, sij, da, phi)
271 CALL cv30_uncompress(idcum, iflag, precip, VPrecip, sig, w0, ft, fq, &
272 fu, fv, inb, Ma, upwd, dnwd, qcondc, cape, da, phi, mp, iflag1, &
273 precip1, VPrecip1, sig1, w01, ft1, fq1, fu1, fv1, inb1, Ma1, &
274 upwd1, dnwd1, qcondc1, cape1, da1, phi1, mp1)
275 ENDIF
276
277 end SUBROUTINE cv_driver
278
279 end module cv_driver_m

  ViewVC Help
Powered by ViewVC 1.1.21