Line data Source code
1 : !-------------------------------------------------------------------------------
2 : ! $Id$
3 : !===============================================================================
4 : module clip_explicit
5 :
6 : implicit none
7 :
8 : private
9 :
10 : public :: clip_covars_denom, &
11 : clip_covar, &
12 : clip_covar_level, &
13 : clip_variance, &
14 : clip_skewness, &
15 : clip_skewness_core
16 :
17 : ! Named constants to avoid string comparisons
18 : integer, parameter, public :: &
19 : clip_rtp2 = 1, & ! Named constant for rtp2 clipping
20 : clip_thlp2 = 2, & ! Named constant for thlp2 clipping
21 : clip_rtpthlp = 3, & ! Named constant for rtpthlp clipping
22 : clip_up2 = 5, & ! Named constant for up2 clipping
23 : clip_vp2 = 6, & ! Named constant for vp2 clipping
24 : ! clip_scalar = 7, & ! Named constant for scalar clipping
25 : clip_wprtp = 8, & ! Named constant for wprtp clipping
26 : clip_wpthlp = 9, & ! Named constant for wpthlp clipping
27 : clip_upwp = 10, & ! Named constant for upwp clipping
28 : clip_vpwp = 11, & ! Named constant for vpwp clipping
29 : clip_wp2 = 12, & ! Named constant for wp2 clipping
30 : clip_wpsclrp = 13, & ! Named constant for wp scalar clipping
31 : clip_sclrp2 = 14, & ! Named constant for sclrp2 clipping
32 : clip_sclrprtp = 15, & ! Named constant for sclrprtp clipping
33 : clip_sclrpthlp = 16, & ! Named constant for sclrpthlp clipping
34 : clip_wphydrometp = 17 ! Named constant for wphydrometp clipping
35 :
36 : contains
37 :
38 : !=============================================================================
39 705888 : subroutine clip_covars_denom( nz, ngrdcol, gr, dt, rtp2, thlp2, up2, vp2, wp2, &
40 705888 : sclrp2, wprtp_cl_num, wpthlp_cl_num, &
41 : wpsclrp_cl_num, upwp_cl_num, vpwp_cl_num, &
42 : l_predict_upwp_vpwp, &
43 : l_tke_aniso, &
44 : l_linearize_pbl_winds, &
45 : stats_metadata, &
46 705888 : stats_zm, &
47 705888 : wprtp, wpthlp, upwp, vpwp, wpsclrp, &
48 705888 : upwp_pert, vpwp_pert )
49 :
50 : ! Description:
51 : ! Some of the covariances found in the CLUBB model code need to be clipped
52 : ! multiple times during each timestep to ensure that the correlation between
53 : ! the two relevant variables stays between -1 and 1 at all times during the
54 : ! model run. The covariances that need to be clipped multiple times are
55 : ! w'r_t', w'th_l', w'sclr', u'w', and v'w'. One of the times that each one
56 : ! of these covariances is clipped is immediately after each one is set.
57 : ! However, each covariance still needs to be clipped two more times during
58 : ! each timestep (once after advance_xp2_xpyp is called and once after
59 : ! advance_wp2_wp3 is called). This subroutine handles the times that the
60 : ! covariances are clipped away from the time that they are set. In other
61 : ! words, this subroutine clips the covariances after the denominator terms
62 : ! in the relevant correlation equation have been altered, ensuring that
63 : ! all correlations will remain between -1 and 1 at all times.
64 :
65 : ! References:
66 : ! None
67 : !-----------------------------------------------------------------------
68 :
69 : use grid_class, only: &
70 : grid ! Type
71 :
72 : use parameters_model, only: &
73 : sclr_dim ! Variable(s)
74 :
75 : use clubb_precision, only: &
76 : core_rknd ! Variable(s)
77 :
78 : use stats_type, only: &
79 : stats ! Type
80 :
81 : use stats_variables, only: &
82 : stats_metadata_type
83 :
84 : implicit none
85 :
86 : ! --------------------- Input Variables ---------------------
87 : integer, intent(in) :: &
88 : nz, &
89 : ngrdcol
90 :
91 : type (grid), target, intent(in) :: gr
92 :
93 : real( kind = core_rknd ), intent(in) :: &
94 : dt ! Timestep [s]
95 :
96 : real( kind = core_rknd ), dimension(ngrdcol,nz), intent(in) :: &
97 : rtp2, & ! r_t'^2 [(kg/kg)^2]
98 : thlp2, & ! theta_l'^2 [K^2]
99 : up2, & ! u'^2 [m^2/s^2]
100 : vp2, & ! v'^2 [m^2/s^2]
101 : wp2 ! w'^2 [m^2/s^2]
102 :
103 : real( kind = core_rknd ), dimension(ngrdcol,nz,sclr_dim), intent(in) :: &
104 : sclrp2 ! sclr'^2 [{units vary}^2]
105 :
106 : integer, intent(in) :: &
107 : wprtp_cl_num, &
108 : wpthlp_cl_num, &
109 : wpsclrp_cl_num, &
110 : upwp_cl_num, &
111 : vpwp_cl_num
112 :
113 : logical, intent(in) :: &
114 : l_predict_upwp_vpwp, & ! Flag to predict <u'w'> and <v'w'> along with <u> and <v> alongside
115 : ! the advancement of <rt>, <w'rt'>, <thl>, <wpthlp>, <sclr>, and
116 : ! <w'sclr'> in subroutine advance_xm_wpxp. Otherwise, <u'w'> and
117 : ! <v'w'> are still approximated by eddy diffusivity when <u> and <v>
118 : ! are advanced in subroutine advance_windm_edsclrm.
119 : l_tke_aniso, & ! For anisotropic turbulent kinetic energy, i.e. TKE = 1/2
120 : ! (u'^2 + v'^2 + w'^2)
121 : l_linearize_pbl_winds ! Flag (used by E3SM) to linearize PBL winds
122 :
123 : type (stats_metadata_type), intent(in) :: &
124 : stats_metadata
125 :
126 : ! --------------------- Input/Output Variables ---------------------
127 : type (stats), target, dimension(ngrdcol), intent(inout) :: &
128 : stats_zm
129 :
130 : real( kind = core_rknd ), dimension(ngrdcol,nz), intent(inout) :: &
131 : wprtp, & ! w'r_t' [(kg/kg) m/s]
132 : wpthlp, & ! w'theta_l' [K m/s]
133 : upwp, & ! u'w' [m^2/s^2]
134 : vpwp ! v'w' [m^2/s^2]
135 :
136 : real( kind = core_rknd ), dimension(ngrdcol,nz,sclr_dim), intent(inout) :: &
137 : wpsclrp ! w'sclr' [units m/s]
138 :
139 : ! Variables used to track perturbed version of winds.
140 : real( kind = core_rknd ), dimension(ngrdcol,nz), intent(inout) :: &
141 : upwp_pert, & ! perturbed <u'w'> [m^2/s^2]
142 : vpwp_pert ! perturbed <v'w'> [m^2/s^2]
143 :
144 : ! --------------------- Local Variables ---------------------
145 : logical :: &
146 : l_first_clip_ts, & ! First instance of clipping in a timestep.
147 : l_last_clip_ts ! Last instance of clipping in a timestep.
148 :
149 : real( kind = core_rknd ), dimension(ngrdcol,nz) :: &
150 1411776 : wprtp_chnge, & ! Net change in w'r_t' due to clipping [(kg/kg) m/s]
151 1411776 : wpthlp_chnge, & ! Net change in w'th_l' due to clipping [K m/s]
152 1411776 : upwp_chnge, & ! Net change in u'w' due to clipping [m^2/s^2]
153 1411776 : vpwp_chnge ! Net change in v'w' due to clipping [m^2/s^2]
154 :
155 : real( kind = core_rknd ), dimension(ngrdcol,nz,sclr_dim) :: &
156 1411776 : wpsclrp_chnge ! Net change in w'sclr' due to clipping [{units vary}]
157 :
158 : integer :: sclr, i ! scalar array index.
159 :
160 : ! --------------------- Begin Code ---------------------
161 :
162 : !$acc enter data create( wprtp_chnge, wpthlp_chnge, upwp_chnge, vpwp_chnge )
163 : !$acc enter data if( sclr_dim > 0 ) create( wpsclrp_chnge )
164 :
165 : !!! Clipping for w'r_t'
166 : !
167 : ! Clipping w'r_t' at each vertical level, based on the
168 : ! correlation of w and r_t at each vertical level, such that:
169 : ! corr_(w,r_t) = w'r_t' / [ sqrt(w'^2) * sqrt(r_t'^2) ];
170 : ! -1 <= corr_(w,r_t) <= 1.
171 : !
172 : ! Since w'^2, r_t'^2, and w'r_t' are each advanced in different
173 : ! subroutines from each other in advance_clubb_core, clipping for w'r_t'
174 : ! is done three times during each timestep (once after each variable has
175 : ! been updated).
176 : !
177 : ! This subroutine handles the first and third instances of
178 : ! w'r_t' clipping.
179 : ! The first instance of w'r_t' clipping takes place after
180 : ! r_t'^2 is updated in advance_xp2_xpyp.
181 : ! The third instance of w'r_t' clipping takes place after
182 : ! w'^2 is updated in advance_wp2_wp3.
183 :
184 : ! Used within subroutine clip_covar.
185 705888 : if ( wprtp_cl_num == 1 ) then
186 0 : l_first_clip_ts = .true.
187 0 : l_last_clip_ts = .false.
188 705888 : elseif ( wprtp_cl_num == 2 ) then
189 352944 : l_first_clip_ts = .false.
190 352944 : l_last_clip_ts = .false.
191 352944 : elseif ( wprtp_cl_num == 3 ) then
192 352944 : l_first_clip_ts = .false.
193 352944 : l_last_clip_ts = .true.
194 : endif
195 :
196 : ! Clip w'r_t'
197 : call clip_covar( nz, ngrdcol, gr, clip_wprtp, l_first_clip_ts, & ! intent(in)
198 : l_last_clip_ts, dt, wp2, rtp2, & ! intent(in)
199 : l_predict_upwp_vpwp, & ! intent(in)
200 : stats_metadata, & ! intent(in)
201 : stats_zm, & ! intent(inout)
202 705888 : wprtp, wprtp_chnge ) ! intent(inout)
203 :
204 : !!! Clipping for w'th_l'
205 : !
206 : ! Clipping w'th_l' at each vertical level, based on the
207 : ! correlation of w and th_l at each vertical level, such that:
208 : ! corr_(w,th_l) = w'th_l' / [ sqrt(w'^2) * sqrt(th_l'^2) ];
209 : ! -1 <= corr_(w,th_l) <= 1.
210 : !
211 : ! Since w'^2, th_l'^2, and w'th_l' are each advanced in different
212 : ! subroutines from each other in advance_clubb_core, clipping for w'th_l'
213 : ! is done three times during each timestep (once after each variable has
214 : ! been updated).
215 : !
216 : ! This subroutine handles the first and third instances of
217 : ! w'th_l' clipping.
218 : ! The first instance of w'th_l' clipping takes place after
219 : ! th_l'^2 is updated in advance_xp2_xpyp.
220 : ! The third instance of w'th_l' clipping takes place after
221 : ! w'^2 is updated in advance_wp2_wp3.
222 :
223 : ! Used within subroutine clip_covar.
224 705888 : if ( wpthlp_cl_num == 1 ) then
225 0 : l_first_clip_ts = .true.
226 0 : l_last_clip_ts = .false.
227 705888 : elseif ( wpthlp_cl_num == 2 ) then
228 352944 : l_first_clip_ts = .false.
229 352944 : l_last_clip_ts = .false.
230 352944 : elseif ( wpthlp_cl_num == 3 ) then
231 352944 : l_first_clip_ts = .false.
232 352944 : l_last_clip_ts = .true.
233 : endif
234 :
235 : ! Clip w'th_l'
236 : call clip_covar( nz, ngrdcol, gr, clip_wpthlp, l_first_clip_ts, & ! intent(in)
237 : l_last_clip_ts, dt, wp2, thlp2, & ! intent(in)
238 : l_predict_upwp_vpwp, & ! intent(in)
239 : stats_metadata, & ! intent(in)
240 : stats_zm, & ! intent(inout)
241 705888 : wpthlp, wpthlp_chnge ) ! intent(inout)
242 :
243 : !!! Clipping for w'sclr'
244 : !
245 : ! Clipping w'sclr' at each vertical level, based on the
246 : ! correlation of w and sclr at each vertical level, such that:
247 : ! corr_(w,sclr) = w'sclr' / [ sqrt(w'^2) * sqrt(sclr'^2) ];
248 : ! -1 <= corr_(w,sclr) <= 1.
249 : !
250 : ! Since w'^2, sclr'^2, and w'sclr' are each advanced in different
251 : ! subroutines from each other in advance_clubb_core, clipping for w'sclr'
252 : ! is done three times during each timestep (once after each variable has
253 : ! been updated).
254 : !
255 : ! This subroutine handles the first and third instances of
256 : ! w'sclr' clipping.
257 : ! The first instance of w'sclr' clipping takes place after
258 : ! sclr'^2 is updated in advance_xp2_xpyp.
259 : ! The third instance of w'sclr' clipping takes place after
260 : ! w'^2 is updated in advance_wp2_wp3.
261 :
262 : ! Used within subroutine clip_covar.
263 705888 : if ( wpsclrp_cl_num == 1 ) then
264 0 : l_first_clip_ts = .true.
265 0 : l_last_clip_ts = .false.
266 705888 : elseif ( wpsclrp_cl_num == 2 ) then
267 352944 : l_first_clip_ts = .false.
268 352944 : l_last_clip_ts = .false.
269 352944 : elseif ( wpsclrp_cl_num == 3 ) then
270 352944 : l_first_clip_ts = .false.
271 352944 : l_last_clip_ts = .true.
272 : endif
273 :
274 : ! Clip w'sclr'
275 705888 : do sclr = 1, sclr_dim
276 : call clip_covar( nz, ngrdcol, gr, clip_wpsclrp, l_first_clip_ts, & ! intent(in)
277 : l_last_clip_ts, dt, wp2(:,:), sclrp2(:,:,sclr), & ! intent(in)
278 : l_predict_upwp_vpwp, & ! intent(in)
279 : stats_metadata, & ! intent(in)
280 : stats_zm, & ! intent(inout)
281 705888 : wpsclrp(:,:,sclr), wpsclrp_chnge(:,:,sclr) ) ! intent(inout)
282 : enddo
283 :
284 :
285 : !!! Clipping for u'w'
286 : !
287 : ! Clipping u'w' at each vertical level, based on the
288 : ! correlation of u and w at each vertical level, such that:
289 : ! corr_(u,w) = u'w' / [ sqrt(u'^2) * sqrt(w'^2) ];
290 : ! -1 <= corr_(u,w) <= 1.
291 : !
292 : ! Since w'^2, u'^2, and u'w' are each advanced in different
293 : ! subroutines from each other in advance_clubb_core, clipping for u'w'
294 : ! is done three times during each timestep (once after each variable has
295 : ! been updated).
296 : !
297 : ! This subroutine handles the first and second instances of
298 : ! u'w' clipping.
299 : ! The first instance of u'w' clipping takes place after
300 : ! u'^2 is updated in advance_xp2_xpyp.
301 : ! The second instance of u'w' clipping takes place after
302 : ! w'^2 is updated in advance_wp2_wp3.
303 :
304 : ! Used within subroutine clip_covar.
305 705888 : if ( upwp_cl_num == 1 ) then
306 0 : l_first_clip_ts = .true.
307 0 : l_last_clip_ts = .false.
308 705888 : elseif ( upwp_cl_num == 2 ) then
309 352944 : l_first_clip_ts = .false.
310 352944 : l_last_clip_ts = .false.
311 352944 : elseif ( upwp_cl_num == 3 ) then
312 352944 : l_first_clip_ts = .false.
313 352944 : l_last_clip_ts = .true.
314 : endif
315 :
316 : ! Clip u'w'
317 705888 : if ( l_tke_aniso ) then
318 : call clip_covar( nz, ngrdcol, gr, clip_upwp, l_first_clip_ts, & ! intent(in)
319 : l_last_clip_ts, dt, wp2, up2, & ! intent(in)
320 : l_predict_upwp_vpwp, & ! intent(in)
321 : stats_metadata, & ! intent(in)
322 : stats_zm, & ! intent(inout)
323 705888 : upwp, upwp_chnge ) ! intent(inout)
324 :
325 705888 : if ( l_linearize_pbl_winds ) then
326 : call clip_covar( nz, ngrdcol, gr, clip_upwp, l_first_clip_ts, & ! intent(in)
327 : l_last_clip_ts, dt, wp2, up2, & ! intent(in)
328 : l_predict_upwp_vpwp, & ! intent(in)
329 : stats_metadata, & ! intent(in)
330 : stats_zm, & ! intent(inout)
331 0 : upwp_pert, upwp_chnge ) ! intent(inout)
332 : endif ! l_linearize_pbl_winds
333 : else
334 : ! In this case, up2 = wp2, and the variable `up2' does not interact
335 : call clip_covar( nz, ngrdcol, gr, clip_upwp, l_first_clip_ts, & ! intent(in)
336 : l_last_clip_ts, dt, wp2, wp2, & ! intent(in)
337 : l_predict_upwp_vpwp, & ! intent(in)
338 : stats_metadata, & ! intent(in)
339 : stats_zm, & ! intent(inout)
340 0 : upwp, upwp_chnge ) ! intent(inout)
341 :
342 0 : if ( l_linearize_pbl_winds ) then
343 : call clip_covar( nz, ngrdcol, gr, clip_upwp, l_first_clip_ts, & ! intent(in)
344 : l_last_clip_ts, dt, wp2, wp2, & ! intent(in)
345 : l_predict_upwp_vpwp, & ! intent(in)
346 : stats_metadata, & ! intent(in)
347 : stats_zm, & ! intent(inout)
348 0 : upwp_pert, upwp_chnge ) ! intent(inout)
349 : endif ! l_linearize_pbl_winds
350 : end if
351 :
352 :
353 :
354 : !!! Clipping for v'w'
355 : !
356 : ! Clipping v'w' at each vertical level, based on the
357 : ! correlation of v and w at each vertical level, such that:
358 : ! corr_(v,w) = v'w' / [ sqrt(v'^2) * sqrt(w'^2) ];
359 : ! -1 <= corr_(v,w) <= 1.
360 : !
361 : ! Since w'^2, v'^2, and v'w' are each advanced in different
362 : ! subroutines from each other in advance_clubb_core, clipping for v'w'
363 : ! is done three times during each timestep (once after each variable has
364 : ! been updated).
365 : !
366 : ! This subroutine handles the first and second instances of
367 : ! v'w' clipping.
368 : ! The first instance of v'w' clipping takes place after
369 : ! v'^2 is updated in advance_xp2_xpyp.
370 : ! The second instance of v'w' clipping takes place after
371 : ! w'^2 is updated in advance_wp2_wp3.
372 :
373 : ! Used within subroutine clip_covar.
374 705888 : if ( vpwp_cl_num == 1 ) then
375 0 : l_first_clip_ts = .true.
376 0 : l_last_clip_ts = .false.
377 705888 : elseif ( vpwp_cl_num == 2 ) then
378 352944 : l_first_clip_ts = .false.
379 352944 : l_last_clip_ts = .false.
380 352944 : elseif ( vpwp_cl_num == 3 ) then
381 352944 : l_first_clip_ts = .false.
382 352944 : l_last_clip_ts = .true.
383 : endif
384 :
385 705888 : if ( l_tke_aniso ) then
386 : call clip_covar( nz, ngrdcol, gr, clip_vpwp, l_first_clip_ts, & ! intent(in)
387 : l_last_clip_ts, dt, wp2, vp2, & ! intent(in)
388 : l_predict_upwp_vpwp, & ! intent(in)
389 : stats_metadata, & ! intent(in)
390 : stats_zm, & ! intent(inout)
391 705888 : vpwp, vpwp_chnge ) ! intent(inout)
392 :
393 705888 : if ( l_linearize_pbl_winds ) then
394 : call clip_covar( nz, ngrdcol, gr, clip_vpwp, l_first_clip_ts, & ! intent(in)
395 : l_last_clip_ts, dt, wp2, vp2, & ! intent(in)
396 : l_predict_upwp_vpwp, & ! intent(in)
397 : stats_metadata, & ! intent(in)
398 : stats_zm, & ! intent(inout)
399 0 : vpwp_pert, vpwp_chnge ) ! intent(inout)
400 : endif ! l_linearize_pbl_winds
401 : else
402 : ! In this case, vp2 = wp2, and the variable `vp2' does not interact
403 : call clip_covar( nz, ngrdcol, gr, clip_vpwp, l_first_clip_ts, & ! intent(in)
404 : l_last_clip_ts, dt, wp2, wp2, & ! intent(in)
405 : l_predict_upwp_vpwp, & ! intent(in)
406 : stats_metadata, & ! intent(in)
407 : stats_zm, & ! intent(inout)
408 0 : vpwp, vpwp_chnge ) ! intent(inout)
409 :
410 0 : if ( l_linearize_pbl_winds ) then
411 : call clip_covar( nz, ngrdcol, gr, clip_vpwp, l_first_clip_ts, & ! intent(in)
412 : l_last_clip_ts, dt, wp2, wp2, & ! intent(in)
413 : l_predict_upwp_vpwp, & ! intent(in)
414 : stats_metadata, & ! intent(in) stats_metadata, & ! intent(in)
415 : stats_zm, & ! intent(inout)
416 0 : vpwp_pert, vpwp_chnge ) ! intent(inout)
417 : endif ! l_linearize_pbl_winds
418 : end if
419 :
420 : !$acc exit data delete( wprtp_chnge, wpthlp_chnge, upwp_chnge, vpwp_chnge )
421 : !$acc exit data if( sclr_dim > 0 ) delete( wpsclrp_chnge )
422 :
423 705888 : return
424 : end subroutine clip_covars_denom
425 :
426 : !=============================================================================
427 4588272 : subroutine clip_covar( nz, ngrdcol, gr, solve_type, l_first_clip_ts, &
428 4588272 : l_last_clip_ts, dt, xp2, yp2, &
429 : l_predict_upwp_vpwp, &
430 : stats_metadata, &
431 4588272 : stats_zm, &
432 4588272 : xpyp, xpyp_chnge )
433 :
434 : ! Description:
435 : ! Clipping the value of covariance x'y' based on the correlation between x
436 : ! and y.
437 : !
438 : ! The correlation between variables x and y is:
439 : !
440 : ! corr_(x,y) = x'y' / [ sqrt(x'^2) * sqrt(y'^2) ];
441 : !
442 : ! where x'^2 is the variance of x, y'^2 is the variance of y, and x'y' is
443 : ! the covariance of x and y.
444 : !
445 : ! The correlation of two variables must always have a value between -1
446 : ! and 1, such that:
447 : !
448 : ! -1 <= corr_(x,y) <= 1.
449 : !
450 : ! Therefore, there is an upper limit on x'y', such that:
451 : !
452 : ! x'y' <= [ sqrt(x'^2) * sqrt(y'^2) ];
453 : !
454 : ! and a lower limit on x'y', such that:
455 : !
456 : ! x'y' >= -[ sqrt(x'^2) * sqrt(y'^2) ].
457 : !
458 : ! The values of x'y', x'^2, and y'^2 are all found on momentum levels.
459 : !
460 : ! The value of x'y' may need to be clipped whenever x'y', x'^2, or y'^2 is
461 : ! updated.
462 : !
463 : ! The following covariances are found in the code:
464 : !
465 : ! w'r_t', w'th_l', w'sclr', (computed in advance_xm_wpxp);
466 : ! r_t'th_l', sclr'r_t', sclr'th_l', (computed in advance_xp2_xpyp);
467 : ! u'w', v'w', w'edsclr' (computed in advance_windm_edsclrm);
468 : ! and w'hm' (computed in setup_pdf_parameters).
469 :
470 : ! References:
471 : ! None
472 : !-----------------------------------------------------------------------
473 :
474 : use grid_class, only: &
475 : grid ! Type
476 :
477 : use constants_clubb, only: &
478 : max_mag_correlation, & ! Constant(s)
479 : max_mag_correlation_flux
480 :
481 : use clubb_precision, only: &
482 : core_rknd ! Variable(s)
483 :
484 : use stats_type_utilities, only: &
485 : stat_begin_update, & ! Procedure(s)
486 : stat_modify, &
487 : stat_end_update
488 :
489 : use stats_variables, only: &
490 : stats_metadata_type
491 :
492 : use stats_type, only: stats ! Type
493 :
494 : implicit none
495 :
496 : ! -------------------------- Input Variables --------------------------
497 : integer, intent(in) :: &
498 : nz, &
499 : ngrdcol
500 :
501 : type (grid), target, intent(in) :: gr
502 :
503 : integer, intent(in) :: &
504 : solve_type ! Variable being solved; used for STATS.
505 :
506 : logical, intent(in) :: &
507 : l_first_clip_ts, & ! First instance of clipping in a timestep.
508 : l_last_clip_ts ! Last instance of clipping in a timestep.
509 :
510 : real( kind = core_rknd ), intent(in) :: &
511 : dt ! Model timestep; used here for STATS [s]
512 :
513 : real( kind = core_rknd ), dimension(ngrdcol,nz), intent(in) :: &
514 : xp2, & ! Variance of x, x'^2 (momentum levels) [{x units}^2]
515 : yp2 ! Variance of y, y'^2 (momentum levels) [{y units}^2]
516 :
517 : logical, intent(in) :: &
518 : l_predict_upwp_vpwp ! Flag to predict <u'w'> and <v'w'> along with <u> and <v> alongside the
519 : ! advancement of <rt>, <w'rt'>, <thl>, <wpthlp>, <sclr>, and <w'sclr'> in
520 : ! subroutine advance_xm_wpxp. Otherwise, <u'w'> and <v'w'> are still
521 : ! approximated by eddy diffusivity when <u> and <v> are advanced in
522 : ! subroutine advance_windm_edsclrm.
523 :
524 : type (stats_metadata_type), intent(in) :: &
525 : stats_metadata
526 :
527 : ! -------------------------- InOut Variables --------------------------
528 : type (stats), target, dimension(ngrdcol), intent(inout) :: &
529 : stats_zm
530 :
531 : real( kind = core_rknd ), dimension(ngrdcol,nz), intent(inout) :: &
532 : xpyp ! Covariance of x and y, x'y' (momentum levels) [{x units}*{y units}]
533 :
534 : !-------------------------- Output Variable --------------------------
535 : real( kind = core_rknd ), dimension(ngrdcol,nz), intent(out) :: &
536 : xpyp_chnge ! Net change in x'y' due to clipping [{x units}*{y units}]
537 :
538 :
539 : ! -------------------------- Local Variables --------------------------
540 : real( kind = core_rknd ) :: &
541 : max_mag_corr, & ! Maximum magnitude of a correlation allowed
542 : xpyp_bound
543 :
544 : integer :: i, k ! Array index
545 :
546 : integer :: &
547 : ixpyp_cl
548 :
549 : ! -------------------------- Begin Code --------------------------
550 :
551 5647104 : select case ( solve_type )
552 : case ( clip_wprtp ) ! wprtp clipping budget term
553 1058832 : ixpyp_cl = stats_metadata%iwprtp_cl
554 : case ( clip_wpthlp ) ! wpthlp clipping budget term
555 1058832 : ixpyp_cl = stats_metadata%iwpthlp_cl
556 : case ( clip_rtpthlp ) ! rtpthlp clipping budget term
557 352944 : ixpyp_cl = stats_metadata%irtpthlp_cl
558 : case ( clip_upwp ) ! upwp clipping budget term
559 1058832 : if ( l_predict_upwp_vpwp ) then
560 1058832 : ixpyp_cl = stats_metadata%iupwp_cl
561 : else
562 0 : ixpyp_cl = 0
563 : endif ! l_predict_upwp_vpwp
564 : case ( clip_vpwp ) ! vpwp clipping budget term
565 1058832 : if ( l_predict_upwp_vpwp ) then
566 1058832 : ixpyp_cl = stats_metadata%ivpwp_cl
567 : else
568 0 : ixpyp_cl = 0
569 : endif ! l_predict_upwp_vpwp
570 : case default ! scalars (or upwp/vpwp) are involved
571 4588272 : ixpyp_cl = 0
572 : end select
573 :
574 :
575 4588272 : if ( stats_metadata%l_stats_samp ) then
576 :
577 : !$acc update host( xpyp )
578 :
579 0 : if ( l_first_clip_ts ) then
580 0 : do i = 1, ngrdcol
581 0 : call stat_begin_update( nz, ixpyp_cl, xpyp(i,:) / dt, & ! intent(in)
582 0 : stats_zm(i) ) ! intent(inout)
583 : end do
584 : else
585 0 : do i = 1, ngrdcol
586 0 : call stat_modify( nz, ixpyp_cl, -xpyp(i,:) / dt, & ! intent(in)
587 0 : stats_zm(i) ) ! intent(inout)
588 : end do
589 : endif
590 : endif
591 :
592 : ! When clipping for wprtp or wpthlp, use the special value for
593 : ! max_mag_correlation_flux. For all other correlations, use
594 : ! max_mag_correlation.
595 : if ( ( solve_type == clip_wprtp ) .or. ( solve_type == clip_wpthlp ) ) then
596 : max_mag_corr = max_mag_correlation_flux
597 : else ! All other covariances
598 : max_mag_corr = max_mag_correlation
599 : endif ! solve_type
600 :
601 : ! The value of x'y' at the surface (or lower boundary) is a set value that
602 : ! is either specified or determined elsewhere in a surface subroutine. It
603 : ! is ensured elsewhere that the correlation between x and y at the surface
604 : ! (or lower boundary) is between -1 and 1. Thus, the covariance clipping
605 : ! code does not need to be invoked at the lower boundary. Likewise, the
606 : ! value of x'y' is set at the upper boundary, so the covariance clipping
607 : ! code does not need to be invoked at the upper boundary.
608 : ! Note that if clipping were applied at the lower boundary, momentum will
609 : ! not be conserved, therefore it should never be added.
610 : !$acc parallel loop gang vector collapse(2) default(present)
611 385414848 : do k = 2, nz-1
612 6363506448 : do i = 1, ngrdcol
613 5978091600 : xpyp_bound = max_mag_corr * sqrt( xp2(i,k) * yp2(i,k) )
614 :
615 : ! Clipping for xpyp at an upper limit corresponding with a correlation
616 : ! between x and y of max_mag_corr.
617 6358918176 : if ( xpyp(i,k) > xpyp_bound ) then
618 :
619 4825238 : xpyp_chnge(i,k) = xpyp_bound - xpyp(i,k)
620 4825238 : xpyp(i,k) = xpyp_bound
621 :
622 : ! Clipping for xpyp at a lower limit corresponding with a correlation
623 : ! between x and y of -max_mag_corr.
624 5973266362 : else if ( xpyp(i,k) < -xpyp_bound ) then
625 :
626 2249628 : xpyp_chnge(i,k) = -xpyp_bound - xpyp(i,k)
627 2249628 : xpyp(i,k) = -xpyp_bound
628 :
629 : else
630 :
631 5971016734 : xpyp_chnge(i,k) = 0.0_core_rknd
632 :
633 : end if
634 : end do
635 : end do
636 : !$acc end parallel loop
637 :
638 : ! Since there is no covariance clipping at the upper or lower boundaries,
639 : ! the change in x'y' due to covariance clipping at those levels is 0.
640 : !$acc parallel loop gang vector default(present)
641 76613472 : do i = 1, ngrdcol
642 72025200 : xpyp_chnge(i,1) = 0.0_core_rknd
643 76613472 : xpyp_chnge(i,nz) = 0.0_core_rknd
644 : end do
645 : !$acc end parallel loop
646 :
647 4588272 : if ( stats_metadata%l_stats_samp ) then
648 :
649 : !$acc update host( xpyp )
650 :
651 0 : if ( l_last_clip_ts ) then
652 0 : do i = 1, ngrdcol
653 0 : call stat_end_update( nz, ixpyp_cl, xpyp(i,:) / dt, & ! intent(in)
654 0 : stats_zm(i) ) ! intent(inout)
655 : end do
656 : else
657 0 : do i = 1, ngrdcol
658 0 : call stat_modify( nz, ixpyp_cl, xpyp(i,:) / dt, & ! intent(in)
659 0 : stats_zm(i) ) ! intent(inout)
660 : end do
661 : endif
662 : endif
663 :
664 4588272 : return
665 :
666 : end subroutine clip_covar
667 :
668 : !=============================================================================
669 0 : subroutine clip_covar_level( solve_type, level, l_first_clip_ts, &
670 : l_last_clip_ts, dt, xp2, yp2, &
671 : l_predict_upwp_vpwp, &
672 : stats_metadata, &
673 : stats_zm, &
674 : xpyp, xpyp_chnge )
675 :
676 : ! Description:
677 : ! Clipping the value of covariance x'y' based on the correlation between x
678 : ! and y. This is all done at a single vertical level.
679 : !
680 : ! The correlation between variables x and y is:
681 : !
682 : ! corr_(x,y) = x'y' / [ sqrt(x'^2) * sqrt(y'^2) ];
683 : !
684 : ! where x'^2 is the variance of x, y'^2 is the variance of y, and x'y' is
685 : ! the covariance of x and y.
686 : !
687 : ! The correlation of two variables must always have a value between -1
688 : ! and 1, such that:
689 : !
690 : ! -1 <= corr_(x,y) <= 1.
691 : !
692 : ! Therefore, there is an upper limit on x'y', such that:
693 : !
694 : ! x'y' <= [ sqrt(x'^2) * sqrt(y'^2) ];
695 : !
696 : ! and a lower limit on x'y', such that:
697 : !
698 : ! x'y' >= -[ sqrt(x'^2) * sqrt(y'^2) ].
699 : !
700 : ! The values of x'y', x'^2, and y'^2 are all found on momentum levels.
701 : !
702 : ! The value of x'y' may need to be clipped whenever x'y', x'^2, or y'^2 is
703 : ! updated.
704 : !
705 : ! The following covariances are found in the code:
706 : !
707 : ! w'r_t', w'th_l', w'sclr', (computed in advance_xm_wpxp);
708 : ! r_t'th_l', sclr'r_t', sclr'th_l', (computed in advance_xp2_xpyp);
709 : ! u'w', v'w', w'edsclr' (computed in advance_windm_edsclrm);
710 : ! and w'hm' (computed in setup_pdf_parameters).
711 :
712 : ! References:
713 : ! None
714 : !-----------------------------------------------------------------------
715 :
716 : use constants_clubb, only: &
717 : max_mag_correlation, & ! Constant(s)
718 : max_mag_correlation_flux, &
719 : zero
720 :
721 : use clubb_precision, only: &
722 : core_rknd ! Variable(s)
723 :
724 : use stats_type_utilities, only: &
725 : stat_begin_update_pt, & ! Procedure(s)
726 : stat_modify_pt, &
727 : stat_end_update_pt
728 :
729 : use stats_variables, only: &
730 : stats_metadata_type
731 :
732 : use stats_type, only: stats ! Type
733 :
734 : implicit none
735 :
736 : type (stats), target, intent(inout) :: &
737 : stats_zm
738 :
739 : !------------------------- Input Variables -------------------------
740 : integer, intent(in) :: &
741 : solve_type, & ! Variable being solved; used for STATS
742 : level ! Vertical level index
743 :
744 : logical, intent(in) :: &
745 : l_first_clip_ts, & ! First instance of clipping in a timestep.
746 : l_last_clip_ts ! Last instance of clipping in a timestep.
747 :
748 : real( kind = core_rknd ), intent(in) :: &
749 : dt ! Model timestep; used here for STATS [s]
750 :
751 : real( kind = core_rknd ), intent(in) :: &
752 : xp2, & ! Variance of x, <x'^2> [{x units}^2]
753 : yp2 ! Variance of y, <y'^2> [{y units}^2]
754 :
755 : logical, intent(in) :: &
756 : l_predict_upwp_vpwp ! Flag to predict <u'w'> and <v'w'> along with <u> and <v> alongside the
757 : ! advancement of <rt>, <w'rt'>, <thl>, <wpthlp>, <sclr>, and <w'sclr'> in
758 : ! subroutine advance_xm_wpxp. Otherwise, <u'w'> and <v'w'> are still
759 : ! approximated by eddy diffusivity when <u> and <v> are advanced in
760 : ! subroutine advance_windm_edsclrm.
761 :
762 : type (stats_metadata_type), intent(in) :: &
763 : stats_metadata
764 :
765 : !------------------------- InOut Variable -------------------------
766 : real( kind = core_rknd ), intent(inout) :: &
767 : xpyp ! Covariance of x and y, <x'y'> [{x units}*{y units}]
768 :
769 : !------------------------- Output Variable -------------------------
770 : real( kind = core_rknd ), intent(out) :: &
771 : xpyp_chnge ! Net change in <x'y'> due to clipping [{x units}*{y units}]
772 :
773 :
774 : !------------------------- Local Variables -------------------------
775 : real( kind = core_rknd ) :: &
776 : max_mag_corr ! Maximum magnitude of a correlation allowed
777 :
778 : integer :: &
779 : ixpyp_cl ! Statistics index
780 :
781 : !------------------------- Begin Code -------------------------
782 :
783 0 : select case ( solve_type )
784 : case ( clip_wprtp ) ! wprtp clipping budget term
785 0 : ixpyp_cl = stats_metadata%iwprtp_cl
786 : case ( clip_wpthlp ) ! wpthlp clipping budget term
787 0 : ixpyp_cl = stats_metadata%iwpthlp_cl
788 : case ( clip_rtpthlp ) ! rtpthlp clipping budget term
789 0 : ixpyp_cl = stats_metadata%irtpthlp_cl
790 : case ( clip_upwp ) ! upwp clipping budget term
791 0 : if ( l_predict_upwp_vpwp ) then
792 0 : ixpyp_cl = stats_metadata%iupwp_cl
793 : else
794 0 : ixpyp_cl = 0
795 : endif ! l_predict_upwp_vpwp
796 : case ( clip_vpwp ) ! vpwp clipping budget term
797 0 : if ( l_predict_upwp_vpwp ) then
798 0 : ixpyp_cl = stats_metadata%ivpwp_cl
799 : else
800 0 : ixpyp_cl = 0
801 : endif ! l_predict_upwp_vpwp
802 : case default ! scalars (or upwp/vpwp) are involved
803 0 : ixpyp_cl = 0
804 : end select
805 :
806 :
807 0 : if ( stats_metadata%l_stats_samp ) then
808 0 : if ( l_first_clip_ts ) then
809 : call stat_begin_update_pt( ixpyp_cl, level, xpyp / dt, & ! intent(in)
810 0 : stats_zm ) ! intent(inout)
811 : else
812 : call stat_modify_pt( ixpyp_cl, level, -xpyp / dt, & ! intent(in)
813 0 : stats_zm ) ! intent(inout)
814 : endif
815 : endif
816 :
817 : ! When clipping for wprtp or wpthlp, use the special value for
818 : ! max_mag_correlation_flux. For all other correlations, use
819 : ! max_mag_correlation.
820 : if ( ( solve_type == clip_wprtp ) .or. ( solve_type == clip_wpthlp ) ) then
821 : max_mag_corr = max_mag_correlation_flux
822 : else ! All other covariances
823 : max_mag_corr = max_mag_correlation
824 : endif ! solve_type
825 :
826 : ! The value of x'y' at the surface (or lower boundary) is a set value that
827 : ! is either specified or determined elsewhere in a surface subroutine. It
828 : ! is ensured elsewhere that the correlation between x and y at the surface
829 : ! (or lower boundary) is between -1 and 1. Thus, the covariance clipping
830 : ! code does not need to be invoked at the lower boundary. Likewise, the
831 : ! value of x'y' is set at the upper boundary, so the covariance clipping
832 : ! code does not need to be invoked at the upper boundary.
833 : ! Note that if clipping were applied at the lower boundary, momentum will
834 : ! not be conserved, therefore it should never be added.
835 :
836 : ! Clipping for xpyp at an upper limit corresponding with a correlation
837 : ! between x and y of max_mag_corr.
838 0 : if ( xpyp > max_mag_corr * sqrt( xp2 * yp2 ) ) then
839 :
840 0 : xpyp_chnge = max_mag_corr * sqrt( xp2 * yp2 ) - xpyp
841 :
842 0 : xpyp = max_mag_corr * sqrt( xp2 * yp2 )
843 :
844 : ! Clipping for xpyp at a lower limit corresponding with a correlation
845 : ! between x and y of -max_mag_corr.
846 0 : elseif ( xpyp < -max_mag_corr * sqrt( xp2 * yp2 ) ) then
847 :
848 0 : xpyp_chnge = -max_mag_corr * sqrt( xp2 * yp2 ) - xpyp
849 :
850 0 : xpyp = -max_mag_corr * sqrt( xp2 * yp2 )
851 :
852 : else
853 :
854 0 : xpyp_chnge = zero
855 :
856 : endif
857 :
858 0 : if ( stats_metadata%l_stats_samp ) then
859 0 : if ( l_last_clip_ts ) then
860 : call stat_end_update_pt( ixpyp_cl, level, xpyp / dt, & ! intent(in)
861 0 : stats_zm ) ! intent(inout)
862 : else
863 : call stat_modify_pt( ixpyp_cl, level, xpyp / dt, & ! intent(in)
864 0 : stats_zm ) ! intent(inout)
865 : endif
866 : endif
867 :
868 :
869 0 : return
870 : end subroutine clip_covar_level
871 :
872 : !=============================================================================
873 1764720 : subroutine clip_variance( nz, ngrdcol, gr, solve_type, dt, threshold, &
874 : stats_metadata, &
875 1764720 : stats_zm, &
876 1764720 : xp2 )
877 :
878 : ! Description:
879 : ! Clipping the value of variance x'^2 based on a minimum threshold value.
880 : ! The threshold value must be greater than or equal to 0.
881 : !
882 : ! The values of x'^2 are found on the momentum levels.
883 : !
884 : ! The following variances are found in the code:
885 : !
886 : ! r_t'^2, th_l'^2, u'^2, v'^2, sclr'^2, (computed in advance_xp2_xpyp);
887 : ! w'^2 (computed in advance_wp2_wp3).
888 :
889 : ! References:
890 : ! None
891 : !-----------------------------------------------------------------------
892 :
893 : use grid_class, only: &
894 : grid ! Type
895 :
896 : use clubb_precision, only: &
897 : core_rknd ! Variable(s)
898 :
899 : use stats_type_utilities, only: &
900 : stat_begin_update, & ! Procedure(s)
901 : stat_end_update
902 :
903 : use stats_variables, only: &
904 : stats_metadata_type
905 :
906 : use stats_type, only: stats ! Type
907 :
908 : implicit none
909 :
910 : ! -------------------- Input Variables --------------------
911 : integer, intent(in) :: &
912 : nz, &
913 : ngrdcol
914 :
915 : type (grid), target, intent(in) :: gr
916 :
917 : integer, intent(in) :: &
918 : solve_type ! Variable being solved; used for STATS.
919 :
920 : real( kind = core_rknd ), intent(in) :: &
921 : dt ! Model timestep; used here for STATS [s]
922 :
923 : real( kind = core_rknd ), dimension(ngrdcol,nz), intent(in) :: &
924 : threshold ! Minimum value of x'^2 [{x units}^2]
925 :
926 : type (stats_metadata_type), intent(in) :: &
927 : stats_metadata
928 :
929 : ! -------------------- InOut Variables --------------------
930 : type (stats), target, dimension(ngrdcol), intent(inout) :: &
931 : stats_zm
932 :
933 : ! -------------------- Output Variable --------------------
934 : real( kind = core_rknd ), dimension(ngrdcol,nz), intent(inout) :: &
935 : xp2 ! Variance of x, x'^2 (momentum levels) [{x units}^2]
936 :
937 : ! -------------------- Local Variables --------------------
938 : integer :: i, k ! Array index
939 :
940 : integer :: &
941 : ixp2_cl
942 :
943 : ! -------------------- Begin Code --------------------
944 :
945 : !$acc data copyin( threshold ) &
946 : !$acc copy( xp2 )
947 :
948 2117664 : select case ( solve_type )
949 : case ( clip_wp2 ) ! wp2 clipping budget term
950 352944 : ixp2_cl = stats_metadata%iwp2_cl
951 : case ( clip_rtp2 ) ! rtp2 clipping budget term
952 352944 : ixp2_cl = stats_metadata%irtp2_cl
953 : case ( clip_thlp2 ) ! thlp2 clipping budget term
954 352944 : ixp2_cl = stats_metadata%ithlp2_cl
955 : case ( clip_up2 ) ! up2 clipping budget term
956 352944 : ixp2_cl = stats_metadata%iup2_cl
957 : case ( clip_vp2 ) ! vp2 clipping budget term
958 352944 : ixp2_cl = stats_metadata%ivp2_cl
959 : case default ! scalars are involved
960 1764720 : ixp2_cl = 0
961 : end select
962 :
963 :
964 1764720 : if ( stats_metadata%l_stats_samp ) then
965 : !$acc update host( xp2 )
966 0 : do i = 1, ngrdcol
967 0 : call stat_begin_update( nz, ixp2_cl, xp2(i,:) / dt, & ! intent(in)
968 0 : stats_zm(i) ) ! intent(inout)
969 : end do
970 : end if
971 :
972 : ! Limit the value of x'^2 at threshold.
973 : ! The value of x'^2 at the surface (or lower boundary) is a set value that
974 : ! is determined elsewhere in a surface subroutine. Thus, the variance
975 : ! clipping code does not need to be invoked at the lower boundary.
976 : ! Likewise, the value of x'^2 is set at the upper boundary, so the variance
977 : ! clipping code does not need to be invoked at the upper boundary.
978 : !
979 : ! charlass on 09/11/2013: I changed the clipping so that also the surface
980 : ! level is clipped. I did this because we discovered that there are slightly
981 : ! negative values in thlp2(1) and rtp2(1) when running quarter_ss case with
982 : ! WRF-CLUBB (see wrf:ticket:51#comment:33)
983 : !$acc parallel loop gang vector collapse(2) default(present)
984 150001200 : do k = 1, nz-1, 1
985 2476969200 : do i = 1, ngrdcol
986 2475204480 : if ( xp2(i,k) < threshold(i,k) ) then
987 2615958 : xp2(i,k) = threshold(i,k)
988 : end if
989 : end do
990 : end do
991 : !$acc end parallel loop
992 :
993 1764720 : if ( stats_metadata%l_stats_samp ) then
994 : !$acc update host( xp2 )
995 0 : do i = 1, ngrdcol
996 0 : call stat_end_update( nz, ixp2_cl, xp2(i,:) / dt, & ! intent(in)
997 0 : stats_zm(i) ) ! intent(inout)
998 : end do
999 : end if
1000 :
1001 : !$acc end data
1002 :
1003 1764720 : return
1004 :
1005 : end subroutine clip_variance
1006 :
1007 : !=============================================================================
1008 352944 : subroutine clip_skewness( nz, ngrdcol, gr, dt, sfc_elevation, & ! intent(in)
1009 352944 : Skw_max_mag, wp2_zt, & ! intent(in)
1010 : l_use_wp3_lim_with_smth_Heaviside, & ! intent(in)
1011 : stats_metadata, & ! intent(in)
1012 352944 : stats_zt, & ! intent(inout)
1013 352944 : wp3 ) ! intent(out)
1014 :
1015 : ! Description:
1016 : ! Clipping the value of w'^3 based on the skewness of w, Sk_w.
1017 : !
1018 : ! Aditionally, to prevent possible crashes due to wp3 growing too large,
1019 : ! abs(wp3) will be clipped to 100.
1020 : !
1021 : ! The skewness of w is:
1022 : !
1023 : ! Sk_w = w'^3 / (w'^2)^(3/2).
1024 : !
1025 : ! The value of Sk_w is limited to a range between an upper limit and a lower
1026 : ! limit. The values of the limits depend on whether the level altitude is
1027 : ! within 100 meters of the surface.
1028 : !
1029 : ! For altitudes less than or equal to 100 meters above ground level (AGL):
1030 : !
1031 : ! -0.2_core_rknd*sqrt(2) <= Sk_w <= 0.2_core_rknd*sqrt(2);
1032 : !
1033 : ! while for all altitudes greater than 100 meters AGL:
1034 : !
1035 : ! -4.5_core_rknd <= Sk_w <= 4.5_core_rknd.
1036 : !
1037 : ! Therefore, there is an upper limit on w'^3, such that:
1038 : !
1039 : ! w'^3 <= threshold_magnitude * (w'^2)^(3/2);
1040 : !
1041 : ! and a lower limit on w'^3, such that:
1042 : !
1043 : ! w'^3 >= -threshold_magnitude * (w'^2)^(3/2).
1044 : !
1045 : ! The values of w'^3 are found on the thermodynamic levels, while the values
1046 : ! of w'^2 are found on the momentum levels. Therefore, the values of w'^2
1047 : ! are interpolated to the thermodynamic levels before being used to
1048 : ! calculate the upper and lower limits for w'^3.
1049 :
1050 : ! References:
1051 : ! None
1052 : !-----------------------------------------------------------------------
1053 :
1054 : use grid_class, only: &
1055 : grid ! Type
1056 :
1057 : use clubb_precision, only: &
1058 : core_rknd ! Variable(s)
1059 :
1060 : use stats_type_utilities, only: &
1061 : stat_begin_update, & ! Procedure(s)
1062 : stat_end_update
1063 :
1064 : use stats_variables, only: &
1065 : stats_metadata_type
1066 :
1067 : use stats_type, only: stats ! Type
1068 :
1069 : implicit none
1070 :
1071 : ! ----------------------- Input Variables -----------------------
1072 : integer, intent(in) :: &
1073 : nz, &
1074 : ngrdcol
1075 :
1076 : type (grid), target, intent(in) :: gr
1077 :
1078 : real( kind = core_rknd ), intent(in) :: &
1079 : dt ! Model timestep; used here for STATS [s]
1080 :
1081 : real( kind = core_rknd ), dimension(ngrdcol), intent(in) :: &
1082 : sfc_elevation ! Elevation of ground level [m AMSL]
1083 :
1084 : real( kind = core_rknd ), intent(in) :: &
1085 : Skw_max_mag ! Maximum allowable magnitude of Skewness [-]
1086 :
1087 : real( kind = core_rknd ), dimension(ngrdcol,nz), intent(in) :: &
1088 : wp2_zt ! w'^2 interpolated to thermodyamic levels [m^2/s^2]
1089 :
1090 : ! Flag to activate modifications on wp3 limiters for convergence test
1091 : ! (use smooth Heaviside 'Preskin' function in the calculation of
1092 : ! clip_skewness for wp3)
1093 : logical, intent(in):: &
1094 : l_use_wp3_lim_with_smth_Heaviside
1095 :
1096 : type (stats_metadata_type), intent(in) :: &
1097 : stats_metadata
1098 :
1099 : ! ----------------------- Input/Output Variables -----------------------
1100 : type (stats), target, dimension(ngrdcol), intent(inout) :: &
1101 : stats_zt
1102 :
1103 : real( kind = core_rknd ), dimension(ngrdcol,nz), intent(inout) :: &
1104 : wp3 ! w'^3 (thermodynamic levels) [m^3/s^3]
1105 :
1106 : ! ----------------------- Local Variables -----------------------
1107 : integer :: i
1108 :
1109 : ! ----------------------- Begin Code -----------------------
1110 :
1111 : !$acc data copyin( gr, gr%zt, &
1112 : !$acc sfc_elevation, wp2_zt ) &
1113 : !$acc copy( wp3 )
1114 :
1115 352944 : if ( stats_metadata%l_stats_samp ) then
1116 :
1117 : !$acc update host( wp3 )
1118 :
1119 0 : do i = 1, ngrdcol
1120 0 : call stat_begin_update( nz, stats_metadata%iwp3_cl, wp3(i,:) / dt, & ! intent(in)
1121 0 : stats_zt(i) ) ! intent(inout)
1122 : end do
1123 : end if
1124 :
1125 : call clip_skewness_core( nz, ngrdcol, gr, sfc_elevation, & ! intent(in)
1126 : Skw_max_mag, wp2_zt, & ! intent(in)
1127 : l_use_wp3_lim_with_smth_Heaviside, & ! intent(in)
1128 352944 : wp3 ) ! intent(inout)
1129 :
1130 352944 : if ( stats_metadata%l_stats_samp ) then
1131 :
1132 : !$acc update host( wp3 )
1133 :
1134 0 : do i = 1, ngrdcol
1135 0 : call stat_end_update( nz, stats_metadata%iwp3_cl, wp3(i,:) / dt, & ! intent(in)
1136 0 : stats_zt(i) ) ! intent(inout)
1137 : end do
1138 : end if
1139 :
1140 : !$acc end data
1141 :
1142 352944 : return
1143 :
1144 : end subroutine clip_skewness
1145 :
1146 : !=============================================================================
1147 352944 : subroutine clip_skewness_core( nz, ngrdcol, gr, sfc_elevation, &
1148 352944 : Skw_max_mag, wp2_zt, &
1149 : l_use_wp3_lim_with_smth_Heaviside, &
1150 352944 : wp3 )
1151 :
1152 : use grid_class, only: &
1153 : grid ! Type
1154 :
1155 : use clubb_precision, only: &
1156 : core_rknd ! Variable(s)
1157 :
1158 : use advance_helper_module, only: &
1159 : smooth_heaviside_peskin
1160 :
1161 : implicit none
1162 :
1163 : !----------------------- Input Variables -----------------------
1164 : integer, intent(in) :: &
1165 : nz, &
1166 : ngrdcol
1167 :
1168 : type (grid), target, intent(in) :: gr
1169 :
1170 : real( kind = core_rknd ), dimension(ngrdcol), intent(in) :: &
1171 : sfc_elevation ! Elevation of ground level [m AMSL]
1172 :
1173 : real( kind = core_rknd ), intent(in) :: &
1174 : Skw_max_mag ! Maximum allowable magnitude of Skewness [-]
1175 :
1176 : real( kind = core_rknd ), dimension(ngrdcol,nz), intent(in) :: &
1177 : wp2_zt ! w'^2 interpolated to thermodyamic levels [m^2/s^2]
1178 :
1179 : ! Flag to activate modifications on wp3 limiters for convergence test
1180 : ! (use smooth Heaviside 'Preskin' function in the calculation of clip_skewness for wp3)
1181 : logical, intent(in):: &
1182 : l_use_wp3_lim_with_smth_Heaviside
1183 :
1184 : !----------------------- Input/Output Variables -----------------------
1185 : real( kind = core_rknd ), dimension(ngrdcol,nz), intent(inout) :: &
1186 : wp3 ! w'^3 (thermodynamic levels) [m^3/s^3]
1187 :
1188 : !----------------------- Local Variables -----------------------
1189 : real( kind = core_rknd ), dimension(ngrdcol,nz) :: &
1190 705888 : wp2_zt_cubed, & ! Variance of vertical velocity cubed (w^2_{zt}^3) [m^6/s^6]
1191 705888 : wp3_lim_sqd ! Keeps absolute value of Sk_w from becoming > limit [m^6/s^6]
1192 :
1193 : integer :: i, k ! Vertical array index.
1194 :
1195 : real( kind = core_rknd ), parameter :: &
1196 : wp3_max = 100._core_rknd ! Threshold for wp3 [m^3/s^3]
1197 :
1198 : real( kind = core_rknd ), dimension(ngrdcol,nz) :: &
1199 705888 : zagl_thresh, & ! temporatory array
1200 705888 : H_zagl ! Heaviside function for clippings of wp3_lim_sqd
1201 :
1202 : !----------------------- Begin Code-----------------------
1203 :
1204 : !$acc enter data create( wp2_zt_cubed, wp3_lim_sqd, zagl_thresh, H_zagl )
1205 :
1206 : ! Compute the upper and lower limits of w'^3 at every level,
1207 : ! based on the skewness of w, Sk_w, such that:
1208 : ! Sk_w = w'^3 / (w'^2)^(3/2);
1209 : ! -4.5 <= Sk_w <= 4.5;
1210 : ! or, if the level altitude is within 100 meters of the surface,
1211 : ! -0.2*sqrt(2) <= Sk_w <= 0.2*sqrt(2).
1212 :
1213 : ! The normal magnitude limit of skewness of w in the CLUBB code is 4.5.
1214 : ! However, according to Andre et al. (1976b & 1978), wp3 should not exceed
1215 : ! [2*(wp2^3)]^(1/2) at any level. However, this term should be multiplied
1216 : ! by 0.2 close to the surface to include surface effects. There already is
1217 : ! a wp3 clipping term in place for all other altitudes, but this term will
1218 : ! be included for the surface layer only. Therefore, the lowest level wp3
1219 : ! should not exceed 0.2 * sqrt(2) * wp2^(3/2). Brian Griffin. 12/18/05.
1220 :
1221 : ! To lower compute time, we squared both sides of the equation and compute
1222 : ! wp2^3 only once. -dschanen 9 Oct 2008
1223 : !$acc parallel loop gang vector collapse(2) default(present)
1224 30353184 : do k = 1, nz
1225 501287184 : do i = 1, ngrdcol
1226 500934240 : wp2_zt_cubed(i,k) = wp2_zt(i,k)**3
1227 : end do
1228 : end do
1229 : !$acc end parallel loop
1230 :
1231 352944 : if ( l_use_wp3_lim_with_smth_Heaviside ) then
1232 :
1233 : !implement a smoothed Heaviside function to avoid discontinuities
1234 : !$acc parallel loop gang vector collapse(2) default(present)
1235 0 : do k = 1, nz
1236 0 : do i = 1, ngrdcol
1237 0 : zagl_thresh(i,k) = ( gr%zt(i,k) - sfc_elevation(i) ) / 100.0_core_rknd
1238 0 : zagl_thresh(i,k) = zagl_thresh(i,k) - 1.0_core_rknd
1239 : end do
1240 : end do
1241 : !$acc end parallel loop
1242 :
1243 0 : H_zagl(:,:) = smooth_heaviside_peskin(nz, ngrdcol, zagl_thresh(:,:), 0.6_core_rknd)
1244 :
1245 : !$acc parallel loop gang vector collapse(2) default(present)
1246 0 : do k = 1, nz
1247 0 : do i = 1, ngrdcol
1248 0 : wp3_lim_sqd(i,k) = wp2_zt_cubed(i,k) &
1249 : * ( H_zagl(i,k) * Skw_max_mag**2 &
1250 : + (1.0_core_rknd - H_zagl(i,k)) &
1251 0 : * 0.0021_core_rknd *Skw_max_mag**2 )
1252 : end do
1253 : end do
1254 : !$acc end parallel loop
1255 :
1256 : else ! default method
1257 :
1258 : !$acc parallel loop gang vector collapse(2) default(present)
1259 30353184 : do k = 1, nz
1260 501287184 : do i = 1, ngrdcol
1261 500934240 : if ( gr%zt(i,k) - sfc_elevation(i) <= 100.0_core_rknd ) then ! Clip for 100 m. AGL.
1262 : !wp3_upper_lim(k) = 0.2_core_rknd * sqrt_2 * wp2_zt(k)**(3.0_core_rknd/2.0_core_rknd)
1263 : !wp3_lower_lim(k) = -0.2_core_rknd * sqrt_2 * wp2_zt(k)**(3.0_core_rknd/2.0_core_rknd)
1264 16621200 : wp3_lim_sqd(i,k) = 0.0021_core_rknd * Skw_max_mag**2 * wp2_zt_cubed(i,k)
1265 : else ! Clip skewness consistently with a.
1266 : !wp3_upper_lim(k) = 4.5_core_rknd * wp2_zt(k)**(3.0_core_rknd/2.0_core_rknd)
1267 : !wp3_lower_lim(k) = -4.5_core_rknd * wp2_zt(k)**(3.0_core_rknd/2.0_core_rknd)
1268 454312800 : wp3_lim_sqd(i,k) = Skw_max_mag**2 * wp2_zt_cubed(i,k) ! Skw_max_mag = 4.5_core_rknd^2
1269 : endif
1270 : end do
1271 : end do
1272 : !$acc end parallel loop
1273 :
1274 : end if
1275 :
1276 : ! Clipping for w'^3 at an upper and lower limit corresponding with
1277 : ! the appropriate value of Sk_w.
1278 : !$acc parallel loop gang vector collapse(2) default(present)
1279 30353184 : do k = 1, nz
1280 501287184 : do i = 1, ngrdcol
1281 : ! Set the magnitude to the wp3 limit and apply the sign of the current wp3
1282 500934240 : if ( wp3(i,k)**2 > wp3_lim_sqd(i,k) ) then
1283 5091482 : wp3(i,k) = sign( sqrt( wp3_lim_sqd(i,k) ), wp3(i,k) )
1284 : end if
1285 : end do
1286 : end do
1287 : !$acc end parallel loop
1288 :
1289 : ! Clipping abs(wp3) to 100. This keeps wp3 from growing too large in some
1290 : ! deep convective cases, which helps prevent these cases from blowing up.
1291 : !$acc parallel loop gang vector collapse(2) default(present)
1292 30353184 : do k = 1, nz
1293 501287184 : do i = 1, ngrdcol
1294 500934240 : if ( abs(wp3(i,k)) > wp3_max ) then
1295 0 : wp3(i,k) = sign( wp3_max, wp3(i,k) ) ! Known magic number
1296 : end if
1297 : end do
1298 : end do
1299 : !$acc end parallel loop
1300 :
1301 : !$acc exit data delete( wp2_zt_cubed, wp3_lim_sqd, zagl_thresh, H_zagl )
1302 :
1303 352944 : end subroutine clip_skewness_core
1304 :
1305 : !===============================================================================
1306 :
1307 : end module clip_explicit
|