Line data Source code
1 : module zm_conv_evap
2 :
3 : use ccpp_kinds, only: kind_phys
4 :
5 : implicit none
6 :
7 : save
8 : private ! Make default type private to the module
9 : !
10 : ! PUBLIC: interfaces
11 : !
12 : public zm_conv_evap_run ! evaporation of precip from ZM schemea
13 :
14 : contains
15 :
16 :
17 : !===============================================================================
18 : !> \section arg_table_zm_conv_evap_run Argument Table
19 : !! \htmlinclude zm_conv_evap_run.html
20 : !!
21 65016 : subroutine zm_conv_evap_run(ncol, pver, pverp, &
22 : gravit, latice, latvap, tmelt, &
23 : cpres, ke, ke_lnd, &
24 130032 : t,pmid,pdel,q, &
25 : landfrac, &
26 65016 : tend_s, tend_s_snwprd, tend_s_snwevmlt, tend_q, &
27 65016 : prdprec_gen, cldfrc, deltat, &
28 325080 : prec_gen, snow, ntprprd, ntsnprd, fsnow_conv, flxprec, flxsnow, scheme_name, errmsg, errflg)
29 :
30 : !-----------------------------------------------------------------------
31 : ! Compute tendencies due to evaporation of rain from ZM scheme
32 : !--
33 : ! Compute the total precipitation and snow fluxes at the surface.
34 : ! Add in the latent heat of fusion for snow formation and melt, since it not dealt with
35 : ! in the Zhang-MacFarlane parameterization.
36 : ! Evaporate some of the precip directly into the environment using a Sundqvist type algorithm
37 : !-----------------------------------------------------------------------
38 :
39 : use wv_saturation, only: qsat
40 :
41 : !------------------------------Arguments--------------------------------
42 : integer,intent(in) :: ncol ! number of columns
43 : integer,intent(in) :: pver, pverp
44 : real(kind_phys),intent(in) :: gravit ! gravitational acceleration (m s-2)
45 : real(kind_phys),intent(in) :: latice ! Latent heat of fusion (J kg-1)
46 : real(kind_phys),intent(in) :: latvap ! Latent heat of vaporization (J kg-1)
47 : real(kind_phys),intent(in) :: tmelt ! Freezing point of water (K)
48 : real(kind_phys), intent(in) :: cpres ! specific heat at constant pressure in j/kg-degk.
49 : real(kind_phys), intent(in) :: ke ! Tunable evaporation efficiency set from namelist input zmconv_ke
50 : real(kind_phys), intent(in) :: ke_lnd
51 : real(kind_phys),intent(in), dimension(:,:) :: t ! temperature (K) (ncol,pver)
52 : real(kind_phys),intent(in), dimension(:,:) :: pmid ! midpoint pressure (Pa) (ncol,pver)
53 : real(kind_phys),intent(in), dimension(:,:) :: pdel ! layer thickness (Pa) (ncol,pver)
54 : real(kind_phys),intent(in), dimension(:,:) :: q ! water vapor (kg/kg) (ncol,pver)
55 : real(kind_phys),intent(in), dimension(:) :: landfrac ! land fraction (ncol)
56 :
57 : real(kind_phys),intent(out), dimension(:,:) :: tend_s ! heating rate (J/kg/s) (ncol,pver)
58 : real(kind_phys),intent(out), dimension(:,:) :: tend_q ! water vapor tendency (kg/kg/s) (ncol,pver)
59 : real(kind_phys),intent(out), dimension(:,:) :: tend_s_snwprd ! Heating rate of snow production (ncol,pver)
60 : real(kind_phys),intent(out), dimension(:,:) :: tend_s_snwevmlt ! Heating rate of evap/melting of snow (ncol,pver)
61 :
62 : real(kind_phys), intent(in ) :: prdprec_gen(:,:)! precipitation production (kg/ks/s) (ncol,pver)
63 : real(kind_phys), intent(in ) :: cldfrc(:,:) ! cloud fraction (ncol,pver)
64 : real(kind_phys), intent(in ) :: deltat ! time step
65 : real(kind_phys), intent(in ) :: fsnow_conv(:,:) ! snow fraction in precip production
66 :
67 : real(kind_phys), intent(inout) :: prec_gen(:) ! Convective-scale preciptn rate (ncol)
68 : real(kind_phys), intent(out) :: snow(:) ! Convective-scale snowfall rate (ncol)
69 :
70 : !
71 : !---------------------------Local storage-------------------------------
72 : real(kind_phys), parameter :: density_fresh_water=1000._kind_phys
73 :
74 130032 : real(kind_phys) :: es (ncol,pver) ! Saturation vapor pressure
75 130032 : real(kind_phys) :: qs (ncol,pver) ! saturation specific humidity
76 : real(kind_phys),intent(out) :: flxprec(:,:) ! Convective-scale flux of precip at interfaces (kg/m2/s) ! (ncol,pverp)
77 : real(kind_phys),intent(out) :: flxsnow(:,:) ! Convective-scale flux of snow at interfaces (kg/m2/s) ! (ncol,pverp)
78 : real(kind_phys),intent(out) :: ntprprd(:,:) ! net precip production in layer ! (ncol,pver)
79 : real(kind_phys),intent(out) :: ntsnprd(:,:) ! net snow production in layer ! (ncol,pver)
80 :
81 : character(len=512), intent(out) :: errmsg
82 : integer, intent(out) :: errflg
83 : character(len=40), intent(out) :: scheme_name
84 :
85 : real(kind_phys) :: work1 ! temp variable (pjr)
86 : real(kind_phys) :: work2 ! temp variable (pjr)
87 :
88 130032 : real(kind_phys) :: evpvint(ncol) ! vertical integral of evaporation
89 130032 : real(kind_phys) :: evpprec(ncol) ! evaporation of precipitation (kg/kg/s)
90 130032 : real(kind_phys) :: evpsnow(ncol) ! evaporation of snowfall (kg/kg/s)
91 130032 : real(kind_phys) :: snowmlt(ncol) ! snow melt tendency in layer
92 65016 : real(kind_phys) :: flxsntm(ncol) ! flux of snow into layer, after melting
93 :
94 : real(kind_phys) :: kemask
95 : real(kind_phys) :: evplimit ! temp variable for evaporation limits
96 : real(kind_phys) :: rlat(ncol)
97 : real(kind_phys) :: dum
98 : real(kind_phys) :: omsm
99 :
100 : integer :: i,k ! longitude,level indices
101 : logical :: old_snow
102 :
103 :
104 : !-----------------------------------------------------------------------
105 65016 : scheme_name = "zm_conv_evap_run"
106 65016 : errmsg = ''
107 65016 : errflg = 0
108 :
109 65016 : old_snow=.true.
110 :
111 : ! convert input precip to kg/m2/s
112 1085616 : prec_gen(:ncol) = prec_gen(:ncol)* density_fresh_water
113 :
114 : ! determine saturation vapor pressure
115 6111504 : do k = 1,pver
116 6111504 : call qsat(t(1:ncol,k), pmid(1:ncol,k), es(1:ncol,k), qs(1:ncol,k), ncol)
117 : end do
118 :
119 : ! zero the flux integrals on the top boundary
120 1085616 : flxprec(:ncol,1) = 0._kind_phys
121 1085616 : flxsnow(:ncol,1) = 0._kind_phys
122 1085616 : evpvint(:ncol) = 0._kind_phys
123 : omsm=0.9999_kind_phys
124 :
125 6111504 : do k = 1, pver
126 101027304 : do i = 1, ncol
127 :
128 : ! Melt snow falling into layer, if necessary.
129 : if( old_snow ) then
130 94915800 : if (t(i,k) > tmelt) then
131 16652799 : flxsntm(i) = 0._kind_phys
132 16652799 : snowmlt(i) = flxsnow(i,k) * gravit/ pdel(i,k)
133 : else
134 78263001 : flxsntm(i) = flxsnow(i,k)
135 78263001 : snowmlt(i) = 0._kind_phys
136 : end if
137 : else
138 : ! make sure melting snow doesn't reduce temperature below threshold
139 : if (t(i,k) > tmelt) then
140 : dum = -latice/cpres*flxsnow(i,k)*gravit/pdel(i,k)*deltat
141 : if (t(i,k) + dum .le. tmelt) then
142 : dum = (t(i,k)-tmelt)*cpres/latice/deltat
143 : dum = dum/(flxsnow(i,k)*gravit/pdel(i,k))
144 : dum = max(0._kind_phys,dum)
145 : dum = min(1._kind_phys,dum)
146 : else
147 : dum = 1._kind_phys
148 : end if
149 : dum = dum*omsm
150 : flxsntm(i) = flxsnow(i,k)*(1.0_kind_phys-dum)
151 : snowmlt(i) = dum*flxsnow(i,k)*gravit/ pdel(i,k)
152 : else
153 : flxsntm(i) = flxsnow(i,k)
154 : snowmlt(i) = 0._kind_phys
155 : end if
156 : end if
157 :
158 : ! relative humidity depression must be > 0 for evaporation
159 94915800 : evplimit = max(1._kind_phys - q(i,k)/qs(i,k), 0._kind_phys)
160 :
161 94915800 : kemask = ke
162 :
163 : ! total evaporation depends on flux in the top of the layer
164 : ! flux prec is the net production above layer minus evaporation into environmet
165 94915800 : evpprec(i) = kemask * (1._kind_phys - cldfrc(i,k)) * evplimit * sqrt(flxprec(i,k))
166 :
167 : ! Don't let evaporation supersaturate layer (approx). Layer may already be saturated.
168 : ! Currently does not include heating/cooling change to qs
169 94915800 : evplimit = max(0._kind_phys, (qs(i,k)-q(i,k)) / deltat)
170 :
171 : ! Don't evaporate more than is falling into the layer - do not evaporate rain formed
172 : ! in this layer but if precip production is negative, remove from the available precip
173 : ! Negative precip production occurs because of evaporation in downdrafts.
174 94915800 : evplimit = min(evplimit, flxprec(i,k) * gravit / pdel(i,k))
175 :
176 : ! Total evaporation cannot exceed input precipitation
177 94915800 : evplimit = min(evplimit, (prec_gen(i) - evpvint(i)) * gravit / pdel(i,k))
178 :
179 94915800 : evpprec(i) = min(evplimit, evpprec(i))
180 : if( .not.old_snow ) then
181 : evpprec(i) = max(0._kind_phys, evpprec(i))
182 : evpprec(i) = evpprec(i)*omsm
183 : end if
184 :
185 :
186 : ! evaporation of snow depends on snow fraction of total precipitation in the top after melting
187 94915800 : if (flxprec(i,k) > 0._kind_phys) then
188 : ! prevent roundoff problems
189 3259970 : work1 = min(max(0._kind_phys,flxsntm(i)/flxprec(i,k)),1._kind_phys)
190 3259970 : evpsnow(i) = evpprec(i) * work1
191 : else
192 91655830 : evpsnow(i) = 0._kind_phys
193 : end if
194 :
195 : ! vertically integrated evaporation
196 94915800 : evpvint(i) = evpvint(i) + evpprec(i) * pdel(i,k)/gravit
197 :
198 : ! net precip production is production - evaporation
199 94915800 : ntprprd(i,k) = prdprec_gen(i,k) - evpprec(i)
200 : ! net snow production is precip production * ice fraction - evaporation - melting
201 : ! the small amount added to flxprec in the work1 expression has been increased from
202 : ! 1e-36 to 8.64e-11 (1e-5 mm/day). This causes the temperature based partitioning
203 : ! scheme to be used for small flxprec amounts. This is to address error growth problems.
204 :
205 : if( old_snow ) then
206 94915800 : if (flxprec(i,k).gt.0._kind_phys) then
207 3259970 : work1 = min(max(0._kind_phys,flxsnow(i,k)/flxprec(i,k)),1._kind_phys)
208 : else
209 : work1 = 0._kind_phys
210 : endif
211 :
212 94915800 : work2 = max(fsnow_conv(i,k), work1)
213 94915800 : if (snowmlt(i).gt.0._kind_phys) work2 = 0._kind_phys
214 94915800 : ntsnprd(i,k) = prdprec_gen(i,k)*work2 - evpsnow(i) - snowmlt(i)
215 94915800 : tend_s_snwprd (i,k) = prdprec_gen(i,k)*work2*latice
216 94915800 : tend_s_snwevmlt(i,k) = - ( evpsnow(i) + snowmlt(i) )*latice
217 : end if
218 :
219 : ! precipitation fluxes
220 94915800 : flxprec(i,k+1) = flxprec(i,k) + ntprprd(i,k) * pdel(i,k)/gravit
221 94915800 : flxsnow(i,k+1) = flxsnow(i,k) + ntsnprd(i,k) * pdel(i,k)/gravit
222 :
223 : ! protect against rounding error
224 94915800 : flxprec(i,k+1) = max(flxprec(i,k+1), 0._kind_phys)
225 94915800 : flxsnow(i,k+1) = max(flxsnow(i,k+1), 0._kind_phys)
226 :
227 : ! heating (cooling) and moistening due to evaporation
228 : ! - latent heat of vaporization for precip production has already been accounted for
229 : ! - snow is contained in prec
230 : if( old_snow ) then
231 94915800 : tend_s(i,k) =-evpprec(i)*latvap + ntsnprd(i,k)*latice
232 : else
233 : tend_s(i,k) =-evpprec(i)*latvap + tend_s_snwevmlt(i,k)
234 : end if
235 100962288 : tend_q(i,k) = evpprec(i)
236 : end do
237 : end do
238 :
239 : ! set output precipitation rates (m/s)
240 : ! convert from 'kg m-2 s-1' to 'm s-1'
241 1085616 : prec_gen(:ncol) = flxprec(:ncol,pverp) / density_fresh_water
242 1085616 : snow(:ncol) = flxsnow(:ncol,pverp) / density_fresh_water
243 :
244 65016 : end subroutine zm_conv_evap_run
245 :
246 :
247 : end module zm_conv_evap
|