/[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 188 by guez, Tue Mar 22 16:31:39 2016 UTC revision 189 by guez, Tue Mar 29 15:20:23 2016 UTC
# Line 4  module cv30_unsat_m Line 4  module cv30_unsat_m
4    
5  contains  contains
6    
7    SUBROUTINE cv30_unsat(icb, inb, t, rr, rs, gz, u, v, p, ph, th, tv, lv, &    SUBROUTINE cv30_unsat(icb, inb, t, q, qs, gz, u, v, p, ph, th, tv, lv, cpn, &
8         cpn, ep, sigp, clw, m, ment, elij, delt, plcl, mp, rp, up, vp, wt, &         ep, sigp, clw, m, ment, elij, delt, plcl, mp, qp, up, vp, wt, water, &
9         water, evap, b)         evap, b)
10    
11      use cv30_param_m, only: nl, sigd      use cv30_param_m, only: nl, sigd
12      use cvthermo, only: cpd, ginv, grav      use cvthermo, only: cpd, ginv, grav
# Line 14  contains Line 14  contains
14    
15      ! inputs:      ! inputs:
16      integer, intent(in):: icb(:), inb(:) ! (ncum)      integer, intent(in):: icb(:), inb(:) ! (ncum)
17      real t(klon, klev), rr(klon, klev), rs(klon, klev)      real, intent(in):: t(:, :), q(:, :), qs(:, :) ! (klon, klev)
18      real gz(klon, klev)      real, intent(in):: gz(:, :) ! (klon, klev)
19      real u(klon, klev), v(klon, klev)      real, intent(in):: u(:, :), v(:, :) ! (klon, klev)
20      real p(klon, klev), ph(klon, klev + 1)      real p(klon, klev), ph(klon, klev + 1)
21      real th(klon, klev)      real th(klon, klev)
22      real tv(klon, klev)      real tv(klon, klev)
# Line 28  contains Line 28  contains
28      real plcl(klon)      real plcl(klon)
29    
30      ! outputs:      ! outputs:
31      real mp(klon, klev), rp(klon, klev), up(klon, klev), vp(klon, klev)      real, intent(out):: mp(klon, klev)
32        real, intent(out):: qp(:, :), up(:, :), vp(:, :) ! (ncum, nl)
33      real wt(klon, klev), water(klon, klev), evap(klon, klev)      real wt(klon, klev), water(klon, klev), evap(klon, klev)
34      real, intent(out):: b(:, :) ! (ncum, nl)      real, intent(out):: b(:, :) ! (ncum, nl - 1)
35    
36      ! Local:      ! Local:
37      integer ncum      integer ncum
# Line 50  contains Line 51  contains
51      delti = 1. / delt      delti = 1. / delt
52      tinv = 1. / 3.      tinv = 1. / 3.
53      mp = 0.      mp = 0.
54        b = 0.
55    
56      do i = 1, nl      do i = 1, nl
57         do il = 1, ncum         do il = 1, ncum
58            mp(il, i) = 0.            qp(il, i) = q(il, i)
           rp(il, i) = rr(il, i)  
59            up(il, i) = u(il, i)            up(il, i) = u(il, i)
60            vp(il, i) = v(il, i)            vp(il, i) = v(il, i)
61            wt(il, i) = 0.001            wt(il, i) = 0.001
62            water(il, i) = 0.            water(il, i) = 0.
63            evap(il, i) = 0.            evap(il, i) = 0.
           b(il, i) = 0.  
64            lvcp(il, i) = lv(il, i) / cpn(il, i)            lvcp(il, i) = lv(il, i) / cpn(il, i)
65         enddo         enddo
66      enddo      enddo
# Line 103  contains Line 103  contains
103            endif            endif
104    
105            ! find rain water and evaporation using provisional            ! find rain water and evaporation using provisional
106            ! estimates of rp(i) and rp(i - 1)            ! estimates of qp(i) and qp(i - 1)
107    
108            do il = 1, ncum            do il = 1, ncum
109               if (i <= inb(il) .and. lwork(il)) then               if (i <= inb(il) .and. lwork(il)) then
110                  wt(il, i) = 45.                  wt(il, i) = 45.
111    
112                  if (i < inb(il)) then                  if (i < inb(il)) then
113                     rp(il, i) = rp(il, i + 1) + (cpd * (t(il, i + 1) &                     qp(il, i) = qp(il, i + 1) + (cpd * (t(il, i + 1) &
114                          - t(il, i)) + gz(il, i + 1) - gz(il, i)) / lv(il, i)                          - t(il, i)) + gz(il, i + 1) - gz(il, i)) / lv(il, i)
115                     rp(il, i) = 0.5 * (rp(il, i) + rr(il, i))                     qp(il, i) = 0.5 * (qp(il, i) + q(il, i))
116                  endif                  endif
117    
118                  rp(il, i) = max(rp(il, i), 0.)                  qp(il, i) = max(qp(il, i), 0.)
119                  rp(il, i) = min(rp(il, i), rs(il, i))                  qp(il, i) = min(qp(il, i), qs(il, i))
120                  rp(il, inb(il)) = rr(il, inb(il))                  qp(il, inb(il)) = q(il, inb(il))
121    
122                  if (i == 1) then                  if (i == 1) then
123                     afac = p(il, 1) * (rs(il, 1) - rp(il, 1)) &                     afac = p(il, 1) * (qs(il, 1) - qp(il, 1)) &
124                          / (1e4 + 2000. * p(il, 1) * rs(il, 1))                          / (1e4 + 2000. * p(il, 1) * qs(il, 1))
125                  else                  else
126                     rp(il, i - 1) = rp(il, i) + (cpd * (t(il, i) &                     qp(il, i - 1) = qp(il, i) + (cpd * (t(il, i) &
127                          - t(il, i - 1)) + gz(il, i) - gz(il, i - 1)) / lv(il, i)                          - t(il, i - 1)) + gz(il, i) - gz(il, i - 1)) / lv(il, i)
128                     rp(il, i - 1) = 0.5 * (rp(il, i - 1) + rr(il, i - 1))                     qp(il, i - 1) = 0.5 * (qp(il, i - 1) + q(il, i - 1))
129                     rp(il, i - 1) = min(rp(il, i - 1), rs(il, i - 1))                     qp(il, i - 1) = min(qp(il, i - 1), qs(il, i - 1))
130                     rp(il, i - 1) = max(rp(il, i - 1), 0.)                     qp(il, i - 1) = max(qp(il, i - 1), 0.)
131                     afac1 = p(il, i) * (rs(il, i) - rp(il, i)) &                     afac1 = p(il, i) * (qs(il, i) - qp(il, i)) &
132                          / (1e4 + 2000. * p(il, i) * rs(il, i))                          / (1e4 + 2000. * p(il, i) * qs(il, i))
133                     afac2 = p(il, i - 1) * (rs(il, i - 1) - rp(il, i - 1)) &                     afac2 = p(il, i - 1) * (qs(il, i - 1) - qp(il, i - 1)) &
134                          / (1e4 + 2000. * p(il, i - 1) * rs(il, i - 1))                          / (1e4 + 2000. * p(il, i - 1) * qs(il, i - 1))
135                     afac = 0.5 * (afac1 + afac2)                     afac = 0.5 * (afac1 + afac2)
136                  endif                  endif
137    
# Line 242  contains Line 242  contains
242                  ! find mixing ratio of precipitating downdraft                  ! find mixing ratio of precipitating downdraft
243    
244                  if (i /= inb(il)) then                  if (i /= inb(il)) then
245                     rp(il, i) = rr(il, i)                     qp(il, i) = q(il, i)
246    
247                     if (mp(il, i) > mp(il, i + 1)) then                     if (mp(il, i) > mp(il, i + 1)) then
248                        rp(il, i) = rp(il, i + 1) * mp(il, i + 1) + rr(il, i) &                        qp(il, i) = qp(il, i + 1) * mp(il, i + 1) + q(il, i) &
249                             * (mp(il, i) - mp(il, i + 1)) + 100. * ginv &                             * (mp(il, i) - mp(il, i + 1)) + 100. * ginv &
250                             * 0.5 * sigd * (ph(il, i) - ph(il, i + 1)) &                             * 0.5 * sigd * (ph(il, i) - ph(il, i + 1)) &
251                             * (evap(il, i + 1) + evap(il, i))                             * (evap(il, i + 1) + evap(il, i))
252                        rp(il, i) = rp(il, i) / mp(il, i)                        qp(il, i) = qp(il, i) / mp(il, i)
253                        up(il, i) = up(il, i + 1) * mp(il, i + 1) + u(il, i) &                        up(il, i) = up(il, i + 1) * mp(il, i + 1) + u(il, i) &
254                             * (mp(il, i) - mp(il, i + 1))                             * (mp(il, i) - mp(il, i + 1))
255                        up(il, i) = up(il, i) / mp(il, i)                        up(il, i) = up(il, i) / mp(il, i)
# Line 258  contains Line 258  contains
258                        vp(il, i) = vp(il, i) / mp(il, i)                        vp(il, i) = vp(il, i) / mp(il, i)
259                     else                     else
260                        if (mp(il, i + 1) > 1e-16) then                        if (mp(il, i + 1) > 1e-16) then
261                           rp(il, i) = rp(il, i + 1) + 100. * ginv * 0.5 * sigd &                           qp(il, i) = qp(il, i + 1) + 100. * ginv * 0.5 * sigd &
262                                * (ph(il, i) - ph(il, i + 1)) &                                * (ph(il, i) - ph(il, i + 1)) &
263                                * (evap(il, i + 1) + evap(il, i)) / mp(il, i + 1)                                * (evap(il, i + 1) + evap(il, i)) / mp(il, i + 1)
264                           up(il, i) = up(il, i + 1)                           up(il, i) = up(il, i + 1)
# Line 266  contains Line 266  contains
266                        endif                        endif
267                     endif                     endif
268    
269                     rp(il, i) = min(rp(il, i), rs(il, i))                     qp(il, i) = min(qp(il, i), qs(il, i))
270                     rp(il, i) = max(rp(il, i), 0.)                     qp(il, i) = max(qp(il, i), 0.)
271                  endif                  endif
272               endif               endif
273            end do            end do
Legend:
Removed from v.188  
changed lines
  Added in v.189
  ViewVC Help
Powered by ViewVC 1.1.21