/[lmdze]/trunk/Sources/phylmd/CV30_routines/cv30_yield.f
ViewVC logotype

Annotation of /trunk/Sources/phylmd/CV30_routines/cv30_yield.f

Parent Directory Parent Directory | Revision Log Revision Log

Revision 205 - (hide annotations)
Tue Jun 21 15:16:03 2016 UTC (7 years, 11 months ago) by guez
File size: 19265 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 guez 185 module cv30_yield_m
2 guez 47
3 guez 97 implicit none
4 guez 47
5 guez 97 contains
6 guez 47
7 guez 188 SUBROUTINE cv30_yield(icb, inb, delt, t, rr, u, v, gz, p, ph, h, hp, lv, &
8 guez 201 cpn, th, ep, clw, m, tp, mp, qp, up, vp, wt, water, evap, b, ment, &
9 guez 188 qent, uent, vent, nent, elij, sig, tv, tvp, iflag, precip, VPrecip, &
10 guez 205 ft, fr, fu, fv, upwd, dnwd, ma, mike, tls, tps, qcondc)
11 guez 47
12 guez 195 ! Tendencies, precipitation, variables of interface with other
13     ! processes, etc.
14    
15 guez 187 use conema3_m, only: iflag_clw
16 guez 195 use cv30_param_m, only: minorig, nl, sigd
17 guez 201 use cv_thermo_m, only: rowl
18 guez 188 USE dimphy, ONLY: klev, klon
19 guez 201 use SUPHEC_M, only: rg, rcpd, rcw, rcpv, rd, rv
20 guez 187
21 guez 97 ! inputs:
22 guez 201
23     integer, intent(in):: icb(:)
24    
25     integer, intent(in):: inb(:) ! (ncum)
26     ! first model level above the level of neutral buoyancy of the
27     ! parcel (1 <= inb <= nl - 1)
28    
29 guez 97 real, intent(in):: delt
30 guez 200 real, intent(in):: t(klon, klev), rr(klon, klev)
31     real, intent(in):: u(klon, klev), v(klon, klev)
32 guez 188 real gz(klon, klev)
33     real p(klon, klev)
34     real ph(klon, klev + 1), h(klon, klev), hp(klon, klev)
35 guez 201 real, intent(in):: lv(:, :) ! (klon, klev)
36    
37     real, intent(in):: cpn(:, :) ! (ncum, nl)
38     ! specific heat capacity at constant pressure of humid air, in J K-1 kg-1
39    
40     real, intent(in):: th(:, :) ! (ncum, nl)
41 guez 188 real ep(klon, klev), clw(klon, klev)
42     real m(klon, klev)
43     real tp(klon, klev)
44 guez 205
45     real, intent(in):: mp(:, :) ! (ncum, nl) Mass flux of the
46     ! unsaturated downdraft, defined positive downward, in kg m-2
47     ! s-1. M_p in Emanuel (1991 928).
48    
49 guez 201 real, intent(in):: qp(:, :), up(:, :) ! (klon, klev)
50 guez 195 real, intent(in):: vp(:, 2:) ! (ncum, 2:nl)
51     real, intent(in):: wt(:, :) ! (ncum, nl - 1)
52 guez 189 real, intent(in):: water(:, :), evap(:, :) ! (ncum, nl)
53     real, intent(in):: b(:, :) ! (ncum, nl - 1)
54 guez 188 real ment(klon, klev, klev), qent(klon, klev, klev), uent(klon, klev, klev)
55     real vent(klon, klev, klev)
56     integer nent(klon, klev)
57     real elij(klon, klev, klev)
58     real sig(klon, klev)
59     real tv(klon, klev), tvp(klon, klev)
60 guez 47
61 guez 200 ! outputs:
62 guez 196 integer, intent(out):: iflag(:) ! (ncum)
63 guez 188 real precip(klon)
64     real VPrecip(klon, klev + 1)
65     real ft(klon, klev), fr(klon, klev), fu(klon, klev), fv(klon, klev)
66     real upwd(klon, klev), dnwd(klon, klev)
67     real ma(klon, klev)
68     real mike(klon, klev)
69     real tls(klon, klev), tps(klon, klev)
70     real qcondc(klon, klev)
71 guez 97
72 guez 188 ! Local:
73 guez 195 real, parameter:: delta = 0.01 ! interface cloud parameterization
74 guez 188 integer ncum
75 guez 200 integer i, k, il, n, j
76     real awat, delti
77 guez 105 real ax, bx, cx, dx
78 guez 97 real cpinv, rdcp, dpinv
79 guez 188 real lvcp(klon, klev)
80     real am(klon), work(klon), ad(klon), amp1(klon)
81     real up1(klon, klev, klev), dn1(klon, klev, klev)
82     real asum(klon), bsum(klon), csum(klon), dsum(klon)
83     real qcond(klon, klev), nqcond(klon, klev), wa(klon, klev)
84     real siga(klon, klev), sax(klon, klev), mac(klon, klev)
85 guez 47
86 guez 97 !-------------------------------------------------------------
87 guez 47
88 guez 188 ncum = size(icb)
89 guez 196 iflag = 0
90 guez 188
91 guez 97 ! initialization:
92 guez 47
93 guez 188 delti = 1.0 / delt
94 guez 47
95 guez 188 do il = 1, ncum
96     precip(il) = 0.0
97     VPrecip(il, klev + 1) = 0.
98 guez 97 enddo
99 guez 47
100 guez 188 do i = 1, klev
101     do il = 1, ncum
102     VPrecip(il, i) = 0.0
103     ft(il, i) = 0.0
104     fr(il, i) = 0.0
105     fu(il, i) = 0.0
106     fv(il, i) = 0.0
107     qcondc(il, i) = 0.0
108     qcond(il, i) = 0.0
109     nqcond(il, i) = 0.0
110 guez 47 enddo
111 guez 97 enddo
112 guez 47
113 guez 188 do i = 1, nl
114     do il = 1, ncum
115     lvcp(il, i) = lv(il, i) / cpn(il, i)
116 guez 47 enddo
117 guez 97 enddo
118 guez 47
119 guez 200 ! calculate surface precipitation in mm / day
120 guez 47
121 guez 188 do il = 1, ncum
122     if (ep(il, inb(il)) >= 1e-4) precip(il) = wt(il, 1) * sigd &
123 guez 198 * water(il, 1) * 86400. * 1000. / (rowl * rg)
124 guez 97 enddo
125 guez 47
126 guez 188 ! CALCULATE VERTICAL PROFILE OF PRECIPITATIONs IN kg / m2 / s ===
127 guez 187
128 guez 97 ! MAF rajout pour lessivage
129 guez 188 do k = 1, nl - 1
130     do il = 1, ncum
131     if (k <= inb(il)) VPrecip(il, k) = wt(il, k) * sigd * water(il, k) &
132 guez 198 / rg
133 guez 47 end do
134 guez 97 end do
135 guez 187
136 guez 200 ! calculate tendencies of lowest level potential temperature
137     ! and mixing ratio
138 guez 187
139 guez 188 do il = 1, ncum
140     work(il) = 1.0 / (ph(il, 1) - ph(il, 2))
141     am(il) = 0.0
142 guez 97 enddo
143 guez 47
144 guez 188 do k = 2, nl
145     do il = 1, ncum
146     if (k <= inb(il)) am(il) = am(il) + m(il, k)
147 guez 47 enddo
148 guez 97 enddo
149 guez 47
150 guez 188 do il = 1, ncum
151 guez 198 if (0.01 * rg * work(il) * am(il) >= delti) iflag(il) = 1
152 guez 47
153 guez 198 ft(il, 1) = 0.01 * rg * work(il) * am(il) * (t(il, 2) - t(il, 1) &
154 guez 200 + (gz(il, 2) - gz(il, 1)) / cpn(il, 1)) - 0.5 * lvcp(il, 1) &
155     * sigd * (evap(il, 1) + evap(il, 2)) - 0.009 * rg * sigd &
156     * mp(il, 2) * t(il, 1) * b(il, 1) * work(il) + 0.01 * sigd &
157 guez 201 * wt(il, 1) * (rcw - rcpd) * water(il, 2) * (t(il, 2) - t(il, 1)) &
158 guez 200 * work(il) / cpn(il, 1)
159 guez 47
160 guez 205 ! jyg Correction pour mieux conserver l'eau (conformite avec CONVECT4.3)
161 guez 198 ! (sb: pour l'instant, on ne fait que le chgt concernant rg, pas evap)
162 guez 201 fr(il, 1) = 0.01 * rg * mp(il, 2) * (qp(il, 2) - rr(il, 1)) &
163 guez 188 * work(il) + sigd * 0.5 * (evap(il, 1) + evap(il, 2))
164     ! + tard : + sigd * evap(il, 1)
165 guez 47
166 guez 198 fr(il, 1) = fr(il, 1) + 0.01 * rg * am(il) * (rr(il, 2) - rr(il, 1)) &
167 guez 188 * work(il)
168 guez 47
169 guez 198 fu(il, 1) = fu(il, 1) + 0.01 * rg * work(il) * (mp(il, 2) &
170 guez 188 * (up(il, 2) - u(il, 1)) + am(il) * (u(il, 2) - u(il, 1)))
171 guez 198 fv(il, 1) = fv(il, 1) + 0.01 * rg * work(il) * (mp(il, 2) &
172 guez 188 * (vp(il, 2) - v(il, 1)) + am(il) * (v(il, 2) - v(il, 1)))
173 guez 200 enddo
174 guez 47
175 guez 188 do j = 2, nl
176     do il = 1, ncum
177 guez 187 if (j <= inb(il)) then
178 guez 198 fr(il, 1) = fr(il, 1) + 0.01 * rg * work(il) * ment(il, j, 1) &
179 guez 188 * (qent(il, j, 1) - rr(il, 1))
180 guez 198 fu(il, 1) = fu(il, 1) + 0.01 * rg * work(il) * ment(il, j, 1) &
181 guez 188 * (uent(il, j, 1) - u(il, 1))
182 guez 198 fv(il, 1) = fv(il, 1) + 0.01 * rg * work(il) * ment(il, j, 1) &
183 guez 188 * (vent(il, j, 1) - v(il, 1))
184     endif
185 guez 47 enddo
186 guez 97 enddo
187 guez 47
188 guez 200 ! calculate tendencies of potential temperature and mixing ratio
189     ! at levels above the lowest level
190 guez 47
191 guez 200 ! first find the net saturated updraft and downdraft mass fluxes
192     ! through each level
193 guez 47
194 guez 188 loop_i: do i = 2, nl - 1
195 guez 200 if (any(inb >= i)) then
196 guez 188 amp1(:ncum) = 0.
197     ad(:ncum) = 0.
198 guez 47
199 guez 188 do k = i + 1, nl + 1
200     do il = 1, ncum
201     if (i <= inb(il) .and. k <= (inb(il) + 1)) then
202     amp1(il) = amp1(il) + m(il, k)
203     endif
204     end do
205 guez 97 end do
206 guez 47
207 guez 188 do k = 1, i
208     do j = i + 1, nl + 1
209     do il = 1, ncum
210     if (i <= inb(il) .and. j <= (inb(il) + 1)) then
211     amp1(il) = amp1(il) + ment(il, k, j)
212     endif
213     end do
214 guez 97 end do
215     end do
216 guez 47
217 guez 188 do k = 1, i - 1
218     do j = i, nl + 1 ! newvecto: nl au lieu nl + 1?
219     do il = 1, ncum
220     if (i <= inb(il) .and. j <= inb(il)) then
221     ad(il) = ad(il) + ment(il, j, k)
222     endif
223     end do
224 guez 97 end do
225     end do
226 guez 47
227 guez 188 do il = 1, ncum
228     if (i <= inb(il)) then
229     dpinv = 1.0 / (ph(il, i) - ph(il, i + 1))
230     cpinv = 1.0 / cpn(il, i)
231 guez 47
232 guez 198 if (0.01 * rg * dpinv * amp1(il) >= delti) iflag(il) = 1
233 guez 47
234 guez 198 ft(il, i) = 0.01 * rg * dpinv * (amp1(il) * (t(il, i + 1) &
235 guez 188 - t(il, i) + (gz(il, i + 1) - gz(il, i)) * cpinv) &
236     - ad(il) * (t(il, i) - t(il, i - 1) + (gz(il, i) &
237     - gz(il, i - 1)) * cpinv)) - 0.5 * sigd * lvcp(il, i) &
238 guez 200 * (evap(il, i) + evap(il, i + 1)) - 0.009 * rg * sigd &
239     * (mp(il, i + 1) * t(il, i) * b(il, i) - mp(il, i) &
240     * t(il, i - 1) * cpn(il, i - 1) * cpinv * b(il, i - 1)) &
241     * dpinv + 0.01 * rg * dpinv * ment(il, i, i) &
242 guez 201 * (hp(il, i) - h(il, i) + t(il, i) * (rcpv - rcpd) &
243 guez 200 * (rr(il, i) - qent(il, i, i))) * cpinv + 0.01 * sigd &
244 guez 201 * wt(il, i) * (rcw - rcpd) * water(il, i + 1) &
245 guez 200 * (t(il, i + 1) - t(il, i)) * dpinv * cpinv
246 guez 198 fr(il, i) = 0.01 * rg * dpinv * (amp1(il) * (rr(il, i + 1) &
247 guez 188 - rr(il, i)) - ad(il) * (rr(il, i) - rr(il, i - 1)))
248 guez 198 fu(il, i) = fu(il, i) + 0.01 * rg * dpinv * (amp1(il) &
249 guez 188 * (u(il, i + 1) - u(il, i)) - ad(il) * (u(il, i) &
250     - u(il, i - 1)))
251 guez 198 fv(il, i) = fv(il, i) + 0.01 * rg * dpinv * (amp1(il) &
252 guez 188 * (v(il, i + 1) - v(il, i)) - ad(il) * (v(il, i) &
253     - v(il, i - 1)))
254     endif
255     end do
256 guez 47
257 guez 188 do k = 1, i - 1
258     do il = 1, ncum
259     if (i <= inb(il)) then
260     dpinv = 1.0 / (ph(il, i) - ph(il, i + 1))
261     cpinv = 1.0 / cpn(il, i)
262 guez 47
263 guez 188 awat = elij(il, k, i) - (1. - ep(il, i)) * clw(il, i)
264     awat = amax1(awat, 0.0)
265 guez 47
266 guez 198 fr(il, i) = fr(il, i) + 0.01 * rg * dpinv &
267 guez 188 * ment(il, k, i) * (qent(il, k, i) - awat - rr(il, i))
268 guez 198 fu(il, i) = fu(il, i) + 0.01 * rg * dpinv &
269 guez 188 * ment(il, k, i) * (uent(il, k, i) - u(il, i))
270 guez 198 fv(il, i) = fv(il, i) + 0.01 * rg * dpinv &
271 guez 188 * ment(il, k, i) * (vent(il, k, i) - v(il, i))
272 guez 47
273 guez 188 ! (saturated updrafts resulting from mixing)
274     qcond(il, i) = qcond(il, i) + (elij(il, k, i) - awat)
275     nqcond(il, i) = nqcond(il, i) + 1.
276     endif ! i
277     end do
278 guez 97 end do
279 guez 47
280 guez 188 do k = i, nl + 1
281     do il = 1, ncum
282     if (i <= inb(il) .and. k <= inb(il)) then
283     dpinv = 1.0 / (ph(il, i) - ph(il, i + 1))
284     cpinv = 1.0 / cpn(il, i)
285 guez 47
286 guez 198 fr(il, i) = fr(il, i) + 0.01 * rg * dpinv &
287 guez 188 * ment(il, k, i) * (qent(il, k, i) - rr(il, i))
288 guez 198 fu(il, i) = fu(il, i) + 0.01 * rg * dpinv &
289 guez 188 * ment(il, k, i) * (uent(il, k, i) - u(il, i))
290 guez 198 fv(il, i) = fv(il, i) + 0.01 * rg * dpinv &
291 guez 188 * ment(il, k, i) * (vent(il, k, i) - v(il, i))
292     endif
293     end do
294 guez 97 end do
295 guez 47
296 guez 188 do il = 1, ncum
297     if (i <= inb(il)) then
298     dpinv = 1.0 / (ph(il, i) - ph(il, i + 1))
299     cpinv = 1.0 / cpn(il, i)
300 guez 47
301 guez 188 ! sb: on ne fait pas encore la correction permettant de mieux
302     ! conserver l'eau:
303     fr(il, i) = fr(il, i) + 0.5 * sigd * (evap(il, i) &
304 guez 198 + evap(il, i + 1)) + 0.01 * rg * (mp(il, i + 1) &
305 guez 201 * (qp(il, i + 1) - rr(il, i)) - mp(il, i) * (qp(il, i) &
306 guez 188 - rr(il, i - 1))) * dpinv
307 guez 47
308 guez 198 fu(il, i) = fu(il, i) + 0.01 * rg * (mp(il, i + 1) &
309 guez 188 * (up(il, i + 1) - u(il, i)) - mp(il, i) * (up(il, i) &
310     - u(il, i - 1))) * dpinv
311 guez 198 fv(il, i) = fv(il, i) + 0.01 * rg * (mp(il, i + 1) &
312 guez 188 * (vp(il, i + 1) - v(il, i)) - mp(il, i) * (vp(il, i) &
313     - v(il, i - 1))) * dpinv
314     endif
315     end do
316 guez 47
317 guez 188 ! sb: interface with the cloud parameterization:
318 guez 47
319 guez 188 do k = i + 1, nl
320     do il = 1, ncum
321     if (k <= inb(il) .and. i <= inb(il)) then
322     ! (saturated downdrafts resulting from mixing)
323     qcond(il, i) = qcond(il, i) + elij(il, k, i)
324     nqcond(il, i) = nqcond(il, i) + 1.
325     endif
326     enddo
327     enddo
328 guez 47
329 guez 188 ! (particular case: no detraining level is found)
330     do il = 1, ncum
331     if (i <= inb(il) .and. nent(il, i) == 0) then
332     qcond(il, i) = qcond(il, i) + (1. - ep(il, i)) * clw(il, i)
333     nqcond(il, i) = nqcond(il, i) + 1.
334     endif
335     enddo
336 guez 47
337 guez 188 do il = 1, ncum
338     if (i <= inb(il) .and. nqcond(il, i) /= 0.) then
339     qcond(il, i) = qcond(il, i) / nqcond(il, i)
340     endif
341     enddo
342     end if
343     end do loop_i
344 guez 47
345 guez 200 ! move the detrainment at level inb down to level inb - 1
346     ! in such a way as to preserve the vertically
347     ! integrated enthalpy and water tendencies
348 guez 47
349 guez 188 do il = 1, ncum
350     ax = 0.1 * ment(il, inb(il), inb(il)) * (hp(il, inb(il)) &
351 guez 201 - h(il, inb(il)) + t(il, inb(il)) * (rcpv - rcpd) &
352 guez 188 * (rr(il, inb(il)) - qent(il, inb(il), inb(il)))) &
353     / (cpn(il, inb(il)) * (ph(il, inb(il)) - ph(il, inb(il) + 1)))
354     ft(il, inb(il)) = ft(il, inb(il)) - ax
355     ft(il, inb(il) - 1) = ft(il, inb(il) - 1) + ax * cpn(il, inb(il)) &
356     * (ph(il, inb(il)) - ph(il, inb(il) + 1)) / (cpn(il, inb(il) - 1) &
357     * (ph(il, inb(il) - 1) - ph(il, inb(il))))
358 guez 47
359 guez 188 bx = 0.1 * ment(il, inb(il), inb(il)) * (qent(il, inb(il), inb(il)) &
360     - rr(il, inb(il))) / (ph(il, inb(il)) - ph(il, inb(il) + 1))
361     fr(il, inb(il)) = fr(il, inb(il)) - bx
362     fr(il, inb(il) - 1) = fr(il, inb(il) - 1) &
363     + bx * (ph(il, inb(il)) - ph(il, inb(il) + 1)) &
364     / (ph(il, inb(il) - 1) - ph(il, inb(il)))
365 guez 47
366 guez 188 cx = 0.1 * ment(il, inb(il), inb(il)) * (uent(il, inb(il), inb(il)) &
367     - u(il, inb(il))) / (ph(il, inb(il)) - ph(il, inb(il) + 1))
368     fu(il, inb(il)) = fu(il, inb(il)) - cx
369     fu(il, inb(il) - 1) = fu(il, inb(il) - 1) &
370     + cx * (ph(il, inb(il)) - ph(il, inb(il) + 1)) &
371     / (ph(il, inb(il) - 1) - ph(il, inb(il)))
372 guez 47
373 guez 188 dx = 0.1 * ment(il, inb(il), inb(il)) * (vent(il, inb(il), inb(il)) &
374     - v(il, inb(il))) / (ph(il, inb(il)) - ph(il, inb(il) + 1))
375     fv(il, inb(il)) = fv(il, inb(il)) - dx
376     fv(il, inb(il) - 1) = fv(il, inb(il) - 1) &
377     + dx * (ph(il, inb(il)) - ph(il, inb(il) + 1)) &
378     / (ph(il, inb(il) - 1) - ph(il, inb(il)))
379 guez 47
380 guez 97 end do
381 guez 47
382 guez 200 ! homoginize tendencies below cloud base
383 guez 187
384 guez 188 do il = 1, ncum
385     asum(il) = 0.0
386     bsum(il) = 0.0
387     csum(il) = 0.0
388     dsum(il) = 0.0
389 guez 97 enddo
390 guez 47
391 guez 188 do i = 1, nl
392     do il = 1, ncum
393     if (i <= (icb(il) - 1)) then
394     asum(il) = asum(il) + ft(il, i) * (ph(il, i) - ph(il, i + 1))
395 guez 201 bsum(il) = bsum(il) + fr(il, i) * (lv(il, i) + (rcw - rcpd) &
396 guez 188 * (t(il, i) - t(il, 1))) * (ph(il, i) - ph(il, i + 1))
397 guez 201 csum(il) = csum(il) + (lv(il, i) + (rcw - rcpd) * (t(il, i) &
398 guez 188 - t(il, 1))) * (ph(il, i) - ph(il, i + 1))
399     dsum(il) = dsum(il) + t(il, i) * (ph(il, i) - ph(il, i + 1)) &
400     / th(il, i)
401 guez 97 endif
402 guez 47 enddo
403 guez 97 enddo
404 guez 47
405 guez 188 do i = 1, nl
406     do il = 1, ncum
407     if (i <= (icb(il) - 1)) then
408     ft(il, i) = asum(il) * t(il, i) / (th(il, i) * dsum(il))
409     fr(il, i) = bsum(il) / csum(il)
410 guez 97 endif
411 guez 47 enddo
412 guez 97 enddo
413 guez 47
414 guez 200 ! reset counter and return
415 guez 187
416 guez 188 do il = 1, ncum
417     sig(il, klev) = 2.0
418 guez 97 enddo
419 guez 47
420 guez 188 do i = 1, klev
421     do il = 1, ncum
422     upwd(il, i) = 0.0
423     dnwd(il, i) = 0.0
424 guez 47 enddo
425 guez 97 enddo
426 guez 47
427 guez 188 do i = 1, nl
428     do il = 1, ncum
429 guez 187 if (i >= icb(il) .and. i <= inb(il)) then
430 guez 188 upwd(il, i) = 0.0
431     dnwd(il, i) = 0.0
432 guez 97 endif
433 guez 47 enddo
434 guez 97 enddo
435 guez 47
436 guez 188 do i = 1, nl
437     do k = 1, nl
438     do il = 1, ncum
439     up1(il, k, i) = 0.0
440     dn1(il, k, i) = 0.0
441 guez 97 enddo
442 guez 47 enddo
443 guez 97 enddo
444 guez 47
445 guez 188 do i = 1, nl
446     do k = i, nl
447     do n = 1, i - 1
448     do il = 1, ncum
449 guez 187 if (i >= icb(il).and.i <= inb(il).and.k <= inb(il)) then
450 guez 188 up1(il, k, i) = up1(il, k, i) + ment(il, n, k)
451     dn1(il, k, i) = dn1(il, k, i) - ment(il, k, n)
452 guez 97 endif
453     enddo
454     enddo
455 guez 47 enddo
456 guez 97 enddo
457 guez 47
458 guez 188 do i = 2, nl
459     do k = i, nl
460     do il = 1, ncum
461 guez 187 if (i <= inb(il).and.k <= inb(il)) then
462 guez 188 upwd(il, i) = upwd(il, i) + m(il, k) + up1(il, k, i)
463     dnwd(il, i) = dnwd(il, i) + dn1(il, k, i)
464 guez 97 endif
465     enddo
466 guez 47 enddo
467 guez 97 enddo
468 guez 47
469 guez 200 ! D\'etermination de la variation de flux ascendant entre
470     ! deux niveaux non dilu\'es mike
471 guez 47
472 guez 188 do i = 1, nl
473     do il = 1, ncum
474     mike(il, i) = m(il, i)
475 guez 47 enddo
476 guez 97 enddo
477 guez 47
478 guez 188 do i = nl + 1, klev
479     do il = 1, ncum
480     mike(il, i) = 0.
481 guez 47 enddo
482 guez 97 enddo
483 guez 47
484 guez 188 do i = 1, klev
485     do il = 1, ncum
486     ma(il, i) = 0
487 guez 47 enddo
488 guez 97 enddo
489 guez 47
490 guez 188 do i = 1, nl
491     do j = i, nl
492     do il = 1, ncum
493     ma(il, i) = ma(il, i) + m(il, j)
494 guez 97 enddo
495 guez 47 enddo
496 guez 97 enddo
497 guez 47
498 guez 188 do i = nl + 1, klev
499     do il = 1, ncum
500     ma(il, i) = 0.
501 guez 47 enddo
502 guez 97 enddo
503 guez 47
504 guez 188 do i = 1, nl
505     do il = 1, ncum
506     if (i <= (icb(il) - 1)) then
507     ma(il, i) = 0
508 guez 97 endif
509 guez 47 enddo
510 guez 97 enddo
511 guez 47
512 guez 200 ! icb repr\'esente le niveau o\`u se trouve la base du nuage, et
513     ! inb le sommet du nuage
514 guez 47
515 guez 188 do i = 1, klev
516     DO il = 1, ncum
517 guez 201 rdcp = (rd * (1. - rr(il, i)) - rr(il, i) * rv) &
518     / (rcpd * (1. - rr(il, i)) + rr(il, i) * rcpv)
519 guez 188 tls(il, i) = t(il, i) * (1000.0 / p(il, i))**rdcp
520     tps(il, i) = tp(il, i)
521 guez 97 end DO
522     enddo
523 guez 47
524 guez 200 ! Diagnose the in-cloud mixing ratio of condensed water
525 guez 47
526 guez 188 do i = 1, klev
527     do il = 1, ncum
528     mac(il, i) = 0.0
529     wa(il, i) = 0.0
530     siga(il, i) = 0.0
531     sax(il, i) = 0.0
532     enddo
533     enddo
534 guez 47
535 guez 188 do i = minorig, nl
536     do k = i + 1, nl + 1
537     do il = 1, ncum
538     if (i <= inb(il) .and. k <= (inb(il) + 1)) then
539     mac(il, i) = mac(il, i) + m(il, k)
540     endif
541     enddo
542     enddo
543     enddo
544 guez 47
545 guez 188 do i = 1, nl
546     do j = 1, i
547     do il = 1, ncum
548     if (i >= icb(il) .and. i <= (inb(il) - 1) &
549     .and. j >= icb(il)) then
550 guez 201 sax(il, i) = sax(il, i) + rd * (tvp(il, j) - tv(il, j)) &
551 guez 188 * (ph(il, j) - ph(il, j + 1)) / p(il, j)
552     endif
553     enddo
554     enddo
555     enddo
556 guez 97
557 guez 188 do i = 1, nl
558     do il = 1, ncum
559     if (i >= icb(il) .and. i <= (inb(il) - 1) &
560     .and. sax(il, i) > 0.0) then
561     wa(il, i) = sqrt(2. * sax(il, i))
562     endif
563     enddo
564     enddo
565 guez 47
566 guez 188 do i = 1, nl
567     do il = 1, ncum
568 guez 201 if (wa(il, i) > 0.0) siga(il, i) = mac(il, i) / wa(il, i) * rd &
569 guez 188 * tvp(il, i) / p(il, i) / 100. / delta
570     siga(il, i) = min(siga(il, i), 1.0)
571    
572 guez 187 if (iflag_clw == 0) then
573 guez 188 qcondc(il, i) = siga(il, i) * clw(il, i) * (1. - ep(il, i)) &
574     + (1. - siga(il, i)) * qcond(il, i)
575 guez 187 else if (iflag_clw == 1) then
576 guez 188 qcondc(il, i) = qcond(il, i)
577 guez 97 endif
578 guez 188 enddo
579     enddo
580 guez 47
581 guez 185 end SUBROUTINE cv30_yield
582 guez 97
583 guez 185 end module cv30_yield_m
  ViewVC Help
Powered by ViewVC 1.1.21