/[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 190 by guez, Thu Apr 14 15:15:56 2016 UTC trunk/phylmd/CV30_routines/cv30_undilute2.f90 revision 332 by guez, Tue Aug 13 09:19:22 2019 UTC
# Line 4  module cv30_undilute2_m Line 4  module cv30_undilute2_m
4    
5  contains  contains
6    
7    SUBROUTINE cv30_undilute2(ncum, icb, icbs, nk, tnk, qnk, gznk, t, qs, gz, &    SUBROUTINE cv30_undilute2(icb, icbs, tnk, qnk, gznk, t, qs, gz, p, h, tv, &
8         p, h, tv, lv, pbase, buoybase, plcl, inb, tp, tvp, clw, hp, ep, sigp, &         lv, pbase, buoybase, plcl, inb, tp, tvp, clw, hp, ep, buoy)
        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 15  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: dtovsh, minorig, nl, pbcrit, ptcrit, spfac      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):: ncum      integer, intent(in):: icb(:) ! (ncum) {2 <= icb <= nl - 3}
24    
25      integer, intent(in):: icb(klon), icbs(klon)      integer, intent(in):: icbs(:) ! (ncum)
26      ! icbs is the first level above LCL (may differ from icb)      ! icbs is the first level above LCL (may differ from icb)
27    
28      integer, intent(in):: nk(klon)      real, intent(in):: tnk(:), qnk(:), gznk(:) ! (klon)
     real, intent(in):: tnk(klon), qnk(klon), gznk(klon)  
29      real, intent(in):: t(klon, klev), qs(klon, klev), gz(klon, klev)      real, intent(in):: t(klon, klev), qs(klon, klev), gz(klon, klev)
30      real, intent(in):: p(klon, klev), h(klon, klev)      real, intent(in):: p(klon, klev), h(klon, klev)
31      real, intent(in):: tv(klon, klev), lv(klon, klev)      real, intent(in):: tv(klon, klev)
32      real, intent(in):: pbase(klon), buoybase(klon), plcl(klon)      real, intent(in):: lv(:, :) ! (ncum, nl)
33        real, intent(in):: pbase(:), buoybase(:), plcl(:) ! (ncum)
34    
35      ! outputs:      ! outputs:
36      integer, intent(out):: inb(:) ! (ncum)      integer, intent(out):: inb(:) ! (ncum)
37      ! first model level above the level of neutral buoyancy of the      ! first model level above the level of neutral buoyancy of the
38      ! parcel (<= nl - 1)      ! parcel (1 <= inb <= nl - 1)
39    
40      real tp(klon, klev), tvp(klon, klev), clw(klon, klev)      real tp(klon, klev), tvp(klon, klev), clw(klon, klev)
41      ! condensed water not removed from tvp      ! condensed water not removed from tvp
42      real hp(klon, klev), ep(klon, klev), sigp(klon, klev)      real hp(klon, klev), ep(klon, klev)
43      real buoy(klon, klev)      real buoy(klon, klev)
44    
45      ! Local:      ! Local:
46    
47        integer ncum
48    
49        real, parameter:: pbcrit = 150.
50        ! critical cloud depth (mbar) beneath which the precipitation
51        ! efficiency is assumed to be zero
52    
53        real, parameter:: ptcrit = 500.
54        ! cloud depth (mbar) above which the precipitation efficiency is
55        ! assumed to be unity
56    
57        real, parameter:: dtovsh = - 0.2 ! dT for overshoot
58    
59      integer i, k      integer i, k
60      real tg, qg, ahg, alv, s, tc, es, denom      real tg, qg, ahg, alv, s, tc, es, denom
61      real pden      real pden
# Line 50  contains Line 63  contains
63    
64      !---------------------------------------------------------------------      !---------------------------------------------------------------------
65    
66        ncum = size(icb)
67    
68      ! SOME INITIALIZATIONS      ! SOME INITIALIZATIONS
69    
70      do k = 1, nl      do k = 1, nl
71         do i = 1, ncum         do i = 1, ncum
72            ep(i, k) = 0.0            ep(i, k) = 0.
           sigp(i, k) = spfac  
73         end do         end do
74      end do      end do
75    
# Line 67  contains Line 81  contains
81      ! Calculate certain parcel quantities, including static energy      ! Calculate certain parcel quantities, including static energy
82    
83      do i = 1, ncum      do i = 1, ncum
84         ah0(i) = (cpd * (1. - qnk(i)) + cl * qnk(i)) * tnk(i) &         ah0(i) = (rcpd * (1. - qnk(i)) + rcw * qnk(i)) * tnk(i) &
85              + qnk(i) * (lv0 - clmcpv * (tnk(i) - 273.15)) + gznk(i)              + qnk(i) * (rlvtt - clmcpv * (tnk(i) - 273.15)) + gznk(i)
86      end do      end do
87    
88      ! Find lifted parcel quantities above cloud base      ! Find lifted parcel quantities above cloud base
# Line 78  contains Line 92  contains
92            if (k >= (icbs(i) + 1)) then            if (k >= (icbs(i) + 1)) then
93               tg = t(i, k)               tg = t(i, k)
94               qg = qs(i, k)               qg = qs(i, k)
95               alv = lv0 - clmcpv * (t(i, k) - 273.15)               alv = rlvtt - clmcpv * (t(i, k) - 273.15)
96    
97               ! First iteration.               ! First iteration.
98    
99               s = cpd * (1. - qnk(i)) + cl * qnk(i) &               s = rcpd * (1. - qnk(i)) + rcw * qnk(i) &
100                    + alv * alv * qg / (rrv * t(i, k) * t(i, k))                    + alv * alv * qg / (rv * t(i, k) * t(i, k))
101               s = 1. / s               s = 1. / s
102    
103               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)
104               tg = tg + s * (ah0(i) - ahg)               tg = tg + s * (ah0(i) - ahg)
105    
106               tc = tg - 273.15               tc = tg - 273.15
107               denom = 243.5 + tc               denom = 243.5 + tc
108               denom = MAX(denom, 1.0)               denom = MAX(denom, 1.)
109    
110               es = 6.112 * exp(17.67 * tc / denom)               es = 6.112 * exp(17.67 * tc / denom)
111    
# Line 99  contains Line 113  contains
113    
114               ! Second iteration.               ! Second iteration.
115    
116               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)
117               tg = tg + s * (ah0(i) - ahg)               tg = tg + s * (ah0(i) - ahg)
118    
119               tc = tg - 273.15               tc = tg - 273.15
120               denom = 243.5 + tc               denom = 243.5 + tc
121               denom = MAX(denom, 1.0)               denom = MAX(denom, 1.)
122    
123               es = 6.112 * exp(17.67 * tc / denom)               es = 6.112 * exp(17.67 * tc / denom)
124    
125               qg = eps * es / (p(i, k) - es * (1. - eps))               qg = eps * es / (p(i, k) - es * (1. - eps))
126    
127               alv = lv0 - clmcpv * (t(i, k) - 273.15)               alv = rlvtt - clmcpv * (t(i, k) - 273.15)
128    
129               ! no approximation:               ! no approximation:
130               tp(i, k) = (ah0(i) - gz(i, k) - alv * qg) &               tp(i, k) = (ah0(i) - gz(i, k) - alv * qg) &
131                    / (cpd + (cl - cpd) * qnk(i))                    / (rcpd + (rcw - rcpd) * qnk(i))
132    
133               clw(i, k) = qnk(i) - qg               clw(i, k) = qnk(i) - qg
134               clw(i, k) = max(0.0, clw(i, k))               clw(i, k) = max(0., clw(i, k))
135               ! qg utilise au lieu du vrai mixing ratio rg:               ! qg utilise au lieu du vrai mixing ratio rg:
136               tvp(i, k) = tp(i, k) * (1. + qg / eps - qnk(i)) ! whole thing               tvp(i, k) = tp(i, k) * (1. + qg / eps - qnk(i)) ! whole thing
137            endif            endif
138         end do         end do
139      end do      end do
140    
141      ! SET THE PRECIPITATION EFFICIENCIES AND THE FRACTION OF      ! SET THE PRECIPITATION EFFICIENCIES
142      ! PRECIPITATION FALLING OUTSIDE OF CLOUD      ! It MAY BE a FUNCTION OF TP(I), P(I) AND CLW(I)
     ! THESE MAY BE FUNCTIONS OF TP(I), P(I) AND CLW(I)  
143      do k = 1, nl      do k = 1, nl
144         do i = 1, ncum         do i = 1, ncum
145            pden = ptcrit - pbcrit            pden = ptcrit - pbcrit
146            ep(i, k) = (plcl(i) - p(i, k) - pbcrit) / pden * epmax            ep(i, k) = (plcl(i) - p(i, k) - pbcrit) / pden * epmax
147            ep(i, k) = amax1(ep(i, k), 0.0)            ep(i, k) = max(ep(i, k), 0.)
148            ep(i, k) = amin1(ep(i, k), epmax)            ep(i, k) = min(ep(i, k), epmax)
           sigp(i, k) = spfac  
149         end do         end do
150      end do      end do
151    
# Line 188  contains Line 200  contains
200    
201      do k = minorig + 1, nl      do k = minorig + 1, nl
202         do i = 1, ncum         do i = 1, ncum
203            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) &
204                 + (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)
205         end do         end do
206      end do      end do
207    
Legend:
Removed from v.190  
changed lines
  Added in v.332
  ViewVC Help
Powered by ViewVC 1.1.21