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

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

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

revision 200 by guez, Thu Jun 2 15:40:30 2016 UTC revision 213 by guez, Mon Feb 27 15:44:55 2017 UTC
# Line 5  module cv30_yield_m Line 5  module cv30_yield_m
5  contains  contains
6    
7    SUBROUTINE cv30_yield(icb, inb, delt, t, rr, u, v, gz, p, ph, h, hp, lv, &    SUBROUTINE cv30_yield(icb, inb, delt, t, rr, u, v, gz, p, ph, h, hp, lv, &
8         cpn, th, ep, clw, m, tp, mp, rp, up, vp, wt, water, evap, b, ment, &         cpn, th, ep, clw, m, tp, mp, qp, up, vp, wt, water, evap, b, ment, &
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, ma, mike, tls, tps, qcondc)
11    
12      ! Tendencies, precipitation, variables of interface with other      ! Tendencies, precipitation, variables of interface with other
13      ! processes, etc.      ! processes, etc.
14    
15      use conema3_m, only: iflag_clw      use conf_phys_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, rowl, rrd, rrv      use cv_thermo_m, only: rowl
18      USE dimphy, ONLY: klev, klon      USE dimphy, ONLY: klev, klon
19      use SUPHEC_M, only: rg      use SUPHEC_M, only: rg, rcpd, rcw, rcpv, rd, rv
20    
21      ! inputs:      ! inputs:
22      integer, intent(in):: icb(:), inb(:) ! (ncum)  
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      real, intent(in):: delt      real, intent(in):: delt
30      real, intent(in):: t(klon, klev), rr(klon, klev)      real, intent(in):: t(klon, klev), rr(klon, klev)
31      real, intent(in):: u(klon, klev), v(klon, klev)      real, intent(in):: u(klon, klev), v(klon, klev)
32      real gz(klon, klev)      real gz(klon, klev)
33      real p(klon, klev)      real p(klon, klev)
34      real ph(klon, klev + 1), h(klon, klev), hp(klon, klev)      real ph(klon, klev + 1), h(klon, klev), hp(klon, klev)
35      real lv(klon, klev), cpn(klon, klev)      real, intent(in):: lv(:, :) ! (klon, klev)
36      real th(klon, klev)  
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      real ep(klon, klev), clw(klon, klev)      real ep(klon, klev), clw(klon, klev)
42      real m(klon, klev)      real m(klon, klev)
43      real tp(klon, klev)      real tp(klon, klev)
44      real mp(klon, klev), rp(klon, klev), up(klon, klev)  
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        real, intent(in):: qp(:, :), up(:, :) ! (klon, klev)
50      real, intent(in):: vp(:, 2:) ! (ncum, 2:nl)      real, intent(in):: vp(:, 2:) ! (ncum, 2:nl)
51      real, intent(in):: wt(:, :) ! (ncum, nl - 1)      real, intent(in):: wt(:, :) ! (ncum, nl - 1)
52      real, intent(in):: water(:, :), evap(:, :) ! (ncum, nl)      real, intent(in):: water(:, :), evap(:, :) ! (ncum, nl)
# Line 49  contains Line 64  contains
64      real VPrecip(klon, klev + 1)      real VPrecip(klon, klev + 1)
65      real ft(klon, klev), fr(klon, klev), fu(klon, klev), fv(klon, klev)      real ft(klon, klev), fr(klon, klev), fu(klon, klev), fv(klon, klev)
66      real upwd(klon, klev), dnwd(klon, klev)      real upwd(klon, klev), dnwd(klon, klev)
     real dnwd0(klon, klev)  
67      real ma(klon, klev)      real ma(klon, klev)
68      real mike(klon, klev)      real mike(klon, klev)
69      real tls(klon, klev), tps(klon, klev)      real tls(klon, klev), tps(klon, klev)
# Line 140  contains Line 154  contains
154              + (gz(il, 2) - gz(il, 1)) / cpn(il, 1)) - 0.5 * lvcp(il, 1) &              + (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 &              * 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 &              * mp(il, 2) * t(il, 1) * b(il, 1) * work(il) + 0.01 * sigd &
157              * wt(il, 1) * (cl - cpd) * water(il, 2) * (t(il, 2) - t(il, 1)) &              * wt(il, 1) * (rcw - rcpd) * water(il, 2) * (t(il, 2) - t(il, 1)) &
158              * work(il) / cpn(il, 1)              * work(il) / cpn(il, 1)
159    
160         !jyg1 Correction pour mieux conserver l'eau (conformite avec CONVECT4.3)         ! jyg Correction pour mieux conserver l'eau (conformite avec CONVECT4.3)
161         ! (sb: pour l'instant, on ne fait que le chgt concernant rg, pas evap)         ! (sb: pour l'instant, on ne fait que le chgt concernant rg, pas evap)
162         fr(il, 1) = 0.01 * rg * mp(il, 2) * (rp(il, 2) - rr(il, 1)) &         fr(il, 1) = 0.01 * rg * mp(il, 2) * (qp(il, 2) - rr(il, 1)) &
163              * work(il) + sigd * 0.5 * (evap(il, 1) + evap(il, 2))              * work(il) + sigd * 0.5 * (evap(il, 1) + evap(il, 2))
164         ! + tard : + sigd * evap(il, 1)         ! + tard : + sigd * evap(il, 1)
165    
# Line 225  contains Line 239  contains
239                       * (mp(il, i + 1) * t(il, i) * b(il, i) - mp(il, i) &                       * (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)) &                       * t(il, i - 1) * cpn(il, i - 1) * cpinv * b(il, i - 1)) &
241                       * dpinv + 0.01 * rg * dpinv * ment(il, i, i) &                       * dpinv + 0.01 * rg * dpinv * ment(il, i, i) &
242                       * (hp(il, i) - h(il, i) + t(il, i) * (cpv - cpd) &                       * (hp(il, i) - h(il, i) + t(il, i) * (rcpv - rcpd) &
243                       * (rr(il, i) - qent(il, i, i))) * cpinv + 0.01 * sigd &                       * (rr(il, i) - qent(il, i, i))) * cpinv + 0.01 * sigd &
244                       * wt(il, i) * (cl - cpd) * water(il, i + 1) &                       * wt(il, i) * (rcw - rcpd) * water(il, i + 1) &
245                       * (t(il, i + 1) - t(il, i)) * dpinv * cpinv                       * (t(il, i + 1) - t(il, i)) * dpinv * cpinv
246                  fr(il, i) = 0.01 * rg * dpinv * (amp1(il) * (rr(il, i + 1) &                  fr(il, i) = 0.01 * rg * dpinv * (amp1(il) * (rr(il, i + 1) &
247                       - rr(il, i)) - ad(il) * (rr(il, i) - rr(il, i - 1)))                       - rr(il, i)) - ad(il) * (rr(il, i) - rr(il, i - 1)))
# Line 288  contains Line 302  contains
302                  ! conserver l'eau:                  ! conserver l'eau:
303                  fr(il, i) = fr(il, i) + 0.5 * sigd * (evap(il, i) &                  fr(il, i) = fr(il, i) + 0.5 * sigd * (evap(il, i) &
304                       + evap(il, i + 1)) + 0.01 * rg * (mp(il, i + 1) &                       + evap(il, i + 1)) + 0.01 * rg * (mp(il, i + 1) &
305                       * (rp(il, i + 1) - rr(il, i)) - mp(il, i) * (rp(il, i) &                       * (qp(il, i + 1) - rr(il, i)) - mp(il, i) * (qp(il, i) &
306                       - rr(il, i - 1))) * dpinv                       - rr(il, i - 1))) * dpinv
307    
308                  fu(il, i) = fu(il, i) + 0.01 * rg * (mp(il, i + 1) &                  fu(il, i) = fu(il, i) + 0.01 * rg * (mp(il, i + 1) &
# Line 334  contains Line 348  contains
348    
349      do il = 1, ncum      do il = 1, ncum
350         ax = 0.1 * ment(il, inb(il), inb(il)) * (hp(il, inb(il)) &         ax = 0.1 * ment(il, inb(il), inb(il)) * (hp(il, inb(il)) &
351              - h(il, inb(il)) + t(il, inb(il)) * (cpv - cpd) &              - h(il, inb(il)) + t(il, inb(il)) * (rcpv - rcpd) &
352              * (rr(il, inb(il)) - qent(il, inb(il), inb(il)))) &              * (rr(il, inb(il)) - qent(il, inb(il), inb(il)))) &
353              / (cpn(il, inb(il)) * (ph(il, inb(il)) - ph(il, inb(il) + 1)))              / (cpn(il, inb(il)) * (ph(il, inb(il)) - ph(il, inb(il) + 1)))
354         ft(il, inb(il)) = ft(il, inb(il)) - ax         ft(il, inb(il)) = ft(il, inb(il)) - ax
# Line 378  contains Line 392  contains
392         do il = 1, ncum         do il = 1, ncum
393            if (i <= (icb(il) - 1)) then            if (i <= (icb(il) - 1)) then
394               asum(il) = asum(il) + ft(il, i) * (ph(il, i) - ph(il, i + 1))               asum(il) = asum(il) + ft(il, i) * (ph(il, i) - ph(il, i + 1))
395               bsum(il) = bsum(il) + fr(il, i) * (lv(il, i) + (cl - cpd) &               bsum(il) = bsum(il) + fr(il, i) * (lv(il, i) + (rcw - rcpd) &
396                    * (t(il, i) - t(il, 1))) * (ph(il, i) - ph(il, i + 1))                    * (t(il, i) - t(il, 1))) * (ph(il, i) - ph(il, i + 1))
397               csum(il) = csum(il) + (lv(il, i) + (cl - cpd) * (t(il, i) &               csum(il) = csum(il) + (lv(il, i) + (rcw - rcpd) * (t(il, i) &
398                    - t(il, 1))) * (ph(il, i) - ph(il, i + 1))                    - 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)) &               dsum(il) = dsum(il) + t(il, i) * (ph(il, i) - ph(il, i + 1)) &
400                    / th(il, i)                    / th(il, i)
# Line 412  contains Line 426  contains
426    
427      do i = 1, nl      do i = 1, nl
428         do il = 1, ncum         do il = 1, ncum
           dnwd0(il, i) = - mp(il, i)  
        enddo  
     enddo  
     do i = nl + 1, klev  
        do il = 1, ncum  
           dnwd0(il, i) = 0.  
        enddo  
     enddo  
   
     do i = 1, nl  
        do il = 1, ncum  
429            if (i >= icb(il) .and. i <= inb(il)) then            if (i >= icb(il) .and. i <= inb(il)) then
430               upwd(il, i) = 0.0               upwd(il, i) = 0.0
431               dnwd(il, i) = 0.0               dnwd(il, i) = 0.0
# Line 511  contains Line 514  contains
514    
515      do i = 1, klev      do i = 1, klev
516         DO il = 1, ncum         DO il = 1, ncum
517            rdcp = (rrd * (1. - rr(il, i)) - rr(il, i) * rrv) &            rdcp = (rd * (1. - rr(il, i)) - rr(il, i) * rv) &
518                 / (cpd * (1. - rr(il, i)) + rr(il, i) * cpv)                 / (rcpd * (1. - rr(il, i)) + rr(il, i) * rcpv)
519            tls(il, i) = t(il, i) * (1000.0 / p(il, i))**rdcp            tls(il, i) = t(il, i) * (1000.0 / p(il, i))**rdcp
520            tps(il, i) = tp(il, i)            tps(il, i) = tp(il, i)
521         end DO         end DO
# Line 544  contains Line 547  contains
547            do il = 1, ncum            do il = 1, ncum
548               if (i >= icb(il) .and. i <= (inb(il) - 1) &               if (i >= icb(il) .and. i <= (inb(il) - 1) &
549                    .and. j >= icb(il)) then                    .and. j >= icb(il)) then
550                  sax(il, i) = sax(il, i) + rrd * (tvp(il, j) - tv(il, j)) &                  sax(il, i) = sax(il, i) + rd * (tvp(il, j) - tv(il, j)) &
551                       * (ph(il, j) - ph(il, j + 1)) / p(il, j)                       * (ph(il, j) - ph(il, j + 1)) / p(il, j)
552               endif               endif
553            enddo            enddo
# Line 562  contains Line 565  contains
565    
566      do i = 1, nl      do i = 1, nl
567         do il = 1, ncum         do il = 1, ncum
568            if (wa(il, i) > 0.0) siga(il, i) = mac(il, i) / wa(il, i) * rrd &            if (wa(il, i) > 0.0) siga(il, i) = mac(il, i) / wa(il, i) * rd &
569                 * tvp(il, i) / p(il, i) / 100. / delta                 * tvp(il, i) / p(il, i) / 100. / delta
570            siga(il, i) = min(siga(il, i), 1.0)            siga(il, i) = min(siga(il, i), 1.0)
571    
Legend:
Removed from v.200  
changed lines
  Added in v.213
  ViewVC Help
Powered by ViewVC 1.1.21