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