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

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

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

revision 193 by guez, Thu May 12 13:22:19 2016 UTC revision 197 by guez, Tue May 24 12:25:29 2016 UTC
# Line 5  module cv30_unsat_m Line 5  module cv30_unsat_m
5  contains  contains
6    
7    SUBROUTINE cv30_unsat(icb, inb, t, q, qs, gz, u, v, p, ph, th, tv, lv, cpn, &    SUBROUTINE cv30_unsat(icb, inb, t, q, qs, gz, u, v, p, ph, th, tv, lv, cpn, &
8         ep, sigp, clw, m, ment, elij, delt, plcl, mp, qp, up, vp, wt, water, &         ep, clw, m, ment, elij, delt, plcl, mp, qp, up, vp, wt, water, evap, b)
9         evap, b)  
10        ! Unsaturated (precipitating) downdrafts
11    
12      use cv30_param_m, only: nl, sigd      use cv30_param_m, only: nl, sigd
13      use cv_thermo_m, only: cpd, ginv, grav      use cv_thermo_m, only: cpd, ginv, grav
     USE dimphy, ONLY: klon, klev  
14    
15      integer, intent(in):: icb(:) ! (ncum)      integer, intent(in):: icb(:) ! (ncum)
16        ! {2 <= icb <= nl - 3}
17    
18      integer, intent(in):: inb(:) ! (ncum)      integer, intent(in):: inb(:) ! (ncum)
19      ! first model level above the level of neutral buoyancy of the      ! first model level above the level of neutral buoyancy of the
20      ! parcel (1 <= inb <= nl - 1)      ! parcel (1 <= inb <= nl - 1)
21    
22      real, intent(in):: t(:, :), q(:, :), qs(:, :) ! (klon, klev)      real, intent(in):: t(:, :), q(:, :), qs(:, :) ! (ncum, nl)
23      real, intent(in):: gz(:, :) ! (klon, klev)      real, intent(in):: gz(:, :) ! (klon, klev)
24      real, intent(in):: u(:, :), v(:, :) ! (klon, klev)      real, intent(in):: u(:, :), v(:, :) ! (klon, klev)
25      real, intent(in):: p(klon, klev), ph(klon, klev + 1)      real, intent(in):: p(:, :) ! (klon, klev) pressure at full level, in hPa
26      real, intent(in):: th(klon, klev)      real, intent(in):: ph(:, :) ! (ncum, klev + 1)
27      real, intent(in):: tv(klon, klev)      real, intent(in):: th(:, :) ! (ncum, nl - 1)
28      real, intent(in):: lv(klon, klev)      real, intent(in):: tv(:, :) ! (klon, klev)
29      real, intent(in):: cpn(klon, klev)      real, intent(in):: lv(:, :) ! (klon, klev)
30      real, intent(in):: ep(:, :), sigp(:, :), clw(:, :) ! (ncum, klev)      real, intent(in):: cpn(:, :) ! (klon, klev)
31        real, intent(in):: ep(:, :) ! (ncum, klev)
32        real, intent(in):: clw(:, :) ! (ncum, klev)
33      real, intent(in):: m(:, :) ! (ncum, klev)      real, intent(in):: m(:, :) ! (ncum, klev)
34      real, intent(in):: ment(:, :, :) ! (ncum, klev, klev)      real, intent(in):: ment(:, :, :) ! (ncum, klev, klev)
35      real, intent(in):: elij(:, :, :) ! (ncum, klev, klev)      real, intent(in):: elij(:, :, :) ! (ncum, klev, klev)
36      real, intent(in):: delt      real, intent(in):: delt
37      real, intent(in):: plcl(klon)      real, intent(in):: plcl(:) ! (ncum)
38    
39      ! outputs:      real, intent(out):: mp(:, :) ! (klon, klev)
     real, intent(out):: mp(klon, klev)  
40      real, intent(out):: qp(:, :), up(:, :), vp(:, :) ! (ncum, nl)      real, intent(out):: qp(:, :), up(:, :), vp(:, :) ! (ncum, nl)
41      real wt(klon, klev), water(klon, klev), evap(klon, klev)      real, intent(out):: wt(:, :) ! (ncum, nl)
42        real, intent(out):: water(:, :), evap(:, :) ! (ncum, nl)
43      real, intent(out):: b(:, :) ! (ncum, nl - 1)      real, intent(out):: b(:, :) ! (ncum, nl - 1)
44    
45      ! Local:      ! Local:
46    
47        real, parameter:: sigp = 0.15
48        ! fraction of precipitation falling outside of cloud, \sig_s in
49        ! Emanuel (1991 928)
50    
51      integer ncum      integer ncum
52      integer i, j, il, imax      integer i, il, imax
53      real tinv, delti      real tinv, delti
54      real awat, afac, afac1, afac2, bfac      real afac, afac1, afac2, bfac
55      real pr1, pr2, sigt, b6, c6, revap, tevap, delth      real pr1, sigt, b6, c6, revap, tevap, delth
56      real amfac, amp2, xf, tf, fac2, ur, sru, fac, d, af, bf      real amfac, amp2, xf, tf, fac2, ur, sru, fac, d, af, bf
57      real ampmax      real ampmax
58      real lvcp(klon, klev)      real lvcp(size(icb), nl) ! (ncum, nl)
59      real wdtrain(size(icb)) ! (ncum)      real wdtrain(size(icb)) ! (ncum)
60      logical lwork(size(icb)) ! (ncum)      logical lwork(size(icb)) ! (ncum)
61    
# Line 86  contains Line 94  contains
94         ! and condensed water flux         ! and condensed water flux
95    
96         ! Calculate detrained precipitation         ! Calculate detrained precipitation
97           forall (il = 1:ncum, inb(il) >= i .and. lwork(il)) wdtrain(il) = grav &
98         do il = 1, ncum              * (ep(il, i) * m(il, i) * clw(il, i) &
99            if (i <= inb(il) .and. lwork(il)) then              + sum(max(elij(il, :i - 1, i) - (1. - ep(il, i)) * clw(il, i), 0.) &
100               wdtrain(il) = grav * ep(il, i) * m(il, i) * clw(il, i)              * ment(il, :i - 1, i)))
           endif  
        enddo  
   
        if (i > 1) then  
           do j = 1, i - 1  
              do il = 1, ncum  
                 if (i <= inb(il) .and. lwork(il)) then  
                    awat = elij(il, j, i) - (1. - ep(il, i)) * clw(il, i)  
                    awat = max(awat, 0.)  
                    wdtrain(il) = wdtrain(il) + grav * awat * ment(il, j, i)  
                 endif  
              enddo  
           end do  
        endif  
101    
102         ! Find rain water and evaporation using provisional         ! Find rain water and evaporation using provisional
103         ! estimates of qp(i) and qp(i - 1)         ! estimates of qp(i) and qp(i - 1)
104    
105         do il = 1, ncum         loop_horizontal: do il = 1, ncum
106            if (i <= inb(il) .and. lwork(il)) then            if (i <= inb(il) .and. lwork(il)) then
107               wt(il, i) = 45.               wt(il, i) = 45.
108    
# Line 142  contains Line 136  contains
136               afac = max(afac, 0.)               afac = max(afac, 0.)
137               bfac = 1. / (sigd * wt(il, i))               bfac = 1. / (sigd * wt(il, i))
138    
139               ! Prise en compte de la variation progressive de sigt dans               if (i <= icb(il)) then
140               ! les couches icb et icb - 1:                  ! Prise en compte de la variation progressive de sigt dans
141               ! pour plcl < ph(i + 1), pr1 = 0 et pr2 = 1                  ! les couches icb et icb - 1 :
142               ! pour plcl > ph(i), pr1 = 1 et pr2 = 0                  ! pour plcl <= ph(i + 1), pr1 = 0
143               ! pour ph(i + 1) < plcl < ph(i), pr1 est la proportion \`a cheval                  ! pour plcl >= ph(i), pr1 = 1
144               ! sur le nuage, et pr2 est la proportion sous la base du                  ! pour ph(i + 1) < plcl < ph(i), pr1 est la proportion
145               ! nuage.                  ! \`a cheval sur le nuage.
146               pr1 = (plcl(il) - ph(il, i + 1)) / (ph(il, i) - ph(il, i + 1))                  pr1 = max(0., min(1., &
147               pr1 = max(0., min(1., pr1))                       (plcl(il) - ph(il, i + 1)) / (ph(il, i) - ph(il, i + 1))))
148               pr2 = (ph(il, i) - plcl(il)) / (ph(il, i) - ph(il, i + 1))                  sigt = sigp * pr1 + 1. - pr1
149               pr2 = max(0., min(1., pr2))               else
150               sigt = sigp(il, i) * pr1 + pr2                  ! {i >= icb(il) + 1}
151                    sigt = sigp
152                 end if
153    
154               b6 = bfac * 50. * sigd * (ph(il, i) - ph(il, i + 1)) * sigt * afac               b6 = bfac * 50. * sigd * (ph(il, i) - ph(il, i + 1)) * sigt * afac
155               c6 = water(il, i + 1) + bfac * wdtrain(il) - 50. * sigd * bfac &               c6 = water(il, i + 1) + bfac * wdtrain(il) - 50. * sigd * bfac &
156                    * (ph(il, i) - ph(il, i + 1)) * evap(il, i + 1)                    * (ph(il, i) - ph(il, i + 1)) * evap(il, i + 1)
157    
158               if (c6 > 0.) then               if (c6 > 0.) then
159                  revap = 0.5 * (- b6 + sqrt(b6 * b6 + 4. * c6))                  revap = 0.5 * (- b6 + sqrt(b6 * b6 + 4. * c6))
160                  evap(il, i) = sigt * afac * revap                  evap(il, i) = sigt * afac * revap
# Line 270  contains Line 267  contains
267                  qp(il, i) = max(qp(il, i), 0.)                  qp(il, i) = max(qp(il, i), 0.)
268               endif               endif
269            endif            endif
270         end do         end do loop_horizontal
271      end DO downdraft_loop      end DO downdraft_loop
272    
273    end SUBROUTINE cv30_unsat    end SUBROUTINE cv30_unsat
Legend:
Removed from v.193  
changed lines
  Added in v.197
  ViewVC Help
Powered by ViewVC 1.1.21