LCOV - code coverage report
Current view: top level - physics/clubb/src/CLUBB_core - advance_helper_module.F90 (source / functions) Hit Total Coverage
Test: coverage.info Lines: 145 321 45.2 %
Date: 2025-03-13 18:42:46 Functions: 6 21 28.6 %

          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

Generated by: LCOV version 1.14