src/parameterizations/vertical/MOM_energetic_PBL.F90

portedportable, not yet portedexecuted, not portableexecutable, not hit by this run

1		! This file is part of MOM6, the Modular Ocean Model version 6.
2		! See the LICENSE file for licensing information.
3		! SPDX-License-Identifier: Apache-2.0
4
5		!> Energetically consistent planetary boundary layer parameterization
6		module MOM_energetic_PBL
7
8		use MOM_cpu_clock, only : cpu_clock_id, cpu_clock_begin, cpu_clock_end, CLOCK_ROUTINE
9		use MOM_coms, only : EFP_type, real_to_EFP, EFP_to_real, operator(+), assignment(=), EFP_sum_across_PEs
10		use MOM_debugging, only : hchksum
11		use MOM_diag_mediator, only : post_data, register_diag_field, safe_alloc_alloc
12		use MOM_diag_mediator, only : post_data_3d_by_column, post_data_3d_final
13		use MOM_diag_mediator, only : time_type, diag_ctrl
14		use MOM_domains, only : create_group_pass, do_group_pass, group_pass_type
15		use MOM_error_handler, only : MOM_error, FATAL, WARNING, MOM_mesg
16		use MOM_file_parser, only : get_param, log_param, log_version, param_file_type
17		use MOM_forcing_type, only : forcing
18		use MOM_grid, only : ocean_grid_type
19		use MOM_interface_heights, only : thickness_to_dz
20		use MOM_intrinsic_functions, only : cuberoot
21		use MOM_string_functions, only : uppercase
22		use MOM_unit_scaling, only : unit_scale_type
23		use MOM_variables, only : thermo_var_ptrs, vertvisc_type
24		use MOM_verticalGrid, only : verticalGrid_type
25		use MOM_wave_interface, only : wave_parameters_CS, Get_Langmuir_Number
26		use MOM_stochastics, only : stochastic_CS
27
28		implicit none ; private
29
30		#include <MOM_memory.h>
31
32		public energetic_PBL, energetic_PBL_init, energetic_PBL_end
33		public energetic_PBL_get_MLD
34
35		! A note on unit descriptions in comments: MOM6 uses units that can be rescaled for dimensional
36		! consistency testing. These are noted in comments with units like Z, H, L, and T, along with
37		! their mks counterparts with notation like "a velocity [Z T-1 ~> m s-1]". If the units
38		! vary with the Boussinesq approximation, the Boussinesq variant is given first.
39
40		!> This control structure holds parameters for the MOM_energetic_PBL module
41		type, public :: energetic_PBL_CS ; private
42		logical :: initialized = .false. !< True if this control structure has been initialized.
43
44		!/ Constants
45		real :: VonKar !< The von Karman coefficient as used in the ePBL module [nondim]
46		real :: omega !< The Earth's rotation rate [T-1 ~> s-1].
47		real :: omega_frac !< When setting the decay scale for turbulence, use this fraction of
48		!! the absolute rotation rate blended with the local value of f, as
49		!! sqrt((1-omega_frac)f^2 + omega_frac4*omega^2) [nondim].
50
51		!/ Convection related terms
52		real :: nstar !< The fraction of the TKE input to the mixed layer available to drive
53		!! entrainment [nondim]. This quantity is the vertically integrated
54		!! buoyancy production minus the vertically integrated dissipation of
55		!! TKE produced by buoyancy.
56
57		!/ Mixing Length terms
58		logical :: Use_MLD_iteration !< If true, use the proximity to the bottom of the actively turbulent
59		!! surface boundary layer to constrain the mixing lengths.
60		logical :: MLD_iteration_guess !< False to default to guessing half the
61		!! ocean depth for the first iteration.
62		logical :: MLD_bisection !< If true, use bisection with the iterative determination of the
63		!! self-consistent mixed layer depth. Otherwise use the false position
64		!! after a maximum and minimum bound have been evaluated and the
65		!! returned value from the previous guess or bisection before this.
66		logical :: MLD_iter_bug !< If true use buggy logic that gives the wrong bounds for the next
67		!! iteration when successive guesses increase by exactly EPBL_MLD_TOLERANCE.
68		integer :: max_MLD_its !< The maximum number of iterations that can be used to find a
69		!! self-consistent mixed layer depth with Use_MLD_iteration.
70		real :: MixLenExponent !< Exponent in the mixing length shape-function [nondim].
71		!! 1 is law-of-the-wall at top and bottom,
72		!! 2 is more KPP like.
73		real :: MKE_to_TKE_effic !< The efficiency with which mean kinetic energy released by
74		!! mechanically forced entrainment of the mixed layer is converted to
75		!! TKE, times conversion factors between the natural units of mean
76		!! kinetic energy and those used for TKE [Z2 L-2 ~> nondim].
77		logical :: direct_calc !< If true and there is no conversion from mean kinetic energy to ePBL
78		!! turbulent kinetic energy, use a direct calculation of the
79		!! diffusivity that is supported by a given energy input instead of the
80		!! more general but slower iterative solver.
81		real :: ustar_min !< A minimum value of ustar to avoid numerical problems [Z T-1 ~> m s-1].
82		!! If the value is small enough, this should not affect the solution.
83		real :: Ekman_scale_coef !< A nondimensional scaling factor controlling the inhibition of the
84		!! diffusive length scale by rotation [nondim]. Making this larger decreases
85		!! the diffusivity in the planetary boundary layer.
86		real :: transLay_scale !< A scale for the mixing length in the transition layer
87		!! at the edge of the boundary layer as a fraction of the
88		!! boundary layer thickness [nondim]. The default is 0, but a
89		!! value of 0.1 might be better justified by observations.
90		real :: MLD_tol !< A tolerance for determining the boundary layer thickness when
91		!! Use_MLD_iteration is true [Z ~> m].
92		real :: min_mix_len !< The minimum mixing length scale that will be used by ePBL [Z ~> m].
93		!! The default (0) does not set a minimum.
94
95		!/ Velocity scale terms
96		integer :: wT_scheme !< An enumerated value indicating the method for finding the turbulent
97		!! velocity scale. There are currently two options:
98		!! wT_mwT_from_cRoot_TKE is the original (TKE_remaining)^1/3
99		!! wT_from_RH18 is the version described by Reichl and Hallberg, 2018
100		real :: wstar_ustar_coef !< A ratio relating the efficiency with which convectively released
101		!! energy is converted to a turbulent velocity, relative to
102		!! mechanically forced turbulent kinetic energy [nondim].
103		!! Making this larger increases the diffusivity.
104		real :: vstar_surf_fac !< If (wT_scheme == wT_from_RH18) this is the proportionality coefficient between
105		!! ustar and the surface mechanical contribution to vstar [nondim]
106		real :: vstar_scale_fac !< An overall nondimensional scaling factor for vstar [nondim]. Making
107		!! this larger increases the diffusivity.
108
109		!mstar related options
110		integer :: mstar_scheme !< An encoded integer to determine which formula is used to set mstar
111		integer :: BBL_mstar_scheme !< An encoded integer to determine which formula is used to set mstar
112		real :: mstar_cap !< Since mstar is restoring undissipated energy to mixing,
113		!! there must be a cap on how large it can be [nondim]. This
114		!! is definitely a function of latitude (Ekman limit),
115		!! but will be taken as constant for now.
116
117		!/ vertical decay related options
118		real :: TKE_decay !< The ratio of the natural Ekman depth to the TKE decay scale [nondim].
119
120		!/ mstar_scheme == 0
121		real :: fixed_mstar !< mstar is the ratio of the friction velocity cubed to the TKE available to
122		!! drive entrainment [nondim]. This quantity is the vertically
123		!! integrated shear production minus the vertically integrated
124		!! dissipation of TKE produced by shear. This value is used if the option
125		!! for using a fixed mstar is used.
126		real :: BBL_fixed_mstar !< Similar to fixed_mstar, but for the bottom boundary layer
127
128		!/ mstar_scheme == 2
129		real :: C_Ek = 0.17 !< mstar Coefficient in rotation limit for EPBL_MSTAR_SCHEME=OM4 [nondim]
130		real :: mstar_coef = 0.3 !< mstar coefficient in rotation/stabilizing balance for EPBL_MSTAR_SCHEME=OM4 [nondim]
131
132		!/ mstar_scheme == 3
133		real :: RH18_mstar_cN1 !< mstar_N coefficient 1 (outer-most coefficient for fit) [nondim].
134		!! Value of 0.275 in RH18. Increasing this
135		!! coefficient increases mechanical mixing for all values of Hf/ust,
136		!! but is most effective at low values (weakly developed OSBLs).
137		real :: RH18_mstar_cN2 !< mstar_N coefficient 2 (coefficient outside of exponential decay) [nondim].
138		!! Value of 8.0 in RH18. Increasing this coefficient increases mstar
139		!! for all values of HF/ust, with a consistent affect across
140		!! a wide range of Hf/ust.
141		real :: RH18_mstar_cN3 !< mstar_N coefficient 3 (exponential decay coefficient) [nondim]. Value of
142		!! -5.0 in RH18. Increasing this increases how quickly the value
143		!! of mstar decreases as Hf/ust increases.
144		real :: RH18_mstar_cS1 !< mstar_S coefficient for RH18 in stabilizing limit [nondim].
145		!! Value of 0.2 in RH18.
146		real :: RH18_mstar_cS2 !< mstar_S exponent for RH18 in stabilizing limit [nondim].
147		!! Value of 0.4 in RH18.
148
149		!/ Coefficient for shear/convective turbulence interaction
150		real :: mstar_convect_coef !< Factor to reduce mstar when statically unstable [nondim].
151
152		!/ Langmuir turbulence related parameters
153		logical :: Use_LT = .false. !< Flag for using LT in Energy calculation
154		integer :: LT_enhance_form !< Integer for Enhancement functional form (various options)
155		real :: LT_enhance_coef !< Coefficient in fit for Langmuir Enhancement [nondim]
156		real :: LT_enhance_exp !< Exponent in fit for Langmuir Enhancement [nondim]
157		real :: LaC_MLD_Ek !< Coefficient for Langmuir number modification based on the ratio of
158		!! the mixed layer depth over the Ekman depth [nondim].
159		real :: LaC_MLD_Ob_stab !< Coefficient for Langmuir number modification based on the ratio of
160		!! the mixed layer depth over the Obukhov depth with stabilizing forcing [nondim].
161		real :: LaC_Ek_Ob_stab !< Coefficient for Langmuir number modification based on the ratio of
162		!! the Ekman depth over the Obukhov depth with stabilizing forcing [nondim].
163		real :: LaC_MLD_Ob_un !< Coefficient for Langmuir number modification based on the ratio of
164		!! the mixed layer depth over the Obukhov depth with destabilizing forcing [nondim].
165		real :: LaC_Ek_Ob_un !< Coefficient for Langmuir number modification based on the ratio of
166		!! the Ekman depth over the Obukhov depth with destabilizing forcing [nondim].
167		real :: Max_Enhance_M = 5. !< The maximum allowed LT enhancement to the mixing [nondim].
168
169		!/ Machine learned equation discovery model paramters
170		logical :: eqdisc !< Uses machine learned shape function
171		logical :: eqdisc_v0 !< Uses machine learned velocity scale
172		logical :: eqdisc_v0h !< Uses machine learned velocity scale that uses boundary layer depth as input
173		real :: v0_lower_cap !< Lower cap to prevent v0 from attaining anomlously low values [Z T-1 ~> m s-1]
174		real :: v0_upper_cap !< Upper cap to prevent v0 from attaining anomlously high values [Z T-1 ~> m s-1]
175		real :: f_lower !< Lower cap of \|f\| i.e. absolute of Coriolis parameter [T-1 ~> s-1]
176		!! Used only in get_eqdisc_v0 subroutine. Default is 0.1deg Lat
177		real :: bflux_lower_cap !< Lower cap for capping blfux [Z2 T-3 ~> m2 s-3]
178		real :: bflux_upper_cap !< Upper cap for capping blfux [Z2 T-3 ~> m2 s-3]
179		real :: sigma_max_lower_cap !< Lower cap to prevent sigma_max from attaining low values [nondim]
180		real :: sigma_max_upper_cap !< Upper cap to prevent sigma_max from attaining high values [nondim]
181		real :: Eh_upper_cap !< Upper cap to prevent Eh = hf/(u__*) from attaining high values [nondim]
182		real :: Lh_cap !< Cap to prevent Lh = h/Monin_Obukhov_depth from attaining beyond extreme values [nondim]
183		real, allocatable, dimension(:) :: shape_function !< shape function used in machine learned diffusivity [nondim]
184		!/ Coefficients used for Machine learned diffusivity
185		real :: ML_c(18) !< Array of non-dimensional constants used in machine learned (ML) diffusivity [nondim]
186		real :: shape_function_epsilon !< An small value of shape_function below the boundary layer depth [nondim]
187
188		!/ Bottom boundary layer mixing related options
189		real :: ePBL_BBL_effic !< The efficiency of bottom boundary layer mixing via ePBL driven by
190		!! the bottom drag dissipation of mean kinetic energy, times
191		!! conversion factors between the natural units of mean kinetic energy
192		!! and those used for TKE [Z2 L-2 ~> nondim].
193		real :: ePBL_tidal_effic !< The efficiency of bottom boundary layer mixing via ePBL driven by
194		!! the bottom drag dissipation of tides, times conversion factors
195		!! between the natural units of mean kinetic energy and those used for
196		!! TKE [Z2 L-2 ~> nondim].
197		logical :: Use_BBLD_iteration !< If true, use the proximity to the top of the actively turbulent
198		!! bottom boundary layer to constrain the mixing lengths.
199		real :: TKE_decay_BBL !< The ratio of the natural Ekman depth to the TKE decay scale for
200		!! bottom boundary layer mixing [nondim]
201		real :: min_BBL_mix_len !< The minimum mixing length scale that will be used by ePBL in the bottom
202		!! boundary layer mixing [Z ~> m]. The default (0) does not set a minimum.
203		real :: MixLenExponent_BBL !< Exponent in the bottom boundary layer mixing length shape-function [nondim].
204		!! 1 is law-of-the-wall at top and bottom,
205		!! 2 is more KPP like.
206		real :: BBLD_tol !< The tolerance for the iteratively determined bottom boundary layer depth [Z ~> m].
207		!! This is only used with USE_MLD_ITERATION.
208		integer :: max_BBLD_its !< The maximum number of iterations that can be used to find a self-consistent
209		!! bottom boundary layer depth.
210		integer :: wT_scheme_BBL !< An enumerated value indicating the method for finding the bottom boundary
211		!! layer turbulent velocity scale. There are currently two options:
212		!! wT_mwT_from_cRoot_TKE is the original (TKE_remaining)^1/3
213		!! wT_from_RH18 is the version described by Reichl and Hallberg, 2018
214		real :: vstar_scale_fac_BBL !< An overall nondimensional scaling factor for wT in the bottom boundary layer [nondim].
215		!! Making this larger increases the bottom boundary layer diffusivity.", &
216		real :: vstar_surf_fac_BBL !< If (wT_scheme_BBL == wT_from_RH18) this is the proportionality coefficient between
217		!! ustar and the bottom boundayer layer mechanical contribution to vstar [nondim]
218		real :: Ekman_scale_coef_BBL !< A nondimensional scaling factor controlling the inhibition of the
219		!! diffusive length scale by rotation in the bottom boundary layer [nondim].
220		!! Making this larger decreases the bottom boundary layer diffusivity.
221		logical :: decay_adjusted_BBL_TKE !< If true, include an adjustment factor in the bottom boundary layer
222		!! energetics that accounts for an exponential decay of TKE from a
223		!! near-bottom source and an assumed piecewise linear linear profile
224		!! of the buoyancy flux response to a change in a diffusivity.
225		logical :: BBL_effic_bug !< If true, overestimate the efficiency of the non-tidal ePBL bottom boundary
226		!! layer diffusivity by a factor of 1/sqrt(CDRAG), which is often a factor of
227		!! about 18.3.
228		logical :: ePBL_BBL_use_mstar !< If true, use an mstar*ustar^3 paramaterization to get the TKE available
229		!! to drive mixing in the bottom boundary layer version of ePBL. Otherwise,
230		!! use the meanflow energy loss to bottom drag scaled by a constant efficiency.
231
232		!/ Options for documenting differences from parameter choices
233		integer :: options_diff !< If positive, this is a coded integer indicating a pair of
234		!! settings whose differences are diagnosed in a passive diagnostic mode
235		!! via extra calls to ePBL_column. If this is 0 or negative no extra
236		!! calls occur.
237
238		!/ Others
239		type(time_type), pointer :: Time=>NULL() !< A pointer to the ocean model's clock.
240
241		logical :: TKE_diagnostics = .false. !< If true, diagnostics of the TKE budget are being calculated.
242		integer :: answer_date !< The vintage of the order of arithmetic and expressions in the ePBL
243		!! calculations. Values below 20190101 recover the answers from the
244		!! end of 2018, while higher values use updated and more robust forms
245		!! of the same expressions. Values below 20240101 use A**(1./3.) to
246		!! estimate the cube root of A in several expressions, while higher
247		!! values use the integer root function cuberoot(A) and therefore
248		!! can work with scaled variables.
249		logical :: orig_PE_calc !< If true, the ePBL code uses the original form of the
250		!! potential energy change code. Otherwise, it uses a newer version
251		!! that can work with successive increments to the diffusivity in
252		!! upward or downward passes.
253		logical :: debug !< If true, write verbose checksums for debugging purposes.
254		type(diag_ctrl), pointer :: diag=>NULL() !< A structure that is used to regulate the
255		!! timing of diagnostic output.
256
257		real, allocatable, dimension(:,:) :: &
258		ML_depth !< The mixed layer depth determined by active mixing in ePBL, which may
259		!! be used for the first guess in the next time step [H ~> m or kg m-2]
260		real, allocatable, dimension(:,:) :: &
261		BBL_depth !< The bottom boundary layer depth determined by active mixing in ePBL [H ~> m or kg m-2]
262
263		type(EFP_type), dimension(2) :: sum_its !< The total number of iterations and columns worked on
264		type(EFP_type), dimension(2) :: sum_its_BBL !< The total number of iterations and columns worked on
265
266		!>@{ Diagnostic IDs
267		integer :: id_Kd_ePBL_col_by_col = -1
268		integer :: id_ML_depth = -1, id_hML_depth = -1, id_TKE_wind = -1, id_TKE_mixing = -1
269		integer :: id_ustar_ePBL = -1, id_bflx_ePBL = -1
270		integer :: id_TKE_MKE = -1, id_TKE_conv = -1, id_TKE_forcing = -1
271		integer :: id_TKE_mech_decay = -1, id_TKE_conv_decay = -1
272		integer :: id_Mixing_Length = -1, id_Velocity_Scale = -1
273		integer :: id_Kd_BBL = -1, id_BBL_Mix_Length = -1, id_BBL_Vel_Scale = -1
274		integer :: id_TKE_BBL = -1, id_TKE_BBL_mixing = -1, id_TKE_BBL_decay = -1
275		integer :: id_ustar_BBL = -1, id_bflx_BBL = -1, id_BBL_decay_scale = -1, id_BBL_depth = -1
276		integer :: id_mstar_sfc = -1, id_mstar_BBL = -1, id_LA_mod = -1, id_LA = -1, id_mstar_LT = -1
277		! The next options are used when passively diagnosing sensitivities from parameter choices
278		integer :: id_opt_diff_Kd_ePBL = -1, id_opt_maxdiff_Kd_ePBL = -1, id_opt_diff_hML_depth = -1
279		!>@}
280		end type energetic_PBL_CS
281
282		!>@{ Enumeration values for mstar_scheme
283		integer, parameter :: Use_Fixed_mstar = 0 !< The value of mstar_scheme to use a constant mstar
284		integer, parameter :: mstar_from_Ekman = 2 !< The value of mstar_scheme to base mstar on the ratio
285		!! of the Ekman layer depth to the Obukhov depth
286		integer, parameter :: mstar_from_RH18 = 3 !< The value of mstar_scheme to base mstar of of RH18
287		integer, parameter :: No_Langmuir = 0 !< The value of LT_enhance_form not use Langmuir turbulence.
288		integer, parameter :: Langmuir_rescale = 2 !< The value of LT_enhance_form to use a multiplicative
289		!! rescaling of mstar to account for Langmuir turbulence.
290		integer, parameter :: Langmuir_add = 3 !< The value of LT_enhance_form to add a contribution to
291		!! mstar from Langmuir turbulence to other contributions.
292		integer, parameter :: wT_from_cRoot_TKE = 0 !< Use a constant times the cube root of remaining TKE
293		!! to calculate the turbulent velocity.
294		integer, parameter :: wT_from_RH18 = 1 !< Use a scheme based on a combination of w* and v* as
295		!! documented in Reichl & Hallberg (2018) to calculate
296		!! the turbulent velocity.
297		character*(20), parameter :: CONSTANT_STRING = "CONSTANT"
298		character*(20), parameter :: OM4_STRING = "OM4"
299		character*(20), parameter :: RH18_STRING = "REICHL_H18"
300		character*(20), parameter :: ROOT_TKE_STRING = "CUBE_ROOT_TKE"
301		character*(20), parameter :: NONE_STRING = "NONE"
302		character*(20), parameter :: RESCALED_STRING = "RESCALE"
303		character*(20), parameter :: ADDITIVE_STRING = "ADDITIVE"
304		!>@}
305
306		logical :: report_avg_its = .false. !< Report the average number of ePBL iterations for debugging.
307
308		!> A type for conveniently passing around ePBL diagnostics for a column.
309		type, public :: ePBL_column_diags ; private
310		!>@{ Local column copies of energy change diagnostics, all in [R Z3 T-3 ~> W m-2].
311		real :: dTKE_conv, dTKE_forcing, dTKE_wind, dTKE_mixing ! Local column diagnostics [R Z3 T-3 ~> W m-2]
312		real :: dTKE_MKE, dTKE_mech_decay, dTKE_conv_decay ! Local column diagnostics [R Z3 T-3 ~> W m-2]
313		real :: dTKE_BBL, dTKE_BBL_decay, dTKE_BBL_mixing ! Local column diagnostics [R Z3 T-3 ~> W m-2]
314		!>@}
315		real :: LA !< The value of the Langmuir number [nondim]
316		real :: LAmod !< The modified Langmuir number by convection [nondim]
317		real :: mstar !< The value of mstar used in ePBL [nondim]
318		real :: mstar_BBL !< The value of mstar used in ePBL BBL [nondim]
319		real :: mstar_LT !< The portion of mstar due to Langmuir turbulence [nondim]
320		integer :: OBL_its !< The number of iterations used to find a self-consistent surface boundary layer depth
321		integer :: BBL_its !< The number of iterations used to find a self-consistent bottom boundary layer depth
322		end type ePBL_column_diags
323
324		contains
325
326		!> This subroutine determines the diffusivities from the integrated energetics
327		!! mixed layer model. It assumes that heating, cooling and freshwater fluxes
328		!! have already been applied. All calculations are done implicitly, and there
329		!! is no stability limit on the time step.
330	12	subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, visc, dt, Kd_int, G, GV, US, CS, &
331	12	stoch_CS, dSV_dT, dSV_dS, TKE_forced, buoy_flux, BBL_buoy_flux, Waves )
332		type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure.
333		type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure.
334		type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type
335		real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), &
336		intent(inout) :: h_3d !< Layer thicknesses [H ~> m or kg m-2].
337		real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), &
338		intent(in) :: u_3d !< Zonal velocities interpolated to h points
339		!! [L T-1 ~> m s-1].
340		real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), &
341		intent(in) :: v_3d !< Zonal velocities interpolated to h points
342		!! [L T-1 ~> m s-1].
343		real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), &
344		intent(in) :: dSV_dT !< The partial derivative of in-situ specific
345		!! volume with potential temperature
346		!! [R-1 C-1 ~> m3 kg-1 degC-1].
347		real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), &
348		intent(in) :: dSV_dS !< The partial derivative of in-situ specific
349		!! volume with salinity [R-1 S-1 ~> m3 kg-1 ppt-1].
350		real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), &
351		intent(in) :: TKE_forced !< The forcing requirements to homogenize the
352		!! forcing that has been applied to each layer
353		!! [R Z3 T-2 ~> J m-2].
354		type(thermo_var_ptrs), intent(inout) :: tv !< A structure containing pointers to any
355		!! available thermodynamic fields. Absent fields
356		!! have NULL ptrs.
357		type(forcing), intent(inout) :: fluxes !< A structure containing pointers to any
358		!! possible forcing fields. Unused fields have
359		!! NULL ptrs.
360		type(vertvisc_type), intent(in) :: visc !< Structure with vertical viscosities,
361		!! BBL properties and related fields
362		real, intent(in) :: dt !< Time increment [T ~> s].
363		real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), &
364		intent(out) :: Kd_int !< The diagnosed diffusivities at interfaces
365		!! [H Z T-1 ~> m2 s-1 or kg m-1 s-1].
366		type(energetic_PBL_CS), intent(inout) :: CS !< Energetic PBL control structure
367		real, dimension(SZI_(G),SZJ_(G)), &
368		intent(in) :: buoy_flux !< The surface buoyancy flux [Z2 T-3 ~> m2 s-3].
369		real, dimension(SZI_(G),SZJ_(G)), &
370		intent(in) :: BBL_buoy_flux !< The bottom buoyancy flux [Z2 T-3 ~> m2 s-3].
371		type(wave_parameters_CS), pointer :: Waves !< Waves control structure for Langmuir turbulence
372		type(stochastic_CS), pointer :: stoch_CS !< The control structure returned by a previous
373
374		! This subroutine determines the diffusivities from the integrated energetics
375		! mixed layer model. It assumes that heating, cooling and freshwater fluxes
376		! have already been applied. All calculations are done implicitly, and there
377		! is no stability limit on the time step.
378		!
379		! For each interior interface, first discard the TKE to account for mixing
380		! of shortwave radiation through the next denser cell. Next drive mixing based
381		! on the local? values of ustar + wstar, subject to available energy. This
382		! step sets the value of Kd(K). Any remaining energy is then subject to decay
383		! before being handed off to the next interface. mech_TKE and conv_PErel are treated
384		! separately for the purposes of decay, but are used proportionately to drive
385		! mixing.
386		!
387		! The key parameters for the mixed layer are found in the control structure.
388		! To use the classic constant mstar mixed layers choose EPBL_MSTAR_SCHEME=CONSTANT.
389		! The key parameters then include mstar, nstar, TKE_decay, and conv_decay.
390		! For the Oberhuber (1993) mixed layer,the values of these are:
391		! mstar = 1.25, nstar = 1, TKE_decay = 2.5, conv_decay = 0.5
392		! TKE_decay is 1/kappa in eq. 28 of Oberhuber (1993), while conv_decay is 1/mu.
393		! For a traditional Kraus-Turner mixed layer, the values are:
394		! mstar = 1.25, nstar = 0.4, TKE_decay = 0.0, conv_decay = 0.0
395
396		! Local variables
397		real, dimension(SZI_(G),SZK_(GV)) :: &
398	24	h_2d, & ! A 2-d slice of the layer thickness [H ~> m or kg m-2].
399	24	dz_2d, & ! A 2-d slice of the vertical distance across layers [Z ~> m].
400	24	T_2d, & ! A 2-d slice of the layer temperatures [C ~> degC].
401	24	S_2d, & ! A 2-d slice of the layer salinities [S ~> ppt].
402	24	TKE_forced_2d, & ! A 2-d slice of TKE_forced [R Z3 T-2 ~> J m-2].
403	24	dSV_dT_2d, & ! A 2-d slice of dSV_dT [R-1 C-1 ~> m3 kg-1 degC-1].
404	24	dSV_dS_2d, & ! A 2-d slice of dSV_dS [R-1 S-1 ~> m3 kg-1 ppt-1].
405	24	u_2d, & ! A 2-d slice of the zonal velocity [L T-1 ~> m s-1].
406	24	v_2d ! A 2-d slice of the meridional velocity [L T-1 ~> m s-1].
407		real, dimension(SZI_(G),SZK_(GV)+1) :: &
408	24	Kd_2d ! A 2-d version of the diapycnal diffusivity [H Z T-1 ~> m2 s-1 or kg m-1 s-1]
409		real, dimension(SZK_(GV)) :: &
410	24	h, & ! The layer thickness [H ~> m or kg m-2].
411	24	dz, & ! The vertical distance across layers [Z ~> m].
412	24	T0, & ! The initial layer temperatures [C ~> degC].
413	24	S0, & ! The initial layer salinities [S ~> ppt].
414	24	dSV_dT_1d, & ! The partial derivatives of specific volume with temperature [R-1 C-1 ~> m3 kg-1 degC-1].
415	24	dSV_dS_1d, & ! The partial derivatives of specific volume with salinity [R-1 S-1 ~> m3 kg-1 ppt-1].
416	24	TKE_forcing, & ! Forcing of the TKE in the layer coming from TKE_forced [R Z3 T-2 ~> J m-2].
417	24	u, & ! The zonal velocity [L T-1 ~> m s-1].
418	24	v ! The meridional velocity [L T-1 ~> m s-1].
419		real, dimension(SZK_(GV)+1) :: &
420	24	Kd, & ! The diapycnal diffusivity due to ePBL [H Z T-1 ~> m2 s-1 or kg m-1 s-1].
421	24	mixvel, & ! A turbulent mixing velocity [Z T-1 ~> m s-1].
422	24	mixlen, & ! A turbulent mixing length [Z ~> m].
423	24	mixvel_BBL, & ! A bottom boundary layer turbulent mixing velocity [Z T-1 ~> m s-1].
424	24	mixlen_BBL, & ! A bottom boundary layer turbulent mixing length [Z ~> m].
425	24	Kd_BBL, & ! The bottom boundary layer diapycnal diffusivity [H Z T-1 ~> m2 s-1 or kg m-1 s-1].
426	24	SpV_dt, & ! Specific volume interpolated to interfaces divided by dt or 1.0 / (dt * Rho0),
427		! in [R-1 T-1 ~> m3 kg-1 s-1], used to convert local TKE into a turbulence velocity cubed.
428	24	SpV_dt_cf ! Specific volume interpolated to interfaces divided by dt or 1.0 / (dt * Rho0)
429		! times conversion factors for answer dates before 20240101 in
430		! [m3 Z-3 R-1 T2 s-3 ~> m3 kg-1 s-1] or without the conversion factors for
431		! answer dates of 20240101 and later in [R-1 T-1 ~> m3 kg-1 s-1], used to
432		! convert local TKE into a turbulence velocity cubed.
433		real :: h_neglect ! A thickness that is so small it is usually lost
434		! in roundoff and can be neglected [H ~> m or kg m-2].
435
436		real :: absf ! The absolute value of f [T-1 ~> s-1].
437		real :: U_star ! The surface friction velocity [Z T-1 ~> m s-1].
438		real :: U_Star_Mean ! The surface friction without gustiness [Z T-1 ~> m s-1].
439		real :: mech_TKE ! The mechanically generated turbulent kinetic energy available for mixing over a
440		! timestep before the application of the efficiency in mstar [R Z3 T-2 ~> J m-2]
441		real :: u_star_BBL ! The bottom boundary layer friction velocity [H T-1 ~> m s-1 or kg m-2 s-1].
442		real :: u_star_BBL_z_t ! The bottom boundary layer friction velocity converted to Z T-1 [Z T-1 ~> m s-1].
443		real :: BBL_TKE ! The mechanically generated turbulent kinetic energy available for bottom
444		! boundary layer mixing within a timestep [R Z3 T-2 ~> J m-2]
445		real :: I_rho ! The inverse of the Boussinesq reference density [R-1 ~> m3 kg-1]
446		real :: I_dt ! The Adcroft reciprocal of the timestep [T-1 ~> s-1]
447		real :: I_rho0dt ! The inverse of the Boussinesq reference density times the time
448		! step [R-1 T-1 ~> m3 kg-1 s-1]
449		real :: B_Flux ! The surface buoyancy flux [Z2 T-3 ~> m2 s-3]
450		real :: MLD_io ! The mixed layer depth found by ePBL_column [Z ~> m]
451		real :: BBLD_io ! The bottom boundary layer thickness found by ePBL_BBL_column [Z ~> m]
452		real :: MLD_in ! The first guess at the mixed layer depth [Z ~> m]
453		real :: BBLD_in ! The first guess at the bottom boundary layer thickness [Z ~> m]
454
455		type(ePBL_column_diags) :: eCD ! A container for passing around diagnostics.
456
457		! The following variables are used for diagnostics
458		real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1) :: &
459	24	diag_Velocity_Scale, & ! The velocity scale used in getting Kd [Z T-1 ~> m s-1]
460	24	diag_Mixing_Length, & ! The length scale used in getting Kd [Z ~> m]
461	24	Kd_BBL_3d, & ! The bottom boundary layer diffusivities [H Z T-1 ~> m2 s-1 or kg m-1 s-1]
462	24	BBL_Vel_Scale, & ! The velocity scale used in getting the BBL part of Kd [Z T-1 ~> m s-1]
463	24	BBL_Mix_Length ! The length scale used in getting the BBL part of Kd [Z ~> m]
464		real, dimension(SZI_(G),SZJ_(G)) :: &
465		! The next 7 diagnostics are terms in the mixed layer TKE budget, all in [R Z3 T-3 ~> W m-2].
466	24	diag_TKE_wind, & ! The wind source of TKE [R Z3 T-3 ~> W m-2]
467	24	diag_TKE_MKE, & ! The resolved KE source of TKE [R Z3 T-3 ~> W m-2]
468	24	diag_TKE_conv, & ! The convective source of TKE [R Z3 T-3 ~> W m-2]
469	24	diag_TKE_forcing, & ! The TKE sink required to mix surface penetrating shortwave heating [R Z3 T-3 ~> W m-2]
470	24	diag_TKE_mech_decay, & ! The decay of mechanical TKE [R Z3 T-3 ~> W m-2]
471	24	diag_TKE_conv_decay, & ! The decay of convective TKE [R Z3 T-3 ~> W m-2]
472	24	diag_TKE_mixing, & ! The work done by TKE to deepen the mixed layer [R Z3 T-3 ~> W m-2]
473	24	diag_TKE_BBL, & ! The source of TKE to the bottom boundary layer [R Z3 T-3 ~> W m-2].
474	24	diag_TKE_BBL_mixing, & ! The work done by TKE to thicken the bottom boundary layer [R Z3 T-3 ~> W m-2].
475	24	diag_TKE_BBL_decay, & ! The work lost to decy of mechanical TKE in the bottom boundary
476		! layer [R Z3 T-3 ~> W m-2].
477	24	diag_ustar_BBL, & ! The bottom boundary layer friction velocity [H T-1 ~> m s-1 or kg m-2 s-1]
478	24	diag_BBL_decay_scale, & ! The bottom boundary layer TKE decay length scale [H ~> m]
479	24	diag_mstar_sfc, & ! mstar used in EPBL [nondim]
480	24	diag_mstar_BBL, & ! mstar used in EPBL BBL [nondim]
481	24	diag_mstar_LT, & ! mstar due to Langmuir turbulence [nondim]
482	24	diag_LA, & ! Langmuir number [nondim]
483	24	diag_LA_mod, & ! Modified Langmuir number [nondim]
484	24	diag_ustar ! The surface boundary layer friction velocity [Z T-1 ~> m s-1]
485
486		! The following variables are only used for diagnosing sensitivities to ePBL settings
487		real, dimension(SZK_(GV)+1) :: &
488	24	Kd_1, Kd_2 ! Diapycnal diffusivities found with different ePBL options [H Z T-1 ~> m2 s-1 or kg m-1 s-1]
489	24	real :: diff_Kd(SZI_(G),SZJ_(G),SZK_(GV)+1) ! The change in diapycnal diffusivities found with different
490		! ePBL options [H Z T-1 ~> m2 s-1 or kg m-1 s-1]
491	24	real :: max_abs_diff_Kd(SZI_(G),SZJ_(G)) ! The column maximum magnitude of the change in diapycnal
492		! diffusivities found with different ePBL options [H Z T-1 ~> m2 s-1 or kg m-1 s-1]
493	24	real :: diff_hML_depth(SZI_(G),SZJ_(G)) ! The change in diagnosed active mixing layer depth with
494		! different ePBL options [Z ~> m]
495		real :: BLD_1, BLD_2 ! Surface or bottom boundary layer depths found with different ePBL_column options [Z ~> m]
496		real :: SpV_scale1 ! A factor that accounts for the varying scaling of SpV_dt with answer date
497		! [nondim] or [T3 m3 Z-3 s-3 ~> 1]
498		real :: SpV_scale2 ! A factor that accounts for the varying scaling of SpV_dt with answer date
499		! [nondim] or [Z3 s3 T-3 m-3 ~> 1]
500	24	real :: SpV_dt_tmp(SZK_(GV)+1) ! Specific volume interpolated to interfaces divided by dt or 1.0 / (dt * Rho0)
501		! times conversion factors for answer dates before 20240101 in
502		! [m3 Z-3 R-1 T2 s-3 ~> m3 kg-1 s-1] or without the conversion factors for
503		! answer dates of 20240101 and later in [R-1 T-1 ~> m3 kg-1 s-1], used to
504		! convert local TKE into a turbulence velocity cubed.
505		type(ePBL_column_diags) :: eCD_tmp ! A container for not passing around diagnostics.
506	12	type(energetic_PBL_CS) :: CS_tmp1, CS_tmp2 ! Copies of the energetic PBL control structure that
507		! can be modified to test for sensitivities
508		logical :: BBL_mixing ! If true, there is bottom boundary layer mixing.
509		integer :: i, j, k, is, ie, js, je, nz
510
511	12	is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke
512
513	12	if (.not. CS%initialized) call MOM_error(FATAL, "energetic_PBL: "//&
514	0	"Module must be initialized before it is used.")
515	12	if (.not. associated(tv%eqn_of_state)) call MOM_error(FATAL, &
516		"energetic_PBL: Temperature, salinity and an equation of state "//&
517	0	"must now be used.")
518	12	if (.not.(associated(fluxes%ustar) .or. associated(fluxes%tau_mag))) call MOM_error(FATAL, &
519	0	"energetic_PBL: No surface friction velocity (ustar or tau_mag) defined in fluxes type.")
520	12	if ((.not.GV%Boussinesq) .and. (.not.associated(fluxes%tau_mag))) call MOM_error(FATAL, &
521	0	"energetic_PBL: No surface wind stress magnitude defined in fluxes type in non-Boussinesq mode.")
522	12	if (CS%use_LT .and. .not.associated(Waves)) call MOM_error(FATAL, &
523		"energetic_PBL: The Waves control structure must be associated if CS%use_LT "//&
524	0	"(i.e., USE_LA_LI2016 or EPBL_LT) is True.")
525
526
527	12	h_neglect = GV%H_subroundoff
528	12	I_rho = GV%H_to_Z * GV%RZ_to_H ! == 1.0 / GV%Rho0 ! This is not used when fully non-Boussinesq.
529	12	I_dt = 0.0 ; if (dt > 0.0) I_dt = 1.0 / dt
530	12	I_rho0dt = 1.0 / (GV%Rho0 * dt) ! This is not used when fully non-Boussinesq.
531	12	BBL_mixing = ((CS%ePBL_BBL_effic > 0.0) .or. (CS%ePBL_tidal_effic > 0.0) .or. CS%ePBL_BBL_use_mstar)
532
533		! Zero out diagnostics before accumulation.
534	12	if (CS%TKE_diagnostics) then
535		!!OMP parallel do default(shared)
536	0	do j=js,je ; do i=is,ie
537	0	diag_TKE_wind(i,j) = 0.0 ; diag_TKE_MKE(i,j) = 0.0
538	0	diag_TKE_conv(i,j) = 0.0 ; diag_TKE_forcing(i,j) = 0.0
539	0	diag_TKE_mixing(i,j) = 0.0 ; diag_TKE_mech_decay(i,j) = 0.0
540	0	diag_TKE_conv_decay(i,j) = 0.0 !; diag_TKE_unbalanced(i,j) = 0.0
541		enddo ; enddo
542	0	if (BBL_mixing) then
543		!!OMP parallel do default(shared)
544	0	do j=js,je ; do i=is,ie
545	0	diag_TKE_BBL(i,j) = 0.0 ; diag_TKE_BBL_mixing(i,j) = 0.0
546	0	diag_TKE_BBL_decay(i,j) = 0.0
547		enddo ; enddo
548		endif
549		endif
550	12	if (CS%debug .or. (CS%id_Mixing_Length>0)) diag_Mixing_Length(:,:,:) = 0.0
551	12	if (CS%debug .or. (CS%id_Velocity_Scale>0)) diag_Velocity_Scale(:,:,:) = 0.0
552	12	if (BBL_mixing) then
553	0	if (CS%debug .or. (CS%id_BBL_Mix_Length>0)) BBL_Mix_Length(:,:,:) = 0.0
554	0	if (CS%debug .or. (CS%id_BBL_Vel_Scale>0)) BBL_Vel_Scale(:,:,:) = 0.0
555	0	if (CS%id_Kd_BBL > 0) Kd_BBL_3d(:,:,:) = 0.0
556	0	if (CS%id_ustar_BBL > 0) diag_ustar_BBL(:,:) = 0.0
557	0	if (CS%id_BBL_decay_scale > 0) diag_BBL_decay_scale(:,:) = 0.0
558		endif
559
560		! CS_tmp is used to test sensitivity to parameter setting changes.
561	12	if (CS%options_diff > 0) then
562	0	CS_tmp1 = CS ; CS_tmp2 = CS
563	0	SpV_scale1 = 1.0 ; SpV_scale2 = 1.0
564
565	0	if (CS%options_diff == 1) then
566	0	CS_tmp1%orig_PE_calc = .true. ; CS_tmp2%orig_PE_calc = .false.
567	0	elseif (CS%options_diff == 2) then
568	0	CS_tmp1%answer_date = 20181231 ; CS_tmp2%answer_date = 20240101
569	0	elseif (CS%options_diff == 3) then
570	0	CS_tmp1%direct_calc = .true. ; CS_tmp2%direct_calc = .false.
571	0	CS_tmp1%MKE_to_TKE_effic = 0.0 ; CS_tmp2%MKE_to_TKE_effic = 0.0
572	0	CS_tmp1%orig_PE_calc = .false. ; CS_tmp2%orig_PE_calc = .false.
573	0	elseif (CS%options_diff == 4) then
574	0	CS_tmp1%direct_calc = .true. ; CS_tmp2%direct_calc = .false.
575	0	CS_tmp1%MKE_to_TKE_effic = 0.0 ; CS_tmp2%MKE_to_TKE_effic = 0.0
576	0	CS_tmp1%ePBL_BBL_effic = 0.2 ; CS_tmp2%ePBL_BBL_effic = 0.2
577	0	elseif (CS%options_diff == 5) then
578	0	CS_tmp1%decay_adjusted_BBL_TKE = .true. ; CS_tmp2%decay_adjusted_BBL_TKE = .false.
579	0	CS_tmp1%MKE_to_TKE_effic = 0.0 ; CS_tmp2%MKE_to_TKE_effic = 0.0
580	0	CS_tmp1%ePBL_BBL_effic = 0.2 ; CS_tmp2%ePBL_BBL_effic = 0.2
581		endif
582		! This logic is needed because the scaling of SpV_dt changes with answer date.
583	0	if (CS_tmp1%answer_date < 20240101) SpV_scale1 = US%m_to_Z*3 US%T_to_s**3
584	0	if (CS_tmp2%answer_date < 20240101) SpV_scale2 = US%m_to_Z*3 US%T_to_s**3
585	0	if (CS%id_opt_diff_Kd_ePBL > 0) diff_Kd(:,:,:) = 0.0
586	0	if (CS%id_opt_maxdiff_Kd_ePBL > 0) max_abs_diff_Kd(:,:) = 0.0
587	0	if (CS%id_opt_diff_hML_depth > 0) diff_hML_depth(:,:) = 0.0
588		endif
589
590		!!OMP parallel do default(private) shared(js,je,nz,is,ie,h_3d,u_3d,v_3d,tv,dt,I_dt,BBL_mixing, &
591		!!OMP CS,G,GV,US,fluxes,TKE_forced,dSV_dT,dSV_dS,Kd_int)
592	732	do j=js,je
593		! Copy the thicknesses and other fields to 2-d arrays.
594	6534720	do k=1,nz ; do i=is,ie
595	6480000	h_2d(i,k) = h_3d(i,j,k) ; u_2d(i,k) = u_3d(i,j,k) ; v_2d(i,k) = v_3d(i,j,k)
596	6480000	T_2d(i,k) = tv%T(i,j,k) ; S_2d(i,k) = tv%S(i,j,k)
597	6480000	TKE_forced_2d(i,k) = TKE_forced(i,j,k)
598	6534000	dSV_dT_2d(i,k) = dSV_dT(i,j,k) ; dSV_dS_2d(i,k) = dSV_dS(i,j,k)
599		enddo ; enddo
600	720	call thickness_to_dz(h_3d, tv, dz_2d, j, G, GV)
601
602		! Set the inverse density used to translating local TKE into a turbulence velocity
603	55440	SpV_dt(:) = 0.0
604	720	if ((dt > 0.0) .and. GV%Boussinesq .or. .not.allocated(tv%SpV_avg)) then
605	720	if (CS%answer_date < 20240101) then
606	0	do K=1,nz+1
607	0	SpV_dt(K) = 1.0 / (dt*GV%Rho0)
608		enddo
609		else
610	55440	do K=1,nz+1
611	55440	SpV_dt(K) = I_rho0dt
612		enddo
613		endif
614		endif
615
616		! Determine the initial mech_TKE and conv_PErel, including the energy required
617		! to mix surface heating through the topmost cell, the energy released by mixing
618		! surface cooling & brine rejection down through the topmost cell, and
619		! homogenizing the shortwave heating within that cell. This sets the energy
620		! and ustar and wstar available to drive mixing at the first interior
621		! interface.
622	87120	do i=is,ie ; if (G%mask2dT(i,j) > 0.0) then
623
624		! Copy the thicknesses and other fields to 1-d arrays.
625	4572768	do k=1,nz
626	4512600	h(k) = h_2d(i,k) + GV%H_subroundoff ; dz(k) = dz_2d(i,k) + GV%dZ_subroundoff
627	4512600	u(k) = u_2d(i,k) ; v(k) = v_2d(i,k)
628	4512600	T0(k) = T_2d(i,k) ; S0(k) = S_2d(i,k) ; TKE_forcing(k) = TKE_forced_2d(i,k)
629	4572768	dSV_dT_1d(k) = dSV_dT_2d(i,k) ; dSV_dS_1d(k) = dSV_dS_2d(i,k)
630		enddo
631	4632936	do K=1,nz+1 ; Kd(K) = 0.0 ; enddo
632
633		! Make local copies of surface forcing and process them.
634	60168	if (associated(fluxes%ustar) .and. (GV%Boussinesq .or. .not.associated(fluxes%tau_mag))) then
635	60168	u_star = fluxes%ustar(i,j)
636	60168	u_star_Mean = fluxes%ustar_gustless(i,j)
637	60168	mech_TKE = dt * GV%Rho0 * u_star**3
638	0	elseif (allocated(tv%SpV_avg)) then
639	0	u_star = sqrt(fluxes%tau_mag(i,j) * tv%SpV_avg(i,j,1))
640	0	u_star_Mean = sqrt(fluxes%tau_mag_gustless(i,j) * tv%SpV_avg(i,j,1))
641	0	mech_TKE = dt * u_star * fluxes%tau_mag(i,j)
642		else
643	0	u_star = sqrt(fluxes%tau_mag(i,j) * I_rho)
644	0	u_star_Mean = sqrt(fluxes%tau_mag_gustless(i,j) * I_rho)
645	0	mech_TKE = dt * GV%Rho0 * u_star**3
646		! The line above is equivalent to: mech_TKE = dt * u_star * fluxes%tau_mag(i,j)
647		endif
648	60168	diag_ustar(i,j) = u_star
649
650	60168	if (allocated(tv%SpV_avg) .and. .not.GV%Boussinesq) then
651	0	SpV_dt(1) = tv%SpV_avg(i,j,1) * I_dt
652	0	do K=2,nz
653	0	SpV_dt(K) = 0.5(tv%SpV_avg(i,j,k-1) + tv%SpV_avg(i,j,k)) I_dt
654		enddo
655	0	SpV_dt(nz+1) = tv%SpV_avg(i,j,nz) * I_dt
656		endif
657
658	60168	B_flux = buoy_flux(i,j)
659	60168	if (associated(fluxes%ustar_shelf) .and. associated(fluxes%frac_shelf_h)) then
660	0	if (fluxes%frac_shelf_h(i,j) > 0.0) &
661		u_star = (1.0 - fluxes%frac_shelf_h(i,j)) * u_star + &
662	0	fluxes%frac_shelf_h(i,j) * fluxes%ustar_shelf(i,j)
663		endif
664	60168	if (u_star < CS%ustar_min) u_star = CS%ustar_min
665	60168	if (CS%omega_frac >= 1.0) then
666	0	absf = 2.0*CS%omega
667		else
668		absf = 0.25*((abs(G%CoriolisBu(I,J)) + abs(G%CoriolisBu(I-1,J-1))) + &
669	60168	(abs(G%CoriolisBu(I,J-1)) + abs(G%CoriolisBu(I-1,J))))
670	60168	if (CS%omega_frac > 0.0) &
671	60168	absf = sqrt(CS%omega_frac4.0CS%omega*2 + (1.0-CS%omega_frac)absf**2)
672		endif
673
674		! Perhaps provide a first guess for MLD based on a stored previous value.
675	60168	MLD_io = -1.0
676	60168	if (CS%MLD_iteration_guess .and. (CS%ML_depth(i,j) > 0.0)) MLD_io = CS%ML_depth(i,j)
677	60168	BBLD_io = 0.0
678
679		! Store the initial guesses at the boundary layer depths for testing sensitivities.
680	60168	MLD_in = MLD_io
681
682	60168	if (CS%answer_date < 20240101) then
683	0	do K=1,nz+1 ; SpV_dt_cf(K) = (US%Z_to_m*3US%s_to_T*3) SpV_dt(K) ; enddo
684		else
685	4632936	do K=1,nz+1 ; SpV_dt_cf(K) = SpV_dt(K) ; enddo
686		endif
687	60168	if (stoch_CS%pert_epbl) then ! stochastics are active
688		call ePBL_column(h, dz, u, v, T0, S0, dSV_dT_1d, dSV_dS_1d, SpV_dt_cf, TKE_forcing, B_flux, absf, &
689		u_star, u_star_mean, mech_TKE, dt, MLD_io, Kd, mixvel, mixlen, GV, &
690		US, CS, eCD, Waves, G, i, j, &
691	0	TKE_gen_stoch=stoch_CS%epbl1_wts(i,j), TKE_diss_stoch=stoch_CS%epbl2_wts(i,j))
692		else
693		call ePBL_column(h, dz, u, v, T0, S0, dSV_dT_1d, dSV_dS_1d, SpV_dt_cf, TKE_forcing, B_flux, absf, &
694		u_star, u_star_mean, mech_TKE, dt, MLD_io, Kd, mixvel, mixlen, GV, &
695	60168	US, CS, eCD, Waves, G, i, j)
696		endif
697	60168	if (CS%id_Kd_ePBL_col_by_col > 0) &
698	0	call post_data_3d_by_column(CS%id_Kd_ePBL_col_by_col, Kd, CS%diag, i, j)
699
700		! Add the diffusivity due to bottom boundary layer mixing, if there is energy to drive this mixing.
701	60168	if (BBL_mixing) then
702	0	if (CS%MLD_iteration_guess .and. (CS%BBL_depth(i,j) > 0.0)) BBLD_io = CS%BBL_depth(i,j)
703	0	BBLD_in = BBLD_io
704	0	u_star_BBL = max(visc%ustar_BBL(i,j), CS%ustar_min*GV%Z_to_H) ! units are H T-1
705	0	if (GV%Boussinesq) then
706	0	u_star_BBL_z_t = u_star_BBL*GV%H_to_Z
707		else
708	0	u_star_BBL_z_t = u_star_BBLGV%H_to_RZtv%SpV_avg(i,j,1)
709		endif
710
711	0	if (CS%ePBL_BBL_use_mstar) then
712	0	BBL_TKE = dt * ((u_star_BBLGV%H_to_RZ) u_star_BBL_z_t**2)
713		else
714	0	if (CS%BBL_effic_bug) then
715	0	BBL_TKE = CS%ePBL_BBL_effic * GV%H_to_RZ * dt * visc%BBL_meanKE_loss_sqrtCd(i,j)
716		else
717	0	BBL_TKE = CS%ePBL_BBL_effic * GV%H_to_RZ * dt * visc%BBL_meanKE_loss(i,j)
718		endif
719		! Add in tidal dissipation energy at the bottom, noting that fluxes%BBL_tidal_dis is
720		! in [R Z L2 T-3 ~> W m-2], unlike visc%BBL_meanKE_loss.
721	0	if ((CS%ePBL_tidal_effic > 0.0) .and. associated(fluxes%BBL_tidal_dis)) &
722	0	BBL_TKE = BBL_TKE + CS%ePBL_tidal_effic * dt * fluxes%BBL_tidal_dis(i,j)
723		endif
724
725		call ePBL_BBL_column(h, dz, u, v, T0, S0, dSV_dT_1d, dSV_dS_1d, SpV_dt, absf, dt, Kd, BBL_TKE, &
726		u_star_BBL, u_star_BBL_z_t, BBL_buoy_flux(i,j), Kd_BBL, BBLD_io, mixvel_BBL, mixlen_BBL, &
727	0	GV, US, CS, eCD)
728
729	0	do K=1,nz+1 ; Kd(K) = Kd(K) + Kd_BBL(K) ; enddo
730	0	if (CS%id_Kd_BBL > 0) then ; do K=1,nz+1
731	0	Kd_BBL_3d(i,j,K) = Kd_BBL(K)
732		enddo ; endif
733	0	if (CS%id_ustar_BBL > 0) diag_ustar_BBL(i,j) = u_star_BBL
734	0	if ((CS%id_BBL_decay_scale > 0) .and. (CS%TKE_decay * absf > 0)) &
735	0	diag_BBL_decay_scale(i,j) = u_star_BBL / (CS%TKE_decay * absf)
736		endif
737
738		! Copy the diffusivities to a 2-d array.
739	4632936	do K=1,nz+1
740	4632936	Kd_2d(i,K) = Kd(K)
741		enddo
742	60168	CS%ML_depth(i,j) = MLD_io
743	60168	CS%BBL_depth(i,j) = BBLD_io
744
745	60168	if (CS%TKE_diagnostics) then
746	0	diag_TKE_MKE(i,j) = diag_TKE_MKE(i,j) + eCD%dTKE_MKE
747	0	diag_TKE_conv(i,j) = diag_TKE_conv(i,j) + eCD%dTKE_conv
748	0	diag_TKE_forcing(i,j) = diag_TKE_forcing(i,j) + eCD%dTKE_forcing
749	0	diag_TKE_wind(i,j) = diag_TKE_wind(i,j) + eCD%dTKE_wind
750	0	diag_TKE_mixing(i,j) = diag_TKE_mixing(i,j) + eCD%dTKE_mixing
751	0	diag_TKE_mech_decay(i,j) = diag_TKE_mech_decay(i,j) + eCD%dTKE_mech_decay
752	0	diag_TKE_conv_decay(i,j) = diag_TKE_conv_decay(i,j) + eCD%dTKE_conv_decay
753		! diag_TKE_unbalanced(i,j) = diag_TKE_unbalanced(i,j) + eCD%dTKE_unbalanced
754		endif
755		! Write mixing length and velocity scale to 3-D arrays for diagnostic output
756	60168	if (CS%debug .or. (CS%id_Mixing_Length > 0)) then ; do K=1,nz+1
757	0	diag_Mixing_Length(i,j,K) = mixlen(K)
758		enddo ; endif
759	60168	if (CS%debug .or. (CS%id_Velocity_Scale > 0)) then ; do K=1,nz+1
760	0	diag_Velocity_Scale(i,j,K) = mixvel(K)
761		enddo ; endif
762	60168	if (BBL_mixing) then
763	0	if (CS%debug .or. (CS%id_BBL_Mix_Length>0)) then ; do k=1,nz
764	0	BBL_Mix_Length(i,j,k) = mixlen_BBL(k)
765		enddo ; endif
766	0	if (CS%debug .or. (CS%id_BBL_Vel_Scale>0)) then ; do k=1,nz
767	0	BBL_Vel_Scale(i,j,k) = mixvel_BBL(k)
768		enddo ; endif
769	0	if (CS%id_TKE_BBL>0) &
770	0	diag_TKE_BBL(i,j) = diag_TKE_BBL(i,j) + BBL_TKE
771		endif
772	60168	if (CS%id_mstar_sfc > 0) diag_mstar_sfc(i,j) = eCD%mstar
773	60168	if (CS%id_mstar_bbl > 0) diag_mstar_BBL(i,j) = eCD%mstar_BBL
774	60168	if (CS%id_mstar_LT > 0) diag_mstar_lt(i,j) = eCD%mstar_LT
775	60168	if (CS%id_LA > 0) diag_LA(i,j) = eCD%LA
776	60168	if (CS%id_LA_mod > 0) diag_LA_mod(i,j) = eCD%LAmod
777	60168	if (report_avg_its) then
778	0	CS%sum_its(1) = CS%sum_its(1) + real_to_EFP(real(eCD%OBL_its))
779	0	CS%sum_its(2) = CS%sum_its(2) + real_to_EFP(1.0)
780	0	if (BBL_mixing) then
781	0	CS%sum_its_BBL(1) = CS%sum_its_BBL(1) + real_to_EFP(real(eCD%BBL_its))
782	0	CS%sum_its_BBL(2) = CS%sum_its_BBL(2) + real_to_EFP(1.0)
783		endif
784		endif
785
786	60168	if (CS%options_diff > 0) then
787		! Call ePBL_column of ePBL_BBL_column with different parameter settings to diagnose sensitivities.
788		! These do not change the model state, and are only used for diagnostic purposes.
789	0	if (CS%options_diff < 4) then
790	0	BLD_1 = MLD_in ; BLD_2 = MLD_in
791	0	do K=1,nz+1 ; SpV_dt_tmp(K) = SpV_scale1 * SpV_dt(K) ; enddo
792		call ePBL_column(h, dz, u, v, T0, S0, dSV_dT_1d, dSV_dS_1d, SpV_dt_tmp, TKE_forcing, &
793		B_flux, absf, u_star, u_star_mean, mech_TKE, dt, BLD_1, Kd_1, &
794	0	mixvel, mixlen, GV, US, CS_tmp1, eCD_tmp, Waves, G, i, j)
795	0	do K=1,nz+1 ; SpV_dt_tmp(K) = SpV_scale2 * SpV_dt(K) ; enddo
796		call ePBL_column(h, dz, u, v, T0, S0, dSV_dT_1d, dSV_dS_1d, SpV_dt_tmp, TKE_forcing, &
797		B_flux, absf, u_star, u_star_mean, mech_TKE, dt, BLD_2, Kd_2, &
798	0	mixvel, mixlen, GV, US, CS_tmp2, eCD_tmp, Waves, G, i, j)
799		else
800	0	BLD_1 = BBLD_in ; BLD_2 = BBLD_in
801	0	BBL_TKE = CS%ePBL_BBL_effic * GV%H_to_RZ * dt * visc%BBL_meanKE_loss(i,j)
802	0	if ((CS%ePBL_tidal_effic > 0.0) .and. associated(fluxes%BBL_tidal_dis)) &
803	0	BBL_TKE = BBL_TKE + CS%ePBL_tidal_effic * dt * fluxes%BBL_tidal_dis(i,j)
804	0	u_star_BBL = max(visc%ustar_BBL(i,j), CS%ustar_min*GV%Z_to_H)
805	0	u_star_BBL_z_t = u_star_bbl*GV%H_to_Z
806		call ePBL_BBL_column(h, dz, u, v, T0, S0, dSV_dT_1d, dSV_dS_1d, SpV_dt, absf, dt, Kd, BBL_TKE, &
807		u_star_BBL, u_star_BBL_z_t, BBL_buoy_flux(i,j), Kd_1, BLD_1, mixvel_BBL, mixlen_BBL, &
808	0	GV, US, CS_tmp1, eCD_tmp)
809		call ePBL_BBL_column(h, dz, u, v, T0, S0, dSV_dT_1d, dSV_dS_1d, SpV_dt, absf, dt, Kd, BBL_TKE, &
810		u_star_BBL, u_star_BBL_z_t, BBL_buoy_flux(i,j), Kd_2, BLD_2, mixvel_BBL, mixlen_BBL, &
811	0	GV, US, CS_tmp2, eCD_tmp)
812		endif
813
814	0	if (CS%id_opt_diff_Kd_ePBL > 0) then
815	0	do K=1,nz+1 ; diff_Kd(i,j,K) = Kd_1(K) - Kd_2(K) ; enddo
816		endif
817	0	if (CS%id_opt_maxdiff_Kd_ePBL > 0) then
818	0	max_abs_diff_Kd(i,j) = 0.0
819	0	do K=1,nz+1 ; max_abs_diff_Kd(i,j) = max(max_abs_diff_Kd(i,j), abs(Kd_1(K) - Kd_2(K))) ; enddo
820		endif
821	0	if (CS%id_opt_diff_hML_depth > 0) diff_hML_depth(i,j) = BLD_1 - BLD_2
822		endif
823
824		else ! End of the ocean-point part of the i-loop
825		! For masked points, Kd_int must still be set (to 0) because it has intent out.
826	2019864	do K=1,nz+1 ; Kd_2d(i,K) = 0. ; enddo
827	26232	CS%ML_depth(i,j) = 0.0
828	26232	CS%BBL_depth(i,j) = 0.0
829		endif ; enddo ! Close of i-loop - Note the unusual loop order, with k-loops inside i-loops.
830
831	6621852	do K=1,nz+1 ; do i=is,ie ; Kd_int(i,j,K) = Kd_2d(i,K) ; enddo ; enddo
832
833		enddo ! j-loop
834	12	if (CS%id_Kd_ePBL_col_by_col > 0) call post_data_3d_final(CS%id_Kd_ePBL_col_by_col, CS%diag)
835
836	12	if (CS%debug .and. BBL_mixing) then
837		call hchksum(visc%BBL_meanKE_loss, "ePBL visc%BBL_meanKE_loss", G%HI, &
838	0	unscale=GV%H_to_MKSUS%L_T_to_m_s2US%s_to_T)
839	0	call hchksum(visc%ustar_BBL, "ePBL visc%ustar_BBL", G%HI, unscale=GV%H_to_MKS*US%s_to_T)
840	0	call hchksum(Kd_int, "End of ePBL Kd_int", G%HI, unscale=GV%H_to_MKSUS%Z_to_mUS%s_to_T)
841	0	call hchksum(diag_Velocity_Scale, "ePBL Velocity_Scale", G%HI, unscale=US%Z_to_m*US%s_to_T)
842	0	call hchksum(diag_Mixing_Length, "ePBL Mixing_Length", G%HI, unscale=US%Z_to_m)
843	0	call hchksum(BBL_Vel_Scale, "ePBL BBL_Vel_Scale", G%HI, unscale=US%Z_to_m*US%s_to_T)
844	0	call hchksum(BBL_Mix_Length, "ePBL BBL_Mix_Length", G%HI, unscale=US%Z_to_m)
845		endif
846
847	12	if (CS%id_ML_depth > 0) call post_data(CS%id_ML_depth, CS%ML_depth, CS%diag)
848	12	if (CS%id_ustar_ePBL > 0) call post_data(CS%id_ustar_ePBL, diag_ustar, CS%diag)
849	12	if (CS%id_bflx_ePBL > 0) call post_data(CS%id_bflx_ePBL, buoy_flux, CS%diag)
850	12	if (CS%id_hML_depth > 0) call post_data(CS%id_hML_depth, CS%ML_depth, CS%diag)
851	12	if (CS%id_TKE_wind > 0) call post_data(CS%id_TKE_wind, diag_TKE_wind, CS%diag)
852	12	if (CS%id_TKE_MKE > 0) call post_data(CS%id_TKE_MKE, diag_TKE_MKE, CS%diag)
853	12	if (CS%id_TKE_conv > 0) call post_data(CS%id_TKE_conv, diag_TKE_conv, CS%diag)
854	12	if (CS%id_TKE_forcing > 0) call post_data(CS%id_TKE_forcing, diag_TKE_forcing, CS%diag)
855	12	if (CS%id_TKE_mixing > 0) call post_data(CS%id_TKE_mixing, diag_TKE_mixing, CS%diag)
856	12	if (CS%id_TKE_mech_decay > 0) &
857	0	call post_data(CS%id_TKE_mech_decay, diag_TKE_mech_decay, CS%diag)
858	12	if (CS%id_TKE_conv_decay > 0) &
859	0	call post_data(CS%id_TKE_conv_decay, diag_TKE_conv_decay, CS%diag)
860	12	if (CS%id_Mixing_Length > 0) call post_data(CS%id_Mixing_Length, diag_Mixing_Length, CS%diag)
861	12	if (CS%id_Velocity_Scale >0) call post_data(CS%id_Velocity_Scale, diag_Velocity_Scale, CS%diag)
862	12	if (CS%id_mstar_sfc > 0) call post_data(CS%id_mstar_sfc, diag_mstar_sfc, CS%diag)
863	12	if (BBL_mixing) then
864	0	if (CS%id_Kd_BBL > 0) call post_data(CS%id_Kd_BBL, Kd_BBL_3d, CS%diag)
865	0	if (CS%id_BBL_Mix_Length > 0) call post_data(CS%id_BBL_Mix_Length, BBL_Mix_Length, CS%diag)
866	0	if (CS%id_BBL_Vel_Scale > 0) call post_data(CS%id_BBL_Vel_Scale, BBL_Vel_Scale, CS%diag)
867	0	if (CS%id_ustar_BBL > 0) call post_data(CS%id_ustar_BBL, diag_ustar_BBL, CS%diag)
868	0	if (CS%id_BBL_decay_scale > 0) call post_data(CS%id_BBL_decay_scale, diag_BBL_decay_scale, CS%diag)
869	0	if (CS%id_TKE_BBL > 0) call post_data(CS%id_TKE_BBL, diag_TKE_BBL, CS%diag)
870	0	if (CS%id_TKE_BBL_mixing > 0) call post_data(CS%id_TKE_BBL_mixing, diag_TKE_BBL_mixing, CS%diag)
871	0	if (CS%id_TKE_BBL_decay > 0) call post_data(CS%id_TKE_BBL_decay, diag_TKE_BBL_decay, CS%diag)
872	0	if (CS%id_BBL_depth > 0) call post_data(CS%id_BBL_depth, CS%BBL_depth, CS%diag)
873	0	if (CS%id_mstar_BBL > 0) call post_data(CS%id_mstar_BBL, diag_mstar_BBL, CS%diag)
874		endif
875	12	if (CS%id_LA > 0) call post_data(CS%id_LA, diag_LA, CS%diag)
876	12	if (CS%id_LA_mod > 0) call post_data(CS%id_LA_mod, diag_LA_mod, CS%diag)
877	12	if (CS%id_mstar_LT > 0) call post_data(CS%id_mstar_LT, diag_mstar_LT, CS%diag)
878	12	if (stoch_CS%pert_epbl) then
879	0	if (stoch_CS%id_epbl1_wts > 0) call post_data(stoch_CS%id_epbl1_wts, stoch_CS%epbl1_wts, CS%diag)
880	0	if (stoch_CS%id_epbl2_wts > 0) call post_data(stoch_CS%id_epbl2_wts, stoch_CS%epbl2_wts, CS%diag)
881		endif
882
883	12	if (CS%options_diff > 0) then
884		! These diagnostics are only for determining sensitivities to different ePBL settings.
885	0	if (CS%id_opt_diff_Kd_ePBL > 0) call post_data(CS%id_opt_diff_Kd_ePBL, diff_Kd, CS%diag)
886	0	if (CS%id_opt_maxdiff_Kd_ePBL > 0) call post_data(CS%id_opt_maxdiff_Kd_ePBL, max_abs_diff_Kd, CS%diag)
887	0	if (CS%id_opt_diff_hML_depth > 0) call post_data(CS%id_opt_diff_hML_depth, diff_hML_depth, CS%diag)
888		endif
889
890	12	end subroutine energetic_PBL
891
892
893
894		!> This subroutine determines the diffusivities from the integrated energetics
895		!! mixed layer model for a single column of water.
896	60168	subroutine ePBL_column(h, dz, u, v, T0, S0, dSV_dT, dSV_dS, SpV_dt, TKE_forcing, B_flux, absf, &
897	60168	u_star, u_star_mean, mech_TKE_in, dt, MLD_io, Kd, mixvel, mixlen, GV, US, CS, eCD, &
898		Waves, G, i, j, TKE_gen_stoch, TKE_diss_stoch)
899		type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure.
900		type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type
901		real, dimension(SZK_(GV)), intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2].
902		real, dimension(SZK_(GV)), intent(in) :: dz !< The vertical distance across layers [Z ~> m].
903		real, dimension(SZK_(GV)), intent(in) :: u !< Zonal velocities interpolated to h points
904		!! [L T-1 ~> m s-1].
905		real, dimension(SZK_(GV)), intent(in) :: v !< Zonal velocities interpolated to h points
906		!! [L T-1 ~> m s-1].
907		real, dimension(SZK_(GV)), intent(in) :: T0 !< The initial layer temperatures [C ~> degC].
908		real, dimension(SZK_(GV)), intent(in) :: S0 !< The initial layer salinities [S ~> ppt].
909
910		real, dimension(SZK_(GV)), intent(in) :: dSV_dT !< The partial derivative of in-situ specific
911		!! volume with potential temperature
912		!! [R-1 C-1 ~> m3 kg-1 degC-1].
913		real, dimension(SZK_(GV)), intent(in) :: dSV_dS !< The partial derivative of in-situ specific
914		!! volume with salinity [R-1 S-1 ~> m3 kg-1 ppt-1].
915		real, dimension(SZK_(GV)+1), intent(in) :: SpV_dt !< Specific volume interpolated to interfaces
916		!! divided by dt or 1.0 / (dt * Rho0), times conversion
917		!! factors for answer dates before 20240101 in
918		!! [m3 Z-3 R-1 T2 s-3 ~> m3 kg-1 s-1] or without
919		!! the conversion factors for answer dates of
920		!! 20240101 and later in [R-1 T-1 ~> m3 kg-1 s-1],
921		!! used to convert local TKE into a turbulence
922		!! velocity cubed.
923		real, dimension(SZK_(GV)), intent(in) :: TKE_forcing !< The forcing requirements to homogenize the
924		!! forcing that has been applied to each layer
925		!! [R Z3 T-2 ~> J m-2].
926		real, intent(in) :: B_flux !< The surface buoyancy flux [Z2 T-3 ~> m2 s-3]
927		real, intent(in) :: absf !< The absolute value of the Coriolis parameter [T-1 ~> s-1].
928		real, intent(in) :: u_star !< The surface friction velocity [Z T-1 ~> m s-1].
929		real, intent(in) :: u_star_mean !< The surface friction velocity without any
930		!! contribution from unresolved gustiness [Z T-1 ~> m s-1].
931		real, intent(in) :: mech_TKE_in !< The mechanically generated turbulent
932		!! kinetic energy available for mixing over a time
933		!! step before the application of the efficiency
934		!! in mstar. [R Z3 T-2 ~> J m-2].
935		real, intent(inout) :: MLD_io !< A first guess at the mixed layer depth on input, and
936		!! the calculated mixed layer depth on output [Z ~> m]
937		real, intent(in) :: dt !< Time increment [T ~> s].
938		real, dimension(SZK_(GV)+1), &
939		intent(out) :: Kd !< The diagnosed diffusivities at interfaces
940		!! [H Z T-1 ~> m2 s-1 or kg m-1 s-1].
941		real, dimension(SZK_(GV)+1), &
942		intent(out) :: mixvel !< The mixing velocity scale used in Kd
943		!! [Z T-1 ~> m s-1].
944		real, dimension(SZK_(GV)+1), &
945		intent(out) :: mixlen !< The mixing length scale used in Kd [Z ~> m].
946		type(energetic_PBL_CS), intent(in) :: CS !< Energetic PBL control structure
947		type(ePBL_column_diags), intent(inout) :: eCD !< A container for passing around diagnostics.
948		type(wave_parameters_CS), pointer :: Waves !< Waves control structure for Langmuir turbulence
949		type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure.
950		integer, intent(in) :: i !< The i-index to work on (used for Waves)
951		integer, intent(in) :: j !< The j-index to work on (used for Waves)
952		real, optional, intent(in) :: TKE_gen_stoch !< random factor used to perturb TKE generation [nondim]
953		real, optional, intent(in) :: TKE_diss_stoch !< random factor used to perturb TKE dissipation [nondim]
954
955		! This subroutine determines the diffusivities in a single column from the integrated energetics
956		! planetary boundary layer (ePBL) model. It assumes that heating, cooling and freshwater fluxes
957		! have already been applied. All calculations are done implicitly, and there
958		! is no stability limit on the time step.
959		!
960		! For each interior interface, first discard the TKE to account for mixing
961		! of shortwave radiation through the next denser cell. Next drive mixing based
962		! on the local? values of ustar + wstar, subject to available energy. This
963		! step sets the value of Kd(K). Any remaining energy is then subject to decay
964		! before being handed off to the next interface. mech_TKE and conv_PErel are treated
965		! separately for the purposes of decay, but are used proportionately to drive
966		! mixing.
967
968		! Local variables
969		real, dimension(SZK_(GV)+1) :: &
970	120336	pres_Z, & ! Interface pressures with a rescaling factor to convert interface height
971		! movements into changes in column potential energy [R Z2 T-2 ~> kg m-1 s-2].
972	120336	hb_hs ! The distance from the bottom over the thickness of the
973		! water column [nondim].
974		real :: mech_TKE ! The mechanically generated turbulent kinetic energy
975		! available for mixing over a time step [R Z3 T-2 ~> J m-2].
976		real :: conv_PErel ! The potential energy that has been convectively released
977		! during this timestep [R Z3 T-2 ~> J m-2]. A portion nstar_FC
978		! of conv_PErel is available to drive mixing.
979		real :: htot ! The total thickness of the layers above an interface [H ~> m or kg m-2].
980		real :: dztot ! The total depth of the layers above an interface [Z ~> m].
981		real :: uhtot ! The depth integrated zonal velocities in the layers above [H L T-1 ~> m2 s-1 or kg m-1 s-1]
982		real :: vhtot ! The depth integrated meridional velocities in the layers above [H L T-1 ~> m2 s-1 or kg m-1 s-1]
983		real :: Idecay_len_TKE ! The inverse of a turbulence decay length scale [H-1 ~> m-1 or m2 kg-1].
984		real :: dz_sum ! The total thickness of the water column [Z ~> m].
985
986		real, dimension(SZK_(GV)) :: &
987	120336	dT_to_dColHt, & ! Partial derivative of the total column height with the temperature changes
988		! within a layer [Z C-1 ~> m degC-1].
989	120336	dS_to_dColHt, & ! Partial derivative of the total column height with the salinity changes
990		! within a layer [Z S-1 ~> m ppt-1].
991	120336	dT_to_dPE, & ! Partial derivatives of column potential energy with the temperature
992		! changes within a layer, in [R Z3 T-2 C-1 ~> J m-2 degC-1].
993	120336	dS_to_dPE, & ! Partial derivatives of column potential energy with the salinity changes
994		! within a layer, in [R Z3 T-2 S-1 ~> J m-2 ppt-1].
995	120336	dT_to_dColHt_a, & ! Partial derivative of the total column height with the temperature changes
996		! within a layer, including the implicit effects of mixing with layers higher
997		! in the water column [Z C-1 ~> m degC-1].
998	120336	dS_to_dColHt_a, & ! Partial derivative of the total column height with the salinity changes
999		! within a layer, including the implicit effects of mixing with layers higher
1000		! in the water column [Z S-1 ~> m ppt-1].
1001	120336	dT_to_dPE_a, & ! Partial derivatives of column potential energy with the temperature changes
1002		! within a layer, including the implicit effects of mixing with layers higher
1003		! in the water column [R Z3 T-2 C-1 ~> J m-2 degC-1].
1004	120336	dS_to_dPE_a, & ! Partial derivative of column potential energy with the salinity changes
1005		! within a layer, including the implicit effects of mixing with layers higher
1006		! in the water column [R Z3 T-2 S-1 ~> J m-2 ppt-1].
1007	120336	c1, & ! c1 is used by the tridiagonal solver [nondim].
1008	120336	Te, & ! Estimated final values of T in the column [C ~> degC].
1009	120336	Se, & ! Estimated final values of S in the column [S ~> ppt].
1010	120336	dTe, & ! Running (1-way) estimates of temperature change [C ~> degC].
1011	120336	dSe, & ! Running (1-way) estimates of salinity change [S ~> ppt].
1012	120336	hp_a, & ! An effective pivot thickness of the layer including the effects
1013		! of coupling with layers above [H ~> m or kg m-2]. This is the first term
1014		! in the denominator of b1 in a downward-oriented tridiagonal solver.
1015	120336	Th_a, & ! An effective temperature times a thickness in the layer above, including implicit
1016		! mixing effects with other yet higher layers [C H ~> degC m or degC kg m-2].
1017	120336	Sh_a, & ! An effective salinity times a thickness in the layer above, including implicit
1018		! mixing effects with other yet higher layers [S H ~> ppt m or ppt kg m-2].
1019	120336	Th_b, & ! An effective temperature times a thickness in the layer below, including implicit
1020		! mixing effects with other yet lower layers [C H ~> degC m or degC kg m-2].
1021	120336	Sh_b ! An effective salinity times a thickness in the layer below, including implicit
1022		! mixing effects with other yet lower layers [S H ~> ppt m or ppt kg m-2].
1023		real, dimension(SZK_(GV)+1) :: &
1024	120336	MixLen_shape, & ! A nondimensional shape factor for the mixing length that
1025		! gives it an appropriate asymptotic value at the bottom of
1026		! the boundary layer [nondim].
1027	120336	h_dz_int, & ! The ratio of the layer thicknesses over the vertical distances
1028		! across the layers surrounding an interface [H Z-1 ~> nondim or kg m-3]
1029	120336	Kddt_h ! The total diapycnal diffusivity at an interface times a timestep divided by the
1030		! average thicknesses around an interface [H ~> m or kg m-2].
1031		real :: b1 ! b1 is inverse of the pivot used by the tridiagonal solver [H-1 ~> m-1 or m2 kg-1].
1032		real :: h_neglect ! A thickness that is so small it is usually lost
1033		! in roundoff and can be neglected [H ~> m or kg m-2].
1034		real :: dz_neglect ! A vertical distance that is so small it is usually lost
1035		! in roundoff and can be neglected [Z ~> m].
1036		real :: dMass ! The mass per unit area within a layer [Z R ~> kg m-2].
1037		real :: dPres ! The hydrostatic pressure change across a layer [R Z2 T-2 ~> Pa] or
1038		! equivalently [R Z2 T-2 ~> J m-3].
1039		real :: dMKE_max ! The maximum amount of mean kinetic energy that could be
1040		! converted to turbulent kinetic energy if the velocity in
1041		! the layer below an interface were homogenized with all of
1042		! the water above the interface [R Z3 T-2 ~> J m-2].
1043		real :: MKE2_Hharm ! Twice the inverse of the harmonic mean of the thickness
1044		! of a layer and the thickness of the water above, used in
1045		! the MKE conversion equation [H-1 ~> m-1 or m2 kg-1].
1046
1047		real :: dt_h ! The timestep divided by the averages of the vertical distances around
1048		! a layer [T Z-1 ~> s m-1].
1049		real :: dz_bot ! The distance from the bottom [Z ~> m].
1050		real :: dz_rsum ! The running sum of dz from the top [Z ~> m].
1051		real :: I_dzsum ! The inverse of dz_sum [Z-1 ~> m-1].
1052		real :: I_MLD ! The inverse of the current value of MLD [Z-1 ~> m-1].
1053		real :: dz_tt ! The distance from the surface or up to the next interface
1054		! that did not exhibit turbulent mixing from this scheme plus
1055		! a surface mixing roughness length given by dz_tt_min [Z ~> m].
1056		real :: dz_tt_min ! A surface roughness length [Z ~> m].
1057
1058		real :: C1_3 ! = 1/3 [nondim]
1059		real :: vstar ! An in-situ turbulent velocity [Z T-1 ~> m s-1].
1060		real :: mstar_total ! The value of mstar used in ePBL [nondim]
1061		real :: mstar_LT ! An addition to mstar due to Langmuir turbulence [nondim] (output for diagnostic)
1062		real :: MLD_output ! The mixed layer depth output from this routine [Z ~> m]
1063		real :: LA ! The value of the Langmuir number [nondim]
1064		real :: LAmod ! The modified Langmuir number by convection [nondim]
1065		real :: hbs_here ! The local minimum of hb_hs and MixLen_shape [nondim]
1066		real :: nstar_FC ! The fraction of conv_PErel that can be converted to mixing [nondim].
1067		real :: TKE_reduc ! The fraction by which TKE and other energy fields are
1068		! reduced to support mixing [nondim]. between 0 and 1.
1069		real :: tot_TKE ! The total TKE available to support mixing at interface K [R Z3 T-2 ~> J m-2].
1070		real :: TKE_here ! The total TKE at this point in the algorithm [R Z3 T-2 ~> J m-2].
1071		real :: dT_km1_t2 ! A diffusivity-independent term related to the temperature
1072		! change in the layer above the interface [C ~> degC].
1073		real :: dS_km1_t2 ! A diffusivity-independent term related to the salinity
1074		! change in the layer above the interface [S ~> ppt].
1075		real :: dTe_term ! A diffusivity-independent term related to the temperature
1076		! change in the layer below the interface [C H ~> degC m or degC kg m-2].
1077		real :: dSe_term ! A diffusivity-independent term related to the salinity
1078		! change in the layer above the interface [S H ~> ppt m or ppt kg m-2].
1079		real :: dTe_t2 ! A part of dTe_term [C H ~> degC m or degC kg m-2].
1080		real :: dSe_t2 ! A part of dSe_term [S H ~> ppt m or ppt kg m-2].
1081		real :: dPE_conv ! The convective change in column potential energy [R Z3 T-2 ~> J m-2].
1082		real :: MKE_src ! The mean kinetic energy source of TKE due to Kddt_h(K) [R Z3 T-2 ~> J m-2].
1083		real :: dMKE_src_dK ! The partial derivative of MKE_src with Kddt_h(K) [R Z3 T-2 H-1 ~> J m-3 or J kg-1].
1084		real :: Kd_guess0 ! A first guess of the diapycnal diffusivity [H Z T-1 ~> m2 s-1 or kg m-1 s-1].
1085		real :: PE_chg_g0 ! The potential energy change when Kd is Kd_guess0 [R Z3 T-2 ~> J m-2]
1086		real :: Kddt_h_g0 ! The first guess of the change in diapycnal diffusivity times a timestep
1087		! divided by the average thicknesses around an interface [H ~> m or kg m-2].
1088		real :: PE_chg_max ! The maximum PE change for very large values of Kddt_h(K) [R Z3 T-2 ~> J m-2].
1089		real :: dPEc_dKd_Kd0 ! The partial derivative of PE change with Kddt_h(K)
1090		! for very small values of Kddt_h(K) [R Z3 T-2 H-1 ~> J m-3 or J kg-1].
1091		real :: PE_chg ! The change in potential energy due to mixing at an
1092		! interface [R Z3 T-2 ~> J m-2], positive for the column increasing
1093		! in potential energy (i.e., consuming TKE).
1094		real :: TKE_left ! The amount of turbulent kinetic energy left for the most
1095		! recent guess at Kddt_h(K) [R Z3 T-2 ~> J m-2].
1096		real :: dPEc_dKd ! The partial derivative of PE_chg with Kddt_h(K) [R Z3 T-2 H-1 ~> J m-3 or J kg-1].
1097		real :: TKE_left_min, TKE_left_max ! Maximum and minimum values of TKE_left [R Z3 T-2 ~> J m-2].
1098		real :: Kddt_h_max, Kddt_h_min ! Maximum and minimum values of Kddt_h(K) [H ~> m or kg m-2].
1099		real :: Kddt_h_guess ! A guess at the value of Kddt_h(K) [H ~> m or kg m-2].
1100		real :: Kddt_h_next ! The next guess at the value of Kddt_h(K) [H ~> m or kg m-2].
1101		real :: dKddt_h ! The change between guesses at Kddt_h(K) [H ~> m or kg m-2].
1102		real :: dKddt_h_Newt ! The change between guesses at Kddt_h(K) with Newton's method [H ~> m or kg m-2].
1103		real :: Kddt_h_newt ! The Newton's method next guess for Kddt_h(K) [H ~> m or kg m-2].
1104		real :: exp_kh ! The nondimensional decay of TKE across a layer [nondim].
1105		real :: vstar_unit_scale ! A unit conversion factor for turbulent velocities [Z T-1 s m-1 ~> 1]
1106		logical :: use_Newt ! Use Newton's method for the next guess at Kddt_h(K).
1107		logical :: convectively_stable ! If true the water column is convectively stable at this interface.
1108		logical :: sfc_connected ! If true the ocean is actively turbulent from the present
1109		! interface all the way up to the surface.
1110		logical :: sfc_disconnect ! If true, any turbulence has become disconnected
1111		! from the surface.
1112
1113		! The following is only used for diagnostics.
1114		real :: I_dtdiag ! = 1.0 / dt [T-1 ~> s-1].
1115
1116		!----------------------------------------------------------------------
1117		!/BGR added Aug24,2016 for adding iteration to get boundary layer depth
1118		! - needed to compute new mixing length.
1119		real :: MLD_guess, MLD_found ! Mixing Layer depth guessed/found for iteration [Z ~> m]
1120		real :: min_MLD, max_MLD ! Iteration bounds on MLD [Z ~> m], which are adjusted at each step
1121		! - These are initialized based on surface/bottom
1122		! 1. The iteration guesses a value (possibly from prev step or neighbor).
1123		! 2. The iteration checks if value is converged, too shallow, or too deep.
1124		! 3. Based on result adjusts the Max/Min and searches through the water column.
1125		! - If using an accurate guess the iteration is very quick (e.g. if MLD doesn't
1126		! change over timestep). Otherwise it takes 5-10 passes, but has a high
1127		! convergence rate. Other iteration may be tried, but this method seems to
1128		! fail very rarely and the added cost is likely not significant.
1129		! Additionally, when it fails to converge it does so in a reasonable
1130		! manner giving a usable guess. When it does fail, it is due to convection
1131		! within the boundary layer. Likely, a new method e.g. surface_disconnect,
1132		! can improve this.
1133		real :: dMLD_min ! The change in diagnosed mixed layer depth when the guess is min_MLD [Z ~> m]
1134		real :: dMLD_max ! The change in diagnosed mixed layer depth when the guess is max_MLD [Z ~> m]
1135		integer :: OBL_it ! Iteration counter
1136
1137		real :: TKE_used ! The TKE used to support mixing at an interface [R Z3 T-2 ~> J m-2].
1138		! real :: Kd_add ! The additional diffusivity at an interface [H Z T-1 ~> m2 s-1 or kg m-1 s-1]
1139		real :: frac_in_BL ! The fraction of the energy required to support dKd_max that is suppiled by
1140		! max_PE_chg, used here to determine a fractional layer contribution to the
1141		! boundary layer thickness [nondim]
1142		real :: Surface_Scale ! Surface decay scale for vstar [nondim]
1143		logical :: calc_Te ! If true calculate the expected final temperature and salinity values.
1144		logical :: no_MKE_conversion ! If true, there is no conversion from MKE to TKE, so a simpler solver can be used.
1145		logical :: debug ! This is used as a hard-coded value for debugging.
1146		logical :: convectively_unstable ! If true, there is convective instability at an interface.
1147
1148		! The following arrays are used only for debugging purposes.
1149		real :: dPE_debug ! An estimate of the potential energy change [R Z3 T-2 ~> J m-2]
1150		real :: mixing_debug ! An estimate of the rate of change of potential energy due to mixing [R Z3 T-3 ~> W m-2]
1151		real, dimension(20) :: TKE_left_itt ! The value of TKE_left after each iteration [R Z3 T-2 ~> J m-2]
1152		real, dimension(20) :: PE_chg_itt ! The value of PE_chg after each iteration [R Z3 T-2 ~> J m-2]
1153		real, dimension(20) :: Kddt_h_itt ! The value of Kddt_h_guess after each iteration [H ~> m or kg m-2]
1154		real, dimension(20) :: dPEa_dKd_itt ! The value of dPEc_dKd after each iteration [R Z3 T-2 H-1 ~> J m-3 or J kg-1]
1155		real, dimension(20) :: MKE_src_itt ! The value of MKE_src after each iteration [R Z3 T-2 ~> J m-2]
1156	120336	real, dimension(SZK_(GV)) :: mech_TKE_k ! The mechanically generated turbulent kinetic energy
1157		! available for mixing over a time step for each layer [R Z3 T-2 ~> J m-2].
1158	120336	real, dimension(SZK_(GV)) :: conv_PErel_k ! The potential energy that has been convectively released
1159		! during this timestep for each layer [R Z3 T-2 ~> J m-2].
1160	120336	real, dimension(SZK_(GV)) :: nstar_k ! The fraction of conv_PErel that can be converted to mixing
1161		! for each layer [nondim].
1162	120336	real, dimension(SZK_(GV)) :: dT_expect ! Expected temperature changes [C ~> degC]
1163	120336	real, dimension(SZK_(GV)) :: dS_expect ! Expected salinity changes [S ~> ppt]
1164	120336	integer, dimension(SZK_(GV)) :: num_itts
1165
1166		integer :: k, nz, itt, max_itt
1167
1168		! variables for ML based diffusivity
1169		real :: v0_ML_turb_vel_scale ! turbulence vel scale from ML in diffusivity [Z T-1 ~> m s-1]
1170
1171	60168	nz = GV%ke
1172
1173	60168	debug = .false. ! Change this hard-coded value for debugging.
1174	60168	calc_Te = (debug .or. (.not.CS%orig_PE_calc))
1175	60168	no_MKE_conversion = ((CS%direct_calc) .and. (CS%MKE_to_TKE_effic == 0.0))
1176
1177	60168	h_neglect = GV%H_subroundoff
1178	60168	dz_neglect = GV%dZ_subroundoff
1179
1180	60168	C1_3 = 1.0 / 3.0
1181	60168	I_dtdiag = 1.0 / dt
1182	60168	max_itt = 20
1183
1184	60168	dz_tt_min = 0.0
1185	60168	if (CS%answer_date < 20240101) vstar_unit_scale = US%m_to_Z * US%T_to_s
1186
1187	60168	MLD_guess = MLD_io
1188
1189		! Determine the initial mech_TKE and conv_PErel, including the energy required
1190		! to mix surface heating through the topmost cell, the energy released by mixing
1191		! surface cooling & brine rejection down through the topmost cell, and
1192		! homogenizing the shortwave heating within that cell. This sets the energy
1193		! and ustar and wstar available to drive mixing at the first interior
1194		! interface.
1195
1196	4632936	do K=1,nz+1 ; Kd(K) = 0.0 ; enddo
1197
1198	60168	pres_Z(1) = 0.0
1199	4572768	do k=1,nz
1200	4512600	dMass = GV%H_to_RZ * h(k)
1201	4512600	dPres = GV%g_Earth_Z_T2 * dMass
1202	4512600	dT_to_dPE(k) = (dMass * (pres_Z(K) + 0.5dPres)) dSV_dT(k)
1203	4512600	dS_to_dPE(k) = (dMass * (pres_Z(K) + 0.5dPres)) dSV_dS(k)
1204	4512600	dT_to_dColHt(k) = dMass * dSV_dT(k)
1205	4512600	dS_to_dColHt(k) = dMass * dSV_dS(k)
1206
1207	4572768	pres_Z(K+1) = pres_Z(K) + dPres
1208		enddo
1209
1210		! Determine the total thickness (dz_sum) and the fractional distance from the bottom (hb_hs).
1211	4572768	dz_sum = dz_neglect ; do k=1,nz ; dz_sum = dz_sum + dz(k) ; enddo
1212	60168	I_dzsum = 0.0 ; if (dz_sum > 0.0) I_dzsum = 1.0 / dz_sum
1213	60168	dz_bot = 0.0
1214	60168	hb_hs(nz+1) = 0.0
1215	4572768	do k=nz,1,-1
1216	4512600	dz_bot = dz_bot + dz(k)
1217	4572768	hb_hs(K) = dz_bot * I_dzsum
1218		enddo
1219
1220	60168	MLD_output = dz(1)
1221
1222		!/The following lines are for the iteration over MLD
1223		! max_MLD will initialized as ocean bottom depth
1224	4572768	max_MLD = 0.0 ; do k=1,nz ; max_MLD = max_MLD + dz(k) ; enddo
1225		! min_MLD will be initialized to 0.
1226	60168	min_MLD = 0.0
1227		! Set values of the wrong signs to indicate that these changes are not based on valid estimates
1228	60168	dMLD_min = -1.0US%m_to_Z ; dMLD_max = 1.0US%m_to_Z
1229
1230		! If no first guess is provided for MLD, try the middle of the water column
1231	60168	if (MLD_guess <= min_MLD) MLD_guess = 0.5 * (min_MLD + max_MLD)
1232
1233	60168	if (GV%Boussinesq) then
1234	4632936	do K=1,nz+1 ; h_dz_int(K) = GV%Z_to_H ; enddo
1235		else
1236	0	h_dz_int(1) = (h(1) + h_neglect) / (dz(1) + dz_neglect)
1237	0	do K=2,nz
1238	0	h_dz_int(K) = (h(k-1) + h(k) + h_neglect) / (dz(k-1) + dz(k) + dz_neglect)
1239		enddo
1240	0	h_dz_int(nz+1) = (h(nz) + h_neglect) / (dz(nz) + dz_neglect)
1241		endif
1242
1243		! Iterate to determine a converged EPBL depth.
1244	313463	do OBL_it=1,CS%Max_MLD_Its
1245
1246	313463	if (debug) then ; mech_TKE_k(:) = 0.0 ; conv_PErel_k(:) = 0.0 ; endif
1247
1248		! Reset ML_depth
1249	313463	MLD_output = dz(1)
1250	313463	sfc_connected = .true.
1251
1252		!/ Here we get mstar, which is the ratio of convective TKE driven mixing to UStar**3
1253	313463	if (CS%Use_LT) then
1254		call get_Langmuir_Number(LA, G, GV, US, abs(MLD_guess), u_star_mean, i, j, dz, Waves, &
1255	313463	U_H=u, V_H=v)
1256		call find_mstar(CS, US, B_flux, u_star, MLD_guess, absf, .false., &
1257		mstar_total, Langmuir_Number=La, Convect_Langmuir_Number=LAmod,&
1258	313463	mstar_LT=mstar_LT)
1259		else
1260	0	call find_mstar(CS, US, B_flux, u_star, MLD_guess, absf, .false., mstar_total)
1261		endif
1262
1263		!/ Apply mstar to get mech_TKE
1264	313463	if ((CS%answer_date < 20190101) .and. (CS%mstar_scheme==Use_Fixed_mstar)) then
1265	0	mech_TKE = (dtmstar_totalGV%Rho0) * u_star**3
1266		else
1267	313463	mech_TKE = mstar_total * mech_TKE_in
1268		! mech_TKE = mstar_total * (dtGV%Rho0 u_star**3)
1269		endif
1270		! stochastically perturb mech_TKE in the UFS
1271	313463	if (present(TKE_gen_stoch)) mech_TKE = mech_TKE*TKE_gen_stoch
1272
1273	313463	if (CS%TKE_diagnostics) then
1274	0	eCD%dTKE_conv = 0.0 ; eCD%dTKE_mixing = 0.0
1275	0	eCD%dTKE_MKE = 0.0 ; eCD%dTKE_mech_decay = 0.0 ; eCD%dTKE_conv_decay = 0.0
1276
1277	0	eCD%dTKE_wind = mech_TKE * I_dtdiag
1278	0	if (TKE_forcing(1) <= 0.0) then
1279	0	eCD%dTKE_forcing = max(-mech_TKE, TKE_forcing(1)) * I_dtdiag
1280		! eCD%dTKE_unbalanced = min(0.0, TKE_forcing(1) + mech_TKE) * I_dtdiag
1281		else
1282	0	eCD%dTKE_forcing = CS%nstarTKE_forcing(1) I_dtdiag
1283		! eCD%dTKE_unbalanced = 0.0
1284		endif
1285		endif
1286
1287	313463	if (TKE_forcing(1) <= 0.0) then
1288	41837	mech_TKE = mech_TKE + TKE_forcing(1)
1289	41837	if (mech_TKE < 0.0) mech_TKE = 0.0
1290	41837	conv_PErel = 0.0
1291		else
1292	271626	conv_PErel = TKE_forcing(1)
1293		endif
1294
1295
1296		! Store in 1D arrays for output.
1297	24136651	do K=1,nz+1 ; mixvel(K) = 0.0 ; mixlen(K) = 0.0 ; enddo
1298
1299		! Determine the mixing shape function MixLen_shape.
1300		if ((.not.CS%Use_MLD_iteration) .or. &
1301	313463	(CS%transLay_scale >= 1.0) .or. (CS%transLay_scale < 0.0) ) then
1302	0	do K=1,nz+1
1303	0	MixLen_shape(K) = 1.0
1304		enddo
1305	313463	elseif (MLD_guess <= 0.0) then
1306	0	if (CS%transLay_scale > 0.0) then ; do K=1,nz+1
1307	0	MixLen_shape(K) = CS%transLay_scale
1308	0	enddo ; else ; do K=1,nz+1
1309	0	MixLen_shape(K) = 1.0
1310		enddo ; endif
1311		else
1312		! Reduce the mixing length based on MLD, with a quadratic
1313		! expression that follows KPP.
1314	313463	I_MLD = 1.0 / MLD_guess
1315	313463	dz_rsum = 0.0
1316	313463	MixLen_shape(1) = 1.0
1317	313463	if (CS%eqdisc) then ! update Kd as per Machine Learning equation discovery
1318	0	call kappa_eqdisc(MixLen_shape, CS, GV, h, absf, B_flux, u_star, MLD_guess)
1319		else
1320	23823188	do K=2,nz+1
1321	23509725	dz_rsum = dz_rsum + dz(k-1)
1322	23823188	if (CS%MixLenExponent==2.0) then
1323		MixLen_shape(K) = CS%transLay_scale + (1.0 - CS%transLay_scale) * &
1324	0	(max(0.0, (MLD_guess - dz_rsum)I_MLD) )*2 ! CS%MixLenExponent
1325		else
1326		MixLen_shape(K) = CS%transLay_scale + (1.0 - CS%transLay_scale) * &
1327	23509725	(max(0.0, (MLD_guess - dz_rsum)I_MLD) )*CS%MixLenExponent
1328		endif
1329		enddo
1330		endif
1331		endif
1332
1333	313463	v0_ML_turb_vel_scale = 0.0 ! a variable that gets passed on to get_eqdisc_v0 & get_eqdisc_v0h
1334	313463	if (CS%eqdisc_v0) then
1335	0	call get_eqdisc_v0(CS,absf,B_flux,u_star,v0_ML_turb_vel_scale)
1336	313463	elseif (CS%eqdisc_v0h) then
1337	0	call get_eqdisc_v0h(CS,B_flux,u_star,MLD_guess,v0_ML_turb_vel_scale)
1338		endif
1339
1340	313463	Kd(1) = 0.0 ; Kddt_h(1) = 0.0
1341	313463	hp_a(1) = h(1)
1342	313463	dT_to_dPE_a(1) = dT_to_dPE(1) ; dT_to_dColHt_a(1) = dT_to_dColHt(1)
1343	313463	dS_to_dPE_a(1) = dS_to_dPE(1) ; dS_to_dColHt_a(1) = dS_to_dColHt(1)
1344
1345	313463	htot = h(1) ; dztot = dz(1) ; uhtot = u(1)h(1) ; vhtot = v(1)h(1)
1346
1347	313463	if (debug) then
1348	0	mech_TKE_k(1) = mech_TKE ; conv_PErel_k(1) = conv_PErel
1349	0	nstar_k(:) = 0.0 ; nstar_k(1) = CS%nstar ; num_itts(:) = -1
1350		endif
1351
1352	23509725	do K=2,nz
1353		! Apply dissipation to the TKE, here applied as an exponential decay
1354		! due to 3-d turbulent energy being lost to inefficient rotational modes.
1355
1356		! There should be several different "flavors" of TKE that decay at
1357		! different rates. The following form is often used for mechanical
1358		! stirring from the surface, perhaps due to breaking surface gravity
1359		! waves and wind-driven turbulence.
1360	23196262	if (GV%Boussinesq) then
1361	23196262	Idecay_len_TKE = (CS%TKE_decay * absf / u_star) * GV%H_to_Z
1362		else
1363	0	Idecay_len_TKE = (CS%TKE_decay * absf) / (h_dz_int(K) * u_star)
1364		endif
1365	23196262	exp_kh = 1.0
1366	23196262	if (Idecay_len_TKE > 0.0) exp_kh = exp(-h(k-1)*Idecay_len_TKE)
1367	23196262	if (CS%TKE_diagnostics) &
1368	0	eCD%dTKE_mech_decay = eCD%dTKE_mech_decay + (exp_kh-1.0) * mech_TKE * I_dtdiag
1369	23196262	if (present(TKE_diss_stoch)) then ! perturb the TKE destruction
1370	0	mech_TKE = mech_TKE * (1.0 + (exp_kh-1.0) * TKE_diss_stoch)
1371		else
1372	23196262	mech_TKE = mech_TKE * exp_kh
1373		endif
1374
1375		! Accumulate any convectively released potential energy to contribute
1376		! to wstar and to drive penetrating convection.
1377	23196262	if (TKE_forcing(k) > 0.0) then
1378	0	conv_PErel = conv_PErel + TKE_forcing(k)
1379	0	if (CS%TKE_diagnostics) &
1380	0	eCD%dTKE_forcing = eCD%dTKE_forcing + CS%nstarTKE_forcing(k) I_dtdiag
1381		endif
1382
1383	23196262	if (debug) then
1384	0	mech_TKE_k(K) = mech_TKE ; conv_PErel_k(K) = conv_PErel
1385		endif
1386
1387		! Determine the total energy
1388	23196262	nstar_FC = CS%nstar
1389	23196262	if (CS%nstar * conv_PErel > 0.0) then
1390		! Here nstar is a function of the natural Rossby number 0.2/(1+0.2/Ro), based
1391		! on a curve fit from the data of Wang (GRL, 2003).
1392		! Note: Ro = 1.0 / sqrt(0.5 * dt * Rho0 * (absfdztot)*3 / conv_PErel)
1393	5614472	if (GV%Boussinesq) then
1394		nstar_FC = CS%nstar * conv_PErel / (conv_PErel + 0.2 * &
1395	5614472	sqrt(0.5 * dt * GV%Rho0 * (absfdztot)3 conv_PErel))
1396		else
1397		nstar_FC = CS%nstar * conv_PErel / (conv_PErel + 0.2 * &
1398	0	sqrt(0.5 * dt * GV%H_to_RZ * (absf*3 (dztot*2 htot)) * conv_PErel))
1399		endif
1400		endif
1401
1402	23196262	if (debug) nstar_k(K) = nstar_FC
1403
1404	23196262	tot_TKE = mech_TKE + nstar_FC * conv_PErel
1405
1406		! For each interior interface, first discard the TKE to account for
1407		! mixing of shortwave radiation through the next denser cell.
1408	23196262	if (TKE_forcing(k) < 0.0) then
1409	0	if (TKE_forcing(k) + tot_TKE < 0.0) then
1410		! The shortwave requirements deplete all the energy in this layer.
1411	0	if (CS%TKE_diagnostics) then
1412	0	eCD%dTKE_mixing = eCD%dTKE_mixing + tot_TKE * I_dtdiag
1413	0	eCD%dTKE_forcing = eCD%dTKE_forcing - tot_TKE * I_dtdiag
1414		! eCD%dTKE_unbalanced = eCD%dTKE_unbalanced + (TKE_forcing(k) + tot_TKE) * I_dtdiag
1415	0	eCD%dTKE_conv_decay = eCD%dTKE_conv_decay + (CS%nstar-nstar_FC) * conv_PErel * I_dtdiag
1416		endif
1417	0	tot_TKE = 0.0 ; mech_TKE = 0.0 ; conv_PErel = 0.0
1418		else
1419		! Reduce the mechanical and convective TKE proportionately.
1420	0	TKE_reduc = (tot_TKE + TKE_forcing(k)) / tot_TKE
1421	0	if (CS%TKE_diagnostics) then
1422	0	eCD%dTKE_mixing = eCD%dTKE_mixing - TKE_forcing(k) * I_dtdiag
1423	0	eCD%dTKE_forcing = eCD%dTKE_forcing + TKE_forcing(k) * I_dtdiag
1424		eCD%dTKE_conv_decay = eCD%dTKE_conv_decay + &
1425	0	(1.0-TKE_reduc)(CS%nstar-nstar_FC) conv_PErel * I_dtdiag
1426		endif
1427	0	tot_TKE = TKE_reduc*tot_TKE ! = tot_TKE + TKE_forcing(k)
1428	0	mech_TKE = TKE_reduc*mech_TKE
1429	0	conv_PErel = TKE_reduc*conv_PErel
1430		endif
1431		endif
1432
1433		! Precalculate some temporary expressions that are independent of Kddt_h(K).
1434	23196262	if (CS%orig_PE_calc) then
1435	23196262	if (K==2) then
1436	313463	dTe_t2 = 0.0 ; dSe_t2 = 0.0
1437		else
1438	22882799	dTe_t2 = Kddt_h(K-1) * ((T0(k-2) - T0(k-1)) + dTe(k-2))
1439	22882799	dSe_t2 = Kddt_h(K-1) * ((S0(k-2) - S0(k-1)) + dSe(k-2))
1440		endif
1441		endif
1442	23196262	dt_h = dt / max(0.5(dz(k-1)+dz(k)), 1e-15dz_sum)
1443
1444		! This tests whether the layers above and below this interface are in
1445		! a convectively stable configuration, without considering any effects of
1446		! mixing at higher interfaces. It is an approximation to the more
1447		! complete test dPEc_dKd_Kd0 >= 0.0, that would include the effects of
1448		! mixing across interface K-1. The dT_to_dColHt here are effectively
1449		! mass-weighted estimates of dSV_dT.
1450		Convectively_stable = ( 0.0 <= &
1451		( (dT_to_dColHt(k) + dT_to_dColHt(k-1) ) * (T0(k-1)-T0(k)) + &
1452	23196262	(dS_to_dColHt(k) + dS_to_dColHt(k-1) ) * (S0(k-1)-S0(k)) ) )
1453
1454	23196262	if ((mech_TKE + conv_PErel) <= 0.0 .and. Convectively_stable) then
1455		! Energy is already exhausted, so set Kd = 0 and cycle or exit?
1456	17016749	tot_TKE = 0.0 ; mech_TKE = 0.0 ; conv_PErel = 0.0
1457	17016749	Kd(K) = 0.0 ; Kddt_h(K) = 0.0
1458	17016749	sfc_disconnect = .true.
1459		! if (.not.debug) exit
1460
1461		! The estimated properties for layer k-1 can be calculated, using
1462		! greatly simplified expressions when Kddt_h = 0. This enables the
1463		! tridiagonal solver for the whole column to be completed for debugging
1464		! purposes, and also allows for something akin to convective adjustment
1465		! in unstable interior regions?
1466	17016749	b1 = 1.0 / hp_a(k-1)
1467	17016749	c1(K) = 0.0
1468	17016749	if (CS%orig_PE_calc) then
1469	17016749	dTe(k-1) = b1 * ( dTe_t2 )
1470	17016749	dSe(k-1) = b1 * ( dSe_t2 )
1471		endif
1472
1473	17016749	hp_a(k) = h(k)
1474	17016749	dT_to_dPE_a(k) = dT_to_dPE(k)
1475	17016749	dS_to_dPE_a(k) = dS_to_dPE(k)
1476	17016749	dT_to_dColHt_a(k) = dT_to_dColHt(k)
1477	17016749	dS_to_dColHt_a(k) = dS_to_dColHt(k)
1478
1479		else ! tot_TKE > 0.0 or this is a potentially convectively unstable profile.
1480	6179513	sfc_disconnect = .false.
1481
1482		! Precalculate some more temporary expressions that are independent of
1483		! Kddt_h(K).
1484	6179513	if (CS%orig_PE_calc) then
1485	6179513	if (K==2) then
1486	312551	dT_km1_t2 = (T0(k)-T0(k-1))
1487	312551	dS_km1_t2 = (S0(k)-S0(k-1))
1488		else
1489		dT_km1_t2 = (T0(k)-T0(k-1)) - &
1490	5866962	(Kddt_h(K-1) / hp_a(k-1)) * ((T0(k-2) - T0(k-1)) + dTe(k-2))
1491		dS_km1_t2 = (S0(k)-S0(k-1)) - &
1492	5866962	(Kddt_h(K-1) / hp_a(k-1)) * ((S0(k-2) - S0(k-1)) + dSe(k-2))
1493		endif
1494	6179513	dTe_term = dTe_t2 + hp_a(k-1) * (T0(k-1)-T0(k))
1495	6179513	dSe_term = dSe_t2 + hp_a(k-1) * (S0(k-1)-S0(k))
1496		else
1497	0	if (K<=2) then
1498	0	Th_a(k-1) = h(k-1) * T0(k-1) ; Sh_a(k-1) = h(k-1) * S0(k-1)
1499		else
1500	0	Th_a(k-1) = h(k-1) * T0(k-1) + Kddt_h(K-1) * Te(k-2)
1501	0	Sh_a(k-1) = h(k-1) * S0(k-1) + Kddt_h(K-1) * Se(k-2)
1502		endif
1503	0	Th_b(k) = h(k) * T0(k) ; Sh_b(k) = h(k) * S0(k)
1504		endif
1505
1506		! Using Pr=1 and the diffusivity at the bottom interface (once it is
1507		! known), determine how much resolved mean kinetic energy (MKE) will be
1508		! extracted within a timestep and add a fraction CS%MKE_to_TKE_effic of
1509		! this to the mTKE budget available for mixing in the next layer.
1510
1511	6179513	if ((CS%MKE_to_TKE_effic > 0.0) .and. (htot*h(k) > 0.0)) then
1512		! This is the energy that would be available from homogenizing the
1513		! velocities between layer k and the layers above.
1514		dMKE_max = (GV%H_to_RZ * CS%MKE_to_TKE_effic) * 0.5 * &
1515		(h(k) / ((htot + h(k))htot)) &
1516	0	(((uhtot-u(k)htot)2) + ((vhtot-v(k)htot)**2))
1517		! A fraction (1-exp(Kddt_h*MKE2_Hharm)) of this energy would be
1518		! extracted by mixing with a finite viscosity.
1519		MKE2_Hharm = (htot + h(k) + 2.0*h_neglect) / &
1520	0	((htot+h_neglect) * (h(k)+h_neglect))
1521		else
1522	6179513	dMKE_max = 0.0
1523	6179513	MKE2_Hharm = 0.0
1524		endif
1525
1526		! At this point, Kddt_h(K) will be unknown because its value may depend
1527		! on how much energy is available. mech_TKE might be negative due to
1528		! contributions from TKE_forced.
1529	6179513	dz_tt = dztot + dz_tt_min
1530	6179513	TKE_here = mech_TKE + CS%wstar_ustar_coef*conv_PErel
1531	6179513	if (TKE_here > 0.0) then
1532	5835783	if (CS%answer_date < 20240101) then
1533	0	if (CS%wT_scheme==wT_from_cRoot_TKE) then
1534	0	vstar = CS%vstar_scale_fac * vstar_unit_scale * (SpV_dt(K)TKE_here)*C1_3
1535	0	elseif (CS%wT_scheme==wT_from_RH18) then
1536	0	Surface_Scale = max(0.05, 1.0 - dztot / MLD_guess)
1537		vstar = CS%vstar_scale_fac * Surface_Scale * (CS%vstar_surf_fac*u_star + &
1538	0	vstar_unit_scale * (CS%wstar_ustar_coefconv_PErelSpV_dt(K))**C1_3)
1539		endif
1540		else
1541	5835783	if (CS%wT_scheme==wT_from_cRoot_TKE) then
1542	5835783	vstar = CS%vstar_scale_fac * cuberoot(SpV_dt(K)*TKE_here)
1543	0	elseif (CS%wT_scheme==wT_from_RH18) then
1544	0	Surface_Scale = max(0.05, 1.0 - dztot / MLD_guess)
1545		vstar = (CS%vstar_scale_fac * Surface_Scale) * ( CS%vstar_surf_fac*u_star + &
1546	0	cuberoot((CS%wstar_ustar_coefconv_PErel) SpV_dt(K)) )
1547		endif
1548		endif
1549	5835783	hbs_here = min(hb_hs(K), MixLen_shape(K))
1550		mixlen(K) = max(CS%min_mix_len, ((dz_tthbs_here)vstar) / &
1551	5835783	((CS%Ekman_scale_coef * absf) * (dz_tt*hbs_here) + vstar))
1552		!Note setting Kd_guess0 to vstar * CS%vonKar * mixlen(K) here will
1553		! change the answers. Therefore, skipping that.
1554	5835783	if (.not.CS%Use_MLD_iteration) then
1555		Kd_guess0 = (h_dz_int(K)vstar) CS%vonKar * ((dz_tthbs_here)vstar) / &
1556	0	((CS%Ekman_scale_coef * absf) * (dz_tt*hbs_here) + vstar)
1557	5835783	elseif (CS%eqdisc) then ! ML-eqdisc line1/2
1558	0	Kd_guess0 = MixLen_shape(K) * v0_ML_turb_vel_scale * MLD_guess ! ML-eqdisc
1559		else
1560	5835783	Kd_guess0 = (h_dz_int(K)vstar) CS%vonKar * mixlen(K)
1561		endif
1562		else
1563	343730	vstar = 0.0 ; Kd_guess0 = 0.0
1564		endif
1565	6179513	mixvel(K) = vstar ! Track vstar
1566	6179513	Kddt_h_g0 = Kd_guess0 * dt_h
1567
1568	6179513	if (no_MKE_conversion) then
1569		! Without conversion from MKE to TKE, the updated diffusivity can be determined directly.
1570		! Replace h(k) with hp_b(k) = h(k), and dT_to_dPE with dT_to_dPE_b, etc., for a 2-direction solver.
1571		call find_Kd_from_PE_chg(0.0, Kd_guess0, dt_h, tot_TKE, hp_a(k-1), h(k), &
1572		Th_a(k-1), Sh_a(k-1), Th_b(k), Sh_b(k), &
1573		dT_to_dPE_a(k-1), dS_to_dPE_a(k-1), dT_to_dPE(k), dS_to_dPE(k), &
1574		pres_Z(K), dT_to_dColHt_a(k-1), dS_to_dColHt_a(k-1), &
1575		dT_to_dColHt(k), dS_to_dColHt(k), Kd_add=Kd(K), PE_chg=TKE_used, &
1576	0	dPE_max=PE_chg_max, frac_dKd_max_PE=frac_in_BL)
1577	0	convectively_unstable = (PE_chg_max < 0.0)
1578	0	PE_chg_g0 = TKE_used ! This is only used in the convectively unstable limit.
1579	0	MKE_src = 0.0
1580	6179513	elseif (CS%orig_PE_calc) then
1581		call find_PE_chg_orig(Kddt_h_g0, h(k), hp_a(k-1), dTe_term, dSe_term, &
1582		dT_km1_t2, dS_km1_t2, dT_to_dPE(k), dS_to_dPE(k), &
1583		dT_to_dPE_a(k-1), dS_to_dPE_a(k-1), &
1584		pres_Z(K), dT_to_dColHt(k), dS_to_dColHt(k), &
1585		dT_to_dColHt_a(k-1), dS_to_dColHt_a(k-1), &
1586	6179513	PE_chg=PE_chg_g0, dPE_max=PE_chg_max, dPEc_dKd_0=dPEc_dKd_Kd0 )
1587	6179513	convectively_unstable = (PE_chg_g0 < 0.0) .or. ((vstar == 0.0) .and. (dPEc_dKd_Kd0 < 0.0))
1588	6179513	MKE_src = dMKE_max(1.0 - exp(-Kddt_h_g0 MKE2_Hharm))
1589		else
1590		call find_PE_chg(0.0, Kddt_h_g0, hp_a(k-1), h(k), &
1591		Th_a(k-1), Sh_a(k-1), Th_b(k), Sh_b(k), &
1592		dT_to_dPE_a(k-1), dS_to_dPE_a(k-1), dT_to_dPE(k), dS_to_dPE(k), &
1593		pres_Z(K), dT_to_dColHt_a(k-1), dS_to_dColHt_a(k-1), &
1594		dT_to_dColHt(k), dS_to_dColHt(k), &
1595	0	PE_chg=PE_chg_g0, dPE_max=PE_chg_max, dPEc_dKd_0=dPEc_dKd_Kd0 )
1596	0	convectively_unstable = (PE_chg_g0 < 0.0) .or. ((vstar == 0.0) .and. (dPEc_dKd_Kd0 < 0.0))
1597	0	MKE_src = dMKE_max(1.0 - exp(-Kddt_h_g0 MKE2_Hharm))
1598		endif
1599
1600		! This block checks out different cases to determine Kd at the present interface.
1601	6179513	if (convectively_unstable) then
1602		! This column is convectively unstable.
1603	3305665	if (PE_chg_max <= 0.0) then
1604		! Does MKE_src need to be included in the calculation of vstar here?
1605	3305665	TKE_here = mech_TKE + CS%wstar_ustar_coef*(conv_PErel-PE_chg_max)
1606	3305665	if (TKE_here > 0.0) then
1607	3305665	if (CS%answer_date < 20240101) then
1608	0	if (CS%wT_scheme==wT_from_cRoot_TKE) then
1609	0	vstar = CS%vstar_scale_fac * vstar_unit_scale * (SpV_dt(K)TKE_here)*C1_3
1610	0	elseif (CS%wT_scheme==wT_from_RH18) then
1611	0	Surface_Scale = max(0.05, 1. - dztot / MLD_guess)
1612		vstar = CS%vstar_scale_fac * Surface_Scale * (CS%vstar_surf_fac*u_star + &
1613	0	vstar_unit_scale * (CS%wstar_ustar_coefconv_PErelSpV_dt(K))**C1_3)
1614		endif
1615		else
1616	3305665	if (CS%wT_scheme==wT_from_cRoot_TKE) then
1617	3305665	vstar = CS%vstar_scale_fac * cuberoot(SpV_dt(K)*TKE_here)
1618	0	elseif (CS%wT_scheme==wT_from_RH18) then
1619	0	Surface_Scale = max(0.05, 1. - dztot / MLD_guess)
1620		vstar = (CS%vstar_scale_fac * Surface_Scale) * ( CS%vstar_surf_fac*u_star + &
1621	0	cuberoot((CS%wstar_ustar_coefconv_PErel) SpV_dt(K)) )
1622		endif
1623		endif
1624	3305665	hbs_here = min(hb_hs(K), MixLen_shape(K))
1625		mixlen(K) = max(CS%min_mix_len, ((dz_tthbs_here)vstar) / &
1626	3305665	((CS%Ekman_scale_coef * absf) * (dz_tt*hbs_here) + vstar))
1627	3305665	if (.not.CS%Use_MLD_iteration) then
1628		! Note again (as prev) that using mixlen here
1629		! instead of redoing the computation will change answers...
1630		Kd(K) = (h_dz_int(K)vstar) CS%vonKar * ((dz_tthbs_here)vstar) / &
1631	0	((CS%Ekman_scale_coef * absf) * (dz_tt*hbs_here) + vstar)
1632	3305665	elseif (CS%eqdisc) then ! ML-eqdisc line2/2
1633	0	Kd(K) = MixLen_shape(K) * v0_ML_turb_vel_scale * MLD_guess ! ML-eqdisc
1634		else
1635	3305665	Kd(K) = (h_dz_int(K)vstar) CS%vonKar * mixlen(K)
1636		endif
1637		else
1638	0	vstar = 0.0 ; Kd(K) = 0.0
1639		endif
1640	3305665	mixvel(K) = vstar
1641
1642	3305665	if (CS%orig_PE_calc) then
1643		call find_PE_chg_orig(Kd(K)*dt_h, h(k), hp_a(k-1), dTe_term, dSe_term, &
1644		dT_km1_t2, dS_km1_t2, dT_to_dPE(k), dS_to_dPE(k), &
1645		dT_to_dPE_a(k-1), dS_to_dPE_a(k-1), &
1646		pres_Z(K), dT_to_dColHt(k), dS_to_dColHt(k), &
1647		dT_to_dColHt_a(k-1), dS_to_dColHt_a(k-1), &
1648	3305665	PE_chg=dPE_conv)
1649		else
1650		call find_PE_chg(0.0, Kd(K)*dt_h, hp_a(k-1), h(k), &
1651		Th_a(k-1), Sh_a(k-1), Th_b(k), Sh_b(k), &
1652		dT_to_dPE_a(k-1), dS_to_dPE_a(k-1), dT_to_dPE(k), dS_to_dPE(k), &
1653		pres_Z(K), dT_to_dColHt_a(k-1), dS_to_dColHt_a(k-1), &
1654		dT_to_dColHt(k), dS_to_dColHt(k), &
1655	0	PE_chg=dPE_conv)
1656		endif
1657		! Should this be iterated to convergence for Kd?
1658	3305665	if (dPE_conv > 0.0) then
1659	0	Kd(K) = Kd_guess0 ; dPE_conv = PE_chg_g0
1660		else
1661	3305665	MKE_src = dMKE_max(1.0 - exp(-(Kd(K)dt_h) * MKE2_Hharm))
1662		endif
1663		else
1664		! The energy change does not vary monotonically with Kddt_h. Find the maximum?
1665	0	Kd(K) = Kd_guess0 ; dPE_conv = PE_chg_g0
1666		endif
1667
1668	3305665	conv_PErel = conv_PErel - dPE_conv
1669	3305665	mech_TKE = mech_TKE + MKE_src
1670	3305665	if (CS%TKE_diagnostics) then
1671	0	eCD%dTKE_conv = eCD%dTKE_conv - CS%nstardPE_conv I_dtdiag
1672	0	eCD%dTKE_MKE = eCD%dTKE_MKE + MKE_src * I_dtdiag
1673		endif
1674	3305665	if (sfc_connected) then
1675	2351427	MLD_output = MLD_output + dz(k)
1676		endif
1677
1678	3305665	Kddt_h(K) = Kd(K) * dt_h
1679
1680	2873848	elseif (no_MKE_conversion) then ! (PE_chg_max >= 0.0) and use the diffusivity from find_Kd_from_PE_chg.
1681		! Kd(K) and TKE_used were already set by find_Kd_from_PE_chg.
1682
1683		! frac_in_BL = min((TKE_used / PE_chg_g0), 1.0)
1684	0	if (sfc_connected) MLD_output = MLD_output + frac_in_BL*dz(k)
1685	0	if (frac_in_BL < 1.0) sfc_disconnect = .true.
1686
1687		! Reduce the mechanical and convective TKE proportionately.
1688	0	TKE_reduc = 0.0 ! tot_TKE could be 0 if Convectively_stable is false.
1689	0	if ((tot_TKE > 0.0) .and. (tot_TKE > TKE_used)) TKE_reduc = (tot_TKE - TKE_used) / tot_TKE
1690
1691		! All TKE should have been consumed.
1692	0	if (CS%TKE_diagnostics) then
1693	0	eCD%dTKE_mixing = eCD%dTKE_mixing - TKE_used * I_dtdiag
1694		eCD%dTKE_conv_decay = eCD%dTKE_conv_decay + &
1695	0	(1.0-TKE_reduc)(CS%nstar-nstar_FC) conv_PErel * I_dtdiag
1696		endif
1697
1698	0	tot_TKE = tot_TKE - TKE_used
1699	0	mech_TKE = TKE_reduc*mech_TKE
1700	0	conv_PErel = TKE_reduc*conv_PErel
1701
1702	0	Kddt_h(K) = Kd(K) * dt_h
1703
1704	2873848	elseif (tot_TKE + (MKE_src - PE_chg_g0) >= 0.0) then
1705		! This column is convectively stable and there is energy to support the suggested
1706		! mixing. Keep that estimate.
1707	2348462	Kd(K) = Kd_guess0
1708	2348462	Kddt_h(K) = Kddt_h_g0
1709
1710		! Reduce the mechanical and convective TKE proportionately.
1711	2348462	tot_TKE = tot_TKE + MKE_src
1712	2348462	TKE_reduc = 0.0 ! tot_TKE could be 0 if Convectively_stable is false.
1713	2348462	if (tot_TKE > 0.0) TKE_reduc = (tot_TKE - PE_chg_g0) / tot_TKE
1714	2348462	if (CS%TKE_diagnostics) then
1715	0	eCD%dTKE_mixing = eCD%dTKE_mixing - PE_chg_g0 * I_dtdiag
1716	0	eCD%dTKE_MKE = eCD%dTKE_MKE + MKE_src * I_dtdiag
1717		eCD%dTKE_conv_decay = eCD%dTKE_conv_decay + &
1718	0	(1.0-TKE_reduc)(CS%nstar-nstar_FC) conv_PErel * I_dtdiag
1719		endif
1720	2348462	tot_TKE = TKE_reduc*tot_TKE
1721	2348462	mech_TKE = TKE_reduc*(mech_TKE + MKE_src)
1722	2348462	conv_PErel = TKE_reduc*conv_PErel
1723	2348462	if (sfc_connected) then
1724	500886	MLD_output = MLD_output + dz(k)
1725		endif
1726
1727	525386	elseif (tot_TKE == 0.0) then
1728		! This can arise if nstar_FC = 0, but it is not common.
1729	0	Kd(K) = 0.0 ; Kddt_h(K) = 0.0
1730	0	tot_TKE = 0.0 ; conv_PErel = 0.0 ; mech_TKE = 0.0
1731	0	sfc_disconnect = .true.
1732		else
1733		! There is not enough energy to support the mixing, so reduce the
1734		! diffusivity to what can be supported.
1735	525386	Kddt_h_max = Kddt_h_g0 ; Kddt_h_min = 0.0
1736	525386	TKE_left_max = tot_TKE + (MKE_src - PE_chg_g0)
1737	525386	TKE_left_min = tot_TKE
1738
1739		! As a starting guess, take the minimum of a false position estimate
1740		! and a Newton's method estimate starting from Kddt_h = 0.0.
1741		Kddt_h_guess = tot_TKE * Kddt_h_max / max( PE_chg_g0 - MKE_src, &
1742	525386	Kddt_h_max * (dPEc_dKd_Kd0 - dMKE_max * MKE2_Hharm) )
1743		! The above expression is mathematically the same as the following
1744		! except it is not susceptible to division by zero when
1745		! dPEc_dKd_Kd0 = dMKE_max = 0 .
1746		! Kddt_h_guess = tot_TKE * min( Kddt_h_max / (PE_chg_g0 - MKE_src), &
1747		! 1.0 / (dPEc_dKd_Kd0 - dMKE_max * MKE2_Hharm) )
1748	525386	if (debug) then
1749	0	TKE_left_itt(:) = 0.0 ; dPEa_dKd_itt(:) = 0.0 ; PE_chg_itt(:) = 0.0
1750	0	MKE_src_itt(:) = 0.0 ; Kddt_h_itt(:) = 0.0
1751		endif
1752	1777384	do itt=1,max_itt
1753	1777384	if (CS%orig_PE_calc) then
1754		call find_PE_chg_orig(Kddt_h_guess, h(k), hp_a(k-1), dTe_term, dSe_term, &
1755		dT_km1_t2, dS_km1_t2, dT_to_dPE(k), dS_to_dPE(k), &
1756		dT_to_dPE_a(k-1), dS_to_dPE_a(k-1), &
1757		pres_Z(K), dT_to_dColHt(k), dS_to_dColHt(k), &
1758		dT_to_dColHt_a(k-1), dS_to_dColHt_a(k-1), &
1759	1777384	PE_chg=PE_chg, dPEc_dKd=dPEc_dKd )
1760		else
1761		call find_PE_chg(0.0, Kddt_h_guess, hp_a(k-1), h(k), &
1762		Th_a(k-1), Sh_a(k-1), Th_b(k), Sh_b(k), &
1763		dT_to_dPE_a(k-1), dS_to_dPE_a(k-1), dT_to_dPE(k), dS_to_dPE(k), &
1764		pres_Z(K), dT_to_dColHt_a(k-1), dS_to_dColHt_a(k-1), &
1765		dT_to_dColHt(k), dS_to_dColHt(k), &
1766	0	PE_chg=PE_chg, dPEc_dKd=dPEc_dKd)
1767		endif
1768	1777384	MKE_src = dMKE_max * (1.0 - exp(-MKE2_Hharm * Kddt_h_guess))
1769	1777384	dMKE_src_dK = dMKE_max * MKE2_Hharm * exp(-MKE2_Hharm * Kddt_h_guess)
1770
1771	1777384	TKE_left = tot_TKE + (MKE_src - PE_chg)
1772	1777384	if (debug .and. itt<=20) then
1773	0	Kddt_h_itt(itt) = Kddt_h_guess ; MKE_src_itt(itt) = MKE_src
1774	0	PE_chg_itt(itt) = PE_chg ; dPEa_dKd_itt(itt) = dPEc_dKd
1775	0	TKE_left_itt(itt) = TKE_left
1776		endif
1777		! Store the new bounding values, bearing in mind that min and max
1778		! here refer to Kddt_h and dTKE_left/dKddt_h < 0:
1779	1777384	if (TKE_left >= 0.0) then
1780	1627472	Kddt_h_min = Kddt_h_guess ; TKE_left_min = TKE_left
1781		else
1782	149912	Kddt_h_max = Kddt_h_guess ; TKE_left_max = TKE_left
1783		endif
1784
1785		! Try to use Newton's method, but if it would go outside the bracketed
1786		! values use the false-position method instead.
1787	1777384	use_Newt = .true.
1788	1777384	if (dPEc_dKd - dMKE_src_dK <= 0.0) then
1789	0	use_Newt = .false.
1790		else
1791	1777384	dKddt_h_Newt = TKE_left / (dPEc_dKd - dMKE_src_dK)
1792	1777384	Kddt_h_Newt = Kddt_h_guess + dKddt_h_Newt
1793	1777384	if ((Kddt_h_Newt > Kddt_h_max) .or. (Kddt_h_Newt < Kddt_h_min)) &
1794	81	use_Newt = .false.
1795		endif
1796
1797	1777384	if (use_Newt) then
1798	1777303	Kddt_h_next = Kddt_h_guess + dKddt_h_Newt
1799	1777303	dKddt_h = dKddt_h_Newt
1800		else
1801		Kddt_h_next = (TKE_left_max * Kddt_h_min - Kddt_h_max * TKE_left_min) / &
1802	81	(TKE_left_max - TKE_left_min)
1803	81	dKddt_h = Kddt_h_next - Kddt_h_guess
1804		endif
1805
1806	1777384	if ((abs(dKddt_h) < 1e-9*Kddt_h_guess) .or. (itt==max_itt)) then
1807		! Use the old value so that the energy calculation does not need to be repeated.
1808	525386	if (debug) num_itts(K) = itt
1809	525386	exit
1810		else
1811	1251998	Kddt_h_guess = Kddt_h_next
1812		endif
1813		enddo ! Inner iteration loop on itt.
1814	525386	Kd(K) = Kddt_h_guess / dt_h ; Kddt_h(K) = Kd(K) * dt_h
1815
1816		! All TKE should have been consumed.
1817	525386	if (CS%TKE_diagnostics) then
1818	0	eCD%dTKE_mixing = eCD%dTKE_mixing - (tot_TKE + MKE_src) * I_dtdiag
1819	0	eCD%dTKE_MKE = eCD%dTKE_MKE + MKE_src * I_dtdiag
1820		eCD%dTKE_conv_decay = eCD%dTKE_conv_decay + &
1821	0	(CS%nstar-nstar_FC) * conv_PErel * I_dtdiag
1822		endif
1823
1824	525386	if (sfc_connected) MLD_output = MLD_output + (PE_chg / (PE_chg_g0)) * dz(k)
1825
1826	525386	tot_TKE = 0.0 ; mech_TKE = 0.0 ; conv_PErel = 0.0
1827	525386	sfc_disconnect = .true.
1828		endif ! End of convective or forced mixing cases to determine Kd.
1829
1830	6179513	Kddt_h(K) = Kd(K) * dt_h
1831		! At this point, the final value of Kddt_h(K) is known, so the
1832		! estimated properties for layer k-1 can be calculated.
1833	6179513	b1 = 1.0 / (hp_a(k-1) + Kddt_h(K))
1834	6179513	c1(K) = Kddt_h(K) * b1
1835	6179513	if (CS%orig_PE_calc) then
1836	6179513	dTe(k-1) = b1 * ( Kddt_h(K)*(T0(k)-T0(k-1)) + dTe_t2 )
1837	6179513	dSe(k-1) = b1 * ( Kddt_h(K)*(S0(k)-S0(k-1)) + dSe_t2 )
1838		endif
1839
1840	6179513	hp_a(k) = h(k) + (hp_a(k-1) * b1) * Kddt_h(K)
1841	6179513	dT_to_dPE_a(k) = dT_to_dPE(k) + c1(K)*dT_to_dPE_a(k-1)
1842	6179513	dS_to_dPE_a(k) = dS_to_dPE(k) + c1(K)*dS_to_dPE_a(k-1)
1843	6179513	dT_to_dColHt_a(k) = dT_to_dColHt(k) + c1(K)*dT_to_dColHt_a(k-1)
1844	6179513	dS_to_dColHt_a(k) = dS_to_dColHt(k) + c1(K)*dS_to_dColHt_a(k-1)
1845
1846		endif ! tot_TKT > 0.0 branch. Kddt_h(K) has been set.
1847
1848		! Store integrated velocities and thicknesses for MKE conversion calculations.
1849	23196262	if (sfc_disconnect) then
1850		! There is no turbulence at this interface, so zero out the running sums.
1851	17542135	uhtot = u(k)*h(k)
1852	17542135	vhtot = v(k)*h(k)
1853	17542135	htot = h(k)
1854	17542135	dztot = dz(k)
1855	17542135	sfc_connected = .false.
1856		else
1857	5654127	uhtot = uhtot + u(k)*h(k)
1858	5654127	vhtot = vhtot + v(k)*h(k)
1859	5654127	htot = htot + h(k)
1860	5654127	dztot = dztot + dz(k)
1861		endif
1862
1863	23509725	if (calc_Te) then
1864	0	if (K==2) then
1865	0	Te(1) = b1(h(1)T0(1))
1866	0	Se(1) = b1(h(1)S0(1))
1867		else
1868	0	Te(k-1) = b1 * (h(k-1) * T0(k-1) + Kddt_h(K-1) * Te(k-2))
1869	0	Se(k-1) = b1 * (h(k-1) * S0(k-1) + Kddt_h(K-1) * Se(k-2))
1870		endif
1871		endif
1872		enddo
1873	313463	Kd(nz+1) = 0.0
1874
1875	313463	if (debug) then
1876		! Complete the tridiagonal solve for Te.
1877	0	b1 = 1.0 / hp_a(nz)
1878	0	Te(nz) = b1 * (h(nz) * T0(nz) + Kddt_h(nz) * Te(nz-1))
1879	0	Se(nz) = b1 * (h(nz) * S0(nz) + Kddt_h(nz) * Se(nz-1))
1880	0	dT_expect(nz) = Te(nz) - T0(nz) ; dS_expect(nz) = Se(nz) - S0(nz)
1881	0	do k=nz-1,1,-1
1882	0	Te(k) = Te(k) + c1(K+1)*Te(k+1)
1883	0	Se(k) = Se(k) + c1(K+1)*Se(k+1)
1884	0	dT_expect(k) = Te(k) - T0(k) ; dS_expect(k) = Se(k) - S0(k)
1885		enddo
1886		endif
1887
1888	313463	if (debug) then
1889	0	dPE_debug = 0.0
1890	0	do k=1,nz
1891		dPE_debug = dPE_debug + (dT_to_dPE(k) * (Te(k) - T0(k)) + &
1892	0	dS_to_dPE(k) * (Se(k) - S0(k)))
1893		enddo
1894	0	mixing_debug = dPE_debug * I_dtdiag
1895		endif
1896
1897	313463	if (OBL_it >= CS%Max_MLD_Its) exit
1898
1899		! The following lines are used for the iteration. Note the iteration has been altered
1900		! to use the value predicted by the TKE threshold (ML_depth). This is because the mstar
1901		! is now dependent on the ML, and therefore the ML needs to be estimated more precisely
1902		! than the grid spacing.
1903
1904		! New method uses ML_depth as computed in ePBL routine
1905	312879	MLD_found = MLD_output
1906
1907		! Find out whether to do another iteration and the new bounds on it.
1908	312879	if (CS%MLD_iter_bug) then
1909		! There is a bug in the logic here if (MLD_found - MLD_guess == CS%MLD_tol).
1910	312879	if (MLD_found - MLD_guess > CS%MLD_tol) then
1911	81845	min_MLD = MLD_guess ; dMLD_min = MLD_found - MLD_guess
1912	231034	elseif (abs(MLD_found - MLD_guess) < CS%MLD_tol) then
1913	59584	exit ! Break the MLD convergence loop
1914		else ! We know this guess was too deep
1915	171450	max_MLD = MLD_guess ; dMLD_max = MLD_found - MLD_guess ! < -CS%MLD_tol
1916		endif
1917		else
1918	0	if (abs(MLD_found - MLD_guess) < CS%MLD_tol) then
1919	0	exit ! Break the MLD convergence loop
1920	0	elseif (MLD_found > MLD_guess) then ! This guess was too shallow
1921	0	min_MLD = MLD_guess ; dMLD_min = MLD_found - MLD_guess
1922		else ! We know this guess was too deep
1923	0	max_MLD = MLD_guess ; dMLD_max = MLD_found - MLD_guess ! < -CS%MLD_tol
1924		endif
1925		endif
1926
1927	253295	if (OBL_it < CS%Max_MLD_Its) then
1928	253295	if (CS%MLD_bisection) then
1929		! For the next pass, guess the average of the minimum and maximum values.
1930	0	MLD_guess = 0.5*(min_MLD + max_MLD)
1931		else ! Try using the false position method or the returned value instead of simple bisection.
1932		! Taking the occasional step with MLD_output empirically helps to converge faster.
1933	253295	if ((dMLD_min > 0.0) .and. (dMLD_max < 0.0) .and. (OBL_it > 2) .and. (mod(OBL_it-1,4) > 0)) then
1934		! Both bounds have valid change estimates and are probably in the range of possible outputs.
1935	111072	MLD_guess = (dMLD_minmax_MLD - dMLD_maxmin_MLD) / (dMLD_min - dMLD_max)
1936	142223	elseif ((MLD_found > min_MLD) .and. (MLD_found < max_MLD)) then
1937		! The output MLD_found is an interesting guess, as it is likely to bracket the true solution
1938		! along with the previous value of MLD_guess and to be close to the solution.
1939	136000	MLD_guess = MLD_found
1940		else ! Bisect if the other guesses would be out-of-bounds. This does not happen much.
1941	6223	MLD_guess = 0.5*(min_MLD + max_MLD)
1942		endif
1943		endif
1944		endif
1945
1946		enddo ! Iteration loop for converged boundary layer thickness.
1947
1948	60168	eCD%OBL_its = min(OBL_it, CS%Max_MLD_Its)
1949	60168	if (CS%Use_LT) then
1950	60168	eCD%LA = LA ; eCD%LAmod = LAmod ; eCD%mstar = mstar_total ; eCD%mstar_LT = mstar_LT
1951		else
1952	0	eCD%LA = 0.0 ; eCD%LAmod = 0.0 ; eCD%mstar = mstar_total ; eCD%mstar_LT = 0.0
1953		endif
1954
1955	60168	MLD_io = MLD_output
1956
1957	60168	end subroutine ePBL_column
1958
1959
1960		!> This subroutine determines the diffusivities from a bottom boundary layer version of
1961		!! the integrated energetics mixed layer model for a single column of water.
1962	0	subroutine ePBL_BBL_column(h, dz, u, v, T0, S0, dSV_dT, dSV_dS, SpV_dt, absf, &
1963	0	dt, Kd, BBL_TKE_in, u_star_BBL, u_star_BBL_z_t, b_flux_BBL, Kd_BBL, BBLD_io, mixvel_BBL, &
1964	0	mixlen_BBL, GV, US, CS, eCD)
1965		type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure.
1966		real, dimension(SZK_(GV)), intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2].
1967		real, dimension(SZK_(GV)), intent(in) :: dz !< The vertical distance across layers [Z ~> m].
1968		real, dimension(SZK_(GV)), intent(in) :: u !< Zonal velocities interpolated to h points
1969		!! [L T-1 ~> m s-1].
1970		real, dimension(SZK_(GV)), intent(in) :: v !< Zonal velocities interpolated to h points
1971		!! [L T-1 ~> m s-1].
1972		real, dimension(SZK_(GV)), intent(in) :: T0 !< The initial layer temperatures [C ~> degC].
1973		real, dimension(SZK_(GV)), intent(in) :: S0 !< The initial layer salinities [S ~> ppt].
1974
1975		real, dimension(SZK_(GV)), intent(in) :: dSV_dT !< The partial derivative of in-situ specific
1976		!! volume with potential temperature
1977		!! [R-1 C-1 ~> m3 kg-1 degC-1].
1978		real, dimension(SZK_(GV)), intent(in) :: dSV_dS !< The partial derivative of in-situ specific
1979		!! volume with salinity [R-1 S-1 ~> m3 kg-1 ppt-1].
1980		real, dimension(SZK_(GV)+1), intent(in) :: SpV_dt !< Specific volume interpolated to interfaces
1981		!! divided by dt (if non-Boussinesq) or
1982		!! 1.0 / (dt * Rho0), in [R-1 T-1 ~> m3 kg-1 s-1],
1983		!! used to convert local TKE into a turbulence
1984		!! velocity cubed.
1985		real, intent(in) :: absf !< The absolute value of the Coriolis parameter [T-1 ~> s-1].
1986		real, intent(in) :: dt !< Time increment [T ~> s].
1987		real, dimension(SZK_(GV)+1), &
1988		intent(in) :: Kd !< The diffusivities at interfaces due to previously
1989		!! applied mixing processes [H Z T-1 ~> m2 s-1 or kg m-1 s-1].
1990		real, intent(in) :: BBL_TKE_in !< The mechanically generated turbulent
1991		!! kinetic energy available for bottom boundary
1992		!! layer mixing within a time step [R Z3 T-2 ~> J m-2].
1993		real, intent(in) :: u_star_BBL !< The bottom boundary layer friction velocity
1994		!! in thickness flux units [H T-1 ~> m s-1 or kg m-2 s-1]
1995		real, intent(in) :: u_star_BBL_z_t !< The bottom boundary layer friction velocity
1996		!! converted to length flux units [Z T-1 ~> m s-1]
1997		real, intent(in) :: b_flux_BBL !< The bottom boundary layer buoyancy flux
1998		real, dimension(SZK_(GV)+1), &
1999		intent(out) :: Kd_BBL !< The bottom boundary layer contribution to diffusivities
2000		!! at interfaces [H Z T-1 ~> m2 s-1 or kg m-1 s-1].
2001		real, intent(inout) :: BBLD_io !< A first guess at the bottom boundary layer depth on input, and
2002		!! the calculated bottom boundary layer depth on output [Z ~> m]
2003		real, dimension(SZK_(GV)+1), &
2004		intent(out) :: mixvel_BBL !< The profile of boundary layer turbulent mixing
2005		!! velocities [Z T-1 ~> m s-1]
2006		real, dimension(SZK_(GV)+1), &
2007		intent(out) :: mixlen_BBL !< The profile of bottom boundary layer turbulent
2008		!! mixing lengths [Z ~> m]
2009		type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type
2010		type(energetic_PBL_CS), intent(in) :: CS !< Energetic PBL control structure
2011		type(ePBL_column_diags), intent(inout) :: eCD !< A container for passing around diagnostics.
2012
2013		! This subroutine determines the contributions from diffusivities in a single column from a
2014		! bottom-boundary layer adaptation of the integrated energetics planetary boundary layer (ePBL)
2015		! model. It accounts for the possibility that the surface boundary diffusivities have already
2016		! been determined. All calculations are done implicitly, and there is no stability limit on the
2017		! time step. Only mechanical mixing in the bottom boundary layer is considered. (Geothermal heat
2018		! fluxes are addressed elsewhere in the MOM6 code, and convection throughout the water column is
2019		! handled by the surface version of ePBL.) There is no conversion of released mean kinetic energy
2020		! into bottom boundary layer turbulent kinetic energy (at least for now), apart from the explicit
2021		! energy that is supplied as an argument to this routine.
2022
2023		! Local variables
2024		real, dimension(SZK_(GV)+1) :: &
2025	0	pres_Z, & ! Interface pressures with a rescaling factor to convert interface height
2026		! movements into changes in column potential energy [R Z2 T-2 ~> kg m-1 s-2].
2027	0	dztop_dztot ! The distance from the surface divided by the thickness of the
2028		! water column [nondim].
2029		real :: mech_BBL_TKE ! The mechanically generated turbulent kinetic energy available for
2030		! bottom boundary layer mixing within a time step [R Z3 T-2 ~> J m-2].
2031		real :: TKE_eff_avail ! The turbulent kinetic energy that is effectively available to drive mixing
2032		! after any effects of exponentially decay have been taken into account
2033		! [R Z3 T-2 ~> J m-2]
2034		real :: TKE_eff_used ! The amount of TKE_eff_avail that has been used to drive mixing [R Z3 T-2 ~> J m-2]
2035		real :: htot ! The total thickness of the layers above an interface [H ~> m or kg m-2].
2036		real :: dztot ! The total depth of the layers above an interface [Z ~> m].
2037		real :: uhtot ! The depth integrated zonal velocities in the layers above [H L T-1 ~> m2 s-1 or kg m-1 s-1]
2038		real :: vhtot ! The depth integrated meridional velocities in the layers above [H L T-1 ~> m2 s-1 or kg m-1 s-1]
2039		real :: Idecay_len_TKE ! The inverse of a turbulence decay length scale [H-1 ~> m-1 or m2 kg-1].
2040		real :: dz_sum ! The total thickness of the water column [Z ~> m].
2041
2042		real, dimension(SZK_(GV)) :: &
2043	0	dT_to_dColHt, & ! Partial derivative of the total column height with the temperature changes
2044		! within a layer [Z C-1 ~> m degC-1].
2045	0	dS_to_dColHt, & ! Partial derivative of the total column height with the salinity changes
2046		! within a layer [Z S-1 ~> m ppt-1].
2047	0	dT_to_dPE, & ! Partial derivatives of column potential energy with the temperature
2048		! changes within a layer, in [R Z3 T-2 C-1 ~> J m-2 degC-1].
2049	0	dS_to_dPE, & ! Partial derivatives of column potential energy with the salinity changes
2050		! within a layer, in [R Z3 T-2 S-1 ~> J m-2 ppt-1].
2051	0	dT_to_dColHt_a, & ! Partial derivative of the total column height with the temperature changes
2052		! within a layer, including the implicit effects of mixing with layers higher
2053		! in the water column [Z C-1 ~> m degC-1].
2054	0	dS_to_dColHt_a, & ! Partial derivative of the total column height with the salinity changes
2055		! within a layer, including the implicit effects of mixing with layers higher
2056		! in the water column [Z S-1 ~> m ppt-1].
2057	0	dT_to_dPE_a, & ! Partial derivatives of column potential energy with the temperature changes
2058		! within a layer, including the implicit effects of mixing with layers higher
2059		! in the water column [R Z3 T-2 C-1 ~> J m-2 degC-1].
2060	0	dS_to_dPE_a, & ! Partial derivative of column potential energy with the salinity changes
2061		! within a layer, including the implicit effects of mixing with layers higher
2062		! in the water column [R Z3 T-2 S-1 ~> J m-2 ppt-1].
2063	0	dT_to_dColHt_b, & ! Partial derivative of the total column height with the temperature changes
2064		! within a layer, including the implicit effects of mixing with layers deeper
2065		! in the water column [Z C-1 ~> m degC-1].
2066	0	dS_to_dColHt_b, & ! Partial derivative of the total column height with the salinity changes
2067		! within a layer, including the implicit effects of mixing with layers deeper
2068		! in the water column [Z S-1 ~> m ppt-1].
2069	0	dT_to_dPE_b, & ! Partial derivatives of column potential energy with the temperature changes
2070		! within a layer, including the implicit effects of mixing with layers deeper
2071		! in the water column [R Z3 T-2 C-1 ~> J m-2 degC-1].
2072	0	dS_to_dPE_b, & ! Partial derivative of column potential energy with the salinity changes
2073		! within a layer, including the implicit effects of mixing with layers deeper
2074		! in the water column [R Z3 T-2 S-1 ~> J m-2 ppt-1].
2075	0	c1, & ! c1 is used by the tridiagonal solver [nondim].
2076	0	Te, & ! Estimated final values of T in the column [C ~> degC].
2077	0	Se, & ! Estimated final values of S in the column [S ~> ppt].
2078	0	hp_a, & ! An effective pivot thickness of the layer including the effects
2079		! of coupling with layers above [H ~> m or kg m-2]. This is the first term
2080		! in the denominator of b1 in a downward-oriented tridiagonal solver.
2081	0	hp_b, & ! An effective pivot thickness of the layer including the effects
2082		! of coupling with layers below [H ~> m or kg m-2]. This is the first term
2083		! in the denominator of b1 in an upward-oriented tridiagonal solver.
2084	0	Th_a, & ! An effective temperature times a thickness in the layer above, including implicit
2085		! mixing effects with other yet higher layers [C H ~> degC m or degC kg m-2].
2086	0	Sh_a, & ! An effective salinity times a thickness in the layer above, including implicit
2087		! mixing effects with other yet higher layers [S H ~> ppt m or ppt kg m-2].
2088	0	Th_b, & ! An effective temperature times a thickness in the layer below, including implicit
2089		! mixing effects with other yet lower layers [C H ~> degC m or degC kg m-2].
2090	0	Sh_b ! An effective salinity times a thickness in the layer below, including implicit
2091		! mixing effects with other yet lower layers [S H ~> ppt m or ppt kg m-2].
2092		real, dimension(SZK_(GV)+1) :: &
2093	0	MixLen_shape, & ! A nondimensional shape factor for the mixing length that
2094		! gives it an appropriate asymptotic value at the bottom of
2095		! the boundary layer [nondim].
2096	0	h_dz_int, & ! The ratio of the layer thicknesses over the vertical distances
2097		! across the layers surrounding an interface [H Z-1 ~> nondim or kg m-3]
2098	0	Kddt_h ! The total diapycnal diffusivity at an interface times a timestep divided by the
2099		! average thicknesses around an interface [H ~> m or kg m-2].
2100		real :: b1 ! b1 is inverse of the pivot used by the tridiagonal solver [H-1 ~> m-1 or m2 kg-1].
2101		real :: h_neglect ! A thickness that is so small it is usually lost
2102		! in roundoff and can be neglected [H ~> m or kg m-2].
2103		real :: dz_neglect ! A vertical distance that is so small it is usually lost
2104		! in roundoff and can be neglected [Z ~> m].
2105		real :: dMass ! The mass per unit area within a layer [Z R ~> kg m-2].
2106		real :: dPres ! The hydrostatic pressure change across a layer [R Z2 T-2 ~> Pa] or
2107		! equivalently [R Z2 T-2 ~> J m-3].
2108		real :: dt_h ! The timestep divided by the averages of the vertical distances around
2109		! a layer [T Z-1 ~> s m-1].
2110		real :: dz_top ! The distance from the surface [Z ~> m].
2111		real :: dz_rsum ! The distance from the seafloor [Z ~> m].
2112		real :: I_dzsum ! The inverse of dz_sum [Z-1 ~> m-1].
2113		real :: I_BBLD ! The inverse of the current value of BBLD [Z-1 ~> m-1].
2114		real :: dz_tt ! The distance from the surface or up to the next interface
2115		! that did not exhibit turbulent mixing from this scheme plus
2116		! a surface mixing roughness length given by dz_tt_min [Z ~> m].
2117		real :: dz_tt_min ! A surface roughness length [Z ~> m].
2118		real :: C1_3 ! = 1/3 [nondim]
2119		real :: vstar ! An in-situ turbulent velocity [Z T-1 ~> m s-1].
2120		real :: BBLD_output ! The bottom boundary layer depth output from this routine [Z ~> m]
2121		real :: hbs_here ! The local minimum of dztop_dztot and MixLen_shape [nondim]
2122		real :: TKE_used ! The TKE used to support mixing at an interface [R Z3 T-2 ~> J m-2].
2123		real :: Kd_guess0 ! A first guess of the diapycnal diffusivity [H Z T-1 ~> m2 s-1 or kg m-1 s-1].
2124		real :: PE_chg_g0 ! The potential energy change when Kd is Kd_guess0 [R Z3 T-2 ~> J m-2]
2125		real :: Kddt_h_g0 ! The first guess of the change in diapycnal diffusivity times a timestep
2126		! divided by the average thicknesses around an interface [H ~> m or kg m-2].
2127		real :: Kddt_h_prev ! The diapycnal diffusivity before modification times a timestep divided
2128		! by the average thicknesses around an interface [H ~> m or kg m-2].
2129		real :: dPEc_dKd_Kd0 ! The partial derivative of PE change with Kddt_h(K)
2130		! for very small values of Kddt_h(K) [R Z3 T-2 H-1 ~> J m-3 or J kg-1].
2131		real :: PE_chg ! The change in potential energy due to mixing at an
2132		! interface [R Z3 T-2 ~> J m-2], positive for the column increasing
2133		! in potential energy (i.e., consuming TKE).
2134		real :: TKE_left ! The amount of turbulent kinetic energy left for the most
2135		! recent guess at Kddt_h(K) [R Z3 T-2 ~> J m-2].
2136		real :: dPEc_dKd ! The partial derivative of PE_chg with Kddt_h(K) [R Z3 T-2 H-1 ~> J m-3 or J kg-1].
2137		real :: TKE_left_min, TKE_left_max ! Maximum and minimum values of TKE_left [R Z3 T-2 ~> J m-2].
2138		real :: Kddt_h_max, Kddt_h_min ! Maximum and minimum values of Kddt_h(K) [H ~> m or kg m-2].
2139		real :: Kddt_h_guess ! A guess at the value of Kddt_h(K) [H ~> m or kg m-2].
2140		real :: Kddt_h_next ! The next guess at the value of Kddt_h(K) [H ~> m or kg m-2].
2141		real :: dKddt_h ! The change between guesses at Kddt_h(K) [H ~> m or kg m-2].
2142		real :: dKddt_h_Newt ! The change between guesses at Kddt_h(K) with Newton's method [H ~> m or kg m-2].
2143		real :: Kddt_h_newt ! The Newton's method next guess for Kddt_h(K) [H ~> m or kg m-2].
2144		real :: exp_kh ! The nondimensional decay of TKE across a layer [nondim].
2145		real :: frac_in_BL ! The fraction of the energy required to support dKd_max that is suppiled by
2146		! max_PE_chg, used here to determine a fractional layer contribution to the
2147		! boundary layer thickness [nondim]
2148		real :: TKE_rescale ! The effective fractional increase in energy available to
2149		! mixing at this interface once its exponential decay is accounted for [nondim]
2150		logical :: use_Newt ! Use Newton's method for the next guess at Kddt_h(K).
2151		logical :: convectively_stable ! If true the water column is convectively stable at this interface.
2152		logical :: bot_connected ! If true the ocean is actively turbulent from the present
2153		! interface all the way down to the seafloor.
2154		logical :: bot_disconnect ! If true, any turbulence has become disconnected
2155		! from the bottom.
2156
2157		! The following is only used for diagnostics.
2158		real :: I_dtdiag ! = 1.0 / dt [T-1 ~> s-1].
2159
2160		real :: BBLD_guess, BBLD_found ! Bottom boundary layer depth guessed/found for iteration [Z ~> m]
2161		real :: min_BBLD, max_BBLD ! Iteration bounds on BBLD [Z ~> m], which are adjusted at each step
2162		real :: dBBLD_min ! The change in diagnosed mixed layer depth when the guess is min_BLD [Z ~> m]
2163		real :: dBBLD_max ! The change in diagnosed mixed layer depth when the guess is max_BLD [Z ~> m]
2164		integer :: BBL_it ! Iteration counter
2165
2166		real :: Surface_Scale ! Surface decay scale for vstar [nondim]
2167		logical :: debug ! This is used as a hard-coded value for debugging.
2168		logical :: no_MKE_conversion ! If true, there is conversion of MKE to TKE in this routine.
2169		real :: mstar_BBL !< the value of mstar for the bottom boundary layer [nondim]
2170
2171		! The following arrays are used only for debugging purposes.
2172		real :: dPE_debug ! An estimate of the potential energy change [R Z3 T-2 ~> J m-2]
2173		real :: mixing_debug ! An estimate of the rate of change of potential energy due to mixing [R Z3 T-3 ~> W m-2]
2174		real, dimension(20) :: TKE_left_itt ! The value of TKE_left after each iteration [R Z3 T-2 ~> J m-2]
2175		real, dimension(20) :: PE_chg_itt ! The value of PE_chg after each iteration [R Z3 T-2 ~> J m-2]
2176		real, dimension(20) :: Kddt_h_itt ! The value of Kddt_h_guess after each iteration [H ~> m or kg m-2]
2177		real, dimension(20) :: dPEa_dKd_itt ! The value of dPEc_dKd after each iteration [R Z3 T-2 H-1 ~> J m-3 or J kg-1]
2178		! real, dimension(20) :: MKE_src_itt ! The value of MKE_src after each iteration [R Z3 T-2 ~> J m-2]
2179	0	real, dimension(SZK_(GV)) :: dT_expect !< Expected temperature changes [C ~> degC]
2180	0	real, dimension(SZK_(GV)) :: dS_expect !< Expected salinity changes [S ~> ppt]
2181	0	real, dimension(SZK_(GV)) :: mech_BBL_TKE_k ! The mechanically generated turbulent kinetic energy
2182		! available for bottom boundary mixing over a time step for each layer [R Z3 T-2 ~> J m-2].
2183	0	integer, dimension(SZK_(GV)) :: num_itts
2184
2185		integer :: k, nz, itt, max_itt
2186
2187	0	nz = GV%ke
2188
2189	0	debug = .false. ! Change this hard-coded value for debugging.
2190	0	no_MKE_conversion = ((CS%direct_calc) ) ! .and. (CS%MKE_to_TKE_effic == 0.0))
2191
2192		! Add bottom boundary layer mixing if there is energy to support it.
2193		if (((CS%ePBL_BBL_effic <= 0.0) .and. (CS%ePBL_tidal_effic <= 0.0) .and. (.not.CS%ePBL_BBL_use_mstar)) &
2194	0	.or. (BBL_TKE_in <= 0.0)) then
2195		! There is no added bottom boundary layer mixing.
2196	0	BBLD_io = 0.0
2197	0	Kd_BBL(:) = 0.0
2198	0	mixvel_BBL(:) = 0.0 ; mixlen_BBL(:) = 0.0
2199	0	eCD%BBL_its = 0
2200	0	if (CS%TKE_diagnostics) then
2201	0	eCD%dTKE_BBL_mixing = 0.0 ; eCD%dTKE_BBL_decay = 0.0 ; eCD%dTKE_BBL = 0.0
2202		! eCD%dTKE_BBL_MKE = 0.0
2203		endif
2204	0	return
2205		else
2206		! There will be added bottom boundary layer mixing.
2207
2208	0	h_neglect = GV%H_subroundoff
2209	0	dz_neglect = GV%dZ_subroundoff
2210
2211	0	C1_3 = 1.0 / 3.0
2212	0	I_dtdiag = 1.0 / dt
2213	0	max_itt = 20
2214	0	dz_tt_min = 0.0
2215
2216		! The next two blocks of code could be shared with ePBL_column.
2217
2218		! Set up fields relating a layer's temperature and salinity changes to potential energy changes.
2219	0	pres_Z(1) = 0.0
2220	0	do k=1,nz
2221	0	dMass = GV%H_to_RZ * h(k)
2222	0	dPres = GV%g_Earth_Z_T2 * dMass
2223	0	dT_to_dPE(k) = (dMass * (pres_Z(K) + 0.5dPres)) dSV_dT(k)
2224	0	dS_to_dPE(k) = (dMass * (pres_Z(K) + 0.5dPres)) dSV_dS(k)
2225	0	dT_to_dColHt(k) = dMass * dSV_dT(k)
2226	0	dS_to_dColHt(k) = dMass * dSV_dS(k)
2227
2228	0	pres_Z(K+1) = pres_Z(K) + dPres
2229		enddo
2230
2231	0	if (GV%Boussinesq) then
2232	0	do K=1,nz+1 ; h_dz_int(K) = GV%Z_to_H ; enddo
2233		else
2234	0	h_dz_int(1) = (h(1) + h_neglect) / (dz(1) + dz_neglect)
2235	0	do K=2,nz
2236	0	h_dz_int(K) = (h(k-1) + h(k) + h_neglect) / (dz(k-1) + dz(k) + dz_neglect)
2237		enddo
2238	0	h_dz_int(nz+1) = (h(nz) + h_neglect) / (dz(nz) + dz_neglect)
2239		endif
2240		! The two previous blocks of code could be shared with ePBL_column.
2241
2242		! Determine the total thickness (dz_sum) and the fractional distance from the top (dztop_dztot).
2243	0	dz_sum = 0.0 ; do k=1,nz ; dz_sum = dz_sum + dz(k) ; enddo
2244	0	I_dzsum = 0.0 ; if (dz_sum > 0.0) I_dzsum = 1.0 / dz_sum
2245	0	dz_top = 0.0
2246	0	dztop_dztot(nz+1) = 0.0
2247	0	do k=1,nz
2248	0	dz_top = dz_top + dz(k)
2249	0	dztop_dztot(K) = dz_top * I_dzsum
2250		enddo
2251
2252		! Set terms from a tridiagonal solver based on the previously determined diffusivities.
2253	0	Kddt_h(1) = 0.0
2254	0	hp_a(1) = h(1)
2255	0	dT_to_dPE_a(1) = dT_to_dPE(1) ; dT_to_dColHt_a(1) = dT_to_dColHt(1)
2256	0	dS_to_dPE_a(1) = dS_to_dPE(1) ; dS_to_dColHt_a(1) = dS_to_dColHt(1)
2257	0	do K=2,nz
2258	0	dt_h = dt / max(0.5(dz(k-1)+dz(k)), 1e-15dz_sum)
2259	0	Kddt_h(K) = Kd(K) * dt_h
2260	0	b1 = 1.0 / (hp_a(k-1) + Kddt_h(K))
2261	0	c1(K) = Kddt_h(K) * b1
2262	0	hp_a(k) = h(k) + (hp_a(k-1) * b1) * Kddt_h(K)
2263	0	dT_to_dPE_a(k) = dT_to_dPE(k) + c1(K)*dT_to_dPE_a(k-1)
2264	0	dS_to_dPE_a(k) = dS_to_dPE(k) + c1(K)*dS_to_dPE_a(k-1)
2265	0	dT_to_dColHt_a(k) = dT_to_dColHt(k) + c1(K)*dT_to_dColHt_a(k-1)
2266	0	dS_to_dColHt_a(k) = dS_to_dColHt(k) + c1(K)*dS_to_dColHt_a(k-1)
2267	0	if (K<=2) then
2268	0	Te(k-1) = b1(h(k-1)T0(k-1)) ; Se(k-1) = b1(h(k-1)S0(k-1))
2269	0	Th_a(k-1) = h(k-1) * T0(k-1) ; Sh_a(k-1) = h(k-1) * S0(k-1)
2270		else
2271	0	Te(k-1) = b1 * (h(k-1) * T0(k-1) + Kddt_h(K-1) * Te(k-2))
2272	0	Se(k-1) = b1 * (h(k-1) * S0(k-1) + Kddt_h(K-1) * Se(k-2))
2273	0	Th_a(k-1) = h(k-1) * T0(k-1) + Kddt_h(K-1) * Te(k-2)
2274	0	Sh_a(k-1) = h(k-1) * S0(k-1) + Kddt_h(K-1) * Se(k-2)
2275		endif
2276		enddo
2277	0	Kddt_h(nz+1) = 0.0
2278	0	if (debug) then
2279		! Complete the tridiagonal solve for Te and Se, which may be useful for debugging.
2280	0	b1 = 1.0 / hp_a(nz)
2281	0	Te(nz) = b1 * (h(nz) * T0(nz) + Kddt_h(nz) * Te(nz-1))
2282	0	Se(nz) = b1 * (h(nz) * S0(nz) + Kddt_h(nz) * Se(nz-1))
2283	0	do k=nz-1,1,-1
2284	0	Te(k) = Te(k) + c1(K+1)*Te(k+1)
2285	0	Se(k) = Se(k) + c1(K+1)*Se(k+1)
2286		enddo
2287		endif
2288
2289	0	BBLD_guess = BBLD_io
2290
2291		!/The following lines are for the iteration over BBLD
2292		! max_BBLD will initialized as ocean bottom depth
2293	0	max_BBLD = 0.0 ; do k=1,nz ; max_BBLD = max_BBLD + dz(k) ; enddo
2294		! min_BBLD will be initialized to 0.
2295	0	min_BBLD = 0.0
2296		! Set values of the wrong signs to indicate that these changes are not based on valid estimates
2297	0	dBBLD_min = -1.0US%m_to_Z ; dBBLD_max = 1.0US%m_to_Z
2298
2299		! If no first guess is provided for BBLD, try the middle of the water column
2300	0	if (BBLD_guess <= min_BBLD) BBLD_guess = 0.5 * (min_BBLD + max_BBLD)
2301
2302		! Iterate to determine a converged EPBL bottom boundary layer depth.
2303	0	do BBL_it=1,CS%max_BBLD_its
2304
2305	0	if (debug) then ; mech_BBL_TKE_k(:) = 0.0 ; endif
2306
2307		! Reset BBL_depth
2308	0	BBLD_output = dz(nz)
2309	0	bot_connected = .true.
2310
2311	0	if (CS%ePBL_BBL_use_mstar) then
2312	0	call find_mstar(CS, US, B_flux_BBL, u_star_BBL_z_t, BBLD_guess, absf, .true., mstar_BBL)
2313	0	eCD%mstar_BBL = mstar_BBL
2314	0	mech_BBL_TKE = mstar_BBL * BBL_TKE_in
2315		else
2316	0	mech_BBL_TKE = BBL_TKE_in
2317	0	eCD%mstar_BBL = 0.0
2318		endif
2319	0	if (CS%TKE_diagnostics) then
2320		! eCD%dTKE_BBL_MKE = 0.0
2321	0	eCD%dTKE_BBL_mixing = 0.0
2322	0	eCD%dTKE_BBL_decay = 0.0
2323	0	eCD%dTKE_BBL = mech_BBL_TKE * I_dtdiag
2324		endif
2325
2326		! Store in 1D arrays for output.
2327	0	do K=1,nz+1 ; mixvel_BBL(K) = 0.0 ; mixlen_BBL(K) = 0.0 ; enddo
2328
2329		! Determine the mixing shape function MixLen_shape.
2330		if ((.not.CS%Use_BBLD_iteration) .or. &
2331	0	(CS%transLay_scale >= 1.0) .or. (CS%transLay_scale < 0.0) ) then
2332	0	do K=1,nz+1
2333	0	MixLen_shape(K) = 1.0
2334		enddo
2335	0	elseif (BBLD_guess <= 0.0) then
2336	0	if (CS%transLay_scale > 0.0) then ; do K=1,nz+1
2337	0	MixLen_shape(K) = CS%transLay_scale
2338	0	enddo ; else ; do K=1,nz+1
2339	0	MixLen_shape(K) = 1.0
2340		enddo ; endif
2341		else
2342		! Reduce the mixing length based on BBLD, with a quadratic
2343		! expression that follows KPP.
2344	0	I_BBLD = 1.0 / BBLD_guess
2345	0	dz_rsum = 0.0
2346	0	MixLen_shape(nz+1) = 1.0
2347	0	if (CS%MixLenExponent_BBL==2.0) then
2348	0	do K=nz,1,-1
2349	0	dz_rsum = dz_rsum + dz(k)
2350		MixLen_shape(K) = CS%transLay_scale + (1.0 - CS%transLay_scale) * &
2351	0	(max(0.0, (BBLD_guess - dz_rsum)I_BBLD) )*2
2352		enddo
2353	0	elseif (CS%MixLenExponent_BBL==1.0) then
2354	0	do K=nz,1,-1
2355	0	dz_rsum = dz_rsum + dz(k)
2356		MixLen_shape(K) = CS%transLay_scale + (1.0 - CS%transLay_scale) * &
2357	0	(max(0.0, (BBLD_guess - dz_rsum)*I_BBLD) )
2358		enddo
2359		else ! (CS%MixLenExponent_BBL /= 2.0 or 1.0) then
2360	0	do K=nz,1,-1
2361	0	dz_rsum = dz_rsum + dz(k)
2362		MixLen_shape(K) = CS%transLay_scale + (1.0 - CS%transLay_scale) * &
2363	0	(max(0.0, (BBLD_guess - dz_rsum)I_BBLD) )*CS%MixLenExponent_BBL
2364		enddo
2365		endif
2366		endif
2367
2368	0	Kd_BBL(nz+1) = 0.0 ; Kddt_h(nz+1) = 0.0
2369	0	hp_b(nz) = h(nz)
2370	0	dT_to_dPE_b(nz) = dT_to_dPE(nz) ; dT_to_dColHt_b(nz) = dT_to_dColHt(nz)
2371	0	dS_to_dPE_b(nz) = dS_to_dPE(nz) ; dS_to_dColHt_b(nz) = dS_to_dColHt(nz)
2372
2373	0	htot = h(nz) ; dztot = dz(nz) ; uhtot = u(nz)h(nz) ; vhtot = v(nz)h(nz)
2374
2375	0	if (debug) then
2376	0	mech_BBL_TKE_k(nz) = mech_BBL_TKE
2377	0	num_itts(:) = -1
2378		endif
2379
2380	0	Idecay_len_TKE = (CS%TKE_decay_BBL * absf) / u_star_BBL
2381	0	do K=nz,2,-1
2382		! Apply dissipation to the TKE, here applied as an exponential decay
2383		! due to 3-d turbulent energy being lost to inefficient rotational modes.
2384		! The following form is often used for mechanical stirring from the surface.
2385		! There could be several different "flavors" of TKE that decay at different rates.
2386	0	exp_kh = 1.0
2387	0	if (Idecay_len_TKE > 0.0) exp_kh = exp(-h(k)*Idecay_len_TKE)
2388	0	if (CS%TKE_diagnostics) &
2389	0	eCD%dTKE_BBL_decay = eCD%dTKE_BBL_decay + (exp_kh-1.0) * mech_BBL_TKE * I_dtdiag
2390	0	mech_BBL_TKE = mech_BBL_TKE * exp_kh
2391
2392	0	if (debug) then
2393	0	mech_BBL_TKE_k(K) = mech_BBL_TKE
2394		endif
2395
2396		! Precalculate some temporary expressions that are independent of Kddt_h(K).
2397	0	dt_h = dt / max(0.5(dz(k-1)+dz(k)), 1e-15dz_sum)
2398
2399		! This tests whether the layers above and below this interface are in
2400		! a convectively stable configuration, without considering any effects of
2401		! mixing at higher interfaces. It is an approximation to the more
2402		! complete test dPEc_dKd_Kd0 >= 0.0, that would include the effects of
2403		! mixing across interface K+1. The dT_to_dColHt here are effectively
2404		! mass-weighted estimates of dSV_dT.
2405		Convectively_stable = ( 0.0 <= &
2406		( (dT_to_dColHt(k) + dT_to_dColHt(k-1) ) * (T0(k-1)-T0(k)) + &
2407	0	(dS_to_dColHt(k) + dS_to_dColHt(k-1) ) * (S0(k-1)-S0(k)) ) )
2408
2409	0	if ((mech_BBL_TKE <= 0.0) .and. Convectively_stable) then
2410		! Energy is already exhausted, so set Kd_BBL = 0 and cycle or exit?
2411	0	mech_BBL_TKE = 0.0
2412	0	Kd_BBL(K) = 0.0 ; Kddt_h(K) = Kd(K) * dt_h
2413	0	bot_disconnect = .true.
2414		! if (.not.debug) exit
2415
2416		else ! mech_BBL_TKE > 0.0 or this is a potentially convectively unstable profile.
2417	0	bot_disconnect = .false.
2418
2419		! Precalculate some more temporary expressions that are independent of Kddt_h(K).
2420	0	if (K>=nz) then
2421	0	Th_b(k) = h(k) * T0(k) ; Sh_b(k) = h(k) * S0(k)
2422		else
2423	0	Th_b(k) = h(k) * T0(k) + Kddt_h(K+1) * Te(k+1)
2424	0	Sh_b(k) = h(k) * S0(k) + Kddt_h(K+1) * Se(k+1)
2425		endif
2426
2427		! Using Pr=1 and the diffusivity at the upper interface (once it is
2428		! known), determine how much resolved mean kinetic energy (MKE) will be
2429		! extracted within a timestep and add a fraction CS%MKE_to_TKE_effic of
2430		! this to the mTKE budget available for mixing in the next layer.
2431		! This is not enabled yet for BBL mixing.
2432		! if ((CS%MKE_to_TKE_effic > 0.0) .and. (htot*h(k-1) > 0.0)) then
2433		! ! This is the energy that would be available from homogenizing the
2434		! ! velocities between layer k-1 and the layers below.
2435		! dMKE_max = (GV%H_to_RZ * CS%MKE_to_TKE_effic) * 0.5 * &
2436		! (h(k-1) / ((htot + h(k-1))htot)) &
2437		! ((uhtot-u(k-1)htot)2 + (vhtot-v(k-1)htot)**2)
2438		! ! A fraction (1-exp(Kddt_h*MKE2_Hharm)) of this energy would be
2439		! ! extracted by mixing with a finite viscosity.
2440		! MKE2_Hharm = (htot + h(k-1) + 2.0*h_neglect) / &
2441		! ((htot+h_neglect) * (h(k-1)+h_neglect))
2442		! else
2443		! dMKE_max = 0.0
2444		! MKE2_Hharm = 0.0
2445		! endif
2446
2447		! At this point, Kddt_h(K) will be unknown because its value may depend
2448		! on how much energy is available.
2449	0	dz_tt = dztot + dz_tt_min
2450	0	if (mech_BBL_TKE > 0.0) then
2451	0	if (CS%wT_scheme_BBL==wT_from_cRoot_TKE) then
2452	0	vstar = CS%vstar_scale_fac_BBL * cuberoot(SpV_dt(K)*mech_BBL_TKE)
2453	0	elseif (CS%wT_scheme_BBL==wT_from_RH18) then
2454	0	Surface_Scale = max(0.05, 1.0 - dztot / BBLD_guess)
2455	0	vstar = (CS%vstar_scale_fac_BBL * Surface_Scale) * ( CS%vstar_surf_fac_BBL*u_star_BBL/h_dz_int(K) )
2456		endif
2457	0	hbs_here = min(dztop_dztot(K), MixLen_shape(K))
2458		mixlen_BBL(K) = max(CS%min_BBL_mix_len, ((dz_tthbs_here)vstar) / &
2459	0	((CS%Ekman_scale_coef_BBL * absf) * (dz_tt*hbs_here) + vstar))
2460	0	Kd_guess0 = (h_dz_int(K)vstar) CS%vonKar * mixlen_BBL(K)
2461		else
2462	0	vstar = 0.0 ; Kd_guess0 = 0.0
2463		endif
2464	0	mixvel_BBL(K) = vstar ! Track vstar
2465
2466	0	TKE_rescale = 1.0
2467	0	if (CS%decay_adjusted_BBL_TKE) then
2468		! Add a scaling factor that accounts for the exponential decay of TKE from a
2469		! near-bottom source and the assumption that an increase in the diffusivity at an
2470		! interface causes a linearly increasing buoyancy flux going from 0 at the bottom
2471		! to a peak at the interface, and then going back to 0 atop the layer above.
2472	0	TKE_rescale = exp_decay_TKE_adjust(htot, h(k-1), Idecay_len_TKE)
2473		endif
2474
2475	0	TKE_eff_avail = TKE_rescale*mech_BBL_TKE
2476
2477	0	if (no_MKE_conversion) then
2478		! Without conversion from MKE to TKE, the updated diffusivity can be determined directly.
2479		call find_Kd_from_PE_chg(Kd(K), Kd_guess0, dt_h, TKE_eff_avail, hp_a(k-1), hp_b(k), &
2480		Th_a(k-1), Sh_a(k-1), Th_b(k), Sh_b(k), &
2481		dT_to_dPE_a(k-1), dS_to_dPE_a(k-1), dT_to_dPE_b(k), dS_to_dPE_b(k), &
2482		pres_Z(K), dT_to_dColHt_a(k-1), dS_to_dColHt_a(k-1), &
2483		dT_to_dColHt_b(k), dS_to_dColHt_b(k), Kd_add=Kd_BBL(K), PE_chg=TKE_eff_used, &
2484	0	frac_dKd_max_PE=frac_in_BL)
2485
2486		! Do not add energy if the column is convectively unstable. This was handled previously
2487		! for mixing from the surface.
2488	0	if (TKE_eff_used < 0.0) TKE_eff_used = 0.0
2489
2490		! Convert back to the TKE that has actually been used.
2491	0	if (CS%decay_adjusted_BBL_TKE) then
2492	0	if (TKE_rescale == 0.0) then ! This probably never occurs, even at roundoff.
2493	0	TKE_used = mech_BBL_TKE ! All the energy was dissipated before it could mix.
2494		else
2495	0	TKE_used = TKE_eff_used / TKE_rescale
2496		endif
2497		else
2498	0	TKE_used = TKE_eff_used
2499		endif
2500
2501	0	if (bot_connected) BBLD_output = BBLD_output + frac_in_BL*dz(k-1)
2502	0	if (frac_in_BL < 1.0) bot_disconnect = .true.
2503
2504	0	if (CS%TKE_diagnostics) then
2505	0	eCD%dTKE_BBL_mixing = eCD%dTKE_BBL_mixing - TKE_eff_used * I_dtdiag
2506	0	eCD%dTKE_BBL_decay = eCD%dTKE_BBL_decay - (TKE_used-TKE_eff_used) * I_dtdiag
2507		endif
2508
2509	0	mech_BBL_TKE = mech_BBL_TKE - TKE_used
2510
2511	0	Kddt_h(K) = (Kd(K) + Kd_BBL(K)) * dt_h
2512
2513		else
2514	0	Kddt_h_prev = Kd(K) * dt_h
2515	0	Kddt_h_g0 = Kd_guess0 * dt_h
2516		! Find the change in PE with the guess at the added bottom boundary layer mixing.
2517		call find_PE_chg(Kddt_h_prev, Kddt_h_g0, hp_a(k-1), hp_b(k), &
2518		Th_a(k-1), Sh_a(k-1), Th_b(k), Sh_b(k), &
2519		dT_to_dPE_a(k-1), dS_to_dPE_a(k-1), dT_to_dPE_b(k), dS_to_dPE_b(k), &
2520		pres_Z(K), dT_to_dColHt_a(k-1), dS_to_dColHt_a(k-1), &
2521		dT_to_dColHt_b(k), dS_to_dColHt_b(k), &
2522	0	PE_chg=PE_chg_g0, dPEc_dKd_0=dPEc_dKd_Kd0 )
2523
2524		! MKE_src = 0.0 ! Enable later?: = dMKE_max(1.0 - exp(-Kddt_h_g0 MKE2_Hharm))
2525
2526		! Do not add energy if the column is convectively unstable. This was handled previously
2527		! for mixing from the surface.
2528	0	if (PE_chg_g0 < 0.0) PE_chg_g0 = 0.0
2529
2530		! This block checks out different cases to determine Kd at the present interface.
2531		! if (mech_BBL_TKE*TKE_rescale + (MKE_src - PE_chg_g0) >= 0.0) then
2532	0	if (TKE_eff_avail - PE_chg_g0 >= 0.0) then
2533		! This column is convectively stable and there is energy to support the suggested
2534		! mixing, or it is convectively unstable. Keep this first estimate of Kd.
2535	0	Kd_BBL(K) = Kd_guess0
2536	0	Kddt_h(K) = Kddt_h_prev + Kddt_h_g0
2537
2538	0	TKE_used = PE_chg_g0 / TKE_rescale
2539
2540	0	if (CS%TKE_diagnostics) then
2541	0	eCD%dTKE_BBL_mixing = eCD%dTKE_BBL_mixing - PE_chg_g0 * I_dtdiag
2542		! eCD%dTKE_MKE = eCD%dTKE_MKE + MKE_src * I_dtdiag
2543	0	eCD%dTKE_BBL_decay = eCD%dTKE_BBL_decay - (TKE_used - PE_chg_g0) * I_dtdiag
2544		endif
2545
2546		! mech_BBL_TKE = mech_BBL_TKE + MKE_src - TKE_used
2547	0	mech_BBL_TKE = mech_BBL_TKE - TKE_used
2548	0	if (bot_connected) then
2549	0	BBLD_output = BBLD_output + dz(k-1)
2550		endif
2551
2552	0	elseif (TKE_eff_avail == 0.0) then
2553		! This can arise if there is no energy input to drive mixing or if there
2554		! is such strong decay that the mech_BBL_TKE becomes 0 via an underflow.
2555	0	Kd_BBL(K) = 0.0 ; Kddt_h(K) = Kddt_h_prev
2556	0	if (CS%TKE_diagnostics) then
2557	0	eCD%dTKE_BBL_decay = eCD%dTKE_BBL_decay - mech_BBL_TKE * I_dtdiag
2558		endif
2559	0	mech_BBL_TKE = 0.0
2560	0	bot_disconnect = .true.
2561		else
2562		! There is not enough energy to support the mixing, so reduce the
2563		! diffusivity to what can be supported.
2564	0	Kddt_h_max = Kddt_h_g0 ; Kddt_h_min = 0.0
2565		! TKE_left_max = TKE_eff_avail + (MKE_src - PE_chg_g0)
2566	0	TKE_left_max = TKE_eff_avail - PE_chg_g0
2567	0	TKE_left_min = TKE_eff_avail
2568
2569		! As a starting guess, take the minimum of a false position estimate
2570		! and a Newton's method estimate starting from dKddt_h = 0.0
2571		! Enable conversion from MKE to TKE in the bottom boundary layer later?
2572		! Kddt_h_guess = TKE_eff_avail * Kddt_h_max / max( PE_chg_g0 - MKE_src, &
2573		! Kddt_h_max * (dPEc_dKd_Kd0 - dMKE_max * MKE2_Hharm) )
2574	0	Kddt_h_guess = TKE_eff_avail * Kddt_h_max / max( PE_chg_g0, Kddt_h_max * dPEc_dKd_Kd0 )
2575		! The above expression is mathematically the same as the following
2576		! except it is not susceptible to division by zero when
2577		! dPEc_dKd_Kd0 = dMKE_max = 0 .
2578		! Kddt_h_guess = TKE_eff_avail * min( Kddt_h_max / (PE_chg_g0 - MKE_src), &
2579		! 1.0 / (dPEc_dKd_Kd0 - dMKE_max * MKE2_Hharm) )
2580	0	if (debug) then
2581	0	TKE_left_itt(:) = 0.0 ; dPEa_dKd_itt(:) = 0.0 ; PE_chg_itt(:) = 0.0
2582	0	Kddt_h_itt(:) = 0.0 ! ; MKE_src_itt(:) = 0.0
2583		endif
2584	0	do itt=1,max_itt
2585		call find_PE_chg(Kddt_h_prev, Kddt_h_guess, hp_a(k-1), hp_b(k), &
2586		Th_a(k-1), Sh_a(k-1), Th_b(k), Sh_b(k), &
2587		dT_to_dPE_a(k-1), dS_to_dPE_a(k-1), dT_to_dPE_b(k), dS_to_dPE_b(k), &
2588		pres_Z(K), dT_to_dColHt_a(k-1), dS_to_dColHt_a(k-1), &
2589		dT_to_dColHt_b(k), dS_to_dColHt_b(k), &
2590	0	PE_chg=PE_chg, dPEc_dKd=dPEc_dKd)
2591		! Enable conversion from MKE to TKE in the bottom boundary layer later?
2592		! MKE_src = dMKE_max * (1.0 - exp(-MKE2_Hharm * Kddt_h_guess))
2593		! dMKE_src_dK = dMKE_max * MKE2_Hharm * exp(-MKE2_Hharm * Kddt_h_guess)
2594
2595		! TKE_left = TKE_eff_avail + (MKE_src - PE_chg)
2596	0	TKE_left = TKE_eff_avail - PE_chg
2597	0	if (debug .and. itt<=20) then
2598	0	Kddt_h_itt(itt) = Kddt_h_guess ! ; MKE_src_itt(itt) = MKE_src
2599	0	PE_chg_itt(itt) = PE_chg ; dPEa_dKd_itt(itt) = dPEc_dKd
2600	0	TKE_left_itt(itt) = TKE_left
2601		endif
2602		! Store the new bounding values, bearing in mind that min and max
2603		! here refer to Kddt_h and dTKE_left/dKddt_h < 0:
2604	0	if (TKE_left >= 0.0) then
2605	0	Kddt_h_min = Kddt_h_guess ; TKE_left_min = TKE_left
2606		else
2607	0	Kddt_h_max = Kddt_h_guess ; TKE_left_max = TKE_left
2608		endif
2609
2610		! Try to use Newton's method, but if it would go outside the bracketed
2611		! values use the false-position method instead.
2612	0	use_Newt = .true.
2613		! if (dPEc_dKd - dMKE_src_dK <= 0.0) then
2614	0	if (dPEc_dKd <= 0.0) then
2615	0	use_Newt = .false.
2616		else
2617		! dKddt_h_Newt = TKE_left / (dPEc_dKd - dMKE_src_dK)
2618	0	dKddt_h_Newt = TKE_left / dPEc_dKd
2619	0	Kddt_h_Newt = Kddt_h_guess + dKddt_h_Newt
2620	0	if ((Kddt_h_Newt > Kddt_h_max) .or. (Kddt_h_Newt < Kddt_h_min)) &
2621	0	use_Newt = .false.
2622		endif
2623
2624	0	if (use_Newt) then
2625	0	Kddt_h_next = Kddt_h_guess + dKddt_h_Newt
2626	0	dKddt_h = dKddt_h_Newt
2627		else
2628		Kddt_h_next = (TKE_left_max * Kddt_h_min - Kddt_h_max * TKE_left_min) / &
2629	0	(TKE_left_max - TKE_left_min)
2630	0	dKddt_h = Kddt_h_next - Kddt_h_guess
2631		endif
2632
2633	0	if ((abs(dKddt_h) < 1e-9*Kddt_h_guess) .or. (itt==max_itt)) then
2634		! Use the old value so that the energy calculation does not need to be repeated.
2635	0	if (debug) num_itts(K) = itt
2636	0	exit
2637		else
2638	0	Kddt_h_guess = Kddt_h_next
2639		endif
2640		enddo ! Inner iteration loop on itt.
2641	0	Kd_BBL(K) = Kddt_h_guess / dt_h
2642	0	Kddt_h(K) = (Kd(K) + Kd_BBL(K)) * dt_h
2643
2644		! All TKE should have been consumed.
2645	0	if (CS%TKE_diagnostics) then
2646		! eCD%dTKE_BBL_mixing = eCD%dTKE_BBL_mixing - (TKE_eff_avail + MKE_src) * I_dtdiag
2647		! eCD%dTKE_BBL_MKE = eCD%dTKE_BBL_MKE + MKE_src * I_dtdiag
2648	0	eCD%dTKE_BBL_mixing = eCD%dTKE_BBL_mixing - TKE_eff_avail * I_dtdiag
2649	0	eCD%dTKE_BBL_decay = eCD%dTKE_BBL_decay - (mech_BBL_TKE-TKE_eff_avail) * I_dtdiag
2650		endif
2651
2652	0	if (bot_connected) BBLD_output = BBLD_output + (PE_chg / PE_chg_g0) * dz(k-1)
2653
2654	0	mech_BBL_TKE = 0.0
2655	0	bot_disconnect = .true.
2656		endif ! End of convective or forced mixing cases to determine Kd.
2657		endif
2658
2659	0	Kddt_h(K) = (Kd(K) + Kd_BBL(K)) * dt_h
2660		endif ! tot_TKT > 0.0 branch. Kddt_h(K) has been set.
2661
2662		! At this point, the final value of Kddt_h(K) is known, so the
2663		! estimated properties for layer k can be calculated.
2664	0	b1 = 1.0 / (hp_b(k) + Kddt_h(K))
2665	0	c1(K) = Kddt_h(K) * b1
2666
2667	0	hp_b(k-1) = h(k-1) + (hp_b(k) * b1) * Kddt_h(K)
2668	0	dT_to_dPE_b(k-1) = dT_to_dPE(k-1) + c1(K)*dT_to_dPE_b(k)
2669	0	dS_to_dPE_b(k-1) = dS_to_dPE(k-1) + c1(K)*dS_to_dPE_b(k)
2670	0	dT_to_dColHt_b(k-1) = dT_to_dColHt(k-1) + c1(K)*dT_to_dColHt_b(k)
2671	0	dS_to_dColHt_b(k-1) = dS_to_dColHt(k-1) + c1(K)*dS_to_dColHt_b(k)
2672
2673		! Store integrated velocities and thicknesses for MKE conversion calculations.
2674	0	if (bot_disconnect) then
2675		! There is no turbulence at this interface, so restart the running sums.
2676	0	uhtot = u(k-1)*h(k-1)
2677	0	vhtot = v(k-1)*h(k-1)
2678	0	htot = h(k-1)
2679	0	dztot = dz(k-1)
2680	0	bot_connected = .false.
2681		else
2682	0	uhtot = uhtot + u(k-1)*h(k-1)
2683	0	vhtot = vhtot + v(k-1)*h(k-1)
2684	0	htot = htot + h(k-1)
2685	0	dztot = dztot + dz(k-1)
2686		endif
2687
2688	0	if (K==nz) then
2689	0	Te(k) = b1(h(k)T0(k))
2690	0	Se(k) = b1(h(k)S0(k))
2691		else
2692	0	Te(k) = b1 * (h(k) * T0(k) + Kddt_h(K+1) * Te(k+1))
2693	0	Se(k) = b1 * (h(k) * S0(k) + Kddt_h(K+1) * Se(k+1))
2694		endif
2695		enddo
2696	0	Kd_BBL(1) = 0.0
2697
2698	0	if (debug) then
2699		! Complete the tridiagonal solve for Te with a downward pass.
2700	0	b1 = 1.0 / hp_b(1)
2701	0	Te(1) = b1 * (h(1) * T0(1) + Kddt_h(2) * Te(2))
2702	0	Se(1) = b1 * (h(1) * S0(1) + Kddt_h(2) * Se(2))
2703	0	dT_expect(1) = Te(1) - T0(1) ; dS_expect(1) = Se(1) - S0(1)
2704	0	do k=2,nz
2705	0	Te(k) = Te(k) + c1(K)*Te(k-1)
2706	0	Se(k) = Se(k) + c1(K)*Se(k-1)
2707	0	dT_expect(k) = Te(k) - T0(k) ; dS_expect(k) = Se(k) - S0(k)
2708		enddo
2709
2710	0	dPE_debug = 0.0
2711	0	do k=1,nz
2712		dPE_debug = dPE_debug + (dT_to_dPE(k) * (Te(k) - T0(k)) + &
2713	0	dS_to_dPE(k) * (Se(k) - S0(k)))
2714		enddo
2715	0	mixing_debug = dPE_debug * I_dtdiag
2716		endif
2717
2718		! Skip the rest of the contents of the do loop if there are no more BBL depth iterations.
2719	0	if (BBL_it >= CS%max_BBLD_its) exit
2720
2721		! The following lines are used for the iteration to determine the boundary layer depth.
2722		! Note that the iteration uses the value predicted by the TKE threshold (BBL_DEPTH),
2723		! because the mixing length shape is dependent on the BBL depth, and therefore the BBL depth
2724		! should be estimated more precisely than the grid spacing.
2725
2726		! New method uses BBL_DEPTH as computed in ePBL routine
2727	0	BBLD_found = BBLD_output
2728	0	if (abs(BBLD_found - BBLD_guess) < CS%BBLD_tol) then
2729	0	exit ! Break the BBL depth convergence loop
2730	0	elseif (BBLD_found > BBLD_guess) then
2731	0	min_BBLD = BBLD_guess ; dBBLD_min = BBLD_found - BBLD_guess
2732		else ! We know this guess was too deep
2733	0	max_BBLD = BBLD_guess ; dBBLD_max = BBLD_found - BBLD_guess ! <= -CS%BBLD_tol
2734		endif
2735
2736		! Try using the false position method or the returned value instead of simple bisection.
2737		! Taking the occasional step with BBLD_output empirically helps to converge faster.
2738	0	if ((dBBLD_min > 0.0) .and. (dBBLD_max < 0.0) .and. (BBL_it > 2) .and. (mod(BBL_it-1,4) > 0)) then
2739		! Both bounds have valid change estimates and are probably in the range of possible outputs.
2740	0	BBLD_guess = (dBBLD_minmax_BBLD - dBBLD_maxmin_BBLD) / (dBBLD_min - dBBLD_max)
2741	0	elseif ((BBLD_found > min_BBLD) .and. (BBLD_found < max_BBLD)) then
2742		! The output BBLD_found is an interesting guess, as it is likely to bracket the true solution
2743		! along with the previous value of BBLD_guess and to be close to the solution.
2744	0	BBLD_guess = BBLD_found
2745		else ! Bisect if the other guesses would be out-of-bounds. This does not happen much.
2746	0	BBLD_guess = 0.5*(min_BBLD + max_BBLD)
2747		endif
2748
2749		enddo ! Iteration loop for converged boundary layer thickness.
2750
2751	0	eCD%BBL_its = min(BBL_it, CS%max_BBLD_its)
2752	0	BBLD_io = BBLD_output
2753		endif
2754
2755		end subroutine ePBL_BBL_column
2756
2757		!> Gives shape function that sets the vertical structure of OSBL diffusivity
2758		!! as described in Sane et al. 2025
2759	0	subroutine kappa_eqdisc(shape_func, CS, GV, dz, absf, B_flux, u_star, MLD_guess)
2760
2761		type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure.
2762		type(energetic_PBL_CS), intent(in) :: CS !< Energetic PBL control struct
2763		real, dimension(SZK_(GV)+1), intent(inout) :: shape_func !< shape function, [nondim]
2764		real, intent(in) :: absf !< The absolute value of f [T-1 ~> s-1]
2765		real, intent(in) :: u_star !< The surface friction velocity [Z T-1 ~> m s-1]
2766		real, intent(in) :: B_Flux !< The surface buoyancy flux [Z2 T-3 ~> m2 s-3]
2767		real, dimension(SZK_(GV)), intent(in) :: dz !< The vertical distance across layers [Z ~> m]
2768		real, intent(in) :: MLD_guess !< Mixing Layer depth guessed/found for iteration [Z ~> m].
2769	0	real, dimension(SZK_(GV)+1) :: hz !< depth variable, only used in this routine [H ~> m]
2770
2771		! local variables for this subroutine
2772		integer :: nz
2773		integer :: K, n ! integers for looping
2774		real :: Lh ! ((B_flux * h))/(u_star^3), boundary layer depth by M-O depth, [nondim]
2775		real :: Eh ! ((h f)/u_star ), boundary layer depth by Ekman depth, [nondim]
2776		real :: sm ! sigma_max: location of maximum of shape function in sigma coordinate [nondim]
2777		real :: hbl ! Boundary layer depth, same as MLD_guess [Z ~> m]
2778		real :: F ! function, used in asymptotic model for sm, Equation 7 in Sane et al. 2024 [nondim]
2779		real :: F_Eh ! F multiplied by Eh [nondim]
2780		real :: u_star_I ! inverse of u_star [Z-1 T ~> m-1 s]
2781
2782		! variables used for optimizing computations:
2783		real :: sm_h ! sigma_max multiplied by boundary layer depth [Z ~> m]
2784		real :: sm_h_I ! inverse of sm_h [Z-1 ~> m-1]
2785		real :: hz_n ! z depth to avoid calling hz multiple times [Z ~> m]
2786		real :: z_minus_sm_h ! depth z minus \sigma_m * MLD_Guess [Z ~> m]
2787		real :: z_minus_sm_h2 ! (depth z minus \sigma_m * MLD_Guess)^2 [Z2 ~> m2]
2788		real :: z_minus_sm_h3 ! (depth z minus \sigma_m * MLD_Guess)^3 [Z3 ~> m3]
2789		real :: h_minus_smh_I ! inverse of (MLD_Guess - \sigma_m * MLD_Guess) [Z-1 ~> m-1]
2790		real :: h_minus_smh_I2 ! inverse of (MLD_Guess - \sigma_m * MLD_Guess) ^ 2 [Z-2 ~> m-2]
2791		real :: h_minus_smh_I3 ! inverse of (MLD_Guess - \sigma_m * MLD_Guess) ^ 3 [Z-3 ~> m-3]
2792		real :: z_sm_h_I ! depth divided by (\sigma_m * MLD_Guess) [nondim]
2793		real :: coef_c2 ! = 2.98 * h_minus_smh_I2 ! [Z-2 ~> m-2]
2794		real :: coef_c3 ! = 2.98 * h_minus_smh_I2 ! [Z-3 ~> m-3]
2795
2796	0	nz = SZK_(GV)+1
2797	0	hz(1) = 0.0
2798	0	do K=2,nz
2799	0	hz(K) = hz(K-1) + dz(K-1)
2800		enddo
2801	0	hbl = MLD_Guess ! hbl is boundary layer depth.
2802
2803	0	u_star_I = 1.0/u_star
2804	0	Lh = (-B_flux * hbl) * ((u_star_I * u_star_I) * u_star_I) ! Boundary layer depth divided by Monin-Obukhov depth
2805	0	Eh = (hbl * absf) * u_star_I ! Boundary layer depth divided by Ekman depth
2806
2807		! B_flux given negative sign to follow convention used in Sane et al. 2023
2808		! Lh < 0 --> surface stabilizing i.e. heating, and Lh > 0 --> surface destabilizing i.e. cooling
2809		! This capping does not matter because these equations have asymptotes. Not sensitive beyond the caps.
2810	0	Eh = min(Eh, CS%Eh_upper_cap) ! capping p1 to less than 2.0. It is always >0.0.
2811	0	Lh = min(max(Lh, -CS%Lh_cap), CS%Lh_cap) ! capping Lh between -8 and 8
2812
2813		! Empirical model to predict sm:
2814		! F is Equation (6) in Sane et al. 2025, and needs to be computed before sigma_m:
2815		! \mathcal{F} = \frac{1}{c_3 + c_4 \cdot e^{-\left( \text{sgn}(B) \cdot {c_5} \cdot {{L_h}^3} \right)}} + c_6
2816		! Equation (5) in Sane et al. 2025:
2817		! \sigma_{m} = \frac{1}{c_1 + \frac{c_2}{\mathcal{F} \cdot E_h}}
2818		! Note: Lh over here is ((Bh)/ustar^3), whereas in Sane et al. 2025, L_h = (((Bh)^{1/3})/(ustar))
2819
2820	0	F = (1.0/ ( CS%ML_c(3) + CS%ML_c(4) * exp(-CS%ML_c(5) * Lh) ) ) + CS%ML_c(6)
2821	0	F_Eh = F * Eh
2822	0	sm = F_Eh / (CS%ML_c(1)*F_Eh +CS%ML_c(2))
2823	0	sm = min(max(sm, CS%sigma_max_lower_cap), CS%sigma_max_upper_cap) ! makes sure 0.1<sm<0.7
2824		! true sm range is (approx) 0.2 to 0.60
2825
2826	0	sm_h = sm * hbl
2827	0	sm_h_I = 1.0/sm_h ! 1.0 / (sm x hbl)
2828	0	h_minus_smh_I = 1.0/(hbl-sm_h) ! 1.0 / (hbl-sm_h)
2829	0	h_minus_smh_I2 = h_minus_smh_I * h_minus_smh_I ! (1.0 / (hbl - sm*hbl))^2
2830	0	h_minus_smh_I3 = h_minus_smh_I2 * h_minus_smh_I ! (1.0 / (hbl - sm*hbl))^3
2831
2832		! The coefficients coef_c3 and coef_c2 are dependent on CS%shape_function_epsilon.
2833		! Above depth sm_h, shape_func is quadratic, and below sm_h, it is cubic.
2834		! For iterative ePBL solver, shape_func should not be zero below hbl, so that it has been set to a small value
2835		! set by CS%shape_function_epsilon. To make the cubic part of shapefunc behave smoothly, the below two coefficients
2836		! are used that depend on CS%shape_function_epsilon. The numbers 1.0, 2.0, 3.0 below are constants,
2837		! and should not be changed.
2838
2839	0	coef_c3 = ( 2.0 * ( 1.0 - CS%shape_function_epsilon ) ) * h_minus_smh_I3
2840	0	coef_c2 = ( 3.0 * ( CS%shape_function_epsilon - 1.0 ) ) * h_minus_smh_I2
2841
2842		! gives the shape, quadratic above sm, cubic below sm in sigma coordinate
2843		! see Equation 3 in Sane et al. 2024
2844		! interpolates a quadratic function from z=0 to z=sm_h, and then a cubic from z=sm_h to z=hbl
2845
2846	0	shape_func(1) = 0.0 ! initializing the first element of shape function array
2847	0	do n = 2,nz
2848	0	hz_n = hz(n) ! calls hz(n) once to avoid calling it multiple times below
2849
2850	0	if (hz_n <= sm_h) then
2851		! Eq.3a in Sane et al. 2025: -(\frac{z}{\sigma_m \cdot h})^2+2(\frac{z}{\sigma_m h}) : Eq. (3) in Sane et al. 2025
2852
2853	0	z_sm_h_I = hz_n * sm_h_I ! pre multiplying
2854	0	shape_func(n) = -z_sm_h_Iz_sm_h_I + 2.0 z_sm_h_I
2855
2856	0	elseif (hz_n <= hbl) then
2857		! Eq.3b in Sane et al. 2025: 2\left(\frac{\s - \sm}{1 - \sm} \right)^3 -
2858		! 3\left(\frac{\s - \sm}{1 - \sm} \right)^2 + 1
2859
2860	0	z_minus_sm_h = (hz_n - sm_h)
2861	0	z_minus_sm_h2 = z_minus_sm_h * z_minus_sm_h
2862	0	z_minus_sm_h3 = z_minus_sm_h * z_minus_sm_h2
2863
2864	0	shape_func(n) = (coef_c3 * z_minus_sm_h3 + coef_c2 * z_minus_sm_h2) + 1.0
2865
2866	0	elseif (hz(n) > hbl) then
2867	0	shape_func(n) = CS%shape_function_epsilon ! set an arbitrary low constant value below hbl, default 0.01
2868		endif
2869		enddo
2870	0	end subroutine kappa_eqdisc
2871
2872		!> Gives velocity scale (v_0) using equations that approximate neural network of Sane et al. 2023
2873	0	subroutine get_eqdisc_v0(CS, absf, B_flux, u_star, v0_dummy)
2874		type(energetic_PBL_CS), intent(in) :: CS !< Energetic PBL control struct
2875		real, intent(in) :: B_flux !< The surface buoyancy flux [Z2 T-3 ~> m2 s-3]
2876		real, intent(in) :: u_star !< The surface friction velocity [Z T-1 ~> m s-1]
2877		real, intent(in) :: absf !< The absolute value of f [T-1 ~> s-1].
2878		real, intent(inout) :: v0_dummy !< velocity scale v0, local variable [Z T-1 ~> m s-1]
2879
2880		! local variables for this subroutine
2881		real :: bflux_c ! capped bflux [Z2 T-3 ~> m2 s-3]
2882		real :: absf_c ! capped absf [T-1 ~> s-1]
2883		real :: root_b_f ! square root of (abs(B_flux) * Coriolis) [Z T-2 ~> m s-2]
2884		real :: f_u2 ! Coriolis X ustar^2 [Z2 T-3 ~> m2 s-3]
2885		real :: den ! denominator, units iof buuyancy flux [Z2 T-3 ~> m2 s-3]
2886		real :: root_B_by_Omega ! sqrt( B / Omega ) [Z T-1 ~> m s-1]
2887		real :: f_prime ! Coriolis divided by Earth's rotation [nondim]
2888		real :: omega_I ! Inverse of the Earth's rotation rate, 1 divided by omega [T ~> s]
2889
2890	0	if (B_flux <= CS%bflux_lower_cap) then
2891	0	bflux_c = CS%bflux_lower_cap
2892	0	elseif (B_flux >= CS%bflux_upper_cap) then
2893	0	bflux_c = CS%bflux_upper_cap
2894		else
2895	0	bflux_c = B_flux
2896		endif
2897
2898	0	if (absf <= CS%f_lower) then !
2899	0	absf_c = CS%f_lower ! 0.1 deg Latitude, cap avoids zero coriolis, solution insensitive below 0.1 deg.
2900		else
2901	0	absf_c = absf
2902		endif
2903
2904	0	f_u2 = absf_c * (u_star * u_star) ! pre-computing
2905
2906		! setting v0_dummy here:
2907		! \lambda = (1/ustar) \sqrt(bflux_c/absf_c)
2908
2909	0	if (bflux_c >= 0.0) then ! surface heating and neutral conditions
2910		! Equation 7 in Sane et al. 2025:
2911		! \frac{v_0}{u_*} = \frac{c_{7}}{\lambda + c_{8} + \frac{c_{9}^2}{\lambda + c_{9}} }
2912
2913	0	root_b_f = sqrt( bflux_c * absf_c)
2914		den = bflux_c + (CS%ML_c(8) + CS%ML_c(9)) * u_star * root_b_f + &
2915	0	(CS%ML_c(8) * CS%ML_c(9) + CS%ML_c(9)*2) f_u2
2916	0	v0_dummy = ( ( CS%ML_c(7)( (u_star root_b_f) + (CS%ML_c(9)f_u2) ) ) u_star) / den
2917
2918		else ! surface cooling
2919		! Equation 8 in Sane et al. 2025:
2920		! \frac{v_0}{u_*}=\frac{c_{10} \cdot \lambda \cdot \sqrt{f'} }{1 +
2921		! \frac{(c_{11} e^{(-c_{12} \cdot f')} + c_{13}) }{\lambda ^2} } + c_{14}
2922
2923	0	omega_I = 1.0 / CS%omega
2924	0	f_prime = absf_c * omega_I ! Coriolis divided by Earth's rotation
2925	0	root_B_by_Omega = sqrt( -bflux_c * omega_I )
2926	0	den = ( -bflux_c + CS%ML_c(11) * f_u2 * exp(-f_prime * CS%ML_c(12) ) ) + CS%ML_c(13)*f_u2
2927	0	v0_dummy = ( CS%ML_c(10) * (-bflux_c * root_B_by_Omega) / den ) + ( CS%ML_c(14) * u_star )
2928
2929		endif
2930
2931	0	v0_dummy = min( max(v0_dummy, CS%v0_lower_cap), CS%v0_upper_cap )
2932		! upper cap kept for safety, but has never hit this cap.
2933
2934		! v0_lower_cap has been set to 0.0001 as data below that values does not exist in the training
2935		! solution was tested for lower cap of 0.00001 and was found to be insensitive.
2936		! sensitivity arises when lower cap is 0.0. That is when diffusivity attains extremely low values and
2937		! they go near molecular diffusivity. Boundary layers might become "sub-grid" i.e. < 1 metre
2938		! some cause issues such as anomlous surface warming.
2939		! this needs further investigation, our choices are motivated by practicallity for now.
2940	0	end subroutine get_eqdisc_v0
2941
2942		!> Gives velocity scale (v_0^h) using equations that with using boundary layer depth as one of its inputs
2943		!! These equations are different than those set in get_eqdisc_v0 subroutine
2944	0	subroutine get_eqdisc_v0h(CS, B_flux, u_star, MLD_guess, v0_dummy)
2945		type(energetic_PBL_CS), intent(in) :: CS !< Energetic PBL control struct
2946		real, intent(in) :: B_flux !< The surface buoyancy flux [Z2 T-3 ~> m2 s-3]
2947		real, intent(in) :: u_star !< The surface friction velocity [Z T-1 ~> m s-1]
2948		real, intent(in) :: MLD_guess !< boundary layer depth guessed/found for iteration [Z ~> m]
2949
2950		real, intent(inout) :: v0_dummy !< velocity scale v0, local variable [Z T-1 ~> m s-1]
2951
2952		! local variables for this subroutine
2953		real :: bflux_c ! capped bflux [Z2 T-3 ~> m2 s-3]
2954		real :: B_h, den ! Surface buoyancy flux multiplied by boundary layer depth, den is a denominator [Z3 T-3 ~> m3 s-3]
2955		real :: B_h_power1by3 ! cuberoot of (Surface buoyancy flux multiplied by boundary layer depth) [Z T-1 ~> m s-1]
2956		real :: u_star_2 ! u_star squared, [Z2 T-2 ~> m2 s-2]
2957		real :: u_star_3 ! u_star cubed, [Z3 T-3 ~> m3 s-3]
2958
2959	0	u_star_2 = u_star * u_star ! pre-multiplying to get ustar ^ 2
2960	0	u_star_3 = u_star_2 * u_star ! ustar ^ 3.0
2961
2962	0	if (B_flux <= CS%bflux_lower_cap) then
2963	0	bflux_c = CS%bflux_lower_cap
2964	0	elseif (B_flux >= CS%bflux_upper_cap) then
2965	0	bflux_c = CS%bflux_upper_cap
2966		else
2967	0	bflux_c = B_flux
2968		endif
2969
2970	0	B_h = abs(bflux_c) * MLD_guess
2971	0	B_h_power1by3 = cuberoot(B_h)
2972
2973		! setting v0_dummy here:
2974
2975	0	if (bflux_c >= 0.0) then ! surface heating and neutral conditions
2976		! Equation 9 in Sane et al. 2025:
2977		! \frac{v_0^h}{u_*} = \frac{C_{14}}{ c_{15} L_h^3 + c_{16} L_h^2 + 1 }
2978
2979		den = ( CS%ML_c(15) * B_h + CS%ML_c(16)* u_star(B_h_power1by3B_h_power1by3)) &
2980	0	+ (u_star*u_star_2)
2981	0	v0_dummy = ( CS%ML_c(14) * (u_star_2 * u_star_2)) / den
2982
2983		else
2984		! Equation 10 in Sane et al. 2025:
2985		! \frac{v_0^h}{u_*} = \frac{L_h}{c_{17} + \frac{c_{18}}{L_h ^2}} + c_{14}
2986	0	den = CS%ML_c(17) * (B_h_power1by3B_h_power1by3) + CS%ML_c(18) u_star_2
2987	0	v0_dummy = (B_h / den ) + CS%ML_c(14) * u_star
2988		endif
2989
2990	0	v0_dummy = min( max(v0_dummy, CS%v0_lower_cap), CS%v0_upper_cap )
2991		! upper cap kept for safety, but has never hit this cap.
2992
2993		! v0_lower_cap has been set to 0.0001 as data below that values does not exist in the training
2994		! solution was tested for lower cap of 0.00001 and was found to be insensitive.
2995		! sensitivity arises when lower cap is 0.0. That is when diffusivity attains extremely low values and
2996		! they go near molecular diffusivity. Boundary layers might become "sub-grid" i.e. < 1 metre
2997		! some cause issues such as anomlous surface warming.
2998		! this needs further investigation, our choices are motivated by practicallity for now.
2999	0	end subroutine get_eqdisc_v0h
3000
3001		!> Determine a scaling factor that accounts for the exponential decay of turbulent kinetic energy
3002		!! from a boundary source and the assumption that an increase in the diffusivity at an interface
3003		!! causes a linearly increasing buoyancy flux going from 0 at the bottom to a peak at the interface,
3004		!! and then going back to 0 atop the layer above. Where this factor increases the available mixing
3005		!! TKE, it is only compensating for the fact that the TKE has already been reduced by the same
3006		!! exponential decay rate. ha and hb must be non-negative, and this function generally increases
3007		!! with hb and decreases with ha.
3008		!!
3009		!! Exp_decay_TKE_adjust is coded to have a lower bound of 1e-30 on the return value. For large
3010		!! values of haIdecay, the return value is about 0.5ka(ha+hb)Idecay*2 exp(-ha*Idecay), but
3011		!! return values of less than 1e-30 are deliberately reset to 1e-30. For relatively large values
3012		!! of hb*Idecay, the return value increases linearly with hb. When Idecay ~= 0, the return value
3013		!! is close to 1.
3014	0	function exp_decay_TKE_adjust(hb, ha, Idecay) result(TKE_to_PE_scale)
3015		real, intent(in) :: hb !< The thickness over which the buoyancy flux varies on the
3016		!! near-boundary side of an interface (e.g., a well-mixed bottom
3017		!! boundary layer thickness) [H ~> m or kg m-2]
3018		real, intent(in) :: ha !< The thickness of the layer on the opposite side of an interface from
3019		!! the boundary [H ~> m or kg m-2]
3020		real, intent(in) :: Idecay !< The inverse of a turbulence decay length scale [H-1 ~> m-1 or m2 kg-1]
3021		real :: TKE_to_PE_scale !< The effective fractional change in energy available to
3022		!! drive mixing at this interface once the exponential decay of TKE
3023		!! is accounted for [nondim]. TKE_to_PE_scale is always positive.
3024
3025		real :: khb ! The thickness on the boundary side times the TKE decay rate [nondim]
3026		real :: kha ! The thickness away from from the boundary times the TKE decay rate [nondim]
3027		real, parameter :: C1_3 = 1.0/3.0 ! A rational constant [nondim]
3028
3029	0	khb = abs(hb*Idecay)
3030	0	kha = abs(ha*Idecay)
3031
3032		! For large enough kha that exp(kha) > 1.0e17*kha:
3033		! TKE_to_PE_scale = (0.5 * (khb + kha) * kha) * exp(-kha) > (0.5 * kha*2) exp(-kha)
3034		! To keep TKE_to_PE_scale > -1e30 and avoid overflow in the exp(), keep kha < kha_max_30, where:
3035		! kha_max_30 = ln(0.51e30) + 2.0 ln(kha_max_30) ~= 68.3844 + 2.0 * ln(68.3844+8.6895))
3036		! If kha_max = 77.0739, (0.5 * kha_max*2) exp(-kha_max) = 1.0e-30.
3037
3038	0	if (kha > 77.0739) then
3039	0	TKE_to_PE_scale = 1.0e-30
3040	0	elseif ((kha > 2.2e-4) .and. (khb > 2.2e-4)) then
3041		! This is the usual case, derived from integrals of z exp(z) over the layers above and below.
3042		! TKE_to_PE_scale = (0.5 * (khb + kha)) / &
3043		! ((exp(-khb) - (1.0 - khb)) / khb + (exp(kha) - (1.0 + kha)) / kha)
3044		TKE_to_PE_scale = (0.5 * (khb + kha) * (kha * khb)) / &
3045	0	(kha * (exp(-khb) - (1.0 - khb)) + khb * (exp(kha) - (1.0 + kha)))
3046	0	elseif (khb > 2.2e-4) then
3047		! For small values of kha, approximate (exp(kha) - (1.0 + hha)) by the first two
3048		! terms of its Taylor series: 0.5kha2 + C1_6kha3 + ... + khan/n! + ...
3049		! which is more accurate when kha**4/24. < 1e-16 or kha < ~ 2.21e-4.
3050		TKE_to_PE_scale = (0.5 * (khb + kha) * khb) / &
3051	0	((exp(-khb) - (1.0 - khb)) + 0.5(khb kha) * (1.0 + C1_3*kha))
3052	0	elseif (kha > 2.2e-4) then
3053		! Use a Taylor series expansion for small values of khb
3054		TKE_to_PE_scale = (0.5 * (khb + kha) * kha) / &
3055	0	(0.5 * (kha * khb) * (1.0 - C1_3*Khb) + (exp(kha) - (1.0 + kha)))
3056		else ! (kha < 2.2e-4) .and. (khb < 2.2e-4) - use Taylor series approximations for both
3057	0	TKE_to_PE_scale = 1.0 / (1.0 + C1_3*(kha - khb))
3058		endif
3059
3060	0	if (TKE_to_PE_scale < 1.0e-30) TKE_to_PE_scale = 1.0e-30
3061
3062		! For kha >> 1:
3063		! TKE_to_PE_scale = (0.5 * (khb + kha) * kha) * exp(-kha)
3064
3065		! For khb >> 1:
3066		! TKE_to_PE_scale = (0.5 * (khb + kha) * (kha * khb)) / &
3067		! (khb * exp(kha) - (kha + khb)))
3068		! For khb >> 1 and khb >> kha:
3069		! TKE_to_PE_scale = (0.5 * (kha * khb)) / (exp(kha) - 1.0))
3070
3071	0	end function exp_decay_TKE_adjust
3072
3073		!> This subroutine calculates the change in potential energy and or derivatives
3074		!! for several changes in an interface's diapycnal diffusivity times a timestep.
3075	0	subroutine find_PE_chg(Kddt_h0, dKddt_h, hp_a, hp_b, Th_a, Sh_a, Th_b, Sh_b, &
3076		dT_to_dPE_a, dS_to_dPE_a, dT_to_dPE_b, dS_to_dPE_b, &
3077		pres_Z, dT_to_dColHt_a, dS_to_dColHt_a, dT_to_dColHt_b, dS_to_dColHt_b, &
3078		PE_chg, dPEc_dKd, dPE_max, dPEc_dKd_0, PE_ColHt_cor)
3079		real, intent(in) :: Kddt_h0 !< The previously used diffusivity at an interface times
3080		!! the time step and divided by the average of the
3081		!! thicknesses around the interface [H ~> m or kg m-2].
3082		real, intent(in) :: dKddt_h !< The trial change in the diffusivity at an interface times
3083		!! the time step and divided by the average of the
3084		!! thicknesses around the interface [H ~> m or kg m-2].
3085		real, intent(in) :: hp_a !< The effective pivot thickness of the layer above the
3086		!! interface, given by h_k plus a term that
3087		!! is a fraction (determined from the tridiagonal solver) of
3088		!! Kddt_h for the interface above [H ~> m or kg m-2].
3089		real, intent(in) :: hp_b !< The effective pivot thickness of the layer below the
3090		!! interface, given by h_k plus a term that
3091		!! is a fraction (determined from the tridiagonal solver) of
3092		!! Kddt_h for the interface below [H ~> m or kg m-2].
3093		real, intent(in) :: Th_a !< An effective temperature times a thickness in the layer
3094		!! above, including implicit mixing effects with other
3095		!! yet higher layers [C H ~> degC m or degC kg m-2].
3096		real, intent(in) :: Sh_a !< An effective salinity times a thickness in the layer
3097		!! above, including implicit mixing effects with other
3098		!! yet higher layers [S H ~> ppt m or ppt kg m-2].
3099		real, intent(in) :: Th_b !< An effective temperature times a thickness in the layer
3100		!! below, including implicit mixing effects with other
3101		!! yet lower layers [C H ~> degC m or degC kg m-2].
3102		real, intent(in) :: Sh_b !< An effective salinity times a thickness in the layer
3103		!! below, including implicit mixing effects with other
3104		!! yet lower layers [S H ~> ppt m or ppt kg m-2].
3105		real, intent(in) :: dT_to_dPE_a !< A factor (pres_laymass_laydSpec_vol/dT) relating
3106		!! a layer's temperature change to the change in column potential
3107		!! energy, including all implicit diffusive changes in the
3108		!! temperatures of all the layers above [R Z3 T-2 C-1 ~> J m-2 degC-1].
3109		real, intent(in) :: dS_to_dPE_a !< A factor (pres_laymass_laydSpec_vol/dS) relating
3110		!! a layer's salinity change to the change in column potential
3111		!! energy, including all implicit diffusive changes in the
3112		!! salinities of all the layers above [R Z3 T-2 S-1 ~> J m-2 ppt-1].
3113		real, intent(in) :: dT_to_dPE_b !< A factor (pres_laymass_laydSpec_vol/dT) relating
3114		!! a layer's temperature change to the change in column potential
3115		!! energy, including all implicit diffusive changes in the
3116		!! temperatures of all the layers below [R Z3 T-2 C-1 ~> J m-2 degC-1].
3117		real, intent(in) :: dS_to_dPE_b !< A factor (pres_laymass_laydSpec_vol/dS) relating
3118		!! a layer's salinity change to the change in column potential
3119		!! energy, including all implicit diffusive changes in the
3120		!! salinities of all the layers below [R Z3 T-2 S-1 ~> J m-2 ppt-1].
3121		real, intent(in) :: pres_Z !< The rescaled hydrostatic interface pressure, which relates
3122		!! the changes in column thickness to the energy that is radiated
3123		!! as gravity waves and unavailable to drive mixing [R Z2 T-2 ~> J m-3].
3124		real, intent(in) :: dT_to_dColHt_a !< A factor (mass_lay*dSColHtc_vol/dT) relating
3125		!! a layer's temperature change to the change in column
3126		!! height, including all implicit diffusive changes
3127		!! in the temperatures of all the layers above [Z C-1 ~> m degC-1].
3128		real, intent(in) :: dS_to_dColHt_a !< A factor (mass_lay*dSColHtc_vol/dS) relating
3129		!! a layer's salinity change to the change in column
3130		!! height, including all implicit diffusive changes
3131		!! in the salinities of all the layers above [Z S-1 ~> m ppt-1].
3132		real, intent(in) :: dT_to_dColHt_b !< A factor (mass_lay*dSColHtc_vol/dT) relating
3133		!! a layer's temperature change to the change in column
3134		!! height, including all implicit diffusive changes
3135		!! in the temperatures of all the layers below [Z C-1 ~> m degC-1].
3136		real, intent(in) :: dS_to_dColHt_b !< A factor (mass_lay*dSColHtc_vol/dS) relating
3137		!! a layer's salinity change to the change in column
3138		!! height, including all implicit diffusive changes
3139		!! in the salinities of all the layers below [Z S-1 ~> m ppt-1].
3140
3141		real, intent(out) :: PE_chg !< The change in column potential energy from applying
3142		!! dKddt_h at the present interface [R Z3 T-2 ~> J m-2].
3143		real, optional, intent(out) :: dPEc_dKd !< The partial derivative of PE_chg with dKddt_h
3144		!! [R Z3 T-2 H-1 ~> J m-3 or J kg-1].
3145		real, optional, intent(out) :: dPE_max !< The maximum change in column potential energy that could
3146		!! be realized by applying a huge value of dKddt_h at the
3147		!! present interface [R Z3 T-2 ~> J m-2].
3148		real, optional, intent(out) :: dPEc_dKd_0 !< The partial derivative of PE_chg with dKddt_h in the
3149		!! limit where dKddt_h = 0 [R Z3 T-2 H-1 ~> J m-3 or J kg-1].
3150		real, optional, intent(out) :: PE_ColHt_cor !< The correction to PE_chg that is made due to a net
3151		!! change in the column height [R Z3 T-2 ~> J m-2].
3152
3153		! Local variables
3154		real :: hps ! The sum of the two effective pivot thicknesses [H ~> m or kg m-2].
3155		real :: bdt1 ! A product of the two pivot thicknesses plus a diffusive term [H2 ~> m2 or kg2 m-4].
3156		real :: dT_c ! The core term in the expressions for the temperature changes [C H2 ~> degC m2 or degC kg2 m-4].
3157		real :: dS_c ! The core term in the expressions for the salinity changes [S H2 ~> ppt m2 or ppt kg2 m-4].
3158		real :: PEc_core ! The diffusivity-independent core term in the expressions
3159		! for the potential energy changes [R Z2 T-2 ~> J m-3].
3160		real :: ColHt_core ! The diffusivity-independent core term in the expressions
3161		! for the column height changes [H Z ~> m2 or kg m-1].
3162		real :: ColHt_chg ! The change in the column height [H ~> m or kg m-2].
3163		real :: y1_3 ! A local temporary term in [H-3 ~> m-3 or m6 kg-3].
3164		real :: y1_4 ! A local temporary term in [H-4 ~> m-4 or m8 kg-4].
3165
3166		! The expression for the change in potential energy used here is derived
3167		! from the expression for the final estimates of the changes in temperature
3168		! and salinities, and then extensively manipulated to get it into its most
3169		! succinct form. The derivation is not necessarily obvious, but it demonstrably
3170		! works by comparison with separate calculations of the energy changes after
3171		! the tridiagonal solver for the final changes in temperature and salinity are
3172		! applied.
3173
3174	0	hps = hp_a + hp_b
3175	0	bdt1 = hp_a * hp_b + Kddt_h0 * hps
3176	0	dT_c = hp_a * Th_b - hp_b * Th_a
3177	0	dS_c = hp_a * Sh_b - hp_b * Sh_a
3178		PEc_core = hp_b * (dT_to_dPE_a * dT_c + dS_to_dPE_a * dS_c) - &
3179	0	hp_a * (dT_to_dPE_b * dT_c + dS_to_dPE_b * dS_c)
3180		ColHt_core = hp_b * (dT_to_dColHt_a * dT_c + dS_to_dColHt_a * dS_c) - &
3181	0	hp_a * (dT_to_dColHt_b * dT_c + dS_to_dColHt_b * dS_c)
3182
3183		! Find the change in column potential energy due to the change in the
3184		! diffusivity at this interface by dKddt_h.
3185	0	y1_3 = dKddt_h / (bdt1 * (bdt1 + dKddt_h * hps))
3186	0	PE_chg = PEc_core * y1_3
3187	0	ColHt_chg = ColHt_core * y1_3
3188	0	if (ColHt_chg < 0.0) PE_chg = PE_chg - pres_Z * ColHt_chg
3189
3190	0	if (present(PE_ColHt_cor)) PE_ColHt_cor = -pres_Z * min(ColHt_chg, 0.0)
3191
3192	0	if (present(dPEc_dKd)) then
3193		! Find the derivative of the potential energy change with dKddt_h.
3194	0	y1_4 = 1.0 / (bdt1 + dKddt_h * hps)**2
3195	0	dPEc_dKd = PEc_core * y1_4
3196	0	ColHt_chg = ColHt_core * y1_4
3197	0	if (ColHt_chg < 0.0) dPEc_dKd = dPEc_dKd - pres_Z * ColHt_chg
3198		endif
3199
3200	0	if (present(dPE_max)) then
3201		! This expression is the limit of PE_chg for infinite dKddt_h.
3202	0	y1_3 = 1.0 / (bdt1 * hps)
3203	0	dPE_max = PEc_core * y1_3
3204	0	ColHt_chg = ColHt_core * y1_3
3205	0	if (ColHt_chg < 0.0) dPE_max = dPE_max - pres_Z * ColHt_chg
3206		endif
3207
3208	0	if (present(dPEc_dKd_0)) then
3209		! This expression is the limit of dPEc_dKd for dKddt_h = 0.
3210	0	y1_4 = 1.0 / bdt1**2
3211	0	dPEc_dKd_0 = PEc_core * y1_4
3212	0	ColHt_chg = ColHt_core * y1_4
3213	0	if (ColHt_chg < 0.0) dPEc_dKd_0 = dPEc_dKd_0 - pres_Z * ColHt_chg
3214		endif
3215
3216	0	end subroutine find_PE_chg
3217
3218
3219		!> This subroutine directly calculates the an increment in the diapycnal diffusivity based on the
3220		!! change in potential energy within a timestep, subject to bounds on the possible change in
3221		!! diffusivity, returning both the added diffusivity and the realized potential energy change, and
3222		!! optionally also the maximum change in potential energy that would be realized for an infinitely
3223		!! large diffusivity.
3224	0	subroutine find_Kd_from_PE_chg(Kd_prev, dKd_max, dt_h, max_PE_chg, hp_a, hp_b, Th_a, Sh_a, Th_b, Sh_b, &
3225		dT_to_dPE_a, dS_to_dPE_a, dT_to_dPE_b, dS_to_dPE_b, pres_Z, &
3226		dT_to_dColHt_a, dS_to_dColHt_a, dT_to_dColHt_b, dS_to_dColHt_b, &
3227		Kd_add, PE_chg, dPE_max, frac_dKd_max_PE)
3228		real, intent(in) :: Kd_prev !< The previously used diffusivity at an interface
3229		!! [H Z T-1 ~> m2 s-1 or kg m-1 s-1].
3230		real, intent(in) :: dKd_max !< The maximum change in the diffusivity at an interface
3231		!! [H Z T-1 ~> m2 s-1 or kg m-1 s-1].
3232		real, intent(in) :: dt_h !< The time step and divided by the average of the
3233		!! thicknesses around the interface [T Z-1 ~> s m-1].
3234		real, intent(in) :: max_PE_chg !< The maximum change in the column potential energy due to
3235		!! additional mixing at an interface [R Z3 T-2 ~> J m-2].
3236
3237		real, intent(in) :: hp_a !< The effective pivot thickness of the layer above the
3238		!! interface, given by h_k plus a term that
3239		!! is a fraction (determined from the tridiagonal solver) of
3240		!! Kddt_h for the interface above [H ~> m or kg m-2].
3241		real, intent(in) :: hp_b !< The effective pivot thickness of the layer below the
3242		!! interface, given by h_k plus a term that
3243		!! is a fraction (determined from the tridiagonal solver) of
3244		!! Kddt_h for the interface below [H ~> m or kg m-2].
3245		real, intent(in) :: Th_a !< An effective temperature times a thickness in the layer
3246		!! above, including implicit mixing effects with other
3247		!! yet higher layers [C H ~> degC m or degC kg m-2].
3248		real, intent(in) :: Sh_a !< An effective salinity times a thickness in the layer
3249		!! above, including implicit mixing effects with other
3250		!! yet higher layers [S H ~> ppt m or ppt kg m-2].
3251		real, intent(in) :: Th_b !< An effective temperature times a thickness in the layer
3252		!! below, including implicit mixing effects with other
3253		!! yet lower layers [C H ~> degC m or degC kg m-2].
3254		real, intent(in) :: Sh_b !< An effective salinity times a thickness in the layer
3255		!! below, including implicit mixing effects with other
3256		!! yet lower layers [S H ~> ppt m or ppt kg m-2].
3257		real, intent(in) :: dT_to_dPE_a !< A factor (pres_laymass_laydSpec_vol/dT) relating
3258		!! a layer's temperature change to the change in column potential
3259		!! energy, including all implicit diffusive changes in the
3260		!! temperatures of all the layers above [R Z3 T-2 C-1 ~> J m-2 degC-1].
3261		real, intent(in) :: dS_to_dPE_a !< A factor (pres_laymass_laydSpec_vol/dS) relating
3262		!! a layer's salinity change to the change in column potential
3263		!! energy, including all implicit diffusive changes in the
3264		!! salinities of all the layers above [R Z3 T-2 S-1 ~> J m-2 ppt-1].
3265		real, intent(in) :: dT_to_dPE_b !< A factor (pres_laymass_laydSpec_vol/dT) relating
3266		!! a layer's temperature change to the change in column potential
3267		!! energy, including all implicit diffusive changes in the
3268		!! temperatures of all the layers below [R Z3 T-2 C-1 ~> J m-2 degC-1].
3269		real, intent(in) :: dS_to_dPE_b !< A factor (pres_laymass_laydSpec_vol/dS) relating
3270		!! a layer's salinity change to the change in column potential
3271		!! energy, including all implicit diffusive changes in the
3272		!! salinities of all the layers below [R Z3 T-2 S-1 ~> J m-2 ppt-1].
3273		real, intent(in) :: pres_Z !< The rescaled hydrostatic interface pressure, which relates
3274		!! the changes in column thickness to the energy that is radiated
3275		!! as gravity waves and unavailable to drive mixing [R Z2 T-2 ~> J m-3].
3276		real, intent(in) :: dT_to_dColHt_a !< A factor (mass_lay*dSColHtc_vol/dT) relating
3277		!! a layer's temperature change to the change in column
3278		!! height, including all implicit diffusive changes
3279		!! in the temperatures of all the layers above [Z C-1 ~> m degC-1].
3280		real, intent(in) :: dS_to_dColHt_a !< A factor (mass_lay*dSColHtc_vol/dS) relating
3281		!! a layer's salinity change to the change in column
3282		!! height, including all implicit diffusive changes
3283		!! in the salinities of all the layers above [Z S-1 ~> m ppt-1].
3284		real, intent(in) :: dT_to_dColHt_b !< A factor (mass_lay*dSColHtc_vol/dT) relating
3285		!! a layer's temperature change to the change in column
3286		!! height, including all implicit diffusive changes
3287		!! in the temperatures of all the layers below [Z C-1 ~> m degC-1].
3288		real, intent(in) :: dS_to_dColHt_b !< A factor (mass_lay*dSColHtc_vol/dS) relating
3289		!! a layer's salinity change to the change in column
3290		!! height, including all implicit diffusive changes
3291		!! in the salinities of all the layers below [Z S-1 ~> m ppt-1].
3292		real, intent(out) :: Kd_add !< The additional diffusivity at an interface
3293		!! [H Z T-1 ~> m2 s-1 or kg m-1 s-1].
3294		real, intent(out) :: PE_chg !< The realized change in the column potential energy due to
3295		!! additional mixing at an interface [R Z3 T-2 ~> J m-2].
3296		real, optional, &
3297		intent(out) :: dPE_max !< The maximum change in column potential energy that could
3298		!! be realized by applying a huge value of dKddt_h at the
3299		!! present interface [R Z3 T-2 ~> J m-2].
3300		real, optional, &
3301		intent(out) :: frac_dKd_max_PE !< The fraction of the energy required to support dKd_max
3302		!! that is supplied by max_PE_chg [nondim]
3303
3304		! Local variables
3305		real :: Kddt_h0 ! The previously used diffusivity at an interface times the time step
3306		! and divided by the average of the thicknesses around the
3307		! interface [H ~> m or kg m-2].
3308		real :: dKddt_h ! The upper bound on the change in the diffusivity at an interface times
3309		! the time step and divided by the average of the thicknesses around
3310		! the interface [H ~> m or kg m-2].
3311		real :: hps ! The sum of the two effective pivot thicknesses [H ~> m or kg m-2].
3312		real :: bdt1 ! A product of the two pivot thicknesses plus a diffusive term [H2 ~> m2 or kg2 m-4].
3313		real :: dT_c ! The core term in the expressions for the temperature changes [C H2 ~> degC m2 or degC kg2 m-4].
3314		real :: dS_c ! The core term in the expressions for the salinity changes [S H2 ~> ppt m2 or ppt kg2 m-4].
3315		real :: PEc_core ! The diffusivity-independent core term in the expressions
3316		! for the potential energy changes [R Z2 T-2 ~> J m-3].
3317		real :: ColHt_core ! The diffusivity-independent core term in the expressions
3318		! for the column height changes [H Z ~> m2 or kg m-1].
3319
3320		! The expression for the change in potential energy used here is derived from the expression
3321		! for the final estimates of the changes in temperature and salinities, which is then
3322		! extensively manipulated to get it into its most succinct form. It is the same as the
3323		! expression that appears in find_PE_chg.
3324
3325	0	Kddt_h0 = Kd_prev * dt_h
3326	0	hps = hp_a + hp_b
3327	0	bdt1 = hp_a * hp_b + Kddt_h0 * hps
3328	0	dT_c = hp_a * Th_b - hp_b * Th_a
3329	0	dS_c = hp_a * Sh_b - hp_b * Sh_a
3330		PEc_core = hp_b * (dT_to_dPE_a * dT_c + dS_to_dPE_a * dS_c) - &
3331	0	hp_a * (dT_to_dPE_b * dT_c + dS_to_dPE_b * dS_c)
3332		ColHt_core = hp_b * (dT_to_dColHt_a * dT_c + dS_to_dColHt_a * dS_c) - &
3333	0	hp_a * (dT_to_dColHt_b * dT_c + dS_to_dColHt_b * dS_c)
3334	0	if (ColHt_core < 0.0) PEc_core = PEc_core - pres_Z * ColHt_core
3335
3336		! Find the change in column potential energy due to the change in the
3337		! diffusivity at this interface by dKd_max, and use this to dermine which limit applies.
3338	0	dKddt_h = dKd_max * dt_h
3339	0	if ( (PEc_core * dKddt_h <= max_PE_chg * (bdt1 * (bdt1 + dKddt_h * hps))) .or. (PEc_core <= 0.0) ) then
3340		! There is more than enough energy available to support the maximum permitted diffusivity.
3341	0	Kd_add = dKd_max
3342	0	PE_chg = PEc_core * dKddt_h / (bdt1 * (bdt1 + dKddt_h * hps))
3343	0	if (present(frac_dKd_max_PE)) frac_dKd_max_PE = 1.0
3344		else
3345		! Mixing is constrained by the available energy, so solve the following for Kd_add:
3346		! max_PE_chg = PEc_core * Kd_add * dt_h / (bdt1 * (bdt1 + Kd_add * dt_h * hps))
3347		! It has been verified that the two branches are continuous.
3348	0	Kd_add = (bdt1*2 max_PE_chg) / (dt_h * (PEc_core - bdt1 * hps * max_PE_chg))
3349	0	PE_chg = max_PE_chg
3350	0	if (present(frac_dKd_max_PE)) &
3351	0	frac_dKd_max_PE = (PE_chg * (bdt1 * (bdt1 + dKddt_h * hps))) / (PEc_core * dKddt_h)
3352		endif
3353
3354		! Note that the derivative of PE_chg with dKddt_h is monotonic:
3355		! dPE_chg_dKd = PEc_core * ( (bdt1 * (bdt1 + dKddt_h * hps)) - bdtl * hps * dKddt_h ) / &
3356		! (bdt1 * (bdt1 + dKddt_h * hps))**2
3357		! dPE_chg_dKd = PEc_core / (bdt1 + dKddt_h * hps)**2
3358
3359		! This expression is the limit of PE_chg for infinite dKddt_h.
3360	0	if (present(dPE_max)) dPE_max = PEc_core / (bdt1 * hps)
3361
3362	0	end subroutine find_Kd_from_PE_chg
3363
3364
3365		!> This subroutine calculates the change in potential energy and or derivatives
3366		!! for several changes in an interface's diapycnal diffusivity times a timestep
3367		!! using the original form used in the first version of ePBL.
3368	11262562	subroutine find_PE_chg_orig(Kddt_h, h_k, b_den_1, dTe_term, dSe_term, &
3369		dT_km1_t2, dS_km1_t2, dT_to_dPE_k, dS_to_dPE_k, &
3370		dT_to_dPEa, dS_to_dPEa, pres_Z, dT_to_dColHt_k, &
3371		dS_to_dColHt_k, dT_to_dColHta, dS_to_dColHta, PE_chg, &
3372		dPEc_dKd, dPE_max, dPEc_dKd_0)
3373		real, intent(in) :: Kddt_h !< The diffusivity at an interface times the time step and
3374		!! divided by the average of the thicknesses around the
3375		!! interface [H ~> m or kg m-2].
3376		real, intent(in) :: h_k !< The thickness of the layer below the interface [H ~> m or kg m-2].
3377		real, intent(in) :: b_den_1 !< The first term in the denominator of the pivot
3378		!! for the tridiagonal solver, given by h_k plus a term that
3379		!! is a fraction (determined from the tridiagonal solver) of
3380		!! Kddt_h for the interface above [H ~> m or kg m-2].
3381		real, intent(in) :: dTe_term !< A diffusivity-independent term related to the temperature change
3382		!! in the layer below the interface [C H ~> degC m or degC kg m-2].
3383		real, intent(in) :: dSe_term !< A diffusivity-independent term related to the salinity change
3384		!! in the layer below the interface [S H ~> ppt m or ppt kg m-2].
3385		real, intent(in) :: dT_km1_t2 !< A diffusivity-independent term related to the
3386		!! temperature change in the layer above the interface [C ~> degC].
3387		real, intent(in) :: dS_km1_t2 !< A diffusivity-independent term related to the
3388		!! salinity change in the layer above the interface [S ~> ppt].
3389		real, intent(in) :: pres_Z !< The rescaled hydrostatic interface pressure, which relates
3390		!! the changes in column thickness to the energy that is radiated
3391		!! as gravity waves and unavailable to drive mixing [R Z2 T-2 ~> J m-3].
3392		real, intent(in) :: dT_to_dPE_k !< A factor (pres_laymass_laydSpec_vol/dT) relating
3393		!! a layer's temperature change to the change in column potential
3394		!! energy, including all implicit diffusive changes in the
3395		!! temperatures of all the layers below [R Z3 T-2 C-1 ~> J m-2 degC-1].
3396		real, intent(in) :: dS_to_dPE_k !< A factor (pres_laymass_laydSpec_vol/dS) relating
3397		!! a layer's salinity change to the change in column potential
3398		!! energy, including all implicit diffusive changes in the
3399		!! in the salinities of all the layers below [R Z3 T-2 S-1 ~> J m-2 ppt-1].
3400		real, intent(in) :: dT_to_dPEa !< A factor (pres_laymass_laydSpec_vol/dT) relating
3401		!! a layer's temperature change to the change in column potential
3402		!! energy, including all implicit diffusive changes in the
3403		!! temperatures of all the layers above [R Z3 T-2 C-1 ~> J m-2 degC-1].
3404		real, intent(in) :: dS_to_dPEa !< A factor (pres_laymass_laydSpec_vol/dS) relating
3405		!! a layer's salinity change to the change in column potential
3406		!! energy, including all implicit diffusive changes in the
3407		!! salinities of all the layers above [R Z3 T-2 S-1 ~> J m-2 ppt-1].
3408		real, intent(in) :: dT_to_dColHt_k !< A factor (mass_lay*dSColHtc_vol/dT) relating
3409		!! a layer's temperature change to the change in column
3410		!! height, including all implicit diffusive changes in the
3411		!! temperatures of all the layers below [Z C-1 ~> m degC-1].
3412		real, intent(in) :: dS_to_dColHt_k !< A factor (mass_lay*dSColHtc_vol/dS) relating
3413		!! a layer's salinity change to the change in column
3414		!! height, including all implicit diffusive changes
3415		!! in the salinities of all the layers below [Z S-1 ~> m ppt-1].
3416		real, intent(in) :: dT_to_dColHta !< A factor (mass_lay*dSColHtc_vol/dT) relating
3417		!! a layer's temperature change to the change in column
3418		!! height, including all implicit diffusive changes
3419		!! in the temperatures of all the layers above [Z C-1 ~> m degC-1].
3420		real, intent(in) :: dS_to_dColHta !< A factor (mass_lay*dSColHtc_vol/dS) relating
3421		!! a layer's salinity change to the change in column
3422		!! height, including all implicit diffusive changes
3423		!! in the salinities of all the layers above [Z S-1 ~> m ppt-1].
3424
3425		real, intent(out) :: PE_chg !< The change in column potential energy from applying
3426		!! Kddt_h at the present interface [R Z3 T-2 ~> J m-2].
3427		real, optional, intent(out) :: dPEc_dKd !< The partial derivative of PE_chg with Kddt_h
3428		!! [R Z3 T-2 H-1 ~> J m-3 or J kg-1].
3429		real, optional, intent(out) :: dPE_max !< The maximum change in column potential energy that could
3430		!! be realized by applying a huge value of Kddt_h at the
3431		!! present interface [R Z3 T-2 ~> J m-2].
3432		real, optional, intent(out) :: dPEc_dKd_0 !< The partial derivative of PE_chg with Kddt_h in the
3433		!! limit where Kddt_h = 0 [R Z3 T-2 H-1 ~> J m-3 or J kg-1].
3434
3435		! This subroutine determines the total potential energy change due to mixing
3436		! at an interface, including all of the implicit effects of the prescribed
3437		! mixing at interfaces above. Everything here is derived by careful manipulation
3438		! of the robust tridiagonal solvers used for tracers by MOM6. The results are
3439		! positive for mixing in a stably stratified environment.
3440		! The comments describing these arguments are for a downward mixing pass, but
3441		! this routine can also be used for an upward pass with the sense of direction
3442		! reversed.
3443
3444		! Local variables
3445		real :: b1 ! b1 is used by the tridiagonal solver [H-1 ~> m-1 or m2 kg-1].
3446		real :: b1Kd ! Temporary array [nondim]
3447		real :: ColHt_chg ! The change in column thickness [Z ~> m].
3448		real :: dColHt_max ! The change in column thickness for infinite diffusivity [Z ~> m].
3449		real :: dColHt_dKd ! The partial derivative of column thickness with Kddt_h [Z H-1 ~> nondim or m3 kg-1]
3450		real :: dT_k, dT_km1 ! Temperature changes in layers k and k-1 [C ~> degC]
3451		real :: dS_k, dS_km1 ! Salinity changes in layers k and k-1 [S ~> ppt]
3452		real :: I_Kr_denom ! Temporary array [H-2 ~> m-2 or m4 kg-2]
3453		real :: dKr_dKd ! Temporary array [H-2 ~> m-2 or m4 kg-2]
3454		real :: ddT_k_dKd, ddT_km1_dKd ! Temporary arrays indicating the temperature changes
3455		! per unit change in Kddt_h [C H-1 ~> degC m-1 or degC m2 kg-1]
3456		real :: ddS_k_dKd, ddS_km1_dKd ! Temporary arrays indicating the salinity changes
3457		! per unit change in Kddt_h [S H-1 ~> ppt m-1 or ppt m2 kg-1]
3458
3459	11262562	b1 = 1.0 / (b_den_1 + Kddt_h)
3460	11262562	b1Kd = Kddt_h*b1
3461
3462		! Start with the temperature change in layer k-1 due to the diffusivity at
3463		! interface K without considering the effects of changes in layer k.
3464
3465		! Calculate the change in PE due to the diffusion at interface K
3466		! if Kddt_h(K+1) = 0.
3467	11262562	I_Kr_denom = 1.0 / (h_kb_den_1 + (b_den_1 + h_k)Kddt_h)
3468
3469	11262562	dT_k = (Kddt_hI_Kr_denom) dTe_term
3470	11262562	dS_k = (Kddt_hI_Kr_denom) dSe_term
3471
3472		! Find the change in energy due to diffusion with strength Kddt_h at this interface.
3473		! Increment the temperature changes in layer k-1 due the changes in layer k.
3474	11262562	dT_km1 = b1Kd * ( dT_k + dT_km1_t2 )
3475	11262562	dS_km1 = b1Kd * ( dS_k + dS_km1_t2 )
3476		PE_chg = (dT_to_dPE_k * dT_k + dT_to_dPEa * dT_km1) + &
3477	11262562	(dS_to_dPE_k * dS_k + dS_to_dPEa * dS_km1)
3478		ColHt_chg = (dT_to_dColHt_k * dT_k + dT_to_dColHta * dT_km1) + &
3479	11262562	(dS_to_dColHt_k * dS_k + dS_to_dColHta * dS_km1)
3480	11262562	if (ColHt_chg < 0.0) PE_chg = PE_chg - pres_Z * ColHt_chg
3481
3482	11262562	if (present(dPEc_dKd)) then
3483		! Find the derivatives of the temperature and salinity changes with Kddt_h.
3484	1777384	dKr_dKd = (h_kb_den_1) I_Kr_denom**2
3485
3486	1777384	ddT_k_dKd = dKr_dKd * dTe_term
3487	1777384	ddS_k_dKd = dKr_dKd * dSe_term
3488	1777384	ddT_km1_dKd = (b1*2 b_den_1) * ( dT_k + dT_km1_t2 ) + b1Kd * ddT_k_dKd
3489	1777384	ddS_km1_dKd = (b1*2 b_den_1) * ( dS_k + dS_km1_t2 ) + b1Kd * ddS_k_dKd
3490
3491		! Calculate the partial derivative of Pe_chg with Kddt_h.
3492		dPEc_dKd = (dT_to_dPE_k * ddT_k_dKd + dT_to_dPEa * ddT_km1_dKd) + &
3493	1777384	(dS_to_dPE_k * ddS_k_dKd + dS_to_dPEa * ddS_km1_dKd)
3494		dColHt_dKd = (dT_to_dColHt_k * ddT_k_dKd + dT_to_dColHta * ddT_km1_dKd) + &
3495	1777384	(dS_to_dColHt_k * ddS_k_dKd + dS_to_dColHta * ddS_km1_dKd)
3496	1777384	if (dColHt_dKd < 0.0) dPEc_dKd = dPEc_dKd - pres_Z * dColHt_dKd
3497		endif
3498
3499	11262562	if (present(dPE_max)) then
3500		! This expression is the limit of PE_chg for infinite Kddt_h.
3501		dPE_max = (dT_to_dPEa * dT_km1_t2 + dS_to_dPEa * dS_km1_t2) + &
3502		((dT_to_dPE_k + dT_to_dPEa) * dTe_term + &
3503	6179513	(dS_to_dPE_k + dS_to_dPEa) * dSe_term) / (b_den_1 + h_k)
3504		dColHt_max = (dT_to_dColHta * dT_km1_t2 + dS_to_dColHta * dS_km1_t2) + &
3505		((dT_to_dColHt_k + dT_to_dColHta) * dTe_term + &
3506	6179513	(dS_to_dColHt_k + dS_to_dColHta) * dSe_term) / (b_den_1 + h_k)
3507	6179513	if (dColHt_max < 0.0) dPE_max = dPE_max - pres_Z*dColHt_max
3508		endif
3509
3510	11262562	if (present(dPEc_dKd_0)) then
3511		! This expression is the limit of dPEc_dKd for Kddt_h = 0.
3512		dPEc_dKd_0 = (dT_to_dPEa * dT_km1_t2 + dS_to_dPEa * dS_km1_t2) / (b_den_1) + &
3513	6179513	(dT_to_dPE_k * dTe_term + dS_to_dPE_k * dSe_term) / (h_k*b_den_1)
3514		dColHt_dKd = (dT_to_dColHta * dT_km1_t2 + dS_to_dColHta * dS_km1_t2) / (b_den_1) + &
3515	6179513	(dT_to_dColHt_k * dTe_term + dS_to_dColHt_k * dSe_term) / (h_k*b_den_1)
3516	6179513	if (dColHt_dKd < 0.0) dPEc_dKd_0 = dPEc_dKd_0 - pres_Z*dColHt_dKd
3517		endif
3518
3519	11262562	end subroutine find_PE_chg_orig
3520
3521		!> This subroutine finds the mstar value for ePBL
3522	313463	subroutine find_mstar(CS, US, Buoyancy_Flux, UStar, &
3523		BLD, Abs_Coriolis, Is_BBL, mstar, &
3524		Langmuir_Number, mstar_LT, Convect_Langmuir_Number)
3525		type(energetic_PBL_CS), intent(in) :: CS !< Energetic PBL control structure
3526		type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type
3527		real, intent(in) :: UStar !< ustar including gustiness [Z T-1 ~> m s-1]
3528		real, intent(in) :: Abs_Coriolis !< absolute value of the Coriolis parameter [T-1 ~> s-1]
3529		real, intent(in) :: Buoyancy_Flux !< Buoyancy flux [Z2 T-3 ~> m2 s-3]
3530		real, intent(in) :: BLD !< boundary layer depth [Z ~> m]
3531		logical, intent(in) :: Is_BBL !< Logcal flag to indicate if bottom boundary layer mode
3532		real, intent(out) :: mstar !< Output mstar (Mixing/ustar**3) [nondim]
3533		real, optional, intent(in) :: Langmuir_Number !< Langmuir number [nondim]
3534		real, optional, intent(out) :: mstar_LT !< mstar increase due to Langmuir turbulence [nondim]
3535		real, optional, intent(out) :: Convect_Langmuir_number !< Langmuir number including buoyancy flux [nondim]
3536
3537		!/ Variables used in computing mstar
3538		real :: MSN_term ! Temporary terms [nondim]
3539		real :: MSCR_term1, MSCR_term2 ! Temporary terms [Z3 T-3 ~> m3 s-3]
3540		real :: mstar_Conv_Red ! Adjustment made to mstar due to convection reducing mechanical mixing [nondim]
3541		real :: mstar_S, mstar_N ! mstar in (S)tabilizing/(N)ot-stabilizing buoyancy flux [nondim]
3542		integer :: mstar_scheme ! Toggles between surface and bottom boundary layer mstar scheme from control structure
3543
3544		!/ Integer options for how to find mstar
3545
3546		!/
3547
3548	313463	if (Is_BBL) then
3549	0	mstar_scheme = CS%BBL_mstar_scheme
3550		else
3551	313463	mstar_scheme = CS%mstar_scheme
3552		endif
3553
3554	313463	if (mstar_scheme == Use_Fixed_mstar) then
3555	0	if (Is_BBL) then
3556	0	mstar = CS%BBL_Fixed_mstar
3557		else
3558	0	mstar = CS%Fixed_mstar
3559		endif
3560		!/ 1. Get mstar
3561	313463	elseif (mstar_scheme == mstar_from_Ekman) then
3562
3563	313463	if (CS%answer_date < 20190101) then
3564		! The limit for the balance of rotation and stabilizing is f(L_Ekman,L_Obukhov)
3565		mstar_S = CS%mstar_coefsqrt(max(0.0,Buoyancy_Flux) / UStar*2 / &
3566	0	(Abs_Coriolis + 1.e-10*US%T_to_s) )
3567		! The limit for rotation (Ekman length) limited mixing
3568	0	mstar_N = CS%C_Ek * log( max( 1., UStar / (Abs_Coriolis + 1.e-10*US%T_to_s) / BLD ) )
3569		else
3570		! The limit for the balance of rotation and stabilizing is f(L_Ekman,L_Obukhov)
3571	313463	mstar_S = CS%mstar_coefsqrt(max(0.0, Buoyancy_Flux) / (UStar2 max(Abs_Coriolis, 1.e-20*US%T_to_s)))
3572		! The limit for rotation (Ekman length) limited mixing
3573	313463	mstar_N = 0.0
3574	313463	if (UStar > Abs_Coriolis * BLD) mstar_N = CS%C_Ek * log(UStar / (Abs_Coriolis * BLD))
3575		endif
3576
3577		! Here 1.25 is about .5/von Karman, which gives the Obukhov limit.
3578	313463	mstar = max(mstar_S, min(1.25, mstar_N))
3579	313463	if (CS%mstar_Cap > 0.0) mstar = min( CS%mstar_Cap,mstar )
3580	0	elseif ( mstar_scheme == mstar_from_RH18 ) then
3581	0	if (CS%answer_date < 20190101) then
3582		mstar_N = CS%RH18_mstar_cn1 * ( 1.0 - 1.0 / ( 1. + CS%RH18_mstar_cn2 * &
3583	0	exp( CS%RH18_mstar_CN3 * BLD * Abs_Coriolis / UStar) ) )
3584		else
3585	0	MSN_term = CS%RH18_mstar_cn2 * exp( CS%RH18_mstar_CN3 * BLD * Abs_Coriolis / UStar)
3586	0	mstar_N = (CS%RH18_mstar_cn1 * MSN_term) / ( 1. + MSN_term)
3587		endif
3588		mstar_S = CS%RH18_mstar_CS1 * ( max(0.0, Buoyancy_Flux)*2 BLD / &
3589	0	( UStar*5 max(Abs_Coriolis,1.e-20US%T_to_s) ) )*CS%RH18_mstar_cs2
3590	0	mstar = mstar_N + mstar_S
3591		endif
3592
3593		!/ 2. Adjust mstar to account for convective turbulence
3594	313463	if (CS%answer_date < 20190101) then
3595		mstar_Conv_Red = 1. - CS%mstar_Convect_coef * (-min(0.0,Buoyancy_Flux) + 1.e-10US%T_to_s3US%m_to_Z**2) / &
3596		( (-min(0.0,Buoyancy_Flux) + 1.e-10US%T_to_s3US%m_to_Z**2) + &
3597	0	2.0 mstar UStar**3 / BLD )
3598		else
3599	313463	MSCR_term1 = -BLD * min(0.0, Buoyancy_Flux)
3600	313463	MSCR_term2 = 2.0mstar UStar**3
3601	313463	if ( abs(MSCR_term2) > 0.0) then
3602	192037	mstar_Conv_Red = ((1.-CS%mstar_convect_coef) * MSCR_term1 + MSCR_term2) / (MSCR_term1 + MSCR_term2)
3603		else
3604	121426	mstar_Conv_Red = 1.-CS%mstar_convect_coef
3605		endif
3606		endif
3607
3608		!/3. Combine various mstar terms to get final value
3609	313463	mstar = mstar * mstar_Conv_Red
3610
3611	313463	if ((.not.Is_BBL) .and. (present(Langmuir_Number))) then
3612		call mstar_Langmuir(CS, US, Abs_Coriolis, Buoyancy_Flux, UStar, BLD, Langmuir_Number, mstar, &
3613	313463	mstar_LT, Convect_Langmuir_Number)
3614		endif
3615
3616	313463	end subroutine Find_mstar
3617
3618		!> This subroutine modifies the mstar value if the Langmuir number is present
3619	313463	subroutine mstar_Langmuir(CS, US, Abs_Coriolis, Buoyancy_Flux, UStar, BLD, Langmuir_Number, &
3620		mstar, mstar_LT, Convect_Langmuir_Number)
3621		type(energetic_PBL_CS), intent(in) :: CS !< Energetic PBL control structure
3622		type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type
3623		real, intent(in) :: Abs_Coriolis !< Absolute value of the Coriolis parameter [T-1 ~> s-1]
3624		real, intent(in) :: Buoyancy_Flux !< Buoyancy flux [Z2 T-3 ~> m2 s-3]
3625		real, intent(in) :: UStar !< Surface friction velocity with? gustiness [Z T-1 ~> m s-1]
3626		real, intent(in) :: BLD !< boundary layer depth [Z ~> m]
3627		real, intent(inout) :: mstar !< Input/output mstar (Mixing/ustar**3) [nondim]
3628		real, intent(in) :: Langmuir_Number !< Langmuir number [nondim]
3629		real, intent(out) :: mstar_LT !< mstar increase due to Langmuir turbulence [nondim]
3630		real, intent(out) :: Convect_Langmuir_number !< Langmuir number including buoyancy flux [nondim]
3631
3632		!/
3633		real, parameter :: Max_ratio = 1.0e16 ! The maximum value of a nondimensional ratio [nondim].
3634		real :: enhance_mstar ! A multiplicative scaling of mstar due to Langmuir turbulence [nondim].
3635		real :: mstar_LT_add ! A value that is added to mstar due to Langmuir turbulence [nondim].
3636		real :: iL_Ekman ! Inverse of Ekman length scale [Z-1 ~> m-1].
3637		real :: iL_Obukhov ! Inverse of Obukhov length scale [Z-1 ~> m-1].
3638		real :: I_ustar ! The Adcroft reciprocal of ustar [T Z-1 ~> s m-1]
3639		real :: I_f ! The Adcroft reciprocal of the Coriolis parameter [T ~> s]
3640		real :: MLD_Ekman ! The ratio of the mixed layer depth to the Ekman layer depth [nondim].
3641		real :: Ekman_Obukhov ! The Ekman layer thickness divided by the Obukhov depth [nondim].
3642		real :: MLD_Obukhov ! The mixed layer depth divided by the Obukhov depth [nondim].
3643		real :: MLD_Obukhov_stab ! The mixed layer depth divided by the Obukhov depth under stable
3644		! conditions or 0 under unstable conditions [nondim].
3645		real :: Ekman_Obukhov_stab ! The Ekman layer thickness divided by the Obukhov depth under stable
3646		! conditions or 0 under unstable conditions [nondim].
3647		real :: MLD_Obukhov_un ! The mixed layer depth divided by the Obukhov depth under unstable
3648		! conditions or 0 under stable conditions [nondim].
3649		real :: Ekman_Obukhov_un ! The Ekman layer thickness divided by the Obukhov depth under unstable
3650		! conditions or 0 under stable conditions [nondim].
3651
3652		! Set default values for no Langmuir effects.
3653	313463	enhance_mstar = 1.0 ; mstar_LT_add = 0.0
3654
3655	313463	if (CS%LT_enhance_form /= No_Langmuir) then
3656		! a. Get parameters for modified LA
3657	313463	if (CS%answer_date < 20190101) then
3658	0	iL_Ekman = Abs_Coriolis / Ustar
3659	0	iL_Obukhov = Buoyancy_FluxCS%vonkar / Ustar*3
3660	0	Ekman_Obukhov_stab = abs(max(0., iL_Obukhov / (iL_Ekman + 1.e-10*US%Z_to_m)))
3661	0	Ekman_Obukhov_un = abs(min(0., iL_Obukhov / (iL_Ekman + 1.e-10*US%Z_to_m)))
3662	0	MLD_Obukhov_stab = abs(max(0., BLD*iL_Obukhov))
3663	0	MLD_Obukhov_un = abs(min(0., BLD*iL_Obukhov))
3664	0	MLD_Ekman = abs( BLD*iL_Ekman )
3665		else
3666	313463	Ekman_Obukhov = Max_ratio ; MLD_Obukhov = Max_ratio ; MLD_Ekman = Max_ratio
3667	313463	I_f = 0.0 ; if (abs(abs_Coriolis) > 0.0) I_f = 1.0 / abs_Coriolis
3668	313463	I_ustar = 0.0 ; if (abs(Ustar) > 0.0) I_ustar = 1.0 / Ustar
3669	313463	if (abs(Buoyancy_FluxCS%vonkar) < Max_ratio(abs_Coriolis * Ustar**2)) &
3670	313463	Ekman_Obukhov = abs(Buoyancy_FluxCS%vonkar) (I_f * I_Ustar**2)
3671	313463	if (abs(BLDBuoyancy_FluxCS%vonkar) < Max_ratioUstar*3) &
3672	313463	MLD_Obukhov = abs(BLDBuoyancy_FluxCS%vonkar) * I_Ustar**3
3673	313463	if (BLDAbs_Coriolis < Max_ratioUstar) &
3674	313463	MLD_Ekman = BLDAbs_Coriolis I_Ustar
3675
3676	313463	if (Buoyancy_Flux > 0.0) then
3677	41837	Ekman_Obukhov_stab = Ekman_Obukhov ; Ekman_Obukhov_un = 0.0
3678	41837	MLD_Obukhov_stab = MLD_Obukhov ; MLD_Obukhov_un = 0.0
3679		else
3680	271626	Ekman_Obukhov_un = Ekman_Obukhov ; Ekman_Obukhov_stab = 0.0
3681	271626	MLD_Obukhov_un = MLD_Obukhov ; MLD_Obukhov_stab = 0.0
3682		endif
3683		endif
3684
3685		! b. Adjust LA based on various parameters.
3686		! Assumes linear factors based on length scale ratios to adjust LA
3687		! Note when these coefficients are set to 0 recovers simple LA.
3688		Convect_Langmuir_Number = Langmuir_Number * &
3689		( (1.0 + max(-0.5, CS%LaC_MLD_Ek * MLD_Ekman)) + &
3690		((CS%LaC_Ek_Ob_stab * Ekman_Obukhov_stab + CS%LaC_Ek_Ob_un * Ekman_Obukhov_un) + &
3691	313463	(CS%LaC_MLD_Ob_stab * MLD_Obukhov_stab + CS%LaC_MLD_Ob_un * MLD_Obukhov_un)) )
3692
3693	313463	if (CS%LT_enhance_form == Langmuir_rescale) then
3694		! Enhancement is multiplied (added mst_lt set to 0)
3695		Enhance_mstar = min(CS%Max_Enhance_M, &
3696	0	(1. + CS%LT_enhance_coef * Convect_Langmuir_Number**CS%LT_enhance_exp) )
3697	313463	elseif (CS%LT_enhance_form == Langmuir_add) then
3698		! or Enhancement is additive (multiplied enhance_m set to 1)
3699	313463	mstar_LT_add = CS%LT_enhance_coef * Convect_Langmuir_Number**CS%LT_enhance_exp
3700		endif
3701		endif
3702
3703	313463	mstar_LT = (enhance_mstar - 1.0)*mstar + mstar_LT_add ! Diagnose the full increase in mstar.
3704	313463	mstar = mstar*enhance_mstar + mstar_LT_add
3705
3706	313463	end subroutine mstar_Langmuir
3707
3708
3709		!> Copies the ePBL active mixed layer depth into MLD, in units of [Z ~> m] unless other units are specified.
3710	12	subroutine energetic_PBL_get_MLD(CS, MLD, G, US, m_to_MLD_units)
3711		type(energetic_PBL_CS), intent(in) :: CS !< Energetic PBL control structure
3712		type(ocean_grid_type), intent(in) :: G !< Grid structure
3713		type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type
3714		real, dimension(SZI_(G),SZJ_(G)), intent(out) :: MLD !< Depth of ePBL active mixing layer [Z ~> m]
3715		!! or other units
3716		real, optional, intent(in) :: m_to_MLD_units !< A conversion factor from meters
3717		!! to the desired units for MLD, sometimes [Z m-1 ~> 1]
3718		! Local variables
3719		real :: scale ! A dimensional rescaling factor, often [nondim] or [m Z-1 ~> 1]
3720		integer :: i, j
3721
3722	12	scale = 1.0 ; if (present(m_to_MLD_units)) scale = US%Z_to_m * m_to_MLD_units
3723
3724	87132	do j=G%jsc,G%jec ; do i=G%isc,G%iec
3725	87120	MLD(i,j) = scale*CS%ML_depth(i,j)
3726		enddo ; enddo
3727
3728	12	end subroutine energetic_PBL_get_MLD
3729
3730
3731		!> This subroutine initializes the energetic_PBL module
3732	1	subroutine energetic_PBL_init(Time, G, GV, US, param_file, diag, CS)
3733		type(time_type), target, intent(in) :: Time !< The current model time
3734		type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure
3735		type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure
3736		type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type
3737		type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters
3738		type(diag_ctrl), target, intent(inout) :: diag !< A structure that is used to regulate diagnostic output
3739		type(energetic_PBL_CS), intent(inout) :: CS !< Energetic PBL control structure
3740
3741		! Local variables
3742		! This include declares and sets the variable "version".
3743		# include "version_variable.h"
3744		character(len=40) :: mdl = "MOM_energetic_PBL" ! This module's name.
3745		character(len=20) :: tmpstr ! A string that is parsed for parameter settings
3746		character(len=20) :: mstar_scheme ! A string that is parsed for mstar parameter settings
3747		character(len=20) :: vel_scale_str ! A string that is parsed for velocity scale parameter settings
3748		character(len=120) :: diff_text ! A clause describing parameter setting that differ.
3749		real :: omega_frac_dflt ! The default for omega_frac [nondim]
3750		integer :: isd, ied, jsd, jed
3751		integer :: mstar_mode, LT_enhance, wT_mode
3752		integer :: default_answer_date ! The default setting for the various ANSWER_DATE flags.
3753		logical :: enable_bugs ! If true, the defaults for recently added bug-fix flags are set to
3754		! recreate the bugs, or if false bugs are only used if actively selected.
3755		logical :: use_omega
3756		logical :: no_BBL ! If true, EPBL_BBL_EFFIC < 0 and EPBL_BBL_TIDAL_EFFIC < 0, so
3757		! bottom boundary layer mixing is not enabled.
3758		logical :: use_la_windsea
3759	1	isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed
3760
3761	1	CS%initialized = .true.
3762	1	CS%diag => diag
3763	1	CS%Time => Time
3764
3765		! Set default, read and log parameters
3766	1	call log_version(param_file, mdl, version, "")
3767
3768
3769		!/1. General ePBL settings
3770		call get_param(param_file, mdl, "DEBUG", CS%debug, &
3771		"If true, write out verbose debugging data.", &
3772	1	default=.false., debuggingParam=.true.)
3773		call get_param(param_file, mdl, "OMEGA", CS%omega, &
3774		"The rotation rate of the earth.", &
3775	1	units="s-1", default=7.2921e-5, scale=US%T_to_S)
3776		call get_param(param_file, mdl, "ML_USE_OMEGA", use_omega, &
3777		"If true, use the absolute rotation rate instead of the "//&
3778		"vertical component of rotation when setting the decay "//&
3779	1	"scale for turbulence.", default=.false., do_not_log=.true.)
3780	1	omega_frac_dflt = 0.0
3781	1	if (use_omega) then
3782	0	call MOM_error(WARNING, "ML_USE_OMEGA is deprecated; use ML_OMEGA_FRAC=1.0 instead.")
3783	0	omega_frac_dflt = 1.0
3784		endif
3785		call get_param(param_file, mdl, "ML_OMEGA_FRAC", CS%omega_frac, &
3786		"When setting the decay scale for turbulence, use this "//&
3787		"fraction of the absolute rotation rate blended with the "//&
3788		"local value of f, as sqrt((1-of)f^2 + of4*omega^2).", &
3789	1	units="nondim", default=omega_frac_dflt)
3790		call get_param(param_file, mdl, "EKMAN_SCALE_COEF", CS%Ekman_scale_coef, &
3791		"A nondimensional scaling factor controlling the inhibition "//&
3792		"of the diffusive length scale by rotation. Making this larger "//&
3793	1	"decreases the PBL diffusivity.", units="nondim", default=1.0)
3794		call get_param(param_file, mdl, 'VON_KARMAN_CONST', CS%vonKar, &
3795		'The value the von Karman constant as used for mixed layer viscosity.', &
3796	1	units='nondim', default=0.41)
3797		call get_param(param_file, mdl, "DEFAULT_ANSWER_DATE", default_answer_date, &
3798		"This sets the default value for the various _ANSWER_DATE parameters.", &
3799	1	default=99991231)
3800		call get_param(param_file, mdl, "EPBL_ANSWER_DATE", CS%answer_date, &
3801		"The vintage of the order of arithmetic and expressions in the energetic "//&
3802		"PBL calculations. Values below 20190101 recover the answers from the "//&
3803		"end of 2018, while higher values use updated and more robust forms of the "//&
3804		"same expressions. Values below 20240101 use A**(1./3.) to estimate the cube "//&
3805		"root of A in several expressions, while higher values use the integer root "//&
3806		"function cuberoot(A) and therefore can work with scaled variables.", &
3807	1	default=default_answer_date, do_not_log=.not.GV%Boussinesq)
3808	1	if (.not.GV%Boussinesq) CS%answer_date = max(CS%answer_date, 20230701)
3809
3810		call get_param(param_file, mdl, "EPBL_ORIGINAL_PE_CALC", CS%orig_PE_calc, &
3811		"If true, the ePBL code uses the original form of the potential energy change "//&
3812		"code. Otherwise, the newer version that can work with successive increments "//&
3813		"to the diffusivity in upward or downward passes is used.", &
3814	1	default=.true.) ! Change the default to .false.?
3815
3816		call get_param(param_file, mdl, "MKE_TO_TKE_EFFIC", CS%MKE_to_TKE_effic, &
3817		"The efficiency with which mean kinetic energy released "//&
3818		"by mechanically forced entrainment of the mixed layer "//&
3819		"is converted to turbulent kinetic energy.", &
3820	1	units="nondim", default=0.0, scale=US%L_to_Z**2)
3821		call get_param(param_file, mdl, "TKE_DECAY", CS%TKE_decay, &
3822		"TKE_DECAY relates the vertical rate of decay of the TKE available "//&
3823		"for mechanical entrainment to the natural Ekman depth.", &
3824	1	units="nondim", default=2.5)
3825		call get_param(param_file, mdl, "DIRECT_EPBL_MIXING_CALC", CS%direct_calc, &
3826		"If true and there is no conversion from mean kinetic energy to ePBL turbulent "//&
3827		"kinetic energy, use a direct calculation of the diffusivity that is supported "//&
3828		"by a given energy input instead of the more general but slower iterative solver.", &
3829	1	default=.false., do_not_log=(CS%MKE_to_TKE_effic>0.0))
3830
3831
3832		!/2. Options related to setting mstar
3833
3834		call get_param(param_file, mdl, "EPBL_MSTAR_SCHEME", mstar_scheme, &
3835		"EPBL_MSTAR_SCHEME selects the method for setting mstar. Valid values are: \n"//&
3836		"\t CONSTANT - Use a fixed mstar given by MSTAR \n"//&
3837		"\t OM4 - Use L_Ekman/L_Obukhov in the stabilizing limit, as in OM4 \n"//&
3838		"\t REICHL_H18 - Use the scheme documented in Reichl & Hallberg, 2018.", &
3839	1	default=CONSTANT_STRING, do_not_log=.true.)
3840	1	call get_param(param_file, mdl, "MSTAR_MODE", mstar_mode, default=-1)
3841	1	if (mstar_mode == 0) then
3842	0	mstar_scheme = CONSTANT_STRING
3843	0	call MOM_error(WARNING, "Use EPBL_MSTAR_SCHEME = CONSTANT instead of the archaic MSTAR_MODE = 0.")
3844	1	elseif (mstar_mode == 1) then
3845		call MOM_error(FATAL, "You are using a legacy mstar mode in ePBL that has been phased out. "//&
3846		"If you need to use this setting please report this error. Also use "//&
3847	0	"EPBL_MSTAR_SCHEME to specify the scheme for mstar.")
3848	1	elseif (mstar_mode == 2) then
3849	0	mstar_scheme = OM4_STRING
3850	0	call MOM_error(WARNING, "Use EPBL_MSTAR_SCHEME = OM4 instead of the archaic MSTAR_MODE = 2.")
3851	1	elseif (mstar_mode == 3) then
3852	0	mstar_scheme = RH18_STRING
3853	0	call MOM_error(WARNING, "Use EPBL_MSTAR_SCHEME = REICHL_H18 instead of the archaic MSTAR_MODE = 3.")
3854	1	elseif (mstar_mode > 3) then
3855	0	call MOM_error(FATAL, "An unrecognized value of the obsolete parameter MSTAR_MODE was specified.")
3856		endif
3857		call log_param(param_file, mdl, "EPBL_MSTAR_SCHEME", mstar_scheme, &
3858		"EPBL_MSTAR_SCHEME selects the method for setting mstar. Valid values are: \n"//&
3859		"\t CONSTANT - Use a fixed mstar given by MSTAR \n"//&
3860		"\t OM4 - Use L_Ekman/L_Obukhov in the stabilizing limit, as in OM4 \n"//&
3861		"\t REICHL_H18 - Use the scheme documented in Reichl & Hallberg, 2018.", &
3862	1	default=CONSTANT_STRING)
3863	1	mstar_scheme = uppercase(mstar_scheme)
3864	0	select case (mstar_scheme)
3865		case (CONSTANT_STRING)
3866	0	CS%mstar_scheme = Use_Fixed_mstar
3867		case (OM4_STRING)
3868	1	CS%mstar_scheme = mstar_from_Ekman
3869		case (RH18_STRING)
3870	0	CS%mstar_scheme = mstar_from_RH18
3871		case default
3872	0	call MOM_mesg('energetic_PBL_init: EPBL_MSTAR_SCHEME ="'//trim(mstar_scheme)//'"', 0)
3873		call MOM_error(FATAL, "energetic_PBL_init: Unrecognized setting "// &
3874	1	"EPBL_MSTAR_SCHEME = "//trim(mstar_scheme)//" found in input file.")
3875		end select
3876		call get_param(param_file, mdl, "MSTAR", CS%fixed_mstar, &
3877		"The ratio of the friction velocity cubed to the TKE input to the "//&
3878		"surface boundary layer. This option is used if EPBL_MSTAR_SCHEME = CONSTANT.", &
3879	1	units="nondim", default=1.2, do_not_log=(CS%mstar_scheme/=Use_Fixed_mstar))
3880
3881		call get_param(param_file, mdl, "MSTAR_CAP", CS%mstar_cap, &
3882		"If this value is positive, it sets the maximum value of mstar "//&
3883		"allowed in ePBL. (This is not used if EPBL_mstar_scheme = CONSTANT).", &
3884	1	units="nondim", default=-1.0, do_not_log=(CS%mstar_scheme==Use_Fixed_mstar))
3885		! mstar_scheme==mstar_from_Ekman options
3886		call get_param(param_file, mdl, "MSTAR2_COEF1", CS%mstar_coef, &
3887		"Coefficient in computing mstar when rotation and stabilizing "//&
3888		"effects are both important (used if EPBL_mstar_scheme = OM4).", &
3889	1	units="nondim", default=0.3, do_not_log=(CS%mstar_scheme/=mstar_from_Ekman))
3890		call get_param(param_file, mdl, "MSTAR2_COEF2", CS%C_Ek, &
3891		"Coefficient in computing mstar when only rotation limits "// &
3892		"the total mixing (used if EPBL_MSTAR_SCHEME = OM4)", &
3893	1	units="nondim", default=0.085, do_not_log=(CS%mstar_scheme/=mstar_from_Ekman))
3894		! mstar_scheme==mstar_from_RH18 options
3895		call get_param(param_file, mdl, "RH18_MSTAR_CN1", CS%RH18_mstar_cn1,&
3896		"MSTAR_N coefficient 1 (outer-most coefficient for fit). "//&
3897		"The value of 0.275 is given in RH18. Increasing this "//&
3898		"coefficient increases mstar for all values of Hf/ust, but more "//&
3899		"effectively at low values (weakly developed OSBLs).", &
3900	1	units="nondim", default=0.275, do_not_log=(CS%mstar_scheme/=mstar_from_RH18))
3901		call get_param(param_file, mdl, "RH18_MSTAR_CN2", CS%RH18_mstar_cn2,&
3902		"MSTAR_N coefficient 2 (coefficient outside of exponential decay). "//&
3903		"The value of 8.0 is given in RH18. Increasing this coefficient "//&
3904		"increases mstar for all values of HF/ust, with a much more even "//&
3905		"effect across a wide range of Hf/ust than CN1.", &
3906	1	units="nondim", default=8.0, do_not_log=(CS%mstar_scheme/=mstar_from_RH18))
3907		call get_param(param_file, mdl, "RH18_MSTAR_CN3", CS%RH18_mstar_CN3,&
3908		"MSTAR_N coefficient 3 (exponential decay coefficient). "//&
3909		"The value of -5.0 is given in RH18. Increasing this increases how "//&
3910		"quickly the value of mstar decreases as Hf/ust increases.", &
3911	1	units="nondim", default=-5.0, do_not_log=(CS%mstar_scheme/=mstar_from_RH18))
3912		call get_param(param_file, mdl, "RH18_MSTAR_CS1", CS%RH18_mstar_cs1,&
3913		"MSTAR_S coefficient for RH18 in stabilizing limit. "//&
3914		"The value of 0.2 is given in RH18 and increasing it increases "//&
3915		"mstar in the presence of a stabilizing surface buoyancy flux.", &
3916	1	units="nondim", default=0.2, do_not_log=(CS%mstar_scheme/=mstar_from_RH18))
3917		call get_param(param_file, mdl, "RH18_MSTAR_CS2", CS%RH18_mstar_cs2,&
3918		"MSTAR_S exponent for RH18 in stabilizing limit. "//&
3919		"The value of 0.4 is given in RH18 and increasing it increases mstar "//&
3920		"exponentially in the presence of a stabilizing surface buoyancy flux.", &
3921	1	Units="nondim", default=0.4, do_not_log=(CS%mstar_scheme/=mstar_from_RH18))
3922		!/ BBL mstar related options
3923		call get_param(param_file, mdl, "EPBL_BBL_USE_MSTAR", CS%ePBL_BBL_use_mstar, &
3924		"A logical to use mstar in the calculation of TKE in the ePBL BBL scheme", &
3925	1	units="nondim", default=.false.)
3926	1	if (CS%ePBL_BBL_use_mstar) then
3927		call get_param(param_file, mdl, "EPBL_BBL_MSTAR_SCHEME", tmpstr, &
3928		"EPBL_BBL_MSTAR_SCHEME selects the method for setting mstar in the BBL. Valid values are: \n"//&
3929		"\t CONSTANT - Use a fixed mstar given by MSTAR_BBL \n"//&
3930		"\t OM4 - Use L_Ekman/L_Obukhov in the stabilizing limit, as in OM4 \n"//&
3931		"\t REICHL_H18 - Use the scheme documented in Reichl & Hallberg, 2018.", &
3932	0	default=mstar_scheme)
3933	0	tmpstr = uppercase(tmpstr)
3934	0	select case (tmpstr)
3935		case (CONSTANT_STRING)
3936	0	CS%BBL_mstar_scheme = Use_Fixed_mstar
3937		case (OM4_STRING)
3938	0	CS%BBL_mstar_scheme = mstar_from_Ekman
3939		case (RH18_STRING)
3940	0	CS%BBL_mstar_scheme = mstar_from_RH18
3941		case default
3942	0	call MOM_mesg('energetic_PBL_init: EPBL_BBL_MSTAR_SCHEME ="'//trim(tmpstr)//'"', 0)
3943		call MOM_error(FATAL, "energetic_PBL_init: Unrecognized setting "// &
3944	0	"EPBL_BBL_MSTAR_SCHEME = "//trim(tmpstr)//" found in input file.")
3945		end select
3946		call get_param(param_file, mdl, "MSTAR_BBL", CS%BBL_fixed_mstar, &
3947		"The ratio of the friction velocity cubed to the TKE input to the "//&
3948		"bottom boundary layer. This option is used if EPBL_BBL_MSTAR_SCHEME = CONSTANT.", &
3949	0	units="nondim", default=1.2, do_not_log=(CS%BBL_mstar_scheme/=Use_Fixed_mstar))
3950		endif
3951
3952		!/ Convective turbulence related options
3953		call get_param(param_file, mdl, "NSTAR", CS%nstar, &
3954		"The portion of the buoyant potential energy imparted by "//&
3955		"surface fluxes that is available to drive entrainment "//&
3956		"at the base of mixed layer when that energy is positive.", &
3957	1	units="nondim", default=0.2)
3958		call get_param(param_file, mdl, "MSTAR_CONV_ADJ", CS%mstar_convect_coef, &
3959		"Coefficient used for reducing mstar during convection "//&
3960		"due to reduction of stable density gradient.", &
3961	1	units="nondim", default=0.0)
3962
3963		!/ Mixing Length Options
3964		call get_param(param_file, mdl, "USE_MLD_ITERATION", CS%Use_MLD_iteration, &
3965		"A logical that specifies whether or not to use the "//&
3966		"distance to the bottom of the actively turbulent boundary "//&
3967	1	"layer to help set the EPBL length scale.", default=.true.)
3968		call get_param(param_file, mdl, "EPBL_TRANSITION_SCALE", CS%transLay_scale, &
3969		"A scale for the mixing length in the transition layer "//&
3970		"at the edge of the boundary layer as a fraction of the "//&
3971	1	"boundary layer thickness.", units="nondim", default=0.1)
3972	1	if ( CS%Use_MLD_iteration .and. abs(CS%transLay_scale-0.5) >= 0.5) then
3973		call MOM_error(FATAL, "If flag USE_MLD_ITERATION is true, then "//&
3974	0	"EPBL_TRANSITION should be greater than 0 and less than 1.")
3975		endif
3976
3977		call get_param(param_file, mdl, "MLD_ITERATION_GUESS", CS%MLD_ITERATION_GUESS, &
3978		"If true, use the previous timestep MLD as a first guess in the MLD iteration, "//&
3979		"otherwise use half the ocean depth as the first guess of the boundary layer "//&
3980		"depth. The default is false to facilitate reproducibility.", &
3981	1	default=.false., do_not_log=.not.CS%Use_MLD_iteration)
3982		call get_param(param_file, mdl, "EPBL_MLD_TOLERANCE", CS%MLD_tol, &
3983		"The tolerance for the iteratively determined mixed "//&
3984		"layer depth. This is only used with USE_MLD_ITERATION.", &
3985	1	units="meter", default=1.0, scale=US%m_to_Z, do_not_log=.not.CS%Use_MLD_iteration)
3986		call get_param(param_file, mdl, "EPBL_MLD_BISECTION", CS%MLD_bisection, &
3987		"If true, use bisection with the iterative determination of the self-consistent "//&
3988		"mixed layer depth. Otherwise use the false position after a maximum and minimum "//&
3989		"bound have been evaluated and the returned value or bisection before this.", &
3990	1	default=.false., do_not_log=.not.CS%Use_MLD_iteration)
3991		call get_param(param_file, mdl, "ENABLE_BUGS_BY_DEFAULT", enable_bugs, &
3992	1	default=.true., do_not_log=.true.) ! This is logged from MOM.F90.
3993		call get_param(param_file, mdl, "EPBL_MLD_ITER_BUG", CS%MLD_iter_bug, &
3994		"If true, use buggy logic that gives the wrong bounds for the next iteration "//&
3995		"when successive guesses increase by exactly EPBL_MLD_TOLERANCE.", &
3996	1	default=enable_bugs, do_not_log=.not.CS%Use_MLD_iteration)
3997		call get_param(param_file, mdl, "EPBL_MLD_MAX_ITS", CS%max_MLD_its, &
3998		"The maximum number of iterations that can be used to find a self-consistent "//&
3999		"mixed layer depth. If EPBL_MLD_BISECTION is true, the maximum number "//&
4000		"of iterations needed is set by Depth/2^MAX_ITS < EPBL_MLD_TOLERANCE.", &
4001	1	default=20, do_not_log=.not.CS%Use_MLD_iteration)
4002	1	if (.not.CS%Use_MLD_iteration) CS%Max_MLD_Its = 1
4003		call get_param(param_file, mdl, "EPBL_MIN_MIX_LEN", CS%min_mix_len, &
4004		"The minimum mixing length scale that will be used "//&
4005		"by ePBL. The default (0) does not set a minimum.", &
4006	1	units="meter", default=0.0, scale=US%m_to_Z)
4007
4008		call get_param(param_file, mdl, "MIX_LEN_EXPONENT", CS%MixLenExponent, &
4009		"The exponent applied to the ratio of the distance to the MLD "//&
4010		"and the MLD depth which determines the shape of the mixing length. "//&
4011		"This is only used if USE_MLD_ITERATION is True.", &
4012	1	units="nondim", default=2.0)
4013
4014		!/ Turbulent velocity scale in mixing coefficient
4015		call get_param(param_file, mdl, "EPBL_VEL_SCALE_SCHEME", vel_scale_str, &
4016		"Selects the method for translating TKE into turbulent velocities. "//&
4017		"Valid values are: \n"//&
4018		"\t CUBE_ROOT_TKE - A constant times the cube root of remaining TKE. \n"//&
4019		"\t REICHL_H18 - Use the scheme based on a combination of w* and v* as \n"//&
4020		"\t documented in Reichl & Hallberg, 2018.", &
4021	1	default=ROOT_TKE_STRING, do_not_log=.true.)
4022	1	call get_param(param_file, mdl, "EPBL_VEL_SCALE_MODE", wT_mode, default=-1)
4023	1	if (wT_mode == 0) then
4024	0	vel_scale_str = ROOT_TKE_STRING
4025	0	call MOM_error(WARNING, "Use EPBL_VEL_SCALE_SCHEME = CUBE_ROOT_TKE instead of the archaic EPBL_VEL_SCALE_MODE = 0.")
4026	1	elseif (wT_mode == 1) then
4027	0	vel_scale_str = RH18_STRING
4028	0	call MOM_error(WARNING, "Use EPBL_VEL_SCALE_SCHEME = REICHL_H18 instead of the archaic EPBL_VEL_SCALE_MODE = 1.")
4029	1	elseif (wT_mode >= 2) then
4030	0	call MOM_error(FATAL, "An unrecognized value of the obsolete parameter EPBL_VEL_SCALE_MODE was specified.")
4031		endif
4032		call log_param(param_file, mdl, "EPBL_VEL_SCALE_SCHEME", vel_scale_str, &
4033		"Selects the method for translating TKE into turbulent velocities. "//&
4034		"Valid values are: \n"//&
4035		"\t CUBE_ROOT_TKE - A constant times the cube root of remaining TKE. \n"//&
4036		"\t REICHL_H18 - Use the scheme based on a combination of w* and v* as \n"//&
4037		"\t documented in Reichl & Hallberg, 2018.", &
4038	1	default=ROOT_TKE_STRING)
4039	1	vel_scale_str = uppercase(vel_scale_str)
4040	1	select case (vel_scale_str)
4041		case (ROOT_TKE_STRING)
4042	1	CS%wT_scheme = wT_from_cRoot_TKE
4043		case (RH18_STRING)
4044	0	CS%wT_scheme = wT_from_RH18
4045		case default
4046	0	call MOM_mesg('energetic_PBL_init: EPBL_VEL_SCALE_SCHEME ="'//trim(vel_scale_str)//'"', 0)
4047		call MOM_error(FATAL, "energetic_PBL_init: Unrecognized setting "// &
4048	1	"EPBL_VEL_SCALE_SCHEME = "//trim(vel_scale_str)//" found in input file.")
4049		end select
4050
4051		call get_param(param_file, mdl, "WSTAR_USTAR_COEF", CS%wstar_ustar_coef, &
4052		"A ratio relating the efficiency with which convectively "//&
4053		"released energy is converted to a turbulent velocity, "//&
4054		"relative to mechanically forced TKE. Making this larger "//&
4055	1	"increases the BL diffusivity", units="nondim", default=1.0)
4056		call get_param(param_file, mdl, "EPBL_VEL_SCALE_FACTOR", CS%vstar_scale_fac, &
4057		"An overall nondimensional scaling factor for wT. "//&
4058		"Making this larger increases the PBL diffusivity.", &
4059	1	units="nondim", default=1.0)
4060		call get_param(param_file, mdl, "VSTAR_SURF_FAC", CS%vstar_surf_fac,&
4061		"The proportionality times ustar to set vstar at the surface.", &
4062	1	units="nondim", default=1.2)
4063
4064		!/ Bottom boundary layer mixing related options
4065		call get_param(param_file, mdl, "EPBL_BBL_EFFIC", CS%ePBL_BBL_effic, &
4066		"The efficiency of bottom boundary layer mixing via ePBL. Setting this to a "//&
4067		"value that is greater than 0 to enable bottom boundary layer mixing from EPBL.", &
4068	1	units="nondim", default=0.0, scale=US%L_to_Z**2)
4069		call get_param(param_file, mdl, "EPBL_BBL_TIDAL_EFFIC", CS%ePBL_tidal_effic, &
4070		"The efficiency of bottom boundary layer mixing via ePBL driven by the "//&
4071		"bottom drag dissipation of tides, as provided in fluxes%BBL_tidal_dis.", &
4072	1	units="nondim", default=0.0, scale=US%L_to_Z**2) !### Change the default to follow EPBL_BBL_EFFIC?
4073	1	no_BBL = ((CS%ePBL_BBL_effic <= 0.0) .and. (CS%ePBL_tidal_effic <= 0.0))
4074
4075		call get_param(param_file, mdl, "USE_BBLD_ITERATION", CS%Use_BBLD_iteration, &
4076		"A logical that specifies whether or not to use the distance to the top of the "//&
4077		"actively turbulent bottom boundary layer to help set the EPBL length scale.", &
4078	1	default=.true., do_not_log=no_BBL)
4079		call get_param(param_file, mdl, "TKE_DECAY_BBL", CS%TKE_decay_BBL, &
4080		"TKE_DECAY_BBL relates the vertical rate of decay of the TKE available for "//&
4081		"mechanical entrainment in the bottom boundary layer to the natural Ekman depth.", &
4082	1	units="nondim", default=CS%TKE_decay, do_not_log=no_BBL)
4083		call get_param(param_file, mdl, "MIX_LEN_EXPONENT_BBL", CS%MixLenExponent_BBL, &
4084		"The exponent applied to the ratio of the distance to the top of the BBL "//&
4085		"and the total BBL depth which determines the shape of the mixing length. "//&
4086		"This is only used if USE_MLD_ITERATION is True.", &
4087	1	units="nondim", default=2.0, do_not_log=(no_BBL.or.(.not.CS%Use_BBLD_iteration)))
4088		call get_param(param_file, mdl, "EPBL_MIN_BBL_MIX_LEN", CS%min_BBL_mix_len, &
4089		"The minimum mixing length scale that will be used by ePBL for bottom boundary "//&
4090		"layer mixing. Choosing (0) does not set a minimum.", &
4091	1	units="meter", default=CS%min_mix_len, scale=US%m_to_Z, do_not_log=no_BBL)
4092		call get_param(param_file, mdl, "EPBL_BBLD_TOLERANCE", CS%BBLD_tol, &
4093		"The tolerance for the iteratively determined bottom boundary layer depth. "//&
4094		"This is only used with USE_MLD_ITERATION.", &
4095		units="meter", default=US%Z_to_m*CS%MLD_tol, scale=US%m_to_Z, &
4096	1	do_not_log=(no_BBL.or.(.not.CS%Use_MLD_iteration)))
4097		call get_param(param_file, mdl, "EPBL_BBLD_MAX_ITS", CS%max_BBLD_its, &
4098		"The maximum number of iterations that can be used to find a self-consistent "//&
4099		"bottom boundary layer depth.", &
4100	1	default=CS%max_MLD_its, do_not_log=(no_BBL.or.(.not.CS%Use_MLD_iteration)))
4101	1	if (.not.CS%Use_MLD_iteration) CS%max_BBLD_its = 1
4102
4103		call get_param(param_file, mdl, "EPBL_BBL_VEL_SCALE_SCHEME", tmpstr, &
4104		"Selects the method for translating bottom boundary layer TKE into turbulent velocities. "//&
4105		"Valid values are: \n"//&
4106		"\t CUBE_ROOT_TKE - A constant times the cube root of remaining BBL TKE. \n"//&
4107		"\t REICHL_H18 - Use the scheme based on a combination of w* and v* as \n"//&
4108		"\t documented in Reichl & Hallberg, 2018.", &
4109	1	default=vel_scale_str, do_not_log=no_BBL)
4110	1	select case (tmpstr)
4111		case (ROOT_TKE_STRING)
4112	1	CS%wT_scheme_BBL = wT_from_cRoot_TKE
4113		case (RH18_STRING)
4114	0	CS%wT_scheme_BBL = wT_from_RH18
4115		case default
4116	0	call MOM_mesg('energetic_PBL_init: EPBL_BBL_VEL_SCALE_SCHEME ="'//trim(tmpstr)//'"', 0)
4117		call MOM_error(FATAL, "energetic_PBL_init: Unrecognized setting "// &
4118	1	"EPBL_BBL_VEL_SCALE_SCHEME = "//trim(tmpstr)//" found in input file.")
4119		end select
4120		call get_param(param_file, mdl, "EPBL_BBL_VEL_SCALE_FACTOR", CS%vstar_scale_fac_BBL, &
4121		"An overall nondimensional scaling factor for wT in the bottom boundary layer. "//&
4122		"Making this larger increases the bottom boundary layer diffusivity.", &
4123	1	units="nondim", default=CS%vstar_scale_fac, do_not_log=no_BBL)
4124		call get_param(param_file, mdl, "VSTAR_BBL_SURF_FAC", CS%vstar_surf_fac_BBL,&
4125		"The proportionality times ustar to set vstar in the bottom boundary layer.", &
4126	1	units="nondim", default=CS%vstar_surf_fac, do_not_log=(no_BBL.or.(CS%wT_scheme_BBL/=wT_from_RH18)))
4127		call get_param(param_file, mdl, "EKMAN_SCALE_COEF_BBL", CS%Ekman_scale_coef_BBL, &
4128		"A nondimensional scaling factor controlling the inhibition of the diffusive "//&
4129		"length scale by rotation in the bottom boundary layer. Making this larger "//&
4130		"decreases the bottom boundary layer diffusivity.", &
4131	1	units="nondim", default=CS%Ekman_scale_coef, do_not_log=no_BBL)
4132		call get_param(param_file, mdl, "EPBL_BBL_EFFIC_BUG", CS%BBL_effic_bug, &
4133		"If true, overestimate the efficiency of the non-tidal ePBL bottom boundary "//&
4134		"layer diffusivity by a factor of 1/sqrt(CDRAG), which is often a factor of "//&
4135	1	"about 18.3.", default=.false., do_not_log=(CS%ePBL_BBL_effic<=0.0))
4136
4137		call get_param(param_file, mdl, "DECAY_ADJUSTED_BBL_TKE", CS%decay_adjusted_BBL_TKE, &
4138		"If true, include an adjustment factor in the bottom boundary layer energetics "//&
4139		"that accounts for an exponential decay of TKE from a near-bottom source and "//&
4140		"an assumed piecewise linear profile of the buoyancy flux response to a change "//&
4141		"in a diffusivity.", &
4142	1	default=.false., do_not_log=no_BBL)
4143
4144		!/ Options related to Langmuir turbulence
4145		call get_param(param_file, mdl, "USE_LA_LI2016", use_LA_Windsea, &
4146		"A logical to use the Li et al. 2016 (submitted) formula to "//&
4147	1	"determine the Langmuir number.", default=.false.)
4148		! Note this can be activated in other ways, but this preserves the old method.
4149	1	if (use_LA_windsea) then
4150	1	CS%use_LT = .true.
4151		else
4152		call get_param(param_file, mdl, "EPBL_LT", CS%use_LT, &
4153	0	"A logical to use a LT parameterization.", default=.false.)
4154		endif
4155	1	if (CS%use_LT) then
4156		call get_param(param_file, mdl, "EPBL_LANGMUIR_SCHEME", tmpstr, &
4157		"EPBL_LANGMUIR_SCHEME selects the method for including Langmuir turbulence. "//&
4158		"Valid values are: \n"//&
4159		"\t NONE - Do not do any extra mixing due to Langmuir turbulence \n"//&
4160		"\t RESCALE - Use a multiplicative rescaling of mstar to account for Langmuir turbulence \n"//&
4161		"\t ADDITIVE - Add a Langmuir turbulence contribution to mstar to other contributions", &
4162	1	default=NONE_STRING, do_not_log=.true.)
4163	1	call get_param(param_file, mdl, "LT_ENHANCE", LT_enhance, default=-1)
4164	1	if (LT_enhance == 0) then
4165	0	tmpstr = NONE_STRING
4166	0	call MOM_error(WARNING, "Use EPBL_LANGMUIR_SCHEME = NONE instead of the archaic LT_ENHANCE = 0.")
4167	1	elseif (LT_enhance == 1) then
4168		call MOM_error(FATAL, "You are using a legacy LT_ENHANCE mode in ePBL that has been phased out. "//&
4169		"If you need to use this setting please report this error. Also use "//&
4170	0	"EPBL_LANGMUIR_SCHEME to specify the scheme for mstar.")
4171	1	elseif (LT_enhance == 2) then
4172	0	tmpstr = RESCALED_STRING
4173	0	call MOM_error(WARNING, "Use EPBL_LANGMUIR_SCHEME = RESCALE instead of the archaic LT_ENHANCE = 2.")
4174	1	elseif (LT_enhance == 3) then
4175	0	tmpstr = ADDITIVE_STRING
4176	0	call MOM_error(WARNING, "Use EPBL_LANGMUIR_SCHEME = ADDITIVE instead of the archaic LT_ENHANCE = 3.")
4177	1	elseif (LT_enhance > 3) then
4178	0	call MOM_error(FATAL, "An unrecognized value of the obsolete parameter LT_ENHANCE was specified.")
4179		endif
4180		call log_param(param_file, mdl, "EPBL_LANGMUIR_SCHEME", tmpstr, &
4181		"EPBL_LANGMUIR_SCHEME selects the method for including Langmuir turbulence. "//&
4182		"Valid values are: \n"//&
4183		"\t NONE - Do not do any extra mixing due to Langmuir turbulence \n"//&
4184		"\t RESCALE - Use a multiplicative rescaling of mstar to account for Langmuir turbulence \n"//&
4185		"\t ADDITIVE - Add a Langmuir turbulence contribution to mstar to other contributions", &
4186	1	default=NONE_STRING)
4187	1	tmpstr = uppercase(tmpstr)
4188	0	select case (tmpstr)
4189		case (NONE_STRING)
4190	0	CS%LT_enhance_form = No_Langmuir
4191		case (RESCALED_STRING)
4192	0	CS%LT_enhance_form = Langmuir_rescale
4193		case (ADDITIVE_STRING)
4194	1	CS%LT_enhance_form = Langmuir_add
4195		case default
4196	0	call MOM_mesg('energetic_PBL_init: EPBL_LANGMUIR_SCHEME ="'//trim(tmpstr)//'"', 0)
4197		call MOM_error(FATAL, "energetic_PBL_init: Unrecognized setting "// &
4198	1	"EPBL_LANGMUIR_SCHEME = "//trim(tmpstr)//" found in input file.")
4199		end select
4200
4201		call get_param(param_file, mdl, "LT_ENHANCE_COEF", CS%LT_enhance_coef, &
4202		"Coefficient for Langmuir enhancement of mstar", &
4203	1	units="nondim", default=0.447, do_not_log=(CS%LT_enhance_form==No_Langmuir))
4204		call get_param(param_file, mdl, "LT_ENHANCE_EXP", CS%LT_enhance_exp, &
4205		"Exponent for Langmuir enhancement of mstar", &
4206	1	units="nondim", default=-1.33, do_not_log=(CS%LT_enhance_form==No_Langmuir))
4207		call get_param(param_file, mdl, "LT_MOD_LAC1", CS%LaC_MLD_Ek, &
4208		"Coefficient for modification of Langmuir number due to "//&
4209		"MLD approaching Ekman depth.", &
4210	1	units="nondim", default=-0.87, do_not_log=(CS%LT_enhance_form==No_Langmuir))
4211		call get_param(param_file, mdl, "LT_MOD_LAC2", CS%LaC_MLD_Ob_stab, &
4212		"Coefficient for modification of Langmuir number due to "//&
4213		"MLD approaching stable Obukhov depth.", &
4214	1	units="nondim", default=0.0, do_not_log=(CS%LT_enhance_form==No_Langmuir))
4215		call get_param(param_file, mdl, "LT_MOD_LAC3", CS%LaC_MLD_Ob_un, &
4216		"Coefficient for modification of Langmuir number due to "//&
4217		"MLD approaching unstable Obukhov depth.", &
4218	1	units="nondim", default=0.0, do_not_log=(CS%LT_enhance_form==No_Langmuir))
4219		call get_param(param_file, mdl, "LT_MOD_LAC4", CS%Lac_Ek_Ob_stab, &
4220		"Coefficient for modification of Langmuir number due to "//&
4221		"ratio of Ekman to stable Obukhov depth.", &
4222	1	units="nondim", default=0.95, do_not_log=(CS%LT_enhance_form==No_Langmuir))
4223		call get_param(param_file, mdl, "LT_MOD_LAC5", CS%Lac_Ek_Ob_un, &
4224		"Coefficient for modification of Langmuir number due to "//&
4225		"ratio of Ekman to unstable Obukhov depth.", &
4226	1	units="nondim", default=0.95, do_not_log=(CS%LT_enhance_form==No_Langmuir))
4227		endif
4228
4229		!/Options related to Machine Learning Equation Discovery
4230		! Logial flags for using shape function from equation discovery - machine learning
4231		! EPBL_EQD_DIFFUSIVITY : EPBL + Equation Discovery Diffusivity parameters
4232
4233		call get_param(param_file, mdl, "EPBL_EQD_DIFFUSIVITY_SHAPE", CS%eqdisc, &
4234		"Logical flag for activating ML equation for shape function "// &
4235		"that uses forcing to change its structure.", &
4236	1	units="nondim", default=.false.)
4237
4238		call get_param(param_file, mdl, "EPBL_EQD_DIFFUSIVITY_VELOCITY", CS%eqdisc_v0, &
4239		"Logical flag for activating ML equation discovery for velocity scale", &
4240	1	units="nondim", default=.false.)
4241
4242		call get_param(param_file, mdl, "EPBL_EQD_DIFFUSIVITY_VELOCITY_H", CS%eqdisc_v0h, &
4243		"Logical flag for activating ML equation discovery for velocity scale with h as input", &
4244	1	units="nondim", default=.false.)
4245
4246
4247		! sets a lower cap for abs_f (Coriolis parameter) required in equation for v_0.
4248		! Small value, solution not sensitive below 1 deg Latitute
4249		! Default value of 2.5384E-07 corresponds to 0.1 deg.
4250		call get_param(param_file, mdl, "EPBL_EQD_DIFFUSIVITY_CORIOLIS_LOWER_CAP", CS%f_lower, &
4251		"value of lower limit cap for v0, default is for 0.1 deg, insensitive below 1deg", &
4252		units="s-1", default=2.5384E-07, scale=US%T_to_S, &
4253	1	do_not_log=.not.CS%eqdisc_v0)
4254
4255		call get_param(param_file, mdl, "EPBL_EQD_DIFFUSIVITY_V0_LOWER_CAP", CS%v0_lower_cap, &
4256		"value of lower limit cap for Coriolis in v0", &
4257		units="m s-1", default=0.0001, scale=US%m_to_Z*US%T_to_s, &
4258	1	do_not_log=.not.(CS%eqdisc_v0.or.CS%eqdisc_v0h))
4259
4260		call get_param(param_file, mdl, "EPBL_EQD_DIFFUSIVITY_V0_UPPER_CAP", CS%v0_upper_cap, &
4261		"value of upper limit cap for Coriolis in v0", &
4262		units="m s-1", default=0.1, scale=US%m_to_Z*US%T_to_s, &
4263	1	do_not_log=.not.(CS%eqdisc_v0.or.CS%eqdisc_v0h))
4264
4265		call get_param(param_file, mdl, "EPBL_EQD_DIFFUSIVITY_BFLUX_LOWER_CAP", CS%bflux_lower_cap, &
4266		"value of lower limit cap for Bflux used in setting in v0", &
4267		units="m2 s-3", default=-7.0E-07, scale=(US%m_to_L*2)(US%T_to_s**3), &
4268	1	do_not_log=.not.(CS%eqdisc_v0.or.CS%eqdisc_v0h))
4269
4270		call get_param(param_file, mdl, "EPBL_EQD_DIFFUSIVITY_BFLUX_UPPER_CAP", CS%bflux_upper_cap, &
4271		"value of upper limit cap for Bflux used in setting in v0", &
4272		units="m2 s-3", default=7.0E-07, scale=(US%m_to_L*2)(US%T_to_s**3), &
4273	1	do_not_log=.not.(CS%eqdisc_v0.or.CS%eqdisc_v0h))
4274
4275		call get_param(param_file, mdl, "EPBL_EQD_DIFFUSIVITY_SIGMA_MAX_LOWER_CAP", CS%sigma_max_lower_cap, &
4276		"value of lower limit cap for sigma coordinate of maximum for diffusivity", &
4277	1	units="nondim", default=0.1, do_not_log=.not.CS%eqdisc)
4278
4279		call get_param(param_file, mdl, "EPBL_EQD_DIFFUSIVITY_SIGMA_MAX_UPPER_CAP", CS%sigma_max_upper_cap, &
4280		"value of upper limit cap for sigma coordinate of maximum for diffusivity", &
4281	1	units="nondim", default=0.7, do_not_log=.not.CS%eqdisc)
4282
4283		call get_param(param_file, mdl, "EPBL_EQD_DIFFUSIVITY_EH_UPPER_CAP", CS%Eh_upper_cap, &
4284		"value of upper limit cap for boundary layer depth by Ekman depth hf/u", &
4285	1	units="nondim", default=2.0, do_not_log=.not.CS%eqdisc)
4286
4287		call get_param(param_file, mdl, "EPBL_EQD_DIFFUSIVITY_LH_CAP", CS%Lh_cap, &
4288		"value of upper limit cap for boundary layer depth by Monin-Obukhov depth hB/u^3", &
4289	1	units="nondim", default=8.0, do_not_log=.not.CS%eqdisc)
4290
4291		! The coefficients used for machine learned diffusivity
4292		! c1 to c6 used for sigma_m,
4293		! 7 to 9 v_0 surface heating, 10 to 14 v_0 surface cooling (ML velocity scale without h as input)
4294		! 14, 15, & 16 for v_0h surface heating, 17, 18, & 14 for v_0h surface cooling (ML velocity scale with h as input)
4295		call get_param(param_file, mdl, "EPBL_EQD_DIFFUSIVITY_COEFFS", CS%ML_c, &
4296		"Coefficient used for ML diffusivity 1 to 18 ", units="nondim", &
4297		defaults=(/1.7908 , 0.6904, 0.0712, 0.4380, 2.6821, 1.5845, 0.1550, 1.1120, 0.8616, 0.0984, &
4298		45.0, 2.8570, 3.290, 0.0785, 0.650, 0.0944, 6.0277, 15.7292 /), &
4299	1	do_not_log=.not.(CS%eqdisc .or. CS%eqdisc_v0 .or. CS%eqdisc_v0h))
4300
4301		call get_param(param_file, mdl, "EPBL_EQD_DIFFUSIVITY_SHAPE_FUNCTION_EPSILON", CS%shape_function_epsilon, &
4302		"Constant value of OSBL shape function below the boundary layer", &
4303	1	units="nondim", default=0.01, do_not_log=.not.CS%eqdisc)
4304
4305		!/ options end for Machine Learning Equation Discovery
4306
4307		!/ Options for documenting differences from parameter choices
4308		call get_param(param_file, mdl, "EPBL_OPTIONS_DIFF", CS%options_diff, &
4309		"If positive, this is a coded integer indicating a pair of settings whose "//&
4310		"differences are diagnosed in a passive diagnostic mode via extra calls to "//&
4311		"ePBL_column. If this is 0 or negative no extra calls occur.", &
4312	1	default=0)
4313	1	if (CS%options_diff > 0) then
4314	0	if (CS%options_diff == 1) then
4315	0	diff_text = "EPBL_ORIGINAL_PE_CALC settings"
4316	0	elseif (CS%options_diff == 2) then
4317	0	diff_text = "EPBL_ANSWER_DATE settings"
4318	0	elseif (CS%options_diff == 3) then
4319	0	diff_text = "DIRECT_EPBL_MIXING_CALC settings"
4320	0	elseif (CS%options_diff == 4) then
4321	0	diff_text = "BBL DIRECT_EPBL_MIXING_CALC settings"
4322	0	elseif (CS%options_diff == 5) then
4323	0	diff_text = "BBL DECAY_ADJUSTED_BBL_TKE settings"
4324		else
4325	0	diff_text = "unchanged settings"
4326		endif
4327		endif
4328
4329		!/ Logging parameters
4330		! This gives a minimum decay scale that is typically much less than Angstrom.
4331	1	CS%ustar_min = 2e-4CS%omega(GV%Angstrom_Z + GV%dZ_subroundoff)
4332		call log_param(param_file, mdl, "!EPBL_USTAR_MIN", CS%ustar_min, &
4333		"The (tiny) minimum friction velocity used within the "//&
4334		"ePBL code, derived from OMEGA and ANGSTROM.", &
4335		units="m s-1", unscale=US%Z_to_m*US%s_to_T, &
4336	1	like_default=.true.)
4337
4338
4339		!/ Checking output flags
4340		CS%id_Kd_ePBL_col_by_col = register_diag_field('ocean_model', 'Kd_ePBL_col_by_col', diag%axesTi, Time, &
4341	1	'ePBL diapycnal diffusivity at interfaces posted column by column', 'm2 s-1', conversion=GV%HZ_T_to_m2_s)
4342		CS%id_ML_depth = register_diag_field('ocean_model', 'ePBL_h_ML', diag%axesT1, &
4343		Time, 'Surface boundary layer depth', units='m', conversion=US%Z_to_m, &
4344	1	cmor_long_name='Ocean Mixed Layer Thickness Defined by Mixing Scheme')
4345		! This is an alias for the same variable as ePBL_h_ML
4346		CS%id_hML_depth = register_diag_field('ocean_model', 'h_ML', diag%axesT1, &
4347	1	Time, 'Surface mixed layer depth based on active turbulence', units='m', conversion=US%Z_to_m)
4348		CS%id_ustar_ePBL = register_diag_field('ocean_model', 'ePBL_ustar', diag%axesT1, &
4349	1	Time, 'Surface friction in ePBL', units='m s-1', conversion=US%Z_to_m*US%s_to_T)
4350		CS%id_bflx_ePBL = register_diag_field('ocean_model', 'ePBL_bflx', diag%axesT1, &
4351	1	Time, 'Surface buoyancy flux in ePBL', units='m2 s-3', conversion=US%Z_to_m*2US%s_to_T**3)
4352		CS%id_TKE_wind = register_diag_field('ocean_model', 'ePBL_TKE_wind', diag%axesT1, &
4353	1	Time, 'Wind-stirring source of mixed layer TKE', units='W m-2', conversion=US%RZ3_T3_to_W_m2)
4354		CS%id_TKE_MKE = register_diag_field('ocean_model', 'ePBL_TKE_MKE', diag%axesT1, &
4355	1	Time, 'Mean kinetic energy source of mixed layer TKE', units='W m-2', conversion=US%RZ3_T3_to_W_m2)
4356		CS%id_TKE_conv = register_diag_field('ocean_model', 'ePBL_TKE_conv', diag%axesT1, &
4357	1	Time, 'Convective source of mixed layer TKE', units='W m-2', conversion=US%RZ3_T3_to_W_m2)
4358		CS%id_TKE_forcing = register_diag_field('ocean_model', 'ePBL_TKE_forcing', diag%axesT1, &
4359		Time, 'TKE consumed by mixing surface forcing or penetrative shortwave radation '//&
4360	1	'through model layers', units='W m-2', conversion=US%RZ3_T3_to_W_m2)
4361		CS%id_TKE_mixing = register_diag_field('ocean_model', 'ePBL_TKE_mixing', diag%axesT1, &
4362	1	Time, 'TKE consumed by mixing that deepens the mixed layer', units='W m-2', conversion=US%RZ3_T3_to_W_m2)
4363		CS%id_TKE_mech_decay = register_diag_field('ocean_model', 'ePBL_TKE_mech_decay', diag%axesT1, &
4364	1	Time, 'Mechanical energy decay sink of mixed layer TKE', units='W m-2', conversion=US%RZ3_T3_to_W_m2)
4365		CS%id_TKE_conv_decay = register_diag_field('ocean_model', 'ePBL_TKE_conv_decay', diag%axesT1, &
4366	1	Time, 'Convective energy decay sink of mixed layer TKE', units='W m-2', conversion=US%RZ3_T3_to_W_m2)
4367		CS%id_Mixing_Length = register_diag_field('ocean_model', 'Mixing_Length', diag%axesTi, &
4368	1	Time, 'Mixing Length that is used', units='m', conversion=US%Z_to_m)
4369		CS%id_Velocity_Scale = register_diag_field('ocean_model', 'Velocity_Scale', diag%axesTi, &
4370	1	Time, 'Velocity Scale that is used.', units='m s-1', conversion=US%Z_to_m*US%s_to_T)
4371		CS%id_mstar_sfc = register_diag_field('ocean_model', 'MSTAR', diag%axesT1, &
4372	1	Time, 'Total mstar that is used.', 'nondim')
4373	1	if ((CS%ePBL_BBL_effic > 0.0) .or. (CS%ePBL_tidal_effic > 0.0) .or. CS%ePBL_BBL_use_mstar) then
4374		CS%id_Kd_BBL = register_diag_field('ocean_model', 'Kd_ePBL_BBL', diag%axesTi, &
4375	0	Time, 'ePBL bottom boundary layer diffusivity', units='m2 s-1', conversion=GV%HZ_T_to_m2_s)
4376		CS%id_BBL_Mix_Length = register_diag_field('ocean_model', 'BBL_Mixing_Length', diag%axesTi, &
4377	0	Time, 'ePBL bottom boundary layer mixing length', units='m', conversion=US%Z_to_m)
4378		CS%id_BBL_Vel_Scale = register_diag_field('ocean_model', 'BBL_Velocity_Scale', diag%axesTi, &
4379	0	Time, 'ePBL bottom boundary layer velocity scale', units='m s-1', conversion=US%Z_to_m*US%s_to_T)
4380		CS%id_BBL_depth = register_diag_field('ocean_model', 'h_BBL', diag%axesT1, &
4381	0	Time, 'Bottom boundary layer depth based on active turbulence', units='m', conversion=US%Z_to_m)
4382		CS%id_ustar_BBL = register_diag_field('ocean_model', 'ePBL_ustar_BBL', diag%axesT1, &
4383	0	Time, 'The bottom boundary layer friction velocity', units='m s-1', conversion=GV%H_to_m*US%s_to_T)
4384		CS%id_BBL_decay_scale = register_diag_field('ocean_model', 'BBL_decay_scale', diag%axesT1, &
4385	0	Time, 'The bottom boundary layer TKE decay lengthscale', units='m', conversion=GV%H_to_m)
4386		CS%id_TKE_BBL = register_diag_field('ocean_model', 'ePBL_BBL_TKE', diag%axesT1, &
4387	0	Time, 'The source of TKE for the bottom boundary layer', units='W m-2', conversion=US%RZ3_T3_to_W_m2)
4388		CS%id_TKE_BBL_mixing = register_diag_field('ocean_model', 'ePBL_BBL_TKE_mixing', diag%axesT1, &
4389		Time, 'TKE consumed by mixing that thickens the bottom boundary layer', &
4390	0	units='W m-2', conversion=US%RZ3_T3_to_W_m2)
4391		CS%id_TKE_BBL_decay = register_diag_field('ocean_model', 'ePBL_BBL_TKE_decay', diag%axesT1, &
4392		Time, 'Energy decay sink of mixed layer TKE in the bottom boundary layer', &
4393	0	units='W m-2', conversion=US%RZ3_T3_to_W_m2)
4394		CS%id_mstar_BBL = register_diag_field('ocean_model', 'MSTAR_BBL', diag%axesT1, &
4395	0	Time, 'Total BBL mstar that is used.', 'nondim')
4396		endif
4397	1	if (CS%use_LT) then
4398		CS%id_LA = register_diag_field('ocean_model', 'LA', diag%axesT1, &
4399	1	Time, 'Langmuir number.', 'nondim')
4400		CS%id_LA_mod = register_diag_field('ocean_model', 'LA_MOD', diag%axesT1, &
4401	1	Time, 'Modified Langmuir number.', 'nondim')
4402		CS%id_mstar_LT = register_diag_field('ocean_model', 'MSTAR_LT', diag%axesT1, &
4403	1	Time, 'Increase in mstar due to Langmuir Turbulence.', 'nondim')
4404		endif
4405
4406	1	if (CS%options_diff > 0) then
4407		CS%id_opt_diff_Kd_ePBL = register_diag_field('ocean_model', 'ePBL_opt_diff_Kd_ePBL', diag%axesTi, &
4408		Time, 'Change in ePBL diapycnal diffusivity at interfaces due to '//trim(diff_text), &
4409	0	units='m2 s-1', conversion=GV%HZ_T_to_m2_s)
4410		CS%id_opt_maxdiff_Kd_ePBL = register_diag_field('ocean_model', 'ePBL_opt_maxdiff_Kd_ePBL', diag%axesT1, &
4411		Time, 'Column maximum change in ePBL diapycnal diffusivity at interfaces due to '//trim(diff_text), &
4412	0	units='m2 s-1', conversion=GV%HZ_T_to_m2_s)
4413		CS%id_opt_diff_hML_depth = register_diag_field('ocean_model', 'ePBL_opt_diff_h_ML', diag%axesT1, Time, &
4414		'Change in surface or bottom boundary layer depth based on active turbulence due to '//trim(diff_text), &
4415	0	units='m', conversion=US%Z_to_m)
4416		endif
4417
4418	1	if (report_avg_its) then
4419	0	CS%sum_its(1) = real_to_EFP(0.0) ; CS%sum_its(2) = real_to_EFP(0.0)
4420	0	CS%sum_its_BBL(1) = real_to_EFP(0.0) ; CS%sum_its_BBL(2) = real_to_EFP(0.0)
4421		endif
4422
4423		CS%TKE_diagnostics = (max(CS%id_TKE_wind, CS%id_TKE_MKE, CS%id_TKE_conv, &
4424		CS%id_TKE_mixing, CS%id_TKE_mech_decay, CS%id_TKE_forcing, &
4425	1	CS%id_TKE_conv_decay) > 0)
4426	1	if ((CS%ePBL_BBL_effic > 0.0) .or. (CS%ePBL_tidal_effic > 0.0) .or. CS%ePBL_BBL_use_mstar) then
4427		CS%TKE_diagnostics = CS%TKE_diagnostics .or. &
4428	0	(max(CS%id_TKE_BBL, CS%id_TKE_BBL_mixing, CS%id_TKE_BBL_decay) > 0)
4429		endif
4430
4431	1	call safe_alloc_alloc(CS%ML_depth, isd, ied, jsd, jed)
4432	1	call safe_alloc_alloc(CS%BBL_depth, isd, ied, jsd, jed)
4433
4434	1	end subroutine energetic_PBL_init
4435
4436		!> Clean up and deallocate memory associated with the energetic_PBL module.
4437	1	subroutine energetic_PBL_end(CS)
4438		type(energetic_PBL_CS), intent(inout) :: CS !< Energetic_PBL control structure
4439
4440		character(len=256) :: mesg
4441		real :: avg_its ! The averaged number of iterations used by ePBL [nondim]
4442
4443	1	if (allocated(CS%ML_depth)) deallocate(CS%ML_depth)
4444	1	if (allocated(CS%BBL_depth)) deallocate(CS%BBL_depth)
4445
4446	1	if (report_avg_its) then
4447	0	call EFP_sum_across_PEs(CS%sum_its, 2)
4448	0	avg_its = EFP_to_real(CS%sum_its(1)) / EFP_to_real(CS%sum_its(2))
4449	0	write (mesg,*) "Average ePBL iterations = ", avg_its
4450	0	call MOM_mesg(mesg)
4451
4452	0	if ((CS%ePBL_BBL_effic > 0.0) .or. (CS%ePBL_tidal_effic > 0.0) .or. CS%ePBL_BBL_use_mstar) then
4453	0	call EFP_sum_across_PEs(CS%sum_its_BBL, 2)
4454	0	avg_its = EFP_to_real(CS%sum_its_BBL(1)) / EFP_to_real(CS%sum_its_BBL(2))
4455	0	write (mesg,*) "Average ePBL BBL iterations = ", avg_its
4456	0	call MOM_mesg(mesg)
4457		endif
4458		endif
4459	1	end subroutine energetic_PBL_end
4460
4461		!> \namespace MOM_energetic_PBL
4462		!!
4463		!! By Robert Hallberg, 2015.
4464		!!
4465		!! This file contains the subroutine (energetic_PBL) that uses an
4466		!! integrated boundary layer energy budget (like a bulk- or refined-
4467		!! bulk mixed layer scheme), but instead of homogenizing this model
4468		!! calculates a finite diffusivity and viscosity, which in this
4469		!! regard is conceptually similar to what is done with KPP or various
4470		!! two-equation closures. However, the scheme that is implemented
4471		!! here has the big advantage that is entirely implicit, but is
4472		!! simple enough that it requires only a single vertical pass to
4473		!! determine the diffusivity. The development of bulk mixed layer
4474		!! models stems from the work of various people, as described in the
4475		!! review paper by \cite niiler1977. The work here draws in
4476		!! with particular on the form for TKE decay proposed by
4477		!! \cite oberhuber1993, with an extension to a refined bulk mixed
4478		!! layer as described in Hallberg (\cite muller2003). The physical
4479		!! processes portrayed in this subroutine include convectively driven
4480		!! mixing and mechanically driven mixing. Unlike boundary-layer
4481		!! mixing, stratified shear mixing is not a one-directional turbulent
4482		!! process, and it is dealt with elsewhere in the MOM6 code within
4483		!! the module MOM_kappa_shear.F90. It is assumed that the heat,
4484		!! mass, and salt fluxes have been applied elsewhere, but that their
4485		!! implications for the integrated TKE budget have been captured in
4486		!! an array that is provided as an argument to this subroutine. This
4487		!! is a full 3-d array due to the effects of penetrating shortwave
4488		!! radiation.
4489
4490	0	end module MOM_energetic_PBL