epbl_find_mstar Subroutine

public pure subroutine epbl_find_mstar(scheme, mstar_const, mstar_cap, mstar_coef1, c_ek, mstar_conv_adj, cn1, cn2, cn3, cs1, cs2, b0, ustar, bld, absf, mstar)

mstar = (mechanical TKE available for entrainment) / u^3. Schemes: constant; OM4 Ekman/Obukhov balance; RH18 fits. All followed by the optional convective reduction (mstar_conv_adj in [0,1]; the u=0 corner multiplies by (1 - adj), matching the reference behaviour).

Arguments

Type IntentOptional Attributes Name
integer, intent(in) :: scheme
real(kind=wp), intent(in) :: mstar_const
real(kind=wp), intent(in) :: mstar_cap
real(kind=wp), intent(in) :: mstar_coef1
real(kind=wp), intent(in) :: c_ek
real(kind=wp), intent(in) :: mstar_conv_adj
real(kind=wp), intent(in) :: cn1
real(kind=wp), intent(in) :: cn2
real(kind=wp), intent(in) :: cn3
real(kind=wp), intent(in) :: cs1
real(kind=wp), intent(in) :: cs2
real(kind=wp), intent(in) :: b0

Surface buoyancy flux (m^2/s^3); > 0 stabilizing.
real(kind=wp), intent(in) :: ustar

Surface friction velocity (m/s), already floored.
real(kind=wp), intent(in) :: bld

Boundary-layer depth guess (m).
real(kind=wp), intent(in) :: absf

|Coriolis| (1/s), possibly omega-blended.
real(kind=wp), intent(out) :: mstar

Called by

proc~~epbl_find_mstar~~CalledByGraph proc~epbl_find_mstar epbl_find_mstar proc~epbl_column_kernel epbl_column_kernel proc~epbl_column_kernel->proc~epbl_find_mstar proc~epbl_compute epbl_compute proc~epbl_compute->proc~epbl_column_kernel proc~vmix_apply_in_stage vmix_apply_in_stage proc~vmix_apply_in_stage->proc~epbl_compute proc~run_stage run_stage proc~run_stage->proc~vmix_apply_in_stage proc~run_stage_split run_stage_split proc~run_stage_split->proc~vmix_apply_in_stage proc~ocean_dyn_step ocean_dyn_step proc~ocean_dyn_step->proc~run_stage proc~ocean_dyn_step_split ocean_dyn_step_split proc~ocean_dyn_step_split->proc~run_stage_split

Variables

Type Visibility Attributes Name Initial
real(kind=wp), private :: absf_floor
real(kind=wp), private :: mscr_t1
real(kind=wp), private :: mscr_t2
real(kind=wp), private :: msn_term
real(kind=wp), private :: mstar_n
real(kind=wp), private :: mstar_s

Source Code

   pure subroutine epbl_find_mstar(scheme, mstar_const, mstar_cap, &
                                   mstar_coef1, c_ek, mstar_conv_adj, &
                                   cn1, cn2, cn3, cs1, cs2, &
                                   b0, ustar, bld, absf, mstar)
      !! mstar = (mechanical TKE available for entrainment) / u*^3.
      !! Schemes: constant; OM4 Ekman/Obukhov balance; RH18 fits.
      !! All followed by the optional convective reduction
      !! (mstar_conv_adj in [0,1]; the u*=0 corner multiplies by
      !! (1 - adj), matching the reference behaviour).
      !$acc routine seq
      integer, intent(in) :: scheme
      real(wp), intent(in) :: mstar_const, mstar_cap
      real(wp), intent(in) :: mstar_coef1, c_ek, mstar_conv_adj
      real(wp), intent(in) :: cn1, cn2, cn3, cs1, cs2
      real(wp), intent(in) :: b0
         !! Surface buoyancy flux (m^2/s^3); > 0 stabilizing.
      real(wp), intent(in) :: ustar
         !! Surface friction velocity (m/s), already floored.
      real(wp), intent(in) :: bld
         !! Boundary-layer depth guess (m).
      real(wp), intent(in) :: absf
         !! |Coriolis| (1/s), possibly omega-blended.
      real(wp), intent(out) :: mstar

      real(wp) :: mstar_n, mstar_s, msn_term, absf_floor
      real(wp) :: mscr_t1, mscr_t2

      absf_floor = max(absf, 1.0e-20_wp)
      select case (scheme)
      case (EPBL_MSTAR_OM4)
         mstar_s = mstar_coef1*sqrt(max(0.0_wp, b0)/(ustar*ustar*absf_floor))
         mstar_n = 0.0_wp
         if (ustar > absf_floor*bld) then
            mstar_n = c_ek*log(ustar/(absf_floor*max(bld, 1.0e-10_wp)))
         end if
         mstar = max(mstar_s, min(1.25_wp, mstar_n))
         if (mstar_cap > 0.0_wp) mstar = min(mstar_cap, mstar)
      case (EPBL_MSTAR_RH18)
         msn_term = cn2*exp(cn3*bld*absf/ustar)
         mstar_n = cn1*msn_term/(1.0_wp + msn_term)
         mstar_s = cs1*(max(0.0_wp, b0)**2*bld/(ustar**5*absf_floor))**cs2
         mstar = mstar_n + mstar_s
         if (mstar_cap > 0.0_wp) mstar = min(mstar_cap, mstar)
      case default  ! EPBL_MSTAR_CONSTANT
         mstar = mstar_const
      end select

      ! Convective reduction (no-op at the default adj = 0).
      if (mstar_conv_adj > 0.0_wp) then
         mscr_t1 = -bld*min(0.0_wp, b0)
         mscr_t2 = 2.0_wp*mstar*ustar**3
         if (mscr_t2 > 0.0_wp) then
            mstar = mstar*((1.0_wp - mstar_conv_adj)*mscr_t1 + mscr_t2)/ &
                    (mscr_t1 + mscr_t2)
         else
            mstar = mstar*(1.0_wp - mstar_conv_adj)
         end if
      end if
   end subroutine epbl_find_mstar