MOM_energetic_PBL.F90

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
7
8use mom_cpu_clock, only : cpu_clock_id, cpu_clock_begin, cpu_clock_end, clock_routine
9use mom_coms, only : efp_type, real_to_efp, efp_to_real, operator(+), assignment(=), efp_sum_across_pes
10use mom_debugging, only : hchksum
11use mom_diag_mediator, only : post_data, register_diag_field, safe_alloc_alloc
13use mom_diag_mediator, only : time_type, diag_ctrl
14use mom_domains, only : create_group_pass, do_group_pass, group_pass_type
15use mom_error_handler, only : mom_error, fatal, warning, mom_mesg
16use mom_file_parser, only : get_param, log_param, log_version, param_file_type
17use mom_forcing_type, only : forcing
18use mom_grid, only : ocean_grid_type
19use mom_interface_heights, only : thickness_to_dz
27
28implicit none ; private
29
30#include <MOM_memory.h>
31
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
41type, 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_frac*4*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 !>@}
280end type energetic_pbl_cs
281
282!>@{ Enumeration values for mstar_scheme
283integer, parameter :: use_fixed_mstar = 0 !< The value of mstar_scheme to use a constant mstar
284integer, 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
286integer, parameter :: mstar_from_rh18 = 3 !< The value of mstar_scheme to base mstar of of RH18
287integer, parameter :: no_langmuir = 0 !< The value of LT_enhance_form not use Langmuir turbulence.
288integer, parameter :: langmuir_rescale = 2 !< The value of LT_enhance_form to use a multiplicative
289 !! rescaling of mstar to account for Langmuir turbulence.
290integer, parameter :: langmuir_add = 3 !< The value of LT_enhance_form to add a contribution to
291 !! mstar from Langmuir turbulence to other contributions.
292integer, parameter :: wt_from_croot_tke = 0 !< Use a constant times the cube root of remaining TKE
293 !! to calculate the turbulent velocity.
294integer, 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.
297character*(20), parameter :: constant_string = "CONSTANT"
298character*(20), parameter :: om4_string = "OM4"
299character*(20), parameter :: rh18_string = "REICHL_H18"
300character*(20), parameter :: root_tke_string = "CUBE_ROOT_TKE"
301character*(20), parameter :: none_string = "NONE"
302character*(20), parameter :: rescaled_string = "RESCALE"
303character*(20), parameter :: additive_string = "ADDITIVE"
304!>@}
305
306logical :: 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.
309type, 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
322end type epbl_column_diags
323
324contains
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.
330subroutine energetic_pbl(h_3d, u_3d, v_3d, tv, fluxes, visc, dt, Kd_int, G, GV, US, CS, &
331 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 h_2d, & ! A 2-d slice of the layer thickness [H ~> m or kg m-2].
399 dz_2d, & ! A 2-d slice of the vertical distance across layers [Z ~> m].
400 t_2d, & ! A 2-d slice of the layer temperatures [C ~> degC].
401 s_2d, & ! A 2-d slice of the layer salinities [S ~> ppt].
402 tke_forced_2d, & ! A 2-d slice of TKE_forced [R Z3 T-2 ~> J m-2].
403 dsv_dt_2d, & ! A 2-d slice of dSV_dT [R-1 C-1 ~> m3 kg-1 degC-1].
404 dsv_ds_2d, & ! A 2-d slice of dSV_dS [R-1 S-1 ~> m3 kg-1 ppt-1].
405 u_2d, & ! A 2-d slice of the zonal velocity [L T-1 ~> m s-1].
406 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 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 h, & ! The layer thickness [H ~> m or kg m-2].
411 dz, & ! The vertical distance across layers [Z ~> m].
412 t0, & ! The initial layer temperatures [C ~> degC].
413 s0, & ! The initial layer salinities [S ~> ppt].
414 dsv_dt_1d, & ! The partial derivatives of specific volume with temperature [R-1 C-1 ~> m3 kg-1 degC-1].
415 dsv_ds_1d, & ! The partial derivatives of specific volume with salinity [R-1 S-1 ~> m3 kg-1 ppt-1].
416 tke_forcing, & ! Forcing of the TKE in the layer coming from TKE_forced [R Z3 T-2 ~> J m-2].
417 u, & ! The zonal velocity [L T-1 ~> m s-1].
418 v ! The meridional velocity [L T-1 ~> m s-1].
419 real, dimension(SZK_(GV)+1) :: &
420 kd, & ! The diapycnal diffusivity due to ePBL [H Z T-1 ~> m2 s-1 or kg m-1 s-1].
421 mixvel, & ! A turbulent mixing velocity [Z T-1 ~> m s-1].
422 mixlen, & ! A turbulent mixing length [Z ~> m].
423 mixvel_bbl, & ! A bottom boundary layer turbulent mixing velocity [Z T-1 ~> m s-1].
424 mixlen_bbl, & ! A bottom boundary layer turbulent mixing length [Z ~> m].
425 kd_bbl, & ! The bottom boundary layer diapycnal diffusivity [H Z T-1 ~> m2 s-1 or kg m-1 s-1].
426 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 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 diag_velocity_scale, & ! The velocity scale used in getting Kd [Z T-1 ~> m s-1]
460 diag_mixing_length, & ! The length scale used in getting Kd [Z ~> m]
461 kd_bbl_3d, & ! The bottom boundary layer diffusivities [H Z T-1 ~> m2 s-1 or kg m-1 s-1]
462 bbl_vel_scale, & ! The velocity scale used in getting the BBL part of Kd [Z T-1 ~> m s-1]
463 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 diag_tke_wind, & ! The wind source of TKE [R Z3 T-3 ~> W m-2]
467 diag_tke_mke, & ! The resolved KE source of TKE [R Z3 T-3 ~> W m-2]
468 diag_tke_conv, & ! The convective source of TKE [R Z3 T-3 ~> W m-2]
469 diag_tke_forcing, & ! The TKE sink required to mix surface penetrating shortwave heating [R Z3 T-3 ~> W m-2]
470 diag_tke_mech_decay, & ! The decay of mechanical TKE [R Z3 T-3 ~> W m-2]
471 diag_tke_conv_decay, & ! The decay of convective TKE [R Z3 T-3 ~> W m-2]
472 diag_tke_mixing, & ! The work done by TKE to deepen the mixed layer [R Z3 T-3 ~> W m-2]
473 diag_tke_bbl, & ! The source of TKE to the bottom boundary layer [R Z3 T-3 ~> W m-2].
474 diag_tke_bbl_mixing, & ! The work done by TKE to thicken the bottom boundary layer [R Z3 T-3 ~> W m-2].
475 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 diag_ustar_bbl, & ! The bottom boundary layer friction velocity [H T-1 ~> m s-1 or kg m-2 s-1]
478 diag_bbl_decay_scale, & ! The bottom boundary layer TKE decay length scale [H ~> m]
479 diag_mstar_sfc, & ! mstar used in EPBL [nondim]
480 diag_mstar_bbl, & ! mstar used in EPBL BBL [nondim]
481 diag_mstar_lt, & ! mstar due to Langmuir turbulence [nondim]
482 diag_la, & ! Langmuir number [nondim]
483 diag_la_mod, & ! Modified Langmuir number [nondim]
484 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 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 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 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 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 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 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 is = g%isc ; ie = g%iec ; js = g%jsc ; je = g%jec ; nz = gv%ke
512
513 if (.not. cs%initialized) call mom_error(fatal, "energetic_PBL: "//&
514 "Module must be initialized before it is used.")
515 if (.not. associated(tv%eqn_of_state)) call mom_error(fatal, &
516 "energetic_PBL: Temperature, salinity and an equation of state "//&
517 "must now be used.")
518 if (.not.(associated(fluxes%ustar) .or. associated(fluxes%tau_mag))) call mom_error(fatal, &
519 "energetic_PBL: No surface friction velocity (ustar or tau_mag) defined in fluxes type.")
520 if ((.not.gv%Boussinesq) .and. (.not.associated(fluxes%tau_mag))) call mom_error(fatal, &
521 "energetic_PBL: No surface wind stress magnitude defined in fluxes type in non-Boussinesq mode.")
522 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 "(i.e., USE_LA_LI2016 or EPBL_LT) is True.")
525
526
527 h_neglect = gv%H_subroundoff
528 i_rho = gv%H_to_Z * gv%RZ_to_H ! == 1.0 / GV%Rho0 ! This is not used when fully non-Boussinesq.
529 i_dt = 0.0 ; if (dt > 0.0) i_dt = 1.0 / dt
530 i_rho0dt = 1.0 / (gv%Rho0 * dt) ! This is not used when fully non-Boussinesq.
531 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 if (cs%TKE_diagnostics) then
535 !!OMP parallel do default(shared)
536 do j=js,je ; do i=is,ie
537 diag_tke_wind(i,j) = 0.0 ; diag_tke_mke(i,j) = 0.0
538 diag_tke_conv(i,j) = 0.0 ; diag_tke_forcing(i,j) = 0.0
539 diag_tke_mixing(i,j) = 0.0 ; diag_tke_mech_decay(i,j) = 0.0
540 diag_tke_conv_decay(i,j) = 0.0 !; diag_TKE_unbalanced(i,j) = 0.0
541 enddo ; enddo
542 if (bbl_mixing) then
543 !!OMP parallel do default(shared)
544 do j=js,je ; do i=is,ie
545 diag_tke_bbl(i,j) = 0.0 ; diag_tke_bbl_mixing(i,j) = 0.0
546 diag_tke_bbl_decay(i,j) = 0.0
547 enddo ; enddo
548 endif
549 endif
550 if (cs%debug .or. (cs%id_Mixing_Length>0)) diag_mixing_length(:,:,:) = 0.0
551 if (cs%debug .or. (cs%id_Velocity_Scale>0)) diag_velocity_scale(:,:,:) = 0.0
552 if (bbl_mixing) then
553 if (cs%debug .or. (cs%id_BBL_Mix_Length>0)) bbl_mix_length(:,:,:) = 0.0
554 if (cs%debug .or. (cs%id_BBL_Vel_Scale>0)) bbl_vel_scale(:,:,:) = 0.0
555 if (cs%id_Kd_BBL > 0) kd_bbl_3d(:,:,:) = 0.0
556 if (cs%id_ustar_BBL > 0) diag_ustar_bbl(:,:) = 0.0
557 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 if (cs%options_diff > 0) then
562 cs_tmp1 = cs ; cs_tmp2 = cs
563 spv_scale1 = 1.0 ; spv_scale2 = 1.0
564
565 if (cs%options_diff == 1) then
566 cs_tmp1%orig_PE_calc = .true. ; cs_tmp2%orig_PE_calc = .false.
567 elseif (cs%options_diff == 2) then
568 cs_tmp1%answer_date = 20181231 ; cs_tmp2%answer_date = 20240101
569 elseif (cs%options_diff == 3) then
570 cs_tmp1%direct_calc = .true. ; cs_tmp2%direct_calc = .false.
571 cs_tmp1%MKE_to_TKE_effic = 0.0 ; cs_tmp2%MKE_to_TKE_effic = 0.0
572 cs_tmp1%orig_PE_calc = .false. ; cs_tmp2%orig_PE_calc = .false.
573 elseif (cs%options_diff == 4) then
574 cs_tmp1%direct_calc = .true. ; cs_tmp2%direct_calc = .false.
575 cs_tmp1%MKE_to_TKE_effic = 0.0 ; cs_tmp2%MKE_to_TKE_effic = 0.0
576 cs_tmp1%ePBL_BBL_effic = 0.2 ; cs_tmp2%ePBL_BBL_effic = 0.2
577 elseif (cs%options_diff == 5) then
578 cs_tmp1%decay_adjusted_BBL_TKE = .true. ; cs_tmp2%decay_adjusted_BBL_TKE = .false.
579 cs_tmp1%MKE_to_TKE_effic = 0.0 ; cs_tmp2%MKE_to_TKE_effic = 0.0
580 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 if (cs_tmp1%answer_date < 20240101) spv_scale1 = us%m_to_Z**3 * us%T_to_s**3
584 if (cs_tmp2%answer_date < 20240101) spv_scale2 = us%m_to_Z**3 * us%T_to_s**3
585 if (cs%id_opt_diff_Kd_ePBL > 0) diff_kd(:,:,:) = 0.0
586 if (cs%id_opt_maxdiff_Kd_ePBL > 0) max_abs_diff_kd(:,:) = 0.0
587 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 do j=js,je
593 ! Copy the thicknesses and other fields to 2-d arrays.
594 do k=1,nz ; do i=is,ie
595 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 t_2d(i,k) = tv%T(i,j,k) ; s_2d(i,k) = tv%S(i,j,k)
597 tke_forced_2d(i,k) = tke_forced(i,j,k)
598 dsv_dt_2d(i,k) = dsv_dt(i,j,k) ; dsv_ds_2d(i,k) = dsv_ds(i,j,k)
599 enddo ; enddo
600 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 spv_dt(:) = 0.0
604 if ((dt > 0.0) .and. gv%Boussinesq .or. .not.allocated(tv%SpV_avg)) then
605 if (cs%answer_date < 20240101) then
606 do k=1,nz+1
607 spv_dt(k) = 1.0 / (dt*gv%Rho0)
608 enddo
609 else
610 do k=1,nz+1
611 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 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 do k=1,nz
626 h(k) = h_2d(i,k) + gv%H_subroundoff ; dz(k) = dz_2d(i,k) + gv%dZ_subroundoff
627 u(k) = u_2d(i,k) ; v(k) = v_2d(i,k)
628 t0(k) = t_2d(i,k) ; s0(k) = s_2d(i,k) ; tke_forcing(k) = tke_forced_2d(i,k)
629 dsv_dt_1d(k) = dsv_dt_2d(i,k) ; dsv_ds_1d(k) = dsv_ds_2d(i,k)
630 enddo
631 do k=1,nz+1 ; kd(k) = 0.0 ; enddo
632
633 ! Make local copies of surface forcing and process them.
634 if (associated(fluxes%ustar) .and. (gv%Boussinesq .or. .not.associated(fluxes%tau_mag))) then
635 u_star = fluxes%ustar(i,j)
636 u_star_mean = fluxes%ustar_gustless(i,j)
637 mech_tke = dt * gv%Rho0 * u_star**3
638 elseif (allocated(tv%SpV_avg)) then
639 u_star = sqrt(fluxes%tau_mag(i,j) * tv%SpV_avg(i,j,1))
640 u_star_mean = sqrt(fluxes%tau_mag_gustless(i,j) * tv%SpV_avg(i,j,1))
641 mech_tke = dt * u_star * fluxes%tau_mag(i,j)
642 else
643 u_star = sqrt(fluxes%tau_mag(i,j) * i_rho)
644 u_star_mean = sqrt(fluxes%tau_mag_gustless(i,j) * i_rho)
645 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 diag_ustar(i,j) = u_star
649
650 if (allocated(tv%SpV_avg) .and. .not.gv%Boussinesq) then
651 spv_dt(1) = tv%SpV_avg(i,j,1) * i_dt
652 do k=2,nz
653 spv_dt(k) = 0.5*(tv%SpV_avg(i,j,k-1) + tv%SpV_avg(i,j,k)) * i_dt
654 enddo
655 spv_dt(nz+1) = tv%SpV_avg(i,j,nz) * i_dt
656 endif
657
658 b_flux = buoy_flux(i,j)
659 if (associated(fluxes%ustar_shelf) .and. associated(fluxes%frac_shelf_h)) then
660 if (fluxes%frac_shelf_h(i,j) > 0.0) &
661 u_star = (1.0 - fluxes%frac_shelf_h(i,j)) * u_star + &
662 fluxes%frac_shelf_h(i,j) * fluxes%ustar_shelf(i,j)
663 endif
664 if (u_star < cs%ustar_min) u_star = cs%ustar_min
665 if (cs%omega_frac >= 1.0) then
666 absf = 2.0*cs%omega
667 else
668 absf = 0.25*((abs(g%CoriolisBu(i,j)) + abs(g%CoriolisBu(i-1,j-1))) + &
669 (abs(g%CoriolisBu(i,j-1)) + abs(g%CoriolisBu(i-1,j))))
670 if (cs%omega_frac > 0.0) &
671 absf = sqrt(cs%omega_frac*4.0*cs%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 mld_io = -1.0
676 if (cs%MLD_iteration_guess .and. (cs%ML_depth(i,j) > 0.0)) mld_io = cs%ML_depth(i,j)
677 bbld_io = 0.0
678
679 ! Store the initial guesses at the boundary layer depths for testing sensitivities.
680 mld_in = mld_io
681
682 if (cs%answer_date < 20240101) then
683 do k=1,nz+1 ; spv_dt_cf(k) = (us%Z_to_m**3*us%s_to_T**3) * spv_dt(k) ; enddo
684 else
685 do k=1,nz+1 ; spv_dt_cf(k) = spv_dt(k) ; enddo
686 endif
687 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 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 us, cs, ecd, waves, g, i, j)
696 endif
697 if (cs%id_Kd_ePBL_col_by_col > 0) &
698 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 if (bbl_mixing) then
702 if (cs%MLD_iteration_guess .and. (cs%BBL_depth(i,j) > 0.0)) bbld_io = cs%BBL_depth(i,j)
703 bbld_in = bbld_io
704 u_star_bbl = max(visc%ustar_BBL(i,j), cs%ustar_min*gv%Z_to_H) ! units are H T-1
705 if (gv%Boussinesq) then
706 u_star_bbl_z_t = u_star_bbl*gv%H_to_Z
707 else
708 u_star_bbl_z_t = u_star_bbl*gv%H_to_RZ*tv%SpV_avg(i,j,1)
709 endif
710
711 if (cs%ePBL_BBL_use_mstar) then
712 bbl_tke = dt * ((u_star_bbl*gv%H_to_RZ) * u_star_bbl_z_t**2)
713 else
714 if (cs%BBL_effic_bug) then
715 bbl_tke = cs%ePBL_BBL_effic * gv%H_to_RZ * dt * visc%BBL_meanKE_loss_sqrtCd(i,j)
716 else
717 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 if ((cs%ePBL_tidal_effic > 0.0) .and. associated(fluxes%BBL_tidal_dis)) &
722 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 gv, us, cs, ecd)
728
729 do k=1,nz+1 ; kd(k) = kd(k) + kd_bbl(k) ; enddo
730 if (cs%id_Kd_BBL > 0) then ; do k=1,nz+1
731 kd_bbl_3d(i,j,k) = kd_bbl(k)
732 enddo ; endif
733 if (cs%id_ustar_BBL > 0) diag_ustar_bbl(i,j) = u_star_bbl
734 if ((cs%id_BBL_decay_scale > 0) .and. (cs%TKE_decay * absf > 0)) &
735 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 do k=1,nz+1
740 kd_2d(i,k) = kd(k)
741 enddo
742 cs%ML_depth(i,j) = mld_io
743 cs%BBL_depth(i,j) = bbld_io
744
745 if (cs%TKE_diagnostics) then
746 diag_tke_mke(i,j) = diag_tke_mke(i,j) + ecd%dTKE_MKE
747 diag_tke_conv(i,j) = diag_tke_conv(i,j) + ecd%dTKE_conv
748 diag_tke_forcing(i,j) = diag_tke_forcing(i,j) + ecd%dTKE_forcing
749 diag_tke_wind(i,j) = diag_tke_wind(i,j) + ecd%dTKE_wind
750 diag_tke_mixing(i,j) = diag_tke_mixing(i,j) + ecd%dTKE_mixing
751 diag_tke_mech_decay(i,j) = diag_tke_mech_decay(i,j) + ecd%dTKE_mech_decay
752 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 if (cs%debug .or. (cs%id_Mixing_Length > 0)) then ; do k=1,nz+1
757 diag_mixing_length(i,j,k) = mixlen(k)
758 enddo ; endif
759 if (cs%debug .or. (cs%id_Velocity_Scale > 0)) then ; do k=1,nz+1
760 diag_velocity_scale(i,j,k) = mixvel(k)
761 enddo ; endif
762 if (bbl_mixing) then
763 if (cs%debug .or. (cs%id_BBL_Mix_Length>0)) then ; do k=1,nz
764 bbl_mix_length(i,j,k) = mixlen_bbl(k)
765 enddo ; endif
766 if (cs%debug .or. (cs%id_BBL_Vel_Scale>0)) then ; do k=1,nz
767 bbl_vel_scale(i,j,k) = mixvel_bbl(k)
768 enddo ; endif
769 if (cs%id_TKE_BBL>0) &
770 diag_tke_bbl(i,j) = diag_tke_bbl(i,j) + bbl_tke
771 endif
772 if (cs%id_mstar_sfc > 0) diag_mstar_sfc(i,j) = ecd%mstar
773 if (cs%id_mstar_bbl > 0) diag_mstar_bbl(i,j) = ecd%mstar_BBL
774 if (cs%id_mstar_LT > 0) diag_mstar_lt(i,j) = ecd%mstar_LT
775 if (cs%id_LA > 0) diag_la(i,j) = ecd%LA
776 if (cs%id_LA_mod > 0) diag_la_mod(i,j) = ecd%LAmod
777 if (report_avg_its) then
778 cs%sum_its(1) = cs%sum_its(1) + real_to_efp(real(ecd%OBL_its))
779 cs%sum_its(2) = cs%sum_its(2) + real_to_efp(1.0)
780 if (bbl_mixing) then
781 cs%sum_its_BBL(1) = cs%sum_its_BBL(1) + real_to_efp(real(ecd%BBL_its))
782 cs%sum_its_BBL(2) = cs%sum_its_BBL(2) + real_to_efp(1.0)
783 endif
784 endif
785
786 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 if (cs%options_diff < 4) then
790 bld_1 = mld_in ; bld_2 = mld_in
791 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 mixvel, mixlen, gv, us, cs_tmp1, ecd_tmp, waves, g, i, j)
795 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 mixvel, mixlen, gv, us, cs_tmp2, ecd_tmp, waves, g, i, j)
799 else
800 bld_1 = bbld_in ; bld_2 = bbld_in
801 bbl_tke = cs%ePBL_BBL_effic * gv%H_to_RZ * dt * visc%BBL_meanKE_loss(i,j)
802 if ((cs%ePBL_tidal_effic > 0.0) .and. associated(fluxes%BBL_tidal_dis)) &
803 bbl_tke = bbl_tke + cs%ePBL_tidal_effic * dt * fluxes%BBL_tidal_dis(i,j)
804 u_star_bbl = max(visc%ustar_BBL(i,j), cs%ustar_min*gv%Z_to_H)
805 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 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 gv, us, cs_tmp2, ecd_tmp)
812 endif
813
814 if (cs%id_opt_diff_Kd_ePBL > 0) then
815 do k=1,nz+1 ; diff_kd(i,j,k) = kd_1(k) - kd_2(k) ; enddo
816 endif
817 if (cs%id_opt_maxdiff_Kd_ePBL > 0) then
818 max_abs_diff_kd(i,j) = 0.0
819 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 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 do k=1,nz+1 ; kd_2d(i,k) = 0. ; enddo
827 cs%ML_depth(i,j) = 0.0
828 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 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 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 if (cs%debug .and. bbl_mixing) then
837 call hchksum(visc%BBL_meanKE_loss, "ePBL visc%BBL_meanKE_loss", g%HI, &
838 unscale=gv%H_to_MKS*us%L_T_to_m_s**2*us%s_to_T)
839 call hchksum(visc%ustar_BBL, "ePBL visc%ustar_BBL", g%HI, unscale=gv%H_to_MKS*us%s_to_T)
840 call hchksum(kd_int, "End of ePBL Kd_int", g%HI, unscale=gv%H_to_MKS*us%Z_to_m*us%s_to_T)
841 call hchksum(diag_velocity_scale, "ePBL Velocity_Scale", g%HI, unscale=us%Z_to_m*us%s_to_T)
842 call hchksum(diag_mixing_length, "ePBL Mixing_Length", g%HI, unscale=us%Z_to_m)
843 call hchksum(bbl_vel_scale, "ePBL BBL_Vel_Scale", g%HI, unscale=us%Z_to_m*us%s_to_T)
844 call hchksum(bbl_mix_length, "ePBL BBL_Mix_Length", g%HI, unscale=us%Z_to_m)
845 endif
846
847 if (cs%id_ML_depth > 0) call post_data(cs%id_ML_depth, cs%ML_depth, cs%diag)
848 if (cs%id_ustar_ePBL > 0) call post_data(cs%id_ustar_ePBL, diag_ustar, cs%diag)
849 if (cs%id_bflx_ePBL > 0) call post_data(cs%id_bflx_ePBL, buoy_flux, cs%diag)
850 if (cs%id_hML_depth > 0) call post_data(cs%id_hML_depth, cs%ML_depth, cs%diag)
851 if (cs%id_TKE_wind > 0) call post_data(cs%id_TKE_wind, diag_tke_wind, cs%diag)
852 if (cs%id_TKE_MKE > 0) call post_data(cs%id_TKE_MKE, diag_tke_mke, cs%diag)
853 if (cs%id_TKE_conv > 0) call post_data(cs%id_TKE_conv, diag_tke_conv, cs%diag)
854 if (cs%id_TKE_forcing > 0) call post_data(cs%id_TKE_forcing, diag_tke_forcing, cs%diag)
855 if (cs%id_TKE_mixing > 0) call post_data(cs%id_TKE_mixing, diag_tke_mixing, cs%diag)
856 if (cs%id_TKE_mech_decay > 0) &
857 call post_data(cs%id_TKE_mech_decay, diag_tke_mech_decay, cs%diag)
858 if (cs%id_TKE_conv_decay > 0) &
859 call post_data(cs%id_TKE_conv_decay, diag_tke_conv_decay, cs%diag)
860 if (cs%id_Mixing_Length > 0) call post_data(cs%id_Mixing_Length, diag_mixing_length, cs%diag)
861 if (cs%id_Velocity_Scale >0) call post_data(cs%id_Velocity_Scale, diag_velocity_scale, cs%diag)
862 if (cs%id_mstar_sfc > 0) call post_data(cs%id_mstar_sfc, diag_mstar_sfc, cs%diag)
863 if (bbl_mixing) then
864 if (cs%id_Kd_BBL > 0) call post_data(cs%id_Kd_BBL, kd_bbl_3d, cs%diag)
865 if (cs%id_BBL_Mix_Length > 0) call post_data(cs%id_BBL_Mix_Length, bbl_mix_length, cs%diag)
866 if (cs%id_BBL_Vel_Scale > 0) call post_data(cs%id_BBL_Vel_Scale, bbl_vel_scale, cs%diag)
867 if (cs%id_ustar_BBL > 0) call post_data(cs%id_ustar_BBL, diag_ustar_bbl, cs%diag)
868 if (cs%id_BBL_decay_scale > 0) call post_data(cs%id_BBL_decay_scale, diag_bbl_decay_scale, cs%diag)
869 if (cs%id_TKE_BBL > 0) call post_data(cs%id_TKE_BBL, diag_tke_bbl, cs%diag)
870 if (cs%id_TKE_BBL_mixing > 0) call post_data(cs%id_TKE_BBL_mixing, diag_tke_bbl_mixing, cs%diag)
871 if (cs%id_TKE_BBL_decay > 0) call post_data(cs%id_TKE_BBL_decay, diag_tke_bbl_decay, cs%diag)
872 if (cs%id_BBL_depth > 0) call post_data(cs%id_BBL_depth, cs%BBL_depth, cs%diag)
873 if (cs%id_mstar_BBL > 0) call post_data(cs%id_mstar_BBL, diag_mstar_bbl, cs%diag)
874 endif
875 if (cs%id_LA > 0) call post_data(cs%id_LA, diag_la, cs%diag)
876 if (cs%id_LA_mod > 0) call post_data(cs%id_LA_mod, diag_la_mod, cs%diag)
877 if (cs%id_mstar_LT > 0) call post_data(cs%id_mstar_LT, diag_mstar_lt, cs%diag)
878 if (stoch_cs%pert_epbl) then
879 if (stoch_cs%id_epbl1_wts > 0) call post_data(stoch_cs%id_epbl1_wts, stoch_cs%epbl1_wts, cs%diag)
880 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 if (cs%options_diff > 0) then
884 ! These diagnostics are only for determining sensitivities to different ePBL settings.
885 if (cs%id_opt_diff_Kd_ePBL > 0) call post_data(cs%id_opt_diff_Kd_ePBL, diff_kd, cs%diag)
886 if (cs%id_opt_maxdiff_Kd_ePBL > 0) call post_data(cs%id_opt_maxdiff_Kd_ePBL, max_abs_diff_kd, cs%diag)
887 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
890end 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.
896subroutine epbl_column(h, dz, u, v, T0, S0, dSV_dT, dSV_dS, SpV_dt, TKE_forcing, B_flux, absf, &
897 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 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 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 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 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 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 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 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 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 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 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 c1, & ! c1 is used by the tridiagonal solver [nondim].
1008 te, & ! Estimated final values of T in the column [C ~> degC].
1009 se, & ! Estimated final values of S in the column [S ~> ppt].
1010 dte, & ! Running (1-way) estimates of temperature change [C ~> degC].
1011 dse, & ! Running (1-way) estimates of salinity change [S ~> ppt].
1012 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 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 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 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 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 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 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 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 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 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 real, dimension(SZK_(GV)) :: nstar_k ! The fraction of conv_PErel that can be converted to mixing
1161 ! for each layer [nondim].
1162 real, dimension(SZK_(GV)) :: dT_expect ! Expected temperature changes [C ~> degC]
1163 real, dimension(SZK_(GV)) :: dS_expect ! Expected salinity changes [S ~> ppt]
1164 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 nz = gv%ke
1172
1173 debug = .false. ! Change this hard-coded value for debugging.
1174 calc_te = (debug .or. (.not.cs%orig_PE_calc))
1175 no_mke_conversion = ((cs%direct_calc) .and. (cs%MKE_to_TKE_effic == 0.0))
1176
1177 h_neglect = gv%H_subroundoff
1178 dz_neglect = gv%dZ_subroundoff
1179
1180 c1_3 = 1.0 / 3.0
1181 i_dtdiag = 1.0 / dt
1182 max_itt = 20
1183
1184 dz_tt_min = 0.0
1185 if (cs%answer_date < 20240101) vstar_unit_scale = us%m_to_Z * us%T_to_s
1186
1187 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 do k=1,nz+1 ; kd(k) = 0.0 ; enddo
1197
1198 pres_z(1) = 0.0
1199 do k=1,nz
1200 dmass = gv%H_to_RZ * h(k)
1201 dpres = gv%g_Earth_Z_T2 * dmass
1202 dt_to_dpe(k) = (dmass * (pres_z(k) + 0.5*dpres)) * dsv_dt(k)
1203 ds_to_dpe(k) = (dmass * (pres_z(k) + 0.5*dpres)) * dsv_ds(k)
1204 dt_to_dcolht(k) = dmass * dsv_dt(k)
1205 ds_to_dcolht(k) = dmass * dsv_ds(k)
1206
1207 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 dz_sum = dz_neglect ; do k=1,nz ; dz_sum = dz_sum + dz(k) ; enddo
1212 i_dzsum = 0.0 ; if (dz_sum > 0.0) i_dzsum = 1.0 / dz_sum
1213 dz_bot = 0.0
1214 hb_hs(nz+1) = 0.0
1215 do k=nz,1,-1
1216 dz_bot = dz_bot + dz(k)
1217 hb_hs(k) = dz_bot * i_dzsum
1218 enddo
1219
1220 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 max_mld = 0.0 ; do k=1,nz ; max_mld = max_mld + dz(k) ; enddo
1225 ! min_MLD will be initialized to 0.
1226 min_mld = 0.0
1227 ! Set values of the wrong signs to indicate that these changes are not based on valid estimates
1228 dmld_min = -1.0*us%m_to_Z ; dmld_max = 1.0*us%m_to_Z
1229
1230 ! If no first guess is provided for MLD, try the middle of the water column
1231 if (mld_guess <= min_mld) mld_guess = 0.5 * (min_mld + max_mld)
1232
1233 if (gv%Boussinesq) then
1234 do k=1,nz+1 ; h_dz_int(k) = gv%Z_to_H ; enddo
1235 else
1236 h_dz_int(1) = (h(1) + h_neglect) / (dz(1) + dz_neglect)
1237 do k=2,nz
1238 h_dz_int(k) = (h(k-1) + h(k) + h_neglect) / (dz(k-1) + dz(k) + dz_neglect)
1239 enddo
1240 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 do obl_it=1,cs%Max_MLD_Its
1245
1246 if (debug) then ; mech_tke_k(:) = 0.0 ; conv_perel_k(:) = 0.0 ; endif
1247
1248 ! Reset ML_depth
1249 mld_output = dz(1)
1250 sfc_connected = .true.
1251
1252 !/ Here we get mstar, which is the ratio of convective TKE driven mixing to UStar**3
1253 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 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 mstar_lt=mstar_lt)
1259 else
1260 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 if ((cs%answer_date < 20190101) .and. (cs%mstar_scheme==use_fixed_mstar)) then
1265 mech_tke = (dt*mstar_total*gv%Rho0) * u_star**3
1266 else
1267 mech_tke = mstar_total * mech_tke_in
1268 ! mech_TKE = mstar_total * (dt*GV%Rho0* u_star**3)
1269 endif
1270 ! stochastically perturb mech_TKE in the UFS
1271 if (present(tke_gen_stoch)) mech_tke = mech_tke*tke_gen_stoch
1272
1273 if (cs%TKE_diagnostics) then
1274 ecd%dTKE_conv = 0.0 ; ecd%dTKE_mixing = 0.0
1275 ecd%dTKE_MKE = 0.0 ; ecd%dTKE_mech_decay = 0.0 ; ecd%dTKE_conv_decay = 0.0
1276
1277 ecd%dTKE_wind = mech_tke * i_dtdiag
1278 if (tke_forcing(1) <= 0.0) then
1279 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 ecd%dTKE_forcing = cs%nstar*tke_forcing(1) * i_dtdiag
1283 ! eCD%dTKE_unbalanced = 0.0
1284 endif
1285 endif
1286
1287 if (tke_forcing(1) <= 0.0) then
1288 mech_tke = mech_tke + tke_forcing(1)
1289 if (mech_tke < 0.0) mech_tke = 0.0
1290 conv_perel = 0.0
1291 else
1292 conv_perel = tke_forcing(1)
1293 endif
1294
1295
1296 ! Store in 1D arrays for output.
1297 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 (cs%transLay_scale >= 1.0) .or. (cs%transLay_scale < 0.0) ) then
1302 do k=1,nz+1
1303 mixlen_shape(k) = 1.0
1304 enddo
1305 elseif (mld_guess <= 0.0) then
1306 if (cs%transLay_scale > 0.0) then ; do k=1,nz+1
1307 mixlen_shape(k) = cs%transLay_scale
1308 enddo ; else ; do k=1,nz+1
1309 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 i_mld = 1.0 / mld_guess
1315 dz_rsum = 0.0
1316 mixlen_shape(1) = 1.0
1317 if (cs%eqdisc) then ! update Kd as per Machine Learning equation discovery
1318 call kappa_eqdisc(mixlen_shape, cs, gv, h, absf, b_flux, u_star, mld_guess)
1319 else
1320 do k=2,nz+1
1321 dz_rsum = dz_rsum + dz(k-1)
1322 if (cs%MixLenExponent==2.0) then
1323 mixlen_shape(k) = cs%transLay_scale + (1.0 - cs%transLay_scale) * &
1324 (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 (max(0.0, (mld_guess - dz_rsum)*i_mld) )**cs%MixLenExponent
1328 endif
1329 enddo
1330 endif
1331 endif
1332
1333 v0_ml_turb_vel_scale = 0.0 ! a variable that gets passed on to get_eqdisc_v0 & get_eqdisc_v0h
1334 if (cs%eqdisc_v0) then
1335 call get_eqdisc_v0(cs,absf,b_flux,u_star,v0_ml_turb_vel_scale)
1336 elseif (cs%eqdisc_v0h) then
1337 call get_eqdisc_v0h(cs,b_flux,u_star,mld_guess,v0_ml_turb_vel_scale)
1338 endif
1339
1340 kd(1) = 0.0 ; kddt_h(1) = 0.0
1341 hp_a(1) = h(1)
1342 dt_to_dpe_a(1) = dt_to_dpe(1) ; dt_to_dcolht_a(1) = dt_to_dcolht(1)
1343 ds_to_dpe_a(1) = ds_to_dpe(1) ; ds_to_dcolht_a(1) = ds_to_dcolht(1)
1344
1345 htot = h(1) ; dztot = dz(1) ; uhtot = u(1)*h(1) ; vhtot = v(1)*h(1)
1346
1347 if (debug) then
1348 mech_tke_k(1) = mech_tke ; conv_perel_k(1) = conv_perel
1349 nstar_k(:) = 0.0 ; nstar_k(1) = cs%nstar ; num_itts(:) = -1
1350 endif
1351
1352 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 if (gv%Boussinesq) then
1361 idecay_len_tke = (cs%TKE_decay * absf / u_star) * gv%H_to_Z
1362 else
1363 idecay_len_tke = (cs%TKE_decay * absf) / (h_dz_int(k) * u_star)
1364 endif
1365 exp_kh = 1.0
1366 if (idecay_len_tke > 0.0) exp_kh = exp(-h(k-1)*idecay_len_tke)
1367 if (cs%TKE_diagnostics) &
1368 ecd%dTKE_mech_decay = ecd%dTKE_mech_decay + (exp_kh-1.0) * mech_tke * i_dtdiag
1369 if (present(tke_diss_stoch)) then ! perturb the TKE destruction
1370 mech_tke = mech_tke * (1.0 + (exp_kh-1.0) * tke_diss_stoch)
1371 else
1372 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 if (tke_forcing(k) > 0.0) then
1378 conv_perel = conv_perel + tke_forcing(k)
1379 if (cs%TKE_diagnostics) &
1380 ecd%dTKE_forcing = ecd%dTKE_forcing + cs%nstar*tke_forcing(k) * i_dtdiag
1381 endif
1382
1383 if (debug) then
1384 mech_tke_k(k) = mech_tke ; conv_perel_k(k) = conv_perel
1385 endif
1386
1387 ! Determine the total energy
1388 nstar_fc = cs%nstar
1389 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 * (absf*dztot)**3 / conv_PErel)
1393 if (gv%Boussinesq) then
1394 nstar_fc = cs%nstar * conv_perel / (conv_perel + 0.2 * &
1395 sqrt(0.5 * dt * gv%Rho0 * (absf*dztot)**3 * conv_perel))
1396 else
1397 nstar_fc = cs%nstar * conv_perel / (conv_perel + 0.2 * &
1398 sqrt(0.5 * dt * gv%H_to_RZ * (absf**3 * (dztot**2 * htot)) * conv_perel))
1399 endif
1400 endif
1401
1402 if (debug) nstar_k(k) = nstar_fc
1403
1404 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 if (tke_forcing(k) < 0.0) then
1409 if (tke_forcing(k) + tot_tke < 0.0) then
1410 ! The shortwave requirements deplete all the energy in this layer.
1411 if (cs%TKE_diagnostics) then
1412 ecd%dTKE_mixing = ecd%dTKE_mixing + tot_tke * i_dtdiag
1413 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 ecd%dTKE_conv_decay = ecd%dTKE_conv_decay + (cs%nstar-nstar_fc) * conv_perel * i_dtdiag
1416 endif
1417 tot_tke = 0.0 ; mech_tke = 0.0 ; conv_perel = 0.0
1418 else
1419 ! Reduce the mechanical and convective TKE proportionately.
1420 tke_reduc = (tot_tke + tke_forcing(k)) / tot_tke
1421 if (cs%TKE_diagnostics) then
1422 ecd%dTKE_mixing = ecd%dTKE_mixing - tke_forcing(k) * i_dtdiag
1423 ecd%dTKE_forcing = ecd%dTKE_forcing + tke_forcing(k) * i_dtdiag
1424 ecd%dTKE_conv_decay = ecd%dTKE_conv_decay + &
1425 (1.0-tke_reduc)*(cs%nstar-nstar_fc) * conv_perel * i_dtdiag
1426 endif
1427 tot_tke = tke_reduc*tot_tke ! = tot_TKE + TKE_forcing(k)
1428 mech_tke = tke_reduc*mech_tke
1429 conv_perel = tke_reduc*conv_perel
1430 endif
1431 endif
1432
1433 ! Precalculate some temporary expressions that are independent of Kddt_h(K).
1434 if (cs%orig_PE_calc) then
1435 if (k==2) then
1436 dte_t2 = 0.0 ; dse_t2 = 0.0
1437 else
1438 dte_t2 = kddt_h(k-1) * ((t0(k-2) - t0(k-1)) + dte(k-2))
1439 dse_t2 = kddt_h(k-1) * ((s0(k-2) - s0(k-1)) + dse(k-2))
1440 endif
1441 endif
1442 dt_h = dt / max(0.5*(dz(k-1)+dz(k)), 1e-15*dz_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 (ds_to_dcolht(k) + ds_to_dcolht(k-1) ) * (s0(k-1)-s0(k)) ) )
1453
1454 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 tot_tke = 0.0 ; mech_tke = 0.0 ; conv_perel = 0.0
1457 kd(k) = 0.0 ; kddt_h(k) = 0.0
1458 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 b1 = 1.0 / hp_a(k-1)
1467 c1(k) = 0.0
1468 if (cs%orig_PE_calc) then
1469 dte(k-1) = b1 * ( dte_t2 )
1470 dse(k-1) = b1 * ( dse_t2 )
1471 endif
1472
1473 hp_a(k) = h(k)
1474 dt_to_dpe_a(k) = dt_to_dpe(k)
1475 ds_to_dpe_a(k) = ds_to_dpe(k)
1476 dt_to_dcolht_a(k) = dt_to_dcolht(k)
1477 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 sfc_disconnect = .false.
1481
1482 ! Precalculate some more temporary expressions that are independent of
1483 ! Kddt_h(K).
1484 if (cs%orig_PE_calc) then
1485 if (k==2) then
1486 dt_km1_t2 = (t0(k)-t0(k-1))
1487 ds_km1_t2 = (s0(k)-s0(k-1))
1488 else
1489 dt_km1_t2 = (t0(k)-t0(k-1)) - &
1490 (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 (kddt_h(k-1) / hp_a(k-1)) * ((s0(k-2) - s0(k-1)) + dse(k-2))
1493 endif
1494 dte_term = dte_t2 + hp_a(k-1) * (t0(k-1)-t0(k))
1495 dse_term = dse_t2 + hp_a(k-1) * (s0(k-1)-s0(k))
1496 else
1497 if (k<=2) then
1498 th_a(k-1) = h(k-1) * t0(k-1) ; sh_a(k-1) = h(k-1) * s0(k-1)
1499 else
1500 th_a(k-1) = h(k-1) * t0(k-1) + kddt_h(k-1) * te(k-2)
1501 sh_a(k-1) = h(k-1) * s0(k-1) + kddt_h(k-1) * se(k-2)
1502 endif
1503 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 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 (((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 ((htot+h_neglect) * (h(k)+h_neglect))
1521 else
1522 dmke_max = 0.0
1523 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 dz_tt = dztot + dz_tt_min
1530 tke_here = mech_tke + cs%wstar_ustar_coef*conv_perel
1531 if (tke_here > 0.0) then
1532 if (cs%answer_date < 20240101) then
1533 if (cs%wT_scheme==wt_from_croot_tke) then
1534 vstar = cs%vstar_scale_fac * vstar_unit_scale * (spv_dt(k)*tke_here)**c1_3
1535 elseif (cs%wT_scheme==wt_from_rh18) then
1536 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 vstar_unit_scale * (cs%wstar_ustar_coef*conv_perel*spv_dt(k))**c1_3)
1539 endif
1540 else
1541 if (cs%wT_scheme==wt_from_croot_tke) then
1542 vstar = cs%vstar_scale_fac * cuberoot(spv_dt(k)*tke_here)
1543 elseif (cs%wT_scheme==wt_from_rh18) then
1544 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 cuberoot((cs%wstar_ustar_coef*conv_perel) * spv_dt(k)) )
1547 endif
1548 endif
1549 hbs_here = min(hb_hs(k), mixlen_shape(k))
1550 mixlen(k) = max(cs%min_mix_len, ((dz_tt*hbs_here)*vstar) / &
1551 ((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 if (.not.cs%Use_MLD_iteration) then
1555 kd_guess0 = (h_dz_int(k)*vstar) * cs%vonKar * ((dz_tt*hbs_here)*vstar) / &
1556 ((cs%Ekman_scale_coef * absf) * (dz_tt*hbs_here) + vstar)
1557 elseif (cs%eqdisc) then ! ML-eqdisc line1/2
1558 kd_guess0 = mixlen_shape(k) * v0_ml_turb_vel_scale * mld_guess ! ML-eqdisc
1559 else
1560 kd_guess0 = (h_dz_int(k)*vstar) * cs%vonKar * mixlen(k)
1561 endif
1562 else
1563 vstar = 0.0 ; kd_guess0 = 0.0
1564 endif
1565 mixvel(k) = vstar ! Track vstar
1566 kddt_h_g0 = kd_guess0 * dt_h
1567
1568 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 dpe_max=pe_chg_max, frac_dkd_max_pe=frac_in_bl)
1577 convectively_unstable = (pe_chg_max < 0.0)
1578 pe_chg_g0 = tke_used ! This is only used in the convectively unstable limit.
1579 mke_src = 0.0
1580 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 pe_chg=pe_chg_g0, dpe_max=pe_chg_max, dpec_dkd_0=dpec_dkd_kd0 )
1587 convectively_unstable = (pe_chg_g0 < 0.0) .or. ((vstar == 0.0) .and. (dpec_dkd_kd0 < 0.0))
1588 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 pe_chg=pe_chg_g0, dpe_max=pe_chg_max, dpec_dkd_0=dpec_dkd_kd0 )
1596 convectively_unstable = (pe_chg_g0 < 0.0) .or. ((vstar == 0.0) .and. (dpec_dkd_kd0 < 0.0))
1597 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 if (convectively_unstable) then
1602 ! This column is convectively unstable.
1603 if (pe_chg_max <= 0.0) then
1604 ! Does MKE_src need to be included in the calculation of vstar here?
1605 tke_here = mech_tke + cs%wstar_ustar_coef*(conv_perel-pe_chg_max)
1606 if (tke_here > 0.0) then
1607 if (cs%answer_date < 20240101) then
1608 if (cs%wT_scheme==wt_from_croot_tke) then
1609 vstar = cs%vstar_scale_fac * vstar_unit_scale * (spv_dt(k)*tke_here)**c1_3
1610 elseif (cs%wT_scheme==wt_from_rh18) then
1611 surface_scale = max(0.05, 1. - dztot / mld_guess)
1612 vstar = cs%vstar_scale_fac * surface_scale * (cs%vstar_surf_fac*u_star + &
1613 vstar_unit_scale * (cs%wstar_ustar_coef*conv_perel*spv_dt(k))**c1_3)
1614 endif
1615 else
1616 if (cs%wT_scheme==wt_from_croot_tke) then
1617 vstar = cs%vstar_scale_fac * cuberoot(spv_dt(k)*tke_here)
1618 elseif (cs%wT_scheme==wt_from_rh18) then
1619 surface_scale = max(0.05, 1. - dztot / mld_guess)
1620 vstar = (cs%vstar_scale_fac * surface_scale) * ( cs%vstar_surf_fac*u_star + &
1621 cuberoot((cs%wstar_ustar_coef*conv_perel) * spv_dt(k)) )
1622 endif
1623 endif
1624 hbs_here = min(hb_hs(k), mixlen_shape(k))
1625 mixlen(k) = max(cs%min_mix_len, ((dz_tt*hbs_here)*vstar) / &
1626 ((cs%Ekman_scale_coef * absf) * (dz_tt*hbs_here) + vstar))
1627 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_tt*hbs_here)*vstar) / &
1631 ((cs%Ekman_scale_coef * absf) * (dz_tt*hbs_here) + vstar)
1632 elseif (cs%eqdisc) then ! ML-eqdisc line2/2
1633 kd(k) = mixlen_shape(k) * v0_ml_turb_vel_scale * mld_guess ! ML-eqdisc
1634 else
1635 kd(k) = (h_dz_int(k)*vstar) * cs%vonKar * mixlen(k)
1636 endif
1637 else
1638 vstar = 0.0 ; kd(k) = 0.0
1639 endif
1640 mixvel(k) = vstar
1641
1642 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 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 pe_chg=dpe_conv)
1656 endif
1657 ! Should this be iterated to convergence for Kd?
1658 if (dpe_conv > 0.0) then
1659 kd(k) = kd_guess0 ; dpe_conv = pe_chg_g0
1660 else
1661 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 kd(k) = kd_guess0 ; dpe_conv = pe_chg_g0
1666 endif
1667
1668 conv_perel = conv_perel - dpe_conv
1669 mech_tke = mech_tke + mke_src
1670 if (cs%TKE_diagnostics) then
1671 ecd%dTKE_conv = ecd%dTKE_conv - cs%nstar*dpe_conv * i_dtdiag
1672 ecd%dTKE_MKE = ecd%dTKE_MKE + mke_src * i_dtdiag
1673 endif
1674 if (sfc_connected) then
1675 mld_output = mld_output + dz(k)
1676 endif
1677
1678 kddt_h(k) = kd(k) * dt_h
1679
1680 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 if (sfc_connected) mld_output = mld_output + frac_in_bl*dz(k)
1685 if (frac_in_bl < 1.0) sfc_disconnect = .true.
1686
1687 ! Reduce the mechanical and convective TKE proportionately.
1688 tke_reduc = 0.0 ! tot_TKE could be 0 if Convectively_stable is false.
1689 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 if (cs%TKE_diagnostics) then
1693 ecd%dTKE_mixing = ecd%dTKE_mixing - tke_used * i_dtdiag
1694 ecd%dTKE_conv_decay = ecd%dTKE_conv_decay + &
1695 (1.0-tke_reduc)*(cs%nstar-nstar_fc) * conv_perel * i_dtdiag
1696 endif
1697
1698 tot_tke = tot_tke - tke_used
1699 mech_tke = tke_reduc*mech_tke
1700 conv_perel = tke_reduc*conv_perel
1701
1702 kddt_h(k) = kd(k) * dt_h
1703
1704 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 kd(k) = kd_guess0
1708 kddt_h(k) = kddt_h_g0
1709
1710 ! Reduce the mechanical and convective TKE proportionately.
1711 tot_tke = tot_tke + mke_src
1712 tke_reduc = 0.0 ! tot_TKE could be 0 if Convectively_stable is false.
1713 if (tot_tke > 0.0) tke_reduc = (tot_tke - pe_chg_g0) / tot_tke
1714 if (cs%TKE_diagnostics) then
1715 ecd%dTKE_mixing = ecd%dTKE_mixing - pe_chg_g0 * i_dtdiag
1716 ecd%dTKE_MKE = ecd%dTKE_MKE + mke_src * i_dtdiag
1717 ecd%dTKE_conv_decay = ecd%dTKE_conv_decay + &
1718 (1.0-tke_reduc)*(cs%nstar-nstar_fc) * conv_perel * i_dtdiag
1719 endif
1720 tot_tke = tke_reduc*tot_tke
1721 mech_tke = tke_reduc*(mech_tke + mke_src)
1722 conv_perel = tke_reduc*conv_perel
1723 if (sfc_connected) then
1724 mld_output = mld_output + dz(k)
1725 endif
1726
1727 elseif (tot_tke == 0.0) then
1728 ! This can arise if nstar_FC = 0, but it is not common.
1729 kd(k) = 0.0 ; kddt_h(k) = 0.0
1730 tot_tke = 0.0 ; conv_perel = 0.0 ; mech_tke = 0.0
1731 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 kddt_h_max = kddt_h_g0 ; kddt_h_min = 0.0
1736 tke_left_max = tot_tke + (mke_src - pe_chg_g0)
1737 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 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 if (debug) then
1749 tke_left_itt(:) = 0.0 ; dpea_dkd_itt(:) = 0.0 ; pe_chg_itt(:) = 0.0
1750 mke_src_itt(:) = 0.0 ; kddt_h_itt(:) = 0.0
1751 endif
1752 do itt=1,max_itt
1753 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 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 pe_chg=pe_chg, dpec_dkd=dpec_dkd)
1767 endif
1768 mke_src = dmke_max * (1.0 - exp(-mke2_hharm * kddt_h_guess))
1769 dmke_src_dk = dmke_max * mke2_hharm * exp(-mke2_hharm * kddt_h_guess)
1770
1771 tke_left = tot_tke + (mke_src - pe_chg)
1772 if (debug .and. itt<=20) then
1773 kddt_h_itt(itt) = kddt_h_guess ; mke_src_itt(itt) = mke_src
1774 pe_chg_itt(itt) = pe_chg ; dpea_dkd_itt(itt) = dpec_dkd
1775 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 if (tke_left >= 0.0) then
1780 kddt_h_min = kddt_h_guess ; tke_left_min = tke_left
1781 else
1782 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 use_newt = .true.
1788 if (dpec_dkd - dmke_src_dk <= 0.0) then
1789 use_newt = .false.
1790 else
1791 dkddt_h_newt = tke_left / (dpec_dkd - dmke_src_dk)
1792 kddt_h_newt = kddt_h_guess + dkddt_h_newt
1793 if ((kddt_h_newt > kddt_h_max) .or. (kddt_h_newt < kddt_h_min)) &
1794 use_newt = .false.
1795 endif
1796
1797 if (use_newt) then
1798 kddt_h_next = kddt_h_guess + dkddt_h_newt
1799 dkddt_h = dkddt_h_newt
1800 else
1801 kddt_h_next = (tke_left_max * kddt_h_min - kddt_h_max * tke_left_min) / &
1802 (tke_left_max - tke_left_min)
1803 dkddt_h = kddt_h_next - kddt_h_guess
1804 endif
1805
1806 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 if (debug) num_itts(k) = itt
1809 exit
1810 else
1811 kddt_h_guess = kddt_h_next
1812 endif
1813 enddo ! Inner iteration loop on itt.
1814 kd(k) = kddt_h_guess / dt_h ; kddt_h(k) = kd(k) * dt_h
1815
1816 ! All TKE should have been consumed.
1817 if (cs%TKE_diagnostics) then
1818 ecd%dTKE_mixing = ecd%dTKE_mixing - (tot_tke + mke_src) * i_dtdiag
1819 ecd%dTKE_MKE = ecd%dTKE_MKE + mke_src * i_dtdiag
1820 ecd%dTKE_conv_decay = ecd%dTKE_conv_decay + &
1821 (cs%nstar-nstar_fc) * conv_perel * i_dtdiag
1822 endif
1823
1824 if (sfc_connected) mld_output = mld_output + (pe_chg / (pe_chg_g0)) * dz(k)
1825
1826 tot_tke = 0.0 ; mech_tke = 0.0 ; conv_perel = 0.0
1827 sfc_disconnect = .true.
1828 endif ! End of convective or forced mixing cases to determine Kd.
1829
1830 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 b1 = 1.0 / (hp_a(k-1) + kddt_h(k))
1834 c1(k) = kddt_h(k) * b1
1835 if (cs%orig_PE_calc) then
1836 dte(k-1) = b1 * ( kddt_h(k)*(t0(k)-t0(k-1)) + dte_t2 )
1837 dse(k-1) = b1 * ( kddt_h(k)*(s0(k)-s0(k-1)) + dse_t2 )
1838 endif
1839
1840 hp_a(k) = h(k) + (hp_a(k-1) * b1) * kddt_h(k)
1841 dt_to_dpe_a(k) = dt_to_dpe(k) + c1(k)*dt_to_dpe_a(k-1)
1842 ds_to_dpe_a(k) = ds_to_dpe(k) + c1(k)*ds_to_dpe_a(k-1)
1843 dt_to_dcolht_a(k) = dt_to_dcolht(k) + c1(k)*dt_to_dcolht_a(k-1)
1844 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 if (sfc_disconnect) then
1850 ! There is no turbulence at this interface, so zero out the running sums.
1851 uhtot = u(k)*h(k)
1852 vhtot = v(k)*h(k)
1853 htot = h(k)
1854 dztot = dz(k)
1855 sfc_connected = .false.
1856 else
1857 uhtot = uhtot + u(k)*h(k)
1858 vhtot = vhtot + v(k)*h(k)
1859 htot = htot + h(k)
1860 dztot = dztot + dz(k)
1861 endif
1862
1863 if (calc_te) then
1864 if (k==2) then
1865 te(1) = b1*(h(1)*t0(1))
1866 se(1) = b1*(h(1)*s0(1))
1867 else
1868 te(k-1) = b1 * (h(k-1) * t0(k-1) + kddt_h(k-1) * te(k-2))
1869 se(k-1) = b1 * (h(k-1) * s0(k-1) + kddt_h(k-1) * se(k-2))
1870 endif
1871 endif
1872 enddo
1873 kd(nz+1) = 0.0
1874
1875 if (debug) then
1876 ! Complete the tridiagonal solve for Te.
1877 b1 = 1.0 / hp_a(nz)
1878 te(nz) = b1 * (h(nz) * t0(nz) + kddt_h(nz) * te(nz-1))
1879 se(nz) = b1 * (h(nz) * s0(nz) + kddt_h(nz) * se(nz-1))
1880 dt_expect(nz) = te(nz) - t0(nz) ; ds_expect(nz) = se(nz) - s0(nz)
1881 do k=nz-1,1,-1
1882 te(k) = te(k) + c1(k+1)*te(k+1)
1883 se(k) = se(k) + c1(k+1)*se(k+1)
1884 dt_expect(k) = te(k) - t0(k) ; ds_expect(k) = se(k) - s0(k)
1885 enddo
1886 endif
1887
1888 if (debug) then
1889 dpe_debug = 0.0
1890 do k=1,nz
1891 dpe_debug = dpe_debug + (dt_to_dpe(k) * (te(k) - t0(k)) + &
1892 ds_to_dpe(k) * (se(k) - s0(k)))
1893 enddo
1894 mixing_debug = dpe_debug * i_dtdiag
1895 endif
1896
1897 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 mld_found = mld_output
1906
1907 ! Find out whether to do another iteration and the new bounds on it.
1908 if (cs%MLD_iter_bug) then
1909 ! There is a bug in the logic here if (MLD_found - MLD_guess == CS%MLD_tol).
1910 if (mld_found - mld_guess > cs%MLD_tol) then
1911 min_mld = mld_guess ; dmld_min = mld_found - mld_guess
1912 elseif (abs(mld_found - mld_guess) < cs%MLD_tol) then
1913 exit ! Break the MLD convergence loop
1914 else ! We know this guess was too deep
1915 max_mld = mld_guess ; dmld_max = mld_found - mld_guess ! < -CS%MLD_tol
1916 endif
1917 else
1918 if (abs(mld_found - mld_guess) < cs%MLD_tol) then
1919 exit ! Break the MLD convergence loop
1920 elseif (mld_found > mld_guess) then ! This guess was too shallow
1921 min_mld = mld_guess ; dmld_min = mld_found - mld_guess
1922 else ! We know this guess was too deep
1923 max_mld = mld_guess ; dmld_max = mld_found - mld_guess ! < -CS%MLD_tol
1924 endif
1925 endif
1926
1927 if (obl_it < cs%Max_MLD_Its) then
1928 if (cs%MLD_bisection) then
1929 ! For the next pass, guess the average of the minimum and maximum values.
1930 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 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 mld_guess = (dmld_min*max_mld - dmld_max*min_mld) / (dmld_min - dmld_max)
1936 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 mld_guess = mld_found
1940 else ! Bisect if the other guesses would be out-of-bounds. This does not happen much.
1941 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 ecd%OBL_its = min(obl_it, cs%Max_MLD_Its)
1949 if (cs%Use_LT) then
1950 ecd%LA = la ; ecd%LAmod = lamod ; ecd%mstar = mstar_total ; ecd%mstar_LT = mstar_lt
1951 else
1952 ecd%LA = 0.0 ; ecd%LAmod = 0.0 ; ecd%mstar = mstar_total ; ecd%mstar_LT = 0.0
1953 endif
1954
1955 mld_io = mld_output
1956
1957end 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.
1962subroutine epbl_bbl_column(h, dz, u, v, T0, S0, dSV_dT, dSV_dS, SpV_dt, absf, &
1963 dt, Kd, BBL_TKE_in, u_star_BBL, u_star_BBL_z_t, b_flux_BBL, Kd_BBL, BBLD_io, mixvel_BBL, &
1964 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 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 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 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 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 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 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 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 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 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 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 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 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 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 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 c1, & ! c1 is used by the tridiagonal solver [nondim].
2076 te, & ! Estimated final values of T in the column [C ~> degC].
2077 se, & ! Estimated final values of S in the column [S ~> ppt].
2078 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 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 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 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 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 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 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 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 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 real, dimension(SZK_(GV)) :: dT_expect !< Expected temperature changes [C ~> degC]
2180 real, dimension(SZK_(GV)) :: dS_expect !< Expected salinity changes [S ~> ppt]
2181 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 integer, dimension(SZK_(GV)) :: num_itts
2184
2185 integer :: k, nz, itt, max_itt
2186
2187 nz = gv%ke
2188
2189 debug = .false. ! Change this hard-coded value for debugging.
2190 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 .or. (bbl_tke_in <= 0.0)) then
2195 ! There is no added bottom boundary layer mixing.
2196 bbld_io = 0.0
2197 kd_bbl(:) = 0.0
2198 mixvel_bbl(:) = 0.0 ; mixlen_bbl(:) = 0.0
2199 ecd%BBL_its = 0
2200 if (cs%TKE_diagnostics) then
2201 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 return
2205 else
2206 ! There will be added bottom boundary layer mixing.
2207
2208 h_neglect = gv%H_subroundoff
2209 dz_neglect = gv%dZ_subroundoff
2210
2211 c1_3 = 1.0 / 3.0
2212 i_dtdiag = 1.0 / dt
2213 max_itt = 20
2214 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 pres_z(1) = 0.0
2220 do k=1,nz
2221 dmass = gv%H_to_RZ * h(k)
2222 dpres = gv%g_Earth_Z_T2 * dmass
2223 dt_to_dpe(k) = (dmass * (pres_z(k) + 0.5*dpres)) * dsv_dt(k)
2224 ds_to_dpe(k) = (dmass * (pres_z(k) + 0.5*dpres)) * dsv_ds(k)
2225 dt_to_dcolht(k) = dmass * dsv_dt(k)
2226 ds_to_dcolht(k) = dmass * dsv_ds(k)
2227
2228 pres_z(k+1) = pres_z(k) + dpres
2229 enddo
2230
2231 if (gv%Boussinesq) then
2232 do k=1,nz+1 ; h_dz_int(k) = gv%Z_to_H ; enddo
2233 else
2234 h_dz_int(1) = (h(1) + h_neglect) / (dz(1) + dz_neglect)
2235 do k=2,nz
2236 h_dz_int(k) = (h(k-1) + h(k) + h_neglect) / (dz(k-1) + dz(k) + dz_neglect)
2237 enddo
2238 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 dz_sum = 0.0 ; do k=1,nz ; dz_sum = dz_sum + dz(k) ; enddo
2244 i_dzsum = 0.0 ; if (dz_sum > 0.0) i_dzsum = 1.0 / dz_sum
2245 dz_top = 0.0
2246 dztop_dztot(nz+1) = 0.0
2247 do k=1,nz
2248 dz_top = dz_top + dz(k)
2249 dztop_dztot(k) = dz_top * i_dzsum
2250 enddo
2251
2252 ! Set terms from a tridiagonal solver based on the previously determined diffusivities.
2253 kddt_h(1) = 0.0
2254 hp_a(1) = h(1)
2255 dt_to_dpe_a(1) = dt_to_dpe(1) ; dt_to_dcolht_a(1) = dt_to_dcolht(1)
2256 ds_to_dpe_a(1) = ds_to_dpe(1) ; ds_to_dcolht_a(1) = ds_to_dcolht(1)
2257 do k=2,nz
2258 dt_h = dt / max(0.5*(dz(k-1)+dz(k)), 1e-15*dz_sum)
2259 kddt_h(k) = kd(k) * dt_h
2260 b1 = 1.0 / (hp_a(k-1) + kddt_h(k))
2261 c1(k) = kddt_h(k) * b1
2262 hp_a(k) = h(k) + (hp_a(k-1) * b1) * kddt_h(k)
2263 dt_to_dpe_a(k) = dt_to_dpe(k) + c1(k)*dt_to_dpe_a(k-1)
2264 ds_to_dpe_a(k) = ds_to_dpe(k) + c1(k)*ds_to_dpe_a(k-1)
2265 dt_to_dcolht_a(k) = dt_to_dcolht(k) + c1(k)*dt_to_dcolht_a(k-1)
2266 ds_to_dcolht_a(k) = ds_to_dcolht(k) + c1(k)*ds_to_dcolht_a(k-1)
2267 if (k<=2) then
2268 te(k-1) = b1*(h(k-1)*t0(k-1)) ; se(k-1) = b1*(h(k-1)*s0(k-1))
2269 th_a(k-1) = h(k-1) * t0(k-1) ; sh_a(k-1) = h(k-1) * s0(k-1)
2270 else
2271 te(k-1) = b1 * (h(k-1) * t0(k-1) + kddt_h(k-1) * te(k-2))
2272 se(k-1) = b1 * (h(k-1) * s0(k-1) + kddt_h(k-1) * se(k-2))
2273 th_a(k-1) = h(k-1) * t0(k-1) + kddt_h(k-1) * te(k-2)
2274 sh_a(k-1) = h(k-1) * s0(k-1) + kddt_h(k-1) * se(k-2)
2275 endif
2276 enddo
2277 kddt_h(nz+1) = 0.0
2278 if (debug) then
2279 ! Complete the tridiagonal solve for Te and Se, which may be useful for debugging.
2280 b1 = 1.0 / hp_a(nz)
2281 te(nz) = b1 * (h(nz) * t0(nz) + kddt_h(nz) * te(nz-1))
2282 se(nz) = b1 * (h(nz) * s0(nz) + kddt_h(nz) * se(nz-1))
2283 do k=nz-1,1,-1
2284 te(k) = te(k) + c1(k+1)*te(k+1)
2285 se(k) = se(k) + c1(k+1)*se(k+1)
2286 enddo
2287 endif
2288
2289 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 max_bbld = 0.0 ; do k=1,nz ; max_bbld = max_bbld + dz(k) ; enddo
2294 ! min_BBLD will be initialized to 0.
2295 min_bbld = 0.0
2296 ! Set values of the wrong signs to indicate that these changes are not based on valid estimates
2297 dbbld_min = -1.0*us%m_to_Z ; dbbld_max = 1.0*us%m_to_Z
2298
2299 ! If no first guess is provided for BBLD, try the middle of the water column
2300 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 do bbl_it=1,cs%max_BBLD_its
2304
2305 if (debug) then ; mech_bbl_tke_k(:) = 0.0 ; endif
2306
2307 ! Reset BBL_depth
2308 bbld_output = dz(nz)
2309 bot_connected = .true.
2310
2311 if (cs%ePBL_BBL_use_mstar) then
2312 call find_mstar(cs, us, b_flux_bbl, u_star_bbl_z_t, bbld_guess, absf, .true., mstar_bbl)
2313 ecd%mstar_BBL = mstar_bbl
2314 mech_bbl_tke = mstar_bbl * bbl_tke_in
2315 else
2316 mech_bbl_tke = bbl_tke_in
2317 ecd%mstar_BBL = 0.0
2318 endif
2319 if (cs%TKE_diagnostics) then
2320 ! eCD%dTKE_BBL_MKE = 0.0
2321 ecd%dTKE_BBL_mixing = 0.0
2322 ecd%dTKE_BBL_decay = 0.0
2323 ecd%dTKE_BBL = mech_bbl_tke * i_dtdiag
2324 endif
2325
2326 ! Store in 1D arrays for output.
2327 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 (cs%transLay_scale >= 1.0) .or. (cs%transLay_scale < 0.0) ) then
2332 do k=1,nz+1
2333 mixlen_shape(k) = 1.0
2334 enddo
2335 elseif (bbld_guess <= 0.0) then
2336 if (cs%transLay_scale > 0.0) then ; do k=1,nz+1
2337 mixlen_shape(k) = cs%transLay_scale
2338 enddo ; else ; do k=1,nz+1
2339 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 i_bbld = 1.0 / bbld_guess
2345 dz_rsum = 0.0
2346 mixlen_shape(nz+1) = 1.0
2347 if (cs%MixLenExponent_BBL==2.0) then
2348 do k=nz,1,-1
2349 dz_rsum = dz_rsum + dz(k)
2350 mixlen_shape(k) = cs%transLay_scale + (1.0 - cs%transLay_scale) * &
2351 (max(0.0, (bbld_guess - dz_rsum)*i_bbld) )**2
2352 enddo
2353 elseif (cs%MixLenExponent_BBL==1.0) then
2354 do k=nz,1,-1
2355 dz_rsum = dz_rsum + dz(k)
2356 mixlen_shape(k) = cs%transLay_scale + (1.0 - cs%transLay_scale) * &
2357 (max(0.0, (bbld_guess - dz_rsum)*i_bbld) )
2358 enddo
2359 else ! (CS%MixLenExponent_BBL /= 2.0 or 1.0) then
2360 do k=nz,1,-1
2361 dz_rsum = dz_rsum + dz(k)
2362 mixlen_shape(k) = cs%transLay_scale + (1.0 - cs%transLay_scale) * &
2363 (max(0.0, (bbld_guess - dz_rsum)*i_bbld) )**cs%MixLenExponent_BBL
2364 enddo
2365 endif
2366 endif
2367
2368 kd_bbl(nz+1) = 0.0 ; kddt_h(nz+1) = 0.0
2369 hp_b(nz) = h(nz)
2370 dt_to_dpe_b(nz) = dt_to_dpe(nz) ; dt_to_dcolht_b(nz) = dt_to_dcolht(nz)
2371 ds_to_dpe_b(nz) = ds_to_dpe(nz) ; ds_to_dcolht_b(nz) = ds_to_dcolht(nz)
2372
2373 htot = h(nz) ; dztot = dz(nz) ; uhtot = u(nz)*h(nz) ; vhtot = v(nz)*h(nz)
2374
2375 if (debug) then
2376 mech_bbl_tke_k(nz) = mech_bbl_tke
2377 num_itts(:) = -1
2378 endif
2379
2380 idecay_len_tke = (cs%TKE_decay_BBL * absf) / u_star_bbl
2381 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 exp_kh = 1.0
2387 if (idecay_len_tke > 0.0) exp_kh = exp(-h(k)*idecay_len_tke)
2388 if (cs%TKE_diagnostics) &
2389 ecd%dTKE_BBL_decay = ecd%dTKE_BBL_decay + (exp_kh-1.0) * mech_bbl_tke * i_dtdiag
2390 mech_bbl_tke = mech_bbl_tke * exp_kh
2391
2392 if (debug) then
2393 mech_bbl_tke_k(k) = mech_bbl_tke
2394 endif
2395
2396 ! Precalculate some temporary expressions that are independent of Kddt_h(K).
2397 dt_h = dt / max(0.5*(dz(k-1)+dz(k)), 1e-15*dz_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 (ds_to_dcolht(k) + ds_to_dcolht(k-1) ) * (s0(k-1)-s0(k)) ) )
2408
2409 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 mech_bbl_tke = 0.0
2412 kd_bbl(k) = 0.0 ; kddt_h(k) = kd(k) * dt_h
2413 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 bot_disconnect = .false.
2418
2419 ! Precalculate some more temporary expressions that are independent of Kddt_h(K).
2420 if (k>=nz) then
2421 th_b(k) = h(k) * t0(k) ; sh_b(k) = h(k) * s0(k)
2422 else
2423 th_b(k) = h(k) * t0(k) + kddt_h(k+1) * te(k+1)
2424 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 dz_tt = dztot + dz_tt_min
2450 if (mech_bbl_tke > 0.0) then
2451 if (cs%wT_scheme_BBL==wt_from_croot_tke) then
2452 vstar = cs%vstar_scale_fac_BBL * cuberoot(spv_dt(k)*mech_bbl_tke)
2453 elseif (cs%wT_scheme_BBL==wt_from_rh18) then
2454 surface_scale = max(0.05, 1.0 - dztot / bbld_guess)
2455 vstar = (cs%vstar_scale_fac_BBL * surface_scale) * ( cs%vstar_surf_fac_BBL*u_star_bbl/h_dz_int(k) )
2456 endif
2457 hbs_here = min(dztop_dztot(k), mixlen_shape(k))
2458 mixlen_bbl(k) = max(cs%min_BBL_mix_len, ((dz_tt*hbs_here)*vstar) / &
2459 ((cs%Ekman_scale_coef_BBL * absf) * (dz_tt*hbs_here) + vstar))
2460 kd_guess0 = (h_dz_int(k)*vstar) * cs%vonKar * mixlen_bbl(k)
2461 else
2462 vstar = 0.0 ; kd_guess0 = 0.0
2463 endif
2464 mixvel_bbl(k) = vstar ! Track vstar
2465
2466 tke_rescale = 1.0
2467 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 tke_rescale = exp_decay_tke_adjust(htot, h(k-1), idecay_len_tke)
2473 endif
2474
2475 tke_eff_avail = tke_rescale*mech_bbl_tke
2476
2477 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 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 if (tke_eff_used < 0.0) tke_eff_used = 0.0
2489
2490 ! Convert back to the TKE that has actually been used.
2491 if (cs%decay_adjusted_BBL_TKE) then
2492 if (tke_rescale == 0.0) then ! This probably never occurs, even at roundoff.
2493 tke_used = mech_bbl_tke ! All the energy was dissipated before it could mix.
2494 else
2495 tke_used = tke_eff_used / tke_rescale
2496 endif
2497 else
2498 tke_used = tke_eff_used
2499 endif
2500
2501 if (bot_connected) bbld_output = bbld_output + frac_in_bl*dz(k-1)
2502 if (frac_in_bl < 1.0) bot_disconnect = .true.
2503
2504 if (cs%TKE_diagnostics) then
2505 ecd%dTKE_BBL_mixing = ecd%dTKE_BBL_mixing - tke_eff_used * i_dtdiag
2506 ecd%dTKE_BBL_decay = ecd%dTKE_BBL_decay - (tke_used-tke_eff_used) * i_dtdiag
2507 endif
2508
2509 mech_bbl_tke = mech_bbl_tke - tke_used
2510
2511 kddt_h(k) = (kd(k) + kd_bbl(k)) * dt_h
2512
2513 else
2514 kddt_h_prev = kd(k) * dt_h
2515 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 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 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 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 kd_bbl(k) = kd_guess0
2536 kddt_h(k) = kddt_h_prev + kddt_h_g0
2537
2538 tke_used = pe_chg_g0 / tke_rescale
2539
2540 if (cs%TKE_diagnostics) then
2541 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 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 mech_bbl_tke = mech_bbl_tke - tke_used
2548 if (bot_connected) then
2549 bbld_output = bbld_output + dz(k-1)
2550 endif
2551
2552 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 kd_bbl(k) = 0.0 ; kddt_h(k) = kddt_h_prev
2556 if (cs%TKE_diagnostics) then
2557 ecd%dTKE_BBL_decay = ecd%dTKE_BBL_decay - mech_bbl_tke * i_dtdiag
2558 endif
2559 mech_bbl_tke = 0.0
2560 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 kddt_h_max = kddt_h_g0 ; kddt_h_min = 0.0
2565 ! TKE_left_max = TKE_eff_avail + (MKE_src - PE_chg_g0)
2566 tke_left_max = tke_eff_avail - pe_chg_g0
2567 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 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 if (debug) then
2581 tke_left_itt(:) = 0.0 ; dpea_dkd_itt(:) = 0.0 ; pe_chg_itt(:) = 0.0
2582 kddt_h_itt(:) = 0.0 ! ; MKE_src_itt(:) = 0.0
2583 endif
2584 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 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 tke_left = tke_eff_avail - pe_chg
2597 if (debug .and. itt<=20) then
2598 kddt_h_itt(itt) = kddt_h_guess ! ; MKE_src_itt(itt) = MKE_src
2599 pe_chg_itt(itt) = pe_chg ; dpea_dkd_itt(itt) = dpec_dkd
2600 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 if (tke_left >= 0.0) then
2605 kddt_h_min = kddt_h_guess ; tke_left_min = tke_left
2606 else
2607 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 use_newt = .true.
2613 ! if (dPEc_dKd - dMKE_src_dK <= 0.0) then
2614 if (dpec_dkd <= 0.0) then
2615 use_newt = .false.
2616 else
2617 ! dKddt_h_Newt = TKE_left / (dPEc_dKd - dMKE_src_dK)
2618 dkddt_h_newt = tke_left / dpec_dkd
2619 kddt_h_newt = kddt_h_guess + dkddt_h_newt
2620 if ((kddt_h_newt > kddt_h_max) .or. (kddt_h_newt < kddt_h_min)) &
2621 use_newt = .false.
2622 endif
2623
2624 if (use_newt) then
2625 kddt_h_next = kddt_h_guess + dkddt_h_newt
2626 dkddt_h = dkddt_h_newt
2627 else
2628 kddt_h_next = (tke_left_max * kddt_h_min - kddt_h_max * tke_left_min) / &
2629 (tke_left_max - tke_left_min)
2630 dkddt_h = kddt_h_next - kddt_h_guess
2631 endif
2632
2633 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 if (debug) num_itts(k) = itt
2636 exit
2637 else
2638 kddt_h_guess = kddt_h_next
2639 endif
2640 enddo ! Inner iteration loop on itt.
2641 kd_bbl(k) = kddt_h_guess / dt_h
2642 kddt_h(k) = (kd(k) + kd_bbl(k)) * dt_h
2643
2644 ! All TKE should have been consumed.
2645 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 ecd%dTKE_BBL_mixing = ecd%dTKE_BBL_mixing - tke_eff_avail * i_dtdiag
2649 ecd%dTKE_BBL_decay = ecd%dTKE_BBL_decay - (mech_bbl_tke-tke_eff_avail) * i_dtdiag
2650 endif
2651
2652 if (bot_connected) bbld_output = bbld_output + (pe_chg / pe_chg_g0) * dz(k-1)
2653
2654 mech_bbl_tke = 0.0
2655 bot_disconnect = .true.
2656 endif ! End of convective or forced mixing cases to determine Kd.
2657 endif
2658
2659 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 b1 = 1.0 / (hp_b(k) + kddt_h(k))
2665 c1(k) = kddt_h(k) * b1
2666
2667 hp_b(k-1) = h(k-1) + (hp_b(k) * b1) * kddt_h(k)
2668 dt_to_dpe_b(k-1) = dt_to_dpe(k-1) + c1(k)*dt_to_dpe_b(k)
2669 ds_to_dpe_b(k-1) = ds_to_dpe(k-1) + c1(k)*ds_to_dpe_b(k)
2670 dt_to_dcolht_b(k-1) = dt_to_dcolht(k-1) + c1(k)*dt_to_dcolht_b(k)
2671 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 if (bot_disconnect) then
2675 ! There is no turbulence at this interface, so restart the running sums.
2676 uhtot = u(k-1)*h(k-1)
2677 vhtot = v(k-1)*h(k-1)
2678 htot = h(k-1)
2679 dztot = dz(k-1)
2680 bot_connected = .false.
2681 else
2682 uhtot = uhtot + u(k-1)*h(k-1)
2683 vhtot = vhtot + v(k-1)*h(k-1)
2684 htot = htot + h(k-1)
2685 dztot = dztot + dz(k-1)
2686 endif
2687
2688 if (k==nz) then
2689 te(k) = b1*(h(k)*t0(k))
2690 se(k) = b1*(h(k)*s0(k))
2691 else
2692 te(k) = b1 * (h(k) * t0(k) + kddt_h(k+1) * te(k+1))
2693 se(k) = b1 * (h(k) * s0(k) + kddt_h(k+1) * se(k+1))
2694 endif
2695 enddo
2696 kd_bbl(1) = 0.0
2697
2698 if (debug) then
2699 ! Complete the tridiagonal solve for Te with a downward pass.
2700 b1 = 1.0 / hp_b(1)
2701 te(1) = b1 * (h(1) * t0(1) + kddt_h(2) * te(2))
2702 se(1) = b1 * (h(1) * s0(1) + kddt_h(2) * se(2))
2703 dt_expect(1) = te(1) - t0(1) ; ds_expect(1) = se(1) - s0(1)
2704 do k=2,nz
2705 te(k) = te(k) + c1(k)*te(k-1)
2706 se(k) = se(k) + c1(k)*se(k-1)
2707 dt_expect(k) = te(k) - t0(k) ; ds_expect(k) = se(k) - s0(k)
2708 enddo
2709
2710 dpe_debug = 0.0
2711 do k=1,nz
2712 dpe_debug = dpe_debug + (dt_to_dpe(k) * (te(k) - t0(k)) + &
2713 ds_to_dpe(k) * (se(k) - s0(k)))
2714 enddo
2715 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 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 bbld_found = bbld_output
2728 if (abs(bbld_found - bbld_guess) < cs%BBLD_tol) then
2729 exit ! Break the BBL depth convergence loop
2730 elseif (bbld_found > bbld_guess) then
2731 min_bbld = bbld_guess ; dbbld_min = bbld_found - bbld_guess
2732 else ! We know this guess was too deep
2733 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 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 bbld_guess = (dbbld_min*max_bbld - dbbld_max*min_bbld) / (dbbld_min - dbbld_max)
2741 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 bbld_guess = bbld_found
2745 else ! Bisect if the other guesses would be out-of-bounds. This does not happen much.
2746 bbld_guess = 0.5*(min_bbld + max_bbld)
2747 endif
2748
2749 enddo ! Iteration loop for converged boundary layer thickness.
2750
2751 ecd%BBL_its = min(bbl_it, cs%max_BBLD_its)
2752 bbld_io = bbld_output
2753 endif
2754
2755end 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
2759subroutine 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 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 nz = szk_(gv)+1
2797 hz(1) = 0.0
2798 do k=2,nz
2799 hz(k) = hz(k-1) + dz(k-1)
2800 enddo
2801 hbl = mld_guess ! hbl is boundary layer depth.
2802
2803 u_star_i = 1.0/u_star
2804 lh = (-b_flux * hbl) * ((u_star_i * u_star_i) * u_star_i) ! Boundary layer depth divided by Monin-Obukhov depth
2805 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 eh = min(eh, cs%Eh_upper_cap) ! capping p1 to less than 2.0. It is always >0.0.
2811 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 f = (1.0/ ( cs%ML_c(3) + cs%ML_c(4) * exp(-cs%ML_c(5) * lh) ) ) + cs%ML_c(6)
2821 f_eh = f * eh
2822 sm = f_eh / (cs%ML_c(1)*f_eh +cs%ML_c(2))
2823 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 sm_h = sm * hbl
2827 sm_h_i = 1.0/sm_h ! 1.0 / (sm x hbl)
2828 h_minus_smh_i = 1.0/(hbl-sm_h) ! 1.0 / (hbl-sm_h)
2829 h_minus_smh_i2 = h_minus_smh_i * h_minus_smh_i ! (1.0 / (hbl - sm*hbl))^2
2830 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 coef_c3 = ( 2.0 * ( 1.0 - cs%shape_function_epsilon ) ) * h_minus_smh_i3
2840 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 shape_func(1) = 0.0 ! initializing the first element of shape function array
2847 do n = 2,nz
2848 hz_n = hz(n) ! calls hz(n) once to avoid calling it multiple times below
2849
2850 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 z_sm_h_i = hz_n * sm_h_i ! pre multiplying
2854 shape_func(n) = -z_sm_h_i*z_sm_h_i + 2.0 * z_sm_h_i
2855
2856 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 z_minus_sm_h = (hz_n - sm_h)
2861 z_minus_sm_h2 = z_minus_sm_h * z_minus_sm_h
2862 z_minus_sm_h3 = z_minus_sm_h * z_minus_sm_h2
2863
2864 shape_func(n) = (coef_c3 * z_minus_sm_h3 + coef_c2 * z_minus_sm_h2) + 1.0
2865
2866 elseif (hz(n) > hbl) then
2867 shape_func(n) = cs%shape_function_epsilon ! set an arbitrary low constant value below hbl, default 0.01
2868 endif
2869 enddo
2870end subroutine kappa_eqdisc
2871
2872!> Gives velocity scale (v_0) using equations that approximate neural network of Sane et al. 2023
2873subroutine 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 if (b_flux <= cs%bflux_lower_cap) then
2891 bflux_c = cs%bflux_lower_cap
2892 elseif (b_flux >= cs%bflux_upper_cap) then
2893 bflux_c = cs%bflux_upper_cap
2894 else
2895 bflux_c = b_flux
2896 endif
2897
2898 if (absf <= cs%f_lower) then !
2899 absf_c = cs%f_lower ! 0.1 deg Latitude, cap avoids zero coriolis, solution insensitive below 0.1 deg.
2900 else
2901 absf_c = absf
2902 endif
2903
2904 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 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 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 (cs%ML_c(8) * cs%ML_c(9) + cs%ML_c(9)**2) * f_u2
2916 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 omega_i = 1.0 / cs%omega
2924 f_prime = absf_c * omega_i ! Coriolis divided by Earth's rotation
2925 root_b_by_omega = sqrt( -bflux_c * omega_i )
2926 den = ( -bflux_c + cs%ML_c(11) * f_u2 * exp(-f_prime * cs%ML_c(12) ) ) + cs%ML_c(13)*f_u2
2927 v0_dummy = ( cs%ML_c(10) * (-bflux_c * root_b_by_omega) / den ) + ( cs%ML_c(14) * u_star )
2928
2929 endif
2930
2931 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.
2940end 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
2944subroutine 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 u_star_2 = u_star * u_star ! pre-multiplying to get ustar ^ 2
2960 u_star_3 = u_star_2 * u_star ! ustar ^ 3.0
2961
2962 if (b_flux <= cs%bflux_lower_cap) then
2963 bflux_c = cs%bflux_lower_cap
2964 elseif (b_flux >= cs%bflux_upper_cap) then
2965 bflux_c = cs%bflux_upper_cap
2966 else
2967 bflux_c = b_flux
2968 endif
2969
2970 b_h = abs(bflux_c) * mld_guess
2971 b_h_power1by3 = cuberoot(b_h)
2972
2973 ! setting v0_dummy here:
2974
2975 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_power1by3*b_h_power1by3)) &
2980 + (u_star*u_star_2)
2981 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 den = cs%ML_c(17) * (b_h_power1by3*b_h_power1by3) + cs%ML_c(18) * u_star_2
2987 v0_dummy = (b_h / den ) + cs%ML_c(14) * u_star
2988 endif
2989
2990 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.
2999end 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 ha*Idecay, the return value is about 0.5*ka*(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.
3014function 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 khb = abs(hb*idecay)
3030 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.5*1e30) + 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 if (kha > 77.0739) then
3039 tke_to_pe_scale = 1.0e-30
3040 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 (kha * (exp(-khb) - (1.0 - khb)) + khb * (exp(kha) - (1.0 + kha)))
3046 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.5*kha**2 + C1_6*kha**3 + ... + kha**n/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 ((exp(-khb) - (1.0 - khb)) + 0.5*(khb * kha) * (1.0 + c1_3*kha))
3052 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.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 tke_to_pe_scale = 1.0 / (1.0 + c1_3*(kha - khb))
3058 endif
3059
3060 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
3071end 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.
3075subroutine 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_lay*mass_lay*dSpec_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_lay*mass_lay*dSpec_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_lay*mass_lay*dSpec_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_lay*mass_lay*dSpec_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 hps = hp_a + hp_b
3175 bdt1 = hp_a * hp_b + kddt_h0 * hps
3176 dt_c = hp_a * th_b - hp_b * th_a
3177 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 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 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 y1_3 = dkddt_h / (bdt1 * (bdt1 + dkddt_h * hps))
3186 pe_chg = pec_core * y1_3
3187 colht_chg = colht_core * y1_3
3188 if (colht_chg < 0.0) pe_chg = pe_chg - pres_z * colht_chg
3189
3190 if (present(pe_colht_cor)) pe_colht_cor = -pres_z * min(colht_chg, 0.0)
3191
3192 if (present(dpec_dkd)) then
3193 ! Find the derivative of the potential energy change with dKddt_h.
3194 y1_4 = 1.0 / (bdt1 + dkddt_h * hps)**2
3195 dpec_dkd = pec_core * y1_4
3196 colht_chg = colht_core * y1_4
3197 if (colht_chg < 0.0) dpec_dkd = dpec_dkd - pres_z * colht_chg
3198 endif
3199
3200 if (present(dpe_max)) then
3201 ! This expression is the limit of PE_chg for infinite dKddt_h.
3202 y1_3 = 1.0 / (bdt1 * hps)
3203 dpe_max = pec_core * y1_3
3204 colht_chg = colht_core * y1_3
3205 if (colht_chg < 0.0) dpe_max = dpe_max - pres_z * colht_chg
3206 endif
3207
3208 if (present(dpec_dkd_0)) then
3209 ! This expression is the limit of dPEc_dKd for dKddt_h = 0.
3210 y1_4 = 1.0 / bdt1**2
3211 dpec_dkd_0 = pec_core * y1_4
3212 colht_chg = colht_core * y1_4
3213 if (colht_chg < 0.0) dpec_dkd_0 = dpec_dkd_0 - pres_z * colht_chg
3214 endif
3215
3216end 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.
3224subroutine 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_lay*mass_lay*dSpec_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_lay*mass_lay*dSpec_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_lay*mass_lay*dSpec_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_lay*mass_lay*dSpec_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 kddt_h0 = kd_prev * dt_h
3326 hps = hp_a + hp_b
3327 bdt1 = hp_a * hp_b + kddt_h0 * hps
3328 dt_c = hp_a * th_b - hp_b * th_a
3329 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 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 hp_a * (dt_to_dcolht_b * dt_c + ds_to_dcolht_b * ds_c)
3334 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 dkddt_h = dkd_max * dt_h
3339 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 kd_add = dkd_max
3342 pe_chg = pec_core * dkddt_h / (bdt1 * (bdt1 + dkddt_h * hps))
3343 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 kd_add = (bdt1**2 * max_pe_chg) / (dt_h * (pec_core - bdt1 * hps * max_pe_chg))
3349 pe_chg = max_pe_chg
3350 if (present(frac_dkd_max_pe)) &
3351 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 if (present(dpe_max)) dpe_max = pec_core / (bdt1 * hps)
3361
3362end 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.
3368subroutine 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_lay*mass_lay*dSpec_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_lay*mass_lay*dSpec_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_lay*mass_lay*dSpec_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_lay*mass_lay*dSpec_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 b1 = 1.0 / (b_den_1 + kddt_h)
3460 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 i_kr_denom = 1.0 / (h_k*b_den_1 + (b_den_1 + h_k)*kddt_h)
3468
3469 dt_k = (kddt_h*i_kr_denom) * dte_term
3470 ds_k = (kddt_h*i_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 dt_km1 = b1kd * ( dt_k + dt_km1_t2 )
3475 ds_km1 = b1kd * ( ds_k + ds_km1_t2 )
3476 pe_chg = (dt_to_dpe_k * dt_k + dt_to_dpea * dt_km1) + &
3477 (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 (ds_to_dcolht_k * ds_k + ds_to_dcolhta * ds_km1)
3480 if (colht_chg < 0.0) pe_chg = pe_chg - pres_z * colht_chg
3481
3482 if (present(dpec_dkd)) then
3483 ! Find the derivatives of the temperature and salinity changes with Kddt_h.
3484 dkr_dkd = (h_k*b_den_1) * i_kr_denom**2
3485
3486 ddt_k_dkd = dkr_dkd * dte_term
3487 dds_k_dkd = dkr_dkd * dse_term
3488 ddt_km1_dkd = (b1**2 * b_den_1) * ( dt_k + dt_km1_t2 ) + b1kd * ddt_k_dkd
3489 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 (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 (ds_to_dcolht_k * dds_k_dkd + ds_to_dcolhta * dds_km1_dkd)
3496 if (dcolht_dkd < 0.0) dpec_dkd = dpec_dkd - pres_z * dcolht_dkd
3497 endif
3498
3499 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 (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 (ds_to_dcolht_k + ds_to_dcolhta) * dse_term) / (b_den_1 + h_k)
3507 if (dcolht_max < 0.0) dpe_max = dpe_max - pres_z*dcolht_max
3508 endif
3509
3510 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 (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 (dt_to_dcolht_k * dte_term + ds_to_dcolht_k * dse_term) / (h_k*b_den_1)
3516 if (dcolht_dkd < 0.0) dpec_dkd_0 = dpec_dkd_0 - pres_z*dcolht_dkd
3517 endif
3518
3519end subroutine find_pe_chg_orig
3520
3521!> This subroutine finds the mstar value for ePBL
3522subroutine 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 if (is_bbl) then
3549 mstar_scheme = cs%BBL_mstar_scheme
3550 else
3551 mstar_scheme = cs%mstar_scheme
3552 endif
3553
3554 if (mstar_scheme == use_fixed_mstar) then
3555 if (is_bbl) then
3556 mstar = cs%BBL_Fixed_mstar
3557 else
3558 mstar = cs%Fixed_mstar
3559 endif
3560 !/ 1. Get mstar
3561 elseif (mstar_scheme == mstar_from_ekman) then
3562
3563 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_coef*sqrt(max(0.0,buoyancy_flux) / ustar**2 / &
3566 (abs_coriolis + 1.e-10*us%T_to_s) )
3567 ! The limit for rotation (Ekman length) limited mixing
3568 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 mstar_s = cs%mstar_coef*sqrt(max(0.0, buoyancy_flux) / (ustar**2 * max(abs_coriolis, 1.e-20*us%T_to_s)))
3572 ! The limit for rotation (Ekman length) limited mixing
3573 mstar_n = 0.0
3574 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 mstar = max(mstar_s, min(1.25, mstar_n))
3579 if (cs%mstar_Cap > 0.0) mstar = min( cs%mstar_Cap,mstar )
3580 elseif ( mstar_scheme == mstar_from_rh18 ) then
3581 if (cs%answer_date < 20190101) then
3582 mstar_n = cs%RH18_mstar_cn1 * ( 1.0 - 1.0 / ( 1. + cs%RH18_mstar_cn2 * &
3583 exp( cs%RH18_mstar_CN3 * bld * abs_coriolis / ustar) ) )
3584 else
3585 msn_term = cs%RH18_mstar_cn2 * exp( cs%RH18_mstar_CN3 * bld * abs_coriolis / ustar)
3586 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 ( ustar**5 * max(abs_coriolis,1.e-20*us%T_to_s) ) )**cs%RH18_mstar_cs2
3590 mstar = mstar_n + mstar_s
3591 endif
3592
3593 !/ 2. Adjust mstar to account for convective turbulence
3594 if (cs%answer_date < 20190101) then
3595 mstar_conv_red = 1. - cs%mstar_Convect_coef * (-min(0.0,buoyancy_flux) + 1.e-10*us%T_to_s**3*us%m_to_Z**2) / &
3596 ( (-min(0.0,buoyancy_flux) + 1.e-10*us%T_to_s**3*us%m_to_Z**2) + &
3597 2.0 *mstar * ustar**3 / bld )
3598 else
3599 mscr_term1 = -bld * min(0.0, buoyancy_flux)
3600 mscr_term2 = 2.0*mstar * ustar**3
3601 if ( abs(mscr_term2) > 0.0) then
3602 mstar_conv_red = ((1.-cs%mstar_convect_coef) * mscr_term1 + mscr_term2) / (mscr_term1 + mscr_term2)
3603 else
3604 mstar_conv_red = 1.-cs%mstar_convect_coef
3605 endif
3606 endif
3607
3608 !/3. Combine various mstar terms to get final value
3609 mstar = mstar * mstar_conv_red
3610
3611 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 mstar_lt, convect_langmuir_number)
3614 endif
3615
3616end subroutine find_mstar
3617
3618!> This subroutine modifies the mstar value if the Langmuir number is present
3619subroutine 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 enhance_mstar = 1.0 ; mstar_lt_add = 0.0
3654
3655 if (cs%LT_enhance_form /= no_langmuir) then
3656 ! a. Get parameters for modified LA
3657 if (cs%answer_date < 20190101) then
3658 il_ekman = abs_coriolis / ustar
3659 il_obukhov = buoyancy_flux*cs%vonkar / ustar**3
3660 ekman_obukhov_stab = abs(max(0., il_obukhov / (il_ekman + 1.e-10*us%Z_to_m)))
3661 ekman_obukhov_un = abs(min(0., il_obukhov / (il_ekman + 1.e-10*us%Z_to_m)))
3662 mld_obukhov_stab = abs(max(0., bld*il_obukhov))
3663 mld_obukhov_un = abs(min(0., bld*il_obukhov))
3664 mld_ekman = abs( bld*il_ekman )
3665 else
3666 ekman_obukhov = max_ratio ; mld_obukhov = max_ratio ; mld_ekman = max_ratio
3667 i_f = 0.0 ; if (abs(abs_coriolis) > 0.0) i_f = 1.0 / abs_coriolis
3668 i_ustar = 0.0 ; if (abs(ustar) > 0.0) i_ustar = 1.0 / ustar
3669 if (abs(buoyancy_flux*cs%vonkar) < max_ratio*(abs_coriolis * ustar**2)) &
3670 ekman_obukhov = abs(buoyancy_flux*cs%vonkar) * (i_f * i_ustar**2)
3671 if (abs(bld*buoyancy_flux*cs%vonkar) < max_ratio*ustar**3) &
3672 mld_obukhov = abs(bld*buoyancy_flux*cs%vonkar) * i_ustar**3
3673 if (bld*abs_coriolis < max_ratio*ustar) &
3674 mld_ekman = bld*abs_coriolis * i_ustar
3675
3676 if (buoyancy_flux > 0.0) then
3677 ekman_obukhov_stab = ekman_obukhov ; ekman_obukhov_un = 0.0
3678 mld_obukhov_stab = mld_obukhov ; mld_obukhov_un = 0.0
3679 else
3680 ekman_obukhov_un = ekman_obukhov ; ekman_obukhov_stab = 0.0
3681 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 (cs%LaC_MLD_Ob_stab * mld_obukhov_stab + cs%LaC_MLD_Ob_un * mld_obukhov_un)) )
3692
3693 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 (1. + cs%LT_enhance_coef * convect_langmuir_number**cs%LT_enhance_exp) )
3697 elseif (cs%LT_enhance_form == langmuir_add) then
3698 ! or Enhancement is additive (multiplied enhance_m set to 1)
3699 mstar_lt_add = cs%LT_enhance_coef * convect_langmuir_number**cs%LT_enhance_exp
3700 endif
3701 endif
3702
3703 mstar_lt = (enhance_mstar - 1.0)*mstar + mstar_lt_add ! Diagnose the full increase in mstar.
3704 mstar = mstar*enhance_mstar + mstar_lt_add
3705
3706end 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.
3710subroutine 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 scale = 1.0 ; if (present(m_to_mld_units)) scale = us%Z_to_m * m_to_mld_units
3723
3724 do j=g%jsc,g%jec ; do i=g%isc,g%iec
3725 mld(i,j) = scale*cs%ML_depth(i,j)
3726 enddo ; enddo
3727
3728end subroutine energetic_pbl_get_mld
3729
3730
3731!> This subroutine initializes the energetic_PBL module
3732subroutine 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 isd = g%isd ; ied = g%ied ; jsd = g%jsd ; jed = g%jed
3760
3761 cs%initialized = .true.
3762 cs%diag => diag
3763 cs%Time => time
3764
3765! Set default, read and log parameters
3766 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 default=.false., debuggingparam=.true.)
3773 call get_param(param_file, mdl, "OMEGA", cs%omega, &
3774 "The rotation rate of the earth.", &
3775 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 "scale for turbulence.", default=.false., do_not_log=.true.)
3780 omega_frac_dflt = 0.0
3781 if (use_omega) then
3782 call mom_error(warning, "ML_USE_OMEGA is deprecated; use ML_OMEGA_FRAC=1.0 instead.")
3783 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 + of*4*omega^2).", &
3789 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 "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 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 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 default=default_answer_date, do_not_log=.not.gv%Boussinesq)
3808 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 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 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 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 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 default=constant_string, do_not_log=.true.)
3840 call get_param(param_file, mdl, "MSTAR_MODE", mstar_mode, default=-1)
3841 if (mstar_mode == 0) then
3842 mstar_scheme = constant_string
3843 call mom_error(warning, "Use EPBL_MSTAR_SCHEME = CONSTANT instead of the archaic MSTAR_MODE = 0.")
3844 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 "EPBL_MSTAR_SCHEME to specify the scheme for mstar.")
3848 elseif (mstar_mode == 2) then
3849 mstar_scheme = om4_string
3850 call mom_error(warning, "Use EPBL_MSTAR_SCHEME = OM4 instead of the archaic MSTAR_MODE = 2.")
3851 elseif (mstar_mode == 3) then
3852 mstar_scheme = rh18_string
3853 call mom_error(warning, "Use EPBL_MSTAR_SCHEME = REICHL_H18 instead of the archaic MSTAR_MODE = 3.")
3854 elseif (mstar_mode > 3) then
3855 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 default=constant_string)
3863 mstar_scheme = uppercase(mstar_scheme)
3864 select case (mstar_scheme)
3865 case (constant_string)
3866 cs%mstar_scheme = use_fixed_mstar
3867 case (om4_string)
3868 cs%mstar_scheme = mstar_from_ekman
3869 case (rh18_string)
3870 cs%mstar_scheme = mstar_from_rh18
3871 case default
3872 call mom_mesg('energetic_PBL_init: EPBL_MSTAR_SCHEME ="'//trim(mstar_scheme)//'"', 0)
3873 call mom_error(fatal, "energetic_PBL_init: Unrecognized setting "// &
3874 "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 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 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 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 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 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 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 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 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 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 units="nondim", default=.false.)
3926 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 default=mstar_scheme)
3933 tmpstr = uppercase(tmpstr)
3934 select case (tmpstr)
3935 case (constant_string)
3936 cs%BBL_mstar_scheme = use_fixed_mstar
3937 case (om4_string)
3938 cs%BBL_mstar_scheme = mstar_from_ekman
3939 case (rh18_string)
3940 cs%BBL_mstar_scheme = mstar_from_rh18
3941 case default
3942 call mom_mesg('energetic_PBL_init: EPBL_BBL_MSTAR_SCHEME ="'//trim(tmpstr)//'"', 0)
3943 call mom_error(fatal, "energetic_PBL_init: Unrecognized setting "// &
3944 "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 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 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 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 "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 "boundary layer thickness.", units="nondim", default=0.1)
3972 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 "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 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 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 default=.false., do_not_log=.not.cs%Use_MLD_iteration)
3991 call get_param(param_file, mdl, "ENABLE_BUGS_BY_DEFAULT", enable_bugs, &
3992 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 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 default=20, do_not_log=.not.cs%Use_MLD_iteration)
4002 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 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 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 default=root_tke_string, do_not_log=.true.)
4022 call get_param(param_file, mdl, "EPBL_VEL_SCALE_MODE", wt_mode, default=-1)
4023 if (wt_mode == 0) then
4024 vel_scale_str = root_tke_string
4025 call mom_error(warning, "Use EPBL_VEL_SCALE_SCHEME = CUBE_ROOT_TKE instead of the archaic EPBL_VEL_SCALE_MODE = 0.")
4026 elseif (wt_mode == 1) then
4027 vel_scale_str = rh18_string
4028 call mom_error(warning, "Use EPBL_VEL_SCALE_SCHEME = REICHL_H18 instead of the archaic EPBL_VEL_SCALE_MODE = 1.")
4029 elseif (wt_mode >= 2) then
4030 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 default=root_tke_string)
4039 vel_scale_str = uppercase(vel_scale_str)
4040 select case (vel_scale_str)
4041 case (root_tke_string)
4042 cs%wT_scheme = wt_from_croot_tke
4043 case (rh18_string)
4044 cs%wT_scheme = wt_from_rh18
4045 case default
4046 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 "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 "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 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 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 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 units="nondim", default=0.0, scale=us%L_to_Z**2) !### Change the default to follow EPBL_BBL_EFFIC?
4073 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 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 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 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 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 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 default=cs%max_MLD_its, do_not_log=(no_bbl.or.(.not.cs%Use_MLD_iteration)))
4101 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 default=vel_scale_str, do_not_log=no_bbl)
4110 select case (tmpstr)
4111 case (root_tke_string)
4112 cs%wT_scheme_BBL = wt_from_croot_tke
4113 case (rh18_string)
4114 cs%wT_scheme_BBL = wt_from_rh18
4115 case default
4116 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 "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 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 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 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 "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 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 "determine the Langmuir number.", default=.false.)
4148 ! Note this can be activated in other ways, but this preserves the old method.
4149 if (use_la_windsea) then
4150 cs%use_LT = .true.
4151 else
4152 call get_param(param_file, mdl, "EPBL_LT", cs%use_LT, &
4153 "A logical to use a LT parameterization.", default=.false.)
4154 endif
4155 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 default=none_string, do_not_log=.true.)
4163 call get_param(param_file, mdl, "LT_ENHANCE", lt_enhance, default=-1)
4164 if (lt_enhance == 0) then
4165 tmpstr = none_string
4166 call mom_error(warning, "Use EPBL_LANGMUIR_SCHEME = NONE instead of the archaic LT_ENHANCE = 0.")
4167 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 "EPBL_LANGMUIR_SCHEME to specify the scheme for mstar.")
4171 elseif (lt_enhance == 2) then
4172 tmpstr = rescaled_string
4173 call mom_error(warning, "Use EPBL_LANGMUIR_SCHEME = RESCALE instead of the archaic LT_ENHANCE = 2.")
4174 elseif (lt_enhance == 3) then
4175 tmpstr = additive_string
4176 call mom_error(warning, "Use EPBL_LANGMUIR_SCHEME = ADDITIVE instead of the archaic LT_ENHANCE = 3.")
4177 elseif (lt_enhance > 3) then
4178 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 default=none_string)
4187 tmpstr = uppercase(tmpstr)
4188 select case (tmpstr)
4189 case (none_string)
4190 cs%LT_enhance_form = no_langmuir
4191 case (rescaled_string)
4192 cs%LT_enhance_form = langmuir_rescale
4193 case (additive_string)
4194 cs%LT_enhance_form = langmuir_add
4195 case default
4196 call mom_mesg('energetic_PBL_init: EPBL_LANGMUIR_SCHEME ="'//trim(tmpstr)//'"', 0)
4197 call mom_error(fatal, "energetic_PBL_init: Unrecognized setting "// &
4198 "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 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 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 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 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 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 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 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 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 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 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 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 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 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 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 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 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 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 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 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 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 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 default=0)
4313 if (cs%options_diff > 0) then
4314 if (cs%options_diff == 1) then
4315 diff_text = "EPBL_ORIGINAL_PE_CALC settings"
4316 elseif (cs%options_diff == 2) then
4317 diff_text = "EPBL_ANSWER_DATE settings"
4318 elseif (cs%options_diff == 3) then
4319 diff_text = "DIRECT_EPBL_MIXING_CALC settings"
4320 elseif (cs%options_diff == 4) then
4321 diff_text = "BBL DIRECT_EPBL_MIXING_CALC settings"
4322 elseif (cs%options_diff == 5) then
4323 diff_text = "BBL DECAY_ADJUSTED_BBL_TKE settings"
4324 else
4325 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 cs%ustar_min = 2e-4*cs%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 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 '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 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 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 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 time, 'Surface buoyancy flux in ePBL', units='m2 s-3', conversion=us%Z_to_m**2*us%s_to_T**3)
4352 cs%id_TKE_wind = register_diag_field('ocean_model', 'ePBL_TKE_wind', diag%axesT1, &
4353 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 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 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 '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 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 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 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 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 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 time, 'Total mstar that is used.', 'nondim')
4373 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 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 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 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 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 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 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 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 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 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 time, 'Total BBL mstar that is used.', 'nondim')
4396 endif
4397 if (cs%use_LT) then
4398 cs%id_LA = register_diag_field('ocean_model', 'LA', diag%axesT1, &
4399 time, 'Langmuir number.', 'nondim')
4400 cs%id_LA_mod = register_diag_field('ocean_model', 'LA_MOD', diag%axesT1, &
4401 time, 'Modified Langmuir number.', 'nondim')
4402 cs%id_mstar_LT = register_diag_field('ocean_model', 'MSTAR_LT', diag%axesT1, &
4403 time, 'Increase in mstar due to Langmuir Turbulence.', 'nondim')
4404 endif
4405
4406 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 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 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 units='m', conversion=us%Z_to_m)
4416 endif
4417
4418 if (report_avg_its) then
4419 cs%sum_its(1) = real_to_efp(0.0) ; cs%sum_its(2) = real_to_efp(0.0)
4420 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 cs%id_TKE_conv_decay) > 0)
4426 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 (max(cs%id_TKE_BBL, cs%id_TKE_BBL_mixing, cs%id_TKE_BBL_decay) > 0)
4429 endif
4430
4431 call safe_alloc_alloc(cs%ML_depth, isd, ied, jsd, jed)
4432 call safe_alloc_alloc(cs%BBL_depth, isd, ied, jsd, jed)
4433
4434end subroutine energetic_pbl_init
4435
4436!> Clean up and deallocate memory associated with the energetic_PBL module.
4437subroutine 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 if (allocated(cs%ML_depth)) deallocate(cs%ML_depth)
4444 if (allocated(cs%BBL_depth)) deallocate(cs%BBL_depth)
4445
4446 if (report_avg_its) then
4447 call efp_sum_across_pes(cs%sum_its, 2)
4448 avg_its = efp_to_real(cs%sum_its(1)) / efp_to_real(cs%sum_its(2))
4449 write (mesg,*) "Average ePBL iterations = ", avg_its
4450 call mom_mesg(mesg)
4451
4452 if ((cs%ePBL_BBL_effic > 0.0) .or. (cs%ePBL_tidal_effic > 0.0) .or. cs%ePBL_BBL_use_mstar) then
4453 call efp_sum_across_pes(cs%sum_its_BBL, 2)
4454 avg_its = efp_to_real(cs%sum_its_BBL(1)) / efp_to_real(cs%sum_its_BBL(2))
4455 write (mesg,*) "Average ePBL BBL iterations = ", avg_its
4456 call mom_mesg(mesg)
4457 endif
4458 endif
4459end 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
4490end module mom_energetic_pbl