/[lmdze]/trunk/phylmd/CV30_routines/cv30_undilute2.f90
ViewVC logotype

Diff of /trunk/phylmd/CV30_routines/cv30_undilute2.f90

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

trunk/Sources/phylmd/CV30_routines/cv30_undilute2.f revision 196 by guez, Mon May 23 13:50:39 2016 UTC trunk/phylmd/CV30_routines/cv30_undilute2.f revision 311 by guez, Mon Dec 3 17:52:21 2018 UTC
# Line 4  module cv30_undilute2_m Line 4  module cv30_undilute2_m
4    
5  contains  contains
6    
7    SUBROUTINE cv30_undilute2(icb, icbs, nk, tnk, qnk, gznk, t, qs, gz, p, h, &    SUBROUTINE cv30_undilute2(icb, icbs, tnk, qnk, gznk, t, qs, gz, p, h, tv, &
8         tv, lv, pbase, buoybase, plcl, inb, tp, tvp, clw, hp, ep, buoy)         lv, pbase, buoybase, plcl, inb, tp, tvp, clw, hp, ep, buoy)
9    
10      ! Undilute (adiabatic) updraft, second part. Purpose: find the      ! Undilute (adiabatic) updraft, second part. Purpose: find the
11      ! rest of the lifted parcel temperatures; compute the      ! rest of the lifted parcel temperatures; compute the
# Line 14  contains Line 14  contains
14    
15      ! Vertical profile of buoyancy computed here (use of buoybase).      ! Vertical profile of buoyancy computed here (use of buoybase).
16    
17      use conema3_m, only: epmax      use conf_phys_m, only: epmax
18      use cv30_param_m, only: minorig, nl      use cv30_param_m, only: minorig, nl
19      use cv_thermo_m, only: cl, clmcpv, cpd, cpv, eps, lv0, rrv      use cv_thermo, only: clmcpv, eps
20      USE dimphy, ONLY: klon, klev      USE dimphy, ONLY: klon, klev
21        use SUPHEC_M, only: rcw, rlvtt, rcpd, rcpv, rv
22    
23      integer, intent(in):: icb(:), icbs(:) ! (ncum)      integer, intent(in):: icb(:), icbs(:) ! (ncum)
24      ! icbs is the first level above LCL (may differ from icb)      ! icbs is the first level above LCL (may differ from icb)
25    
26      integer, intent(in):: nk(klon)      real, intent(in):: tnk(:), qnk(:), gznk(:) ! (klon)
     real, intent(in):: tnk(klon), qnk(klon), gznk(klon)  
27      real, intent(in):: t(klon, klev), qs(klon, klev), gz(klon, klev)      real, intent(in):: t(klon, klev), qs(klon, klev), gz(klon, klev)
28      real, intent(in):: p(klon, klev), h(klon, klev)      real, intent(in):: p(klon, klev), h(klon, klev)
29      real, intent(in):: tv(klon, klev), lv(klon, klev)      real, intent(in):: tv(klon, klev)
30        real, intent(in):: lv(:, :) ! (ncum, nl)
31      real, intent(in):: pbase(:), buoybase(:), plcl(:) ! (ncum)      real, intent(in):: pbase(:), buoybase(:), plcl(:) ! (ncum)
32    
33      ! outputs:      ! outputs:
# Line 78  contains Line 79  contains
79      ! Calculate certain parcel quantities, including static energy      ! Calculate certain parcel quantities, including static energy
80    
81      do i = 1, ncum      do i = 1, ncum
82         ah0(i) = (cpd * (1. - qnk(i)) + cl * qnk(i)) * tnk(i) &         ah0(i) = (rcpd * (1. - qnk(i)) + rcw * qnk(i)) * tnk(i) &
83              + qnk(i) * (lv0 - clmcpv * (tnk(i) - 273.15)) + gznk(i)              + qnk(i) * (rlvtt - clmcpv * (tnk(i) - 273.15)) + gznk(i)
84      end do      end do
85    
86      ! Find lifted parcel quantities above cloud base      ! Find lifted parcel quantities above cloud base
# Line 89  contains Line 90  contains
90            if (k >= (icbs(i) + 1)) then            if (k >= (icbs(i) + 1)) then
91               tg = t(i, k)               tg = t(i, k)
92               qg = qs(i, k)               qg = qs(i, k)
93               alv = lv0 - clmcpv * (t(i, k) - 273.15)               alv = rlvtt - clmcpv * (t(i, k) - 273.15)
94    
95               ! First iteration.               ! First iteration.
96    
97               s = cpd * (1. - qnk(i)) + cl * qnk(i) &               s = rcpd * (1. - qnk(i)) + rcw * qnk(i) &
98                    + alv * alv * qg / (rrv * t(i, k) * t(i, k))                    + alv * alv * qg / (rv * t(i, k) * t(i, k))
99               s = 1. / s               s = 1. / s
100    
101               ahg = cpd * tg + (cl - cpd) * qnk(i) * tg + alv * qg + gz(i, k)               ahg = rcpd * tg + (rcw - rcpd) * qnk(i) * tg + alv * qg + gz(i, k)
102               tg = tg + s * (ah0(i) - ahg)               tg = tg + s * (ah0(i) - ahg)
103    
104               tc = tg - 273.15               tc = tg - 273.15
# Line 110  contains Line 111  contains
111    
112               ! Second iteration.               ! Second iteration.
113    
114               ahg = cpd * tg + (cl - cpd) * qnk(i) * tg + alv * qg + gz(i, k)               ahg = rcpd * tg + (rcw - rcpd) * qnk(i) * tg + alv * qg + gz(i, k)
115               tg = tg + s * (ah0(i) - ahg)               tg = tg + s * (ah0(i) - ahg)
116    
117               tc = tg - 273.15               tc = tg - 273.15
# Line 121  contains Line 122  contains
122    
123               qg = eps * es / (p(i, k) - es * (1. - eps))               qg = eps * es / (p(i, k) - es * (1. - eps))
124    
125               alv = lv0 - clmcpv * (t(i, k) - 273.15)               alv = rlvtt - clmcpv * (t(i, k) - 273.15)
126    
127               ! no approximation:               ! no approximation:
128               tp(i, k) = (ah0(i) - gz(i, k) - alv * qg) &               tp(i, k) = (ah0(i) - gz(i, k) - alv * qg) &
129                    / (cpd + (cl - cpd) * qnk(i))                    / (rcpd + (rcw - rcpd) * qnk(i))
130    
131               clw(i, k) = qnk(i) - qg               clw(i, k) = qnk(i) - qg
132               clw(i, k) = max(0., clw(i, k))               clw(i, k) = max(0., clw(i, k))
# Line 197  contains Line 198  contains
198    
199      do k = minorig + 1, nl      do k = minorig + 1, nl
200         do i = 1, ncum         do i = 1, ncum
201            if (k >= icb(i) .and. k <= inb(i)) hp(i, k) = h(i, nk(i)) &            if (k >= icb(i) .and. k <= inb(i)) hp(i, k) = h(i, minorig) &
202                 + (lv(i, k) + (cpd - cpv) * t(i, k)) * ep(i, k) * clw(i, k)                 + (lv(i, k) + (rcpd - rcpv) * t(i, k)) * ep(i, k) * clw(i, k)
203         end do         end do
204      end do      end do
205    
Legend:
Removed from v.196  
changed lines
  Added in v.311
  ViewVC Help
Powered by ViewVC 1.1.21