Line data Source code
1 : module gw_convect
2 :
3 : !
4 : ! This module handles gravity waves from convection, and was extracted from
5 : ! gw_drag in May 2013.
6 : !
7 :
8 : use gw_utils, only: r8
9 :
10 : implicit none
11 : private
12 : save
13 :
14 : public :: BeresSourceDesc
15 : public :: gw_beres_src
16 :
17 : type :: BeresSourceDesc
18 : ! Whether wind speeds are shifted to be relative to storm cells.
19 : logical :: storm_shift
20 : ! Index for level where wind speed is used as the source speed.
21 : integer :: k
22 : ! Heating depths below this value [m] will be ignored.
23 : real(r8) :: min_hdepth
24 : ! Table bounds, for convenience. (Could be inferred from shape(mfcc).)
25 : integer :: maxh
26 : integer :: maxuh
27 : ! Heating depths [m].
28 : real(r8), allocatable :: hd(:)
29 : ! Table of source spectra.
30 : real(r8), allocatable :: mfcc(:,:,:)
31 : end type BeresSourceDesc
32 :
33 : contains
34 :
35 : !==========================================================================
36 :
37 72960 : subroutine gw_beres_src(ncol, band, desc, u, v, &
38 145920 : netdt, zm, src_level, tend_level, tau, ubm, ubi, xv, yv, &
39 72960 : c, hdepth, maxq0)
40 : !-----------------------------------------------------------------------
41 : ! Driver for multiple gravity wave drag parameterization.
42 : !
43 : ! The parameterization is assumed to operate only where water vapor
44 : ! concentrations are negligible in determining the density.
45 : !
46 : ! Beres, J.H., M.J. Alexander, and J.R. Holton, 2004: "A method of
47 : ! specifying the gravity wave spectrum above convection based on latent
48 : ! heating properties and background wind". J. Atmos. Sci., Vol 61, No. 3,
49 : ! pp. 324-337.
50 : !
51 : !-----------------------------------------------------------------------
52 : use gw_utils, only: get_unit_vector, dot_2d, midpoint_interp
53 : use gw_common, only: GWBand, pver, qbo_hdepth_scaling
54 :
55 : !------------------------------Arguments--------------------------------
56 : ! Column dimension.
57 : integer, intent(in) :: ncol
58 :
59 : ! Wavelengths triggered by convection.
60 : type(GWBand), intent(in) :: band
61 :
62 : ! Settings for convection type (e.g. deep vs shallow).
63 : type(BeresSourceDesc), intent(in) :: desc
64 :
65 : ! Midpoint zonal/meridional winds.
66 : real(r8), intent(in) :: u(ncol,pver), v(ncol,pver)
67 : ! Heating rate due to convection.
68 : real(r8), intent(in) :: netdt(:,:)
69 : ! Midpoint altitudes.
70 : real(r8), intent(in) :: zm(ncol,pver)
71 :
72 : ! Indices of top gravity wave source level and lowest level where wind
73 : ! tendencies are allowed.
74 : integer, intent(out) :: src_level(ncol)
75 : integer, intent(out) :: tend_level(ncol)
76 :
77 : ! Wave Reynolds stress.
78 : real(r8), intent(out) :: tau(ncol,-band%ngwv:band%ngwv,pver+1)
79 : ! Projection of wind at midpoints and interfaces.
80 : real(r8), intent(out) :: ubm(ncol,pver), ubi(ncol,pver+1)
81 : ! Unit vectors of source wind (zonal and meridional components).
82 : real(r8), intent(out) :: xv(ncol), yv(ncol)
83 : ! Phase speeds.
84 : real(r8), intent(out) :: c(ncol,-band%ngwv:band%ngwv)
85 :
86 : ! Heating depth [m] and maximum heating in each column.
87 : real(r8), intent(out) :: hdepth(ncol), maxq0(ncol)
88 :
89 : !---------------------------Local Storage-------------------------------
90 : ! Column and level indices.
91 : integer :: i, k
92 :
93 : ! Zonal/meridional wind at roughly the level where the convection occurs.
94 145920 : real(r8) :: uconv(ncol), vconv(ncol)
95 :
96 : ! Maximum heating rate.
97 145920 : real(r8) :: q0(ncol)
98 :
99 : ! Bottom/top heating range index.
100 145920 : integer :: boti(ncol), topi(ncol)
101 : ! Index for looking up heating depth dimension in the table.
102 145920 : integer :: hd_idx(ncol)
103 : ! Mean wind in heating region.
104 145920 : real(r8) :: uh(ncol)
105 : ! Min/max wavenumber for critical level filtering.
106 145920 : integer :: Umini(ncol), Umaxi(ncol)
107 : ! Source level tau for a column.
108 145920 : real(r8) :: tau0(-band%ngwv:band%ngwv)
109 : ! Speed of convective cells relative to storm.
110 145920 : real(r8) :: CS(ncol)
111 : ! Index to shift spectra relative to ground.
112 : integer :: shift
113 :
114 : ! Heating rate conversion factor.
115 : real(r8), parameter :: CF = 20._r8
116 : ! Averaging length.
117 : real(r8), parameter :: AL = 1.0e5_r8
118 :
119 : !----------------------------------------------------------------------
120 : ! Initialize tau array
121 : !----------------------------------------------------------------------
122 :
123 2412568320 : tau = 0.0_r8
124 1123584 : hdepth = 0.0_r8
125 1123584 : q0 = 0.0_r8
126 4815360 : tau0 = 0.0_r8
127 :
128 : !------------------------------------------------------------------------
129 : ! Determine wind and unit vectors approximately at the source level, then
130 : ! project winds.
131 : !------------------------------------------------------------------------
132 :
133 : ! Source wind speed and direction.
134 1123584 : uconv = u(:,desc%k)
135 1123584 : vconv = v(:,desc%k)
136 :
137 : ! Get the unit vector components and magnitude at the source level.
138 72960 : call get_unit_vector(uconv, vconv, xv, yv, ubi(:,desc%k+1))
139 :
140 : ! Project the local wind at midpoints onto the source wind.
141 2407680 : do k = 1, pver
142 2407680 : ubm(:,k) = dot_2d(u(:,k), v(:,k), xv, yv)
143 : end do
144 :
145 : ! Compute the interface wind projection by averaging the midpoint winds.
146 : ! Use the top level wind at the top interface.
147 1123584 : ubi(:,1) = ubm(:,1)
148 :
149 72960 : ubi(:,2:pver) = midpoint_interp(ubm)
150 :
151 : !-----------------------------------------------------------------------
152 : ! Calculate heating depth.
153 : !
154 : ! Heating depth is defined as the first height range from the bottom in
155 : ! which heating rate is continuously positive.
156 : !-----------------------------------------------------------------------
157 :
158 : ! First find the indices for the top and bottom of the heating range.
159 1123584 : boti = 0
160 1123584 : topi = 0
161 2099568 : do k = pver, 1, -1
162 32339135 : do i = 1, ncol
163 32339135 : if (boti(i) == 0) then
164 : ! Detect if we are outside the top of range (where z = 20 km).
165 22928159 : if (zm(i,k) >= 20000._r8) then
166 817160 : boti(i) = k
167 817160 : topi(i) = k
168 : else
169 : ! First spot where heating rate is positive.
170 22110999 : if (netdt(i,k) > 0.0_r8) boti(i) = k
171 : end if
172 : end if
173 : end do
174 : ! When all done, exit
175 3186373 : if (all(boti /= 0)) exit
176 : end do
177 :
178 1762029 : do k = 1, pver
179 27142277 : do i = 1, ncol
180 27142277 : if (topi(i) == 0) then
181 : ! First spot where heating rate is positive.
182 5328052 : if ((netdt(i,k) > 0.0_r8) .AND. (zm(i,k) <= 20000._r8)) topi(i) = k-1
183 : end if
184 : end do
185 : ! When all done, exit
186 15545673 : if (all(topi /= 0)) exit
187 : end do
188 :
189 : ! Heating depth in m.
190 2174208 : hdepth = [ ( (zm(i,topi(i))-zm(i,boti(i))), i = 1, ncol ) ]
191 :
192 : ! J. Richter: this is an effective reduction of the GW phase speeds (needed to drive the QBO)
193 1123584 : hdepth = hdepth*qbo_hdepth_scaling
194 :
195 72960 : hd_idx = index_of_nearest(hdepth, desc%hd)
196 :
197 : ! hd_idx=0 signals that a heating depth is too shallow, i.e. that it is
198 : ! either not big enough for the lowest table entry, or it is below the
199 : ! minimum allowed for this convection type.
200 : ! Values above the max in the table still get the highest value, though.
201 1123584 : where (hdepth < max(desc%min_hdepth, desc%hd(1))) hd_idx = 0
202 :
203 : ! Maximum heating rate.
204 4131564 : do k = minval(topi), maxval(boti)
205 30228522 : where (k >= topi .and. k <= boti)
206 1957356 : q0 = max(q0, netdt(:,k))
207 : end where
208 : end do
209 :
210 : !output max heating rate in K/day
211 1123584 : maxq0 = q0*24._r8*3600._r8
212 :
213 : ! Multipy by conversion factor
214 1123584 : q0 = q0 * CF
215 :
216 72960 : if (desc%storm_shift) then
217 :
218 : ! Find the cell speed where the storm speed is > 10 m/s.
219 : ! Storm speed is taken to be the source wind speed.
220 1123584 : CS = sign(max(abs(ubm(:,desc%k))-10._r8, 0._r8), ubm(:,desc%k))
221 :
222 : ! Average wind in heating region, relative to storm cells.
223 1123584 : uh = 0._r8
224 4131564 : do k = minval(topi), maxval(boti)
225 30228522 : where (k >= topi .and. k <= boti)
226 1957356 : uh = uh + ubm(:,k)/(boti-topi+1)
227 : end where
228 : end do
229 :
230 1123584 : uh = uh - CS
231 :
232 : else
233 :
234 : ! For shallow convection, wind is relative to ground, and "heating
235 : ! region" wind is just the source level wind.
236 0 : uh = ubm(:,desc%k)
237 :
238 : end if
239 :
240 : ! Limit uh to table range.
241 1123584 : uh = min(uh, real(desc%maxuh, r8))
242 1123584 : uh = max(uh, -real(desc%maxuh, r8))
243 :
244 : ! Speeds for critical level filtering.
245 1123584 : Umini = band%ngwv
246 1123584 : Umaxi = -band%ngwv
247 4131564 : do k = minval(topi), maxval(boti)
248 88582290 : where (k >= topi .and. k <= boti)
249 1957356 : Umini = min(Umini, nint(ubm(:,k)/band%dc))
250 : Umaxi = max(Umaxi, nint(ubm(:,k)/band%dc))
251 : end where
252 : end do
253 :
254 1123584 : Umini = max(Umini, -band%ngwv)
255 1123584 : Umaxi = min(Umaxi, band%ngwv)
256 :
257 : !-----------------------------------------------------------------------
258 : ! Gravity wave sources
259 : !-----------------------------------------------------------------------
260 : ! Start loop over all columns.
261 : !-----------------------------------------------------------------------
262 1123584 : do i=1,ncol
263 :
264 : !---------------------------------------------------------------------
265 : ! Look up spectrum only if the heating depth is large enough, else set
266 : ! tau0 = 0.
267 : !---------------------------------------------------------------------
268 :
269 1123584 : if (hd_idx(i) > 0) then
270 :
271 : !------------------------------------------------------------------
272 : ! Look up the spectrum using depth and uh.
273 : !------------------------------------------------------------------
274 :
275 5534166 : tau0 = desc%mfcc(hd_idx(i),nint(uh(i)),:)
276 :
277 83851 : if (desc%storm_shift) then
278 : ! For deep convection, the wind was relative to storm cells, so
279 : ! shift the spectrum so that it is now relative to the ground.
280 83851 : shift = -nint(CS(i)/band%dc)
281 5534166 : tau0 = eoshift(tau0, shift)
282 : end if
283 :
284 : ! Adjust magnitude.
285 5534166 : tau0 = tau0*q0(i)*q0(i)/AL
286 :
287 : ! Adjust for critical level filtering.
288 502589 : tau0(Umini(i):Umaxi(i)) = 0.0_r8
289 :
290 5534166 : tau(i,:,topi(i)+1) = tau0
291 :
292 : end if ! heating depth above min and not at the pole
293 :
294 : enddo
295 :
296 : !-----------------------------------------------------------------------
297 : ! End loop over all columns.
298 : !-----------------------------------------------------------------------
299 :
300 : ! Output the source level.
301 1123584 : src_level = topi
302 1123584 : tend_level = topi
303 :
304 : ! Set phase speeds; just use reference speeds.
305 72960 : c = spread(band%cref, 1, ncol)
306 :
307 72960 : end subroutine gw_beres_src
308 :
309 : ! Short routine to get the indices of a set of values rounded to their
310 : ! nearest points on a grid.
311 72960 : function index_of_nearest(x, grid) result(idx)
312 : real(r8), intent(in) :: x(:)
313 : real(r8), intent(in) :: grid(:)
314 :
315 : integer :: idx(size(x))
316 :
317 145920 : real(r8) :: interfaces(size(grid)-1)
318 : integer :: i, n
319 :
320 72960 : n = size(grid)
321 1532160 : interfaces = (grid(:n-1) + grid(2:))/2._r8
322 :
323 1123584 : idx = 1
324 1459200 : do i = 1, n-1
325 21421056 : where (x > interfaces(i)) idx = i + 1
326 : end do
327 :
328 72960 : end function index_of_nearest
329 :
330 0 : end module gw_convect
|
