/[lmdze]/trunk/Sources/phylmd/CV30_routines/cv30_undilute2.f
ViewVC logotype

Diff of /trunk/Sources/phylmd/CV30_routines/cv30_undilute2.f

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

trunk/Sources/phylmd/CV3_routines/cv3_undilute2.f revision 183 by guez, Wed Mar 16 14:42:58 2016 UTC trunk/Sources/phylmd/CV30_routines/cv30_undilute2.f revision 195 by guez, Wed May 18 17:56:44 2016 UTC
# Line 1  Line 1 
1  module cv3_undilute2_m  module cv30_undilute2_m
2    
3    implicit none    implicit none
4    
5  contains  contains
6    
7    SUBROUTINE cv3_undilute2(nloc, ncum, nd, icb, icbs, nk, tnk, qnk, gznk, t, &    SUBROUTINE cv30_undilute2(icb, icbs, nk, tnk, qnk, gznk, t, qs, gz, p, h, &
8         qs, gz, p, h, tv, lv, pbase, buoybase, plcl, inb, tp, tvp, clw, hp, &         tv, lv, pbase, buoybase, plcl, inb, tp, tvp, clw, hp, ep, buoy)
9         ep, sigp, buoy)  
10        ! Undilute (adiabatic) updraft, second part. Purpose: find the
11      ! Purpose: find the rest of the lifted parcel temperatures;      ! rest of the lifted parcel temperatures; compute the
12      ! compute the precipitation efficiencies and the fraction of      ! precipitation efficiencies and the fraction of precipitation
13      ! precipitation falling outside of cloud; find the level of      ! falling outside of cloud; find the level of neutral buoyancy.
     ! neutral buoyancy.  
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 conema3_m, only: epmax
18      use cv3_param_m, only: dtovsh, minorig, nl, nlp, pbcrit, ptcrit, spfac      use cv30_param_m, only: minorig, nl
19      use cvthermo, only: cl, clmcpv, cpd, cpv, eps, lv0, rrv      use cv_thermo_m, only: cl, clmcpv, cpd, cpv, eps, lv0, rrv
20        USE dimphy, ONLY: klon, klev
21      ! inputs:  
22      integer, intent(in):: nloc, ncum, nd      integer, intent(in):: icb(:), icbs(:) ! (ncum)
23      integer icb(nloc), icbs(nloc), nk(nloc)      ! icbs is the first level above LCL (may differ from icb)
24      ! icbs (input) is the first level above LCL (may differ from icb)  
25      real tnk(nloc), qnk(nloc), gznk(nloc)      integer, intent(in):: nk(klon)
26      real t(nloc, nd), qs(nloc, nd), gz(nloc, nd)      real, intent(in):: tnk(klon), qnk(klon), gznk(klon)
27      real p(nloc, nd), h(nloc, nd)      real, intent(in):: t(klon, klev), qs(klon, klev), gz(klon, klev)
28      real tv(nloc, nd), lv(nloc, nd)      real, intent(in):: p(klon, klev), h(klon, klev)
29      real pbase(nloc), buoybase(nloc), plcl(nloc)      real, intent(in):: tv(klon, klev), lv(klon, klev)
30        real, intent(in):: pbase(klon), buoybase(klon), plcl(klon)
31    
32      ! outputs:      ! outputs:
33      integer inb(nloc)      integer, intent(out):: inb(:) ! (ncum)
34      real tp(nloc, nd), tvp(nloc, nd), clw(nloc, nd)      ! first model level above the level of neutral buoyancy of the
35        ! parcel (1 <= inb <= nl - 1)
36    
37        real tp(klon, klev), tvp(klon, klev), clw(klon, klev)
38      ! condensed water not removed from tvp      ! condensed water not removed from tvp
39      real hp(nloc, nd), ep(nloc, nd), sigp(nloc, nd)      real hp(klon, klev), ep(klon, klev)
40      real buoy(nloc, nd)      real buoy(klon, klev)
41    
42      ! Local:      ! Local:
43    
44        integer ncum
45    
46        real, parameter:: pbcrit = 150.
47        ! critical cloud depth (mbar) beneath which the precipitation
48        ! efficiency is assumed to be zero
49    
50        real, parameter:: ptcrit = 500.
51        ! cloud depth (mbar) above which the precipitation efficiency is
52        ! assumed to be unity
53    
54        real, parameter:: dtovsh = - 0.2 ! dT for overshoot
55    
56      integer i, k      integer i, k
57      real tg, qg, ahg, alv, s, tc, es, denom      real tg, qg, ahg, alv, s, tc, es, denom
58      real pden      real pden
59      real ah0(nloc)      real ah0(klon)
60    
61      !---------------------------------------------------------------------      !---------------------------------------------------------------------
62    
63        ncum = size(icb)
64    
65      ! SOME INITIALIZATIONS      ! SOME INITIALIZATIONS
66    
67      do k = 1, nl      do k = 1, nl
68         do i = 1, ncum         do i = 1, ncum
69            ep(i, k) = 0.0            ep(i, k) = 0.
           sigp(i, k) = spfac  
70         end do         end do
71      end do      end do
72    
# Line 85  contains Line 102  contains
102    
103               tc = tg - 273.15               tc = tg - 273.15
104               denom = 243.5 + tc               denom = 243.5 + tc
105               denom = MAX(denom, 1.0)               denom = MAX(denom, 1.)
106    
107               es = 6.112 * exp(17.67 * tc / denom)               es = 6.112 * exp(17.67 * tc / denom)
108    
# Line 98  contains Line 115  contains
115    
116               tc = tg - 273.15               tc = tg - 273.15
117               denom = 243.5 + tc               denom = 243.5 + tc
118               denom = MAX(denom, 1.0)               denom = MAX(denom, 1.)
119    
120               es = 6.112 * exp(17.67 * tc / denom)               es = 6.112 * exp(17.67 * tc / denom)
121    
# Line 111  contains Line 128  contains
128                    / (cpd + (cl - cpd) * qnk(i))                    / (cpd + (cl - cpd) * qnk(i))
129    
130               clw(i, k) = qnk(i) - qg               clw(i, k) = qnk(i) - qg
131               clw(i, k) = max(0.0, clw(i, k))               clw(i, k) = max(0., clw(i, k))
132               ! qg utilise au lieu du vrai mixing ratio rg:               ! qg utilise au lieu du vrai mixing ratio rg:
133               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
134            endif            endif
135         end do         end do
136      end do      end do
137    
138      ! SET THE PRECIPITATION EFFICIENCIES AND THE FRACTION OF      ! SET THE PRECIPITATION EFFICIENCIES
139      ! 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)  
140      do k = 1, nl      do k = 1, nl
141         do i = 1, ncum         do i = 1, ncum
142            pden = ptcrit - pbcrit            pden = ptcrit - pbcrit
143            ep(i, k) = (plcl(i) - p(i, k) - pbcrit) / pden * epmax            ep(i, k) = (plcl(i) - p(i, k) - pbcrit) / pden * epmax
144            ep(i, k) = amax1(ep(i, k), 0.0)            ep(i, k) = max(ep(i, k), 0.)
145            ep(i, k) = amin1(ep(i, k), epmax)            ep(i, k) = min(ep(i, k), epmax)
           sigp(i, k) = spfac  
146         end do         end do
147      end do      end do
148    
# Line 137  contains Line 152  contains
152      ! tvp est calcule en une seule fois, et sans retirer      ! tvp est calcule en une seule fois, et sans retirer
153      ! l'eau condensee (~> reversible CAPE)      ! l'eau condensee (~> reversible CAPE)
154      do i = 1, ncum      do i = 1, ncum
155         tp(i, nlp) = tp(i, nl)         tp(i, nl + 1) = tp(i, nl)
156      end do      end do
157    
158      ! EFFECTIVE VERTICAL PROFILE OF BUOYANCY:      ! EFFECTIVE VERTICAL PROFILE OF BUOYANCY:
# Line 160  contains Line 175  contains
175         buoy(icb(i), k) = buoybase(i)         buoy(icb(i), k) = buoybase(i)
176      end do      end do
177    
178      ! FIND THE FIRST MODEL LEVEL (INB) ABOVE THE PARCEL'S      ! Compute inb:
     ! LEVEL OF NEUTRAL BUOYANCY  
179    
180      do i = 1, ncum      inb = nl - 1
        inb(i) = nl - 1  
     end do  
181    
182      do i = 1, ncum      do i = 1, ncum
183         do k = 1, nl - 1         do k = 1, nl - 1
# Line 177  contains Line 189  contains
189    
190      ! CALCULATE LIQUID WATER STATIC ENERGY OF LIFTED PARCEL      ! CALCULATE LIQUID WATER STATIC ENERGY OF LIFTED PARCEL
191    
192      do k = 1, nlp      do k = 1, nl + 1
193         do i = 1, ncum         do i = 1, ncum
194            hp(i, k) = h(i, k)            hp(i, k) = h(i, k)
195         enddo         enddo
# Line 190  contains Line 202  contains
202         end do         end do
203      end do      end do
204    
205    end SUBROUTINE cv3_undilute2    end SUBROUTINE cv30_undilute2
206    
207  end module cv3_undilute2_m  end module cv30_undilute2_m
Legend:
Removed from v.183  
changed lines
  Added in v.195
  ViewVC Help
Powered by ViewVC 1.1.21