/[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 192 by guez, Thu May 12 13:00:07 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 cv_thermo_m, only: cpd, ginv, grav
13      USE dimphy, ONLY: klon, klev      USE dimphy, ONLY: klon, klev
14    
15      ! inputs:      integer, intent(in):: icb(:) ! (ncum)
16      integer, intent(in):: icb(:), inb(:) ! (ncum)  
17      real t(klon, klev), rr(klon, klev), rs(klon, klev)      integer, intent(in):: inb(:) ! (ncum)
18      real gz(klon, klev)      ! first model level above the level of neutral buoyancy of the
19      real u(klon, klev), v(klon, klev)      ! parcel (1 <= inb <= nl - 1)
20      real p(klon, klev), ph(klon, klev + 1)  
21      real th(klon, klev)      real, intent(in):: t(:, :), q(:, :), qs(:, :) ! (klon, klev)
22      real tv(klon, klev)      real, intent(in):: gz(:, :) ! (klon, klev)
23      real lv(klon, klev)      real, intent(in):: u(:, :), v(:, :) ! (klon, klev)
24      real cpn(klon, klev)      real, intent(in):: p(klon, klev), ph(klon, klev + 1)
25      real, intent(in):: ep(klon, klev), sigp(klon, klev), clw(klon, klev)      real, intent(in):: th(klon, klev)
26      real m(klon, klev), ment(klon, klev, klev), elij(klon, klev, klev)      real, intent(in):: tv(klon, klev)
27        real, intent(in):: lv(klon, klev)
28        real, intent(in):: cpn(klon, klev)
29        real, intent(in):: ep(:, :), sigp(:, :), clw(:, :) ! (ncum, klev)
30        real, intent(in):: m(:, :) ! (ncum, klev)
31        real, intent(in):: ment(:, :, :) ! (ncum, klev, klev)
32        real, intent(in):: elij(:, :, :) ! (ncum, klev, klev)
33      real, intent(in):: delt      real, intent(in):: delt
34      real plcl(klon)      real, intent(in):: plcl(klon)
35    
36      ! outputs:      ! outputs:
37      real mp(klon, klev), rp(klon, klev), up(klon, klev), vp(klon, klev)      real, intent(out):: mp(klon, klev)
38        real, intent(out):: qp(:, :), up(:, :), vp(:, :) ! (ncum, nl)
39      real wt(klon, klev), water(klon, klev), evap(klon, klev)      real wt(klon, klev), water(klon, klev), evap(klon, klev)
40      real, intent(out):: b(:, :) ! (ncum, nl)      real, intent(out):: b(:, :) ! (ncum, nl - 1)
41    
42      ! Local:      ! Local:
43      integer ncum      integer ncum
# Line 50  contains Line 57  contains
57      delti = 1. / delt      delti = 1. / delt
58      tinv = 1. / 3.      tinv = 1. / 3.
59      mp = 0.      mp = 0.
60        b = 0.
61    
62      do i = 1, nl      do i = 1, nl
63         do il = 1, ncum         do il = 1, ncum
64            mp(il, i) = 0.            qp(il, i) = q(il, i)
           rp(il, i) = rr(il, i)  
65            up(il, i) = u(il, i)            up(il, i) = u(il, i)
66            vp(il, i) = v(il, i)            vp(il, i) = v(il, i)
67            wt(il, i) = 0.001            wt(il, i) = 0.001
68            water(il, i) = 0.            water(il, i) = 0.
69            evap(il, i) = 0.            evap(il, i) = 0.
           b(il, i) = 0.  
70            lvcp(il, i) = lv(il, i) / cpn(il, i)            lvcp(il, i) = lv(il, i) / cpn(il, i)
71         enddo         enddo
72      enddo      enddo
# Line 103  contains Line 109  contains
109            endif            endif
110    
111            ! find rain water and evaporation using provisional            ! find rain water and evaporation using provisional
112            ! estimates of rp(i) and rp(i - 1)            ! estimates of qp(i) and qp(i - 1)
113    
114            do il = 1, ncum            do il = 1, ncum
115               if (i <= inb(il) .and. lwork(il)) then               if (i <= inb(il) .and. lwork(il)) then
116                  wt(il, i) = 45.                  wt(il, i) = 45.
117    
118                  if (i < inb(il)) then                  if (i < inb(il)) then
119                     rp(il, i) = rp(il, i + 1) + (cpd * (t(il, i + 1) &                     qp(il, i) = qp(il, i + 1) + (cpd * (t(il, i + 1) &
120                          - 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)
121                     rp(il, i) = 0.5 * (rp(il, i) + rr(il, i))                     qp(il, i) = 0.5 * (qp(il, i) + q(il, i))
122                  endif                  endif
123    
124                  rp(il, i) = max(rp(il, i), 0.)                  qp(il, i) = max(qp(il, i), 0.)
125                  rp(il, i) = min(rp(il, i), rs(il, i))                  qp(il, i) = min(qp(il, i), qs(il, i))
126                  rp(il, inb(il)) = rr(il, inb(il))                  qp(il, inb(il)) = q(il, inb(il))
127    
128                  if (i == 1) then                  if (i == 1) then
129                     afac = p(il, 1) * (rs(il, 1) - rp(il, 1)) &                     afac = p(il, 1) * (qs(il, 1) - qp(il, 1)) &
130                          / (1e4 + 2000. * p(il, 1) * rs(il, 1))                          / (1e4 + 2000. * p(il, 1) * qs(il, 1))
131                  else                  else
132                     rp(il, i - 1) = rp(il, i) + (cpd * (t(il, i) &                     qp(il, i - 1) = qp(il, i) + (cpd * (t(il, i) &
133                          - 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)
134                     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))
135                     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))
136                     rp(il, i - 1) = max(rp(il, i - 1), 0.)                     qp(il, i - 1) = max(qp(il, i - 1), 0.)
137                     afac1 = p(il, i) * (rs(il, i) - rp(il, i)) &                     afac1 = p(il, i) * (qs(il, i) - qp(il, i)) &
138                          / (1e4 + 2000. * p(il, i) * rs(il, i))                          / (1e4 + 2000. * p(il, i) * qs(il, i))
139                     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)) &
140                          / (1e4 + 2000. * p(il, i - 1) * rs(il, i - 1))                          / (1e4 + 2000. * p(il, i - 1) * qs(il, i - 1))
141                     afac = 0.5 * (afac1 + afac2)                     afac = 0.5 * (afac1 + afac2)
142                  endif                  endif
143    
# Line 242  contains Line 248  contains
248                  ! find mixing ratio of precipitating downdraft                  ! find mixing ratio of precipitating downdraft
249    
250                  if (i /= inb(il)) then                  if (i /= inb(il)) then
251                     rp(il, i) = rr(il, i)                     qp(il, i) = q(il, i)
252    
253                     if (mp(il, i) > mp(il, i + 1)) then                     if (mp(il, i) > mp(il, i + 1)) then
254                        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) &
255                             * (mp(il, i) - mp(il, i + 1)) + 100. * ginv &                             * (mp(il, i) - mp(il, i + 1)) + 100. * ginv &
256                             * 0.5 * sigd * (ph(il, i) - ph(il, i + 1)) &                             * 0.5 * sigd * (ph(il, i) - ph(il, i + 1)) &
257                             * (evap(il, i + 1) + evap(il, i))                             * (evap(il, i + 1) + evap(il, i))
258                        rp(il, i) = rp(il, i) / mp(il, i)                        qp(il, i) = qp(il, i) / mp(il, i)
259                        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) &
260                             * (mp(il, i) - mp(il, i + 1))                             * (mp(il, i) - mp(il, i + 1))
261                        up(il, i) = up(il, i) / mp(il, i)                        up(il, i) = up(il, i) / mp(il, i)
# Line 258  contains Line 264  contains
264                        vp(il, i) = vp(il, i) / mp(il, i)                        vp(il, i) = vp(il, i) / mp(il, i)
265                     else                     else
266                        if (mp(il, i + 1) > 1e-16) then                        if (mp(il, i + 1) > 1e-16) then
267                           rp(il, i) = rp(il, i + 1) + 100. * ginv * 0.5 * sigd &                           qp(il, i) = qp(il, i + 1) + 100. * ginv * 0.5 * sigd &
268                                * (ph(il, i) - ph(il, i + 1)) &                                * (ph(il, i) - ph(il, i + 1)) &
269                                * (evap(il, i + 1) + evap(il, i)) / mp(il, i + 1)                                * (evap(il, i + 1) + evap(il, i)) / mp(il, i + 1)
270                           up(il, i) = up(il, i + 1)                           up(il, i) = up(il, i + 1)
# Line 266  contains Line 272  contains
272                        endif                        endif
273                     endif                     endif
274    
275                     rp(il, i) = min(rp(il, i), rs(il, i))                     qp(il, i) = min(qp(il, i), qs(il, i))
276                     rp(il, i) = max(rp(il, i), 0.)                     qp(il, i) = max(qp(il, i), 0.)
277                  endif                  endif
278               endif               endif
279            end do            end do
Legend:
Removed from v.188  
changed lines
  Added in v.192
  ViewVC Help
Powered by ViewVC 1.1.21