Line data Source code
1 :
2 : module advance_helper_module
3 :
4 : ! Description:
5 : ! This module contains helper methods for the advance_* modules.
6 : !------------------------------------------------------------------------
7 :
8 : implicit none
9 :
10 : public :: &
11 : set_boundary_conditions_lhs, &
12 : set_boundary_conditions_rhs, &
13 : calc_stability_correction, &
14 : calc_brunt_vaisala_freq_sqd, &
15 : compute_Cx_fnc_Richardson, &
16 : wp2_term_splat_lhs, &
17 : wp3_term_splat_lhs, &
18 : smooth_min, smooth_max, &
19 : smooth_heaviside_peskin, &
20 : calc_xpwp, &
21 : vertical_avg, &
22 : vertical_integral, &
23 : Lscale_width_vert_avg
24 :
25 : interface calc_xpwp
26 : module procedure calc_xpwp_1D
27 : module procedure calc_xpwp_2D
28 : end interface
29 :
30 : private ! Set Default Scope
31 :
32 : !===============================================================================
33 : interface smooth_min
34 :
35 : ! These functions smooth the output of the min function
36 : ! by introducing a varyingly steep path between the two input variables.
37 : ! The degree to which smoothing is applied depends on the value of 'smth_coef'.
38 : ! If 'smth_coef' goes toward 0, the output of the min function will be
39 : ! 0.5 * ((a+b) - abs(a-b))
40 : ! If a > b, then this comes out to be b. Likewise, if a < b, abs(a-b)=b-a so we get a.
41 : ! Increasing the smoothing coefficient will lead to a greater degree of smoothing
42 : ! in the smooth min and max functions. Generally, the coefficient should roughly scale
43 : ! with the magnitude of data in the data structure that is to be smoothed, in order to
44 : ! obtain a sensible degree of smoothing (not too much, not too little).
45 :
46 : module procedure smooth_min_scalar_array
47 : module procedure smooth_min_array_scalar
48 : module procedure smooth_min_arrays
49 : module procedure smooth_min_scalars
50 :
51 : end interface
52 :
53 : !===============================================================================
54 : interface smooth_max
55 :
56 : ! These functions smooth the output of the max functions
57 : ! by introducing a varyingly steep path between the two input variables.
58 : ! The degree to which smoothing is applied depends on the value of 'smth_coef'.
59 : ! If 'smth_coef' goes toward 0, the output of the max function will be
60 : ! 0.5 * ((a+b) + abs(a-b))
61 : ! If a > b, then this comes out to be a. Likewise, if a < b, abs(a-b)=b-a so we get b.
62 : ! Increasing the smoothing coefficient will lead to a greater degree of smoothing
63 : ! in the smooth min and max functions. Generally, the coefficient should roughly scale
64 : ! with the magnitude of data in the data structure that is to be smoothed, in order to
65 : ! obtain a sensible degree of smoothing (not too much, not too little).
66 :
67 : module procedure smooth_max_scalar_array
68 : module procedure smooth_max_array_scalar
69 : module procedure smooth_max_arrays
70 : module procedure smooth_max_scalars
71 :
72 : end interface
73 :
74 : !===============================================================================
75 : contains
76 :
77 : !---------------------------------------------------------------------------
78 0 : subroutine set_boundary_conditions_lhs( diag_index, low_bound, high_bound, &
79 0 : lhs, &
80 : diag_index2, low_bound2, high_bound2 )
81 :
82 : ! Description:
83 : ! Sets the boundary conditions for a left-hand side LAPACK matrix.
84 : !
85 : ! References:
86 : ! none
87 : !---------------------------------------------------------------------------
88 :
89 : use clubb_precision, only: &
90 : core_rknd ! Variable(s)
91 :
92 : use constants_clubb, only: &
93 : one, zero
94 :
95 : implicit none
96 :
97 : ! Exernal
98 : intrinsic :: present
99 :
100 : ! Input Variables
101 : integer, intent(in) :: &
102 : diag_index, low_bound, high_bound ! boundary indexes for the first variable
103 :
104 : ! Input / Output Variables
105 : real( kind = core_rknd ), dimension(:,:), intent(inout) :: &
106 : lhs ! left hand side of the LAPACK matrix equation
107 :
108 : ! Optional Input Variables
109 : integer, intent(in), optional :: &
110 : diag_index2, low_bound2, high_bound2 ! boundary indexes for the second variable
111 :
112 : ! --------------------- BEGIN CODE ----------------------
113 :
114 0 : if ( ( present( low_bound2 ) .or. present( high_bound2 ) ) .and. &
115 : ( .not. present( diag_index2 ) ) ) then
116 :
117 0 : error stop "Boundary index provided without diag_index."
118 :
119 : end if
120 :
121 : ! Set the lower boundaries for the first variable
122 0 : lhs(:,low_bound) = zero
123 0 : lhs(diag_index,low_bound) = one
124 :
125 : ! Set the upper boundaries for the first variable
126 0 : lhs(:,high_bound) = zero
127 0 : lhs(diag_index,high_bound) = one
128 :
129 : ! Set the lower boundaries for the second variable, if it is provided
130 0 : if ( present( low_bound2 ) ) then
131 :
132 0 : lhs(:,low_bound2) = zero
133 0 : lhs(diag_index2,low_bound2) = one
134 :
135 : end if
136 :
137 : ! Set the upper boundaries for the second variable, if it is provided
138 0 : if ( present( high_bound2 ) ) then
139 :
140 0 : lhs(:,high_bound2) = zero
141 0 : lhs(diag_index2,high_bound2) = one
142 :
143 : end if
144 :
145 0 : return
146 : end subroutine set_boundary_conditions_lhs
147 :
148 : !--------------------------------------------------------------------------
149 0 : subroutine set_boundary_conditions_rhs( &
150 : low_value, low_bound, high_value, high_bound, &
151 0 : rhs, &
152 : low_value2, low_bound2, high_value2, high_bound2 )
153 :
154 : ! Description:
155 : ! Sets the boundary conditions for a right-hand side LAPACK vector.
156 : !
157 : ! References:
158 : ! none
159 : !---------------------------------------------------------------------------
160 :
161 : use clubb_precision, only: &
162 : core_rknd ! Variable(s)
163 :
164 : implicit none
165 :
166 : ! Exernal
167 : intrinsic :: present
168 :
169 : ! Input Variables
170 :
171 : ! The values for the first variable
172 : real( kind = core_rknd ), intent(in) :: low_value, high_value
173 :
174 : ! The bounds for the first variable
175 : integer, intent(in) :: low_bound, high_bound
176 :
177 : ! Input / Output Variables
178 :
179 : ! The right-hand side vector
180 : real( kind = core_rknd ), dimension(:), intent(inout) :: rhs
181 :
182 : ! Optional Input Variables
183 :
184 : ! The values for the second variable
185 : real( kind = core_rknd ), intent(in), optional :: low_value2, high_value2
186 :
187 : ! The bounds for the second variable
188 : integer, intent(in), optional :: low_bound2, high_bound2
189 :
190 :
191 : ! -------------------- BEGIN CODE ------------------------
192 :
193 : ! Stop execution if a boundary was provided without a value
194 0 : if ( (present( low_bound2 ) .and. (.not. present( low_value2 ))) .or. &
195 : (present( high_bound2 ) .and. (.not. present( high_value2 ))) ) then
196 :
197 0 : error stop "Boundary condition provided without value."
198 :
199 : end if
200 :
201 : ! Set the lower and upper bounds for the first variable
202 0 : rhs(low_bound) = low_value
203 0 : rhs(high_bound) = high_value
204 :
205 : ! If a lower bound was given for the second variable, set it
206 0 : if ( present( low_bound2 ) ) then
207 0 : rhs(low_bound2) = low_value2
208 : end if
209 :
210 : ! If an upper bound was given for the second variable, set it
211 0 : if ( present( high_bound2 ) ) then
212 0 : rhs(high_bound2) = high_value2
213 : end if
214 :
215 0 : return
216 : end subroutine set_boundary_conditions_rhs
217 :
218 : !===============================================================================
219 352944 : subroutine calc_stability_correction( nz, ngrdcol, gr, &
220 352944 : thlm, Lscale, em, &
221 352944 : exner, rtm, rcm, &
222 352944 : p_in_Pa, thvm, ice_supersat_frac, &
223 : lambda0_stability_coef, &
224 : bv_efold, &
225 : l_brunt_vaisala_freq_moist, &
226 : l_use_thvm_in_bv_freq, &
227 352944 : stability_correction )
228 : !
229 : ! Description:
230 : ! Stability Factor
231 : !
232 : ! References:
233 : !
234 : !--------------------------------------------------------------------
235 :
236 : use constants_clubb, only: &
237 : zero, one, three ! Constant(s)
238 :
239 : use grid_class, only: &
240 : grid, & ! Type
241 : zt2zm ! Procedure(s)
242 :
243 : use clubb_precision, only: &
244 : core_rknd ! Variable(s)
245 :
246 : implicit none
247 :
248 : ! ---------------- Input Variables ----------------
249 : integer, intent(in) :: &
250 : nz, &
251 : ngrdcol
252 :
253 : type (grid), target, intent(in) :: gr
254 :
255 : real( kind = core_rknd ), intent(in), dimension(ngrdcol,nz) :: &
256 : Lscale, & ! Turbulent mixing length [m]
257 : em, & ! Turbulent Kinetic Energy (TKE) [m^2/s^2]
258 : thlm, & ! th_l (thermo. levels) [K]
259 : exner, & ! Exner function [-]
260 : rtm, & ! total water mixing ratio, r_t [kg/kg]
261 : rcm, & ! cloud water mixing ratio, r_c [kg/kg]
262 : p_in_Pa, & ! Air pressure [Pa]
263 : thvm, & ! Virtual potential temperature [K]
264 : ice_supersat_frac
265 :
266 : real( kind = core_rknd ), intent(in) :: &
267 : lambda0_stability_coef, & ! CLUBB tunable parameter lambda0_stability_coef
268 : bv_efold ! Control parameter for inverse e-folding of
269 : ! cloud fraction in the mixed Brunt Vaisala frequency
270 :
271 : logical, intent(in) :: &
272 : l_brunt_vaisala_freq_moist, & ! Use a different formula for the Brunt-Vaisala frequency in
273 : ! saturated atmospheres (from Durran and Klemp, 1982)
274 : l_use_thvm_in_bv_freq ! Use thvm in the calculation of Brunt-Vaisala frequency
275 :
276 : ! ---------------- Output Variables ----------------
277 : real( kind = core_rknd ), intent(out), dimension(ngrdcol,nz) :: &
278 : stability_correction
279 :
280 : ! ---------------- Local Variables ----------------
281 : real( kind = core_rknd ), dimension(ngrdcol,nz) :: &
282 705888 : brunt_vaisala_freq_sqd, & ! []
283 705888 : brunt_vaisala_freq_sqd_mixed, &
284 705888 : brunt_vaisala_freq_sqd_dry, & ! []
285 705888 : brunt_vaisala_freq_sqd_moist, &
286 705888 : lambda0_stability, &
287 705888 : Lscale_zm
288 :
289 : integer :: i, k
290 :
291 : !------------ Begin Code --------------
292 :
293 : !$acc enter data create( brunt_vaisala_freq_sqd, brunt_vaisala_freq_sqd_mixed, &
294 : !$acc brunt_vaisala_freq_sqd_moist, brunt_vaisala_freq_sqd_dry, &
295 : !$acc lambda0_stability, Lscale_zm )
296 :
297 : call calc_brunt_vaisala_freq_sqd( nz, ngrdcol, gr, thlm, & ! intent(in)
298 : exner, rtm, rcm, p_in_Pa, thvm, & ! intent(in)
299 : ice_supersat_frac, & ! intent(in)
300 : l_brunt_vaisala_freq_moist, & ! intent(in)
301 : l_use_thvm_in_bv_freq, & ! intent(in)
302 : bv_efold, & ! intent(in)
303 : brunt_vaisala_freq_sqd, & ! intent(out)
304 : brunt_vaisala_freq_sqd_mixed,& ! intent(out)
305 : brunt_vaisala_freq_sqd_dry, & ! intent(out)
306 352944 : brunt_vaisala_freq_sqd_moist ) ! intent(out)
307 :
308 : !$acc parallel loop gang vector collapse(2) default(present)
309 30353184 : do k = 1, nz
310 501287184 : do i = 1, ngrdcol
311 500934240 : if ( brunt_vaisala_freq_sqd(i,k) > zero ) then
312 456525552 : lambda0_stability(i,k) = lambda0_stability_coef
313 : else
314 14408448 : lambda0_stability(i,k) = zero
315 : end if
316 : end do
317 : end do
318 : !$acc end parallel loop
319 :
320 352944 : Lscale_zm = zt2zm( nz, ngrdcol, gr, Lscale(:,:) )
321 :
322 : !$acc parallel loop gang vector collapse(2) default(present)
323 30353184 : do k = 1, nz
324 501287184 : do i = 1, ngrdcol
325 941868000 : stability_correction(i,k) = one + min( lambda0_stability(i,k) * brunt_vaisala_freq_sqd(i,k) &
326 1442802240 : * Lscale_zm(i,k)**2 / em(i,k), three )
327 : end do
328 : end do
329 : !$acc end parallel loop
330 :
331 : !$acc exit data delete( brunt_vaisala_freq_sqd, brunt_vaisala_freq_sqd_mixed, &
332 : !$acc brunt_vaisala_freq_sqd_moist, brunt_vaisala_freq_sqd_dry, &
333 : !$acc lambda0_stability, Lscale_zm )
334 :
335 352944 : return
336 :
337 : end subroutine calc_stability_correction
338 :
339 : !===============================================================================
340 705888 : subroutine calc_brunt_vaisala_freq_sqd( nz, ngrdcol, gr, thlm, &
341 705888 : exner, rtm, rcm, p_in_Pa, thvm, &
342 705888 : ice_supersat_frac, &
343 : l_brunt_vaisala_freq_moist, &
344 : l_use_thvm_in_bv_freq, &
345 : bv_efold, &
346 705888 : brunt_vaisala_freq_sqd, &
347 705888 : brunt_vaisala_freq_sqd_mixed,&
348 705888 : brunt_vaisala_freq_sqd_dry, &
349 705888 : brunt_vaisala_freq_sqd_moist )
350 :
351 : ! Description:
352 : ! Calculate the Brunt-Vaisala frequency squared, N^2.
353 :
354 : ! References:
355 : ! ?
356 : !-----------------------------------------------------------------------
357 :
358 : use clubb_precision, only: &
359 : core_rknd ! Konstant
360 :
361 : use constants_clubb, only: &
362 : grav, & ! Constant(s)
363 : Lv, &
364 : Cp, &
365 : Rd, &
366 : ep, &
367 : one, &
368 : one_half, &
369 : zero_threshold
370 :
371 : use parameters_model, only: &
372 : T0 ! Variable!
373 :
374 : use grid_class, only: &
375 : grid, & ! Type
376 : ddzt, & ! Procedure(s)
377 : zt2zm
378 :
379 : use T_in_K_module, only: &
380 : thlm2T_in_K ! Procedure
381 :
382 : use saturation, only: &
383 : sat_mixrat_liq ! Procedure
384 :
385 : implicit none
386 :
387 : !---------------------------- Input Variables ----------------------------
388 : integer, intent(in) :: &
389 : nz, &
390 : ngrdcol
391 :
392 : type (grid), target, intent(in) :: gr
393 :
394 : real( kind = core_rknd ), dimension(ngrdcol,nz), intent(in) :: &
395 : thlm, & ! th_l (thermo. levels) [K]
396 : exner, & ! Exner function [-]
397 : rtm, & ! total water mixing ratio, r_t [kg/kg]
398 : rcm, & ! cloud water mixing ratio, r_c [kg/kg]
399 : p_in_Pa, & ! Air pressure [Pa]
400 : thvm, & ! Virtual potential temperature [K]
401 : ice_supersat_frac
402 :
403 : logical, intent(in) :: &
404 : l_brunt_vaisala_freq_moist, & ! Use a different formula for the Brunt-Vaisala frequency in
405 : ! saturated atmospheres (from Durran and Klemp, 1982)
406 : l_use_thvm_in_bv_freq ! Use thvm in the calculation of Brunt-Vaisala frequency
407 :
408 : real( kind = core_rknd ), intent(in) :: &
409 : bv_efold ! Control parameter for inverse e-folding of
410 : ! cloud fraction in the mixed Brunt Vaisala frequency
411 :
412 : !---------------------------- Output Variables ----------------------------
413 : real( kind = core_rknd ), dimension(ngrdcol,nz), intent(out) :: &
414 : brunt_vaisala_freq_sqd, & ! Brunt-Vaisala frequency squared, N^2 [1/s^2]
415 : brunt_vaisala_freq_sqd_mixed, &
416 : brunt_vaisala_freq_sqd_dry,&
417 : brunt_vaisala_freq_sqd_moist
418 :
419 : !---------------------------- Local Variables ----------------------------
420 : real( kind = core_rknd ), dimension(ngrdcol,nz) :: &
421 1411776 : T_in_K, T_in_K_zm, rsat, rsat_zm, thm, thm_zm, ddzt_thlm, &
422 1411776 : ddzt_thm, ddzt_rsat, ddzt_rtm, thvm_zm, ddzt_thvm
423 :
424 : real( kind = core_rknd ), dimension(ngrdcol,nz) :: &
425 1411776 : stat_dry, stat_liq, ddzt_stat_liq, ddzt_stat_liq_zm, &
426 1411776 : stat_dry_virtual, stat_dry_virtual_zm, ddzt_rtm_zm
427 :
428 : integer :: i, k
429 :
430 : !---------------------------- Begin Code ----------------------------
431 :
432 : !$acc data copyin( gr, gr%zt, &
433 : !$acc thlm, exner, rtm, rcm, p_in_Pa, thvm, ice_supersat_frac ) &
434 : !$acc copyout( brunt_vaisala_freq_sqd, brunt_vaisala_freq_sqd_mixed, &
435 : !$acc brunt_vaisala_freq_sqd_dry, brunt_vaisala_freq_sqd_moist ) &
436 : !$acc create( T_in_K, T_in_K_zm, rsat, rsat_zm, thm, thm_zm, ddzt_thlm, &
437 : !$acc ddzt_thm, ddzt_rsat, ddzt_rtm, thvm_zm, ddzt_thvm, stat_dry, &
438 : !$acc stat_liq, ddzt_stat_liq, ddzt_stat_liq_zm, stat_dry_virtual, &
439 : !$acc stat_dry_virtual_zm, ddzt_rtm_zm )
440 :
441 705888 : ddzt_thlm = ddzt( nz, ngrdcol, gr, thlm )
442 705888 : thvm_zm = zt2zm( nz, ngrdcol, gr, thvm )
443 705888 : ddzt_thvm = ddzt( nz, ngrdcol, gr, thvm )
444 :
445 : ! Dry Brunt-Vaisala frequency
446 705888 : if ( l_use_thvm_in_bv_freq ) then
447 :
448 : !$acc parallel loop gang vector collapse(2) default(present)
449 0 : do k = 1, nz
450 0 : do i = 1, ngrdcol
451 0 : brunt_vaisala_freq_sqd(i,k) = ( grav / thvm_zm(i,k) ) * ddzt_thvm(i,k)
452 : end do
453 : end do
454 : !$acc end parallel loop
455 :
456 : else
457 :
458 : !$acc parallel loop gang vector collapse(2) default(present)
459 60706368 : do k = 1, nz
460 1002574368 : do i = 1, ngrdcol
461 1001868480 : brunt_vaisala_freq_sqd(i,k) = ( grav / T0 ) * ddzt_thlm(i,k)
462 : end do
463 : end do
464 : !$acc end parallel loop
465 :
466 : end if
467 :
468 705888 : T_in_K = thlm2T_in_K( nz, ngrdcol, thlm, exner, rcm )
469 705888 : T_in_K_zm = zt2zm( nz, ngrdcol, gr, T_in_K )
470 705888 : rsat = sat_mixrat_liq( nz, ngrdcol, p_in_Pa, T_in_K )
471 705888 : rsat_zm = zt2zm( nz, ngrdcol, gr, rsat )
472 705888 : ddzt_rsat = ddzt( nz, ngrdcol, gr, rsat )
473 :
474 : !$acc parallel loop gang vector collapse(2) default(present)
475 60706368 : do k = 1, nz
476 1002574368 : do i = 1, ngrdcol
477 1001868480 : thm(i,k) = thlm(i,k) + Lv/(Cp*exner(i,k)) * rcm(i,k)
478 : end do
479 : end do
480 : !$acc end parallel loop
481 :
482 705888 : thm_zm = zt2zm( nz, ngrdcol, gr, thm )
483 705888 : ddzt_thm = ddzt( nz, ngrdcol, gr, thm )
484 705888 : ddzt_rtm = ddzt( nz, ngrdcol, gr, rtm )
485 :
486 : !$acc parallel loop gang vector collapse(2) default(present)
487 60706368 : do k = 1, nz
488 1002574368 : do i = 1, ngrdcol
489 941868000 : stat_dry(i,k) = Cp * T_in_K(i,k) + grav * gr%zt(i,k)
490 1001868480 : stat_liq(i,k) = stat_dry(i,k) - Lv * rcm(i,k)
491 : end do
492 : end do
493 : !$acc end parallel loop
494 :
495 705888 : ddzt_stat_liq = ddzt( nz, ngrdcol, gr, stat_liq )
496 705888 : ddzt_stat_liq_zm = zt2zm( nz, ngrdcol, gr, ddzt_stat_liq)
497 :
498 : !$acc parallel loop gang vector collapse(2) default(present)
499 60706368 : do k = 1, nz
500 1002574368 : do i = 1, ngrdcol
501 1883736000 : stat_dry_virtual(i,k) = stat_dry(i,k) + Cp * T_in_K(i,k) &
502 2885604480 : *( 0.608 * ( rtm(i,k) - rcm(i,k) )- rcm(i,k) )
503 : end do
504 : end do
505 : !$acc end parallel loop
506 :
507 705888 : stat_dry_virtual_zm = zt2zm( nz, ngrdcol, gr, stat_dry_virtual)
508 705888 : ddzt_rtm_zm = zt2zm( nz, ngrdcol, gr, ddzt_rtm )
509 :
510 : !$acc parallel loop gang vector collapse(2) default(present)
511 60706368 : do k = 1, nz
512 1002574368 : do i = 1, ngrdcol
513 1001868480 : brunt_vaisala_freq_sqd_dry(i,k) = ( grav / thm_zm(i,k) )* ddzt_thm(i,k)
514 : end do
515 : end do
516 : !$acc end parallel loop
517 :
518 : !$acc parallel loop gang vector collapse(2) default(present)
519 60706368 : do k = 1, nz
520 1002574368 : do i = 1, ngrdcol
521 : ! In-cloud Brunt-Vaisala frequency. This is Eq. (36) of Durran and
522 : ! Klemp (1982)
523 1883736000 : brunt_vaisala_freq_sqd_moist(i,k) = &
524 : grav * ( ((one + Lv*rsat_zm(i,k) / (Rd*T_in_K_zm(i,k))) / &
525 : (one + ep*(Lv**2)*rsat_zm(i,k)/(Cp*Rd*T_in_K_zm(i,k)**2))) * &
526 : ( (one/thm_zm(i,k) * ddzt_thm(i,k)) + (Lv/(Cp*T_in_K_zm(i,k)))*ddzt_rsat(i,k)) - &
527 2885604480 : ddzt_rtm(i,k) )
528 : end do
529 : end do ! k=1, gr%nz
530 : !$acc end parallel loop
531 :
532 : !$acc parallel loop gang vector collapse(2) default(present)
533 60706368 : do k = 1, nz
534 1002574368 : do i = 1, ngrdcol
535 1883736000 : brunt_vaisala_freq_sqd_mixed(i,k) = &
536 : brunt_vaisala_freq_sqd_moist(i,k) + &
537 : exp( - bv_efold * ice_supersat_frac(i,k) ) * &
538 2885604480 : ( brunt_vaisala_freq_sqd_dry(i,k) - brunt_vaisala_freq_sqd_moist(i,k) )
539 : end do
540 : end do
541 : !$acc end parallel loop
542 :
543 705888 : if ( l_brunt_vaisala_freq_moist ) then
544 :
545 0 : brunt_vaisala_freq_sqd = brunt_vaisala_freq_sqd_moist
546 :
547 : end if
548 :
549 : !$acc end data
550 :
551 705888 : return
552 :
553 : end subroutine calc_brunt_vaisala_freq_sqd
554 :
555 : !===============================================================================
556 0 : subroutine compute_Cx_fnc_Richardson( nz, ngrdcol, gr, &
557 0 : thlm, um, vm, em, Lscale, exner, rtm, &
558 0 : rcm, p_in_Pa, thvm, rho_ds_zm, &
559 0 : ice_supersat_frac, &
560 : clubb_params, &
561 : l_brunt_vaisala_freq_moist, &
562 : l_use_thvm_in_bv_freq, &
563 : l_use_shear_Richardson, &
564 : l_modify_limiters_for_cnvg_test, &
565 : stats_metadata, &
566 0 : stats_zm, &
567 0 : Cx_fnc_Richardson )
568 :
569 : ! Description:
570 : ! Compute Cx as a function of the Richardson number
571 :
572 : ! References:
573 : ! cam:ticket:59
574 : !-----------------------------------------------------------------------
575 :
576 : use clubb_precision, only: &
577 : core_rknd ! Konstant
578 :
579 : use grid_class, only: &
580 : grid, & ! Type
581 : ddzt, & ! Procedure(s)
582 : zt2zm, &
583 : zm2zt2zm
584 :
585 : use constants_clubb, only: &
586 : one, zero
587 :
588 : use interpolation, only: &
589 : linear_interp_factor ! Procedure
590 :
591 : use parameter_indices, only: &
592 : nparams, & ! Variable(s)
593 : iCx_min, &
594 : iCx_max, &
595 : iRichardson_num_min, &
596 : iRichardson_num_max, &
597 : ibv_efold
598 :
599 : use stats_variables, only: &
600 : stats_metadata_type
601 :
602 : use stats_type_utilities, only: &
603 : stat_update_var ! Procedure
604 :
605 : use stats_type, only: stats ! Type
606 :
607 : implicit none
608 :
609 : !------------------------------ Constant Parameters ------------------------------
610 : real( kind = core_rknd ), parameter :: &
611 : Richardson_num_divisor_threshold = 1.0e-6_core_rknd, &
612 : Cx_fnc_Richardson_below_ground_value = one
613 :
614 : logical, parameter :: &
615 : l_Cx_fnc_Richardson_vert_avg = .false. ! Vertically average Cx_fnc_Richardson over a
616 : ! distance of Lscale
617 :
618 : real( kind = core_rknd ), parameter :: &
619 : min_max_smth_mag = 1.0e-9_core_rknd ! "base" smoothing magnitude before scaling
620 : ! for the respective data structure. See
621 : ! https://github.com/larson-group/clubb/issues/965#issuecomment-1119816722
622 : ! for a plot on how output behaves with varying min_max_smth_mag
623 :
624 : !------------------------------ Input Variables ------------------------------
625 : integer, intent(in) :: &
626 : nz, &
627 : ngrdcol
628 :
629 : type (grid), target, intent(in) :: gr
630 :
631 : real( kind = core_rknd ), dimension(ngrdcol,nz), intent(in) :: &
632 : thlm, & ! th_l (liquid water potential temperature) [K]
633 : um, & ! u mean wind component (thermodynamic levels) [m/s]
634 : vm, & ! v mean wind component (thermodynamic levels) [m/s]
635 : em, & ! Turbulent Kinetic Energy (TKE) [m^2/s^2]
636 : Lscale, & ! Turbulent mixing length [m]
637 : exner, & ! Exner function [-]
638 : rtm, & ! total water mixing ratio, r_t [kg/kg]
639 : rcm, & ! cloud water mixing ratio, r_c [kg/kg]
640 : p_in_Pa, & ! Air pressure [Pa]
641 : thvm, & ! Virtual potential temperature [K]
642 : rho_ds_zm, & ! Dry static density on momentum levels [kg/m^3]
643 : ice_supersat_frac ! ice cloud fraction
644 :
645 : real( kind = core_rknd ), dimension(nparams), intent(in) :: &
646 : clubb_params ! Array of CLUBB's tunable parameters [units vary]
647 :
648 : logical, intent(in) :: &
649 : l_brunt_vaisala_freq_moist, & ! Use a different formula for the Brunt-Vaisala frequency in
650 : ! saturated atmospheres (from Durran and Klemp, 1982)
651 : l_use_thvm_in_bv_freq, & ! Use thvm in the calculation of Brunt-Vaisala frequency
652 : l_use_shear_Richardson ! Use shear in the calculation of Richardson number
653 :
654 : ! Flag to activate modifications on limiters for convergence test
655 : ! (smoothed max and min for Cx_fnc_Richardson in advance_helper_module.F90)
656 : ! (remove the clippings on brunt_vaisala_freq_sqd_smth in mixing_length.F90)
657 : ! (reduce threshold on limiters for sqrt_Ri_zm in mixing_length.F90)
658 : logical, intent(in) :: &
659 : l_modify_limiters_for_cnvg_test
660 :
661 : type (stats_metadata_type), intent(in) :: &
662 : stats_metadata
663 :
664 : !------------------------------ InOut Variable ------------------------------
665 : type (stats), target, dimension(ngrdcol), intent(inout) :: &
666 : stats_zm
667 :
668 : !------------------------------ Output Variable ------------------------------
669 : real( kind = core_rknd), dimension(ngrdcol,nz), intent(out) :: &
670 : Cx_fnc_Richardson
671 :
672 : !------------------------------ Local Variables ------------------------------
673 : real( kind = core_rknd ), dimension(ngrdcol,nz) :: &
674 0 : brunt_vaisala_freq_sqd, &
675 0 : brunt_vaisala_freq_sqd_mixed,&
676 0 : brunt_vaisala_freq_sqd_dry, &
677 0 : brunt_vaisala_freq_sqd_moist, &
678 0 : fnc_Richardson, &
679 0 : fnc_Richardson_clipped, &
680 0 : fnc_Richardson_smooth, &
681 0 : Ri_zm, &
682 0 : ddzt_um, &
683 0 : ddzt_vm, &
684 0 : shear_sqd, &
685 0 : Lscale_zm, &
686 0 : Cx_fnc_interp, &
687 0 : Cx_fnc_Richardson_avg
688 :
689 : real ( kind = core_rknd ) :: &
690 : invrs_min_max_diff, &
691 : invrs_num_div_thresh
692 :
693 : real( kind = core_rknd ) :: &
694 : Richardson_num_max, & ! CLUBB tunable parameter Richardson_num_max
695 : Richardson_num_min, & ! CLUBB tunable parameter Richardson_num_min
696 : Cx_max, & ! CLUBB tunable parameter max of Cx_fnc_Richardson
697 : Cx_min ! CLUBB tunable parameter min of Cx_fnc_Richardson
698 :
699 : integer :: smth_type = 1
700 :
701 : integer :: i, k
702 :
703 : !------------------------------ Begin Code ------------------------------
704 :
705 : !$acc enter data create( brunt_vaisala_freq_sqd, brunt_vaisala_freq_sqd_mixed, &
706 : !$acc brunt_vaisala_freq_sqd_dry, brunt_vaisala_freq_sqd_moist, &
707 : !$acc Cx_fnc_interp, &
708 : !$acc Ri_zm, ddzt_um, ddzt_vm, shear_sqd, Lscale_zm, &
709 : !$acc Cx_fnc_Richardson_avg, fnc_Richardson, &
710 : !$acc fnc_Richardson_clipped, fnc_Richardson_smooth )
711 :
712 : call calc_brunt_vaisala_freq_sqd( nz, ngrdcol, gr, thlm, & ! intent(in)
713 : exner, rtm, rcm, p_in_Pa, thvm, & ! intent(in)
714 : ice_supersat_frac, & ! intent(in)
715 : l_brunt_vaisala_freq_moist, & ! intent(in)
716 : l_use_thvm_in_bv_freq, & ! intent(in)
717 : clubb_params(ibv_efold), & ! intent(in)
718 : brunt_vaisala_freq_sqd, & ! intent(out)
719 : brunt_vaisala_freq_sqd_mixed,& ! intent(out)
720 : brunt_vaisala_freq_sqd_dry, & ! intent(out)
721 0 : brunt_vaisala_freq_sqd_moist ) ! intent(out)
722 :
723 0 : Richardson_num_max = clubb_params(iRichardson_num_max)
724 0 : Richardson_num_min = clubb_params(iRichardson_num_min)
725 0 : Cx_max = clubb_params(iCx_max)
726 0 : Cx_min = clubb_params(iCx_min)
727 :
728 0 : invrs_min_max_diff = one / ( Richardson_num_max - Richardson_num_min )
729 0 : invrs_num_div_thresh = one / Richardson_num_divisor_threshold
730 :
731 0 : Lscale_zm = zt2zm( nz, ngrdcol, gr, Lscale )
732 :
733 : ! Calculate shear_sqd
734 0 : ddzt_um = ddzt( nz, ngrdcol, gr, um )
735 0 : ddzt_vm = ddzt( nz, ngrdcol, gr, vm )
736 :
737 : !$acc parallel loop gang vector collapse(2) default(present)
738 0 : do k = 1, nz
739 0 : do i = 1, ngrdcol
740 0 : shear_sqd(i,k) = ddzt_um(i,k)**2 + ddzt_vm(i,k)**2
741 : end do
742 : end do
743 : !$acc end parallel loop
744 :
745 0 : if ( stats_metadata%l_stats_samp ) then
746 : !$acc update host(shear_sqd)
747 0 : do i = 1, ngrdcol
748 0 : call stat_update_var( stats_metadata%ishear_sqd, shear_sqd(i,:), & ! intent(in)
749 0 : stats_zm(i) ) ! intent(inout)
750 : end do
751 : end if
752 :
753 0 : if ( l_use_shear_Richardson ) then
754 :
755 : !$acc parallel loop gang vector collapse(2) default(present)
756 0 : do k = 1, nz
757 0 : do i = 1, ngrdcol
758 0 : Ri_zm(i,k) = max( 1.0e-7_core_rknd, brunt_vaisala_freq_sqd_mixed(i,k) ) &
759 0 : / max( shear_sqd(i,k), 1.0e-7_core_rknd )
760 : end do
761 : end do
762 : !$acc end parallel loop
763 :
764 : else
765 : !$acc parallel loop gang vector collapse(2) default(present)
766 0 : do k = 1, nz
767 0 : do i = 1, ngrdcol
768 0 : Ri_zm(i,k) = brunt_vaisala_freq_sqd(i,k) * invrs_num_div_thresh
769 : end do
770 : end do
771 : !$acc end parallel loop
772 : end if
773 :
774 : ! Cx_fnc_Richardson is interpolated based on the value of Richardson_num
775 : ! The min function ensures that Cx does not exceed Cx_max, regardless of the
776 : ! value of Richardson_num_max.
777 0 : if ( l_modify_limiters_for_cnvg_test ) then
778 :
779 : !$acc parallel loop gang vector collapse(2) default(present)
780 0 : do k = 1, nz
781 0 : do i = 1, ngrdcol
782 0 : fnc_Richardson(i,k) = ( Ri_zm(i,k) - Richardson_num_min ) * invrs_min_max_diff
783 : end do
784 : end do
785 :
786 : fnc_Richardson_clipped = smooth_min( nz, ngrdcol, one, &
787 : fnc_Richardson, &
788 0 : min_max_smth_mag )
789 :
790 : fnc_Richardson_smooth = smooth_max( nz, ngrdcol, zero, &
791 : fnc_Richardson_clipped, &
792 0 : min_max_smth_mag )
793 :
794 : ! use smoothed max amd min to achive smoothed profile and avoid discontinuities
795 : !$acc parallel loop gang vector collapse(2) default(present)
796 0 : do k = 1, nz
797 0 : do i = 1, ngrdcol
798 0 : Cx_fnc_interp(i,k) = fnc_Richardson_smooth(i,k) * ( Cx_max - Cx_min ) + Cx_min
799 : end do
800 : end do
801 :
802 0 : Cx_fnc_Richardson = zm2zt2zm( nz, ngrdcol, gr, Cx_fnc_interp )
803 :
804 : else ! default method
805 :
806 : !$acc parallel loop gang vector collapse(2) default(present)
807 0 : do k = 1, nz
808 0 : do i = 1, ngrdcol
809 0 : Cx_fnc_Richardson(i,k) = ( max(min(Richardson_num_max, Ri_zm(i,k)), Richardson_num_min) &
810 : - Richardson_num_min ) &
811 0 : * invrs_min_max_diff * ( Cx_max - Cx_min ) + Cx_min
812 : end do
813 : end do
814 : !$acc end parallel loop
815 :
816 : end if
817 :
818 : if ( l_Cx_fnc_Richardson_vert_avg ) then
819 : Cx_fnc_Richardson = Lscale_width_vert_avg( nz, ngrdcol, gr, smth_type, &
820 : Cx_fnc_Richardson, Lscale_zm, rho_ds_zm, &
821 : Cx_fnc_Richardson_below_ground_value )
822 :
823 : !$acc parallel loop gang vector collapse(2) default(present)
824 : do k = 1, nz
825 : do i = 1, ngrdcol
826 : Cx_fnc_Richardson(i,k) = Cx_fnc_Richardson_avg(i,k)
827 : end do
828 : end do
829 : !$acc end parallel loop
830 : end if
831 :
832 : ! On some compilers, roundoff error can result in Cx_fnc_Richardson being
833 : ! slightly outside the range [0,1]. Thus, it is clipped here.
834 : !$acc parallel loop gang vector collapse(2) default(present)
835 0 : do k = 1, nz
836 0 : do i = 1, ngrdcol
837 0 : Cx_fnc_Richardson(i,k) = max( zero, min( one, Cx_fnc_Richardson(i,k) ) )
838 : end do
839 : end do
840 : !$acc end parallel loop
841 :
842 : !$acc exit data delete( brunt_vaisala_freq_sqd, brunt_vaisala_freq_sqd_mixed, &
843 : !$acc brunt_vaisala_freq_sqd_dry, brunt_vaisala_freq_sqd_moist, &
844 : !$acc Cx_fnc_interp, Ri_zm, &
845 : !$acc ddzt_um, ddzt_vm, shear_sqd, Lscale_zm, &
846 : !$acc Cx_fnc_Richardson_avg, fnc_Richardson, &
847 : !$acc fnc_Richardson_clipped, fnc_Richardson_smooth )
848 :
849 0 : return
850 :
851 : end subroutine compute_Cx_fnc_Richardson
852 : !----------------------------------------------------------------------
853 :
854 : !----------------------------------------------------------------------
855 352944 : function Lscale_width_vert_avg( nz, ngrdcol, gr, smth_type, &
856 352944 : var_profile, Lscale_zm, rho_ds_zm, &
857 : var_below_ground_value )&
858 1411776 : result (Lscale_width_vert_avg_output)
859 :
860 : ! Description:
861 : ! Averages a profile with a running mean of width Lscale_zm
862 :
863 : ! References:
864 : ! cam:ticket:59
865 :
866 : use clubb_precision, only: &
867 : core_rknd ! Precision
868 :
869 : use grid_class, only: &
870 : grid ! Type
871 :
872 : use constants_clubb, only: &
873 : zero
874 :
875 : implicit none
876 :
877 : !-------------------------- Input Variables --------------------------
878 : integer, intent(in) :: &
879 : nz, &
880 : ngrdcol, &
881 : smth_type
882 :
883 : type (grid), target, intent(in) :: gr
884 :
885 : real( kind = core_rknd ), dimension(ngrdcol,nz), intent(in) :: &
886 : var_profile, & ! Profile on momentum levels
887 : Lscale_zm, & ! Lscale on momentum levels
888 : rho_ds_zm ! Dry static energy on momentum levels!
889 :
890 : real( kind = core_rknd ), intent(in) :: &
891 : var_below_ground_value ! Value to use below ground
892 :
893 : !-------------------------- Result Variable --------------------------
894 : real( kind = core_rknd ), dimension(ngrdcol,nz) :: &
895 : Lscale_width_vert_avg_output ! Vertically averaged profile (on momentum levels)
896 :
897 : !-------------------------- Local Variables --------------------------
898 : integer :: &
899 : k, i, & ! Loop variable
900 : k_avg_lower, &
901 : k_avg_upper, &
902 : k_avg
903 :
904 : real( kind = core_rknd ), dimension(ngrdcol,nz) :: &
905 705888 : one_half_avg_width, &
906 705888 : numer_terms, &
907 352944 : denom_terms
908 :
909 : integer :: &
910 : n_below_ground_levels
911 :
912 : real( kind = core_rknd ) :: &
913 : numer_integral, & ! Integral in the numerator (see description)
914 : denom_integral ! Integral in the denominator (see description)
915 :
916 : !-------------------------- Begin Code --------------------------
917 :
918 : !$acc enter data create( one_half_avg_width, numer_terms, denom_terms )
919 :
920 352944 : if ( smth_type == 1 ) then
921 : !$acc parallel loop gang vector collapse(2) default(present)
922 0 : do k = 1, nz
923 0 : do i = 1, ngrdcol
924 0 : one_half_avg_width(i,k) = max( Lscale_zm(i,k), 500.0_core_rknd )
925 : end do
926 : end do
927 352944 : else if (smth_type == 2 ) then
928 : !$acc parallel loop gang vector collapse(2) default(present)
929 30353184 : do k = 1, nz
930 501287184 : do i = 1, ngrdcol
931 500934240 : one_half_avg_width(i,k) = 60.0_core_rknd
932 : end do
933 : end do
934 : endif
935 :
936 : ! Pre calculate numerator and denominator terms
937 : !$acc parallel loop gang vector collapse(2) default(present)
938 30353184 : do k = 1, nz
939 501287184 : do i = 1, ngrdcol
940 470934000 : numer_terms(i,k) = rho_ds_zm(i,k) * gr%dzm(i,k) * var_profile(i,k)
941 500934240 : denom_terms(i,k) = rho_ds_zm(i,k) * gr%dzm(i,k)
942 : end do
943 : end do
944 :
945 : ! For every grid level
946 : !$acc parallel loop gang vector collapse(2) default(present)
947 30353184 : do k = 1, nz
948 501287184 : do i = 1, ngrdcol
949 :
950 : !-----------------------------------------------------------------------
951 : ! Hunt down all vertical levels with one_half_avg_width(k) of gr%zm(k).
952 : !
953 : ! Note: Outdated explanation of version that improves CPU performance
954 : ! below. Reworked due to it requiring a k dependency. Now we
955 : ! begin looking for k_avg_upper and k_avg_lower starting at
956 : ! the kth level.
957 : !
958 : ! Outdated but potentially useful note:
959 : ! k_avg_upper and k_avg_lower can be saved each loop iteration, this
960 : ! reduces iterations beacuse the kth values are likely to be within
961 : ! one or two grid levels of the k-1th values. Less searching is required
962 : ! by starting the search at the previous values and incrementing or
963 : ! decrement as needed.
964 : !-----------------------------------------------------------------------
965 :
966 : ! Determine if k_avg_upper needs to increment
967 477258214 : do k_avg_upper = k, nz-1
968 477258214 : if ( gr%zm(i,k_avg_upper+1) - gr%zm(i,k) > one_half_avg_width(i,k) ) then
969 : exit
970 : end if
971 : end do
972 :
973 : ! Determine if k_avg_lower needs to decrement
974 477258214 : do k_avg_lower = k, 2, -1
975 477258214 : if ( gr%zm(i,k) - gr%zm(i,k_avg_lower-1) > one_half_avg_width(i,k) ) then
976 : exit
977 : end if
978 : end do
979 :
980 : ! Compute the number of levels below ground to include.
981 470934000 : if ( k_avg_lower > 1 ) then
982 :
983 : ! k=1, the lowest "real" level, is not included in the average, so no
984 : ! below-ground levels should be included.
985 954516428 : n_below_ground_levels = 0
986 :
987 : numer_integral = zero
988 : denom_integral = zero
989 :
990 : else
991 :
992 : ! The number of below-ground levels included is equal to the distance
993 : ! below the lowest level spanned by one_half_avg_width(k)
994 : ! divided by the distance between vertical levels below ground; the
995 : ! latter is assumed to be the same as the distance between the first and
996 : ! second vertical levels.
997 33242400 : n_below_ground_levels = int( ( one_half_avg_width(i,k)-(gr%zm(i,k)-gr%zm(i,1)) ) / &
998 44323200 : ( gr%zm(i,2)-gr%zm(i,1) ) )
999 :
1000 11080800 : numer_integral = n_below_ground_levels * denom_terms(i,1) * var_below_ground_value
1001 : denom_integral = n_below_ground_levels * denom_terms(i,1)
1002 :
1003 : end if
1004 :
1005 : ! Add numerator and denominator terms for all above-ground levels
1006 954516428 : do k_avg = k_avg_lower, k_avg_upper
1007 :
1008 483582428 : numer_integral = numer_integral + numer_terms(i,k_avg)
1009 954516428 : denom_integral = denom_integral + denom_terms(i,k_avg)
1010 :
1011 : end do
1012 :
1013 500934240 : Lscale_width_vert_avg_output(i,k) = numer_integral / denom_integral
1014 :
1015 : end do
1016 : end do
1017 :
1018 : !$acc exit data delete( one_half_avg_width, numer_terms, denom_terms )
1019 :
1020 352944 : return
1021 :
1022 352944 : end function Lscale_width_vert_avg
1023 :
1024 : !=============================================================================
1025 352944 : subroutine wp2_term_splat_lhs( nz, ngrdcol, gr, C_wp2_splat, &
1026 352944 : brunt_vaisala_freq_sqd_splat, &
1027 352944 : lhs_splat_wp2 )
1028 :
1029 : ! Description
1030 : ! DESCRIBE TERM
1031 :
1032 : ! References:
1033 : !-----------------------------------------------------------------------
1034 :
1035 : use grid_class, only: &
1036 : grid, & ! Type
1037 : zm2zt2zm
1038 :
1039 : use constants_clubb, only: &
1040 : zero
1041 :
1042 : use clubb_precision, only: &
1043 : core_rknd ! Variable(s)
1044 :
1045 : implicit none
1046 :
1047 : ! --------------------- Input Variables ---------------------
1048 : integer, intent(in) :: &
1049 : nz, &
1050 : ngrdcol
1051 :
1052 : type (grid), target, intent(in) :: &
1053 : gr
1054 :
1055 : real( kind = core_rknd ), dimension(ngrdcol,nz), intent(in) :: &
1056 : brunt_vaisala_freq_sqd_splat ! Inverse time-scale tau at momentum levels [1/s^2]
1057 :
1058 : real( kind = core_rknd ), intent(in) :: &
1059 : C_wp2_splat ! Model parameter C_wp2_splat [ -]
1060 :
1061 : ! --------------------- Output Variable ---------------------
1062 : real( kind = core_rknd ), dimension(ngrdcol,nz), intent(out) :: &
1063 : lhs_splat_wp2 ! LHS coefficient of wp2 splatting term [1/s]
1064 :
1065 : ! --------------------- Local Variables ---------------------
1066 : real( kind = core_rknd ), dimension(ngrdcol,nz) :: &
1067 705888 : brunt_vaisala_freq_splat_clipped, &
1068 705888 : brunt_vaisala_freq_splat_smooth
1069 :
1070 : integer :: i, k
1071 :
1072 : !----------------------------- Begin Code -----------------------------
1073 :
1074 : !$acc enter data create( brunt_vaisala_freq_splat_clipped, brunt_vaisala_freq_splat_smooth )
1075 :
1076 : !$acc parallel loop gang vector collapse(2) default(present)
1077 30353184 : do k = 1, nz
1078 501287184 : do i = 1, ngrdcol
1079 941868000 : brunt_vaisala_freq_splat_clipped(i,k) &
1080 1442802240 : = sqrt( max( zero, brunt_vaisala_freq_sqd_splat(i,k) ) )
1081 : end do
1082 : end do
1083 : !$acc end parallel loop
1084 :
1085 : brunt_vaisala_freq_splat_smooth = zm2zt2zm( nz, ngrdcol, gr, &
1086 352944 : brunt_vaisala_freq_splat_clipped )
1087 :
1088 : !$acc parallel loop gang vector collapse(2) default(present)
1089 30353184 : do k = 1, nz
1090 501287184 : do i = 1, ngrdcol
1091 500934240 : lhs_splat_wp2(i,k) = + C_wp2_splat * brunt_vaisala_freq_splat_smooth(i,k)
1092 : end do
1093 : end do
1094 : !$acc end parallel loop
1095 :
1096 : !$acc exit data delete( brunt_vaisala_freq_splat_clipped, brunt_vaisala_freq_splat_smooth )
1097 :
1098 352944 : return
1099 :
1100 : end subroutine wp2_term_splat_lhs
1101 :
1102 : !=============================================================================
1103 352944 : subroutine wp3_term_splat_lhs( nz, ngrdcol, gr, C_wp2_splat, &
1104 352944 : brunt_vaisala_freq_sqd_splat, &
1105 352944 : lhs_splat_wp3 )
1106 :
1107 : ! Description
1108 : ! DESCRIBE TERM
1109 :
1110 : ! References:
1111 : !-----------------------------------------------------------------------
1112 :
1113 : use grid_class, only: &
1114 : grid, & ! Type
1115 : zm2zt2zm
1116 :
1117 : use constants_clubb, only: &
1118 : zero, &
1119 : one_half, &
1120 : three
1121 :
1122 : use clubb_precision, only: &
1123 : core_rknd ! Variable(s)
1124 :
1125 : implicit none
1126 :
1127 : ! --------------------- Input Variables ---------------------
1128 : integer, intent(in) :: &
1129 : nz, &
1130 : ngrdcol
1131 :
1132 : type (grid), target, intent(in) :: &
1133 : gr
1134 :
1135 : real( kind = core_rknd ), dimension(ngrdcol,nz), intent(in) :: &
1136 : brunt_vaisala_freq_sqd_splat ! Inverse time-scale tau at momentum levels [1/s^2]
1137 :
1138 : real( kind = core_rknd ), intent(in) :: &
1139 : C_wp2_splat ! Model parameter C_wp2_splat [-]
1140 :
1141 : ! --------------------- Output Variable ---------------------
1142 : real( kind = core_rknd ), dimension(ngrdcol,nz), intent(out) :: &
1143 : lhs_splat_wp3 ! LHS coefficient of wp3 splatting term [1/s]
1144 :
1145 : ! --------------------- Local Variables ---------------------
1146 : real( kind = core_rknd ), dimension(ngrdcol,nz) :: &
1147 705888 : brunt_vaisala_freq_splat_clipped, &
1148 705888 : brunt_vaisala_freq_splat_smooth
1149 :
1150 : integer :: i, k
1151 :
1152 : !----------------------------- Begin Code -----------------------------
1153 :
1154 : !$acc enter data create( brunt_vaisala_freq_splat_clipped, brunt_vaisala_freq_splat_smooth )
1155 :
1156 : !$acc parallel loop gang vector collapse(2) default(present)
1157 30353184 : do k = 1, nz
1158 501287184 : do i = 1, ngrdcol
1159 941868000 : brunt_vaisala_freq_splat_clipped(i,k) &
1160 1442802240 : = sqrt( max( zero, brunt_vaisala_freq_sqd_splat(i,k) ) )
1161 : end do
1162 : end do
1163 : !$acc end parallel loop
1164 :
1165 : brunt_vaisala_freq_splat_smooth = zm2zt2zm( nz, ngrdcol, gr, &
1166 352944 : brunt_vaisala_freq_splat_clipped )
1167 :
1168 : !$acc parallel loop gang vector collapse(2) default(present)
1169 30353184 : do k = 1, nz
1170 501287184 : do i = 1, ngrdcol
1171 941868000 : lhs_splat_wp3(i,k) = + one_half * three * C_wp2_splat &
1172 1442802240 : * brunt_vaisala_freq_splat_smooth(i,k)
1173 : end do
1174 : end do
1175 : !$acc end parallel loop
1176 :
1177 : !$acc exit data delete( brunt_vaisala_freq_splat_clipped, brunt_vaisala_freq_splat_smooth )
1178 :
1179 352944 : return
1180 :
1181 : end subroutine wp3_term_splat_lhs
1182 :
1183 : !===============================================================================
1184 0 : function smooth_min_scalar_array( nz, ngrdcol, input_var1, input_var2, smth_coef ) &
1185 0 : result( output_var )
1186 :
1187 : ! Description:
1188 : ! Computes a smoothed version of the min function, using one scalar and
1189 : ! one 1d array as inputs. For more details, see the interface in this file.
1190 :
1191 : ! References:
1192 : ! See clubb:ticket:894, updated version: 965
1193 : !----------------------------------------------------------------------
1194 :
1195 : use clubb_precision, only: &
1196 : core_rknd ! Constant(s)
1197 :
1198 : use constants_clubb, only: &
1199 : one_half
1200 :
1201 : implicit none
1202 :
1203 : integer, intent(in) :: &
1204 : nz, &
1205 : ngrdcol
1206 :
1207 : !----------------------------- Input Variables -----------------------------
1208 : real ( kind = core_rknd ), intent(in) :: &
1209 : input_var1, & ! Units vary
1210 : smth_coef ! "intensity" of the smoothing. Should be of a similar magnitude to
1211 : ! that of the data structures input_var1 and input_var2
1212 :
1213 : real ( kind = core_rknd ), dimension(ngrdcol, nz), intent(in) :: &
1214 : input_var2 ! Units vary
1215 :
1216 : !----------------------------- Output Variables -----------------------------
1217 : real( kind = core_rknd ), dimension(ngrdcol, nz) :: &
1218 : output_var ! Same unit as input_var1 and input_var2
1219 :
1220 : !----------------------------- Local Variables -----------------------------
1221 : integer :: i, k
1222 :
1223 : !----------------------------- Begin Code -----------------------------
1224 :
1225 : !$acc data copyin( input_var2 ) &
1226 : !$acc copyout( output_var )
1227 :
1228 : !$acc parallel loop gang vector collapse(2) default(present)
1229 0 : do k = 1, nz
1230 0 : do i = 1, ngrdcol
1231 0 : output_var(i,k) = one_half * ( (input_var1+input_var2(i,k)) - &
1232 0 : sqrt((input_var1-input_var2(i,k))**2 + smth_coef**2) )
1233 : end do
1234 : end do
1235 : !$acc end parallel loop
1236 :
1237 : !$acc end data
1238 :
1239 0 : return
1240 :
1241 0 : end function smooth_min_scalar_array
1242 :
1243 : !===============================================================================
1244 0 : function smooth_min_array_scalar( nz, ngrdcol, input_var1, input_var2, smth_coef ) &
1245 0 : result( output_var )
1246 :
1247 : ! Description:
1248 : ! Computes a smoothed version of the min function, using one scalar and
1249 : ! one 1d array as inputs. For more details, see the interface in this file.
1250 :
1251 : ! References:
1252 : ! See clubb:ticket:894, updated version: 965
1253 : !----------------------------------------------------------------------
1254 :
1255 : use clubb_precision, only: &
1256 : core_rknd ! Constant(s)
1257 :
1258 : use constants_clubb, only: &
1259 : one_half
1260 :
1261 : implicit none
1262 :
1263 : !----------------------------- Input Variables -----------------------------
1264 : integer, intent(in) :: &
1265 : nz, &
1266 : ngrdcol
1267 :
1268 : real ( kind = core_rknd ), dimension(ngrdcol, nz), intent(in) :: &
1269 : input_var1 ! Units vary
1270 :
1271 : real ( kind = core_rknd ), intent(in) :: &
1272 : input_var2, & ! Units vary
1273 : smth_coef ! "intensity" of the smoothing. Should be of a similar magnitude to
1274 : ! that of the data structures input_var1 and input_var2
1275 :
1276 : !----------------------------- Output Variables -----------------------------
1277 : real( kind = core_rknd ), dimension(ngrdcol, nz) :: &
1278 : output_var ! Same unit as input_var1 and input_var2
1279 :
1280 : !----------------------------- Local Variables -----------------------------
1281 : integer :: i, k
1282 :
1283 : !----------------------------- Begin Code -----------------------------
1284 :
1285 : !$acc data copyin( input_var1 ) &
1286 : !$acc copyout( output_var )
1287 :
1288 : !$acc parallel loop gang vector collapse(2) default(present)
1289 0 : do k = 1, nz
1290 0 : do i = 1, ngrdcol
1291 0 : output_var(i,k) = one_half * ( (input_var1(i,k)+input_var2) - &
1292 0 : sqrt((input_var1(i,k)-input_var2)**2 + smth_coef**2) )
1293 : end do
1294 : end do
1295 : !$acc end parallel loop
1296 :
1297 : !$acc end data
1298 :
1299 0 : return
1300 :
1301 0 : end function smooth_min_array_scalar
1302 :
1303 : !===============================================================================
1304 0 : function smooth_min_arrays( nz, ngrdcol, input_var1, input_var2, smth_coef ) &
1305 0 : result( output_var )
1306 :
1307 : ! Description:
1308 : ! Computes a smoothed version of the min function, using two 1d arrays as inputs.
1309 : ! For more details, see the interface in this file.
1310 :
1311 : ! References:
1312 : ! See clubb:ticket:894, updated version: 965
1313 : !----------------------------------------------------------------------
1314 :
1315 : use clubb_precision, only: &
1316 : core_rknd ! Constant(s)
1317 :
1318 : use constants_clubb, only: &
1319 : one_half
1320 :
1321 : implicit none
1322 :
1323 : !----------------------------- Input Variables-----------------------------
1324 : integer, intent(in) :: &
1325 : nz, &
1326 : ngrdcol
1327 :
1328 : real ( kind = core_rknd ), dimension(ngrdcol, nz), intent(in) :: &
1329 : input_var1, & ! Units vary
1330 : input_var2 ! Units vary
1331 :
1332 : real ( kind = core_rknd ), intent(in) :: &
1333 : smth_coef ! "intensity" of the smoothing. Should be of a similar magnitude to
1334 : ! that of the data structures input_var1 and input_var2
1335 :
1336 : !----------------------------- Output Variables -----------------------------
1337 : real( kind = core_rknd ), dimension(ngrdcol, nz) :: &
1338 : output_var ! Same unit as input_var1 and input_var2
1339 :
1340 : !----------------------------- Local Variables -----------------------------
1341 : integer :: i, k
1342 :
1343 : !----------------------------- Begin Code -----------------------------
1344 :
1345 : !$acc data copyin( input_var1, input_var2 ) &
1346 : !$acc copyout( output_var )
1347 :
1348 : !$acc parallel loop gang vector collapse(2) default(present)
1349 0 : do k = 1, nz
1350 0 : do i = 1, ngrdcol
1351 0 : output_var(i,k) = one_half * ( (input_var1(i,k)+input_var2(i,k)) - &
1352 0 : sqrt((input_var1(i,k)-input_var2(i,k))**2 + smth_coef**2) )
1353 : end do
1354 : end do
1355 : !$acc end parallel loop
1356 :
1357 : !$acc end data
1358 :
1359 0 : return
1360 :
1361 0 : end function smooth_min_arrays
1362 :
1363 : !===============================================================================
1364 0 : function smooth_min_scalars( input_var1, input_var2, smth_coef ) &
1365 : result( output_var )
1366 : !$acc routine
1367 :
1368 : ! Description:
1369 : ! Computes a smoothed version of the min function, using two scalars as inputs.
1370 : ! For more details, see the interface in this file.
1371 :
1372 : ! References:
1373 : ! See clubb:ticket: 965
1374 : !----------------------------------------------------------------------
1375 :
1376 : use clubb_precision, only: &
1377 : core_rknd ! Constant(s)
1378 :
1379 : use constants_clubb, only: &
1380 : one_half
1381 :
1382 : implicit none
1383 :
1384 : ! Input Variables
1385 : real ( kind = core_rknd ), intent(in) :: &
1386 : input_var1, & ! Units vary
1387 : input_var2, & ! Units vary
1388 : smth_coef ! "intensity" of the smoothing. Should be of a similar magnitude to
1389 : ! that of the data structures input_var1 and input_var2
1390 :
1391 : ! Output Variables
1392 : real( kind = core_rknd ) :: &
1393 : output_var ! Same unit as input_var1 and input_var2
1394 :
1395 : !----------------------------------------------------------------------
1396 :
1397 : output_var = one_half * ( (input_var1+input_var2) - &
1398 0 : sqrt((input_var1-input_var2)**2 + smth_coef**2) )
1399 :
1400 : return
1401 : end function smooth_min_scalars
1402 :
1403 : !===============================================================================
1404 0 : function smooth_max_scalar_array( nz, ngrdcol, input_var1, input_var2, smth_coef ) &
1405 0 : result( output_var )
1406 :
1407 : ! Description:
1408 : ! Computes a smoothed version of the max function, using one scalar and
1409 : ! one 1d array as inputs. For more details, see the interface in this file.
1410 :
1411 : ! References:
1412 : ! See clubb:ticket:894, updated version: 965
1413 : !----------------------------------------------------------------------
1414 :
1415 : use clubb_precision, only: &
1416 : core_rknd ! Constant(s)
1417 :
1418 : use constants_clubb, only: &
1419 : one_half
1420 :
1421 : implicit none
1422 :
1423 : !----------------------------- Input Variables -----------------------------
1424 : integer, intent(in) :: &
1425 : nz, &
1426 : ngrdcol
1427 :
1428 : real ( kind = core_rknd ), intent(in) :: &
1429 : input_var1, & ! Units vary
1430 : smth_coef ! "intensity" of the smoothing. Should be of a similar magnitude to
1431 : ! that of the data structures input_var1 and input_var2
1432 :
1433 : real ( kind = core_rknd ), dimension(ngrdcol, nz), intent(in) :: &
1434 : input_var2 ! Units vary
1435 :
1436 : !----------------------------- Output Variables -----------------------------
1437 : real( kind = core_rknd ), dimension(ngrdcol, nz) :: &
1438 : output_var ! Same unit as input_var1 and input_var2
1439 :
1440 : !----------------------------- Local Variables -----------------------------
1441 : integer :: i, k
1442 :
1443 : !----------------------------- Begin Code -----------------------------
1444 :
1445 : !$acc data copyin( input_var2 ) &
1446 : !$acc copyout( output_var )
1447 :
1448 : !$acc parallel loop gang vector collapse(2) default(present)
1449 0 : do k = 1, nz
1450 0 : do i = 1, ngrdcol
1451 0 : output_var(i,k) = one_half * ( (input_var1+input_var2(i,k)) + &
1452 0 : sqrt((input_var1-input_var2(i,k))**2 + smth_coef**2) )
1453 : end do
1454 : end do
1455 : !$acc end parallel loop
1456 :
1457 : !$acc end data
1458 :
1459 0 : return
1460 :
1461 0 : end function smooth_max_scalar_array
1462 :
1463 : !===============================================================================
1464 0 : function smooth_max_array_scalar( nz, ngrdcol, input_var1, input_var2, smth_coef ) &
1465 0 : result( output_var )
1466 :
1467 : ! Description:
1468 : ! Computes a smoothed version of the max function, using one scalar and
1469 : ! one 1d array as inputs. For more details, see the interface in this file.
1470 :
1471 : ! References:
1472 : ! See clubb:ticket:894, updated version: 965
1473 : !----------------------------------------------------------------------
1474 :
1475 : use clubb_precision, only: &
1476 : core_rknd ! Constant(s)
1477 :
1478 : use constants_clubb, only: &
1479 : one_half
1480 :
1481 : implicit none
1482 :
1483 : !----------------------------- Input Variables -----------------------------
1484 : integer, intent(in) :: &
1485 : nz, &
1486 : ngrdcol
1487 :
1488 : real ( kind = core_rknd ), dimension(ngrdcol, nz), intent(in) :: &
1489 : input_var1 ! Units vary
1490 :
1491 : real ( kind = core_rknd ), intent(in) :: &
1492 : input_var2, & ! Units vary
1493 : smth_coef ! "intensity" of the smoothing. Should be of a similar magnitude to
1494 : ! that of the data structures input_var1 and input_var2
1495 :
1496 : !----------------------------- Output Variables -----------------------------
1497 : real( kind = core_rknd ), dimension(ngrdcol, nz) :: &
1498 : output_var ! Same unit as input_var1 and input_var2
1499 :
1500 : !----------------------------- Local Variables -----------------------------
1501 : integer :: i, k
1502 :
1503 : !----------------------------- Begin Code -----------------------------
1504 :
1505 : !$acc data copyin( input_var1 ) &
1506 : !$acc copyout( output_var )
1507 :
1508 : !$acc parallel loop gang vector collapse(2) default(present)
1509 0 : do k = 1, nz
1510 0 : do i = 1, ngrdcol
1511 0 : output_var(i,k) = one_half * ( ( input_var1(i,k) + input_var2 ) + &
1512 0 : sqrt(( input_var1(i,k) - input_var2 )**2 + smth_coef**2) )
1513 : end do
1514 : end do
1515 : !$acc end parallel loop
1516 :
1517 : !$acc end data
1518 :
1519 0 : return
1520 :
1521 0 : end function smooth_max_array_scalar
1522 :
1523 : !===============================================================================
1524 0 : function smooth_max_arrays( nz, ngrdcol, input_var1, input_var2, smth_coef ) &
1525 0 : result( output_var )
1526 :
1527 : ! Description:
1528 : ! Computes a smoothed version of the max function, using two 1d arrays as inputs.
1529 : ! For more details, see the interface in this file.
1530 :
1531 : ! References:
1532 : ! See clubb:ticket:894, updated version: 965
1533 : !----------------------------------------------------------------------
1534 :
1535 : use clubb_precision, only: &
1536 : core_rknd ! Constant(s)
1537 :
1538 : use constants_clubb, only: &
1539 : one_half
1540 :
1541 : implicit none
1542 :
1543 : !----------------------------- Input Variables -----------------------------
1544 : integer, intent(in) :: &
1545 : nz, &
1546 : ngrdcol
1547 :
1548 : real ( kind = core_rknd ), dimension(ngrdcol, nz), intent(in) :: &
1549 : input_var1, & ! Units vary
1550 : input_var2 ! Units vary
1551 :
1552 : real( kind = core_rknd ), intent(in) :: &
1553 : smth_coef ! "intensity" of the smoothing. Should be of a similar magnitude to
1554 : ! that of the data structures input_var1 and input_var2
1555 :
1556 : !----------------------------- Output Variables -----------------------------
1557 : real( kind = core_rknd ), dimension(ngrdcol, nz) :: &
1558 : output_var ! Same unit as input_var1 and input_var2
1559 :
1560 : !----------------------------- Local Variables -----------------------------
1561 : integer :: i, k
1562 :
1563 : !----------------------------- Begin Code -----------------------------
1564 :
1565 : !$acc data copyin( input_var1, input_var2 ) &
1566 : !$acc copyout( output_var )
1567 :
1568 : !$acc parallel loop gang vector collapse(2) default(present)
1569 0 : do k = 1, nz
1570 0 : do i = 1, ngrdcol
1571 0 : output_var(i,k) = one_half * ( (input_var1(i,k)+input_var2(i,k)) + &
1572 0 : sqrt((input_var1(i,k)-input_var2(i,k))**2 + smth_coef**2) )
1573 : end do
1574 : end do
1575 : !$acc end parallel loop
1576 :
1577 : !$acc end data
1578 :
1579 0 : return
1580 :
1581 0 : end function smooth_max_arrays
1582 :
1583 : !===============================================================================
1584 0 : function smooth_max_scalars( input_var1, input_var2, smth_coef ) &
1585 : result( output_var )
1586 : !$acc routine
1587 :
1588 : ! Description:
1589 : ! Computes a smoothed version of the max function, using two scalars as inputs.
1590 : ! For more details, see the interface in this file.
1591 :
1592 : ! References:
1593 : ! See clubb:ticket: 965
1594 : !----------------------------------------------------------------------
1595 :
1596 : use clubb_precision, only: &
1597 : core_rknd ! Constant(s)
1598 :
1599 : use constants_clubb, only: &
1600 : one_half
1601 :
1602 : implicit none
1603 :
1604 : !----------------------------- Input Variables -----------------------------
1605 : real ( kind = core_rknd ), intent(in) :: &
1606 : input_var1, & ! Units vary
1607 : input_var2, & ! Units vary
1608 : smth_coef ! "intensity" of the smoothing. Should be of a similar magnitude to
1609 : ! that of the data structures input_var1 and input_var2
1610 :
1611 : !----------------------------- Output Variables -----------------------------
1612 : real( kind = core_rknd ) :: &
1613 : output_var ! Same unit as input_var1 and input_var2
1614 :
1615 : !----------------------------- Local Variables -----------------------------
1616 : integer :: i, k
1617 :
1618 : !----------------------------- Begin Code -----------------------------
1619 :
1620 : output_var = one_half * ( (input_var1+input_var2) + &
1621 0 : sqrt((input_var1-input_var2)**2 + smth_coef**2) )
1622 : return
1623 :
1624 : end function smooth_max_scalars
1625 :
1626 0 : function smooth_heaviside_peskin( nz, ngrdcol, input, smth_range ) &
1627 0 : result( smth_output )
1628 :
1629 : ! Description:
1630 : ! Computes a smoothed heaviside function as in
1631 : ! [Lin, Lee et al., 2005, A level set characteristic Galerkin
1632 : ! finite element method for free surface flows], equation (2)
1633 :
1634 : ! References:
1635 : ! See clubb:ticket:965
1636 : !----------------------------------------------------------------------
1637 :
1638 : use clubb_precision, only: &
1639 : core_rknd ! Constant(s)
1640 :
1641 : use constants_clubb, only: &
1642 : pi, invrs_pi, one, one_half, zero
1643 :
1644 : implicit none
1645 :
1646 : !------------------------- Input Variables -------------------------
1647 : integer, intent(in) :: &
1648 : nz, &
1649 : ngrdcol
1650 :
1651 : real ( kind = core_rknd ), dimension(ngrdcol,nz), intent(in) :: &
1652 : input ! Units vary
1653 :
1654 : real ( kind = core_rknd ), intent(in) :: &
1655 : smth_range ! Smooth Heaviside function on [-smth_range, smth_range]
1656 :
1657 : !------------------------- Output Variables -------------------------
1658 : real( kind = core_rknd ), dimension(ngrdcol,nz) :: &
1659 : smth_output ! Same units as input
1660 :
1661 : !------------------------- Local Variables -------------------------
1662 : real ( kind = core_rknd ) :: &
1663 : input_over_smth_range ! input divided by smth_range
1664 :
1665 : integer :: i, k
1666 :
1667 : !------------------------- Begin Code -------------------------
1668 :
1669 : !$acc data copyin( input ) &
1670 : !$acc copyout( smth_output )
1671 :
1672 : !$acc parallel loop gang vector collapse(2) default(present)
1673 0 : do k = 1, nz
1674 0 : do i = 1, ngrdcol
1675 :
1676 0 : if ( input(i,k) < -smth_range ) then
1677 0 : smth_output(i,k) = zero
1678 0 : elseif ( input(i,k) > smth_range ) then
1679 0 : smth_output(i,k) = one
1680 : else
1681 : ! Note that this case will only ever be reached if smth_range != 0,
1682 : ! so this division is fine and should not cause any issues
1683 0 : input_over_smth_range = input(i,k) / smth_range
1684 : smth_output(i,k) = one_half &
1685 : * (one + input_over_smth_range &
1686 0 : + invrs_pi * sin(pi * input_over_smth_range))
1687 : end if
1688 :
1689 : end do
1690 : end do
1691 : !$acc end parallel loop
1692 :
1693 : !$acc end data
1694 :
1695 0 : return
1696 :
1697 0 : end function smooth_heaviside_peskin
1698 :
1699 : !===============================================================================
1700 0 : subroutine calc_xpwp_1D( gr, Km_zm, xm, &
1701 0 : xpwp )
1702 :
1703 : ! Description:
1704 : ! Compute x'w' from x<k>, x<k+1>, Kh and invrs_dzm
1705 :
1706 : ! References:
1707 : ! None
1708 : !-----------------------------------------------------------------------
1709 :
1710 : use clubb_precision, only: &
1711 : core_rknd ! Variable(s)
1712 :
1713 : use grid_class, only: &
1714 : grid
1715 :
1716 : implicit none
1717 :
1718 : ! ----------------------- Input variables -----------------------
1719 : type (grid), target, intent(in) :: gr
1720 :
1721 : real( kind = core_rknd ), dimension(gr%nz), intent(in) :: &
1722 : Km_zm, & ! Eddy diff. (k momentum level) [m^2/s]
1723 : xm ! x (k thermo level) [units vary]
1724 :
1725 : ! ----------------------- Output variable -----------------------
1726 : real( kind = core_rknd ), dimension(gr%nz), intent(out) :: &
1727 : xpwp ! x'w' [(units vary)(m/s)]
1728 :
1729 : integer :: k
1730 :
1731 : ! ----------------------- Begin Code -----------------------
1732 :
1733 : ! Solve for x'w' at all intermediate model levels.
1734 0 : do k = 1, gr%nz-1
1735 0 : xpwp(k) = Km_zm(k) * gr%invrs_dzm(1,k) * ( xm(k+1) - xm(k) )
1736 : end do
1737 :
1738 0 : return
1739 : end subroutine calc_xpwp_1D
1740 :
1741 : !===============================================================================
1742 16235424 : subroutine calc_xpwp_2D( nz, ngrdcol, gr, &
1743 16235424 : Km_zm, xm, &
1744 16235424 : xpwp )
1745 :
1746 : ! Description:
1747 : ! Compute x'w' from x<k>, x<k+1>, Kh and invrs_dzm
1748 :
1749 : ! References:
1750 : ! None
1751 : !-----------------------------------------------------------------------
1752 :
1753 : use clubb_precision, only: &
1754 : core_rknd ! Variable(s)
1755 :
1756 : use grid_class, only: &
1757 : grid
1758 :
1759 : implicit none
1760 :
1761 : ! ----------------------- Input variables -----------------------
1762 : integer, intent(in) :: &
1763 : nz, &
1764 : ngrdcol
1765 :
1766 : type (grid), target, intent(in) :: gr
1767 :
1768 : real( kind = core_rknd ), dimension(ngrdcol,nz), intent(in) :: &
1769 : Km_zm, & ! Eddy diff. (k momentum level) [m^2/s]
1770 : xm ! x (k thermo level) [units vary]
1771 :
1772 : ! ----------------------- Output variable -----------------------
1773 : real( kind = core_rknd ), dimension(ngrdcol,nz), intent(out) :: &
1774 : xpwp ! x'w' [(units vary)(m/s)]
1775 :
1776 : integer :: i, k
1777 :
1778 : ! ----------------------- Begin Code -----------------------
1779 :
1780 : !$acc data copyin( gr, gr%invrs_dzm, Km_zm, xm ) &
1781 : !$acc copyout( xpwp )
1782 :
1783 : ! Solve for x'w' at all intermediate model levels.
1784 : !$acc parallel loop gang vector collapse(2) default(present)
1785 1380011040 : do k = 1, nz-1
1786 22788116640 : do i = 1, ngrdcol
1787 22771881216 : xpwp(i,k) = Km_zm(i,k) * gr%invrs_dzm(i,k) * ( xm(i,k+1) - xm(i,k) )
1788 : end do
1789 : end do
1790 : !$acc end parallel loop
1791 :
1792 : !$acc end data
1793 :
1794 16235424 : return
1795 :
1796 : end subroutine calc_xpwp_2D
1797 :
1798 : !=============================================================================
1799 0 : function vertical_avg( total_idx, rho_ds, field, dz )
1800 :
1801 : ! Description:
1802 : ! Computes the density-weighted vertical average of a field.
1803 : !
1804 : ! The average value of a function, f, over a set domain, [a,b], is
1805 : ! calculated by the equation:
1806 : !
1807 : ! f_avg = ( INT(a:b) f*g ) / ( INT(a:b) g );
1808 : !
1809 : ! as long as f is continous and g is nonnegative and integrable. Therefore,
1810 : ! the density-weighted (by dry, static, base-static density) vertical
1811 : ! average value of any model field, x, is calculated by the equation:
1812 : !
1813 : ! x_avg|_z = ( INT(z_bot:z_top) x rho_ds dz )
1814 : ! / ( INT(z_bot:z_top) rho_ds dz );
1815 : !
1816 : ! where z_bot is the bottom of the vertical domain, and z_top is the top of
1817 : ! the vertical domain.
1818 : !
1819 : ! This calculation is done slightly differently depending on whether x is a
1820 : ! thermodynamic-level or a momentum-level variable.
1821 : !
1822 : ! Thermodynamic-level computation:
1823 :
1824 : !
1825 : ! For numerical purposes, INT(z_bot:z_top) x rho_ds dz, which is the
1826 : ! numerator integral, is calculated as:
1827 : !
1828 : ! SUM(k_bot:k_top) x(k) rho_ds(k) delta_z(k);
1829 : !
1830 : ! where k is the index of the given thermodynamic level, x and rho_ds are
1831 : ! both thermodynamic-level variables, and delta_z(k) = zm(k) - zm(k-1). The
1832 : ! indices k_bot and k_top are the indices of the respective lower and upper
1833 : ! thermodynamic levels involved in the integration.
1834 : !
1835 : ! Likewise, INT(z_bot:z_top) rho_ds dz, which is the denominator integral,
1836 : ! is calculated as:
1837 : !
1838 : ! SUM(k_bot:k_top) rho_ds(k) delta_z(k).
1839 : !
1840 : ! The first (k=1) thermodynamic level is below ground (or below the
1841 : ! official lower boundary at the first momentum level), so it should not
1842 : ! count in a vertical average, whether that vertical average is used for
1843 : ! the hole-filling scheme or for statistical purposes. Begin no lower
1844 : ! than level k=2, which is the first thermodynamic level above ground (or
1845 : ! above the model lower boundary).
1846 : !
1847 : ! For cases where hole-filling over the entire (global) vertical domain
1848 : ! is desired, or where statistics over the entire (global) vertical
1849 : ! domain are desired, the lower (thermodynamic-level) index of k = 2 and
1850 : ! the upper (thermodynamic-level) index of k = gr%nz, means that the
1851 : ! overall vertical domain will be gr%zm(1,gr%nz) - gr%zm(1,1).
1852 : !
1853 : !
1854 : ! Momentum-level computation:
1855 : !
1856 : ! For numerical purposes, INT(z_bot:z_top) x rho_ds dz, which is the
1857 : ! numerator integral, is calculated as:
1858 : !
1859 : ! SUM(k_bot:k_top) x(k) rho_ds(k) delta_z(k);
1860 : !
1861 : ! where k is the index of the given momentum level, x and rho_ds are both
1862 : ! momentum-level variables, and delta_z(k) = zt(k+1) - zt(k). The indices
1863 : ! k_bot and k_top are the indices of the respective lower and upper momentum
1864 : ! levels involved in the integration.
1865 : !
1866 : ! Likewise, INT(z_bot:z_top) rho_ds dz, which is the denominator integral,
1867 : ! is calculated as:
1868 : !
1869 : ! SUM(k_bot:k_top) rho_ds(k) delta_z(k).
1870 : !
1871 : ! The first (k=1) momentum level is right at ground level (or right at
1872 : ! the official lower boundary). The momentum level variables that call
1873 : ! the hole-filling scheme have set values at the surface (or lower
1874 : ! boundary), and those set values should not be changed. Therefore, the
1875 : ! vertical average (for purposes of hole-filling) should not include the
1876 : ! surface level (or lower boundary level). For hole-filling purposes,
1877 : ! begin no lower than level k=2, which is the second momentum level above
1878 : ! ground (or above the model lower boundary). Likewise, the value at the
1879 : ! model upper boundary (k=gr%nz) is also set for momentum level
1880 : ! variables. That value should also not be changed.
1881 : !
1882 : ! However, this function is also used to keep track (for statistical
1883 : ! purposes) of the vertical average of certain variables. In that case,
1884 : ! the vertical average needs to be taken over the entire vertical domain
1885 : ! (level 1 to level gr%nz).
1886 : !
1887 : !
1888 : ! In both the thermodynamic-level computation and the momentum-level
1889 : ! computation, the numerator integral is divided by the denominator integral
1890 : ! in order to find the average value (over the vertical domain) of x.
1891 :
1892 : ! References:
1893 : ! None
1894 : !-----------------------------------------------------------------------
1895 :
1896 : use clubb_precision, only: &
1897 : core_rknd ! Variable(s)
1898 :
1899 : implicit none
1900 :
1901 : ! Input variables
1902 : integer, intent(in) :: &
1903 : total_idx ! The total numer of indices within the range of averaging
1904 :
1905 : real( kind = core_rknd ), dimension(total_idx), intent(in) :: &
1906 : rho_ds, & ! Dry, static density on either thermodynamic or momentum levels [kg/m^3]
1907 : field, & ! The field (e.g. wp2) to be vertically averaged [Units vary]
1908 : dz ! Reciprocal of thermodynamic or momentum level thickness [1/m]
1909 : ! depending on whether we're on zt or zm grid.
1910 : ! Note: The rho_ds and field points need to be arranged from
1911 : ! lowest to highest in altitude, with rho_ds(1) and
1912 : ! field(1) actually their respective values at level k = 1.
1913 :
1914 : ! Output variable
1915 : real( kind = core_rknd ) :: &
1916 : vertical_avg ! Vertical average of field [Units of field]
1917 :
1918 : ! Local variables
1919 : real( kind = core_rknd ) :: &
1920 : numer_integral, & ! Integral in the numerator (see description)
1921 : denom_integral ! Integral in the denominator (see description)
1922 :
1923 :
1924 : integer :: k
1925 :
1926 : !-----------------------------------------------------------------------
1927 :
1928 : ! Initialize variable
1929 0 : numer_integral = 0.0_core_rknd
1930 0 : denom_integral = 0.0_core_rknd
1931 :
1932 : ! Compute the numerator and denominator integral.
1933 : ! Multiply rho_ds at level k by the level thickness
1934 : ! at level k. Then, sum over all vertical levels.
1935 0 : do k=1, total_idx
1936 :
1937 0 : numer_integral = numer_integral + rho_ds(k) * dz(k) * field(k)
1938 0 : denom_integral = denom_integral + rho_ds(k) * dz(k)
1939 :
1940 : end do
1941 :
1942 : ! Find the vertical average of 'field'.
1943 0 : vertical_avg = numer_integral / denom_integral
1944 : !vertical_avg = sum( rho_ds(:) * dz(:) * field(:) ) / sum( rho_ds(:) * dz(:) )
1945 :
1946 : return
1947 : end function vertical_avg
1948 :
1949 : !=============================================================================
1950 0 : function vertical_integral( total_idx, rho_ds, &
1951 0 : field, dz )
1952 :
1953 : ! Description:
1954 : ! Computes the vertical integral. rho_ds, field, and dz must all be
1955 : ! of size total_idx and should all start at the same index.
1956 : !
1957 :
1958 : ! References:
1959 : ! None
1960 : !-----------------------------------------------------------------------
1961 :
1962 : use clubb_precision, only: &
1963 : core_rknd ! Variable(s)
1964 :
1965 : implicit none
1966 :
1967 : ! Input variables
1968 : integer, intent(in) :: &
1969 : total_idx ! The total numer of indices within the range of averaging
1970 :
1971 : real( kind = core_rknd ), dimension(total_idx), intent(in) :: &
1972 : rho_ds, & ! Dry, static density [kg/m^3]
1973 : field, & ! The field to be vertically averaged [Units vary]
1974 : dz ! Level thickness [1/m]
1975 : ! Note: The rho_ds and field points need to be arranged from
1976 : ! lowest to highest in altitude, with rho_ds(1) and
1977 : ! field(1) actually their respective values at level k = k_start.
1978 :
1979 : ! Local variables
1980 : real( kind = core_rknd ) :: &
1981 : vertical_integral ! Integral in the numerator (see description)
1982 :
1983 : !-----------------------------------------------------------------------
1984 :
1985 : ! Assertion checks: that k_start <= gr%nz - 1
1986 : ! that k_end >= 2
1987 : ! that k_start <= k_end
1988 :
1989 :
1990 : ! Initializing vertical_integral to avoid a compiler warning.
1991 0 : vertical_integral = 0.0_core_rknd
1992 :
1993 : ! Compute the integral.
1994 : ! Multiply the field at level k by rho_ds at level k and by
1995 : ! the level thickness at level k. Then, sum over all vertical levels.
1996 : ! Note: The values of the field and rho_ds are passed into this function
1997 : ! so that field(1) and rho_ds(1) are actually the field and rho_ds
1998 : ! at level k_start.
1999 0 : vertical_integral = sum( field * rho_ds * dz )
2000 :
2001 : !print *, vertical_integral
2002 :
2003 : return
2004 : end function vertical_integral
2005 :
2006 :
2007 : end module advance_helper_module
|