MOM6
MOM_energetic_PBL.F90
1 !> Energetically consistent planetary boundary layer parameterization
3 
4 ! This file is part of MOM6. See LICENSE.md for the license.
5 
6 use mom_cpu_clock, only : cpu_clock_id, cpu_clock_begin, cpu_clock_end, clock_routine
7 use mom_diag_mediator, only : post_data, register_diag_field, safe_alloc_alloc
8 use mom_diag_mediator, only : time_type, diag_ctrl
9 use mom_domains, only : create_group_pass, do_group_pass, group_pass_type
10 use mom_error_handler, only : mom_error, fatal, warning, mom_mesg
12 use mom_forcing_type, only : forcing
13 use mom_grid, only : ocean_grid_type
14 use mom_string_functions, only : uppercase
18 use mom_wave_interface, only: wave_parameters_cs, get_langmuir_number
19 
20 ! use MOM_EOS, only : calculate_density, calculate_density_derivs
21 
22 implicit none ; private
23 
24 #include <MOM_memory.h>
25 
26 public energetic_pbl, energetic_pbl_init, energetic_pbl_end
27 public energetic_pbl_get_mld
28 
29 ! A note on unit descriptions in comments: MOM6 uses units that can be rescaled for dimensional
30 ! consistency testing. These are noted in comments with units like Z, H, L, and T, along with
31 ! their mks counterparts with notation like "a velocity [Z T-1 ~> m s-1]". If the units
32 ! vary with the Boussinesq approximation, the Boussinesq variant is given first.
33 
34 !> This control structure holds parameters for the MOM_energetic_PBL module
35 type, public :: energetic_pbl_cs ; private
36 
37  !/ Constants
38  real :: vonkar = 0.41 !< The von Karman coefficient. This should be runtime, but because
39  !! it is runtime in KPP and set to 0.4 it might change answers.
40  real :: omega !< The Earth's rotation rate [T-1].
41  real :: omega_frac !< When setting the decay scale for turbulence, use this fraction of
42  !! the absolute rotation rate blended with the local value of f, as
43  !! sqrt((1-of)*f^2 + of*4*omega^2) [nondim].
44 
45  !/ Convection related terms
46  real :: nstar !< The fraction of the TKE input to the mixed layer available to drive
47  !! entrainment [nondim]. This quantity is the vertically integrated
48  !! buoyancy production minus the vertically integrated dissipation of
49  !! TKE produced by buoyancy.
50 
51  !/ Mixing Length terms
52  logical :: use_mld_iteration=.false. !< False to use old ePBL method.
53  logical :: mld_iteration_guess=.false. !< False to default to guessing half the
54  !! ocean depth for the iteration.
55  integer :: max_mld_its !< The maximum number of iterations that can be used to find a
56  !! self-consistent mixed layer depth with Use_MLD_iteration.
57  real :: mixlenexponent !< Exponent in the mixing length shape-function.
58  !! 1 is law-of-the-wall at top and bottom,
59  !! 2 is more KPP like.
60  real :: mke_to_tke_effic !< The efficiency with which mean kinetic energy released by
61  !! mechanically forced entrainment of the mixed layer is converted to
62  !! TKE [nondim].
63  real :: ustar_min !< A minimum value of ustar to avoid numerical problems [Z T-1 ~> m s-1].
64  !! If the value is small enough, this should not affect the solution.
65  real :: ekman_scale_coef !< A nondimensional scaling factor controlling the inhibition of the
66  !! diffusive length scale by rotation. Making this larger decreases
67  !! the diffusivity in the planetary boundary layer.
68  real :: translay_scale !< A scale for the mixing length in the transition layer
69  !! at the edge of the boundary layer as a fraction of the
70  !! boundary layer thickness. The default is 0, but a
71  !! value of 0.1 might be better justified by observations.
72  real :: mld_tol !< A tolerance for determining the boundary layer thickness when
73  !! Use_MLD_iteration is true [Z ~> m].
74  real :: min_mix_len !< The minimum mixing length scale that will be used by ePBL [Z ~> m].
75  !! The default (0) does not set a minimum.
76 
77  !/ Velocity scale terms
78  integer :: wt_scheme !< An enumerated value indicating the method for finding the turbulent
79  !! velocity scale. There are currently two options:
80  !! wT_mwT_from_cRoot_TKE is the original (TKE_remaining)^1/3
81  !! wT_from_RH18 is the version described by Reichl and Hallberg, 2018
82  real :: wstar_ustar_coef !< A ratio relating the efficiency with which convectively released
83  !! energy is converted to a turbulent velocity, relative to
84  !! mechanically forced turbulent kinetic energy [nondim].
85  !! Making this larger increases the diffusivity.
86  real :: vstar_surf_fac !< If (wT_scheme == wT_from_RH18) this is the proportionality coefficient between
87  !! ustar and the surface mechanical contribution to vstar [nondim]
88  real :: vstar_scale_fac !< An overall nondimensional scaling factor for vstar times a unit
89  !! conversion factor [Z s T-1 m-1 ~> nondim]. Making this larger increases
90  !! the diffusivity.
91 
92  !mstar related options
93  integer :: mstar_scheme !< An encoded integer to determine which formula is used to set mstar
94  logical :: mstar_flatcap=.true. !< Set false to use asymptotic mstar cap.
95  real :: mstar_cap !< Since MSTAR is restoring undissipated energy to mixing,
96  !! there must be a cap on how large it can be. This
97  !! is definitely a function of latitude (Ekman limit),
98  !! but will be taken as constant for now.
99 
100  !/ vertical decay related options
101  real :: tke_decay !< The ratio of the natural Ekman depth to the TKE decay scale [nondim].
102 
103  !/ mstar_scheme == 0
104  real :: fixed_mstar !< Mstar is the ratio of the friction velocity cubed to the TKE available to
105  !! drive entrainment, nondimensional. This quantity is the vertically
106  !! integrated shear production minus the vertically integrated
107  !! dissipation of TKE produced by shear. This value is used if the option
108  !! for using a fixed mstar is used.
109 
110  !/ mstar_scheme == 2
111  real :: c_ek = 0.17 !< MSTAR Coefficient in rotation limit for mstar_scheme=OM4
112  real :: mstar_coef = 0.3 !< MSTAR coefficient in rotation/stabilizing balance for mstar_scheme=OM4
113 
114  !/ mstar_scheme == 3
115  real :: rh18_mstar_cn1 !< MSTAR_N coefficient 1 (outter-most coefficient for fit).
116  !! Value of 0.275 in RH18. Increasing this
117  !! coefficient increases mechanical mixing for all values of Hf/ust,
118  !! but is most effective at low values (weakly developed OSBLs).
119  real :: rh18_mstar_cn2 !< MSTAR_N coefficient 2 (coefficient outside of exponential decay).
120  !! Value of 8.0 in RH18. Increasing this coefficient increases MSTAR
121  !! for all values of HF/ust, with a consistent affect across
122  !! a wide range of Hf/ust.
123  real :: rh18_mstar_cn3 !< MSTAR_N coefficient 3 (exponential decay coefficient). Value of
124  !! -5.0 in RH18. Increasing this increases how quickly the value
125  !! of MSTAR decreases as Hf/ust increases.
126  real :: rh18_mstar_cs1 !< MSTAR_S coefficient for RH18 in stabilizing limit.
127  !! Value of 0.2 in RH18.
128  real :: rh18_mstar_cs2 !< MSTAR_S exponent for RH18 in stabilizing limit.
129  !! Value of 0.4 in RH18.
130 
131  !/ Coefficient for shear/convective turbulence interaction
132  real :: mstar_convect_coef !< Factor to reduce mstar when statically unstable.
133 
134  !/ Langmuir turbulence related parameters
135  logical :: use_lt = .false. !< Flag for using LT in Energy calculation
136  integer :: lt_enhance_form !< Integer for Enhancement functional form (various options)
137  real :: lt_enhance_coef !< Coefficient in fit for Langmuir Enhancment
138  real :: lt_enhance_exp !< Exponent in fit for Langmuir Enhancement
139  real :: lac_mldoek !< Coefficient for Langmuir number modification based on the ratio of
140  !! the mixed layer depth over the Ekman depth.
141  real :: lac_mldoob_stab !< Coefficient for Langmuir number modification based on the ratio of
142  !! the mixed layer depth over the Obukov depth with stablizing forcing.
143  real :: lac_ekoob_stab !< Coefficient for Langmuir number modification based on the ratio of
144  !! the Ekman depth over the Obukov depth with stablizing forcing.
145  real :: lac_mldoob_un !< Coefficient for Langmuir number modification based on the ratio of
146  !! the mixed layer depth over the Obukov depth with destablizing forcing.
147  real :: lac_ekoob_un !< Coefficient for Langmuir number modification based on the ratio of
148  !! the Ekman depth over the Obukov depth with destablizing forcing.
149  real :: max_enhance_m = 5. !< The maximum allowed LT enhancement to the mixing.
150 
151  !/ Others
152  type(time_type), pointer :: time=>null() !< A pointer to the ocean model's clock.
153 
154  logical :: tke_diagnostics = .false. !< If true, diagnostics of the TKE budget are being calculated.
155  logical :: answers_2018 !< If true, use the order of arithmetic and expressions that recover the
156  !! answers from the end of 2018. Otherwise, use updated and more robust
157  !! forms of the same expressions.
158  logical :: orig_pe_calc !< If true, the ePBL code uses the original form of the
159  !! potential energy change code. Otherwise, it uses a newer version
160  !! that can work with successive increments to the diffusivity in
161  !! upward or downward passes.
162  type(diag_ctrl), pointer :: diag=>null() !< A structure that is used to regulate the
163  !! timing of diagnostic output.
164 
165  real, allocatable, dimension(:,:) :: &
166  ml_depth !< The mixed layer depth determined by active mixing in ePBL [Z ~> m].
167 
168  ! These are terms in the mixed layer TKE budget, all in [kg m-3 Z3 T-2 ~> J m-2] = [kg s-2].
169  real, allocatable, dimension(:,:) :: &
170  diag_tke_wind, & !< The wind source of TKE [kg m-3 Z3 T-3 ~> W m-2].
171  diag_tke_mke, & !< The resolved KE source of TKE [kg m-3 Z3 T-3 ~> W m-2].
172  diag_tke_conv, & !< The convective source of TKE [kg m-3 Z3 T-3 ~> W m-2].
173  diag_tke_forcing, & !< The TKE sink required to mix surface penetrating shortwave heating
174  !! [kg m-3 Z3 T-2 ~> W m-2].
175  diag_tke_mech_decay, & !< The decay of mechanical TKE [kg m-3 Z3 T-3 ~> W m-2].
176  diag_tke_conv_decay, & !< The decay of convective TKE [kg m-3 Z3 T-3 ~> W m-2].
177  diag_tke_mixing, & !< The work done by TKE to deepen the mixed layer [kg m-3 Z3 T-3 ~> W m-2].
178  ! These additional diagnostics are also 2d.
179  mstar_mix, & !< Mstar used in EPBL [nondim]
180  mstar_lt, & !< Mstar due to Langmuir turbulence [nondim]
181  la, & !< Langmuir number [nondim]
182  la_mod !< Modified Langmuir number [nondim]
183 
184  real, allocatable, dimension(:,:,:) :: &
185  velocity_scale, & !< The velocity scale used in getting Kd [Z T-1 ~> m s-1]
186  mixing_length !< The length scale used in getting Kd [Z ~> m]
187  !>@{ Diagnostic IDs
188  integer :: id_ml_depth = -1, id_tke_wind = -1, id_tke_mixing = -1
189  integer :: id_tke_mke = -1, id_tke_conv = -1, id_tke_forcing = -1
190  integer :: id_tke_mech_decay = -1, id_tke_conv_decay = -1
191  integer :: id_mixing_length = -1, id_velocity_scale = -1
192  integer :: id_mstar_mix = -1, id_la_mod = -1, id_la = -1, id_mstar_lt = -1
193  !!@}
194 end type energetic_pbl_cs
195 
196 !>@{ Enumeration values for mstar_Scheme
197 integer, parameter :: use_fixed_mstar = 0 !< The value of mstar_scheme to use a constant mstar
198 integer, parameter :: mstar_from_ekman = 2 !< The value of mstar_scheme to base mstar on the ratio
199  !! of the Ekman layer depth to the Obukhov depth
200 integer, parameter :: mstar_from_rh18 = 3 !< The value of mstar_scheme to base mstar of of RH18
201 integer, parameter :: no_langmuir = 0 !< The value of LT_ENHANCE_FORM not use Langmuir turbolence.
202 integer, parameter :: langmuir_rescale = 2 !< The value of LT_ENHANCE_FORM to use a multiplicative
203  !! rescaling of mstar to account for Langmuir turbulence.
204 integer, parameter :: langmuir_add = 3 !< The value of LT_ENHANCE_FORM to add a contribution to
205  !! mstar from Langmuir turblence to other contributions.
206 integer, parameter :: wt_from_croot_tke = 0 !< Use a constant times the cube root of remaining TKE
207  !! to calculate the turbulent velocity.
208 integer, parameter :: wt_from_rh18 = 1 !< Use a scheme based on a combination of w* and v* as
209  !! documented in Reichl & Hallberg (2018) to calculate
210  !! the turbulent velocity.
211 character*(20), parameter :: constant_string = "CONSTANT"
212 character*(20), parameter :: om4_string = "OM4"
213 character*(20), parameter :: rh18_string = "REICHL_H18"
214 character*(20), parameter :: root_tke_string = "CUBE_ROOT_TKE"
215 character*(20), parameter :: none_string = "NONE"
216 character*(20), parameter :: rescaled_string = "RESCALE"
217 character*(20), parameter :: additive_string = "ADDITIVE"
218 !!@}
219 
220 !> A type for conveniently passing around ePBL diagnostics for a column.
221 type, public :: epbl_column_diags ; private
222  !>@{ Local column copies of energy change diagnostics, all in [kg m-3 Z3 T-3 ~> W m-2].
223  real :: dtke_conv, dtke_forcing, dtke_wind, dtke_mixing
224  real :: dtke_mke, dtke_mech_decay, dtke_conv_decay
225  !!@}
226  real :: la !< The value of the Langmuir number [nondim]
227  real :: lamod !< The modified Langmuir number by convection [nondim]
228  real :: mstar !< The value of mstar used in ePBL [nondim]
229  real :: mstar_lt !< The portion of mstar due to Langmuir turbulence [nondim]
230  real, allocatable, dimension(:) :: dt_expect !< Expected temperature changes [degC]
231  real, allocatable, dimension(:) :: ds_expect !< Expected salinity changes [ppt]
232 end type epbl_column_diags
233 
234 contains
235 
236 !> This subroutine determines the diffusivities from the integrated energetics
237 !! mixed layer model. It assumes that heating, cooling and freshwater fluxes
238 !! have already been applied. All calculations are done implicitly, and there
239 !! is no stability limit on the time step.
240 subroutine energetic_pbl(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS, &
241  dSV_dT, dSV_dS, TKE_forced, buoy_flux, dt_diag, last_call, &
242  dT_expected, dS_expected, Waves )
243  type(ocean_grid_type), intent(inout) :: g !< The ocean's grid structure.
244  type(verticalgrid_type), intent(in) :: gv !< The ocean's vertical grid structure.
245  type(unit_scale_type), intent(in) :: us !< A dimensional unit scaling type
246  real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), &
247  intent(inout) :: h_3d !< Layer thicknesses [H ~> m or kg m-2].
248  real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), &
249  intent(in) :: u_3d !< Zonal velocities interpolated to h points
250  !! [m s-1].
251  real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), &
252  intent(in) :: v_3d !< Zonal velocities interpolated to h points
253  !! [m s-1].
254  real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), &
255  intent(in) :: dsv_dt !< The partial derivative of in-situ specific
256  !! volume with potential temperature
257  !! [m3 kg-1 degC-1].
258  real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), &
259  intent(in) :: dsv_ds !< The partial derivative of in-situ specific
260  !! volume with salinity [m3 kg-1 ppt-1].
261  real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), &
262  intent(in) :: tke_forced !< The forcing requirements to homogenize the
263  !! forcing that has been applied to each layer
264  !! [kg m-3 Z3 T-2 ~> J m-2].
265  type(thermo_var_ptrs), intent(inout) :: tv !< A structure containing pointers to any
266  !! available thermodynamic fields. Absent fields
267  !! have NULL ptrs.
268  type(forcing), intent(inout) :: fluxes !< A structure containing pointers to any
269  !! possible forcing fields. Unused fields have
270  !! NULL ptrs.
271  real, intent(in) :: dt !< Time increment [T ~> s].
272  real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), &
273  intent(out) :: kd_int !< The diagnosed diffusivities at interfaces
274  !! [Z2 s-1 ~> m2 s-1].
275  type(energetic_pbl_cs), pointer :: cs !< The control structure returned by a previous
276  !! call to mixedlayer_init.
277  real, dimension(SZI_(G),SZJ_(G)), &
278  intent(in) :: buoy_flux !< The surface buoyancy flux [Z2 T-3 ~> m2 s-3].
279  real, optional, intent(in) :: dt_diag !< The diagnostic time step, which may be less
280  !! than dt if there are two calls to mixedlayer [T ~> s].
281  logical, optional, intent(in) :: last_call !< If true, this is the last call to
282  !! mixedlayer in the current time step, so
283  !! diagnostics will be written. The default
284  !! is .true.
285  real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), &
286  optional, intent(out) :: dt_expected !< The values of temperature change that
287  !! should be expected when the returned
288  !! diffusivities are applied [degC].
289  real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), &
290  optional, intent(out) :: ds_expected !< The values of salinity change that
291  !! should be expected when the returned
292  !! diffusivities are applied [ppt].
293  type(wave_parameters_cs), &
294  optional, pointer :: waves !< Wave CS
295 
296 ! This subroutine determines the diffusivities from the integrated energetics
297 ! mixed layer model. It assumes that heating, cooling and freshwater fluxes
298 ! have already been applied. All calculations are done implicitly, and there
299 ! is no stability limit on the time step.
300 !
301 ! For each interior interface, first discard the TKE to account for mixing
302 ! of shortwave radiation through the next denser cell. Next drive mixing based
303 ! on the local? values of ustar + wstar, subject to available energy. This
304 ! step sets the value of Kd(K). Any remaining energy is then subject to decay
305 ! before being handed off to the next interface. mech_TKE and conv_PErel are treated
306 ! separately for the purposes of decay, but are used proportionately to drive
307 ! mixing.
308 !
309 ! The key parameters for the mixed layer are found in the control structure.
310 ! To use the classic constant mstar mixied layers choose MSTAR_SCHEME=CONSTANT.
311 ! The key parameters then include mstar, nstar, TKE_decay, and conv_decay.
312 ! For the Oberhuber (1993) mixed layer,the values of these are:
313 ! mstar = 1.25, nstar = 1, TKE_decay = 2.5, conv_decay = 0.5
314 ! TKE_decay is 1/kappa in eq. 28 of Oberhuber (1993), while conv_decay is 1/mu.
315 ! For a traditional Kraus-Turner mixed layer, the values are:
316 ! mstar = 1.25, nstar = 0.4, TKE_decay = 0.0, conv_decay = 0.0
317 
318  ! Local variables
319  real, dimension(SZI_(G),SZK_(GV)) :: &
320  h_2d, & ! A 2-d slice of the layer thickness [H ~> m or kg m-2].
321  t_2d, & ! A 2-d slice of the layer temperatures [degC].
322  s_2d, & ! A 2-d slice of the layer salinities [ppt].
323  tke_forced_2d, & ! A 2-d slice of TKE_forced [kg m-3 Z3 T-2 ~> J m-2].
324  dsv_dt_2d, & ! A 2-d slice of dSV_dT [m3 kg-1 degC-1].
325  dsv_ds_2d, & ! A 2-d slice of dSV_dS [m3 kg-1 ppt-1].
326  u_2d, & ! A 2-d slice of the zonal velocity [m s-1].
327  v_2d ! A 2-d slice of the meridional velocity [m s-1].
328  real, dimension(SZI_(G),SZK_(GV)+1) :: &
329  kd_2d ! A 2-d version of the diapycnal diffusivity [Z2 T-1 ~> m2 s-1].
330  real, dimension(SZK_(GV)) :: &
331  h, & ! The layer thickness [H ~> m or kg m-2].
332  t0, & ! The initial layer temperatures [degC].
333  s0, & ! The initial layer salinities [ppt].
334  dsv_dt_1d, & ! The partial derivatives of specific volume with temperature [m3 kg-1 degC-1].
335  dsv_ds_1d, & ! The partial derivatives of specific volume with salinity [m3 kg-1 ppt-1].
336  tke_forcing, & ! Forcing of the TKE in the layer coming from TKE_forced [kg m-3 Z3 T-2 ~> J m-2].
337  u, & ! The zonal velocity [m s-1].
338  v ! The meridional velocity [m s-1].
339  real, dimension(SZK_(GV)+1) :: &
340  kd, & ! The diapycnal diffusivity [Z2 T-1 ~> m2 s-1].
341  mixvel, & ! A turbulent mixing veloxity [Z T-1 ~> m s-1].
342  mixlen ! A turbulent mixing length [Z ~> m].
343  real :: h_neglect ! A thickness that is so small it is usually lost
344  ! in roundoff and can be neglected [H ~> m or kg m-2].
345 
346  real :: absf ! The absolute value of f [T-1].
347  real :: u_star ! The surface friction velocity [Z T-1 ~> m s-1].
348  real :: u_star_mean ! The surface friction without gustiness [Z T-1 ~> m s-1].
349  real :: b_flux ! The surface buoyancy flux [Z2 T-3 ~> m2 s-3]
350  real :: mld_io ! The mixed layer depth found by ePBL_column [Z ~> m].
351 
352 ! The following are only used for diagnostics.
353  real :: dt__diag ! A copy of dt_diag (if present) or dt [T ~> s].
354  logical :: write_diags ! If true, write out diagnostics with this step.
355  logical :: reset_diags ! If true, zero out the accumulated diagnostics.
356 
357  logical :: debug=.false. ! Change this hard-coded value for debugging.
358  type(epbl_column_diags) :: ecd ! A container for passing around diagnostics.
359 
360  integer :: i, j, k, is, ie, js, je, nz
361 
362  is = g%isc ; ie = g%iec ; js = g%jsc ; je = g%jec ; nz = gv%ke
363 
364  if (.not. associated(cs)) call mom_error(fatal, "energetic_PBL: "//&
365  "Module must be initialized before it is used.")
366 
367  if (.not. associated(tv%eqn_of_state)) call mom_error(fatal, &
368  "energetic_PBL: Temperature, salinity and an equation of state "//&
369  "must now be used.")
370  if (.NOT. associated(fluxes%ustar)) call mom_error(fatal, &
371  "energetic_PBL: No surface TKE fluxes (ustar) defined in mixedlayer!")
372  debug = .false. ; if (present(dt_expected) .or. present(ds_expected)) debug = .true.
373 
374  if (debug) allocate(ecd%dT_expect(nz), ecd%dS_expect(nz))
375 
376  h_neglect = gv%H_subroundoff
377 
378  dt__diag = dt ; if (present(dt_diag)) dt__diag = dt_diag
379  write_diags = .true. ; if (present(last_call)) write_diags = last_call
380 
381 
382  ! Determine whether to zero out diagnostics before accumulation.
383  reset_diags = .true.
384  if (present(dt_diag) .and. write_diags .and. (dt__diag > dt)) &
385  reset_diags = .false. ! This is the second call to mixedlayer.
386 
387  if (reset_diags) then
388  if (cs%TKE_diagnostics) then
389 !!OMP parallel do default(none) shared(is,ie,js,je,CS)
390  do j=js,je ; do i=is,ie
391  cs%diag_TKE_wind(i,j) = 0.0 ; cs%diag_TKE_MKE(i,j) = 0.0
392  cs%diag_TKE_conv(i,j) = 0.0 ; cs%diag_TKE_forcing(i,j) = 0.0
393  cs%diag_TKE_mixing(i,j) = 0.0 ; cs%diag_TKE_mech_decay(i,j) = 0.0
394  cs%diag_TKE_conv_decay(i,j) = 0.0 !; CS%diag_TKE_unbalanced(i,j) = 0.0
395  enddo ; enddo
396  endif
397  endif
398  ! if (CS%id_Mixing_Length>0) CS%Mixing_Length(:,:,:) = 0.0
399  ! if (CS%id_Velocity_Scale>0) CS%Velocity_Scale(:,:,:) = 0.0
400 
401 !!OMP parallel do default(private) shared(js,je,nz,is,ie,h_3d,u_3d,v_3d,tv,dt, &
402 !!OMP CS,G,GV,US,fluxes,debug, &
403 !!OMP TKE_forced,dSV_dT,dSV_dS,Kd_int)
404  do j=js,je
405  ! Copy the thicknesses and other fields to 2-d arrays.
406  do k=1,nz ; do i=is,ie
407  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)
408  t_2d(i,k) = tv%T(i,j,k) ; s_2d(i,k) = tv%S(i,j,k)
409  tke_forced_2d(i,k) = tke_forced(i,j,k)
410  dsv_dt_2d(i,k) = dsv_dt(i,j,k) ; dsv_ds_2d(i,k) = dsv_ds(i,j,k)
411  enddo ; enddo
412 
413  ! Determine the initial mech_TKE and conv_PErel, including the energy required
414  ! to mix surface heating through the topmost cell, the energy released by mixing
415  ! surface cooling & brine rejection down through the topmost cell, and
416  ! homogenizing the shortwave heating within that cell. This sets the energy
417  ! and ustar and wstar available to drive mixing at the first interior
418  ! interface.
419  do i=is,ie ; if (g%mask2dT(i,j) > 0.5) then
420 
421  ! Copy the thicknesses and other fields to 1-d arrays.
422  do k=1,nz
423  h(k) = h_2d(i,k) + gv%H_subroundoff ; u(k) = u_2d(i,k) ; v(k) = v_2d(i,k)
424  t0(k) = t_2d(i,k) ; s0(k) = s_2d(i,k) ; tke_forcing(k) = tke_forced_2d(i,k)
425  dsv_dt_1d(k) = dsv_dt_2d(i,k) ; dsv_ds_1d(k) = dsv_ds_2d(i,k)
426  enddo
427  do k=1,nz+1 ; kd(k) = 0.0 ; enddo
428 
429  ! Make local copies of surface forcing and process them.
430  u_star = fluxes%ustar(i,j)
431  u_star_mean = fluxes%ustar_gustless(i,j)
432  b_flux = buoy_flux(i,j)
433  if (associated(fluxes%ustar_shelf) .and. associated(fluxes%frac_shelf_h)) then
434  if (fluxes%frac_shelf_h(i,j) > 0.0) &
435  u_star = (1.0 - fluxes%frac_shelf_h(i,j)) * u_star + &
436  fluxes%frac_shelf_h(i,j) * fluxes%ustar_shelf(i,j)
437  endif
438  if (u_star < cs%ustar_min) u_star = cs%ustar_min
439  if (cs%omega_frac >= 1.0) then
440  absf = 2.0*cs%omega
441  else
442  absf = 0.25*((abs(g%CoriolisBu(i,j)) + abs(g%CoriolisBu(i-1,j-1))) + &
443  (abs(g%CoriolisBu(i,j-1)) + abs(g%CoriolisBu(i-1,j))))
444  if (cs%omega_frac > 0.0) &
445  absf = sqrt(cs%omega_frac*4.0*cs%omega**2 + (1.0-cs%omega_frac)*absf**2)
446  endif
447 
448  ! Perhaps provide a first guess for MLD based on a stored previous value.
449  mld_io = -1.0
450  if (cs%MLD_iteration_guess .and. (cs%ML_Depth(i,j) > 0.0)) mld_io = cs%ML_Depth(i,j)
451 
452  call epbl_column(h, u, v, t0, s0, dsv_dt_1d, dsv_ds_1d, tke_forcing, b_flux, absf, &
453  u_star, u_star_mean, dt, mld_io, kd, mixvel, mixlen, gv, &
454  us, cs, ecd, dt_diag=dt_diag, waves=waves, g=g, i=i, j=j)
455 
456 
457  ! Copy the diffusivities to a 2-d array.
458  do k=1,nz+1
459  kd_2d(i,k) = kd(k)
460  enddo
461  cs%ML_depth(i,j) = mld_io
462 
463  if (present(dt_expected)) then
464  do k=1,nz ; dt_expected(i,j,k) = ecd%dT_expect(k) ; enddo
465  endif
466  if (present(ds_expected)) then
467  do k=1,nz ; ds_expected(i,j,k) = ecd%dS_expect(k) ; enddo
468  endif
469 
470  if (cs%TKE_diagnostics) then
471  cs%diag_TKE_MKE(i,j) = cs%diag_TKE_MKE(i,j) + ecd%dTKE_MKE
472  cs%diag_TKE_conv(i,j) = cs%diag_TKE_conv(i,j) + ecd%dTKE_conv
473  cs%diag_TKE_forcing(i,j) = cs%diag_TKE_forcing(i,j) + ecd%dTKE_forcing
474  cs%diag_TKE_wind(i,j) = cs%diag_TKE_wind(i,j) + ecd%dTKE_wind
475  cs%diag_TKE_mixing(i,j) = cs%diag_TKE_mixing(i,j) + ecd%dTKE_mixing
476  cs%diag_TKE_mech_decay(i,j) = cs%diag_TKE_mech_decay(i,j) + ecd%dTKE_mech_decay
477  cs%diag_TKE_conv_decay(i,j) = cs%diag_TKE_conv_decay(i,j) + ecd%dTKE_conv_decay
478  ! CS%diag_TKE_unbalanced(i,j) = CS%diag_TKE_unbalanced(i,j) + eCD%dTKE_unbalanced
479  endif
480  ! Write to 3-D for outputing Mixing length and velocity scale.
481  if (cs%id_Mixing_Length>0) then ; do k=1,nz
482  cs%Mixing_Length(i,j,k) = mixlen(k)
483  enddo ; endif
484  if (cs%id_Velocity_Scale>0) then ; do k=1,nz
485  cs%Velocity_Scale(i,j,k) = mixvel(k)
486  enddo ; endif
487  if (allocated(cs%mstar_mix)) cs%mstar_mix(i,j) = ecd%mstar
488  if (allocated(cs%mstar_lt)) cs%mstar_lt(i,j) = ecd%mstar_LT
489  if (allocated(cs%La)) cs%La(i,j) = ecd%LA
490  if (allocated(cs%La_mod)) cs%La_mod(i,j) = ecd%LAmod
491  else ! End of the ocean-point part of the i-loop
492  ! For masked points, Kd_int must still be set (to 0) because it has intent out.
493  do k=1,nz+1 ; kd_2d(i,k) = 0. ; enddo
494  cs%ML_depth(i,j) = 0.0
495 
496  if (present(dt_expected)) then
497  do k=1,nz ; dt_expected(i,j,k) = 0.0 ; enddo
498  endif
499  if (present(ds_expected)) then
500  do k=1,nz ; ds_expected(i,j,k) = 0.0 ; enddo
501  endif
502  endif ; enddo ! Close of i-loop - Note unusual loop order!
503 
504  do k=1,nz+1 ; do i=is,ie ; kd_int(i,j,k) = kd_2d(i,k) ; enddo ; enddo
505 
506  enddo ! j-loop
507 
508  if (write_diags) then
509  if (cs%id_ML_depth > 0) call post_data(cs%id_ML_depth, cs%ML_depth, cs%diag)
510  if (cs%id_TKE_wind > 0) call post_data(cs%id_TKE_wind, cs%diag_TKE_wind, cs%diag)
511  if (cs%id_TKE_MKE > 0) call post_data(cs%id_TKE_MKE, cs%diag_TKE_MKE, cs%diag)
512  if (cs%id_TKE_conv > 0) call post_data(cs%id_TKE_conv, cs%diag_TKE_conv, cs%diag)
513  if (cs%id_TKE_forcing > 0) call post_data(cs%id_TKE_forcing, cs%diag_TKE_forcing, cs%diag)
514  if (cs%id_TKE_mixing > 0) call post_data(cs%id_TKE_mixing, cs%diag_TKE_mixing, cs%diag)
515  if (cs%id_TKE_mech_decay > 0) &
516  call post_data(cs%id_TKE_mech_decay, cs%diag_TKE_mech_decay, cs%diag)
517  if (cs%id_TKE_conv_decay > 0) &
518  call post_data(cs%id_TKE_conv_decay, cs%diag_TKE_conv_decay, cs%diag)
519  if (cs%id_Mixing_Length > 0) call post_data(cs%id_Mixing_Length, cs%Mixing_Length, cs%diag)
520  if (cs%id_Velocity_Scale >0) call post_data(cs%id_Velocity_Scale, cs%Velocity_Scale, cs%diag)
521  if (cs%id_MSTAR_MIX > 0) call post_data(cs%id_MSTAR_MIX, cs%MSTAR_MIX, cs%diag)
522  if (cs%id_LA > 0) call post_data(cs%id_LA, cs%LA, cs%diag)
523  if (cs%id_LA_MOD > 0) call post_data(cs%id_LA_MOD, cs%LA_MOD, cs%diag)
524  if (cs%id_MSTAR_LT > 0) call post_data(cs%id_MSTAR_LT, cs%MSTAR_LT, cs%diag)
525  endif
526 
527  if (debug) deallocate(ecd%dT_expect, ecd%dS_expect)
528 
529 end subroutine energetic_pbl
530 
531 
532 
533 !> This subroutine determines the diffusivities from the integrated energetics
534 !! mixed layer model for a single column of water.
535 subroutine epbl_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, absf, &
536  u_star, u_star_mean, dt, MLD_io, Kd, mixvel, mixlen, GV, US, CS, eCD, &
537  dt_diag, Waves, G, i, j)
538  type(verticalgrid_type), intent(in) :: GV !< The ocean's vertical grid structure.
539  type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type
540  real, dimension(SZK_(GV)), intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2].
541  real, dimension(SZK_(GV)), intent(in) :: u !< Zonal velocities interpolated to h points
542  !! [m s-1].
543  real, dimension(SZK_(GV)), intent(in) :: v !< Zonal velocities interpolated to h points
544  !! [m s-1].
545  real, dimension(SZK_(GV)), intent(in) :: T0 !< The initial layer temperatures [degC].
546  real, dimension(SZK_(GV)), intent(in) :: S0 !< The initial layer salinities [ppt].
547 
548  real, dimension(SZK_(GV)), intent(in) :: dSV_dT !< The partial derivative of in-situ specific
549  !! volume with potential temperature
550  !! [m3 kg-1 degC-1].
551  real, dimension(SZK_(GV)), intent(in) :: dSV_dS !< The partial derivative of in-situ specific
552  !! volume with salinity [m3 kg-1 ppt-1].
553  real, dimension(SZK_(GV)), intent(in) :: TKE_forcing !< The forcing requirements to homogenize the
554  !! forcing that has been applied to each layer
555  !! [kg m-3 Z3 T-2 ~> J m-2].
556  real, intent(in) :: B_flux !< The surface buoyancy flux [Z2 T-3 ~> m2 s-3]
557  real, intent(in) :: absf !< The absolute value of the Coriolis parameter [T-1].
558  real, intent(in) :: u_star !< The surface friction velocity [Z T-1 ~> m s-1].
559  real, intent(in) :: u_star_mean !< The surface friction velocity without any
560  !! contribution from unresolved gustiness [Z T-1 ~> m s-1].
561  real, intent(inout) :: MLD_io !< A first guess at the mixed layer depth on input, and
562  !! the calculated mixed layer depth on output [Z ~> m].
563  real, intent(in) :: dt !< Time increment [T ~> s].
564  real, dimension(SZK_(GV)+1), &
565  intent(out) :: Kd !< The diagnosed diffusivities at interfaces
566  !! [Z2 T-1 ~> m2 s-1].
567  real, dimension(SZK_(GV)+1), &
568  intent(out) :: mixvel !< The mixing velocity scale used in Kd
569  !! [Z T-1 ~> m s-1].
570  real, dimension(SZK_(GV)+1), &
571  intent(out) :: mixlen !< The mixing length scale used in Kd [Z ~> m].
572  type(energetic_pbl_cs), pointer :: CS !< The control structure returned by a previous
573  !! call to mixedlayer_init.
574  type(epbl_column_diags), intent(inout) :: eCD !< A container for passing around diagnostics.
575  real, optional, intent(in) :: dt_diag !< The diagnostic time step, which may be less
576  !! than dt if there are two calls to mixedlayer [T ~> s].
577  type(wave_parameters_cs), &
578  optional, pointer :: Waves !< Wave CS for Langmuir turbulence
579  type(ocean_grid_type), &
580  optional, intent(inout) :: G !< The ocean's grid structure.
581  integer, optional, intent(in) :: i !< The i-index to work on (used for Waves)
582  integer, optional, intent(in) :: j !< The i-index to work on (used for Waves)
583 
584 ! This subroutine determines the diffusivities in a single column from the integrated energetics
585 ! planetary boundary layer (ePBL) model. It assumes that heating, cooling and freshwater fluxes
586 ! have already been applied. All calculations are done implicitly, and there
587 ! is no stability limit on the time step.
588 !
589 ! For each interior interface, first discard the TKE to account for mixing
590 ! of shortwave radiation through the next denser cell. Next drive mixing based
591 ! on the local? values of ustar + wstar, subject to available energy. This
592 ! step sets the value of Kd(K). Any remaining energy is then subject to decay
593 ! before being handed off to the next interface. mech_TKE and conv_PErel are treated
594 ! separately for the purposes of decay, but are used proportionately to drive
595 ! mixing.
596 
597  ! Local variables
598  real, dimension(SZK_(GV)+1) :: &
599  pres_Z, & ! Interface pressures with a rescaling factor to convert interface height
600  ! movements into changes in column potential energy [kg m-3 Z2 T-2 ~> kg m-1 s-2].
601  hb_hs ! The distance from the bottom over the thickness of the
602  ! water column [nondim].
603  real :: mech_TKE ! The mechanically generated turbulent kinetic energy
604  ! available for mixing over a time step [kg m-3 Z3 T-2 ~> J m-2].
605  real :: conv_PErel ! The potential energy that has been convectively released
606  ! during this timestep [kg m-3 Z3 T-2 ~> J m-2]. A portion nstar_FC
607  ! of conv_PErel is available to drive mixing.
608  real :: htot ! The total depth of the layers above an interface [H ~> m or kg m-2].
609  real :: uhtot ! The depth integrated zonal and meridional velocities in the
610  real :: vhtot ! layers above [H m s-1 ~> m2 s-1 or kg m-1 s-1].
611  real :: Idecay_len_TKE ! The inverse of a turbulence decay length scale [H-1 ~> m-1 or m2 kg-1].
612  real :: h_sum ! The total thickness of the water column [H ~> m or kg m-2].
613 
614  real, dimension(SZK_(GV)) :: &
615  dT_to_dColHt, & ! Partial derivative of the total column height with the temperature changes
616  ! within a layer [Z degC-1 ~> m degC-1].
617  ds_to_dcolht, & ! Partial derivative of the total column height with the salinity changes
618  ! within a layer [Z ppt-1 ~> m ppt-1].
619  dt_to_dpe, & ! Partial derivatives of column potential energy with the temperature
620  ! changes within a layer, in [kg m-3 Z3 T-2 degC-1 ~> J m-2 degC-1].
621  ds_to_dpe, & ! Partial derivatives of column potential energy with the salinity changes
622  ! within a layer, in [kg m-3 Z3 T-2 ppt-1 ~> J m-2 ppt-1].
623  dt_to_dcolht_a, & ! Partial derivative of the total column height with the temperature changes
624  ! within a layer, including the implicit effects of mixing with layers higher
625  ! in the water column [Z degC-1 ~> m degC-1].
626  ds_to_dcolht_a, & ! Partial derivative of the total column height with the salinity changes
627  ! within a layer, including the implicit effects of mixing with layers higher
628  ! in the water column [Z ppt-1 ~> m ppt-1].
629  dt_to_dpe_a, & ! Partial derivatives of column potential energy with the temperature changes
630  ! within a layer, including the implicit effects of mixing with layers higher
631  ! in the water column [kg m-3 Z3 T-2 degC-1 ~> J m-2 degC-1].
632  ds_to_dpe_a, & ! Partial derivative of column potential energy with the salinity changes
633  ! within a layer, including the implicit effects of mixing with layers higher
634  ! in the water column [kg m-3 Z3 T-2 ppt-1 ~> J m-2 ppt-1].
635  c1, & ! c1 is used by the tridiagonal solver [nondim].
636  te, & ! Estimated final values of T in the column [degC].
637  se, & ! Estimated final values of S in the column [ppt].
638  dte, & ! Running (1-way) estimates of temperature change [degC].
639  dse, & ! Running (1-way) estimates of salinity change [ppt].
640  th_a, & ! An effective temperature times a thickness in the layer above, including implicit
641  ! mixing effects with other yet higher layers [degC H ~> degC m or degC kg m-2].
642  sh_a, & ! An effective salinity times a thickness in the layer above, including implicit
643  ! mixing effects with other yet higher layers [ppt H ~> ppt m or ppt kg m-2].
644  th_b, & ! An effective temperature times a thickness in the layer below, including implicit
645  ! mixing effects with other yet lower layers [degC H ~> degC m or degC kg m-2].
646  sh_b ! An effective salinity times a thickness in the layer below, including implicit
647  ! mixing effects with other yet lower layers [ppt H ~> ppt m or ppt kg m-2].
648  real, dimension(SZK_(GV)+1) :: &
649  MixLen_shape, & ! A nondimensional shape factor for the mixing length that
650  ! gives it an appropriate assymptotic value at the bottom of
651  ! the boundary layer.
652  kddt_h ! The diapycnal diffusivity times a timestep divided by the
653  ! average thicknesses around a layer [H ~> m or kg m-2].
654  real :: b1 ! b1 is inverse of the pivot used by the tridiagonal solver [H-1 ~> m-1 or m2 kg-1].
655  real :: hp_a ! An effective pivot thickness of the layer including the effects
656  ! of coupling with layers above [H ~> m or kg m-2]. This is the first term
657  ! in the denominator of b1 in a downward-oriented tridiagonal solver.
658  real :: h_neglect ! A thickness that is so small it is usually lost
659  ! in roundoff and can be neglected [H ~> m or kg m-2].
660  real :: dMass ! The mass per unit area within a layer [Z kg m-3 ~> kg m-2].
661  real :: dPres ! The hydrostatic pressure change across a layer [kg m-3 Z2 T-2 ~> kg m-1 s-2 = Pa].
662  real :: dMKE_max ! The maximum amount of mean kinetic energy that could be
663  ! converted to turbulent kinetic energy if the velocity in
664  ! the layer below an interface were homogenized with all of
665  ! the water above the interface [kg m-3 Z3 T-2 ~> J m-2].
666  real :: MKE2_Hharm ! Twice the inverse of the harmonic mean of the thickness
667  ! of a layer and the thickness of the water above, used in
668  ! the MKE conversion equation [H-1 ~> m-1 or m2 kg-1].
669 
670  real :: dt_h ! The timestep divided by the averages of the thicknesses around
671  ! a layer, times a thickness conversion factor [H T m-2 ~> s m-1 or kg s m-4].
672  real :: h_bot ! The distance from the bottom [H ~> m or kg m-2].
673  real :: h_rsum ! The running sum of h from the top [Z ~> m].
674  real :: I_hs ! The inverse of h_sum [H-1 ~> m-1 or m2 kg-1].
675  real :: I_MLD ! The inverse of the current value of MLD [Z-1 ~> m-1].
676  real :: h_tt ! The distance from the surface or up to the next interface
677  ! that did not exhibit turbulent mixing from this scheme plus
678  ! a surface mixing roughness length given by h_tt_min [H ~> m or kg m-2].
679  real :: h_tt_min ! A surface roughness length [H ~> m or kg m-2].
680 
681  real :: C1_3 ! = 1/3.
682  real :: I_dtrho ! 1.0 / (dt * Rho0) times conversion factors in [m6 Z-3 kg-1 T2 s-3 ~> m3 kg-1 s-1].
683  ! This is used convert TKE back into ustar^3.
684  real :: vstar ! An in-situ turbulent velocity [Z T-1 ~> m s-1].
685  real :: mstar_total ! The value of mstar used in ePBL [nondim]
686  real :: mstar_LT ! An addition to mstar due to Langmuir turbulence [nondim] (output for diagnostic)
687  real :: MLD_output ! The mixed layer depth output from this routine [Z ~> m].
688  real :: LA ! The value of the Langmuir number [nondim]
689  real :: LAmod ! The modified Langmuir number by convection [nondim]
690  real :: hbs_here ! The local minimum of hb_hs and MixLen_shape, times a
691  ! conversion factor from H to Z [Z H-1 ~> 1 or m3 kg-1].
692  real :: nstar_FC ! The fraction of conv_PErel that can be converted to mixing [nondim].
693  real :: TKE_reduc ! The fraction by which TKE and other energy fields are
694  ! reduced to support mixing [nondim]. between 0 and 1.
695  real :: tot_TKE ! The total TKE available to support mixing at interface K [kg m-3 Z3 T-2 ~> J m-2].
696  real :: TKE_here ! The total TKE at this point in the algorithm [kg m-3 Z3 T-2 ~> J m-2].
697  real :: dT_km1_t2 ! A diffusivity-independent term related to the temperature
698  ! change in the layer above the interface [degC].
699  real :: dS_km1_t2 ! A diffusivity-independent term related to the salinity
700  ! change in the layer above the interface [ppt].
701  real :: dTe_term ! A diffusivity-independent term related to the temperature
702  ! change in the layer below the interface [degC H ~> degC m or degC kg m-2].
703  real :: dSe_term ! A diffusivity-independent term related to the salinity
704  ! change in the layer above the interface [ppt H ~> ppt m or ppt kg m-2].
705  real :: dTe_t2 ! A part of dTe_term [degC H ~> degC m or degC kg m-2].
706  real :: dSe_t2 ! A part of dSe_term [ppt H ~> ppt m or ppt kg m-2].
707  real :: dPE_conv ! The convective change in column potential energy [kg m-3 Z3 T-2 ~> J m-2].
708  real :: MKE_src ! The mean kinetic energy source of TKE due to Kddt_h(K) [kg m-3 Z3 T-2 ~> J m-2].
709  real :: dMKE_src_dK ! The partial derivative of MKE_src with Kddt_h(K) [kg m-3 Z3 T-2 H-1 ~> J m-3 or J kg-1].
710  real :: Kd_guess0 ! A first guess of the diapycnal diffusivity [Z2 T-1 ~> m2 s-1].
711  real :: PE_chg_g0 ! The potential energy change when Kd is Kd_guess0 [kg m-3 Z3 T-2 ~> J m-2]
712  real :: dPEa_dKd_g0
713  real :: Kddt_h_g0 ! The first guess diapycnal diffusivity times a timestep divided
714  ! by the average thicknesses around a layer [H ~> m or kg m-2].
715  real :: PE_chg_max ! The maximum PE change for very large values of Kddt_h(K) [kg m-3 Z3 T-2 ~> J m-2].
716  real :: dPEc_dKd_Kd0 ! The partial derivative of PE change with Kddt_h(K)
717  ! for very small values of Kddt_h(K) [kg m-3 Z3 T-2 H-1 ~> J m-3 or J kg-1].
718  real :: PE_chg ! The change in potential energy due to mixing at an
719  ! interface [kg m-3 Z3 T-2 ~> J m-2], positive for the column increasing
720  ! in potential energy (i.e., consuming TKE).
721  real :: TKE_left ! The amount of turbulent kinetic energy left for the most
722  ! recent guess at Kddt_h(K) [kg m-3 Z3 T-2 ~> J m-2].
723  real :: dPEc_dKd ! The partial derivative of PE_chg with Kddt_h(K) [J m-2 H-1 ~> J m-3 or J kg-1].
724  real :: TKE_left_min, TKE_left_max ! Maximum and minimum values of TKE_left [kg m-3 Z3 T-2 ~> J m-2].
725  real :: Kddt_h_max, Kddt_h_min ! Maximum and minimum values of Kddt_h(K) [H ~> m or kg m-2].
726  real :: Kddt_h_guess ! A guess at the value of Kddt_h(K) [H ~> m or kg m-2].
727  real :: Kddt_h_next ! The next guess at the value of Kddt_h(K) [H ~> m or kg m-2].
728  real :: dKddt_h ! The change between guesses at Kddt_h(K) [H ~> m or kg m-2].
729  real :: dKddt_h_Newt ! The change between guesses at Kddt_h(K) with Newton's method [H ~> m or kg m-2].
730  real :: Kddt_h_newt ! The Newton's method next guess for Kddt_h(K) [H ~> m or kg m-2].
731  real :: exp_kh ! The nondimensional decay of TKE across a layer [nondim].
732  real :: vstar_unit_scale ! A unit converion factor for turbulent velocities [Z T-1 s m-1 ~> 1]
733  logical :: use_Newt ! Use Newton's method for the next guess at Kddt_h(K).
734  logical :: convectively_stable ! If true the water column is convectively stable at this interface.
735  logical :: sfc_connected ! If true the ocean is actively turbulent from the present
736  ! interface all the way up to the surface.
737  logical :: sfc_disconnect ! If true, any turbulence has become disconnected
738  ! from the surface.
739 
740 ! The following are only used for diagnostics.
741  real :: dt__diag ! A copy of dt_diag (if present) or dt [T].
742  real :: I_dtdiag ! = 1.0 / dt__diag [T-1 ~> s-1].
743 
744  !----------------------------------------------------------------------
745  !/BGR added Aug24,2016 for adding iteration to get boundary layer depth
746  ! - needed to compute new mixing length.
747  real :: MLD_guess, MLD_found ! Mixing Layer depth guessed/found for iteration [Z ~> m].
748  real :: min_MLD ! Iteration bounds [Z ~> m], which are adjusted at each step
749  real :: max_MLD ! - These are initialized based on surface/bottom
750  ! 1. The iteration guesses a value (possibly from prev step or neighbor).
751  ! 2. The iteration checks if value is converged, too shallow, or too deep.
752  ! 3. Based on result adjusts the Max/Min and searches through the water column.
753  ! - If using an accurate guess the iteration is very quick (e.g. if MLD doesn't
754  ! change over timestep). Otherwise it takes 5-10 passes, but has a high
755  ! convergence rate. Other iteration may be tried, but this method seems to
756  ! fail very rarely and the added cost is likely not significant.
757  ! Additionally, when it fails to converge it does so in a reasonable
758  ! manner giving a usable guess. When it does fail, it is due to convection
759  ! within the boundary layer. Likely, a new method e.g. surface_disconnect,
760  ! can improve this.
761  logical :: FIRST_OBL ! Flag for computing "found" Mixing layer depth
762  logical :: OBL_converged ! Flag for convergence of MLD
763  integer :: OBL_it ! Iteration counter
764 
765  real :: Surface_Scale ! Surface decay scale for vstar
766 
767  logical :: debug=.false. ! Change this hard-coded value for debugging.
768 
769  ! The following arrays are used only for debugging purposes.
770  real :: dPE_debug, mixing_debug, taux2, tauy2
771  real, dimension(20) :: TKE_left_itt, PE_chg_itt, Kddt_h_itt, dPEa_dKd_itt, MKE_src_itt
772  real, dimension(SZK_(GV)) :: mech_TKE_k, conv_PErel_k, nstar_k
773  integer, dimension(SZK_(GV)) :: num_itts
774 
775  integer :: k, nz, itt, max_itt
776 
777  nz = gv%ke
778 
779  if (.not. associated(cs)) call mom_error(fatal, "energetic_PBL: "//&
780  "Module must be initialized before it is used.")
781 
782  debug = .false. ; if (allocated(ecd%dT_expect) .or. allocated(ecd%dS_expect)) debug = .true.
783 
784  h_neglect = gv%H_subroundoff
785 
786  c1_3 = 1.0 / 3.0
787  dt__diag = dt ; if (present(dt_diag)) dt__diag = dt_diag
788  i_dtdiag = 1.0 / dt__diag
789  max_itt = 20
790 
791  h_tt_min = 0.0
792  i_dtrho = 0.0 ; if (dt*gv%Rho0 > 0.0) i_dtrho = (us%Z_to_m**3*us%s_to_T**3) / (dt*gv%Rho0)
793  vstar_unit_scale = us%m_to_Z * us%T_to_s
794 
795  mld_guess = mld_io
796 
797 ! Determine the initial mech_TKE and conv_PErel, including the energy required
798 ! to mix surface heating through the topmost cell, the energy released by mixing
799 ! surface cooling & brine rejection down through the topmost cell, and
800 ! homogenizing the shortwave heating within that cell. This sets the energy
801 ! and ustar and wstar available to drive mixing at the first interior
802 ! interface.
803 
804  do k=1,nz+1 ; kd(k) = 0.0 ; enddo
805 
806  pres_z(1) = 0.0
807  do k=1,nz
808  dmass = us%m_to_Z * gv%H_to_kg_m2 * h(k)
809  dpres = us%L_to_Z**2 * gv%g_Earth * dmass ! Equivalent to GV%H_to_Pa * h(k) with rescaling
810  dt_to_dpe(k) = (dmass * (pres_z(k) + 0.5*dpres)) * dsv_dt(k)
811  ds_to_dpe(k) = (dmass * (pres_z(k) + 0.5*dpres)) * dsv_ds(k)
812  dt_to_dcolht(k) = dmass * dsv_dt(k)
813  ds_to_dcolht(k) = dmass * dsv_ds(k)
814 
815  pres_z(k+1) = pres_z(k) + dpres
816  enddo
817 
818  ! Determine the total thickness (h_sum) and the fractional distance from the bottom (hb_hs).
819  h_sum = h_neglect ; do k=1,nz ; h_sum = h_sum + h(k) ; enddo
820  i_hs = 0.0 ; if (h_sum > 0.0) i_hs = 1.0 / h_sum
821  h_bot = 0.0
822  hb_hs(nz+1) = 0.0
823  do k=nz,1,-1
824  h_bot = h_bot + h(k)
825  hb_hs(k) = h_bot * i_hs
826  enddo
827 
828  mld_output = h(1)*gv%H_to_Z
829 
830  !/The following lines are for the iteration over MLD
831  ! max_MLD will initialized as ocean bottom depth
832  max_mld = 0.0 ; do k=1,nz ; max_mld = max_mld + h(k)*gv%H_to_Z ; enddo
833  !min_MLD will initialize as 0.
834  min_mld = 0.0
835 
836  ! If no first guess is provided for MLD, try the middle of the water column
837  if (mld_guess <= min_mld) mld_guess = 0.5 * (min_mld + max_mld)
838 
839  ! Iterate to determine a converged EPBL depth.
840  obl_converged = .false.
841  do obl_it=1,cs%Max_MLD_Its
842 
843  if (.not. obl_converged) then
844  ! If not using MLD_Iteration flag loop to only execute once.
845  if (.not.cs%Use_MLD_iteration) obl_converged = .true.
846 
847  if (debug) then ; mech_tke_k(:) = 0.0 ; conv_perel_k(:) = 0.0 ; endif
848 
849  ! Reset ML_depth
850  mld_output = h(1)*gv%H_to_Z
851  sfc_connected = .true.
852 
853  !/ Here we get MStar, which is the ratio of convective TKE driven mixing to UStar**3
854  if (cs%Use_LT) then
855  call get_langmuir_number(la, g, gv, us, abs(mld_guess), u_star_mean, i, j, &
856  h=h, u_h=u, v_h=v, waves=waves)
857  call find_mstar(cs, us, b_flux, u_star, u_star_mean, mld_guess, absf, &
858  mstar_total, langmuir_number=la, convect_langmuir_number=lamod,&
859  mstar_lt=mstar_lt)
860  else
861  call find_mstar(cs, us, b_flux, u_star, u_star_mean, mld_guess, absf, mstar_total)
862  endif
863 
864  !/ Apply MStar to get mech_TKE
865  if ((cs%answers_2018) .and. (cs%mstar_scheme==use_fixed_mstar)) then
866  mech_tke = (dt*mstar_total*gv%Rho0) * u_star**3
867  else
868  mech_tke = mstar_total * (dt*gv%Rho0* u_star**3)
869  endif
870 
871  if (cs%TKE_diagnostics) then
872  ecd%dTKE_conv = 0.0 ; ecd%dTKE_mixing = 0.0
873  ecd%dTKE_MKE = 0.0 ; ecd%dTKE_mech_decay = 0.0 ; ecd%dTKE_conv_decay = 0.0
874 
875  ecd%dTKE_wind = mech_tke * i_dtdiag
876  if (tke_forcing(1) <= 0.0) then
877  ecd%dTKE_forcing = max(-mech_tke, tke_forcing(1)) * i_dtdiag
878  ! eCD%dTKE_unbalanced = min(0.0, TKE_forcing(1) + mech_TKE) * I_dtdiag
879  else
880  ecd%dTKE_forcing = cs%nstar*tke_forcing(1) * i_dtdiag
881  ! eCD%dTKE_unbalanced = 0.0
882  endif
883  endif
884 
885  if (tke_forcing(1) <= 0.0) then
886  mech_tke = mech_tke + tke_forcing(1)
887  if (mech_tke < 0.0) mech_tke = 0.0
888  conv_perel = 0.0
889  else
890  conv_perel = tke_forcing(1)
891  endif
892 
893 
894  ! Store in 1D arrays for output.
895  do k=1,nz+1 ; mixvel(k) = 0.0 ; mixlen(k) = 0.0 ; enddo
896 
897  ! Determine the mixing shape function MixLen_shape.
898  if ((.not.cs%Use_MLD_iteration) .or. &
899  (cs%transLay_scale >= 1.0) .or. (cs%transLay_scale < 0.0) ) then
900  do k=1,nz+1
901  mixlen_shape(k) = 1.0
902  enddo
903  elseif (mld_guess <= 0.0) then
904  if (cs%transLay_scale > 0.0) then ; do k=1,nz+1
905  mixlen_shape(k) = cs%transLay_scale
906  enddo ; else ; do k=1,nz+1
907  mixlen_shape(k) = 1.0
908  enddo ; endif
909  else
910  ! Reduce the mixing length based on MLD, with a quadratic
911  ! expression that follows KPP.
912  i_mld = 1.0 / mld_guess
913  h_rsum = 0.0
914  mixlen_shape(1) = 1.0
915  do k=2,nz+1
916  h_rsum = h_rsum + h(k-1)*gv%H_to_Z
917  if (cs%MixLenExponent==2.0) then
918  mixlen_shape(k) = cs%transLay_scale + (1.0 - cs%transLay_scale) * &
919  (max(0.0, (mld_guess - h_rsum)*i_mld) )**2 ! CS%MixLenExponent
920  else
921  mixlen_shape(k) = cs%transLay_scale + (1.0 - cs%transLay_scale) * &
922  (max(0.0, (mld_guess - h_rsum)*i_mld) )**cs%MixLenExponent
923  endif
924  enddo
925  endif
926 
927  kd(1) = 0.0 ; kddt_h(1) = 0.0
928  hp_a = h(1)
929  dt_to_dpe_a(1) = dt_to_dpe(1) ; dt_to_dcolht_a(1) = dt_to_dcolht(1)
930  ds_to_dpe_a(1) = ds_to_dpe(1) ; ds_to_dcolht_a(1) = ds_to_dcolht(1)
931 
932  htot = h(1) ; uhtot = u(1)*h(1) ; vhtot = v(1)*h(1)
933 
934  if (debug) then
935  mech_tke_k(1) = mech_tke ; conv_perel_k(1) = conv_perel
936  nstar_k(:) = 0.0 ; nstar_k(1) = cs%nstar ; num_itts(:) = -1
937  endif
938 
939  do k=2,nz
940  ! Apply dissipation to the TKE, here applied as an exponential decay
941  ! due to 3-d turbulent energy being lost to inefficient rotational modes.
942 
943  ! There should be several different "flavors" of TKE that decay at
944  ! different rates. The following form is often used for mechanical
945  ! stirring from the surface, perhaps due to breaking surface gravity
946  ! waves and wind-driven turbulence.
947  idecay_len_tke = (cs%TKE_decay * absf / u_star) * gv%H_to_Z
948  exp_kh = 1.0
949  if (idecay_len_tke > 0.0) exp_kh = exp(-h(k-1)*idecay_len_tke)
950  if (cs%TKE_diagnostics) &
951  ecd%dTKE_mech_decay = ecd%dTKE_mech_decay + (exp_kh-1.0) * mech_tke * i_dtdiag
952  mech_tke = mech_tke * exp_kh
953 
954  ! Accumulate any convectively released potential energy to contribute
955  ! to wstar and to drive penetrating convection.
956  if (tke_forcing(k) > 0.0) then
957  conv_perel = conv_perel + tke_forcing(k)
958  if (cs%TKE_diagnostics) &
959  ecd%dTKE_forcing = ecd%dTKE_forcing + cs%nstar*tke_forcing(k) * i_dtdiag
960  endif
961 
962  if (debug) then
963  mech_tke_k(k) = mech_tke ; conv_perel_k(k) = conv_perel
964  endif
965 
966  ! Determine the total energy
967  nstar_fc = cs%nstar
968  if (cs%nstar * conv_perel > 0.0) then
969  ! Here nstar is a function of the natural Rossby number 0.2/(1+0.2/Ro), based
970  ! on a curve fit from the data of Wang (GRL, 2003).
971  ! Note: Ro = 1.0 / sqrt(0.5 * dt * Rho0 * (absf*htot)**3 / conv_PErel)
972  nstar_fc = cs%nstar * conv_perel / (conv_perel + 0.2 * &
973  sqrt(0.5 * dt * gv%Rho0 * (absf*(htot*gv%H_to_Z))**3 * conv_perel))
974  endif
975 
976  if (debug) nstar_k(k) = nstar_fc
977 
978  tot_tke = mech_tke + nstar_fc * conv_perel
979 
980  ! For each interior interface, first discard the TKE to account for
981  ! mixing of shortwave radiation through the next denser cell.
982  if (tke_forcing(k) < 0.0) then
983  if (tke_forcing(k) + tot_tke < 0.0) then
984  ! The shortwave requirements deplete all the energy in this layer.
985  if (cs%TKE_diagnostics) then
986  ecd%dTKE_mixing = ecd%dTKE_mixing + tot_tke * i_dtdiag
987  ecd%dTKE_forcing = ecd%dTKE_forcing - tot_tke * i_dtdiag
988  ! eCD%dTKE_unbalanced = eCD%dTKE_unbalanced + (TKE_forcing(k) + tot_TKE) * I_dtdiag
989  ecd%dTKE_conv_decay = ecd%dTKE_conv_decay + (cs%nstar-nstar_fc) * conv_perel * i_dtdiag
990  endif
991  tot_tke = 0.0 ; mech_tke = 0.0 ; conv_perel = 0.0
992  else
993  ! Reduce the mechanical and convective TKE proportionately.
994  tke_reduc = (tot_tke + tke_forcing(k)) / tot_tke
995  if (cs%TKE_diagnostics) then
996  ecd%dTKE_mixing = ecd%dTKE_mixing - tke_forcing(k) * i_dtdiag
997  ecd%dTKE_forcing = ecd%dTKE_forcing + tke_forcing(k) * i_dtdiag
998  ecd%dTKE_conv_decay = ecd%dTKE_conv_decay + &
999  (1.0-tke_reduc)*(cs%nstar-nstar_fc) * conv_perel * i_dtdiag
1000  endif
1001  tot_tke = tke_reduc*tot_tke ! = tot_TKE + TKE_forcing(k)
1002  mech_tke = tke_reduc*mech_tke
1003  conv_perel = tke_reduc*conv_perel
1004  endif
1005  endif
1006 
1007  ! Precalculate some temporary expressions that are independent of Kddt_h(K).
1008  if (cs%orig_PE_calc) then
1009  if (k==2) then
1010  dte_t2 = 0.0 ; dse_t2 = 0.0
1011  else
1012  dte_t2 = kddt_h(k-1) * ((t0(k-2) - t0(k-1)) + dte(k-2))
1013  dse_t2 = kddt_h(k-1) * ((s0(k-2) - s0(k-1)) + dse(k-2))
1014  endif
1015  endif
1016  dt_h = (gv%Z_to_H**2*dt) / max(0.5*(h(k-1)+h(k)), 1e-15*h_sum)
1017 
1018  ! This tests whether the layers above and below this interface are in
1019  ! a convetively stable configuration, without considering any effects of
1020  ! mixing at higher interfaces. It is an approximation to the more
1021  ! complete test dPEc_dKd_Kd0 >= 0.0, that would include the effects of
1022  ! mixing across interface K-1. The dT_to_dColHt here are effectively
1023  ! mass-weigted estimates of dSV_dT.
1024  convectively_stable = ( 0.0 <= &
1025  ( (dt_to_dcolht(k) + dt_to_dcolht(k-1) ) * (t0(k-1)-t0(k)) + &
1026  (ds_to_dcolht(k) + ds_to_dcolht(k-1) ) * (s0(k-1)-s0(k)) ) )
1027 
1028  if ((mech_tke + conv_perel) <= 0.0 .and. convectively_stable) then
1029  ! Energy is already exhausted, so set Kd = 0 and cycle or exit?
1030  tot_tke = 0.0 ; mech_tke = 0.0 ; conv_perel = 0.0
1031  kd(k) = 0.0 ; kddt_h(k) = 0.0
1032  sfc_disconnect = .true.
1033  ! if (.not.debug) exit
1034 
1035  ! The estimated properties for layer k-1 can be calculated, using
1036  ! greatly simplified expressions when Kddt_h = 0. This enables the
1037  ! tridiagonal solver for the whole column to be completed for debugging
1038  ! purposes, and also allows for something akin to convective adjustment
1039  ! in unstable interior regions?
1040  b1 = 1.0 / hp_a
1041  c1(k) = 0.0
1042  if (cs%orig_PE_calc) then
1043  dte(k-1) = b1 * ( dte_t2 )
1044  dse(k-1) = b1 * ( dse_t2 )
1045  endif
1046 
1047  hp_a = h(k)
1048  dt_to_dpe_a(k) = dt_to_dpe(k)
1049  ds_to_dpe_a(k) = ds_to_dpe(k)
1050  dt_to_dcolht_a(k) = dt_to_dcolht(k)
1051  ds_to_dcolht_a(k) = ds_to_dcolht(k)
1052 
1053  else ! tot_TKE > 0.0 or this is a potentially convectively unstable profile.
1054  sfc_disconnect = .false.
1055 
1056  ! Precalculate some more temporary expressions that are independent of
1057  ! Kddt_h(K).
1058  if (cs%orig_PE_calc) then
1059  if (k==2) then
1060  dt_km1_t2 = (t0(k)-t0(k-1))
1061  ds_km1_t2 = (s0(k)-s0(k-1))
1062  else
1063  dt_km1_t2 = (t0(k)-t0(k-1)) - &
1064  (kddt_h(k-1) / hp_a) * ((t0(k-2) - t0(k-1)) + dte(k-2))
1065  ds_km1_t2 = (s0(k)-s0(k-1)) - &
1066  (kddt_h(k-1) / hp_a) * ((s0(k-2) - s0(k-1)) + dse(k-2))
1067  endif
1068  dte_term = dte_t2 + hp_a * (t0(k-1)-t0(k))
1069  dse_term = dse_t2 + hp_a * (s0(k-1)-s0(k))
1070  else
1071  if (k<=2) then
1072  th_a(k-1) = h(k-1) * t0(k-1) ; sh_a(k-1) = h(k-1) * s0(k-1)
1073  else
1074  th_a(k-1) = h(k-1) * t0(k-1) + kddt_h(k-1) * te(k-2)
1075  sh_a(k-1) = h(k-1) * s0(k-1) + kddt_h(k-1) * se(k-2)
1076  endif
1077  th_b(k) = h(k) * t0(k) ; sh_b(k) = h(k) * s0(k)
1078  endif
1079 
1080  ! Using Pr=1 and the diffusivity at the bottom interface (once it is
1081  ! known), determine how much resolved mean kinetic energy (MKE) will be
1082  ! extracted within a timestep and add a fraction CS%MKE_to_TKE_effic of
1083  ! this to the mTKE budget available for mixing in the next layer.
1084 
1085  if ((cs%MKE_to_TKE_effic > 0.0) .and. (htot*h(k) > 0.0)) then
1086  ! This is the energy that would be available from homogenizing the
1087  ! velocities between layer k and the layers above.
1088  dmke_max = (us%m_to_Z**3*us%T_to_s**2)*(gv%H_to_kg_m2 * cs%MKE_to_TKE_effic) * 0.5 * &
1089  (h(k) / ((htot + h(k))*htot)) * &
1090  ((uhtot-u(k)*htot)**2 + (vhtot-v(k)*htot)**2)
1091  ! A fraction (1-exp(Kddt_h*MKE2_Hharm)) of this energy would be
1092  ! extracted by mixing with a finite viscosity.
1093  mke2_hharm = (htot + h(k) + 2.0*h_neglect) / &
1094  ((htot+h_neglect) * (h(k)+h_neglect))
1095  else
1096  dmke_max = 0.0
1097  mke2_hharm = 0.0
1098  endif
1099 
1100  ! At this point, Kddt_h(K) will be unknown because its value may depend
1101  ! on how much energy is available. mech_TKE might be negative due to
1102  ! contributions from TKE_forced.
1103  h_tt = htot + h_tt_min
1104  tke_here = mech_tke + cs%wstar_ustar_coef*conv_perel
1105  if (tke_here > 0.0) then
1106  if (cs%wT_scheme==wt_from_croot_tke) then
1107  vstar = cs%vstar_scale_fac * vstar_unit_scale * (i_dtrho*tke_here)**c1_3
1108  elseif (cs%wT_scheme==wt_from_rh18) then
1109  surface_scale = max(0.05, 1.0 - htot/mld_guess)
1110  vstar = cs%vstar_scale_fac * surface_scale * (cs%vstar_surf_fac*u_star + &
1111  vstar_unit_scale * (cs%wstar_ustar_coef*conv_perel*i_dtrho)**c1_3)
1112  endif
1113  hbs_here = gv%H_to_Z * min(hb_hs(k), mixlen_shape(k))
1114  mixlen(k) = max(cs%min_mix_len, ((h_tt*hbs_here)*vstar) / &
1115  ((cs%Ekman_scale_coef * absf) * (h_tt*hbs_here) + vstar))
1116  !Note setting Kd_guess0 to vstar * CS%vonKar * mixlen(K) here will
1117  ! change the answers. Therefore, skipping that.
1118  if (.not.cs%Use_MLD_iteration) then
1119  kd_guess0 = vstar * cs%vonKar * ((h_tt*hbs_here)*vstar) / &
1120  ((cs%Ekman_scale_coef * absf) * (h_tt*hbs_here) + vstar)
1121  else
1122  kd_guess0 = vstar * cs%vonKar * mixlen(k)
1123  endif
1124  else
1125  vstar = 0.0 ; kd_guess0 = 0.0
1126  endif
1127  mixvel(k) = vstar ! Track vstar
1128  kddt_h_g0 = kd_guess0 * dt_h
1129 
1130  if (cs%orig_PE_calc) then
1131  call find_pe_chg_orig(kddt_h_g0, h(k), hp_a, dte_term, dse_term, &
1132  dt_km1_t2, ds_km1_t2, dt_to_dpe(k), ds_to_dpe(k), &
1133  dt_to_dpe_a(k-1), ds_to_dpe_a(k-1), &
1134  pres_z(k), dt_to_dcolht(k), ds_to_dcolht(k), &
1135  dt_to_dcolht_a(k-1), ds_to_dcolht_a(k-1), &
1136  pe_chg=pe_chg_g0, dpec_dkd=dpea_dkd_g0, dpe_max=pe_chg_max, &
1137  dpec_dkd_0=dpec_dkd_kd0 )
1138  else
1139  call find_pe_chg(0.0, kddt_h_g0, hp_a, h(k), &
1140  th_a(k-1), sh_a(k-1), th_b(k), sh_b(k), &
1141  dt_to_dpe_a(k-1), ds_to_dpe_a(k-1), dt_to_dpe(k), ds_to_dpe(k), &
1142  pres_z(k), dt_to_dcolht_a(k-1), ds_to_dcolht_a(k-1), &
1143  dt_to_dcolht(k), ds_to_dcolht(k), &
1144  pe_chg=pe_chg_g0, dpec_dkd=dpea_dkd_g0, dpe_max=pe_chg_max, &
1145  dpec_dkd_0=dpec_dkd_kd0 )
1146  endif
1147 
1148  mke_src = dmke_max*(1.0 - exp(-kddt_h_g0 * mke2_hharm))
1149 
1150  ! This block checks out different cases to determine Kd at the present interface.
1151  if ((pe_chg_g0 < 0.0) .or. ((vstar == 0.0) .and. (dpec_dkd_kd0 < 0.0))) then
1152  ! This column is convectively unstable.
1153  if (pe_chg_max <= 0.0) then
1154  ! Does MKE_src need to be included in the calculation of vstar here?
1155  tke_here = mech_tke + cs%wstar_ustar_coef*(conv_perel-pe_chg_max)
1156  if (tke_here > 0.0) then
1157  if (cs%wT_scheme==wt_from_croot_tke) then
1158  vstar = cs%vstar_scale_fac * vstar_unit_scale * (i_dtrho*tke_here)**c1_3
1159  elseif (cs%wT_scheme==wt_from_rh18) then
1160  surface_scale = max(0.05, 1. - htot/mld_guess)
1161  vstar = cs%vstar_scale_fac * surface_scale * (cs%vstar_surf_fac*u_star + &
1162  vstar_unit_scale * (cs%wstar_ustar_coef*conv_perel*i_dtrho)**c1_3)
1163  endif
1164  hbs_here = gv%H_to_Z * min(hb_hs(k), mixlen_shape(k))
1165  mixlen(k) = max(cs%min_mix_len, ((h_tt*hbs_here)*vstar) / &
1166  ((cs%Ekman_scale_coef * absf) * (h_tt*hbs_here) + vstar))
1167  if (.not.cs%Use_MLD_iteration) then
1168  ! Note again (as prev) that using mixlen here
1169  ! instead of redoing the computation will change answers...
1170  kd(k) = vstar * cs%vonKar * ((h_tt*hbs_here)*vstar) / &
1171  ((cs%Ekman_scale_coef * absf) * (h_tt*hbs_here) + vstar)
1172  else
1173  kd(k) = vstar * cs%vonKar * mixlen(k)
1174  endif
1175  else
1176  vstar = 0.0 ; kd(k) = 0.0
1177  endif
1178  mixvel(k) = vstar
1179 
1180  if (cs%orig_PE_calc) then
1181  call find_pe_chg_orig(kd(k)*dt_h, h(k), hp_a, dte_term, dse_term, &
1182  dt_km1_t2, ds_km1_t2, dt_to_dpe(k), ds_to_dpe(k), &
1183  dt_to_dpe_a(k-1), ds_to_dpe_a(k-1), &
1184  pres_z(k), dt_to_dcolht(k), ds_to_dcolht(k), &
1185  dt_to_dcolht_a(k-1), ds_to_dcolht_a(k-1), &
1186  pe_chg=dpe_conv)
1187  else
1188  call find_pe_chg(0.0, kd(k)*dt_h, hp_a, h(k), &
1189  th_a(k-1), sh_a(k-1), th_b(k), sh_b(k), &
1190  dt_to_dpe_a(k-1), ds_to_dpe_a(k-1), dt_to_dpe(k), ds_to_dpe(k), &
1191  pres_z(k), dt_to_dcolht_a(k-1), ds_to_dcolht_a(k-1), &
1192  dt_to_dcolht(k), ds_to_dcolht(k), &
1193  pe_chg=dpe_conv)
1194  endif
1195  ! Should this be iterated to convergence for Kd?
1196  if (dpe_conv > 0.0) then
1197  kd(k) = kd_guess0 ; dpe_conv = pe_chg_g0
1198  else
1199  mke_src = dmke_max*(1.0 - exp(-(kd(k)*dt_h) * mke2_hharm))
1200  endif
1201  else
1202  ! The energy change does not vary monotonically with Kddt_h. Find the maximum?
1203  kd(k) = kd_guess0 ; dpe_conv = pe_chg_g0
1204  endif
1205 
1206  conv_perel = conv_perel - dpe_conv
1207  mech_tke = mech_tke + mke_src
1208  if (cs%TKE_diagnostics) then
1209  ecd%dTKE_conv = ecd%dTKE_conv - cs%nstar*dpe_conv * i_dtdiag
1210  ecd%dTKE_MKE = ecd%dTKE_MKE + mke_src * i_dtdiag
1211  endif
1212  if (sfc_connected) then
1213  mld_output = mld_output + gv%H_to_Z * h(k)
1214  endif
1215 
1216  kddt_h(k) = kd(k) * dt_h
1217  elseif (tot_tke + (mke_src - pe_chg_g0) >= 0.0) then
1218  ! This column is convctively stable and there is energy to support the suggested
1219  ! mixing. Keep that estimate.
1220  kd(k) = kd_guess0
1221  kddt_h(k) = kddt_h_g0
1222 
1223  ! Reduce the mechanical and convective TKE proportionately.
1224  tot_tke = tot_tke + mke_src
1225  tke_reduc = 0.0 ! tot_TKE could be 0 if Convectively_stable is false.
1226  if (tot_tke > 0.0) tke_reduc = (tot_tke - pe_chg_g0) / tot_tke
1227  if (cs%TKE_diagnostics) then
1228  ecd%dTKE_mixing = ecd%dTKE_mixing - pe_chg_g0 * i_dtdiag
1229  ecd%dTKE_MKE = ecd%dTKE_MKE + mke_src * i_dtdiag
1230  ecd%dTKE_conv_decay = ecd%dTKE_conv_decay + &
1231  (1.0-tke_reduc)*(cs%nstar-nstar_fc) * conv_perel * i_dtdiag
1232  endif
1233  tot_tke = tke_reduc*tot_tke
1234  mech_tke = tke_reduc*(mech_tke + mke_src)
1235  conv_perel = tke_reduc*conv_perel
1236  if (sfc_connected) then
1237  mld_output = mld_output + gv%H_to_Z * h(k)
1238  endif
1239 
1240  elseif (tot_tke == 0.0) then
1241  ! This can arise if nstar_FC = 0, but it is not common.
1242  kd(k) = 0.0 ; kddt_h(k) = 0.0
1243  tot_tke = 0.0 ; conv_perel = 0.0 ; mech_tke = 0.0
1244  sfc_disconnect = .true.
1245  else
1246  ! There is not enough energy to support the mixing, so reduce the
1247  ! diffusivity to what can be supported.
1248  kddt_h_max = kddt_h_g0 ; kddt_h_min = 0.0
1249  tke_left_max = tot_tke + (mke_src - pe_chg_g0)
1250  tke_left_min = tot_tke
1251 
1252  ! As a starting guess, take the minimum of a false position estimate
1253  ! and a Newton's method estimate starting from Kddt_h = 0.0.
1254  kddt_h_guess = tot_tke * kddt_h_max / max( pe_chg_g0 - mke_src, &
1255  kddt_h_max * (dpec_dkd_kd0 - dmke_max * mke2_hharm) )
1256  ! The above expression is mathematically the same as the following
1257  ! except it is not susceptible to division by zero when
1258  ! dPEc_dKd_Kd0 = dMKE_max = 0 .
1259  ! Kddt_h_guess = tot_TKE * min( Kddt_h_max / (PE_chg_g0 - MKE_src), &
1260  ! 1.0 / (dPEc_dKd_Kd0 - dMKE_max * MKE2_Hharm) )
1261  if (debug) then
1262  tke_left_itt(:) = 0.0 ; dpea_dkd_itt(:) = 0.0 ; pe_chg_itt(:) = 0.0
1263  mke_src_itt(:) = 0.0 ; kddt_h_itt(:) = 0.0
1264  endif
1265  do itt=1,max_itt
1266  if (cs%orig_PE_calc) then
1267  call find_pe_chg_orig(kddt_h_guess, h(k), hp_a, dte_term, dse_term, &
1268  dt_km1_t2, ds_km1_t2, dt_to_dpe(k), ds_to_dpe(k), &
1269  dt_to_dpe_a(k-1), ds_to_dpe_a(k-1), &
1270  pres_z(k), dt_to_dcolht(k), ds_to_dcolht(k), &
1271  dt_to_dcolht_a(k-1), ds_to_dcolht_a(k-1), &
1272  pe_chg=pe_chg, dpec_dkd=dpec_dkd )
1273  else
1274  call find_pe_chg(0.0, kddt_h_guess, hp_a, h(k), &
1275  th_a(k-1), sh_a(k-1), th_b(k), sh_b(k), &
1276  dt_to_dpe_a(k-1), ds_to_dpe_a(k-1), dt_to_dpe(k), ds_to_dpe(k), &
1277  pres_z(k), dt_to_dcolht_a(k-1), ds_to_dcolht_a(k-1), &
1278  dt_to_dcolht(k), ds_to_dcolht(k), &
1279  pe_chg=dpe_conv)
1280  endif
1281  mke_src = dmke_max * (1.0 - exp(-mke2_hharm * kddt_h_guess))
1282  dmke_src_dk = dmke_max * mke2_hharm * exp(-mke2_hharm * kddt_h_guess)
1283 
1284  tke_left = tot_tke + (mke_src - pe_chg)
1285  if (debug .and. itt<=20) then
1286  kddt_h_itt(itt) = kddt_h_guess ; mke_src_itt(itt) = mke_src
1287  pe_chg_itt(itt) = pe_chg ; dpea_dkd_itt(itt) = dpec_dkd
1288  tke_left_itt(itt) = tke_left
1289  endif
1290  ! Store the new bounding values, bearing in mind that min and max
1291  ! here refer to Kddt_h and dTKE_left/dKddt_h < 0:
1292  if (tke_left >= 0.0) then
1293  kddt_h_min = kddt_h_guess ; tke_left_min = tke_left
1294  else
1295  kddt_h_max = kddt_h_guess ; tke_left_max = tke_left
1296  endif
1297 
1298  ! Try to use Newton's method, but if it would go outside the bracketed
1299  ! values use the false-position method instead.
1300  use_newt = .true.
1301  if (dpec_dkd - dmke_src_dk <= 0.0) then
1302  use_newt = .false.
1303  else
1304  dkddt_h_newt = tke_left / (dpec_dkd - dmke_src_dk)
1305  kddt_h_newt = kddt_h_guess + dkddt_h_newt
1306  if ((kddt_h_newt > kddt_h_max) .or. (kddt_h_newt < kddt_h_min)) &
1307  use_newt = .false.
1308  endif
1309 
1310  if (use_newt) then
1311  kddt_h_next = kddt_h_guess + dkddt_h_newt
1312  dkddt_h = dkddt_h_newt
1313  else
1314  kddt_h_next = (tke_left_max * kddt_h_min - kddt_h_max * tke_left_min) / &
1315  (tke_left_max - tke_left_min)
1316  dkddt_h = kddt_h_next - kddt_h_guess
1317  endif
1318 
1319  if ((abs(dkddt_h) < 1e-9*kddt_h_guess) .or. (itt==max_itt)) then
1320  ! Use the old value so that the energy calculation does not need to be repeated.
1321  if (debug) num_itts(k) = itt
1322  exit
1323  else
1324  kddt_h_guess = kddt_h_next
1325  endif
1326  enddo ! Inner iteration loop on itt.
1327  kd(k) = kddt_h_guess / dt_h ; kddt_h(k) = kd(k) * dt_h
1328 
1329  ! All TKE should have been consumed.
1330  if (cs%TKE_diagnostics) then
1331  ecd%dTKE_mixing = ecd%dTKE_mixing - (tot_tke + mke_src) * i_dtdiag
1332  ecd%dTKE_MKE = ecd%dTKE_MKE + mke_src * i_dtdiag
1333  ecd%dTKE_conv_decay = ecd%dTKE_conv_decay + &
1334  (cs%nstar-nstar_fc) * conv_perel * i_dtdiag
1335  endif
1336 
1337  if (sfc_connected) mld_output = mld_output + &
1338  (pe_chg / (pe_chg_g0)) * gv%H_to_Z * h(k)
1339 
1340  tot_tke = 0.0 ; mech_tke = 0.0 ; conv_perel = 0.0
1341  sfc_disconnect = .true.
1342  endif ! End of convective or forced mixing cases to determine Kd.
1343 
1344  kddt_h(k) = kd(k) * dt_h
1345  ! At this point, the final value of Kddt_h(K) is known, so the
1346  ! estimated properties for layer k-1 can be calculated.
1347  b1 = 1.0 / (hp_a + kddt_h(k))
1348  c1(k) = kddt_h(k) * b1
1349  if (cs%orig_PE_calc) then
1350  dte(k-1) = b1 * ( kddt_h(k)*(t0(k)-t0(k-1)) + dte_t2 )
1351  dse(k-1) = b1 * ( kddt_h(k)*(s0(k)-s0(k-1)) + dse_t2 )
1352  endif
1353 
1354  hp_a = h(k) + (hp_a * b1) * kddt_h(k)
1355  dt_to_dpe_a(k) = dt_to_dpe(k) + c1(k)*dt_to_dpe_a(k-1)
1356  ds_to_dpe_a(k) = ds_to_dpe(k) + c1(k)*ds_to_dpe_a(k-1)
1357  dt_to_dcolht_a(k) = dt_to_dcolht(k) + c1(k)*dt_to_dcolht_a(k-1)
1358  ds_to_dcolht_a(k) = ds_to_dcolht(k) + c1(k)*ds_to_dcolht_a(k-1)
1359 
1360  endif ! tot_TKT > 0.0 branch. Kddt_h(K) has been set.
1361 
1362  ! Store integrated velocities and thicknesses for MKE conversion calculations.
1363  if (sfc_disconnect) then
1364  ! There is no turbulence at this interface, so zero out the running sums.
1365  uhtot = u(k)*h(k)
1366  vhtot = v(k)*h(k)
1367  htot = h(k)
1368  sfc_connected = .false.
1369  else
1370  uhtot = uhtot + u(k)*h(k)
1371  vhtot = vhtot + v(k)*h(k)
1372  htot = htot + h(k)
1373  endif
1374 
1375  if (debug) then
1376  if (k==2) then
1377  te(1) = b1*(h(1)*t0(1))
1378  se(1) = b1*(h(1)*s0(1))
1379  else
1380  te(k-1) = b1 * (h(k-1) * t0(k-1) + kddt_h(k-1) * te(k-2))
1381  se(k-1) = b1 * (h(k-1) * s0(k-1) + kddt_h(k-1) * se(k-2))
1382  endif
1383  endif
1384  enddo
1385  kd(nz+1) = 0.0
1386 
1387  if (debug) then
1388  ! Complete the tridiagonal solve for Te.
1389  b1 = 1.0 / hp_a
1390  te(nz) = b1 * (h(nz) * t0(nz) + kddt_h(nz) * te(nz-1))
1391  se(nz) = b1 * (h(nz) * s0(nz) + kddt_h(nz) * se(nz-1))
1392  ecd%dT_expect(nz) = te(nz) - t0(nz) ; ecd%dS_expect(nz) = se(nz) - s0(nz)
1393  do k=nz-1,1,-1
1394  te(k) = te(k) + c1(k+1)*te(k+1)
1395  se(k) = se(k) + c1(k+1)*se(k+1)
1396  ecd%dT_expect(k) = te(k) - t0(k) ; ecd%dS_expect(k) = se(k) - s0(k)
1397  enddo
1398 
1399  dpe_debug = 0.0
1400  do k=1,nz
1401  dpe_debug = dpe_debug + (dt_to_dpe(k) * (te(k) - t0(k)) + &
1402  ds_to_dpe(k) * (se(k) - s0(k)))
1403  enddo
1404  mixing_debug = dpe_debug * i_dtdiag
1405  endif
1406  k = nz ! This is here to allow a breakpoint to be set.
1407  !/BGR
1408  ! The following lines are used for the iteration
1409  ! note the iteration has been altered to use the value predicted by
1410  ! the TKE threshold (ML_DEPTH). This is because the MSTAR
1411  ! is now dependent on the ML, and therefore the ML needs to be estimated
1412  ! more precisely than the grid spacing.
1413 
1414  !New method uses ML_DEPTH as computed in ePBL routine
1415  mld_found = mld_output
1416  if (mld_found - cs%MLD_tol > mld_guess) then
1417  min_mld = mld_guess
1418  elseif (abs(mld_guess - mld_found) < cs%MLD_tol) then
1419  obl_converged = .true. ! Break convergence loop
1420  else
1421  max_mld = mld_guess ! We know this guess was too deep
1422  endif
1423 
1424  ! For next pass, guess average of minimum and maximum values.
1425  !### We should try using the false position method instead of simple bisection.
1426  mld_guess = 0.5*(min_mld + max_mld)
1427  endif
1428  enddo ! Iteration loop for converged boundary layer thickness.
1429  if (cs%Use_LT) then
1430  ecd%LA = la ; ecd%LAmod = lamod ; ecd%mstar = mstar_total ; ecd%mstar_LT = mstar_lt
1431  else
1432  ecd%LA = 0.0 ; ecd%LAmod = 0.0 ; ecd%mstar = mstar_total ; ecd%mstar_LT = 0.0
1433  endif
1434 
1435  mld_io = mld_output
1436 
1437 end subroutine epbl_column
1438 
1439 !> This subroutine calculates the change in potential energy and or derivatives
1440 !! for several changes in an interfaces's diapycnal diffusivity times a timestep.
1441 subroutine find_pe_chg(Kddt_h0, dKddt_h, hp_a, hp_b, Th_a, Sh_a, Th_b, Sh_b, &
1442  dT_to_dPE_a, dS_to_dPE_a, dT_to_dPE_b, dS_to_dPE_b, &
1443  pres_Z, dT_to_dColHt_a, dS_to_dColHt_a, dT_to_dColHt_b, dS_to_dColHt_b, &
1444  PE_chg, dPEc_dKd, dPE_max, dPEc_dKd_0, ColHt_cor)
1445  real, intent(in) :: Kddt_h0 !< The previously used diffusivity at an interface times
1446  !! the time step and divided by the average of the
1447  !! thicknesses around the interface [H ~> m or kg m-2].
1448  real, intent(in) :: dKddt_h !< The trial change in the diffusivity at an interface times
1449  !! the time step and divided by the average of the
1450  !! thicknesses around the interface [H ~> m or kg m-2].
1451  real, intent(in) :: hp_a !< The effective pivot thickness of the layer above the
1452  !! interface, given by h_k plus a term that
1453  !! is a fraction (determined from the tridiagonal solver) of
1454  !! Kddt_h for the interface above [H ~> m or kg m-2].
1455  real, intent(in) :: hp_b !< The effective pivot thickness of the layer below the
1456  !! interface, given by h_k plus a term that
1457  !! is a fraction (determined from the tridiagonal solver) of
1458  !! Kddt_h for the interface above [H ~> m or kg m-2].
1459  real, intent(in) :: Th_a !< An effective temperature times a thickness in the layer
1460  !! above, including implicit mixing effects with other
1461  !! yet higher layers [degC H ~> degC m or degC kg m-2].
1462  real, intent(in) :: Sh_a !< An effective salinity times a thickness in the layer
1463  !! above, including implicit mixing effects with other
1464  !! yet higher layers [degC H ~> degC m or degC kg m-2].
1465  real, intent(in) :: Th_b !< An effective temperature times a thickness in the layer
1466  !! below, including implicit mixfing effects with other
1467  !! yet lower layers [degC H ~> degC m or degC kg m-2].
1468  real, intent(in) :: Sh_b !< An effective salinity times a thickness in the layer
1469  !! below, including implicit mixing effects with other
1470  !! yet lower layers [degC H ~> degC m or degC kg m-2].
1471  real, intent(in) :: dT_to_dPE_a !< A factor (pres_lay*mass_lay*dSpec_vol/dT) relating
1472  !! a layer's temperature change to the change in column potential
1473  !! energy, including all implicit diffusive changes in the
1474  !! temperatures of all the layers above [kg m-3 Z3 T-2 degC-1 ~> J m-2 degC-1].
1475  real, intent(in) :: dS_to_dPE_a !< A factor (pres_lay*mass_lay*dSpec_vol/dS) relating
1476  !! a layer's salinity change to the change in column potential
1477  !! energy, including all implicit diffusive changes in the
1478  !! salinities of all the layers above [kg m-3 Z3 T-2 ppt-1 ~> J m-2 ppt-1].
1479  real, intent(in) :: dT_to_dPE_b !< A factor (pres_lay*mass_lay*dSpec_vol/dT) relating
1480  !! a layer's temperature change to the change in column potential
1481  !! energy, including all implicit diffusive changes in the
1482  !! temperatures of all the layers below [kg m-3 Z3 T-2 degC-1 ~> J m-2 degC-1].
1483  real, intent(in) :: dS_to_dPE_b !< A factor (pres_lay*mass_lay*dSpec_vol/dS) relating
1484  !! a layer's salinity change to the change in column potential
1485  !! energy, including all implicit diffusive changes in the
1486  !! salinities of all the layers below [kg m-3 Z3 T-2 ppt-1 ~> J m-2 ppt-1].
1487  real, intent(in) :: pres_Z !< The rescaled hydrostatic interface pressure, which relates
1488  !! the changes in column thickness to the energy that is radiated
1489  !! as gravity waves and unavailable to drive mixing [J m-2 Z-1 ~> J m-3].
1490  real, intent(in) :: dT_to_dColHt_a !< A factor (mass_lay*dSColHtc_vol/dT) relating
1491  !! a layer's temperature change to the change in column
1492  !! height, including all implicit diffusive changes
1493  !! in the temperatures of all the layers above [Z degC-1 ~> m degC-1].
1494  real, intent(in) :: dS_to_dColHt_a !< A factor (mass_lay*dSColHtc_vol/dS) relating
1495  !! a layer's salinity change to the change in column
1496  !! height, including all implicit diffusive changes
1497  !! in the salinities of all the layers above [Z ppt-1 ~> m ppt-1].
1498  real, intent(in) :: dT_to_dColHt_b !< A factor (mass_lay*dSColHtc_vol/dT) relating
1499  !! a layer's temperature change to the change in column
1500  !! height, including all implicit diffusive changes
1501  !! in the temperatures of all the layers below [Z degC-1 ~> m degC-1].
1502  real, intent(in) :: dS_to_dColHt_b !< A factor (mass_lay*dSColHtc_vol/dS) relating
1503  !! a layer's salinity change to the change in column
1504  !! height, including all implicit diffusive changes
1505  !! in the salinities of all the layers below [Z ppt-1 ~> m ppt-1].
1506 
1507  real, optional, intent(out) :: PE_chg !< The change in column potential energy from applying
1508  !! Kddt_h at the present interface [kg m-3 Z3 T-2 ~> J m-2].
1509  real, optional, intent(out) :: dPEc_dKd !< The partial derivative of PE_chg with Kddt_h
1510  !! [J m-2 H-1 ~> J m-3 or J kg-1].
1511  real, optional, intent(out) :: dPE_max !< The maximum change in column potential energy that could
1512  !! be realizedd by applying a huge value of Kddt_h at the
1513  !! present interface [kg m-3 Z3 T-2 ~> J m-2].
1514  real, optional, intent(out) :: dPEc_dKd_0 !< The partial derivative of PE_chg with Kddt_h in the
1515  !! limit where Kddt_h = 0 [kg m-3 Z3 T-2 H-1 ~> J m-3 or J kg-1].
1516  real, optional, intent(out) :: ColHt_cor !< The correction to PE_chg that is made due to a net
1517  !! change in the column height [kg m-3 Z3 T-2 ~> J m-2].
1518 
1519  real :: hps ! The sum of the two effective pivot thicknesses [H ~> m or kg m-2].
1520  real :: bdt1 ! A product of the two pivot thicknesses plus a diffusive term [H2 ~> m2 or kg2 m-4].
1521  real :: dT_c ! The core term in the expressions for the temperature changes [degC H2 ~> degC m2 or degC kg2 m-4].
1522  real :: dS_c ! The core term in the expressions for the salinity changes [ppt H2 ~> ppt m2 or ppt kg2 m-4].
1523  real :: PEc_core ! The diffusivity-independent core term in the expressions
1524  ! for the potential energy changes [kg m-3 Z2 T-2 ~> J m-3].
1525  real :: ColHt_core ! The diffusivity-independent core term in the expressions
1526  ! for the column height changes [H Z ~> m2 or kg m-1].
1527  real :: ColHt_chg ! The change in the column height [H ~> m or kg m-2].
1528  real :: y1_3 ! A local temporary term in [H-3 ~> m-3 or m6 kg-3].
1529  real :: y1_4 ! A local temporary term in [H-4 ~> m-4 or m8 kg-4].
1530 
1531  ! The expression for the change in potential energy used here is derived
1532  ! from the expression for the final estimates of the changes in temperature
1533  ! and salinities, and then extensively manipulated to get it into its most
1534  ! succint form. The derivation is not necessarily obvious, but it demonstrably
1535  ! works by comparison with separate calculations of the energy changes after
1536  ! the tridiagonal solver for the final changes in temperature and salinity are
1537  ! applied.
1538 
1539  hps = hp_a + hp_b
1540  bdt1 = hp_a * hp_b + kddt_h0 * hps
1541  dt_c = hp_a * th_b - hp_b * th_a
1542  ds_c = hp_a * sh_b - hp_b * sh_a
1543  pec_core = hp_b * (dt_to_dpe_a * dt_c + ds_to_dpe_a * ds_c) - &
1544  hp_a * (dt_to_dpe_b * dt_c + ds_to_dpe_b * ds_c)
1545  colht_core = hp_b * (dt_to_dcolht_a * dt_c + ds_to_dcolht_a * ds_c) - &
1546  hp_a * (dt_to_dcolht_b * dt_c + ds_to_dcolht_b * ds_c)
1547 
1548  if (present(pe_chg)) then
1549  ! Find the change in column potential energy due to the change in the
1550  ! diffusivity at this interface by dKddt_h.
1551  y1_3 = dkddt_h / (bdt1 * (bdt1 + dkddt_h * hps))
1552  pe_chg = pec_core * y1_3
1553  colht_chg = colht_core * y1_3
1554  if (colht_chg < 0.0) pe_chg = pe_chg - pres_z * colht_chg
1555  if (present(colht_cor)) colht_cor = -pres_z * min(colht_chg, 0.0)
1556  elseif (present(colht_cor)) then
1557  y1_3 = dkddt_h / (bdt1 * (bdt1 + dkddt_h * hps))
1558  colht_cor = -pres_z * min(colht_core * y1_3, 0.0)
1559  endif
1560 
1561  if (present(dpec_dkd)) then
1562  ! Find the derivative of the potential energy change with dKddt_h.
1563  y1_4 = 1.0 / (bdt1 + dkddt_h * hps)**2
1564  dpec_dkd = pec_core * y1_4
1565  colht_chg = colht_core * y1_4
1566  if (colht_chg < 0.0) dpec_dkd = dpec_dkd - pres_z * colht_chg
1567  endif
1568 
1569  if (present(dpe_max)) then
1570  ! This expression is the limit of PE_chg for infinite dKddt_h.
1571  y1_3 = 1.0 / (bdt1 * hps)
1572  dpe_max = pec_core * y1_3
1573  colht_chg = colht_core * y1_3
1574  if (colht_chg < 0.0) dpe_max = dpe_max - pres_z * colht_chg
1575  endif
1576 
1577  if (present(dpec_dkd_0)) then
1578  ! This expression is the limit of dPEc_dKd for dKddt_h = 0.
1579  y1_4 = 1.0 / bdt1**2
1580  dpec_dkd_0 = pec_core * y1_4
1581  colht_chg = colht_core * y1_4
1582  if (colht_chg < 0.0) dpec_dkd_0 = dpec_dkd_0 - pres_z * colht_chg
1583  endif
1584 
1585 end subroutine find_pe_chg
1586 
1587 !> This subroutine calculates the change in potential energy and or derivatives
1588 !! for several changes in an interfaces's diapycnal diffusivity times a timestep
1589 !! using the original form used in the first version of ePBL.
1590 subroutine find_pe_chg_orig(Kddt_h, h_k, b_den_1, dTe_term, dSe_term, &
1591  dT_km1_t2, dS_km1_t2, dT_to_dPE_k, dS_to_dPE_k, &
1592  dT_to_dPEa, dS_to_dPEa, pres_Z, dT_to_dColHt_k, &
1593  dS_to_dColHt_k, dT_to_dColHta, dS_to_dColHta, &
1594  PE_chg, dPEc_dKd, dPE_max, dPEc_dKd_0)
1595  real, intent(in) :: Kddt_h !< The diffusivity at an interface times the time step and
1596  !! divided by the average of the thicknesses around the
1597  !! interface [H ~> m or kg m-2].
1598  real, intent(in) :: h_k !< The thickness of the layer below the interface [H ~> m or kg m-2].
1599  real, intent(in) :: b_den_1 !< The first term in the denominator of the pivot
1600  !! for the tridiagonal solver, given by h_k plus a term that
1601  !! is a fraction (determined from the tridiagonal solver) of
1602  !! Kddt_h for the interface above [H ~> m or kg m-2].
1603  real, intent(in) :: dTe_term !< A diffusivity-independent term related to the temperature change
1604  !! in the layer below the interface [degC H ~> degC m or degC kg m-2].
1605  real, intent(in) :: dSe_term !< A diffusivity-independent term related to the salinity change
1606  !! in the layer below the interface [ppt H ~> ppt m or ppt kg m-2].
1607  real, intent(in) :: dT_km1_t2 !< A diffusivity-independent term related to the
1608  !! temperature change in the layer above the interface [degC].
1609  real, intent(in) :: dS_km1_t2 !< A diffusivity-independent term related to the
1610  !! salinity change in the layer above the interface [ppt].
1611  real, intent(in) :: pres_Z !< The rescaled hydrostatic interface pressure, which relates
1612  !! the changes in column thickness to the energy that is radiated
1613  !! as gravity waves and unavailable to drive mixing [J m-2 Z-1 ~> J m-3].
1614  real, intent(in) :: dT_to_dPE_k !< A factor (pres_lay*mass_lay*dSpec_vol/dT) relating
1615  !! a layer's temperature change to the change in column potential
1616  !! energy, including all implicit diffusive changes in the
1617  !! temperatures of all the layers below [kg m-3 Z3 T-2 degC-1 ~> J m-2 degC-1].
1618  real, intent(in) :: dS_to_dPE_k !< A factor (pres_lay*mass_lay*dSpec_vol/dS) relating
1619  !! a layer's salinity change to the change in column potential
1620  !! energy, including all implicit diffusive changes in the
1621  !! in the salinities of all the layers below [kg m-3 Z3 T-2 ppt-1 ~> J m-2 ppt-1].
1622  real, intent(in) :: dT_to_dPEa !< A factor (pres_lay*mass_lay*dSpec_vol/dT) relating
1623  !! a layer's temperature change to the change in column potential
1624  !! energy, including all implicit diffusive changes in the
1625  !! temperatures of all the layers above [kg m-3 Z3 T-2 degC-1 ~> J m-2 degC-1].
1626  real, intent(in) :: dS_to_dPEa !< A factor (pres_lay*mass_lay*dSpec_vol/dS) relating
1627  !! a layer's salinity change to the change in column potential
1628  !! energy, including all implicit diffusive changes in the
1629  !! salinities of all the layers above [kg m-3 Z3 T-2 ppt-1 ~> J m-2 ppt-1].
1630  real, intent(in) :: dT_to_dColHt_k !< A factor (mass_lay*dSColHtc_vol/dT) relating
1631  !! a layer's temperature change to the change in column
1632  !! height, including all implicit diffusive changes in the
1633  !! temperatures of all the layers below [Z degC-1 ~> m degC-1].
1634  real, intent(in) :: dS_to_dColHt_k !< A factor (mass_lay*dSColHtc_vol/dS) relating
1635  !! a layer's salinity change to the change in column
1636  !! height, including all implicit diffusive changes
1637  !! in the salinities of all the layers below [Z ppt-1 ~> m ppt-1].
1638  real, intent(in) :: dT_to_dColHta !< A factor (mass_lay*dSColHtc_vol/dT) relating
1639  !! a layer's temperature change to the change in column
1640  !! height, including all implicit diffusive changes
1641  !! in the temperatures of all the layers above [Z degC-1 ~> m degC-1].
1642  real, intent(in) :: dS_to_dColHta !< A factor (mass_lay*dSColHtc_vol/dS) relating
1643  !! a layer's salinity change to the change in column
1644  !! height, including all implicit diffusive changes
1645  !! in the salinities of all the layers above [Z ppt-1 ~> m ppt-1].
1646 
1647  real, optional, intent(out) :: PE_chg !< The change in column potential energy from applying
1648  !! Kddt_h at the present interface [kg m-3 Z3 T-2 ~> J m-2].
1649  real, optional, intent(out) :: dPEc_dKd !< The partial derivative of PE_chg with Kddt_h
1650  !! [kg m-3 Z3 T-2 H-1 ~> J m-3 or J kg-1].
1651  real, optional, intent(out) :: dPE_max !< The maximum change in column potential energy that could
1652  !! be realizedd by applying a huge value of Kddt_h at the
1653  !! present interface [kg m-3 Z3 T-2 ~> J m-2].
1654  real, optional, intent(out) :: dPEc_dKd_0 !< The partial derivative of PE_chg with Kddt_h in the
1655  !! limit where Kddt_h = 0 [kg m-3 Z3 T-2 H-1 ~> J m-3 or J kg-1].
1656 
1657 ! This subroutine determines the total potential energy change due to mixing
1658 ! at an interface, including all of the implicit effects of the prescribed
1659 ! mixing at interfaces above. Everything here is derived by careful manipulation
1660 ! of the robust tridiagonal solvers used for tracers by MOM6. The results are
1661 ! positive for mixing in a stably stratified environment.
1662 ! The comments describing these arguments are for a downward mixing pass, but
1663 ! this routine can also be used for an upward pass with the sense of direction
1664 ! reversed.
1665 
1666  real :: b1 ! b1 is used by the tridiagonal solver [H-1 ~> m-1 or m2 kg-1].
1667  real :: b1Kd ! Temporary array [nondim]
1668  real :: ColHt_chg ! The change in column thickness [Z ~> m].
1669  real :: dColHt_max ! The change in column thickness for infinite diffusivity [Z ~> m].
1670  real :: dColHt_dKd ! The partial derivative of column thickness with diffusivity [s Z-1 ~> s m-1].
1671  real :: dT_k, dT_km1 ! Temporary arrays [degC].
1672  real :: dS_k, dS_km1 ! Temporary arrays [ppt].
1673  real :: I_Kr_denom ! Temporary array [H-2 ~> m-2 or m4 kg-2]
1674  real :: dKr_dKd ! Nondimensional temporary array.
1675  real :: ddT_k_dKd, ddT_km1_dKd ! Temporary arrays [degC H-1 ~> m-1 or m2 kg-1].
1676  real :: ddS_k_dKd, ddS_km1_dKd ! Temporary arrays [ppt H-1 ~> ppt m-1 or ppt m2 kg-1].
1677 
1678  b1 = 1.0 / (b_den_1 + kddt_h)
1679  b1kd = kddt_h*b1
1680 
1681  ! Start with the temperature change in layer k-1 due to the diffusivity at
1682  ! interface K without considering the effects of changes in layer k.
1683 
1684  ! Calculate the change in PE due to the diffusion at interface K
1685  ! if Kddt_h(K+1) = 0.
1686  i_kr_denom = 1.0 / (h_k*b_den_1 + (b_den_1 + h_k)*kddt_h)
1687 
1688  dt_k = (kddt_h*i_kr_denom) * dte_term
1689  ds_k = (kddt_h*i_kr_denom) * dse_term
1690 
1691  if (present(pe_chg)) then
1692  ! Find the change in energy due to diffusion with strength Kddt_h at this interface.
1693  ! Increment the temperature changes in layer k-1 due the changes in layer k.
1694  dt_km1 = b1kd * ( dt_k + dt_km1_t2 )
1695  ds_km1 = b1kd * ( ds_k + ds_km1_t2 )
1696  pe_chg = (dt_to_dpe_k * dt_k + dt_to_dpea * dt_km1) + &
1697  (ds_to_dpe_k * ds_k + ds_to_dpea * ds_km1)
1698  colht_chg = (dt_to_dcolht_k * dt_k + dt_to_dcolhta * dt_km1) + &
1699  (ds_to_dcolht_k * ds_k + ds_to_dcolhta * ds_km1)
1700  if (colht_chg < 0.0) pe_chg = pe_chg - pres_z * colht_chg
1701  endif
1702 
1703  if (present(dpec_dkd)) then
1704  ! Find the derivatives of the temperature and salinity changes with Kddt_h.
1705  dkr_dkd = (h_k*b_den_1) * i_kr_denom**2
1706 
1707  ddt_k_dkd = dkr_dkd * dte_term
1708  dds_k_dkd = dkr_dkd * dse_term
1709  ddt_km1_dkd = (b1**2 * b_den_1) * ( dt_k + dt_km1_t2 ) + b1kd * ddt_k_dkd
1710  dds_km1_dkd = (b1**2 * b_den_1) * ( ds_k + ds_km1_t2 ) + b1kd * dds_k_dkd
1711 
1712  ! Calculate the partial derivative of Pe_chg with Kddt_h.
1713  dpec_dkd = (dt_to_dpe_k * ddt_k_dkd + dt_to_dpea * ddt_km1_dkd) + &
1714  (ds_to_dpe_k * dds_k_dkd + ds_to_dpea * dds_km1_dkd)
1715  dcolht_dkd = (dt_to_dcolht_k * ddt_k_dkd + dt_to_dcolhta * ddt_km1_dkd) + &
1716  (ds_to_dcolht_k * dds_k_dkd + ds_to_dcolhta * dds_km1_dkd)
1717  if (dcolht_dkd < 0.0) dpec_dkd = dpec_dkd - pres_z * dcolht_dkd
1718  endif
1719 
1720  if (present(dpe_max)) then
1721  ! This expression is the limit of PE_chg for infinite Kddt_h.
1722  dpe_max = (dt_to_dpea * dt_km1_t2 + ds_to_dpea * ds_km1_t2) + &
1723  ((dt_to_dpe_k + dt_to_dpea) * dte_term + &
1724  (ds_to_dpe_k + ds_to_dpea) * dse_term) / (b_den_1 + h_k)
1725  dcolht_max = (dt_to_dcolhta * dt_km1_t2 + ds_to_dcolhta * ds_km1_t2) + &
1726  ((dt_to_dcolht_k + dt_to_dcolhta) * dte_term + &
1727  (ds_to_dcolht_k + ds_to_dcolhta) * dse_term) / (b_den_1 + h_k)
1728  if (dcolht_max < 0.0) dpe_max = dpe_max - pres_z*dcolht_max
1729  endif
1730 
1731  if (present(dpec_dkd_0)) then
1732  ! This expression is the limit of dPEc_dKd for Kddt_h = 0.
1733  dpec_dkd_0 = (dt_to_dpea * dt_km1_t2 + ds_to_dpea * ds_km1_t2) / (b_den_1) + &
1734  (dt_to_dpe_k * dte_term + ds_to_dpe_k * dse_term) / (h_k*b_den_1)
1735  dcolht_dkd = (dt_to_dcolhta * dt_km1_t2 + ds_to_dcolhta * ds_km1_t2) / (b_den_1) + &
1736  (dt_to_dcolht_k * dte_term + ds_to_dcolht_k * dse_term) / (h_k*b_den_1)
1737  if (dcolht_dkd < 0.0) dpec_dkd_0 = dpec_dkd_0 - pres_z*dcolht_dkd
1738  endif
1739 
1740 end subroutine find_pe_chg_orig
1741 
1742 !> This subroutine finds the Mstar value for ePBL
1743 subroutine find_mstar(CS, US, Buoyancy_Flux, UStar, UStar_Mean,&
1744  BLD, Abs_Coriolis, MStar, Langmuir_Number,&
1745  MStar_LT, Convect_Langmuir_Number)
1746  type(energetic_pbl_cs), pointer :: CS !< Energetic_PBL control structure.
1747  type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type
1748  real, intent(in) :: UStar !< ustar w/ gustiness [Z T-1 ~> m s-1]
1749  real, intent(in) :: UStar_Mean !< ustar w/o gustiness [Z T-1 ~> m s-1]
1750  real, intent(in) :: Abs_Coriolis !< abolute value of the Coriolis parameter [T-1]
1751  real, intent(in) :: Buoyancy_Flux !< Buoyancy flux [Z2 T-3 ~> m2 s-3]
1752  real, intent(in) :: BLD !< boundary layer depth [Z ~> m]
1753  real, intent(out) :: Mstar !< Ouput mstar (Mixing/ustar**3) [nondim]
1754  real, optional, intent(in) :: Langmuir_Number !< Langmuir number [nondim]
1755  real, optional, intent(out) :: MStar_LT !< Mstar increase due to Langmuir turbulence [nondim]
1756  real, optional, intent(out) :: Convect_Langmuir_number !< Langmuir number including buoyancy flux [nondim]
1757 
1758  !/ Variables used in computing mstar
1759  real :: MSN_term ! Temporary terms [nondim]
1760  real :: MSCR_term1, MSCR_term2 ! Temporary terms [Z3 T-3 ~> m3 s-3]
1761  real :: MStar_Conv_Red ! Adjustment made to mstar due to convection reducing mechanical mixing [nondim]
1762  real :: MStar_S, MStar_N ! Mstar in (S)tabilizing/(N)ot-stabilizing buoyancy flux [nondim]
1763 
1764  !/ Integer options for how to find mstar
1765 
1766  !/
1767 
1768  if (cs%mstar_scheme == use_fixed_mstar) then
1769  mstar = cs%Fixed_MStar
1770  !/ 1. Get mstar
1771  elseif (cs%mstar_scheme == mstar_from_ekman) then
1772 
1773  if (cs%answers_2018) then
1774  ! The limit for the balance of rotation and stabilizing is f(L_Ekman,L_Obukhov)
1775  mstar_s = cs%MStar_coef*sqrt(max(0.0,buoyancy_flux) / ustar**2 / &
1776  (abs_coriolis + 1.e-10*us%T_to_s) )
1777  ! The limit for rotation (Ekman length) limited mixing
1778  mstar_n = cs%C_Ek * log( max( 1., ustar / (abs_coriolis + 1.e-10*us%T_to_s) / bld ) )
1779  else
1780  ! The limit for the balance of rotation and stabilizing is f(L_Ekman,L_Obukhov)
1781  mstar_s = cs%MSTAR_COEF*sqrt(max(0.0, buoyancy_flux) / (ustar**2 * max(abs_coriolis, 1.e-20*us%T_to_s)))
1782  ! The limit for rotation (Ekman length) limited mixing
1783  mstar_n = 0.0
1784  if (ustar > abs_coriolis * bld) mstar_n = cs%C_EK * log(ustar / (abs_coriolis * bld))
1785  endif
1786 
1787  ! Here 1.25 is about .5/von Karman, which gives the Obukhov limit.
1788  mstar = max(mstar_s, min(1.25, mstar_n))
1789  if (cs%MStar_Cap > 0.0) mstar = min( cs%MStar_Cap,mstar )
1790  elseif ( cs%mstar_scheme == mstar_from_rh18 ) then
1791  if (cs%answers_2018) then
1792  mstar_n = cs%RH18_MStar_cn1 * ( 1.0 - 1.0 / ( 1. + cs%RH18_MStar_cn2 * &
1793  exp( cs%RH18_mstar_CN3 * bld * abs_coriolis / ustar) ) )
1794  else
1795  msn_term = cs%RH18_MStar_cn2 * exp( cs%RH18_mstar_CN3 * bld * abs_coriolis / ustar)
1796  mstar_n = (cs%RH18_MStar_cn1 * msn_term) / ( 1. + msn_term)
1797  endif
1798  mstar_s = cs%RH18_MStar_CS1 * ( max(0.0, buoyancy_flux)**2 * bld / &
1799  ( ustar**5 * max(abs_coriolis,1.e-20*us%T_to_s) ) )**cs%RH18_mstar_cs2
1800  mstar = mstar_n + mstar_s
1801  endif
1802 
1803  !/ 2. Adjust mstar to account for convective turbulence
1804  if (cs%answers_2018) then
1805  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) / &
1806  ( (-min(0.0,buoyancy_flux) + 1.e-10*us%T_to_s**3*us%m_to_Z**2) + &
1807  2.0 *mstar * ustar**3 / bld )
1808  else
1809  mscr_term1 = -bld * min(0.0, buoyancy_flux)
1810  mscr_term2 = 2.0*mstar * ustar**3
1811  mstar_conv_red = ((1.-cs%mstar_convect_coef) * mscr_term1 + mscr_term2) / (mscr_term1 + mscr_term2)
1812  endif
1813 
1814  !/3. Combine various mstar terms to get final value
1815  mstar = mstar * mstar_conv_red
1816 
1817  if (present(langmuir_number)) then
1818  !### In this call, ustar was previously ustar_mean. Is this change deliberate?
1819  call mstar_langmuir(cs, us, abs_coriolis, buoyancy_flux, ustar, bld, langmuir_number, mstar, &
1820  mstar_lt, convect_langmuir_number)
1821  endif
1822 
1823 end subroutine find_mstar
1824 
1825 !> This subroutine modifies the Mstar value if the Langmuir number is present
1826 subroutine mstar_langmuir(CS, US, abs_Coriolis, buoyancy_flux, ustar, BLD, Langmuir_Number, &
1827  mstar, mstar_LT, Convect_Langmuir_Number)
1828  type(energetic_pbl_cs), pointer :: CS !< Energetic_PBL control structure.
1829  type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type
1830  real, intent(in) :: Abs_Coriolis !< Absolute value of the Coriolis parameter [T-1 ~> s-1]
1831  real, intent(in) :: Buoyancy_Flux !< Buoyancy flux [Z2 T-3 ~> m2 s-3]
1832  real, intent(in) :: UStar !< Surface friction velocity with? gustiness [Z T-1 ~> m s-1]
1833  real, intent(in) :: BLD !< boundary layer depth [Z ~> m]
1834  real, intent(inout) :: Mstar !< Input/output mstar (Mixing/ustar**3) [nondim]
1835  real, intent(in) :: Langmuir_Number !< Langmuir number [nondim]
1836  real, intent(out) :: MStar_LT !< Mstar increase due to Langmuir turbulence [nondim]
1837  real, intent(out) :: Convect_Langmuir_number !< Langmuir number including buoyancy flux [nondim]
1838 
1839  !/
1840  real, parameter :: Max_ratio = 1.0e16 ! The maximum value of a nondimensional ratio.
1841  real :: enhance_mstar ! A multiplicative scaling of mstar due to Langmuir turbulence.
1842  real :: mstar_LT_add ! A value that is added to mstar due to Langmuir turbulence.
1843  real :: iL_Ekman ! Inverse of Ekman length scale [Z-1 ~> m-1].
1844  real :: iL_Obukhov ! Inverse of Obukhov length scale [Z-1 ~> m-1].
1845  real :: I_ustar ! The Adcroft reciprocal of ustar [T Z-1 ~> s m-1]
1846  real :: I_f ! The Adcroft reciprocal of the Coriolis parameter [T ~> s]
1847  real :: MLD_Ekman ! The ratio of the mixed layer depth to the Ekman layer depth [nondim].
1848  real :: Ekman_Obukhov ! The Ekman layer thickness divided by the Obukhov depth [nondim].
1849  real :: MLD_Obukhov ! The mixed layer depth divided by the Obukhov depth [nondim].
1850  real :: MLD_Obukhov_stab ! Ratios of length scales where MLD is boundary layer depth [nondim].
1851  real :: Ekman_Obukhov_stab ! >
1852  real :: MLD_Obukhov_un ! Ratios of length scales where MLD is boundary layer depth
1853  real :: Ekman_Obukhov_un ! >
1854 
1855  ! Set default values for no Langmuir effects.
1856  enhance_mstar = 1.0 ; mstar_lt_add = 0.0
1857 
1858  if (cs%LT_Enhance_Form /= no_langmuir) then
1859  ! a. Get parameters for modified LA
1860  if (cs%answers_2018) then
1861  il_ekman = abs_coriolis / ustar
1862  il_obukhov = buoyancy_flux*cs%vonkar / ustar**3
1863  ekman_obukhov_stab = abs(max(0., il_obukhov / (il_ekman + 1.e-10*us%Z_to_m)))
1864  ekman_obukhov_un = abs(min(0., il_obukhov / (il_ekman + 1.e-10*us%Z_to_m)))
1865  mld_obukhov_stab = abs(max(0., bld*il_obukhov))
1866  mld_obukhov_un = abs(min(0., bld*il_obukhov))
1867  mld_ekman = abs( bld*il_ekman )
1868  else
1869  ekman_obukhov = max_ratio ; mld_obukhov = max_ratio ; mld_ekman = max_ratio
1870  i_f = 0.0 ; if (abs(abs_coriolis) > 0.0) i_f = 1.0 / abs_coriolis
1871  i_ustar = 0.0 ; if (abs(ustar) > 0.0) i_ustar = 1.0 / ustar
1872  if (abs(buoyancy_flux*cs%vonkar) < max_ratio*(abs_coriolis * ustar**2)) &
1873  ekman_obukhov = abs(buoyancy_flux*cs%vonkar) * (i_f * i_ustar**2)
1874  if (abs(bld*buoyancy_flux*cs%vonkar) < max_ratio*ustar**3) &
1875  mld_obukhov = abs(bld*buoyancy_flux*cs%vonkar) * i_ustar**3
1876  if (bld*abs_coriolis < max_ratio*ustar) &
1877  mld_ekman = bld*abs_coriolis * i_ustar
1878 
1879  if (buoyancy_flux > 0.0) then
1880  ekman_obukhov_stab = ekman_obukhov ; ekman_obukhov_un = 0.0
1881  mld_obukhov_stab = mld_obukhov ; mld_obukhov_un = 0.0
1882  else
1883  ekman_obukhov_un = ekman_obukhov ; ekman_obukhov_stab = 0.0
1884  mld_obukhov_un = mld_obukhov ; mld_obukhov_stab = 0.0
1885  endif
1886  endif
1887 
1888  ! b. Adjust LA based on various parameters.
1889  ! Assumes linear factors based on length scale ratios to adjust LA
1890  ! Note when these coefficients are set to 0 recovers simple LA.
1891  convect_langmuir_number = langmuir_number * &
1892  ( (1.0 + max(-0.5, cs%LaC_MLDoEK * mld_ekman)) + &
1893  ((cs%LaC_EKoOB_stab * ekman_obukhov_stab + cs%LaC_EKoOB_un * ekman_obukhov_un) + &
1894  (cs%LaC_MLDoOB_stab * mld_obukhov_stab + cs%LaC_MLDoOB_un * mld_obukhov_un)) )
1895 
1896  if (cs%LT_Enhance_Form == langmuir_rescale) then
1897  ! Enhancement is multiplied (added mst_lt set to 0)
1898  enhance_mstar = min(cs%Max_Enhance_M, &
1899  (1. + cs%LT_ENHANCE_COEF * convect_langmuir_number**cs%LT_ENHANCE_EXP) )
1900  elseif (cs%LT_ENHANCE_Form == langmuir_add) then
1901  ! or Enhancement is additive (multiplied enhance_m set to 1)
1902  mstar_lt_add = cs%LT_ENHANCE_COEF * convect_langmuir_number**cs%LT_ENHANCE_EXP
1903  endif
1904  endif
1905 
1906  mstar_lt = (enhance_mstar - 1.0)*mstar + mstar_lt_add ! Diagnose the full increase in mstar.
1907  mstar = mstar*enhance_mstar + mstar_lt_add
1908 
1909 end subroutine mstar_langmuir
1910 
1911 
1912 !> Copies the ePBL active mixed layer depth into MLD
1913 subroutine energetic_pbl_get_mld(CS, MLD, G, US, m_to_MLD_units)
1914  type(energetic_pbl_cs), pointer :: cs !< Control structure for ePBL
1915  type(ocean_grid_type), intent(in) :: g !< Grid structure
1916  type(unit_scale_type), intent(in) :: us !< A dimensional unit scaling type
1917  real, dimension(SZI_(G),SZJ_(G)), intent(out) :: mld !< Depth of ePBL active mixing layer [m or other units]
1918  real, optional, intent(in) :: m_to_mld_units !< A conversion factor to the
1919  !! desired units for MLD
1920  ! Local variables
1921  real :: scale ! A dimensional rescaling factor
1922  integer :: i,j
1923 
1924  scale = us%Z_to_m ; if (present(m_to_mld_units)) scale = scale * m_to_mld_units
1925 
1926  do j=g%jsc,g%jec ; do i=g%isc,g%iec
1927  mld(i,j) = scale*cs%ML_Depth(i,j)
1928  enddo ; enddo
1929 
1930 end subroutine energetic_pbl_get_mld
1931 
1932 
1933 !> This subroutine initializes the energetic_PBL module
1934 subroutine energetic_pbl_init(Time, G, GV, US, param_file, diag, CS)
1935  type(time_type), target, intent(in) :: time !< The current model time
1936  type(ocean_grid_type), intent(in) :: g !< The ocean's grid structure
1937  type(verticalgrid_type), intent(in) :: gv !< The ocean's vertical grid structure
1938  type(unit_scale_type), intent(in) :: us !< A dimensional unit scaling type
1939  type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters
1940  type(diag_ctrl), target, intent(inout) :: diag !< A structure that is used to regulate diagnostic output
1941  type(energetic_pbl_cs), pointer :: cs !< A pointer that is set to point to the control
1942  !! structure for this module
1943  ! Local variables
1944  ! This include declares and sets the variable "version".
1945 # include "version_variable.h"
1946  character(len=40) :: mdl = "MOM_energetic_PBL" ! This module's name.
1947  character(len=20) :: tmpstr
1948  real :: omega_frac_dflt
1949  real :: z3_t3_to_m3_s3 ! A conversion factor for work diagnostics [m3 T3 Z-3 s-3 ~> nondim]
1950  integer :: isd, ied, jsd, jed
1951  integer :: mstar_mode, lt_enhance, wt_mode
1952  logical :: default_2018_answers
1953  logical :: use_temperature, use_omega
1954  logical :: use_la_windsea
1955  isd = g%isd ; ied = g%ied ; jsd = g%jsd ; jed = g%jed
1956 
1957  if (associated(cs)) then
1958  call mom_error(warning, "mixedlayer_init called with an associated"//&
1959  "associated control structure.")
1960  return
1961  else ; allocate(cs) ; endif
1962 
1963  cs%diag => diag
1964  cs%Time => time
1965 
1966 ! Set default, read and log parameters
1967  call log_version(param_file, mdl, version, "")
1968 
1969 
1970 !/1. General ePBL settings
1971  call get_param(param_file, mdl, "OMEGA", cs%omega, &
1972  "The rotation rate of the earth.", units="s-1", &
1973  default=7.2921e-5, scale=us%T_to_S)
1974  call get_param(param_file, mdl, "ML_USE_OMEGA", use_omega, &
1975  "If true, use the absolute rotation rate instead of the "//&
1976  "vertical component of rotation when setting the decay "//&
1977  "scale for turbulence.", default=.false., do_not_log=.true.)
1978  omega_frac_dflt = 0.0
1979  if (use_omega) then
1980  call mom_error(warning, "ML_USE_OMEGA is depricated; use ML_OMEGA_FRAC=1.0 instead.")
1981  omega_frac_dflt = 1.0
1982  endif
1983  call get_param(param_file, mdl, "ML_OMEGA_FRAC", cs%omega_frac, &
1984  "When setting the decay scale for turbulence, use this "//&
1985  "fraction of the absolute rotation rate blended with the "//&
1986  "local value of f, as sqrt((1-of)*f^2 + of*4*omega^2).", &
1987  units="nondim", default=omega_frac_dflt)
1988  call get_param(param_file, mdl, "EKMAN_SCALE_COEF", cs%Ekman_scale_coef, &
1989  "A nondimensional scaling factor controlling the inhibition "//&
1990  "of the diffusive length scale by rotation. Making this larger "//&
1991  "decreases the PBL diffusivity.", units="nondim", default=1.0)
1992  call get_param(param_file, mdl, "DEFAULT_2018_ANSWERS", default_2018_answers, &
1993  "This sets the default value for the various _2018_ANSWERS parameters.", &
1994  default=.true.)
1995  call get_param(param_file, mdl, "EPBL_2018_ANSWERS", cs%answers_2018, &
1996  "If true, use the order of arithmetic and expressions that recover the "//&
1997  "answers from the end of 2018. Otherwise, use updated and more robust "//&
1998  "forms of the same expressions.", default=default_2018_answers)
1999 
2000 
2001  call get_param(param_file, mdl, "EPBL_ORIGINAL_PE_CALC", cs%orig_PE_calc, &
2002  "If true, the ePBL code uses the original form of the "//&
2003  "potential energy change code. Otherwise, the newer "//&
2004  "version that can work with successive increments to the "//&
2005  "diffusivity in upward or downward passes is used.", default=.true.)
2006 
2007  call get_param(param_file, mdl, "MKE_TO_TKE_EFFIC", cs%MKE_to_TKE_effic, &
2008  "The efficiency with which mean kinetic energy released "//&
2009  "by mechanically forced entrainment of the mixed layer "//&
2010  "is converted to turbulent kinetic energy.", units="nondim", &
2011  default=0.0)
2012  call get_param(param_file, mdl, "TKE_DECAY", cs%TKE_decay, &
2013  "TKE_DECAY relates the vertical rate of decay of the "//&
2014  "TKE available for mechanical entrainment to the natural "//&
2015  "Ekman depth.", units="nondim", default=2.5)
2016 
2017 
2018 !/2. Options related to setting MSTAR
2019  call get_param(param_file, mdl, "EPBL_MSTAR_SCHEME", tmpstr, &
2020  "EPBL_MSTAR_SCHEME selects the method for setting mstar. Valid values are: \n"//&
2021  "\t CONSTANT - Use a fixed mstar given by MSTAR \n"//&
2022  "\t OM4 - Use L_Ekman/L_Obukhov in the sabilizing limit, as in OM4 \n"//&
2023  "\t REICHL_H18 - Use the scheme documented in Reichl & Hallberg, 2018.", &
2024  default=constant_string, do_not_log=.true.)
2025  call get_param(param_file, mdl, "MSTAR_MODE", mstar_mode, default=-1)
2026  if (mstar_mode == 0) then
2027  tmpstr = constant_string
2028  call mom_error(warning, "Use EPBL_MSTAR_SCHEME = CONSTANT instead of the archaic MSTAR_MODE = 0.")
2029  elseif (mstar_mode == 1) then
2030  call mom_error(fatal, "You are using a legacy mstar mode in ePBL that has been phased out. "//&
2031  "If you need to use this setting please report this error. Also use "//&
2032  "EPBL_MSTAR_SCHEME to specify the scheme for mstar.")
2033  elseif (mstar_mode == 2) then
2034  tmpstr = om4_string
2035  call mom_error(warning, "Use EPBL_MSTAR_SCHEME = OM4 instead of the archaic MSTAR_MODE = 2.")
2036  elseif (mstar_mode == 3) then
2037  tmpstr = rh18_string
2038  call mom_error(warning, "Use EPBL_MSTAR_SCHEME = REICHL_H18 instead of the archaic MSTAR_MODE = 3.")
2039  elseif (mstar_mode > 3) then
2040  call mom_error(fatal, "An unrecognized value of the obsolete parameter MSTAR_MODE was specified.")
2041  endif
2042  call log_param(param_file, mdl, "EPBL_MSTAR_SCHEME", tmpstr, &
2043  "EPBL_MSTAR_SCHEME selects the method for setting mstar. Valid values are: \n"//&
2044  "\t CONSTANT - Use a fixed mstar given by MSTAR \n"//&
2045  "\t OM4 - Use L_Ekman/L_Obukhov in the sabilizing limit, as in OM4 \n"//&
2046  "\t REICHL_H18 - Use the scheme documented in Reichl & Hallberg, 2018.", &
2047  default=constant_string)
2048  tmpstr = uppercase(tmpstr)
2049  select case (tmpstr)
2050  case (constant_string)
2051  cs%mstar_Scheme = use_fixed_mstar
2052  case (om4_string)
2053  cs%mstar_Scheme = mstar_from_ekman
2054  case (rh18_string)
2055  cs%mstar_Scheme = mstar_from_rh18
2056  case default
2057  call mom_mesg('energetic_PBL_init: EPBL_MSTAR_SCHEME ="'//trim(tmpstr)//'"', 0)
2058  call mom_error(fatal, "energetic_PBL_init: Unrecognized setting "// &
2059  "EPBL_MSTAR_SCHEME = "//trim(tmpstr)//" found in input file.")
2060  end select
2061 
2062  call get_param(param_file, mdl, "MSTAR", cs%fixed_mstar, &
2063  "The ratio of the friction velocity cubed to the TKE input to the "//&
2064  "mixed layer. This option is used if EPBL_MSTAR_SCHEME = CONSTANT.", &
2065  units="nondim", default=1.2, do_not_log=(cs%mstar_scheme/=use_fixed_mstar))
2066  call get_param(param_file, mdl, "MSTAR_CAP", cs%mstar_cap, &
2067  "If this value is positive, it sets the maximum value of mstar "//&
2068  "allowed in ePBL. (This is not used if EPBL_MSTAR_SCHEME = CONSTANT).", &
2069  units="nondim", default=-1.0, do_not_log=(cs%mstar_scheme==use_fixed_mstar))
2070  ! mstar_scheme==MStar_from_Ekman options
2071  call get_param(param_file, mdl, "MSTAR2_COEF1", cs%MSTAR_COEF, &
2072  "Coefficient in computing mstar when rotation and stabilizing "//&
2073  "effects are both important (used if EPBL_MSTAR_SCHEME = OM4).", &
2074  units="nondim", default=0.3, do_not_log=(cs%mstar_scheme/=mstar_from_ekman))
2075  call get_param(param_file, mdl, "MSTAR2_COEF2", cs%C_EK, &
2076  "Coefficient in computing mstar when only rotation limits "// &
2077  "the total mixing (used if EPBL_MSTAR_SCHEME = OM4)", &
2078  units="nondim", default=0.085, do_not_log=(cs%mstar_scheme/=mstar_from_ekman))
2079  ! mstar_scheme==MStar_from_RH18 options
2080  call get_param(param_file, mdl, "RH18_MSTAR_CN1", cs%RH18_mstar_cn1,&
2081  "MSTAR_N coefficient 1 (outter-most coefficient for fit). "//&
2082  "The value of 0.275 is given in RH18. Increasing this "//&
2083  "coefficient increases MSTAR for all values of Hf/ust, but more "//&
2084  "effectively at low values (weakly developed OSBLs).", &
2085  units="nondim", default=0.275, do_not_log=(cs%mstar_scheme/=mstar_from_rh18))
2086  call get_param(param_file, mdl, "RH18_MSTAR_CN2", cs%RH18_mstar_cn2,&
2087  "MSTAR_N coefficient 2 (coefficient outside of exponential decay). "//&
2088  "The value of 8.0 is given in RH18. Increasing this coefficient "//&
2089  "increases MSTAR for all values of HF/ust, with a much more even "//&
2090  "effect across a wide range of Hf/ust than CN1.", &
2091  units="nondim", default=8.0, do_not_log=(cs%mstar_scheme/=mstar_from_rh18))
2092  call get_param(param_file, mdl, "RH18_MSTAR_CN3", cs%RH18_mstar_CN3,&
2093  "MSTAR_N coefficient 3 (exponential decay coefficient). "//&
2094  "The value of -5.0 is given in RH18. Increasing this increases how "//&
2095  "quickly the value of MSTAR decreases as Hf/ust increases.", &
2096  units="nondim", default=-5.0, do_not_log=(cs%mstar_scheme/=mstar_from_rh18))
2097  call get_param(param_file, mdl, "RH18_MSTAR_CS1", cs%RH18_mstar_cs1,&
2098  "MSTAR_S coefficient for RH18 in stabilizing limit. "//&
2099  "The value of 0.2 is given in RH18 and increasing it increases "//&
2100  "MSTAR in the presence of a stabilizing surface buoyancy flux.", &
2101  units="nondim", default=0.2, do_not_log=(cs%mstar_scheme/=mstar_from_rh18))
2102  call get_param(param_file, mdl, "RH18_MSTAR_CS2", cs%RH18_mstar_cs2,&
2103  "MSTAR_S exponent for RH18 in stabilizing limit. "//&
2104  "The value of 0.4 is given in RH18 and increasing it increases MSTAR "//&
2105  "exponentially in the presence of a stabilizing surface buoyancy flux.", &
2106  units="nondim", default=0.4, do_not_log=(cs%mstar_scheme/=mstar_from_rh18))
2107 
2108 
2109 !/ Convective turbulence related options
2110  call get_param(param_file, mdl, "NSTAR", cs%nstar, &
2111  "The portion of the buoyant potential energy imparted by "//&
2112  "surface fluxes that is available to drive entrainment "//&
2113  "at the base of mixed layer when that energy is positive.", &
2114  units="nondim", default=0.2)
2115  call get_param(param_file, mdl, "MSTAR_CONV_ADJ", cs%mstar_convect_coef, &
2116  "Coefficient used for reducing mstar during convection "//&
2117  "due to reduction of stable density gradient.", &
2118  units="nondim", default=0.0)
2119 
2120 !/ Mixing Length Options
2121  !### THIS DEFAULT SHOULD BECOME TRUE.
2122  call get_param(param_file, mdl, "USE_MLD_ITERATION", cs%Use_MLD_iteration, &
2123  "A logical that specifies whether or not to use the "//&
2124  "distance to the bottom of the actively turbulent boundary "//&
2125  "layer to help set the EPBL length scale.", default=.false.)
2126  call get_param(param_file, mdl, "EPBL_TRANSITION_SCALE", cs%transLay_scale, &
2127  "A scale for the mixing length in the transition layer "//&
2128  "at the edge of the boundary layer as a fraction of the "//&
2129  "boundary layer thickness.", units="nondim", default=0.1)
2130  if ( cs%Use_MLD_iteration .and. abs(cs%transLay_scale-0.5) >= 0.5) then
2131  call mom_error(fatal, "If flag USE_MLD_ITERATION is true, then "//&
2132  "EPBL_TRANSITION should be greater than 0 and less than 1.")
2133  endif
2134 
2135  call get_param(param_file, mdl, "MLD_ITERATION_GUESS", cs%MLD_ITERATION_GUESS, &
2136  "A logical that specifies whether or not to use the "//&
2137  "previous timestep MLD as a first guess in the MLD iteration. "//&
2138  "The default is false to facilitate reproducibility.", default=.false.)
2139  call get_param(param_file, mdl, "EPBL_MLD_TOLERANCE", cs%MLD_tol, &
2140  "The tolerance for the iteratively determined mixed "//&
2141  "layer depth. This is only used with USE_MLD_ITERATION.", &
2142  units="meter", default=1.0, scale=us%m_to_Z)
2143  call get_param(param_file, mdl, "EPBL_MLD_MAX_ITS", cs%max_MLD_its, &
2144  "The maximum number of iterations that can be used to find a self-consistent "//&
2145  "mixed layer depth. For now, due to the use of bisection, the maximum number "//&
2146  "iteractions needed is set by Depth/2^MAX_ITS < EPBL_MLD_TOLERANCE.", &
2147  default=20, do_not_log=.not.cs%Use_MLD_iteration)
2148  if (.not.cs%Use_MLD_iteration) cs%Max_MLD_Its = 1
2149  call get_param(param_file, mdl, "EPBL_MIN_MIX_LEN", cs%min_mix_len, &
2150  "The minimum mixing length scale that will be used "//&
2151  "by ePBL. The default (0) does not set a minimum.", &
2152  units="meter", default=0.0, scale=us%m_to_Z)
2153 
2154  call get_param(param_file, mdl, "MIX_LEN_EXPONENT", cs%MixLenExponent, &
2155  "The exponent applied to the ratio of the distance to the MLD "//&
2156  "and the MLD depth which determines the shape of the mixing length. "//&
2157  "This is only used if USE_MLD_ITERATION is True.", &
2158  units="nondim", default=2.0)
2159 
2160 !/ Turbulent velocity scale in mixing coefficient
2161  call get_param(param_file, mdl, "EPBL_VEL_SCALE_SCHEME", tmpstr, &
2162  "Selects the method for translating TKE into turbulent velocities. "//&
2163  "Valid values are: \n"//&
2164  "\t CUBE_ROOT_TKE - A constant times the cube root of remaining TKE. \n"//&
2165  "\t REICHL_H18 - Use the scheme based on a combination of w* and v* as \n"//&
2166  "\t documented in Reichl & Hallberg, 2018.", &
2167  default=root_tke_string, do_not_log=.true.)
2168  call get_param(param_file, mdl, "EPBL_VEL_SCALE_MODE", wt_mode, default=-1)
2169  if (wt_mode == 0) then
2170  tmpstr = root_tke_string
2171  call mom_error(warning, "Use EPBL_VEL_SCALE_SCHEME = CUBE_ROOT_TKE instead of the archaic EPBL_VEL_SCALE_MODE = 0.")
2172  elseif (wt_mode == 1) then
2173  tmpstr = rh18_string
2174  call mom_error(warning, "Use EPBL_VEL_SCALE_SCHEME = REICHL_H18 instead of the archaic EPBL_VEL_SCALE_MODE = 1.")
2175  elseif (wt_mode >= 2) then
2176  call mom_error(fatal, "An unrecognized value of the obsolete parameter EPBL_VEL_SCALE_MODE was specified.")
2177  endif
2178  call log_param(param_file, mdl, "EPBL_VEL_SCALE_SCHEME", tmpstr, &
2179  "Selects the method for translating TKE into turbulent velocities. "//&
2180  "Valid values are: \n"//&
2181  "\t CUBE_ROOT_TKE - A constant times the cube root of remaining TKE. \n"//&
2182  "\t REICHL_H18 - Use the scheme based on a combination of w* and v* as \n"//&
2183  "\t documented in Reichl & Hallberg, 2018.", &
2184  default=root_tke_string)
2185  tmpstr = uppercase(tmpstr)
2186  select case (tmpstr)
2187  case (root_tke_string)
2188  cs%wT_scheme = wt_from_croot_tke
2189  case (rh18_string)
2190  cs%wT_scheme = wt_from_rh18
2191  case default
2192  call mom_mesg('energetic_PBL_init: EPBL_VEL_SCALE_SCHEME ="'//trim(tmpstr)//'"', 0)
2193  call mom_error(fatal, "energetic_PBL_init: Unrecognized setting "// &
2194  "EPBL_VEL_SCALE_SCHEME = "//trim(tmpstr)//" found in input file.")
2195  end select
2196 
2197  call get_param(param_file, mdl, "WSTAR_USTAR_COEF", cs%wstar_ustar_coef, &
2198  "A ratio relating the efficiency with which convectively "//&
2199  "released energy is converted to a turbulent velocity, "//&
2200  "relative to mechanically forced TKE. Making this larger "//&
2201  "increases the BL diffusivity", units="nondim", default=1.0)
2202  call get_param(param_file, mdl, "EPBL_VEL_SCALE_FACTOR", cs%vstar_scale_fac, &
2203  "An overall nondimensional scaling factor for wT. "//&
2204  "Making this larger increases the PBL diffusivity.", &
2205  units="nondim", default=1.0)
2206  call get_param(param_file, mdl, "VSTAR_SURF_FAC", cs%vstar_surf_fac,&
2207  "The proportionality times ustar to set vstar at the surface.", &
2208  units="nondim", default=1.2)
2209 
2210  !/ Options related to Langmuir turbulence
2211  call get_param(param_file, mdl, "USE_LA_LI2016", use_la_windsea, &
2212  "A logical to use the Li et al. 2016 (submitted) formula to "//&
2213  "determine the Langmuir number.", units="nondim", default=.false.)
2214  ! Note this can be activated in other ways, but this preserves the old method.
2215  if (use_la_windsea) then
2216  cs%USE_LT = .true.
2217  else
2218  call get_param(param_file, mdl, "EPBL_LT", cs%USE_LT, &
2219  "A logical to use a LT parameterization.", &
2220  units="nondim", default=.false.)
2221  endif
2222  if (cs%USE_LT) then
2223  call get_param(param_file, mdl, "EPBL_LANGMUIR_SCHEME", tmpstr, &
2224  "EPBL_LANGMUIR_SCHEME selects the method for including Langmuir turbulence. "//&
2225  "Valid values are: \n"//&
2226  "\t NONE - Do not do any extra mixing due to Langmuir turbulence \n"//&
2227  "\t RESCALE - Use a multiplicative rescaling of mstar to account for Langmuir turbulence \n"//&
2228  "\t ADDITIVE - Add a Langmuir turblence contribution to mstar to other contributions", &
2229  default=none_string, do_not_log=.true.)
2230  call get_param(param_file, mdl, "LT_ENHANCE", lt_enhance, default=-1)
2231  if (lt_enhance == 0) then
2232  tmpstr = none_string
2233  call mom_error(warning, "Use EPBL_LANGMUIR_SCHEME = NONE instead of the archaic LT_ENHANCE = 0.")
2234  elseif (lt_enhance == 1) then
2235  call mom_error(fatal, "You are using a legacy LT_ENHANCE mode in ePBL that has been phased out. "//&
2236  "If you need to use this setting please report this error. Also use "//&
2237  "EPBL_LANGMUIR_SCHEME to specify the scheme for mstar.")
2238  elseif (lt_enhance == 2) then
2239  tmpstr = rescaled_string
2240  call mom_error(warning, "Use EPBL_LANGMUIR_SCHEME = RESCALE instead of the archaic LT_ENHANCE = 2.")
2241  elseif (lt_enhance == 3) then
2242  tmpstr = additive_string
2243  call mom_error(warning, "Use EPBL_LANGMUIR_SCHEME = ADDITIVE instead of the archaic LT_ENHANCE = 3.")
2244  elseif (lt_enhance > 3) then
2245  call mom_error(fatal, "An unrecognized value of the obsolete parameter LT_ENHANCE was specified.")
2246  endif
2247  call log_param(param_file, mdl, "EPBL_LANGMUIR_SCHEME", tmpstr, &
2248  "EPBL_LANGMUIR_SCHEME selects the method for including Langmuir turbulence. "//&
2249  "Valid values are: \n"//&
2250  "\t NONE - Do not do any extra mixing due to Langmuir turbulence \n"//&
2251  "\t RESCALE - Use a multiplicative rescaling of mstar to account for Langmuir turbulence \n"//&
2252  "\t ADDITIVE - Add a Langmuir turblence contribution to mstar to other contributions", &
2253  default=none_string)
2254  tmpstr = uppercase(tmpstr)
2255  select case (tmpstr)
2256  case (none_string)
2257  cs%LT_enhance_form = no_langmuir
2258  case (rescaled_string)
2259  cs%LT_enhance_form = langmuir_rescale
2260  case (additive_string)
2261  cs%LT_enhance_form = langmuir_add
2262  case default
2263  call mom_mesg('energetic_PBL_init: EPBL_LANGMUIR_SCHEME ="'//trim(tmpstr)//'"', 0)
2264  call mom_error(fatal, "energetic_PBL_init: Unrecognized setting "// &
2265  "EPBL_LANGMUIR_SCHEME = "//trim(tmpstr)//" found in input file.")
2266  end select
2267 
2268  call get_param(param_file, mdl, "LT_ENHANCE_COEF", cs%LT_ENHANCE_COEF, &
2269  "Coefficient for Langmuir enhancement of mstar", &
2270  units="nondim", default=0.447, do_not_log=(cs%LT_enhance_form==no_langmuir))
2271  call get_param(param_file, mdl, "LT_ENHANCE_EXP", cs%LT_ENHANCE_EXP, &
2272  "Exponent for Langmuir enhancementt of mstar", &
2273  units="nondim", default=-1.33, do_not_log=(cs%LT_enhance_form==no_langmuir))
2274  call get_param(param_file, mdl, "LT_MOD_LAC1", cs%LaC_MLDoEK, &
2275  "Coefficient for modification of Langmuir number due to "//&
2276  "MLD approaching Ekman depth.", &
2277  units="nondim", default=-0.87, do_not_log=(cs%LT_enhance_form==no_langmuir))
2278  call get_param(param_file, mdl, "LT_MOD_LAC2", cs%LaC_MLDoOB_stab, &
2279  "Coefficient for modification of Langmuir number due to "//&
2280  "MLD approaching stable Obukhov depth.", &
2281  units="nondim", default=0.0, do_not_log=(cs%LT_enhance_form==no_langmuir))
2282  call get_param(param_file, mdl, "LT_MOD_LAC3", cs%LaC_MLDoOB_un, &
2283  "Coefficient for modification of Langmuir number due to "//&
2284  "MLD approaching unstable Obukhov depth.", &
2285  units="nondim", default=0.0, do_not_log=(cs%LT_enhance_form==no_langmuir))
2286  call get_param(param_file, mdl, "LT_MOD_LAC4", cs%Lac_EKoOB_stab, &
2287  "Coefficient for modification of Langmuir number due to "//&
2288  "ratio of Ekman to stable Obukhov depth.", &
2289  units="nondim", default=0.95, do_not_log=(cs%LT_enhance_form==no_langmuir))
2290  call get_param(param_file, mdl, "LT_MOD_LAC5", cs%Lac_EKoOB_un, &
2291  "Coefficient for modification of Langmuir number due to "//&
2292  "ratio of Ekman to unstable Obukhov depth.", &
2293  units="nondim", default=0.95, do_not_log=(cs%LT_enhance_form==no_langmuir))
2294  endif
2295 
2296 
2297 !/ Logging parameters
2298  ! This gives a minimum decay scale that is typically much less than Angstrom.
2299  cs%ustar_min = 2e-4*cs%omega*(gv%Angstrom_Z + gv%H_to_Z*gv%H_subroundoff)
2300  call log_param(param_file, mdl, "EPBL_USTAR_MIN", cs%ustar_min*us%Z_to_m*us%s_to_T, &
2301  "The (tiny) minimum friction velocity used within the "//&
2302  "ePBL code, derived from OMEGA and ANGSTROM.", units="m s-1")
2303 
2304 
2305 !/ Checking output flags
2306  z3_t3_to_m3_s3 = us%Z_to_m**3 * us%s_to_T**3
2307  cs%id_ML_depth = register_diag_field('ocean_model', 'ePBL_h_ML', diag%axesT1, &
2308  time, 'Surface boundary layer depth', 'm', conversion=us%Z_to_m, &
2309  cmor_long_name='Ocean Mixed Layer Thickness Defined by Mixing Scheme')
2310  cs%id_TKE_wind = register_diag_field('ocean_model', 'ePBL_TKE_wind', diag%axesT1, &
2311  time, 'Wind-stirring source of mixed layer TKE', 'm3 s-3', conversion=z3_t3_to_m3_s3)
2312  cs%id_TKE_MKE = register_diag_field('ocean_model', 'ePBL_TKE_MKE', diag%axesT1, &
2313  time, 'Mean kinetic energy source of mixed layer TKE', 'm3 s-3', conversion=z3_t3_to_m3_s3)
2314  cs%id_TKE_conv = register_diag_field('ocean_model', 'ePBL_TKE_conv', diag%axesT1, &
2315  time, 'Convective source of mixed layer TKE', 'm3 s-3', conversion=z3_t3_to_m3_s3)
2316  cs%id_TKE_forcing = register_diag_field('ocean_model', 'ePBL_TKE_forcing', diag%axesT1, &
2317  time, 'TKE consumed by mixing surface forcing or penetrative shortwave radation '//&
2318  'through model layers', 'm3 s-3', conversion=z3_t3_to_m3_s3)
2319  cs%id_TKE_mixing = register_diag_field('ocean_model', 'ePBL_TKE_mixing', diag%axesT1, &
2320  time, 'TKE consumed by mixing that deepens the mixed layer', 'm3 s-3', conversion=z3_t3_to_m3_s3)
2321  cs%id_TKE_mech_decay = register_diag_field('ocean_model', 'ePBL_TKE_mech_decay', diag%axesT1, &
2322  time, 'Mechanical energy decay sink of mixed layer TKE', 'm3 s-3', conversion=z3_t3_to_m3_s3)
2323  cs%id_TKE_conv_decay = register_diag_field('ocean_model', 'ePBL_TKE_conv_decay', diag%axesT1, &
2324  time, 'Convective energy decay sink of mixed layer TKE', 'm3 s-3', conversion=z3_t3_to_m3_s3)
2325  cs%id_Mixing_Length = register_diag_field('ocean_model', 'Mixing_Length', diag%axesTi, &
2326  time, 'Mixing Length that is used', 'm', conversion=us%Z_to_m)
2327  cs%id_Velocity_Scale = register_diag_field('ocean_model', 'Velocity_Scale', diag%axesTi, &
2328  time, 'Velocity Scale that is used.', 'm s-1', conversion=us%Z_to_m*us%s_to_T)
2329  cs%id_MSTAR_mix = register_diag_field('ocean_model', 'MSTAR', diag%axesT1, &
2330  time, 'Total mstar that is used.', 'nondim')
2331 
2332  if (cs%use_LT) then
2333  cs%id_LA = register_diag_field('ocean_model', 'LA', diag%axesT1, &
2334  time, 'Langmuir number.', 'nondim')
2335  cs%id_LA_mod = register_diag_field('ocean_model', 'LA_MOD', diag%axesT1, &
2336  time, 'Modified Langmuir number.', 'nondim')
2337  cs%id_MSTAR_LT = register_diag_field('ocean_model', 'MSTAR_LT', diag%axesT1, &
2338  time, 'Increase in mstar due to Langmuir Turbulence.', 'nondim')
2339  endif
2340 
2341  call get_param(param_file, mdl, "ENABLE_THERMODYNAMICS", use_temperature, &
2342  "If true, temperature and salinity are used as state "//&
2343  "variables.", default=.true.)
2344 
2345  if (max(cs%id_TKE_wind, cs%id_TKE_MKE, cs%id_TKE_conv, &
2346  cs%id_TKE_mixing, cs%id_TKE_mech_decay, cs%id_TKE_forcing, &
2347  cs%id_TKE_conv_decay) > 0) then
2348  call safe_alloc_alloc(cs%diag_TKE_wind, isd, ied, jsd, jed)
2349  call safe_alloc_alloc(cs%diag_TKE_MKE, isd, ied, jsd, jed)
2350  call safe_alloc_alloc(cs%diag_TKE_conv, isd, ied, jsd, jed)
2351  call safe_alloc_alloc(cs%diag_TKE_forcing, isd, ied, jsd, jed)
2352  call safe_alloc_alloc(cs%diag_TKE_mixing, isd, ied, jsd, jed)
2353  call safe_alloc_alloc(cs%diag_TKE_mech_decay, isd, ied, jsd, jed)
2354  call safe_alloc_alloc(cs%diag_TKE_conv_decay, isd, ied, jsd, jed)
2355 
2356  cs%TKE_diagnostics = .true.
2357  endif
2358  if (cs%id_Velocity_Scale>0) call safe_alloc_alloc(cs%Velocity_Scale, isd, ied, jsd, jed, gv%ke+1)
2359  if (cs%id_Mixing_Length>0) call safe_alloc_alloc(cs%Mixing_Length, isd, ied, jsd, jed, gv%ke+1)
2360 
2361  call safe_alloc_alloc(cs%ML_depth, isd, ied, jsd, jed)
2362  if (max(cs%id_mstar_mix, cs%id_LA, cs%id_LA_mod, cs%id_MSTAR_LT ) >0) then
2363  call safe_alloc_alloc(cs%Mstar_mix, isd, ied, jsd, jed)
2364  call safe_alloc_alloc(cs%LA, isd, ied, jsd, jed)
2365  call safe_alloc_alloc(cs%LA_MOD, isd, ied, jsd, jed)
2366  call safe_alloc_alloc(cs%MSTAR_LT, isd, ied, jsd, jed)
2367  endif
2368 
2369 end subroutine energetic_pbl_init
2370 
2371 !> Clean up and deallocate memory associated with the energetic_PBL module.
2372 subroutine energetic_pbl_end(CS)
2373  type(energetic_pbl_cs), pointer :: cs !< Energetic_PBL control structure that
2374  !! will be deallocated in this subroutine.
2375 
2376  if (.not.associated(cs)) return
2377 
2378  if (allocated(cs%ML_depth)) deallocate(cs%ML_depth)
2379  if (allocated(cs%LA)) deallocate(cs%LA)
2380  if (allocated(cs%LA_MOD)) deallocate(cs%LA_MOD)
2381  if (allocated(cs%MSTAR_MIX)) deallocate(cs%MSTAR_MIX)
2382  if (allocated(cs%MSTAR_LT)) deallocate(cs%MSTAR_LT)
2383  if (allocated(cs%diag_TKE_wind)) deallocate(cs%diag_TKE_wind)
2384  if (allocated(cs%diag_TKE_MKE)) deallocate(cs%diag_TKE_MKE)
2385  if (allocated(cs%diag_TKE_conv)) deallocate(cs%diag_TKE_conv)
2386  if (allocated(cs%diag_TKE_forcing)) deallocate(cs%diag_TKE_forcing)
2387  if (allocated(cs%diag_TKE_mixing)) deallocate(cs%diag_TKE_mixing)
2388  if (allocated(cs%diag_TKE_mech_decay)) deallocate(cs%diag_TKE_mech_decay)
2389  if (allocated(cs%diag_TKE_conv_decay)) deallocate(cs%diag_TKE_conv_decay)
2390  if (allocated(cs%Mixing_Length)) deallocate(cs%Mixing_Length)
2391  if (allocated(cs%Velocity_Scale)) deallocate(cs%Velocity_Scale)
2392 
2393  deallocate(cs)
2394 
2395 end subroutine energetic_pbl_end
2396 
2397 !> \namespace MOM_energetic_PBL
2398 !!
2399 !! By Robert Hallberg, 2015.
2400 !!
2401 !! This file contains the subroutine (energetic_PBL) that uses an
2402 !! integrated boundary layer energy budget (like a bulk- or refined-
2403 !! bulk mixed layer scheme), but instead of homogenizing this model
2404 !! calculates a finite diffusivity and viscosity, which in this
2405 !! regard is conceptually similar to what is done with KPP or various
2406 !! two-equation closures. However, the scheme that is implemented
2407 !! here has the big advantage that is entirely implicit, but is
2408 !! simple enough that it requires only a single vertical pass to
2409 !! determine the diffusivity. The development of bulk mixed layer
2410 !! models stems from the work of various people, as described in the
2411 !! review paper by Niiler and Kraus (1979). The work here draws in
2412 !! with particular on the form for TKE decay proposed by Oberhuber
2413 !! (JPO, 1993, 808-829), with an extension to a refined bulk mixed
2414 !! layer as described in Hallberg (Aha Huliko'a, 2003). The physical
2415 !! processes portrayed in this subroutine include convectively driven
2416 !! mixing and mechanically driven mixing. Unlike boundary-layer
2417 !! mixing, stratified shear mixing is not a one-directional turbulent
2418 !! process, and it is dealt with elsewhere in the MOM6 code within
2419 !! the module MOM_kappa_shear.F90. It is assumed that the heat,
2420 !! mass, and salt fluxes have been applied elsewhere, but that their
2421 !! implications for the integrated TKE budget have been captured in
2422 !! an array that is provided as an argument to this subroutine. This
2423 !! is a full 3-d array due to the effects of penetrating shortwave
2424 !! radiation.
2425 
2426 end module mom_energetic_pbl
mom_verticalgrid
Provides a transparent vertical ocean grid type and supporting routines.
Definition: MOM_verticalGrid.F90:2
mom_file_parser::log_version
An overloaded interface to log version information about modules.
Definition: MOM_file_parser.F90:109
mom_diag_mediator
The subroutines here provide convenient wrappers to the fms diag_manager interfaces with additional d...
Definition: MOM_diag_mediator.F90:3
mom_variables::thermo_var_ptrs
Pointers to an assortment of thermodynamic fields that may be available, including potential temperat...
Definition: MOM_variables.F90:82
mom_string_functions
Handy functions for manipulating strings.
Definition: MOM_string_functions.F90:2
mom_energetic_pbl
Energetically consistent planetary boundary layer parameterization.
Definition: MOM_energetic_PBL.F90:2
mom_file_parser::param_file_type
A structure that can be parsed to read and document run-time parameters.
Definition: MOM_file_parser.F90:54
mom_file_parser::get_param
An overloaded interface to read and log the values of various types of parameters.
Definition: MOM_file_parser.F90:102
mom_unit_scaling::unit_scale_type
Describes various unit conversion factors.
Definition: MOM_unit_scaling.F90:14
mom_diag_mediator::post_data
Make a diagnostic available for averaging or output.
Definition: MOM_diag_mediator.F90:70
mom_forcing_type
This module implements boundary forcing for MOM6.
Definition: MOM_forcing_type.F90:2
mom_wave_interface
Interface for surface waves.
Definition: MOM_wave_interface.F90:2
mom_wave_interface::wave_parameters_cs
Container for all surface wave related parameters.
Definition: MOM_wave_interface.F90:47
mom_verticalgrid::verticalgrid_type
Describes the vertical ocean grid, including unit conversion factors.
Definition: MOM_verticalGrid.F90:24
mom_domains
Describes the decomposed MOM domain and has routines for communications across PEs.
Definition: MOM_domains.F90:2
mom_variables
Provides transparent structures with groups of MOM6 variables and supporting routines.
Definition: MOM_variables.F90:2
mom_cpu_clock
Wraps the MPP cpu clock functions.
Definition: MOM_cpu_clock.F90:2
mom_file_parser
The MOM6 facility to parse input files for runtime parameters.
Definition: MOM_file_parser.F90:2
mom_energetic_pbl::energetic_pbl_cs
This control structure holds parameters for the MOM_energetic_PBL module.
Definition: MOM_energetic_PBL.F90:35
mom_grid
Provides the ocean grid type.
Definition: MOM_grid.F90:2
mom_unit_scaling
Provides a transparent unit rescaling type to facilitate dimensional consistency testing.
Definition: MOM_unit_scaling.F90:2
mom_forcing_type::forcing
Structure that contains pointers to the boundary forcing used to drive the liquid ocean simulated by ...
Definition: MOM_forcing_type.F90:49
mom_energetic_pbl::epbl_column_diags
A type for conveniently passing around ePBL diagnostics for a column.
Definition: MOM_energetic_PBL.F90:221
mom_file_parser::log_param
An overloaded interface to log the values of various types of parameters.
Definition: MOM_file_parser.F90:96
mom_domains::create_group_pass
Set up a group of halo updates.
Definition: MOM_domains.F90:79
mom_error_handler
Routines for error handling and I/O management.
Definition: MOM_error_handler.F90:2
mom_grid::ocean_grid_type
Ocean grid type. See mom_grid for details.
Definition: MOM_grid.F90:25
mom_diag_mediator::diag_ctrl
The following data type a list of diagnostic fields an their variants, as well as variables that cont...
Definition: MOM_diag_mediator.F90:239