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

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

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 190 by guez, Thu Apr 14 15:15:56 2016 UTC revision 198 by guez, Tue May 31 16:17:35 2016 UTC
# Line 9  contains Line 9  contains
9         qent, uent, vent, nent, elij, sig, tv, tvp, iflag, precip, VPrecip, &         qent, uent, vent, nent, elij, sig, tv, tvp, iflag, precip, VPrecip, &
10         ft, fr, fu, fv, upwd, dnwd, dnwd0, ma, mike, tls, tps, qcondc)         ft, fr, fu, fv, upwd, dnwd, dnwd0, ma, mike, tls, tps, qcondc)
11    
12        ! Tendencies, precipitation, variables of interface with other
13        ! processes, etc.
14    
15      use conema3_m, only: iflag_clw      use conema3_m, only: iflag_clw
16      use cv30_param_m, only: delta, minorig, nl, sigd      use cv30_param_m, only: minorig, nl, sigd
17      use cv_thermo_m, only: cl, cpd, cpv, grav, rowl, rrd, rrv      use cv_thermo_m, only: cl, cpd, cpv, rowl, rrd, rrv
18      USE dimphy, ONLY: klev, klon      USE dimphy, ONLY: klev, klon
19        use SUPHEC_M, only: rg
20    
21      ! inputs:      ! inputs:
22      integer, intent(in):: icb(:), inb(:) ! (ncum)      integer, intent(in):: icb(:), inb(:) ! (ncum)
# Line 27  contains Line 31  contains
31      real m(klon, klev)      real m(klon, klev)
32      real tp(klon, klev)      real tp(klon, klev)
33      real mp(klon, klev), rp(klon, klev), up(klon, klev)      real mp(klon, klev), rp(klon, klev), up(klon, klev)
34      real vp(klon, klev), wt(klon, klev)      real, intent(in):: vp(:, 2:) ! (ncum, 2:nl)
35        real, intent(in):: wt(:, :) ! (ncum, nl - 1)
36      real, intent(in):: water(:, :), evap(:, :) ! (ncum, nl)      real, intent(in):: water(:, :), evap(:, :) ! (ncum, nl)
37      real, intent(in):: b(:, :) ! (ncum, nl - 1)      real, intent(in):: b(:, :) ! (ncum, nl - 1)
38      real ment(klon, klev, klev), qent(klon, klev, klev), uent(klon, klev, klev)      real ment(klon, klev, klev), qent(klon, klev, klev), uent(klon, klev, klev)
# Line 37  contains Line 42  contains
42      real sig(klon, klev)      real sig(klon, klev)
43      real tv(klon, klev), tvp(klon, klev)      real tv(klon, klev), tvp(klon, klev)
44    
45      ! input / output:      integer, intent(out):: iflag(:) ! (ncum)
     integer iflag(klon)  
46    
47      ! outputs:      ! outputs:
48      real precip(klon)      real precip(klon)
# Line 52  contains Line 56  contains
56      real qcondc(klon, klev)      real qcondc(klon, klev)
57    
58      ! Local:      ! Local:
59        real, parameter:: delta = 0.01 ! interface cloud parameterization
60      integer ncum      integer ncum
61      integer i, k, il, n, j, num1      integer i, k, il, n, j, num1
62      real rat, awat, delti      real rat, awat, delti
# Line 67  contains Line 72  contains
72      !-------------------------------------------------------------      !-------------------------------------------------------------
73    
74      ncum = size(icb)      ncum = size(icb)
75        iflag = 0
76    
77      ! initialization:      ! initialization:
78    
# Line 100  contains Line 106  contains
106    
107      do il = 1, ncum      do il = 1, ncum
108         if (ep(il, inb(il)) >= 1e-4) precip(il) = wt(il, 1) * sigd &         if (ep(il, inb(il)) >= 1e-4) precip(il) = wt(il, 1) * sigd &
109              * water(il, 1) * 86400. * 1000. / (rowl * grav)              * water(il, 1) * 86400. * 1000. / (rowl * rg)
110      enddo      enddo
111    
112      ! CALCULATE VERTICAL PROFILE OF PRECIPITATIONs IN kg / m2 / s ===      ! CALCULATE VERTICAL PROFILE OF PRECIPITATIONs IN kg / m2 / s ===
# Line 109  contains Line 115  contains
115      do k = 1, nl - 1      do k = 1, nl - 1
116         do il = 1, ncum         do il = 1, ncum
117            if (k <= inb(il)) VPrecip(il, k) = wt(il, k) * sigd * water(il, k) &            if (k <= inb(il)) VPrecip(il, k) = wt(il, k) * sigd * water(il, k) &
118                 / grav                 / rg
119         end do         end do
120      end do      end do
121    
# Line 129  contains Line 135  contains
135    
136      do il = 1, ncum      do il = 1, ncum
137         ! Consist vect:         ! Consist vect:
138         if (0.01 * grav * work(il) * am(il) >= delti) iflag(il) = 1         if (0.01 * rg * work(il) * am(il) >= delti) iflag(il) = 1
139    
140         ft(il, 1) = 0.01 * grav * work(il) * am(il) * (t(il, 2) - t(il, 1) &         ft(il, 1) = 0.01 * rg * work(il) * am(il) * (t(il, 2) - t(il, 1) &
141              + (gz(il, 2) - gz(il, 1)) / cpn(il, 1))              + (gz(il, 2) - gz(il, 1)) / cpn(il, 1))
142    
143         ft(il, 1) = ft(il, 1) - 0.5 * lvcp(il, 1) * sigd * (evap(il, 1) &         ft(il, 1) = ft(il, 1) - 0.5 * lvcp(il, 1) * sigd * (evap(il, 1) &
144              + evap(il, 2))              + evap(il, 2))
145    
146         ft(il, 1) = ft(il, 1) - 0.009 * grav * sigd * mp(il, 2) &         ft(il, 1) = ft(il, 1) - 0.009 * rg * sigd * mp(il, 2) &
147              * t(il, 1) * b(il, 1) * work(il)              * t(il, 1) * b(il, 1) * work(il)
148    
149         ft(il, 1) = ft(il, 1) + 0.01 * sigd * wt(il, 1) * (cl - cpd) &         ft(il, 1) = ft(il, 1) + 0.01 * sigd * wt(il, 1) * (cl - cpd) &
150              * water(il, 2) * (t(il, 2) - t(il, 1)) * work(il) / cpn(il, 1)              * water(il, 2) * (t(il, 2) - t(il, 1)) * work(il) / cpn(il, 1)
151    
152         !jyg1 Correction pour mieux conserver l'eau (conformite avec CONVECT4.3)         !jyg1 Correction pour mieux conserver l'eau (conformite avec CONVECT4.3)
153         ! (sb: pour l'instant, on ne fait que le chgt concernant grav, pas evap)         ! (sb: pour l'instant, on ne fait que le chgt concernant rg, pas evap)
154         fr(il, 1) = 0.01 * grav * mp(il, 2) * (rp(il, 2) - rr(il, 1)) &         fr(il, 1) = 0.01 * rg * mp(il, 2) * (rp(il, 2) - rr(il, 1)) &
155              * work(il) + sigd * 0.5 * (evap(il, 1) + evap(il, 2))              * work(il) + sigd * 0.5 * (evap(il, 1) + evap(il, 2))
156         ! + tard : + sigd * evap(il, 1)         ! + tard : + sigd * evap(il, 1)
157    
158         fr(il, 1) = fr(il, 1) + 0.01 * grav * am(il) * (rr(il, 2) - rr(il, 1)) &         fr(il, 1) = fr(il, 1) + 0.01 * rg * am(il) * (rr(il, 2) - rr(il, 1)) &
159              * work(il)              * work(il)
160    
161         fu(il, 1) = fu(il, 1) + 0.01 * grav * work(il) * (mp(il, 2) &         fu(il, 1) = fu(il, 1) + 0.01 * rg * work(il) * (mp(il, 2) &
162              * (up(il, 2) - u(il, 1)) + am(il) * (u(il, 2) - u(il, 1)))              * (up(il, 2) - u(il, 1)) + am(il) * (u(il, 2) - u(il, 1)))
163         fv(il, 1) = fv(il, 1) + 0.01 * grav * work(il) * (mp(il, 2) &         fv(il, 1) = fv(il, 1) + 0.01 * rg * work(il) * (mp(il, 2) &
164              * (vp(il, 2) - v(il, 1)) + am(il) * (v(il, 2) - v(il, 1)))              * (vp(il, 2) - v(il, 1)) + am(il) * (v(il, 2) - v(il, 1)))
165      enddo ! il      enddo ! il
166    
167      do j = 2, nl      do j = 2, nl
168         do il = 1, ncum         do il = 1, ncum
169            if (j <= inb(il)) then            if (j <= inb(il)) then
170               fr(il, 1) = fr(il, 1) + 0.01 * grav * work(il) * ment(il, j, 1) &               fr(il, 1) = fr(il, 1) + 0.01 * rg * work(il) * ment(il, j, 1) &
171                    * (qent(il, j, 1) - rr(il, 1))                    * (qent(il, j, 1) - rr(il, 1))
172               fu(il, 1) = fu(il, 1) + 0.01 * grav * work(il) * ment(il, j, 1) &               fu(il, 1) = fu(il, 1) + 0.01 * rg * work(il) * ment(il, j, 1) &
173                    * (uent(il, j, 1) - u(il, 1))                    * (uent(il, j, 1) - u(il, 1))
174               fv(il, 1) = fv(il, 1) + 0.01 * grav * work(il) * ment(il, j, 1) &               fv(il, 1) = fv(il, 1) + 0.01 * rg * work(il) * ment(il, j, 1) &
175                    * (vent(il, j, 1) - v(il, 1))                    * (vent(il, j, 1) - v(il, 1))
176            endif            endif
177         enddo         enddo
# Line 222  contains Line 228  contains
228                  cpinv = 1.0 / cpn(il, i)                  cpinv = 1.0 / cpn(il, i)
229    
230                  ! Vecto:                  ! Vecto:
231                  if (0.01 * grav * dpinv * amp1(il) >= delti) iflag(il) = 1                  if (0.01 * rg * dpinv * amp1(il) >= delti) iflag(il) = 1
232    
233                  ft(il, i) = 0.01 * grav * dpinv * (amp1(il) * (t(il, i + 1) &                  ft(il, i) = 0.01 * rg * dpinv * (amp1(il) * (t(il, i + 1) &
234                       - t(il, i) + (gz(il, i + 1) - gz(il, i)) * cpinv) &                       - t(il, i) + (gz(il, i + 1) - gz(il, i)) * cpinv) &
235                       - ad(il) * (t(il, i) - t(il, i - 1) + (gz(il, i) &                       - ad(il) * (t(il, i) - t(il, i - 1) + (gz(il, i) &
236                       - gz(il, i - 1)) * cpinv)) - 0.5 * sigd * lvcp(il, i) &                       - gz(il, i - 1)) * cpinv)) - 0.5 * sigd * lvcp(il, i) &
237                       * (evap(il, i) + evap(il, i + 1))                       * (evap(il, i) + evap(il, i + 1))
238                  rat = cpn(il, i - 1) * cpinv                  rat = cpn(il, i - 1) * cpinv
239                  ft(il, i) = ft(il, i) - 0.009 * grav * sigd * (mp(il, i + 1) &                  ft(il, i) = ft(il, i) - 0.009 * rg * sigd * (mp(il, i + 1) &
240                       * t(il, i) * b(il, i) - mp(il, i) * t(il, i - 1) * rat &                       * t(il, i) * b(il, i) - mp(il, i) * t(il, i - 1) * rat &
241                       * b(il, i - 1)) * dpinv                       * b(il, i - 1)) * dpinv
242                  ft(il, i) = ft(il, i) + 0.01 * grav * dpinv * ment(il, i, i) &                  ft(il, i) = ft(il, i) + 0.01 * rg * dpinv * ment(il, i, i) &
243                       * (hp(il, i) - h(il, i) + t(il, i) * (cpv - cpd) &                       * (hp(il, i) - h(il, i) + t(il, i) * (cpv - cpd) &
244                       * (rr(il, i) - qent(il, i, i))) * cpinv                       * (rr(il, i) - qent(il, i, i))) * cpinv
245    
# Line 241  contains Line 247  contains
247                       * water(il, i + 1) * (t(il, i + 1) - t(il, i)) * dpinv &                       * water(il, i + 1) * (t(il, i + 1) - t(il, i)) * dpinv &
248                       * cpinv                       * cpinv
249    
250                  fr(il, i) = 0.01 * grav * dpinv * (amp1(il) * (rr(il, i + 1) &                  fr(il, i) = 0.01 * rg * dpinv * (amp1(il) * (rr(il, i + 1) &
251                       - rr(il, i)) - ad(il) * (rr(il, i) - rr(il, i - 1)))                       - rr(il, i)) - ad(il) * (rr(il, i) - rr(il, i - 1)))
252                  fu(il, i) = fu(il, i) + 0.01 * grav * dpinv * (amp1(il) &                  fu(il, i) = fu(il, i) + 0.01 * rg * dpinv * (amp1(il) &
253                       * (u(il, i + 1) - u(il, i)) - ad(il) * (u(il, i) &                       * (u(il, i + 1) - u(il, i)) - ad(il) * (u(il, i) &
254                       - u(il, i - 1)))                       - u(il, i - 1)))
255                  fv(il, i) = fv(il, i) + 0.01 * grav * dpinv * (amp1(il) &                  fv(il, i) = fv(il, i) + 0.01 * rg * dpinv * (amp1(il) &
256                       * (v(il, i + 1) - v(il, i)) - ad(il) * (v(il, i) &                       * (v(il, i + 1) - v(il, i)) - ad(il) * (v(il, i) &
257                       - v(il, i - 1)))                       - v(il, i - 1)))
258               endif               endif
# Line 261  contains Line 267  contains
267                     awat = elij(il, k, i) - (1. - ep(il, i)) * clw(il, i)                     awat = elij(il, k, i) - (1. - ep(il, i)) * clw(il, i)
268                     awat = amax1(awat, 0.0)                     awat = amax1(awat, 0.0)
269    
270                     fr(il, i) = fr(il, i) + 0.01 * grav * dpinv &                     fr(il, i) = fr(il, i) + 0.01 * rg * dpinv &
271                          * ment(il, k, i) * (qent(il, k, i) - awat - rr(il, i))                          * ment(il, k, i) * (qent(il, k, i) - awat - rr(il, i))
272                     fu(il, i) = fu(il, i) + 0.01 * grav * dpinv &                     fu(il, i) = fu(il, i) + 0.01 * rg * dpinv &
273                          * ment(il, k, i) * (uent(il, k, i) - u(il, i))                          * ment(il, k, i) * (uent(il, k, i) - u(il, i))
274                     fv(il, i) = fv(il, i) + 0.01 * grav * dpinv &                     fv(il, i) = fv(il, i) + 0.01 * rg * dpinv &
275                          * ment(il, k, i) * (vent(il, k, i) - v(il, i))                          * ment(il, k, i) * (vent(il, k, i) - v(il, i))
276    
277                     ! (saturated updrafts resulting from mixing)                     ! (saturated updrafts resulting from mixing)
# Line 281  contains Line 287  contains
287                     dpinv = 1.0 / (ph(il, i) - ph(il, i + 1))                     dpinv = 1.0 / (ph(il, i) - ph(il, i + 1))
288                     cpinv = 1.0 / cpn(il, i)                     cpinv = 1.0 / cpn(il, i)
289    
290                     fr(il, i) = fr(il, i) + 0.01 * grav * dpinv &                     fr(il, i) = fr(il, i) + 0.01 * rg * dpinv &
291                          * ment(il, k, i) * (qent(il, k, i) - rr(il, i))                          * ment(il, k, i) * (qent(il, k, i) - rr(il, i))
292                     fu(il, i) = fu(il, i) + 0.01 * grav * dpinv &                     fu(il, i) = fu(il, i) + 0.01 * rg * dpinv &
293                          * ment(il, k, i) * (uent(il, k, i) - u(il, i))                          * ment(il, k, i) * (uent(il, k, i) - u(il, i))
294                     fv(il, i) = fv(il, i) + 0.01 * grav * dpinv &                     fv(il, i) = fv(il, i) + 0.01 * rg * dpinv &
295                          * ment(il, k, i) * (vent(il, k, i) - v(il, i))                          * ment(il, k, i) * (vent(il, k, i) - v(il, i))
296                  endif                  endif
297               end do               end do
# Line 299  contains Line 305  contains
305                  ! sb: on ne fait pas encore la correction permettant de mieux                  ! sb: on ne fait pas encore la correction permettant de mieux
306                  ! conserver l'eau:                  ! conserver l'eau:
307                  fr(il, i) = fr(il, i) + 0.5 * sigd * (evap(il, i) &                  fr(il, i) = fr(il, i) + 0.5 * sigd * (evap(il, i) &
308                       + evap(il, i + 1)) + 0.01 * grav * (mp(il, i + 1) &                       + evap(il, i + 1)) + 0.01 * rg * (mp(il, i + 1) &
309                       * (rp(il, i + 1) - rr(il, i)) - mp(il, i) * (rp(il, i) &                       * (rp(il, i + 1) - rr(il, i)) - mp(il, i) * (rp(il, i) &
310                       - rr(il, i - 1))) * dpinv                       - rr(il, i - 1))) * dpinv
311    
312                  fu(il, i) = fu(il, i) + 0.01 * grav * (mp(il, i + 1) &                  fu(il, i) = fu(il, i) + 0.01 * rg * (mp(il, i + 1) &
313                       * (up(il, i + 1) - u(il, i)) - mp(il, i) * (up(il, i) &                       * (up(il, i + 1) - u(il, i)) - mp(il, i) * (up(il, i) &
314                       - u(il, i - 1))) * dpinv                       - u(il, i - 1))) * dpinv
315                  fv(il, i) = fv(il, i) + 0.01 * grav * (mp(il, i + 1) &                  fv(il, i) = fv(il, i) + 0.01 * rg * (mp(il, i + 1) &
316                       * (vp(il, i + 1) - v(il, i)) - mp(il, i) * (vp(il, i) &                       * (vp(il, i + 1) - v(il, i)) - mp(il, i) * (vp(il, i) &
317                       - v(il, i - 1))) * dpinv                       - v(il, i - 1))) * dpinv
318               endif               endif
Legend:
Removed from v.190  
changed lines
  Added in v.198
  ViewVC Help
Powered by ViewVC 1.1.21