/[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 197 by guez, Mon May 23 13:50:39 2016 UTC revision 198 by guez, Tue May 31 16:17:35 2016 UTC
# Line 14  contains Line 14  contains
14    
15      use conema3_m, only: iflag_clw      use conema3_m, only: iflag_clw
16      use cv30_param_m, only: 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 105  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 114  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 134  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 227  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 246  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 266  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 286  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 304  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.197  
changed lines
  Added in v.198
  ViewVC Help
Powered by ViewVC 1.1.21