From ea57802abffc16fb444196d4f6f6c4630a17a590 Mon Sep 17 00:00:00 2001 From: Brandon Reichl Date: Fri, 24 May 2019 10:15:10 -0400 Subject: [PATCH 01/82] First working version of split Mstar in MOM_ePBL --- .../vertical/MOM_energetic_PBL.F90 | 657 ++++++++++-------- 1 file changed, 352 insertions(+), 305 deletions(-) diff --git a/src/parameterizations/vertical/MOM_energetic_PBL.F90 b/src/parameterizations/vertical/MOM_energetic_PBL.F90 index 1392f4c55c..b707c88eea 100644 --- a/src/parameterizations/vertical/MOM_energetic_PBL.F90 +++ b/src/parameterizations/vertical/MOM_energetic_PBL.F90 @@ -32,39 +32,32 @@ module MOM_energetic_PBL !> This control structure holds parameters for the MOM_energetic_PBL module type, public :: energetic_PBL_CS ; private - real :: mstar !< The ratio of the friction velocity cubed to the TKE available to - !! drive entrainment, nondimensional. This quantity is the vertically - !! integrated shear production minus the vertically integrated - !! dissipation of TKE produced by shear. + !/ Constants + real :: VonKar = 0.41 !< The von Karman coefficient + real :: omega !< The Earth's rotation rate [s-1]. + real :: omega_frac !< When setting the decay scale for turbulence, use this fraction of + !! the absolute rotation rate blended with the local value of f, as + !! sqrt((1-of)*f^2 + of*4*omega^2). + + !/ Convection related terms real :: nstar !< The fraction of the TKE input to the mixed layer available to drive !! entrainment [nondim]. This quantity is the vertically integrated !! buoyancy production minus the vertically integrated dissipation of !! TKE produced by buoyancy. + + !/ Mixing Length terms + logical :: Use_MLD_iteration=.false. !< False to use old ePBL method. + logical :: Orig_MLD_iteration=.false. !< False to use old MLD value + logical :: MLD_iteration_guess=.false. !< False to default to guessing half the + !! ocean depth for the iteration. real :: MixLenExponent !< Exponent in the mixing length shape-function. !! 1 is law-of-the-wall at top and bottom, !! 2 is more KPP like. - real :: TKE_decay !< The ratio of the natural Ekman depth to the TKE decay scale [nondim]. real :: MKE_to_TKE_effic !< The efficiency with which mean kinetic energy released by !! mechanically forced entrainment of the mixed layer is converted to !! TKE [nondim]. -! real :: Hmix_min !< The minimum mixed layer thickness in m. real :: ustar_min !< A minimum value of ustar to avoid numerical problems [m s-1]. !! If the value is small enough, this should not affect the solution. - real :: omega !< The Earth's rotation rate [s-1]. - real :: omega_frac !< When setting the decay scale for turbulence, use this fraction of - !! the absolute rotation rate blended with the local value of f, as - !! sqrt((1-of)*f^2 + of*4*omega^2). - real :: wstar_ustar_coef !< A ratio relating the efficiency with which convectively released - !! energy is converted to a turbulent velocity, relative to - !! mechanically forced turbulent kinetic energy [nondim]. - !! Making this larger increases the diffusivity. - integer :: vstar_mode !< An integer marking the chosen method for finding vstar. - !! vstar = 0 is the original (TKE_remaining)^1/3 - !! vstar = 1 is the version described by Reichl and Hallberg, 2018 - real :: vstar_surf_fac !< If (vstar == 1) this is the proportionality coefficient between - !! ustar and the surface mechanical contribution to vstar - real :: vstar_scale_fac !< An overall nondimensional scaling factor for vstar times a unit - !! conversion factor. Making this larger increases the diffusivity. real :: Ekman_scale_coef !< A nondimensional scaling factor controlling the inhibition of the !! diffusive length scale by rotation. Making this larger decreases !! the diffusivity in the planetary boundary layer. @@ -76,6 +69,31 @@ module MOM_energetic_PBL !! Use_MLD_iteration is true [Z ~> m]. real :: min_mix_len !< The minimum mixing length scale that will be used by ePBL [Z ~> m]. !! The default (0) does not set a minimum. + + !/ Velocity scale terms + integer :: wT_mode !< An integer marking the chosen method for finding wT + !! (the turbulent velocity scale) . + !! wT_mode = 0 is the original (TKE_remaining)^1/3 + !! wT_mode = 1 is the version described by Reichl and Hallberg, 2018 + real :: wstar_ustar_coef !< A ratio relating the efficiency with which convectively released + !! energy is converted to a turbulent velocity, relative to + !! mechanically forced turbulent kinetic energy [nondim]. + !! Making this larger increases the diffusivity. + real :: vstar_surf_fac !< If (wT_mode == 1) this is the proportionality coefficient between + !! ustar and the surface mechanical contribution to vstar + real :: vstar_scale_fac !< An overall nondimensional scaling factor for vstar times a unit + !! conversion factor. Making this larger increases the diffusivity. + + !mstar related options + integer :: MStar_mode = 0 !< An coded integer to determine which formula is used to set mstar + logical :: MSTAR_FLATCAP=.true. !< Set false to use asymptotic mstar cap. + real :: mstar_cap !< Since MSTAR is restoring undissipated energy to mixing, + !! there must be a cap on how large it can be. This + !! is definitely a function of latitude (Ekman limit), + !! but will be taken as constant for now. + + !/ vertical decay related options + real :: TKE_decay !< The ratio of the natural Ekman depth to the TKE decay scale [nondim]. real :: N2_Dissipation_Scale_Neg !< A nondimensional scaling factor controlling the loss of TKE !! due to enhanced dissipation in the presence of negative (unstable) !! local stratification. This dissipation is applied to the available @@ -86,43 +104,56 @@ module MOM_energetic_PBL !! local stratification. This dissipation is applied to the available !! TKE which includes both that generated at the surface and that !! generated at depth. - !MSTAR related options - real :: MSTAR_CAP !< Since MSTAR is restoring undissipated energy to mixing, - !! there must be a cap on how large it can be. This - !! is definitely a function of latitude (Ekman limit), - !! but will be taken as constant for now. - real :: MSTAR_SLOPE !< Slope of the function which relates the shear production to the + + !/ mstar_mode == 0 + real :: fixed_mstar !< Mstar is the ratio of the friction velocity cubed to the TKE available to + !! drive entrainment, nondimensional. This quantity is the vertically + !! integrated shear production minus the vertically integrated + !! dissipation of TKE produced by shear. This value is used if the option + !! for using a fixed mstar is used. + + !/ mstar_mode == 1 + real :: mstar_slope !< Slope of the function which relates the shear production to the !< mixing layer depth, Ekman depth, and Monin-Obukhov depth. - real :: MSTAR_XINT !< Value where MSTAR function transitions from linear + real :: mstar_xint !< Value where MSTAR function transitions from linear !! to decay toward MSTAR->0 at fully developed Ekman depth. - real :: MSTAR_XINT_UP !< Similar but for transition to asymptotic cap. - real :: MSTAR_AT_XINT !< Intercept value of MSTAR at value where function + real :: mstar_xint_up !< Similar but for transition to asymptotic cap. + real :: mstar_at_xint !< Intercept value of MSTAR at value where function !! changes to linear transition. - real :: RH18_mst_cN1 !< MSTAR_N coefficient 1 (outter-most coefficient for fit). + real :: mstar_exp = -2. !< Exponent in decay at negative and positive limits of MLD_over_STAB + real :: mstar_a !< Coefficients of expressions for mstar in asymptotic limits, computed + !! to match the function value and slope at both ends of the linear fit + !! within the well constrained region. + real :: mstar_a2 !< Coefficients of expressions for mstar in asymptotic limits. + real :: mstar_b !< Coefficients of expressions for mstar in asymptotic limits. + real :: mstar_b2 !< Coefficients of expressions for mstar in asymptotic limits. + + !/ mstar_mode == 2 + real :: C_EK = 0.17 !< MSTAR Coefficient in rotation limit for mstar_mode=2 + real :: MSTAR_COEF = 0.3 !< MSTAR coefficient in rotation/stabilizing balance for mstar_mode=2 + + !/ mstar_mode == 3 + real :: RH18_mstar_cN1 !< MSTAR_N coefficient 1 (outter-most coefficient for fit). !! Value of 0.275 in RH18. Increasing this !! coefficient increases mechanical mixing for all values of Hf/ust, !! but is most effective at low values (weakly developed OSBLs). - real :: RH18_mst_cN2 !< MSTAR_N coefficient 2 (coefficient outside of exponential decay). + real :: RH18_mstar_cN2 !< MSTAR_N coefficient 2 (coefficient outside of exponential decay). !! Value of 8.0 in RH18. Increasing this coefficient increases MSTAR !! for all values of HF/ust, with a consistent affect across !! a wide range of Hf/ust. - real :: RH18_mst_cN3 !< MSTAR_N coefficient 3 (exponential decay coefficient). Value of + real :: RH18_mstar_cN3 !< MSTAR_N coefficient 3 (exponential decay coefficient). Value of !! -5.0 in RH18. Increasing this increases how quickly the value !! of MSTAR decreases as Hf/ust increases. - real :: RH18_mst_cS1 !< MSTAR_S coefficient for RH18 in stabilizing limit. + real :: RH18_mstar_cS1 !< MSTAR_S coefficient for RH18 in stabilizing limit. !! Value of 0.2 in RH18. - real :: RH18_mst_cS2 !< MSTAR_S exponent for RH18 in stabilizing limit. + real :: RH18_mstar_cS2 !< MSTAR_S exponent for RH18 in stabilizing limit. !! Value of 0.4 in RH18. - real :: MSTAR_N = -2. !< Exponent in decay at negative and positive limits of MLD_over_STAB - real :: MSTAR_A !< Coefficients of expressions for mstar in asymptotic limits, computed - !! to match the function value and slope at both ends of the linear fit - !! within the well constrained region. - real :: MSTAR_A2 !< Coefficients of expressions for mstar in asymptotic limits. - real :: MSTAR_B !< Coefficients of expressions for mstar in asymptotic limits. - real :: MSTAR_B2 !< Coefficients of expressions for mstar in asymptotic limits. - real :: C_EK = 0.17 !< MSTAR Coefficient in rotation limit for mstar_mode=2 - real :: MSTAR_COEF = 0.3 !< MSTAR coefficient in rotation/stabilizing balance for mstar_mode=2 - !Langmuir turbulence related parameters + + !/ Coefficient for shear/convective turbulence interaction + real :: mstar_convect_coef !< Factor to reduce mstar when statically unstable. + + !/ Langmuir turbulence related parameters + logical :: Use_LT = .false. !< Flag for using LT in Energy calculation integer :: LT_ENHANCE_FORM !< Integer for Enhancement functional form (various options) real :: LT_ENHANCE_COEF !< Coefficient in fit for Langmuir Enhancment real :: LT_ENHANCE_EXP !< Exponent in fit for Langmuir Enhancement @@ -141,27 +172,15 @@ module MOM_energetic_PBL real :: LaC_EKoOB_un !< Coefficient for Langmuir number modification based on the ratio of !! the Ekman depth over the Obukov depth with destablizing forcing. real :: Max_Enhance_M = 5. !< The maximum allowed LT enhancement to the mixing. - real :: CNV_MST_FAC !< Factor to reduce mstar when statically unstable. + + !/ Others type(time_type), pointer :: Time=>NULL() !< A pointer to the ocean model's clock. - integer :: MSTAR_MODE = 0 !< An coded integer to determine which formula is used to set mstar - integer :: CONST_MSTAR=0 !< The value of MSTAR_MODE to use a constant mstar - integer :: MLD_o_OBUKHOV=1 !< The value of MSTAR_MODE to base mstar on the ratio of the mixed - !! layer depth to the Obukhov depth - integer :: EKMAN_o_OBUKHOV=2 !< The value of MSTAR_MODE to base mstar on the ratio of the Ekman - !! layer depth to the Obukhov depth - integer :: MSTAR_RH18 = 3 !< The value of MSTAR_MODE to base mstar off of RH18 - logical :: MSTAR_FLATCAP=.true. !< Set false to use asymptotic mstar cap. logical :: TKE_diagnostics = .false. !< If true, diagnostics of the TKE budget are being calculated. - logical :: Use_LT = .false. !< Flag for using LT in Energy calculation logical :: orig_PE_calc = .true. !< If true, the ePBL code uses the original form of the !! potential energy change code. Otherwise, it uses a newer version !! that can work with successive increments to the diffusivity in !! upward or downward passes. - logical :: Use_MLD_iteration=.false. !< False to use old ePBL method. - logical :: Orig_MLD_iteration=.false. !< False to use old MLD value - logical :: MLD_iteration_guess=.false. !< False to default to guessing half the - !! ocean depth for the iteration. logical :: Mixing_Diagnostics = .false. !< Will be true when outputting mixing !! length and velocity scales logical :: MSTAR_Diagnostics=.false. !< If true, utput diagnostics of the mstar calculation. @@ -381,15 +400,17 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS real :: h_tt_min ! A surface roughness length [H ~> m or kg m-2]. real :: C1_3 ! = 1/3. - real :: vonKar ! The vonKarman constant. real :: I_dtrho ! 1.0 / (dt * Rho0) in [m3 kg-1 s-1]. This is ! used convert TKE back into ustar^3. real :: U_star ! The surface friction velocity [Z s-1 ~> m s-1]. real :: U_Star_Mean ! The surface friction without gustiness [Z s-1 ~> m s-1]. + real :: B_Flux ! The surface buoyancy flux [Z2 s-3 ~> m2 s-3] real :: vstar ! An in-situ turbulent velocity [m s-1]. - real :: Enhance_M ! An enhancement factor for vstar, based here on Langmuir impact. - real :: LA ! The Langmuir number [nondim] - real :: LAmod ! A modified Langmuir number accounting for other parameters. + real :: mstar_total ! The value of mstar used in ePBL + real :: enhance_mstar ! An ehhancement to mstar (output for diagnostic) + real :: mstar_LT ! An addition to mstar (output for diagnostic) + real :: LA ! The value of the Langmuir number + real :: LAmod ! real :: hbs_here ! The local minimum of hb_hs and MixLen_shape, times a ! conversion factor from H to Z [Z H-1 ~> 1 or m3 kg-1]. real :: nstar_FC ! The fraction of conv_PErel that can be converted to mixing [nondim]. @@ -502,26 +523,6 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS integer, save :: NOTCONVERGED! !-End BGR iteration parameters----------------------------------------- real :: N2_dissipation - real :: Bf_STABLE ! Buoyancy flux, capped at 0 (negative only) - real :: Bf_UNSTABLE ! Buoyancy flux, floored at 0 (positive only) - real :: Stab_Scale ! Composite of stabilizing Ekman scale and Monin-Obukhov length scales [Z ~> m]. - real :: iL_Ekman ! Inverse of Ekman length scale [Z-1 ~> m-1]. - real :: iL_Obukhov ! Inverse of Obukhov length scale [Z-1 ~> m-1]. - real :: MLD_o_Ekman ! > - real :: MLD_o_Obukhov_stab ! Ratios of length scales where MLD is boundary layer depth - real :: Ekman_o_Obukhov_stab ! > - real :: MLD_o_Obukhov_un ! Ratios of length scales where MLD is boundary layer depth - real :: Ekman_o_Obukhov_un ! > - - real :: C_MO = 1. ! Constant in Stab_Scale for Monin-Obukhov - real :: C_EK = 2. ! Constant in Stab_Scale for Ekman length - real :: MLD_over_STAB ! Mixing layer depth divided by Stab_Scale - real :: MSTAR_MIX ! The value of mstar (Proportionality of TKE to drive mixing to ustar - ! cubed) which is computed as a function of latitude, boundary layer depth, - ! and the Monin-Obukhov depth. - real :: MSTAR_LT ! The added mstar contribution due to Langmuir turbulence - real :: MSTAR_Conv_Adj ! Adjustment made to mstar due to convection reducing mechanical mixing. - real :: MSTAR_STAB, MSTAR_ROT ! Mstar in each limit, max is used. real :: Surface_Scale ! Surface decay scale for vstar real :: K_Enhancement ! A local enhancement of K, perhaps due to Langmuir turbulence ! For LT_ENH_K_R16 @@ -529,6 +530,10 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS real, parameter :: Max_Shape_Function = 0.148148 ! The max value of the shape function of the enhancement real, parameter :: Max_K_Enhancement = 2.25 ! The max value of the enhancement !-End for LT_ENH_K_R16 + ! For output of MLD relations, if not using we should eliminate + real :: iL_Ekman ! Inverse of Ekman length scale [Z-1 ~> m-1]. + real :: iL_Obukhov ! Inverse of Obukhov length scale [Z-1 ~> m-1]. + logical :: debug=.false. ! Change this hard-coded value for debugging. ! The following arrays are used only for debugging purposes. @@ -560,11 +565,9 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS dt__diag = dt ; if (present(dt_diag)) dt__diag = dt_diag IdtdR0 = 1.0 / (dt__diag * GV%Rho0) write_diags = .true. ; if (present(last_call)) write_diags = last_call - max_itt = 20 + max_itt = 20 !BGR: Why is this hard-coded? h_tt_min = 0.0 - vonKar = 0.41 - mstar_mix=CS%MSTAR!Initialize to mstar I_dtrho = 0.0 ; if (dt*GV%Rho0 > 0.0) I_dtrho = 1.0 / (dt*GV%Rho0) ! Determine whether to zero out diagnostics before accumulation. @@ -628,7 +631,6 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS enddo ; enddo do i=is,ie CS%ML_depth(i,j) = h(i,1)*GV%H_to_Z - !CS%ML_depth2(i,j) = h(i,1)*GV%H_to_Z sfc_connected(i) = .true. enddo @@ -646,16 +648,13 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS U_star = fluxes%ustar(i,j) U_Star_Mean = fluxes%ustar_gustless(i,j) + B_Flux = buoy_flux(i,j) if (associated(fluxes%ustar_shelf) .and. associated(fluxes%frac_shelf_h)) then if (fluxes%frac_shelf_h(i,j) > 0.0) & U_star = (1.0 - fluxes%frac_shelf_h(i,j)) * U_star + & fluxes%frac_shelf_h(i,j) * fluxes%ustar_shelf(i,j) endif if (U_Star < CS%ustar_min) U_Star = CS%ustar_min - - ! Computing Bf w/ limiters. - Bf_Stable = max(0.0, buoy_Flux(i,j)) ! Positive for stable - Bf_Unstable = min(0.0, buoy_flux(i,j)) ! Negative for unstable if (CS%omega_frac >= 1.0) then ; absf(i) = 2.0*CS%omega else absf(i) = 0.25*US%s_to_T*((abs(G%CoriolisBu(I,J)) + abs(G%CoriolisBu(I-1,J-1))) + & @@ -663,51 +662,6 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS if (CS%omega_frac > 0.0) & absf(i) = sqrt(CS%omega_frac*4.0*CS%omega**2 + (1.0-CS%omega_frac)*absf(i)**2) endif - ! Computing stability scale which correlates with TKE for mixing, where - ! TKE for mixing = TKE production minus TKE dissipation - Stab_Scale = U_star**2 / ( VonKar * ( C_MO * BF_Stable / U_star - C_EK * U_star * absf(i))) - ! Inverse of Ekman and Obukhov - iL_Ekman = absf(i) / U_star - iL_Obukhov = buoy_flux(i,j)*vonkar / (U_star**3) - if (CS%USE_LT) then - Ekman_o_Obukhov_stab = abs(max(0., iL_Obukhov / (iL_Ekman + 1.e-10*US%Z_to_m))) - Ekman_o_Obukhov_un = abs(min(0., iL_Obukhov / (iL_Ekman + 1.e-10*US%Z_to_m))) - !### Consider recoding this as... - ! Max_ratio = 1.0e16 - ! Ekman_Obukhov = Max_ratio - ! if (abs(buoy_flux(i,j)*vonkar) < Max_ratio*(absf(i) * U_star**2)) & - ! Ekman_Obukhov = buoy_flux(i,j)*vonkar / (absf(i) * U_star**2) - ! if (buoy_flux(i,j) > 0.0) then - ! Ekman_o_Obukhov_stab = Ekman_Obukhov ; Ekman_o_Obukhov_un = 0.0 - ! else - ! Ekman_o_Obukhov_un = Ekman_Obukhov ; Ekman_o_Obukhov_stab = 0.0 - ! endif - endif - - if (CS%Mstar_Mode == CS%CONST_MSTAR) then - mech_TKE(i) = (dt*CS%mstar*GV%Rho0) * US%Z_to_m**3 * U_star**3 - conv_PErel(i) = 0.0 - - if (CS%TKE_diagnostics) then - CS%diag_TKE_wind(i,j) = CS%diag_TKE_wind(i,j) + mech_TKE(i) * IdtdR0 - if (TKE_forced(i,j,1) <= 0.0) then - CS%diag_TKE_forcing(i,j) = CS%diag_TKE_forcing(i,j) + & - max(-mech_TKE(i), TKE_forced(i,j,1)) * IdtdR0 - ! CS%diag_TKE_unbalanced_forcing(i,j) = CS%diag_TKE_unbalanced_forcing(i,j) + & - ! min(0.0, TKE_forced(i,j,1) + mech_TKE(i)) * IdtdR0 - else - CS%diag_TKE_forcing(i,j) = CS%diag_TKE_forcing(i,j) + CS%nstar*TKE_forced(i,j,1) * IdtdR0 - endif - endif - - if (TKE_forced(i,j,1) <= 0.0) then - mech_TKE(i) = mech_TKE(i) + TKE_forced(i,j,1) - if (mech_TKE(i) < 0.0) mech_TKE(i) = 0.0 - else - conv_PErel(i) = conv_PErel(i) + TKE_forced(i,j,1) - endif - - endif ! endif ; enddo @@ -741,16 +695,11 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS ! do i=is,ie ; if (G%mask2dT(i,j) > 0.5) then do k=1,nz ; T0(k) = T(i,k) ; S0(k) = S(i,k) ; enddo - ! Store the initial mechanical TKE and convectively released PE to - ! enable multiple iterations. - mech_TKE_top(i) = mech_TKE(i) ; conv_PErel_top(i) = conv_PErel(i) - !/The following lines are for the iteration over MLD - !{ ! max_MLD will initialized as ocean bottom depth max_MLD = 0.0 ; do k=1,nz ; max_MLD = max_MLD + h(i,k)*GV%H_to_Z ; enddo - min_MLD = 0.0 !min_MLD will initialize as 0. - !/BGR: May add user-input bounds for max/min MLD + !min_MLD will initialize as 0. + min_MLD = 0.0 !/BGR: Add MLD_guess based on stored previous value. ! note that this is different from ML_Depth already @@ -766,10 +715,9 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS ! Iterate up to MAX_OBL_IT times to determine a converged EPBL depth. OBL_CONVERGED = .false. - ! Initialize ENHANCE_M to 1 and mstar_lt to 0 - ENHANCE_M=1.e0 - MSTAR_LT = 0.0 do OBL_IT=1,MAX_OBL_IT ; if (.not. OBL_CONVERGED) then + ! If not using MLD_Iteration flag loop to only execute once. + if (.not.CS%Use_MLD_Iteration) OBL_CONVERGED = .true. ! Reset ML_depth CS%ML_depth(i,j) = h(i,1)*GV%H_to_Z @@ -777,117 +725,39 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS sfc_connected(i) = .true. - if (CS%Mstar_Mode > 0) then - ! Note the value of mech_TKE(i) now must be iterated over, so it is moved here - ! First solve for the TKE to PE length scale - if (CS%MSTAR_MODE == CS%MLD_o_OBUKHOV) then - MLD_over_Stab = MLD_guess / Stab_Scale - CS%MSTAR_XINT - !### MLD_over_Stab = (MLD_guess * (VonKar * (C_MO*BF_Stable - C_EK*U_star**2*absf(i)))) / & - !### U_star**3 - CS%MSTAR_XINT - if ((MLD_over_Stab) <= 0.0) then - !Asymptote to 0 as MLD_over_Stab -> -infinity (always) - MSTAR_mix = (CS%MSTAR_B*(MLD_over_Stab)+CS%MSTAR_A)**(CS%MSTAR_N) - else - if (CS%MSTAR_CAP>=0.) then - if (CS%MSTAR_FLATCAP .OR. (MLD_over_Stab <= CS%MSTAR_XINT_UP)) then - !If using flat cap (or if using asymptotic cap - ! but within linear regime we can make use of same code) - MSTAR_mix = min(CS%MSTAR_CAP, & - CS%MSTAR_SLOPE*(MLD_over_Stab)+CS%MSTAR_AT_XINT) - else - !Asymptote to MSTAR_CAP as MLD_over_Stab -> infinity - MSTAR_mix = CS%MSTAR_CAP - & - (CS%MSTAR_B2*(MLD_over_Stab-CS%MSTAR_XINT_UP)& - +CS%MSTAR_A2)**(CS%MSTAR_N) - endif - else - !No cap if negative cap value given. - MSTAR_mix = CS%MSTAR_SLOPE*(MLD_over_Stab)+CS%MSTAR_AT_XINT - endif - endif - elseif (CS%MSTAR_MODE == CS%EKMAN_o_OBUKHOV) then - !### Please refrain from using the construct A / B / C in place of A/(B*C). - ! The limit for the balance of rotation and stabilizing is f(L_Ekman,L_Obukhov) - mstar_STAB = CS%MSTAR_COEF*sqrt(Bf_Stable / U_star**2 / (absf(i)+1.e-10)) - !### Should be mstar_STAB = CS%MSTAR_COEF*sqrt(Bf_Stable / (U_star**2 * (absf(i)+1.e-10))) - ! The limit for rotation (Ekman length) limited mixin - mstar_ROT = CS%C_EK * log(max(1., U_star / (absf(i)+1.e-10) / MLD_guess)) - !### Consider rewriting the expression for mstar_ROT as: - ! mstar_Rot = 0.0 - ! if (Ustar > absf(i) * MLD_guess) & - ! mstar_ROT = CS%C_EK * log(U_star / (absf(i) * MLD_guess)) - ! Here 1.25 is .5/von Karman, which gives the Obukhov limit. - MSTAR_MIX = max(mstar_STAB, min(1.25, mstar_ROT)) - if (CS%MSTAR_CAP > 0.0) MSTAR_MIX = min(CS%MSTAR_CAP, MSTAR_MIX) - elseif (CS%MSTAR_MODE.eq.CS%MSTAR_RH18) then - MSTAR_ROT = CS%RH18_MST_CN1 * ( 1.0 - ( 1.+CS%RH18_MST_CN2 * & - exp( CS%RH18_MST_CN3 * MLD_GUESS * absf(i) / u_star) )**-1.0 ) - MSTAR_STAB = CS%RH18_MST_CS1 * (bf_stable**2*MLD_GUESS & - / ( u_star**5 * absf(i) ) ) **CS%RH18_MST_CS2 - MSTAR_MIX = MSTAR_ROT + MSTAR_STAB - endif!mstar_mode==1 or ==2 or ==3 - ! Adjustment for unstable buoyancy flux. - ! Convection reduces mechanical mixing because there - ! is less density gradient to mix. (Statically unstable near surface) - MSTAR_Conv_Adj = 1. - CS%CNV_MST_FAC * (-BF_Unstable + 1.e-10*US%m_to_Z**2) / & - ( (-Bf_Unstable + 1.e-10*US%m_to_Z**2) + & - 2.0 *MSTAR_MIX * U_star**3 / MLD_guess ) - ! MSTAR_Conv_Adj = 1. - CS%CNV_MST_FAC * ((-BF_Unstable + 1.e-10*US%m_to_Z**2)*MLD_guess) / & - ! ( (-Bf_Unstable + 1.e-10*US%m_to_Z**2)*MLD_guess + & - ! 2.0*MSTAR_MIX * U_star**3 ) - if (CS%USE_LT) then - call get_Langmuir_Number( LA, G, GV, US, abs(MLD_guess), u_star_mean, i, j, & - H=H(i,:), U_H=U(i,:), V_H=V(i,:), WAVES=WAVES) - ! 2. Get parameters for modified LA - MLD_o_Ekman = abs(MLD_guess * iL_Ekman) - MLD_o_Obukhov_stab = abs(max(0., MLD_guess*iL_Obukhov)) - MLD_o_Obukhov_un = abs(min(0., MLD_guess*iL_Obukhov)) - ! 3. Adjust LA based on various parameters. - ! Assumes linear factors based on length scale ratios to adjust LA - ! Note when these coefficients are set to 0 recovers simple LA. - LAmod = LA * (1.0 + max(-0.5,CS%LaC_MLDoEK * MLD_o_Ekman) + & - CS%LaC_EKoOB_stab * Ekman_o_Obukhov_stab + & - CS%LaC_EKoOB_un * Ekman_o_Obukhov_un + & - CS%LaC_MLDoOB_stab * MLD_o_Obukhov_stab + & - CS%LaC_MLDoOB_un * MLD_o_Obukhov_un ) - if (CS%LT_Enhance_Form==1) then - !Original w'/ust scaling w/ Van Roekel et al. 2012 scaling - ! NOTE we know now that this is not the right way to scale M. - ENHANCE_M = (1. + (1.4*LA)**(-2) + (5.4*LA)**(-4))**(1.5) - elseif (CS%LT_Enhance_Form==2) then - ! Enhancement is multiplied (added mst_lt set to 0) - ENHANCE_M = min(CS%Max_Enhance_M, (1. + CS%LT_ENHANCE_COEF*LAmod**CS%LT_ENHANCE_EXP)) - MSTAR_LT = 0.0 - elseif (CS%LT_ENHANCE_Form == 3) then - ! or Enhancement is additive (multiplied enhance_m set to 1) - MSTAR_LT = CS%LT_ENHANCE_COEF * LAmod**CS%LT_ENHANCE_EXP - ENHANCE_M = 1.0 - endif - endif - !Reset mech_tke and conv_perel values (based on new mstar) - mech_TKE(i) = ( MSTAR_mix * MSTAR_conv_adj * ENHANCE_M + MSTAR_LT) * & - US%Z_to_m**3 * (dt*GV%Rho0*U_star**3) - conv_PErel(i) = 0.0 - if (CS%TKE_diagnostics) then - CS%diag_TKE_wind(i,j) = CS%diag_TKE_wind(i,j) + mech_TKE(i) * IdtdR0 - if (TKE_forced(i,j,1) <= 0.0) then - CS%diag_TKE_forcing(i,j) = CS%diag_TKE_forcing(i,j) + & - max(-mech_TKE(i), TKE_forced(i,j,1)) * IdtdR0 - ! CS%diag_TKE_unbalanced_forcing(i,j) = CS%diag_TKE_unbalanced_forcing(i,j) + & - ! min(0.0, TKE_forced(i,j,1) + mech_TKE(i)) * IdtdR0 - else - CS%diag_TKE_forcing(i,j) = CS%diag_TKE_forcing(i,j) + CS%nstar*TKE_forced(i,j,1) * IdtdR0 - endif - endif - + !call find_mstar(CS,US, b_flux, u_star, u_star_mean,& + ! mld_guess, absf(i), mstar_total) + mstar_total = CS%fixed_mstar + if (CS%Use_LT) then + call get_Langmuir_Number( LA, G, GV, US, abs(MLD_guess), u_star_mean, i, j, & + H=H(i,:), U_H=U(i,:), V_H=V(i,:), WAVES=WAVES) + call mstar_Langmuir(CS,US,absf(i),b_flux,u_star,mld_guess,LA,mstar_total, & + enhance_mstar, mstar_lt,LAmod) + endif + !This bit of code preserves answers but should be eliminated. + if (CS%mstar_mode==0) then + mech_TKE(i) = (dt*MSTAR_total*GV%Rho0) * US%Z_to_m**3 * U_star**3 + else + mech_TKE(i) = MSTAR_total * US%Z_to_m**3 * (dt*GV%Rho0*U_star**3) + endif + conv_PErel(i) = 0.0 + if (CS%TKE_diagnostics) then + CS%diag_TKE_wind(i,j) = CS%diag_TKE_wind(i,j) + mech_TKE(i) * IdtdR0 if (TKE_forced(i,j,1) <= 0.0) then - mech_TKE(i) = mech_TKE(i) + TKE_forced(i,j,1) - if (mech_TKE(i) < 0.0) mech_TKE(i) = 0.0 + CS%diag_TKE_forcing(i,j) = CS%diag_TKE_forcing(i,j) + & + max(-mech_TKE(i), TKE_forced(i,j,1)) * IdtdR0 + ! CS%diag_TKE_unbalanced_forcing(i,j) = CS%diag_TKE_unbalanced_forcing(i,j) + & + ! min(0.0, TKE_forced(i,j,1) + mech_TKE(i)) * IdtdR0 else - conv_PErel(i) = conv_PErel(i) + TKE_forced(i,j,1) + CS%diag_TKE_forcing(i,j) = CS%diag_TKE_forcing(i,j) + CS%nstar*TKE_forced(i,j,1) * IdtdR0 endif + endif + + if (TKE_forced(i,j,1) <= 0.0) then + mech_TKE(i) = mech_TKE(i) + TKE_forced(i,j,1) + if (mech_TKE(i) < 0.0) mech_TKE(i) = 0.0 else - mech_TKE(i) = mech_TKE_top(i)*ENHANCE_M ; conv_PErel(i) = conv_PErel_top(i) + conv_PErel(i) = conv_PErel(i) + TKE_forced(i,j,1) endif if (CS%TKE_diagnostics) then @@ -895,12 +765,10 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS dTKE_MKE = 0.0 ; dTKE_mech_decay = 0.0 ; dTKE_conv_decay = 0.0 endif - ! Store in 1D arrays cleared out each iteration. Only write in - ! 3D arrays after convergence. + ! Store in 1D arrays for output. do k=1,nz Vstar_Used(k) = 0.0 ; Mixing_Length_Used(k) = 0.0 enddo - if (.not.CS%Use_MLD_Iteration) OBL_CONVERGED = .true. if ((.not.CS%Use_MLD_Iteration) .or. & (CS%transLay_scale >= 1.0) .or. (CS%transLay_scale < 0.0) ) then @@ -1108,9 +976,9 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS h_tt = htot(i) + h_tt_min TKE_here = mech_TKE(i) + CS%wstar_ustar_coef*conv_PErel(i) if (TKE_here > 0.0) then - if (CS%vstar_mode==0) then + if (CS%wT_mode==0) then vstar = CS%vstar_scale_fac * (I_dtrho*TKE_here)**C1_3 - elseif (CS%vstar_mode==1) then + elseif (CS%wT_mode==1) then Surface_Scale = max(0.05,1.-htot(i)/MLD_guess) vstar = CS%vstar_scale_fac * (CS%vstar_surf_fac*U_Star + & (CS%wstar_ustar_coef*conv_PErel(i)*I_dtrho)**C1_3)* & @@ -1122,10 +990,10 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS !Note setting Kd_guess0 to Mixing_Length_Used(K) here will ! change the answers. Therefore, skipping that. if (.not.CS%Use_MLD_Iteration) then - Kd_guess0 = vstar * vonKar * ((h_tt*hbs_here)*vstar) / & + Kd_guess0 = vstar * CS%vonKar * ((h_tt*hbs_here)*vstar) / & ((CS%Ekman_scale_coef * absf(i)) * (h_tt*hbs_here) + vstar) else - Kd_guess0 = vstar * vonKar * Mixing_Length_Used(k) + Kd_guess0 = vstar * CS%vonKar * Mixing_Length_Used(k) endif ! Compute the local enhnacement of K (perhaps due to Langmuir) if (CS%LT_ENH_K_R16) then @@ -1173,9 +1041,9 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS ! Does MKE_src need to be included in the calculation of vstar here? TKE_here = mech_TKE(i) + CS%wstar_ustar_coef*(conv_PErel(i)-PE_chg_max) if (TKE_here > 0.0) then - if (CS%vstar_mode==0) then + if (CS%wT_mode==0) then vstar = CS%vstar_scale_fac * (I_dtrho*TKE_here)**C1_3 - elseif (CS%vstar_mode==1) then + elseif (CS%wT_mode==1) then Surface_Scale = max(0.05,1.-htot(i)/MLD_guess) vstar = cs%vstar_scale_fac * (CS%vstar_surf_fac*U_Star + & (CS%wstar_ustar_coef*conv_PErel(i)*I_dtrho)**C1_3)* & @@ -1187,10 +1055,10 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS if (.not.CS%Use_MLD_Iteration) then ! Note again (as prev) that using Mixing_Length_Used here ! instead of redoing the computation will change answers... - Kd(i,k) = vstar * vonKar * ((h_tt*hbs_here)*vstar) / & + Kd(i,k) = vstar * CS%vonKar * ((h_tt*hbs_here)*vstar) / & ((CS%Ekman_scale_coef * absf(i)) * (h_tt*hbs_here) + vstar) else - Kd(i,k) = vstar * vonKar * Mixing_Length_Used(k) + Kd(i,k) = vstar * CS%vonKar * Mixing_Length_Used(k) endif ! Compute the local enhnacement of K (perhaps due to Langmuir) if (CS%LT_ENH_K_R16) then @@ -1535,9 +1403,11 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS CS%Velocity_Scale(i,j,k) = Vstar_Used(k) enddo endif - if (allocated(CS%Enhance_M)) CS%Enhance_M(i,j) = Enhance_M - if (allocated(CS%mstar_mix)) CS%mstar_mix(i,j) = MSTAR_MIX + if (allocated(CS%Enhance_M)) CS%Enhance_M(i,j) = Enhance_mstar + if (allocated(CS%mstar_mix)) CS%mstar_mix(i,j) = mstar_total if (allocated(CS%mstar_lt)) CS%mstar_lt(i,j) = MSTAR_LT + iL_Ekman = absf(i) / u_star + iL_Obukhov = b_flux*CS%vonkar / (u_star**3) if (allocated(CS%MLD_Obukhov)) CS%MLD_Obukhov(i,j) = MLD_guess * iL_Obukhov if (allocated(CS%MLD_Ekman)) CS%MLD_Ekman(i,j) = MLD_guess * iL_Ekman if (allocated(CS%Ekman_Obukhov)) CS%Ekman_Obukhov(i,j) = iL_Obukhov / (iL_Ekman + 1.e-10*US%Z_to_m) @@ -1916,6 +1786,183 @@ subroutine find_PE_chg_orig(Kddt_h, h_k, b_den_1, dTe_term, dSe_term, & end subroutine find_PE_chg_orig +!> Finds mstar for ePBL +subroutine Find_Mstar(CS,US, bflux, ustar, ustar_mean,& + bld, absf, mstar_total) + type(energetic_PBL_CS), pointer :: CS !< Energetic_PBL control structure. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + real, intent(in) :: ustar !< ustar w/ gustiness + real, intent(in) :: ustar_mean !< ustar w/o gustiness + real, intent(in) :: absf !< abolute value of Coriolis parameter + real, intent(in) :: bflux !< Buoyancy flux + real, intent(in) :: bld !< boundary layer depth + real, intent(out) :: mstar_total !< Ouput mstar (Mixing/ustar**3) + + real :: Bf_stable ! Buoyancy flux, capped at 0 (negative only) + real :: Bf_unstable ! Buoyancy flux, floored at 0 (positive only) + real :: mstar_Conv_red ! Adjustment made to mstar due to convection reducing mechanical mixing. + real :: mstar_S, mstar_N ! Mstar in each limit, max is used. + + !/ Options for mstar_from_MLD + real :: Stab_Scale ! Composite of stabilizing Ekman scale and Monin-Obukhov length scales [Z ~> m]. + real :: MLD_over_STAB ! Mixing layer depth divided by Stab_Scale + real :: C_MO = 1. ! Constant in Stab_Scale for Monin-Obukhov + real :: C_EK = 2. ! Constant in Stab_Scale for Ekman length + + + !/ Integer options for how to find mstar + integer, parameter :: & + use_fixed_mstar = 0 !< The value of MSTAR_MODE to use a constant mstar + integer, parameter :: & + mstar_from_MLD = 1 !< The value of MSTAR_MODE to base mstar on the ratio of the mixed + !! layer depth to the Obukhov depth + integer, parameter :: & + mstar_from_Ekman = 2 !< The value of MSTAR_MODE to base mstar on the ratio of the Ekman + !! layer depth to the Obukhov depth + integer, parameter :: & + mstar_from_RH18 = 3 !< The value of MSTAR_MODE to base mstar of of RH18 + + if ( CS%mstar_mode == use_fixed_mstar) then + mstar_total = CS%fixed_mstar + return + endif + + ! Computing Bf w/ limiters. + Bf_Stable = max(0.0, bflux) ! Positive for stable + Bf_Unstable = min(0.0, bflux) ! Negative for unstable + + !/ 1. Get mstar + if (CS%mstar_mode == mstar_from_MLD) then + if (bflux.lt.0.) then + ! Computing stability scale which correlates with TKE for mixing, where + ! TKE for mixing = TKE production minus TKE dissipation + Stab_Scale = ustar**2 / ( CS%VonKar * ( C_MO * BF_Stable / ustar - C_EK * Ustar * absf)) + endif + MLD_over_Stab = BLD / Stab_Scale - CS%MSTAR_XINT + !### MLD_over_Stab = (MLD_guess * (VonKar * (C_MO*BF_Stable - C_EK*U_star**2*absf(i)))) / & + !### U_star**3 - CS%MSTAR_XINT + if ((MLD_over_Stab) <= 0.0) then + !Asymptote to 0 as MLD_over_Stab -> -infinity (always) + mstar_total = (CS%MSTAR_B*(MLD_over_Stab)+CS%MSTAR_A)**(CS%mstar_exp) + else + if (CS%MSTAR_CAP>=0.) then + if (CS%MSTAR_FLATCAP .OR. (MLD_over_Stab <= CS%MSTAR_XINT_UP)) then + !If using flat cap (or if using asymptotic cap + ! but within linear regime we can make use of same code) + mstar_total = min(CS%MSTAR_CAP, & + CS%MSTAR_SLOPE*(MLD_over_Stab)+CS%MSTAR_AT_XINT) + else + !Asymptote to MSTAR_CAP as MLD_over_Stab -> infinity + mstar_total = CS%MSTAR_CAP - & + (CS%MSTAR_B2*(MLD_over_Stab-CS%MSTAR_XINT_UP)& + +CS%MSTAR_A2)**(CS%mstar_exp) + endif + else + !No cap if negative cap value given. + mstar_total = CS%MSTAR_SLOPE*(MLD_over_Stab)+CS%MSTAR_AT_XINT + endif + endif + elseif (CS%MSTAR_MODE == mstar_from_Ekman) then + !### Please refrain from using the construct A / B / C in place of A/(B*C). + ! The limit for the balance of rotation and stabilizing is f(L_Ekman,L_Obukhov) + mstar_S = CS%MSTAR_COEF*sqrt(Bf_Stable / ustar**2 / (absf+1.e-10)) + !### Should be mstar_STAB = CS%MSTAR_COEF*sqrt(Bf_Stable / (U_star**2 * (absf(i)+1.e-10))) + ! The limit for rotation (Ekman length) limited mixin + mstar_N = CS%C_EK * log(max(1., ustar / (absf+1.e-10) / BLD)) + !### Consider rewriting the expression for mstar_ROT as: + ! mstar_Rot = 0.0 + ! if (Ustar > absf(i) * MLD_guess) & + ! mstar_ROT = CS%C_EK * log(U_star / (absf(i) * MLD_guess)) + ! Here 1.25 is .5/von Karman, which gives the Obukhov limit. + mstar_total = max(mstar_S, min(1.25, mstar_N)) + if (CS%MSTAR_CAP > 0.0) mstar_total = min(CS%MSTAR_CAP, mstar_total) + elseif (CS%MSTAR_MODE.eq.mstar_from_RH18) then + mstar_N = CS%RH18_mstar_cn1 * ( 1.0 - ( 1.+CS%RH18_mstar_cn2 * & + exp( CS%RH18_mstar_CN3 * BLD * absf / ustar) )**-1.0 ) + mstar_S = CS%RH18_mstar_CS1 * (bf_stable**2*BLD & + / ( ustar**5 * absf ) ) **CS%RH18_mstar_cs2 + mstar_total = mstar_N + mstar_S + endif!mstar_mode + + !/ 2. Adjust mstar to account for convective turbulence + mstar_conv_red = 1. - CS%mstar_convect_coef * (-BF_Unstable + 1.e-10*US%m_to_Z**2) / & + ( (-Bf_Unstable + 1.e-10*US%m_to_Z**2) + & + 2.0 *mstar_total * ustar**3 / BLD ) + ! MSTAR_Conv_Adj = 1. - CS%mstar_convect_coef * ((-BF_Unstable + 1.e-10*US%m_to_Z**2)*MLD_guess) / & + ! ( (-Bf_Unstable + 1.e-10*US%m_to_Z**2)*MLD_guess + & + ! 2.0*MSTAR_MIX * U_star**3 ) + + !/3. Combine various mstar terms to get final value + mstar_total = mstar_total*mstar_conv_red + + return +end subroutine Find_Mstar + +subroutine Mstar_Langmuir(CS,US,absf,bflux,ustar,bld,La,mstar,enhance_mstar,mstar_lt, LAmod) + type(energetic_PBL_CS), pointer :: CS !< Energetic_PBL control structure. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + real, intent(in) :: absf + real, intent(in) :: bflux + real, intent(in) :: ustar + real, intent(in) :: bld + real, intent(in) :: La + real, intent(inout) :: mstar + real, intent(out) :: enhance_mstar, mstar_lt, LAmod + + !/ + real :: iL_Ekman ! Inverse of Ekman length scale [Z-1 ~> m-1]. + real :: iL_Obukhov ! Inverse of Obukhov length scale [Z-1 ~> m-1]. + real :: MLD_o_Ekman ! > + real :: MLD_o_Obukhov_stab ! Ratios of length scales where MLD is boundary layer depth + real :: Ekman_o_Obukhov_stab ! > + real :: MLD_o_Obukhov_un ! Ratios of length scales where MLD is boundary layer depth + real :: Ekman_o_Obukhov_un ! > + + !if (CS%OldAnswers) then + iL_Ekman = absf / ustar + iL_Obukhov = bflux*CS%vonkar / (ustar**3) + Ekman_o_Obukhov_stab = abs(max(0., iL_Obukhov / (iL_Ekman + 1.e-10*US%Z_to_m))) + Ekman_o_Obukhov_un = abs(min(0., iL_Obukhov / (iL_Ekman + 1.e-10*US%Z_to_m))) + !else + ! Max_ratio = 1.0e16 + ! Ekman_Obukhov = Max_ratio + ! if (abs(bflux*vonkar) < Max_ratio*(absf * ustar**2)) then + ! Ekman_Obukhov = buoy_flux(i,j)*vonkar / (absf(i) * U_star**2) + ! endif + ! if (bflux > 0.0) then + ! Ekman_o_Obukhov_stab = Ekman_Obukhov ; Ekman_o_Obukhov_un = 0.0 + ! else + ! Ekman_o_Obukhov_un = Ekman_Obukhov ; Ekman_o_Obukhov_stab = 0.0 + ! endif + !endif + + ! a. Get parameters for modified LA + MLD_o_Ekman = abs( BLD*iL_Ekman ) + MLD_o_Obukhov_stab = abs(max(0., BLD*iL_Obukhov)) + MLD_o_Obukhov_un = abs(min(0., BLD*iL_Obukhov)) + ! b. Adjust LA based on various parameters. + ! Assumes linear factors based on length scale ratios to adjust LA + ! Note when these coefficients are set to 0 recovers simple LA. + LAmod = LA * (1.0 + max(-0.5,CS%LaC_MLDoEK * MLD_o_Ekman) + & + CS%LaC_EKoOB_stab * Ekman_o_Obukhov_stab + & + CS%LaC_EKoOB_un * Ekman_o_Obukhov_un + & + CS%LaC_MLDoOB_stab * MLD_o_Obukhov_stab + & + CS%LaC_MLDoOB_un * MLD_o_Obukhov_un ) + if (CS%LT_Enhance_Form==2) then + ! Enhancement is multiplied (added mst_lt set to 0) + Enhance_mstar = min(CS%Max_Enhance_M, (1. + CS%LT_ENHANCE_COEF*LAmod**CS%LT_ENHANCE_EXP)) + MSTAR_LT = 0.0 + elseif (CS%LT_ENHANCE_Form == 3) then + ! or Enhancement is additive (multiplied enhance_m set to 1) + mstar_LT = CS%LT_ENHANCE_COEF * LAmod**CS%LT_ENHANCE_EXP + enhance_mstar = 1.0 + endif + + mstar = mstar*enhance_mstar + mstar_LT + return +end subroutine Mstar_Langmuir + + !> Copies the ePBL active mixed layer depth into MLD subroutine energetic_PBL_get_MLD(CS, MLD, G, US, m_to_MLD_units) type(energetic_PBL_CS), pointer :: CS !< Control structure for ePBL @@ -2071,7 +2118,7 @@ subroutine get_LA_windsea(ustar, hbl, GV, US, LA) else LA=1.e8 endif -endsubroutine Get_LA_windsea +end subroutine Get_LA_windsea !> This subroutine initializes the energetic_PBL module subroutine energetic_PBL_init(Time, G, GV, US, param_file, diag, CS) @@ -2106,74 +2153,74 @@ subroutine energetic_PBL_init(Time, G, GV, US, param_file, diag, CS) call log_version(param_file, mdl, version, "") call get_param(param_file, mdl, "MSTAR_MODE", CS%mstar_mode, & - "An integer switch for how to compute MSTAR. \n"//& + "An integer switch for how to compute MSTAR.\n"//& " 0 for constant MSTAR\n"//& " 1 for MSTAR w/ MLD in stabilizing limit\n"//& " 2 for MSTAR w/ L_E/L_O in stabilizing limit\n"//& " 3 for MSTAR as in RH18.",& "units=nondim",default=0) - call get_param(param_file, mdl, "MSTAR", CS%mstar, & - "The ratio of the friction velocity cubed to the TKE \n"//& + call get_param(param_file, mdl, "MSTAR", CS%fixed_mstar, & + "The ratio of the friction velocity cubed to the TKE "//& "input to the mixed layer.", "units=nondim", default=1.2) call get_param(param_file, mdl, "MIX_LEN_EXPONENT", CS%MixLenExponent, & - "The exponent applied to the ratio of the distance to the MLD \n"//& + "The exponent applied to the ratio of the distance to the MLD "//& "and the MLD depth which determines the shape of the mixing length.",& "units=nondim", default=2.0) call get_param(param_file, mdl, "MSTAR_CAP", CS%mstar_cap, & - "Maximum value of mstar allowed in model if non-negative\n"//& + "Maximum value of mstar allowed in model if non-negative "//& "(used if MSTAR_MODE>0).",& "units=nondim", default=-1.0) - call get_param(param_file, mdl, "MSTAR_CONV_ADJ", CS%cnv_mst_fac, & - "Factor used for reducing mstar during convection \n"//& + call get_param(param_file, mdl, "MSTAR_CONV_ADJ", CS%mstar_convect_coef, & + "Factor used for reducing mstar during convection"//& " due to reduction of stable density gradient.",& "units=nondim", default=0.0) call get_param(param_file, mdl, "MSTAR_SLOPE", CS%mstar_slope, & - "The slope of the linear relationship between mstar \n"//& + "The slope of the linear relationship between mstar "//& "and the length scale ratio (used if MSTAR_MODE=1).",& "units=nondim", default=0.85) call get_param(param_file, mdl, "MSTAR_XINT", CS%mstar_xint, & - "The value of the length scale ratio where the mstar \n"//& + "The value of the length scale ratio where the mstar "//& "is linear above (used if MSTAR_MODE=1).",& "units=nondim", default=-0.3) call get_param(param_file, mdl, "MSTAR_AT_XINT", CS%mstar_at_xint, & - "The value of mstar at MSTAR_XINT \n"//& + "The value of mstar at MSTAR_XINT "//& "(used if MSTAR_MODE=1).",& "units=nondim", default=0.095) call get_param(param_file, mdl, "MSTAR_FLATCAP", CS%MSTAR_FLATCAP, & - "Set false to use asymptotic cap, defaults to true.\n"//& - "(used only if MSTAR_MODE=1)"& + "Set false to use asymptotic cap, defaults to true "//& + "(used only if MSTAR_MODE=1)."& ,"units=nondim",default=.true.) call get_param(param_file, mdl, "MSTAR2_COEF1", CS%MSTAR_COEF, & - "Coefficient in computing mstar when rotation and \n"//& - " stabilizing effects are both important (used if MSTAR_MODE=2)"& + "Coefficient in computing mstar when rotation and "//& + " stabilizing effects are both important (used if MSTAR_MODE=2)."& ,"units=nondim",default=0.3) call get_param(param_file, mdl, "MSTAR2_COEF2", CS%C_EK, & - "Coefficient in computing mstar when only rotation limits \n"//& + "Coefficient in computing mstar when only rotation limits "//& " the total mixing. (used only if MSTAR_MODE=2)"& ,"units=nondim",default=0.085) - call get_param(param_file, mdl, "RH18_MST_CN1", CS%RH18_MST_CN1,& - "MSTAR_N coefficient 1 (outter-most coefficient for fit). \n"//& - " The value of 0.275 is given in RH18. Increasing this \n"//& - "coefficient increases MSTAR for all values of Hf/ust, but more \n"//& + call get_param(param_file, mdl, "RH18_MSTAR_CN1", CS%RH18_mstar_cn1,& + "MSTAR_N coefficient 1 (outter-most coefficient for fit). "//& + " The value of 0.275 is given in RH18. Increasing this "//& + "coefficient increases MSTAR for all values of Hf/ust, but more "//& "effectively at low values (weakly developed OSBLs).",& units="nondim", default=0.275) - call get_param(param_file, mdl, "RH18_MST_CN2", CS%RH18_MST_CN2,& - "MSTAR_N coefficient 2 (coefficient outside of exponential decay). \n"//& - "The value of 8.0 is given in RH18. Increasing this coefficient \n"//& - "increases MSTAR for all values of HF/ust, with a much more even \n"//& + call get_param(param_file, mdl, "RH18_MSTAR_CN2", CS%RH18_mstar_cn2,& + "MSTAR_N coefficient 2 (coefficient outside of exponential decay). "//& + "The value of 8.0 is given in RH18. Increasing this coefficient "//& + "increases MSTAR for all values of HF/ust, with a much more even "//& "effect across a wide range of Hf/ust than CN1.",& units="nondim",default=8.0) - call get_param(param_file, mdl, "RH18_MST_CN3", CS%RH18_MST_CN3,& - "MSTAR_N coefficient 3 (exponential decay coefficient). \n"//& - "The value of -5.0 is given in RH18. Increasing this increases how \n"//& + call get_param(param_file, mdl, "RH18_MSTAR_CN3", CS%RH18_mstar_CN3,& + "MSTAR_N coefficient 3 (exponential decay coefficient). "//& + "The value of -5.0 is given in RH18. Increasing this increases how "//& "quickly the value of MSTAR decreases as Hf/ust increases.",& units="nondim",default=-5.0) - call get_param(param_file, mdl, "RH18_MST_CS1", CS%RH18_MST_CS1,& - "MSTAR_S coefficient for RH18 in stabilizing limit. \n"//& - "The value of 0.2 is given in RH18 and increasing it increases \n"//& + call get_param(param_file, mdl, "RH18_MSTAR_CS1", CS%RH18_mstar_cs1,& + "MSTAR_S coefficient for RH18 in stabilizing limit. "//& + "The value of 0.2 is given in RH18 and increasing it increases"//& "MSTAR in the presence of a stabilizing surface buoyancy flux.",& units="nondim",default=0.2) - call get_param(param_file, mdl, "RH18_MST_CS2", CS%RH18_MST_CS2,& + call get_param(param_file, mdl, "RH18_MSTAR_CS2", CS%RH18_mstar_cs2,& "MSTAR_S exponent for RH18 in stabilizing limit. \n"//& "The value of 0.4 is given in RH18 and increasing it increases MSTAR \n"//& "exponentially in the presence of a stabilizing surface buoyancy flux.",& @@ -2213,10 +2260,10 @@ subroutine energetic_PBL_init(Time, G, GV, US, param_file, diag, CS) "fraction of the absolute rotation rate blended with the \n"//& "local value of f, as sqrt((1-of)*f^2 + of*4*omega^2).", & units="nondim", default=omega_frac_dflt) - call get_param(param_file, mdl, "VSTAR_MODE", CS%vstar_mode, & + call get_param(param_file, mdl, "WT_MODE", CS%wT_mode, & "An integer switch for how to compute VSTAR. \n"//& - " 0 for old vstar (TKE Remaining)^(1/3)\n"//& - " 1 for vstar from u* and w* (see Reichl & Hallberg 2018).",& + " 0 for old wT (TKE Remaining)^(1/3)\n"//& + " 1 for wT from u* and w* (see Reichl & Hallberg 2018).",& "units=nondim",default=0) call get_param(param_file, mdl, "WSTAR_USTAR_COEF", CS%wstar_ustar_coef, & "A ratio relating the efficiency with which convectively \n"//& @@ -2302,7 +2349,7 @@ subroutine energetic_PBL_init(Time, G, GV, US, param_file, diag, CS) "Integer for Langmuir number mode. \n"// & " *Requires USE_LA_LI2016 to be set to True. \n"// & "Options: 0 - No Langmuir \n"// & - " 1 - Van Roekel et al. 2014/Li et al., 2016 \n"// & + " 1 - (removed) \n"// & " 2 - Multiplied w/ adjusted La. \n"// & " 3 - Added w/ adjusted La.", & units="nondim", default=0) @@ -2423,12 +2470,12 @@ subroutine energetic_PBL_init(Time, G, GV, US, param_file, diag, CS) endif !Fitting coefficients to asymptote twoard 0 as MLD -> Ekman depth - CS%MSTAR_A = CS%MSTAR_AT_XINT**(1./CS%MSTAR_N) - CS%MSTAR_B = CS%MSTAR_SLOPE / (CS%MSTAR_N*CS%MSTAR_A**(CS%MSTAR_N-1.)) + CS%MSTAR_A = CS%MSTAR_AT_XINT**(1./CS%mstar_exp) + CS%MSTAR_B = CS%MSTAR_SLOPE / (CS%MSTAR_EXP*CS%MSTAR_A**(CS%mstar_exp-1.)) !Fitting coefficients to asymptote toward MSTAR_CAP !*Fixed to begin asymptote at MSTAR_CAP-0.5 toward MSTAR_CAP - CS%MSTAR_A2 = 0.5**(1./CS%MSTAR_N) - CS%MSTAR_B2 = -CS%MSTAR_SLOPE / (CS%MSTAR_N*CS%MSTAR_A2**(CS%MSTAR_N-1)) + CS%MSTAR_A2 = 0.5**(1./CS%mstar_exp) + CS%MSTAR_B2 = -CS%MSTAR_SLOPE / (CS%mstar_exp*CS%MSTAR_A2**(CS%mstar_exp-1)) !Compute value of X (referenced to MSTAR_XINT) where transition ! to asymptotic regime based on value of X where MSTAR=MSTAR_CAP-0.5 CS%MSTAR_XINT_UP = (CS%MSTAR_CAP-0.5-CS%MSTAR_AT_XINT)/CS%MSTAR_SLOPE From 8d896f2eac69932f1cef0c77997c073e416bf99c Mon Sep 17 00:00:00 2001 From: Brandon Reichl Date: Fri, 24 May 2019 15:07:02 -0400 Subject: [PATCH 02/82] Rearrangement of ePBL, prior to pulling out ePBL_inner loop --- .../vertical/MOM_energetic_PBL.F90 | 594 ++++++++++-------- 1 file changed, 333 insertions(+), 261 deletions(-) diff --git a/src/parameterizations/vertical/MOM_energetic_PBL.F90 b/src/parameterizations/vertical/MOM_energetic_PBL.F90 index b707c88eea..5d6eaf3412 100644 --- a/src/parameterizations/vertical/MOM_energetic_PBL.F90 +++ b/src/parameterizations/vertical/MOM_energetic_PBL.F90 @@ -32,8 +32,10 @@ module MOM_energetic_PBL !> This control structure holds parameters for the MOM_energetic_PBL module type, public :: energetic_PBL_CS ; private + !/ Constants - real :: VonKar = 0.41 !< The von Karman coefficient + real :: VonKar = 0.41 !< The von Karman coefficient. This should be runtime, but because + !! it is runtime in KPP and set to 0.4 it might change answers. real :: omega !< The Earth's rotation rate [s-1]. real :: omega_frac !< When setting the decay scale for turbulence, use this fraction of !! the absolute rotation rate blended with the local value of f, as @@ -112,21 +114,23 @@ module MOM_energetic_PBL !! dissipation of TKE produced by shear. This value is used if the option !! for using a fixed mstar is used. + !delete0 at fully developed Ekman depth. - real :: mstar_xint_up !< Similar but for transition to asymptotic cap. - real :: mstar_at_xint !< Intercept value of MSTAR at value where function - !! changes to linear transition. - real :: mstar_exp = -2. !< Exponent in decay at negative and positive limits of MLD_over_STAB - real :: mstar_a !< Coefficients of expressions for mstar in asymptotic limits, computed - !! to match the function value and slope at both ends of the linear fit - !! within the well constrained region. - real :: mstar_a2 !< Coefficients of expressions for mstar in asymptotic limits. - real :: mstar_b !< Coefficients of expressions for mstar in asymptotic limits. - real :: mstar_b2 !< Coefficients of expressions for mstar in asymptotic limits. + !real :: mstar_slope !< Slope of the function which relates the shear production to the + ! !< mixing layer depth, Ekman depth, and Monin-Obukhov depth. + !real :: mstar_xint !< Value where MSTAR function transitions from linear + ! !! to decay toward MSTAR->0 at fully developed Ekman depth. + !real :: mstar_xint_up !< Similar but for transition to asymptotic cap. + !real :: mstar_at_xint !< Intercept value of MSTAR at value where function + ! !! changes to linear transition. + !real :: mstar_exp = -2. !< Exponent in decay at negative and positive limits of MLD_over_STAB + !real :: mstar_a !< Coefficients of expressions for mstar in asymptotic limits, computed + ! !! to match the function value and slope at both ends of the linear fit + ! !! within the well constrained region. + !real :: mstar_a2 !< Coefficients of expressions for mstar in asymptotic limits. + !real :: mstar_b !< Coefficients of expressions for mstar in asymptotic limits. + !real :: mstar_b2 !< Coefficients of expressions for mstar in asymptotic limits. + !delete Finds mstar for ePBL -subroutine Find_Mstar(CS,US, bflux, ustar, ustar_mean,& - bld, absf, mstar_total) - type(energetic_PBL_CS), pointer :: CS !< Energetic_PBL control structure. - type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - real, intent(in) :: ustar !< ustar w/ gustiness - real, intent(in) :: ustar_mean !< ustar w/o gustiness - real, intent(in) :: absf !< abolute value of Coriolis parameter - real, intent(in) :: bflux !< Buoyancy flux - real, intent(in) :: bld !< boundary layer depth - real, intent(out) :: mstar_total !< Ouput mstar (Mixing/ustar**3) - - real :: Bf_stable ! Buoyancy flux, capped at 0 (negative only) - real :: Bf_unstable ! Buoyancy flux, floored at 0 (positive only) - real :: mstar_Conv_red ! Adjustment made to mstar due to convection reducing mechanical mixing. - real :: mstar_S, mstar_N ! Mstar in each limit, max is used. - - !/ Options for mstar_from_MLD - real :: Stab_Scale ! Composite of stabilizing Ekman scale and Monin-Obukhov length scales [Z ~> m]. - real :: MLD_over_STAB ! Mixing layer depth divided by Stab_Scale - real :: C_MO = 1. ! Constant in Stab_Scale for Monin-Obukhov - real :: C_EK = 2. ! Constant in Stab_Scale for Ekman length - +subroutine Find_Mstar(CS,US, Buoyancy_Flux, UStar, UStar_Mean,& + BLD, Abs_Coriolis, MStar, Langmuir_Number,& + MStar_LT, Enhance_MStar, Convect_Langmuir_Number) + type(energetic_PBL_CS), pointer ::& + CS !< Energetic_PBL control structure. + type(unit_scale_type), intent(in) ::& + US !< A dimensional unit scaling type + real, intent(in) :: & + UStar !< ustar w/ gustiness + real, intent(in) ::& + UStar_Mean !< ustar w/o gustiness + real, intent(in) ::& + Abs_Coriolis !< abolute value of Coriolis parameter + real, intent(in) ::& + Buoyancy_Flux !< Buoyancy flux + real, intent(in) ::& + BLD !< boundary layer depth + real, intent(out) ::& + Mstar !< Ouput mstar (Mixing/ustar**3) + real, optional, intent(in) ::& + Langmuir_Number !Langmuir number + real, optional, intent(out) ::& + MStar_LT !< Additive mstar increase due to Langmuir turbulence + real, optional, intent(out) ::& + Enhance_MStar !< Multiplicative mstar increase due to Langmuir turbulence + real, optional, intent(out) ::& + Convect_Langmuir_number !< Langmuir number including buoyancy flux + + !/ Variables used in computing mstar + real :: MStar_Conv_Red ! Adjustment made to mstar due to convection reducing mechanical mixing. + real :: MStar_S, MStar_N ! Mstar in (S)tabilizing/(N)ot-stabilizing buoyancy flux !/ Integer options for how to find mstar - integer, parameter :: & - use_fixed_mstar = 0 !< The value of MSTAR_MODE to use a constant mstar - integer, parameter :: & - mstar_from_MLD = 1 !< The value of MSTAR_MODE to base mstar on the ratio of the mixed - !! layer depth to the Obukhov depth - integer, parameter :: & - mstar_from_Ekman = 2 !< The value of MSTAR_MODE to base mstar on the ratio of the Ekman - !! layer depth to the Obukhov depth - integer, parameter :: & - mstar_from_RH18 = 3 !< The value of MSTAR_MODE to base mstar of of RH18 - - if ( CS%mstar_mode == use_fixed_mstar) then - mstar_total = CS%fixed_mstar - return - endif + integer, parameter :: Use_Fixed_MStar = 0 !< The value of MSTAR_MODE to use a constant mstar + !delete integer, parameter :: MStar_from_BLD = 1 !< The value of MSTAR_MODE to base mstar on the ratio + !delete !! of the mixed layer depth to the Obukhov depth + integer, parameter :: MStar_from_Ekman = 2 !< The value of MSTAR_MODE to base mstar on the ratio + !! of the Ekman layer depth to the Obukhov depth + integer, parameter :: MStar_from_RH18 = 3 !< The value of MSTAR_MODE to base mstar of of RH18 + + !delete m]. + !real :: MLD_over_STAB ! Mixing layer depth divided by Stab_Scale + !real :: C_MO = 1. ! Constant in Stab_Scale for Monin-Obukhov + !real :: C_EK = 2. ! Constant in Stab_Scale for Ekman length + !delete -infinity (always) - mstar_total = (CS%MSTAR_B*(MLD_over_Stab)+CS%MSTAR_A)**(CS%mstar_exp) - else - if (CS%MSTAR_CAP>=0.) then - if (CS%MSTAR_FLATCAP .OR. (MLD_over_Stab <= CS%MSTAR_XINT_UP)) then - !If using flat cap (or if using asymptotic cap - ! but within linear regime we can make use of same code) - mstar_total = min(CS%MSTAR_CAP, & - CS%MSTAR_SLOPE*(MLD_over_Stab)+CS%MSTAR_AT_XINT) - else - !Asymptote to MSTAR_CAP as MLD_over_Stab -> infinity - mstar_total = CS%MSTAR_CAP - & - (CS%MSTAR_B2*(MLD_over_Stab-CS%MSTAR_XINT_UP)& - +CS%MSTAR_A2)**(CS%mstar_exp) - endif - else - !No cap if negative cap value given. - mstar_total = CS%MSTAR_SLOPE*(MLD_over_Stab)+CS%MSTAR_AT_XINT - endif - endif - elseif (CS%MSTAR_MODE == mstar_from_Ekman) then + !delete -infinity (always) + ! mstar_total = (CS%MSTAR_B*(MLD_over_Stab)+CS%MSTAR_A)**(CS%mstar_exp) + ! else + ! if (CS%MSTAR_CAP>=0.) then + ! if (CS%MSTAR_FLATCAP .OR. (MLD_over_Stab <= CS%MSTAR_XINT_UP)) then + ! !If using flat cap (or if using asymptotic cap + ! ! but within linear regime we can make use of same code) + ! mstar_total = min(CS%MSTAR_CAP, & + ! CS%MSTAR_SLOPE*(MLD_over_Stab)+CS%MSTAR_AT_XINT) + ! else + ! !Asymptote to MSTAR_CAP as MLD_over_Stab -> infinity + ! mstar_total = CS%MSTAR_CAP - & + ! (CS%MSTAR_B2*(MLD_over_Stab-CS%MSTAR_XINT_UP)& + ! +CS%MSTAR_A2)**(CS%mstar_exp) + ! endif + ! else + ! !No cap if negative cap value given. + ! mstar_total = CS%MSTAR_SLOPE*(MLD_over_Stab)+CS%MSTAR_AT_XINT + ! endif + ! endif + !delete absf(i) * MLD_guess) & ! mstar_ROT = CS%C_EK * log(U_star / (absf(i) * MLD_guess)) ! Here 1.25 is .5/von Karman, which gives the Obukhov limit. - mstar_total = max(mstar_S, min(1.25, mstar_N)) - if (CS%MSTAR_CAP > 0.0) mstar_total = min(CS%MSTAR_CAP, mstar_total) - elseif (CS%MSTAR_MODE.eq.mstar_from_RH18) then - mstar_N = CS%RH18_mstar_cn1 * ( 1.0 - ( 1.+CS%RH18_mstar_cn2 * & - exp( CS%RH18_mstar_CN3 * BLD * absf / ustar) )**-1.0 ) - mstar_S = CS%RH18_mstar_CS1 * (bf_stable**2*BLD & - / ( ustar**5 * absf ) ) **CS%RH18_mstar_cs2 - mstar_total = mstar_N + mstar_S + MStar = max(MStar_S, min(1.25, MStar_N)) + if (CS%MStar_Cap > 0.0) MStar = min( CS%MStar_Cap,MStar ) + elseif ( CS%MStar_Mode.eq.MStar_from_RH18 ) then + MStar_N = CS%RH18_MStar_cn1 * ( 1.0 - ( 1.+CS%RH18_MStar_cn2 * & + exp( CS%RH18_mstar_CN3 * BLD * Abs_Coriolis / UStar) )**-1.0 ) + MStar_S = CS%RH18_MStar_CS1 * ( max(0.0,Buoyancy_Flux)**2 * BLD & + / ( UStar**5 * Abs_Coriolis ) ) **CS%RH18_mstar_cs2 + MStar = MStar_N + MStar_S endif!mstar_mode !/ 2. Adjust mstar to account for convective turbulence - mstar_conv_red = 1. - CS%mstar_convect_coef * (-BF_Unstable + 1.e-10*US%m_to_Z**2) / & - ( (-Bf_Unstable + 1.e-10*US%m_to_Z**2) + & - 2.0 *mstar_total * ustar**3 / BLD ) + MStar_Conv_Red = 1. - CS%MStar_Convect_coef * (-min(0.0,Buoyancy_Flux) + 1.e-10*US%m_to_Z**2) / & + ( (-min(0.0,Buoyancy_Flux) + 1.e-10*US%m_to_Z**2) + & + 2.0 *MStar * ustar**3 / BLD ) ! MSTAR_Conv_Adj = 1. - CS%mstar_convect_coef * ((-BF_Unstable + 1.e-10*US%m_to_Z**2)*MLD_guess) / & ! ( (-Bf_Unstable + 1.e-10*US%m_to_Z**2)*MLD_guess + & ! 2.0*MSTAR_MIX * U_star**3 ) !/3. Combine various mstar terms to get final value - mstar_total = mstar_total*mstar_conv_red + MStar = MStar*MStar_Conv_Red + + if (present(Langmuir_Number)) then + call mstar_Langmuir(CS,US,abs_Coriolis,buoyancy_flux,ustar,BLD,Langmuir_number,mstar, & + Enhance_MStar, mstar_lt,Convect_Langmuir_Number) + endif return end subroutine Find_Mstar -subroutine Mstar_Langmuir(CS,US,absf,bflux,ustar,bld,La,mstar,enhance_mstar,mstar_lt, LAmod) +subroutine Mstar_Langmuir(CS,US,abs_Coriolis,buoyancy_flux,ustar,BLD,Langmuir_Number,& + mstar,enhance_mstar,mstar_lt, Convect_Langmuir_Number) type(energetic_PBL_CS), pointer :: CS !< Energetic_PBL control structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - real, intent(in) :: absf - real, intent(in) :: bflux - real, intent(in) :: ustar - real, intent(in) :: bld - real, intent(in) :: La + real, intent(in) :: Abs_Coriolis + real, intent(in) :: Buoyancy_Flux + real, intent(in) :: UStar + real, intent(in) :: BLD + real, intent(in) :: Langmuir_Number real, intent(inout) :: mstar - real, intent(out) :: enhance_mstar, mstar_lt, LAmod + real, intent(out) :: enhance_mstar, mstar_LT, Convect_Langmuir_Number !/ real :: iL_Ekman ! Inverse of Ekman length scale [Z-1 ~> m-1]. @@ -1919,8 +1944,8 @@ subroutine Mstar_Langmuir(CS,US,absf,bflux,ustar,bld,La,mstar,enhance_mstar,msta real :: Ekman_o_Obukhov_un ! > !if (CS%OldAnswers) then - iL_Ekman = absf / ustar - iL_Obukhov = bflux*CS%vonkar / (ustar**3) + iL_Ekman = Abs_Coriolis / UStar + iL_Obukhov = Buoyancy_Flux*CS%vonkar / (UStar**3) Ekman_o_Obukhov_stab = abs(max(0., iL_Obukhov / (iL_Ekman + 1.e-10*US%Z_to_m))) Ekman_o_Obukhov_un = abs(min(0., iL_Obukhov / (iL_Ekman + 1.e-10*US%Z_to_m))) !else @@ -1943,18 +1968,20 @@ subroutine Mstar_Langmuir(CS,US,absf,bflux,ustar,bld,La,mstar,enhance_mstar,msta ! b. Adjust LA based on various parameters. ! Assumes linear factors based on length scale ratios to adjust LA ! Note when these coefficients are set to 0 recovers simple LA. - LAmod = LA * (1.0 + max(-0.5,CS%LaC_MLDoEK * MLD_o_Ekman) + & - CS%LaC_EKoOB_stab * Ekman_o_Obukhov_stab + & - CS%LaC_EKoOB_un * Ekman_o_Obukhov_un + & - CS%LaC_MLDoOB_stab * MLD_o_Obukhov_stab + & - CS%LaC_MLDoOB_un * MLD_o_Obukhov_un ) + Convect_Langmuir_Number = Langmuir_Number * ( 1.0 + & + max(-0.5,CS%LaC_MLDoEK * MLD_o_Ekman) + & + CS%LaC_EKoOB_stab * Ekman_o_Obukhov_stab + & + CS%LaC_EKoOB_un * Ekman_o_Obukhov_un + & + CS%LaC_MLDoOB_stab * MLD_o_Obukhov_stab + & + CS%LaC_MLDoOB_un * MLD_o_Obukhov_un ) if (CS%LT_Enhance_Form==2) then ! Enhancement is multiplied (added mst_lt set to 0) - Enhance_mstar = min(CS%Max_Enhance_M, (1. + CS%LT_ENHANCE_COEF*LAmod**CS%LT_ENHANCE_EXP)) + Enhance_mstar = min(CS%Max_Enhance_M, & + (1. + CS%LT_ENHANCE_COEF*Convect_Langmuir_Number**CS%LT_ENHANCE_EXP) ) MSTAR_LT = 0.0 elseif (CS%LT_ENHANCE_Form == 3) then ! or Enhancement is additive (multiplied enhance_m set to 1) - mstar_LT = CS%LT_ENHANCE_COEF * LAmod**CS%LT_ENHANCE_EXP + mstar_LT = CS%LT_ENHANCE_COEF * Convect_Langmuir_Number**CS%LT_ENHANCE_EXP enhance_mstar = 1.0 endif @@ -2152,44 +2179,100 @@ subroutine energetic_PBL_init(Time, G, GV, US, param_file, diag, CS) ! Set default, read and log parameters call log_version(param_file, mdl, version, "") + +!/1. General ePBL settings + call get_param(param_file, mdl, "OMEGA",CS%omega, & + "The rotation rate of the earth.", units="s-1", & + default=7.2921e-5) + call get_param(param_file, mdl, "ML_USE_OMEGA", use_omega, & + "If true, use the absolute rotation rate instead of the "//& + "vertical component of rotation when setting the decay "// & + "scale for turbulence.", default=.false., do_not_log=.true.) + omega_frac_dflt = 0.0 + if (use_omega) then + call MOM_error(WARNING, "ML_USE_OMEGA is depricated; use ML_OMEGA_FRAC=1.0 instead.") + omega_frac_dflt = 1.0 + endif + call get_param(param_file, mdl, "ML_OMEGA_FRAC", CS%omega_frac, & + "When setting the decay scale for turbulence, use this "// & + "fraction of the absolute rotation rate blended with the "//& + "local value of f, as sqrt((1-of)*f^2 + of*4*omega^2).", & + units="nondim", default=omega_frac_dflt) + call get_param(param_file, mdl, "EKMAN_SCALE_COEF", CS%Ekman_scale_coef, & + "A nondimensional scaling factor controlling the inhibition "// & + "of the diffusive length scale by rotation. Making this larger "//& + "decreases the PBL diffusivity.", units="nondim", default=1.0) + call get_param(param_file, mdl, "EPBL_ORIGINAL_PE_CALC", CS%orig_PE_calc, & + "If true, the ePBL code uses the original form of the "// & + "potential energy change code. Otherwise, the newer "// & + "version that can work with successive increments to the "// & + "diffusivity in upward or downward passes is used.", default=.true.) + call get_param(param_file, mdl, "N2_DISSIPATION_POS", CS%N2_Dissipation_Scale_Pos, & + "A scale for the dissipation of TKE due to stratification "// & + "in the boundary layer, applied when local stratification "// & + "is positive. The default is 0, but should probably be ~0.4.", & + units="nondim", default=0.0) + call get_param(param_file, mdl, "N2_DISSIPATION_NEG", CS%N2_Dissipation_Scale_Neg,& + "A scale for the dissipation of TKE due to stratification "// & + "in the boundary layer, applied when local stratification "// & + "is negative. The default is 0, but should probably be ~1.", & + units="nondim", default=0.0) + call get_param(param_file, mdl, "MKE_TO_TKE_EFFIC", CS%MKE_to_TKE_effic, & + "The efficiency with which mean kinetic energy released \n"//& + "by mechanically forced entrainment of the mixed layer \n"//& + "is converted to turbulent kinetic energy.", units="nondim", & + default=0.0) + call get_param(param_file, mdl, "TKE_DECAY", CS%TKE_decay, & + "TKE_DECAY relates the vertical rate of decay of the \n"//& + "TKE available for mechanical entrainment to the natural \n"//& + "Ekman depth.", units="nondim", default=2.5) + + + +!/2. Options related to setting MSTAR call get_param(param_file, mdl, "MSTAR_MODE", CS%mstar_mode, & "An integer switch for how to compute MSTAR.\n"//& " 0 for constant MSTAR\n"//& - " 1 for MSTAR w/ MLD in stabilizing limit\n"//& - " 2 for MSTAR w/ L_E/L_O in stabilizing limit\n"//& + !delete " 1 for MSTAR w/ MLD in stabilizing limit\n"//& + " 2 for OM4 MSTAR, which uses L_E/L_O in stabilizing limit\n"//& " 3 for MSTAR as in RH18.",& "units=nondim",default=0) + !delete0).",& + "If this value is non-negative, it sets a maximum value of mstar "//& + "allowed in model (used only if MSTAR_MODE>0).",& "units=nondim", default=-1.0) - call get_param(param_file, mdl, "MSTAR_CONV_ADJ", CS%mstar_convect_coef, & - "Factor used for reducing mstar during convection"//& - " due to reduction of stable density gradient.",& - "units=nondim", default=0.0) - call get_param(param_file, mdl, "MSTAR_SLOPE", CS%mstar_slope, & - "The slope of the linear relationship between mstar "//& - "and the length scale ratio (used if MSTAR_MODE=1).",& - "units=nondim", default=0.85) - call get_param(param_file, mdl, "MSTAR_XINT", CS%mstar_xint, & - "The value of the length scale ratio where the mstar "//& - "is linear above (used if MSTAR_MODE=1).",& - "units=nondim", default=-0.3) - call get_param(param_file, mdl, "MSTAR_AT_XINT", CS%mstar_at_xint, & - "The value of mstar at MSTAR_XINT "//& - "(used if MSTAR_MODE=1).",& - "units=nondim", default=0.095) - call get_param(param_file, mdl, "MSTAR_FLATCAP", CS%MSTAR_FLATCAP, & - "Set false to use asymptotic cap, defaults to true "//& - "(used only if MSTAR_MODE=1)."& - ,"units=nondim",default=.true.) + !delete= 0.5) then + call MOM_error(FATAL, "If flag USE_MLD_ITERATION is true, then "// & + "EPBL_TRANSITION should be greater than 0 and less than 1.") + endif + !delete= 0.5) then - call MOM_error(FATAL, "If flag USE_MLD_ITERATION is true, then "// & - "EPBL_TRANSITION should be greater than 0 and less than 1.") - endif - call get_param(param_file, mdl, "N2_DISSIPATION_POS", CS%N2_Dissipation_Scale_Pos, & - "A scale for the dissipation of TKE due to stratification \n"// & - "in the boundary layer, applied when local stratification \n"// & - "is positive. The default is 0, but should probably be ~0.4.", & - units="nondim", default=0.0) - call get_param(param_file, mdl, "N2_DISSIPATION_NEG", CS%N2_Dissipation_Scale_Neg,& - "A scale for the dissipation of TKE due to stratification \n"// & - "in the boundary layer, applied when local stratification \n"// & - "is negative. The default is 0, but should probably be ~1.", & - units="nondim", default=0.0) + call get_param(param_file, mdl, "MIX_LEN_EXPONENT", CS%MixLenExponent, & + "The exponent applied to the ratio of the distance to the MLD "//& + "and the MLD depth which determines the shape of the mixing length. "//& + "This is only used if",& + "units=nondim", default=2.0) + + +!/ Turbulent velocity scale in mixing coefficient + call get_param(param_file, mdl, "EPBL_VEL_SCALE_MODE", CS%wT_mode, & + "An integer switch for how to compute the turbulent velocity. \n"//& + " 0 for old wT = (TKE Remaining)^(1/3)\n"//& + " 1 for new wT = v* + w* -see Reichl & Hallberg 2018.",& + "units=nondim",default=0) + call get_param(param_file, mdl, "WSTAR_USTAR_COEF", CS%wstar_ustar_coef, & + "A ratio relating the efficiency with which convectively \n"//& + "released energy is converted to a turbulent velocity, \n"// & + "relative to mechanically forced TKE. Making this larger \n"//& + "increases the BL diffusivity", units="nondim", default=1.0) + call get_param(param_file, mdl, "EPBL_VEL_SCALE_FACTOR", CS%vstar_scale_fac, & + "An overall nondimensional scaling factor for wT. \n"// & + "Making this larger decreases the PBL diffusivity.", & + units="nondim", default=1.0, scale=US%m_to_Z) + call get_param(param_file, mdl, "VSTAR_SURF_FAC", CS%vstar_surf_fac,& + "The proportionality times ustar to set v* at the surface.",& + "units=nondim", default=1.2) + + + !/ Options related to Langmuir turbulence + call get_param(param_file, mdl, "LT_ENHANCE_K_R16",CS%LT_ENH_K_R16, & + "Logical flag to toggle on enhancing mixing coefficient in\n"//& + "boundary layer due to Langmuir turbulence following Reichl\n"//& + "et al., 2016. \n"//& + "This approach is not recommended for use, as it is based\n"//& + "on a hurricane LES configuration and not known if it is general.",& + units="nondim",default=.false.) call get_param(param_file, mdl, "USE_LA_LI2016", USE_LA_Windsea, & "A logical to use the Li et al. 2016 (submitted) formula to \n"//& " determine the Langmuir number.", & @@ -2380,12 +2445,17 @@ subroutine energetic_PBL_init(Time, G, GV, US, param_file, diag, CS) " ratio of Ekman to unstable Obukhov depth if LT_ENHANCE=2.",& units="nondim", default=0.95) endif + + +!/ Logging parameters ! This gives a minimum decay scale that is typically much less than Angstrom. CS%ustar_min = 2e-4*CS%omega*(GV%Angstrom_Z + GV%H_to_Z*GV%H_subroundoff) call log_param(param_file, mdl, "EPBL_USTAR_MIN", CS%ustar_min*US%Z_to_m, & "The (tiny) minimum friction velocity used within the \n"//& "ePBL code, derived from OMEGA and ANGSTROM.", units="m s-1") + +!/ Checking output flags CS%id_ML_depth = register_diag_field('ocean_model', 'ePBL_h_ML', diag%axesT1, & Time, 'Surface boundary layer depth', 'm', conversion=US%Z_to_m, & cmor_long_name='Ocean Mixed Layer Thickness Defined by Mixing Scheme') @@ -2469,16 +2539,18 @@ subroutine energetic_PBL_init(Time, G, GV, US, param_file, diag, CS) call safe_alloc_alloc(CS%MSTAR_LT, isd, ied, jsd, jed) endif + !delete Ekman depth - CS%MSTAR_A = CS%MSTAR_AT_XINT**(1./CS%mstar_exp) - CS%MSTAR_B = CS%MSTAR_SLOPE / (CS%MSTAR_EXP*CS%MSTAR_A**(CS%mstar_exp-1.)) + !CS%MSTAR_A = CS%MSTAR_AT_XINT**(1./CS%mstar_exp) + !CS%MSTAR_B = CS%MSTAR_SLOPE / (CS%MSTAR_EXP*CS%MSTAR_A**(CS%mstar_exp-1.)) !Fitting coefficients to asymptote toward MSTAR_CAP !*Fixed to begin asymptote at MSTAR_CAP-0.5 toward MSTAR_CAP - CS%MSTAR_A2 = 0.5**(1./CS%mstar_exp) - CS%MSTAR_B2 = -CS%MSTAR_SLOPE / (CS%mstar_exp*CS%MSTAR_A2**(CS%mstar_exp-1)) + !CS%MSTAR_A2 = 0.5**(1./CS%mstar_exp) + !CS%MSTAR_B2 = -CS%MSTAR_SLOPE / (CS%mstar_exp*CS%MSTAR_A2**(CS%mstar_exp-1)) !Compute value of X (referenced to MSTAR_XINT) where transition ! to asymptotic regime based on value of X where MSTAR=MSTAR_CAP-0.5 - CS%MSTAR_XINT_UP = (CS%MSTAR_CAP-0.5-CS%MSTAR_AT_XINT)/CS%MSTAR_SLOPE + !CS%MSTAR_XINT_UP = (CS%MSTAR_CAP-0.5-CS%MSTAR_AT_XINT)/CS%MSTAR_SLOPE + !delete Date: Tue, 28 May 2019 08:26:06 -0400 Subject: [PATCH 03/82] Unpacking Loops in ePBL for code clarity. --- .../vertical/MOM_energetic_PBL.F90 | 1376 +++++++++-------- 1 file changed, 706 insertions(+), 670 deletions(-) diff --git a/src/parameterizations/vertical/MOM_energetic_PBL.F90 b/src/parameterizations/vertical/MOM_energetic_PBL.F90 index 5d6eaf3412..6250762674 100644 --- a/src/parameterizations/vertical/MOM_energetic_PBL.F90 +++ b/src/parameterizations/vertical/MOM_energetic_PBL.F90 @@ -33,14 +33,14 @@ module MOM_energetic_PBL !> This control structure holds parameters for the MOM_energetic_PBL module type, public :: energetic_PBL_CS ; private - !/ Constants + !/ Constants real :: VonKar = 0.41 !< The von Karman coefficient. This should be runtime, but because !! it is runtime in KPP and set to 0.4 it might change answers. real :: omega !< The Earth's rotation rate [s-1]. real :: omega_frac !< When setting the decay scale for turbulence, use this fraction of !! the absolute rotation rate blended with the local value of f, as !! sqrt((1-of)*f^2 + of*4*omega^2). - + !/ Convection related terms real :: nstar !< The fraction of the TKE input to the mixed layer available to drive !! entrainment [nondim]. This quantity is the vertically integrated @@ -305,7 +305,7 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS ! ! The key parameters for the mixed layer are found in the control structure. ! To use the classic constant mstar mixied layers choose MSTAR_MODE=0. -! The key parameters then include mstar, nstar, TKE_decay, and conv_decay. +! The key parameters then include mstar, nstar, TKE_decay, and conv_decay. ! For the Oberhuber (1993) mixed layer,the values of these are: ! mstar = 1.25, nstar = 1, TKE_decay = 2.5, conv_decay = 0.5 ! TKE_decay is 1/kappa in eq. 28 of Oberhuber (1993), while conv_decay is 1/mu. @@ -571,7 +571,7 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS dt__diag = dt ; if (present(dt_diag)) dt__diag = dt_diag IdtdR0 = 1.0 / (dt__diag * GV%Rho0) write_diags = .true. ; if (present(last_call)) write_diags = last_call - max_itt = 20 !BGR: Why is this hard-coded? + max_itt = 20 h_tt_min = 0.0 I_dtrho = 0.0 ; if (dt*GV%Rho0 > 0.0) I_dtrho = 1.0 / (dt*GV%Rho0) @@ -630,11 +630,13 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS !!OMP dMKE_max,sfc_connected,TKE_here) do j=js,je ! Copy the thicknesses and other fields to 2-d arrays. - do k=1,nz ; do i=is,ie - h(i,k) = h_3d(i,j,k) + h_neglect ; u(i,k) = u_3d(i,j,k) ; v(i,k) = v_3d(i,j,k) - T(i,k) = tv%T(i,j,k) ; S(i,k) = tv%S(i,j,k) - Kd(i,K) = 0.0 - enddo ; enddo + do k=1,nz + do i=is,ie + h(i,k) = h_3d(i,j,k) + h_neglect ; u(i,k) = u_3d(i,j,k) ; v(i,k) = v_3d(i,j,k) + T(i,k) = tv%T(i,j,k) ; S(i,k) = tv%S(i,j,k) + Kd(i,K) = 0.0 + enddo + enddo do i=is,ie CS%ML_depth(i,j) = h(i,1)*GV%H_to_Z sfc_connected(i) = .true. @@ -650,742 +652,775 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS ! homogenizing the shortwave heating within that cell. This sets the energy ! and ustar and wstar available to drive mixing at the first interior ! interface. - do i=is,ie ; if (G%mask2dT(i,j) > 0.5) then - - U_star = fluxes%ustar(i,j) - U_Star_Mean = fluxes%ustar_gustless(i,j) - B_Flux = buoy_flux(i,j) - if (associated(fluxes%ustar_shelf) .and. associated(fluxes%frac_shelf_h)) then - if (fluxes%frac_shelf_h(i,j) > 0.0) & - U_star = (1.0 - fluxes%frac_shelf_h(i,j)) * U_star + & - fluxes%frac_shelf_h(i,j) * fluxes%ustar_shelf(i,j) - endif - if (U_Star < CS%ustar_min) U_Star = CS%ustar_min - if (CS%omega_frac >= 1.0) then ; absf(i) = 2.0*CS%omega - else - absf(i) = 0.25*US%s_to_T*((abs(G%CoriolisBu(I,J)) + abs(G%CoriolisBu(I-1,J-1))) + & - (abs(G%CoriolisBu(I,J-1)) + abs(G%CoriolisBu(I-1,J)))) - if (CS%omega_frac > 0.0) & - absf(i) = sqrt(CS%omega_frac*4.0*CS%omega**2 + (1.0-CS%omega_frac)*absf(i)**2) - endif + do i=is,ie + if (G%mask2dT(i,j) > 0.5) then + + U_star = fluxes%ustar(i,j) + U_Star_Mean = fluxes%ustar_gustless(i,j) + B_Flux = buoy_flux(i,j) + if (associated(fluxes%ustar_shelf) .and. associated(fluxes%frac_shelf_h)) then + if (fluxes%frac_shelf_h(i,j) > 0.0) & + U_star = (1.0 - fluxes%frac_shelf_h(i,j)) * U_star + & + fluxes%frac_shelf_h(i,j) * fluxes%ustar_shelf(i,j) + endif + if (U_Star < CS%ustar_min) U_Star = CS%ustar_min + if (CS%omega_frac >= 1.0) then + absf(i) = 2.0*CS%omega + else + absf(i) = 0.25*US%s_to_T*((abs(G%CoriolisBu(I,J)) + abs(G%CoriolisBu(I-1,J-1))) + & + (abs(G%CoriolisBu(I,J-1)) + abs(G%CoriolisBu(I-1,J)))) + if (CS%omega_frac > 0.0) & + absf(i) = sqrt(CS%omega_frac*4.0*CS%omega**2 + (1.0-CS%omega_frac)*absf(i)**2) + endif ! endif ; enddo ! do i=is,ie ; if (G%mask2dT(i,j) > 0.5) then - h_sum(i) = H_neglect ; do k=1,nz ; h_sum(i) = h_sum(i) + h(i,k) ; enddo - I_hs = 0.0 ; if (h_sum(i) > 0.0) I_hs = 1.0 / h_sum(i) + h_sum(i) = H_neglect + do k=1,nz + h_sum(i) = h_sum(i) + h(i,k) + enddo + I_hs = 0.0 + if (h_sum(i) > 0.0) I_hs = 1.0 / h_sum(i) + h_bot = 0.0 + hb_hs(i,nz+1) = 0.0 + do k=nz,1,-1 + h_bot = h_bot + h(i,k) + hb_hs(i,K) = h_bot * I_hs + enddo - h_bot = 0.0 ; hb_hs(i,nz+1) = 0.0 - do k=nz,1,-1 - h_bot = h_bot + h(i,k) - hb_hs(i,K) = h_bot * I_hs - enddo + pres(i,1) = 0.0 + pres_Z(i,1) = 0.0 + do k=1,nz + dMass = GV%H_to_kg_m2 * h(i,k) + dPres = (GV%g_Earth*US%m_to_Z) * dMass ! This is equivalent to GV%H_to_Pa * h(i,k) + dT_to_dPE(i,k) = (dMass * (pres(i,K) + 0.5*dPres)) * dSV_dT(i,j,k) + dS_to_dPE(i,k) = (dMass * (pres(i,K) + 0.5*dPres)) * dSV_dS(i,j,k) + dT_to_dColHt(i,k) = dMass * US%m_to_Z * dSV_dT(i,j,k) + dS_to_dColHt(i,k) = dMass * US%m_to_Z * dSV_dS(i,j,k) - pres(i,1) = 0.0 ; pres_Z(i,1) = 0.0 - do k=1,nz - dMass = GV%H_to_kg_m2 * h(i,k) - dPres = (GV%g_Earth*US%m_to_Z) * dMass ! This is equivalent to GV%H_to_Pa * h(i,k) - dT_to_dPE(i,k) = (dMass * (pres(i,K) + 0.5*dPres)) * dSV_dT(i,j,k) - dS_to_dPE(i,k) = (dMass * (pres(i,K) + 0.5*dPres)) * dSV_dS(i,j,k) - dT_to_dColHt(i,k) = dMass * US%m_to_Z * dSV_dT(i,j,k) - dS_to_dColHt(i,k) = dMass * US%m_to_Z * dSV_dS(i,j,k) - - pres(i,K+1) = pres(i,K) + dPres - pres_Z(i,K+1) = US%Z_to_m * pres(i,K+1) - enddo + pres(i,K+1) = pres(i,K) + dPres + pres_Z(i,K+1) = US%Z_to_m * pres(i,K+1) + enddo ! endif ; enddo ! Note the outer i-loop and inner k-loop loop order!!! ! do i=is,ie ; if (G%mask2dT(i,j) > 0.5) then - do k=1,nz ; T0(k) = T(i,k) ; S0(k) = S(i,k) ; enddo - - !/The following lines are for the iteration over MLD - ! max_MLD will initialized as ocean bottom depth - max_MLD = 0.0 ; do k=1,nz ; max_MLD = max_MLD + h(i,k)*GV%H_to_Z ; enddo - !min_MLD will initialize as 0. - min_MLD = 0.0 - - !/BGR: Add MLD_guess based on stored previous value. - ! note that this is different from ML_Depth already - ! computed by EPBL, need to figure out why. - if (CS%MLD_iteration_guess .and. (CS%ML_Depth2(i,j) > 1.0*US%m_to_Z)) then - !If prev value is present use for guess. - MLD_guess = CS%ML_Depth2(i,j) - else - !Otherwise guess middle of water column (or Stab_Scale if smaller). - MLD_guess = 0.5 * (min_MLD+max_MLD) - endif + do k=1,nz + T0(k) = T(i,k) + S0(k) = S(i,k) + enddo + + !/The following lines are for the iteration over MLD + ! max_MLD will initialized as ocean bottom depth + max_MLD = 0.0 + do k=1,nz + max_MLD = max_MLD + h(i,k)*GV%H_to_Z + enddo + !min_MLD will initialize as 0. + min_MLD = 0.0 + + !/BGR: Add MLD_guess based on stored previous value. + ! note that this is different from ML_Depth already + ! computed by EPBL, need to figure out why. + if (CS%MLD_iteration_guess .and. (CS%ML_Depth2(i,j) > 1.0*US%m_to_Z)) then + !If prev value is present use for guess. + MLD_guess = CS%ML_Depth2(i,j) + else + !Otherwise guess middle of water column (or Stab_Scale if smaller). + MLD_guess = 0.5 * (min_MLD+max_MLD) + endif + + ! Iterate up to MAX_OBL_IT times to determine a converged EPBL depth. + OBL_CONVERGED = .false. + + do OBL_IT=1,MAX_OBL_IT + + if (.not. OBL_CONVERGED) then + ! If not using MLD_Iteration flag loop to only execute once. + if (.not.CS%Use_MLD_Iteration) OBL_CONVERGED = .true. + + ! Reset ML_depth + CS%ML_depth(i,j) = h(i,1)*GV%H_to_Z + sfc_connected(i) = .true. + + !/ Here we get MStar, which is the ratio of convective TKE driven + ! mixing to UStar**3 + if (CS%Use_LT) then + call get_Langmuir_Number( LA, G, GV, US, abs(MLD_guess), u_star_mean, i, j, & + H=H(i,:), U_H=U(i,:), V_H=V(i,:), WAVES=WAVES) + call find_mstar(CS,& + US,& + Buoyancy_Flux = b_flux,& + UStar = U_Star,& + UStar_Mean = U_Star_Mean,& + BLD = MLD_Guess,& + Abs_Coriolis = AbsF(i),& + MStar = MStar_total,& + Langmuir_Number = La,& + Convect_Langmuir_Number = LAmod,& + Enhance_MStar = Enhance_MStar,& + mstar_LT = mstar_LT) + else + call find_mstar(CS,US, b_flux, u_star, u_star_mean,& + mld_guess, absf(i), mstar_total) + endif + + !/ Apply MStar to get mech_TKE + !This bit of code preserves answers but should be eliminated. + if (CS%mstar_mode==0) then + mech_TKE(i) = (dt*MSTAR_total*GV%Rho0) * US%Z_to_m**3 * U_star**3 + else + mech_TKE(i) = MSTAR_total * US%Z_to_m**3 * (dt*GV%Rho0*U_star**3) + endif + + if (CS%TKE_diagnostics) then + CS%diag_TKE_wind(i,j) = CS%diag_TKE_wind(i,j) + mech_TKE(i) * IdtdR0 + if (TKE_forced(i,j,1) <= 0.0) then + CS%diag_TKE_forcing(i,j) = CS%diag_TKE_forcing(i,j) + & + max(-mech_TKE(i), TKE_forced(i,j,1)) * IdtdR0 + ! CS%diag_TKE_unbalanced_forcing(i,j) = CS%diag_TKE_unbalanced_forcing(i,j) + & + ! min(0.0, TKE_forced(i,j,1) + mech_TKE(i)) * IdtdR0 + else + CS%diag_TKE_forcing(i,j) = CS%diag_TKE_forcing(i,j) + CS%nstar*TKE_forced(i,j,1) * IdtdR0 + endif + endif + + conv_PErel(i) = 0.0 + if (TKE_forced(i,j,1) <= 0.0) then + mech_TKE(i) = mech_TKE(i) + TKE_forced(i,j,1) + if (mech_TKE(i) < 0.0) mech_TKE(i) = 0.0 + else + conv_PErel(i) = conv_PErel(i) + TKE_forced(i,j,1) + endif + + if (CS%TKE_diagnostics) then + dTKE_conv = 0.0 ; dTKE_forcing = 0.0 ; dTKE_mixing = 0.0 + dTKE_MKE = 0.0 ; dTKE_mech_decay = 0.0 ; dTKE_conv_decay = 0.0 + endif + + ! Store in 1D arrays for output. + do k=1,nz + Vstar_Used(k) = 0. + Mixing_Length_Used(k) = 0. + enddo + + if ((.not.CS%Use_MLD_Iteration) .or. & + (CS%transLay_scale >= 1.0) .or. (CS%transLay_scale < 0.0) ) then + do K=1,nz+1 + MixLen_shape(K) = 1.0 + enddo + elseif (MLD_guess <= 0.0) then + if (CS%transLay_scale > 0.0) then + do K=1,nz+1 + MixLen_shape(K) = CS%transLay_scale + enddo + else + do K=1,nz+1 + MixLen_shape(K) = 1.0 + enddo + endif + else + ! Reduce the mixing length based on MLD, with a quadratic + ! expression that follows KPP. + I_MLD = 1.0 / MLD_guess + h_rsum = 0.0 + MixLen_shape(1) = 1.0 + do K=2,nz+1 + h_rsum = h_rsum + h(i,k-1)*GV%H_to_Z + if (CS%MixLenExponent==2.0)then + MixLen_shape(K) = CS%transLay_scale + (1.0 - CS%transLay_scale) * & + (max(0.0, (MLD_guess - h_rsum)*I_MLD) )**2!CS%MixLenExponent + else + MixLen_shape(K) = CS%transLay_scale + (1.0 - CS%transLay_scale) * & + (max(0.0, (MLD_guess - h_rsum)*I_MLD) )**CS%MixLenExponent + endif + enddo + endif - ! Iterate up to MAX_OBL_IT times to determine a converged EPBL depth. - OBL_CONVERGED = .false. - - do OBL_IT=1,MAX_OBL_IT ; if (.not. OBL_CONVERGED) then - ! If not using MLD_Iteration flag loop to only execute once. - if (.not.CS%Use_MLD_Iteration) OBL_CONVERGED = .true. - - ! Reset ML_depth - CS%ML_depth(i,j) = h(i,1)*GV%H_to_Z - !CS%ML_depth2(i,j) = h(i,1)*GV%H_to_Z - - sfc_connected(i) = .true. - - !/ Here we get MStar, which is the ratio of convective TKE driven - ! mixing to UStar**3 - if (CS%Use_LT) then - call get_Langmuir_Number( LA, G, GV, US, abs(MLD_guess), u_star_mean, i, j, & - H=H(i,:), U_H=U(i,:), V_H=V(i,:), WAVES=WAVES) - call find_mstar(CS,& - US,& - Buoyancy_Flux = b_flux,& - UStar = U_Star,& - UStar_Mean = U_Star_Mean,& - BLD = MLD_Guess,& - Abs_Coriolis = AbsF(i),& - MStar = MStar_total,& - Langmuir_Number = La,& - Convect_Langmuir_Number = LAmod,& - Enhance_MStar = Enhance_MStar,& - mstar_LT = mstar_LT) - else - call find_mstar(CS,US, b_flux, u_star, u_star_mean,& - mld_guess, absf(i), mstar_total) - endif + Kd(i,1) = 0.0 ; Kddt_h(1) = 0.0 + hp_a(i) = h(i,1) + dT_to_dPE_a(i,1) = dT_to_dPE(i,1) ; dT_to_dColHt_a(i,1) = dT_to_dColHt(i,1) + dS_to_dPE_a(i,1) = dS_to_dPE(i,1) ; dS_to_dColHt_a(i,1) = dS_to_dColHt(i,1) - !/ Apply MStar to get mech_TKE - !This bit of code preserves answers but should be eliminated. - if (CS%mstar_mode==0) then - mech_TKE(i) = (dt*MSTAR_total*GV%Rho0) * US%Z_to_m**3 * U_star**3 - else - mech_TKE(i) = MSTAR_total * US%Z_to_m**3 * (dt*GV%Rho0*U_star**3) - endif + htot(i) = h(i,1) ; uhtot(i) = u(i,1)*h(i,1) ; vhtot(i) = v(i,1)*h(i,1) - if (CS%TKE_diagnostics) then - CS%diag_TKE_wind(i,j) = CS%diag_TKE_wind(i,j) + mech_TKE(i) * IdtdR0 - if (TKE_forced(i,j,1) <= 0.0) then - CS%diag_TKE_forcing(i,j) = CS%diag_TKE_forcing(i,j) + & - max(-mech_TKE(i), TKE_forced(i,j,1)) * IdtdR0 - ! CS%diag_TKE_unbalanced_forcing(i,j) = CS%diag_TKE_unbalanced_forcing(i,j) + & - ! min(0.0, TKE_forced(i,j,1) + mech_TKE(i)) * IdtdR0 - else - CS%diag_TKE_forcing(i,j) = CS%diag_TKE_forcing(i,j) + CS%nstar*TKE_forced(i,j,1) * IdtdR0 + if (debug) then + mech_TKE_k(i,1) = mech_TKE(i) ; conv_PErel_k(i,1) = conv_PErel(i) + nstar_k(:) = 0.0 ; nstar_k(1) = CS%nstar ; num_itts(:) = -1 endif - endif - conv_PErel(i) = 0.0 - if (TKE_forced(i,j,1) <= 0.0) then - mech_TKE(i) = mech_TKE(i) + TKE_forced(i,j,1) - if (mech_TKE(i) < 0.0) mech_TKE(i) = 0.0 - else - conv_PErel(i) = conv_PErel(i) + TKE_forced(i,j,1) - endif - if (CS%TKE_diagnostics) then - dTKE_conv = 0.0 ; dTKE_forcing = 0.0 ; dTKE_mixing = 0.0 - dTKE_MKE = 0.0 ; dTKE_mech_decay = 0.0 ; dTKE_conv_decay = 0.0 - endif - ! Store in 1D arrays for output. - do k=1,nz - Vstar_Used(k) = 0.0 ; Mixing_Length_Used(k) = 0.0 - enddo - - if ((.not.CS%Use_MLD_Iteration) .or. & - (CS%transLay_scale >= 1.0) .or. (CS%transLay_scale < 0.0) ) then - do K=1,nz+1 ; MixLen_shape(K) = 1.0 ; enddo - elseif (MLD_guess <= 0.0) then - if (CS%transLay_scale > 0.0) then - do K=1,nz+1 ; MixLen_shape(K) = CS%transLay_scale ; enddo - else - do K=1,nz+1 ; MixLen_shape(K) = 1.0 ; enddo - endif - else - ! Reduce the mixing length based on MLD, with a quadratic - ! expression that follows KPP. - I_MLD = 1.0 / MLD_guess ; h_rsum = 0.0 - MixLen_shape(1) = 1.0 - do K=2,nz+1 - h_rsum = h_rsum + h(i,k-1)*GV%H_to_Z - if (CS%MixLenExponent==2.0)then - MixLen_shape(K) = CS%transLay_scale + (1.0 - CS%transLay_scale) * & - (max(0.0, (MLD_guess - h_rsum)*I_MLD) )**2!CS%MixLenExponent - else - MixLen_shape(K) = CS%transLay_scale + (1.0 - CS%transLay_scale) * & - (max(0.0, (MLD_guess - h_rsum)*I_MLD) )**CS%MixLenExponent - endif - enddo - endif - Kd(i,1) = 0.0 ; Kddt_h(1) = 0.0 - hp_a(i) = h(i,1) - dT_to_dPE_a(i,1) = dT_to_dPE(i,1) ; dT_to_dColHt_a(i,1) = dT_to_dColHt(i,1) - dS_to_dPE_a(i,1) = dS_to_dPE(i,1) ; dS_to_dColHt_a(i,1) = dS_to_dColHt(i,1) + do K=2,nz + ! Apply dissipation to the TKE, here applied as an exponential decay + ! due to 3-d turbulent energy being lost to inefficient rotational modes. - htot(i) = h(i,1) ; uhtot(i) = u(i,1)*h(i,1) ; vhtot(i) = v(i,1)*h(i,1) - - if (debug) then - mech_TKE_k(i,1) = mech_TKE(i) ; conv_PErel_k(i,1) = conv_PErel(i) - nstar_k(:) = 0.0 ; nstar_k(1) = CS%nstar ; num_itts(:) = -1 - endif - do K=2,nz - ! Apply dissipation to the TKE, here applied as an exponential decay - ! due to 3-d turbulent energy being lost to inefficient rotational modes. - - ! There should be several different "flavors" of TKE that decay at - ! different rates. The following form is often used for mechanical - ! stirring from the surface, perhaps due to breaking surface gravity - ! waves and wind-driven turbulence. - Idecay_len_TKE(i) = (CS%TKE_decay * absf(i) / U_star) * GV%H_to_Z - exp_kh = 1.0 - if (Idecay_len_TKE(i) > 0.0) exp_kh = exp(-h(i,k-1)*Idecay_len_TKE(i)) - if (CS%TKE_diagnostics) & - dTKE_mech_decay = dTKE_mech_decay + (exp_kh-1.0) * mech_TKE(i) * IdtdR0 - mech_TKE(i) = mech_TKE(i) * exp_kh - - ! Accumulate any convectively released potential energy to contribute - ! to wstar and to drive penetrating convection. - if (TKE_forced(i,j,k) > 0.0) then - conv_PErel(i) = conv_PErel(i) + TKE_forced(i,j,k) + ! There should be several different "flavors" of TKE that decay at + ! different rates. The following form is often used for mechanical + ! stirring from the surface, perhaps due to breaking surface gravity + ! waves and wind-driven turbulence. + Idecay_len_TKE(i) = (CS%TKE_decay * absf(i) / U_star) * GV%H_to_Z + exp_kh = 1.0 + if (Idecay_len_TKE(i) > 0.0) exp_kh = exp(-h(i,k-1)*Idecay_len_TKE(i)) if (CS%TKE_diagnostics) & - dTKE_forcing = dTKE_forcing + CS%nstar*TKE_forced(i,j,k) * IdtdR0 - endif + dTKE_mech_decay = dTKE_mech_decay + (exp_kh-1.0) * mech_TKE(i) * IdtdR0 + mech_TKE(i) = mech_TKE(i) * exp_kh + + ! Accumulate any convectively released potential energy to contribute + ! to wstar and to drive penetrating convection. + if (TKE_forced(i,j,k) > 0.0) then + conv_PErel(i) = conv_PErel(i) + TKE_forced(i,j,k) + if (CS%TKE_diagnostics) & + dTKE_forcing = dTKE_forcing + CS%nstar*TKE_forced(i,j,k) * IdtdR0 + endif - if (debug) then - mech_TKE_k(i,K) = mech_TKE(i) ; conv_PErel_k(i,K) = conv_PErel(i) - endif + if (debug) then + mech_TKE_k(i,K) = mech_TKE(i) ; conv_PErel_k(i,K) = conv_PErel(i) + endif - ! Determine the total energy - nstar_FC = CS%nstar - if (CS%nstar * conv_PErel(i) > 0.0) then - ! Here nstar is a function of the natural Rossby number 0.2/(1+0.2/Ro), based - ! on a curve fit from the data of Wang (GRL, 2003). - ! Note: Ro = 1.0 / sqrt(0.5 * dt * Rho0 * (absf*htot(i))**3 / conv_PErel(i)) - nstar_FC = CS%nstar * conv_PErel(i) / (conv_PErel(i) + 0.2 * & - sqrt(0.5 * dt * GV%Rho0 * (absf(i)*(htot(i)*GV%H_to_m))**3 * conv_PErel(i))) - endif + ! Determine the total energy + nstar_FC = CS%nstar + if (CS%nstar * conv_PErel(i) > 0.0) then + ! Here nstar is a function of the natural Rossby number 0.2/(1+0.2/Ro), based + ! on a curve fit from the data of Wang (GRL, 2003). + ! Note: Ro = 1.0 / sqrt(0.5 * dt * Rho0 * (absf*htot(i))**3 / conv_PErel(i)) + nstar_FC = CS%nstar * conv_PErel(i) / (conv_PErel(i) + 0.2 * & + sqrt(0.5 * dt * GV%Rho0 * (absf(i)*(htot(i)*GV%H_to_m))**3 * conv_PErel(i))) + endif - if (debug) nstar_k(K) = nstar_FC - - tot_TKE = mech_TKE(i) + nstar_FC * conv_PErel(i) - - ! For each interior interface, first discard the TKE to account for - ! mixing of shortwave radiation through the next denser cell. - if (TKE_forced(i,j,k) < 0.0) then - if (TKE_forced(i,j,k) + tot_TKE < 0.0) then - ! The shortwave requirements deplete all the energy in this layer. - if (CS%TKE_diagnostics) then - dTKE_mixing = dTKE_mixing + tot_TKE * IdtdR0 - dTKE_forcing = dTKE_forcing - tot_TKE * IdtdR0 - ! dTKE_unbalanced_forcing = dTKE_unbalanced_forcing + & - ! (TKE_forced(i,j,k) + tot_TKE) * IdtdR0 - dTKE_conv_decay = dTKE_conv_decay + & - (CS%nstar-nstar_FC) * conv_PErel(i) * IdtdR0 - endif - tot_TKE = 0.0 ; mech_TKE(i) = 0.0 ; conv_PErel(i) = 0.0 - else - ! Reduce the mechanical and convective TKE proportionately. - TKE_reduc = (tot_TKE + TKE_forced(i,j,k)) / tot_TKE - if (CS%TKE_diagnostics) then - dTKE_mixing = dTKE_mixing - TKE_forced(i,j,k) * IdtdR0 - dTKE_forcing = dTKE_forcing + TKE_forced(i,j,k) * IdtdR0 - dTKE_conv_decay = dTKE_conv_decay + & - (1.0-TKE_reduc)*(CS%nstar-nstar_FC) * conv_PErel(i) * IdtdR0 + if (debug) nstar_k(K) = nstar_FC + + tot_TKE = mech_TKE(i) + nstar_FC * conv_PErel(i) + + ! For each interior interface, first discard the TKE to account for + ! mixing of shortwave radiation through the next denser cell. + if (TKE_forced(i,j,k) < 0.0) then + if (TKE_forced(i,j,k) + tot_TKE < 0.0) then + ! The shortwave requirements deplete all the energy in this layer. + if (CS%TKE_diagnostics) then + dTKE_mixing = dTKE_mixing + tot_TKE * IdtdR0 + dTKE_forcing = dTKE_forcing - tot_TKE * IdtdR0 + ! dTKE_unbalanced_forcing = dTKE_unbalanced_forcing + & + ! (TKE_forced(i,j,k) + tot_TKE) * IdtdR0 + dTKE_conv_decay = dTKE_conv_decay + & + (CS%nstar-nstar_FC) * conv_PErel(i) * IdtdR0 + endif + tot_TKE = 0.0 ; mech_TKE(i) = 0.0 ; conv_PErel(i) = 0.0 + else + ! Reduce the mechanical and convective TKE proportionately. + TKE_reduc = (tot_TKE + TKE_forced(i,j,k)) / tot_TKE + if (CS%TKE_diagnostics) then + dTKE_mixing = dTKE_mixing - TKE_forced(i,j,k) * IdtdR0 + dTKE_forcing = dTKE_forcing + TKE_forced(i,j,k) * IdtdR0 + dTKE_conv_decay = dTKE_conv_decay + & + (1.0-TKE_reduc)*(CS%nstar-nstar_FC) * conv_PErel(i) * IdtdR0 + endif + tot_TKE = TKE_reduc*tot_TKE ! = tot_TKE + TKE_forced(i,j,k) + mech_TKE(i) = TKE_reduc*mech_TKE(i) + conv_PErel(i) = TKE_reduc*conv_PErel(i) endif - tot_TKE = TKE_reduc*tot_TKE ! = tot_TKE + TKE_forced(i,j,k) - mech_TKE(i) = TKE_reduc*mech_TKE(i) - conv_PErel(i) = TKE_reduc*conv_PErel(i) endif - endif - ! Precalculate some temporary expressions that are independent of Kddt_h(K). - if (CS%orig_PE_calc) then - if (K==2) then - dTe_t2 = 0.0 ; dSe_t2 = 0.0 - else - dTe_t2 = Kddt_h(K-1) * ((T0(k-2) - T0(k-1)) + dTe(k-2)) - dSe_t2 = Kddt_h(K-1) * ((S0(k-2) - S0(k-1)) + dSe(k-2)) - endif - endif - dt_h = (GV%Z_to_H**2*dt) / max(0.5*(h(i,k-1)+h(i,k)), 1e-15*h_sum(i)) - - ! This tests whether the layers above and below this interface are in - ! a convetively stable configuration, without considering any effects of - ! mixing at higher interfaces. It is an approximation to the more - ! complete test dPEc_dKd_Kd0 >= 0.0, that would include the effects of - ! mixing across interface K-1. The dT_to_dColHt here are effectively - ! mass-weigted estimates of dSV_dT. - Convectively_stable = ( 0.0 <= & - ( (dT_to_dColHt(i,k) + dT_to_dColHt(i,k-1) ) * (T0(k-1)-T0(k)) + & - (dS_to_dColHt(i,k) + dS_to_dColHt(i,k-1) ) * (S0(k-1)-S0(k)) ) ) - - if ((mech_TKE(i) + conv_PErel(i)) <= 0.0 .and. Convectively_stable) then - ! Energy is already exhausted, so set Kd = 0 and cycle or exit? - tot_TKE = 0.0 ; mech_TKE(i) = 0.0 ; conv_PErel(i) = 0.0 - Kd(i,K) = 0.0 ; Kddt_h(K) = 0.0 - sfc_disconnect = .true. - ! if (.not.debug) exit - - ! The estimated properties for layer k-1 can be calculated, using - ! greatly simplified expressions when Kddt_h = 0. This enables the - ! tridiagonal solver for the whole column to be completed for debugging - ! purposes, and also allows for something akin to convective adjustment - ! in unstable interior regions? - b1 = 1.0 / hp_a(i) - c1(K) = 0.0 + ! Precalculate some temporary expressions that are independent of Kddt_h(K). if (CS%orig_PE_calc) then - dTe(k-1) = b1 * ( dTe_t2 ) - dSe(k-1) = b1 * ( dSe_t2 ) + if (K==2) then + dTe_t2 = 0.0 ; dSe_t2 = 0.0 + else + dTe_t2 = Kddt_h(K-1) * ((T0(k-2) - T0(k-1)) + dTe(k-2)) + dSe_t2 = Kddt_h(K-1) * ((S0(k-2) - S0(k-1)) + dSe(k-2)) + endif endif + dt_h = (GV%Z_to_H**2*dt) / max(0.5*(h(i,k-1)+h(i,k)), 1e-15*h_sum(i)) + + ! This tests whether the layers above and below this interface are in + ! a convetively stable configuration, without considering any effects of + ! mixing at higher interfaces. It is an approximation to the more + ! complete test dPEc_dKd_Kd0 >= 0.0, that would include the effects of + ! mixing across interface K-1. The dT_to_dColHt here are effectively + ! mass-weigted estimates of dSV_dT. + Convectively_stable = ( 0.0 <= & + ( (dT_to_dColHt(i,k) + dT_to_dColHt(i,k-1) ) * (T0(k-1)-T0(k)) + & + (dS_to_dColHt(i,k) + dS_to_dColHt(i,k-1) ) * (S0(k-1)-S0(k)) ) ) + + if ((mech_TKE(i) + conv_PErel(i)) <= 0.0 .and. Convectively_stable) then + ! Energy is already exhausted, so set Kd = 0 and cycle or exit? + tot_TKE = 0.0 ; mech_TKE(i) = 0.0 ; conv_PErel(i) = 0.0 + Kd(i,K) = 0.0 ; Kddt_h(K) = 0.0 + sfc_disconnect = .true. + ! if (.not.debug) exit + + ! The estimated properties for layer k-1 can be calculated, using + ! greatly simplified expressions when Kddt_h = 0. This enables the + ! tridiagonal solver for the whole column to be completed for debugging + ! purposes, and also allows for something akin to convective adjustment + ! in unstable interior regions? + b1 = 1.0 / hp_a(i) + c1(K) = 0.0 + if (CS%orig_PE_calc) then + dTe(k-1) = b1 * ( dTe_t2 ) + dSe(k-1) = b1 * ( dSe_t2 ) + endif - hp_a(i) = h(i,k) - dT_to_dPE_a(i,k) = dT_to_dPE(i,k) - dS_to_dPE_a(i,k) = dS_to_dPE(i,k) - dT_to_dColHt_a(i,k) = dT_to_dColHt(i,k) - dS_to_dColHt_a(i,k) = dS_to_dColHt(i,k) + hp_a(i) = h(i,k) + dT_to_dPE_a(i,k) = dT_to_dPE(i,k) + dS_to_dPE_a(i,k) = dS_to_dPE(i,k) + dT_to_dColHt_a(i,k) = dT_to_dColHt(i,k) + dS_to_dColHt_a(i,k) = dS_to_dColHt(i,k) + + else ! tot_TKE > 0.0 or this is a potentially convectively unstable profile. + sfc_disconnect = .false. + + ! Precalculate some more temporary expressions that are independent of + ! Kddt_h(K). + if (CS%orig_PE_calc) then + if (K==2) then + dT_km1_t2 = (T0(k)-T0(k-1)) + dS_km1_t2 = (S0(k)-S0(k-1)) + else + dT_km1_t2 = (T0(k)-T0(k-1)) - & + (Kddt_h(K-1) / hp_a(i)) * ((T0(k-2) - T0(k-1)) + dTe(k-2)) + dS_km1_t2 = (S0(k)-S0(k-1)) - & + (Kddt_h(K-1) / hp_a(i)) * ((S0(k-2) - S0(k-1)) + dSe(k-2)) + endif + dTe_term = dTe_t2 + hp_a(i) * (T0(k-1)-T0(k)) + dSe_term = dSe_t2 + hp_a(i) * (S0(k-1)-S0(k)) + else + if (K<=2) then + Th_a(k-1) = h(i,k-1) * T0(k-1) ; Sh_a(k-1) = h(i,k-1) * S0(k-1) + else + Th_a(k-1) = h(i,k-1) * T0(k-1) + Kddt_h(K-1) * Te(k-2) + Sh_a(k-1) = h(i,k-1) * S0(k-1) + Kddt_h(K-1) * Se(k-2) + endif + Th_b(k) = h(i,k) * T0(k) ; Sh_b(k) = h(i,k) * S0(k) + endif - else ! tot_TKE > 0.0 or this is a potentially convectively unstable profile. - sfc_disconnect = .false. + ! Using Pr=1 and the diffusivity at the bottom interface (once it is + ! known), determine how much resolved mean kinetic energy (MKE) will be + ! extracted within a timestep and add a fraction CS%MKE_to_TKE_effic of + ! this to the mTKE budget available for mixing in the next layer. + + if ((CS%MKE_to_TKE_effic > 0.0) .and. (htot(i)*h(i,k) > 0.0)) then + ! This is the energy that would be available from homogenizing the + ! velocities between layer k and the layers above. + dMKE_max = (GV%H_to_kg_m2 * CS%MKE_to_TKE_effic) * 0.5 * & + (h(i,k) / ((htot(i) + h(i,k))*htot(i))) * & + ((uhtot(i)-u(i,k)*htot(i))**2 + (vhtot(i)-v(i,k)*htot(i))**2) + ! A fraction (1-exp(Kddt_h*MKE2_Hharm)) of this energy would be + ! extracted by mixing with a finite viscosity. + MKE2_Hharm = (htot(i) + h(i,k) + 2.0*h_neglect) / & + ((htot(i)+h_neglect) * (h(i,k)+h_neglect)) + else + dMKE_max = 0.0 + MKE2_Hharm = 0.0 + endif - ! Precalculate some more temporary expressions that are independent of - ! Kddt_h(K). - if (CS%orig_PE_calc) then - if (K==2) then - dT_km1_t2 = (T0(k)-T0(k-1)) - dS_km1_t2 = (S0(k)-S0(k-1)) + ! At this point, Kddt_h(K) will be unknown because its value may depend + ! on how much energy is available. mech_TKE might be negative due to + ! contributions from TKE_forced. + h_tt = htot(i) + h_tt_min + TKE_here = mech_TKE(i) + CS%wstar_ustar_coef*conv_PErel(i) + if (TKE_here > 0.0) then + if (CS%wT_mode==0) then + vstar = CS%vstar_scale_fac * (I_dtrho*TKE_here)**C1_3 + elseif (CS%wT_mode==1) then + Surface_Scale = max(0.05,1.-htot(i)/MLD_guess) + vstar = CS%vstar_scale_fac * (CS%vstar_surf_fac*U_Star + & + (CS%wstar_ustar_coef*conv_PErel(i)*I_dtrho)**C1_3)* & + Surface_Scale + endif + hbs_here = GV%H_to_Z * min(hb_hs(i,K), MixLen_shape(K)) + Mixing_Length_Used(k) = MAX(CS%min_mix_len, ((h_tt*hbs_here)*vstar) / & + ((CS%Ekman_scale_coef * absf(i)) * (h_tt*hbs_here) + vstar)) + !Note setting Kd_guess0 to Mixing_Length_Used(K) here will + ! change the answers. Therefore, skipping that. + if (.not.CS%Use_MLD_Iteration) then + Kd_guess0 = vstar * CS%vonKar * ((h_tt*hbs_here)*vstar) / & + ((CS%Ekman_scale_coef * absf(i)) * (h_tt*hbs_here) + vstar) + else + Kd_guess0 = vstar * CS%vonKar * Mixing_Length_Used(k) + endif + ! Compute the local enhnacement of K (perhaps due to Langmuir) + if (CS%LT_ENH_K_R16) then + Shape_Function = htot(i)/MLD_guess*(1.-htot(i)/MLD_guess)**2 + K_Enhancement = ( min( Max_K_Enhancement,1.+1./La ) - 1. ) + Kd_guess0 = Kd_guess0 * Shape_Function / Max_Shape_Function + endif else - dT_km1_t2 = (T0(k)-T0(k-1)) - & - (Kddt_h(K-1) / hp_a(i)) * ((T0(k-2) - T0(k-1)) + dTe(k-2)) - dS_km1_t2 = (S0(k)-S0(k-1)) - & - (Kddt_h(K-1) / hp_a(i)) * ((S0(k-2) - S0(k-1)) + dSe(k-2)) + vstar = 0.0 ; Kd_guess0 = 0.0 endif - dTe_term = dTe_t2 + hp_a(i) * (T0(k-1)-T0(k)) - dSe_term = dSe_t2 + hp_a(i) * (S0(k-1)-S0(k)) - else - if (K<=2) then - Th_a(k-1) = h(i,k-1) * T0(k-1) ; Sh_a(k-1) = h(i,k-1) * S0(k-1) + Vstar_Used(k) = vstar ! Track vstar + Kddt_h_g0 = Kd_guess0*dt_h + + if (CS%orig_PE_calc) then + call find_PE_chg_orig(Kddt_h_g0, h(i,k), hp_a(i), dTe_term, dSe_term, & + dT_km1_t2, dS_km1_t2, dT_to_dPE(i,k), dS_to_dPE(i,k), & + dT_to_dPE_a(i,k-1), dS_to_dPE_a(i,k-1), & + pres_Z(i,K), dT_to_dColHt(i,k), dS_to_dColHt(i,k), & + dT_to_dColHt_a(i,k-1), dS_to_dColHt_a(i,k-1), & + PE_chg=PE_chg_g0, dPEc_dKd=dPEa_dKd_g0, dPE_max=PE_chg_max, & + dPEc_dKd_0=dPEc_dKd_Kd0 ) else - Th_a(k-1) = h(i,k-1) * T0(k-1) + Kddt_h(K-1) * Te(k-2) - Sh_a(k-1) = h(i,k-1) * S0(k-1) + Kddt_h(K-1) * Se(k-2) + call find_PE_chg(0.0, Kddt_h_g0, hp_a(i), h(i,k), & + Th_a(k-1), Sh_a(k-1), Th_b(k), Sh_b(k), & + dT_to_dPE_a(i,k-1), dS_to_dPE_a(i,k-1), dT_to_dPE(i,k), dS_to_dPE(i,k), & + pres_Z(i,K), dT_to_dColHt_a(i,k-1), dS_to_dColHt_a(i,k-1), & + dT_to_dColHt(i,k), dS_to_dColHt(i,k), & + PE_chg=PE_chg_g0, dPEc_dKd=dPEa_dKd_g0, dPE_max=PE_chg_max, & + dPEc_dKd_0=dPEc_dKd_Kd0 ) endif - Th_b(k) = h(i,k) * T0(k) ; Sh_b(k) = h(i,k) * S0(k) - endif - ! Using Pr=1 and the diffusivity at the bottom interface (once it is - ! known), determine how much resolved mean kinetic energy (MKE) will be - ! extracted within a timestep and add a fraction CS%MKE_to_TKE_effic of - ! this to the mTKE budget available for mixing in the next layer. - - if ((CS%MKE_to_TKE_effic > 0.0) .and. (htot(i)*h(i,k) > 0.0)) then - ! This is the energy that would be available from homogenizing the - ! velocities between layer k and the layers above. - dMKE_max = (GV%H_to_kg_m2 * CS%MKE_to_TKE_effic) * 0.5 * & - (h(i,k) / ((htot(i) + h(i,k))*htot(i))) * & - ((uhtot(i)-u(i,k)*htot(i))**2 + (vhtot(i)-v(i,k)*htot(i))**2) - ! A fraction (1-exp(Kddt_h*MKE2_Hharm)) of this energy would be - ! extracted by mixing with a finite viscosity. - MKE2_Hharm = (htot(i) + h(i,k) + 2.0*h_neglect) / & - ((htot(i)+h_neglect) * (h(i,k)+h_neglect)) - else - dMKE_max = 0.0 ; MKE2_Hharm = 0.0 - endif + MKE_src = dMKE_max*(1.0 - exp(-Kddt_h_g0 * MKE2_Hharm)) - ! At this point, Kddt_h(K) will be unknown because its value may depend - ! on how much energy is available. mech_TKE might be negative due to - ! contributions from TKE_forced. - h_tt = htot(i) + h_tt_min - TKE_here = mech_TKE(i) + CS%wstar_ustar_coef*conv_PErel(i) - if (TKE_here > 0.0) then - if (CS%wT_mode==0) then - vstar = CS%vstar_scale_fac * (I_dtrho*TKE_here)**C1_3 - elseif (CS%wT_mode==1) then - Surface_Scale = max(0.05,1.-htot(i)/MLD_guess) - vstar = CS%vstar_scale_fac * (CS%vstar_surf_fac*U_Star + & - (CS%wstar_ustar_coef*conv_PErel(i)*I_dtrho)**C1_3)* & - Surface_Scale - endif - hbs_here = GV%H_to_Z * min(hb_hs(i,K), MixLen_shape(K)) - Mixing_Length_Used(k) = MAX(CS%min_mix_len, ((h_tt*hbs_here)*vstar) / & - ((CS%Ekman_scale_coef * absf(i)) * (h_tt*hbs_here) + vstar)) - !Note setting Kd_guess0 to Mixing_Length_Used(K) here will - ! change the answers. Therefore, skipping that. - if (.not.CS%Use_MLD_Iteration) then - Kd_guess0 = vstar * CS%vonKar * ((h_tt*hbs_here)*vstar) / & - ((CS%Ekman_scale_coef * absf(i)) * (h_tt*hbs_here) + vstar) + if (pe_chg_g0 > 0.0) then + !Negative buoyancy (increases PE) + N2_dissipation = 1.+CS%N2_DISSIPATION_SCALE_NEG else - Kd_guess0 = vstar * CS%vonKar * Mixing_Length_Used(k) - endif - ! Compute the local enhnacement of K (perhaps due to Langmuir) - if (CS%LT_ENH_K_R16) then - Shape_Function = htot(i)/MLD_guess*(1.-htot(i)/MLD_guess)**2 - K_Enhancement = ( min( Max_K_Enhancement,1.+1./La ) - 1. ) - Kd_guess0 = Kd_guess0 * Shape_Function / Max_Shape_Function + !Positive buoyancy (decreases PE) + N2_dissipation = 1.+CS%N2_DISSIPATION_SCALE_POS endif - else - vstar = 0.0 ; Kd_guess0 = 0.0 - endif - Vstar_Used(k) = vstar ! Track vstar - Kddt_h_g0 = Kd_guess0*dt_h - if (CS%orig_PE_calc) then - call find_PE_chg_orig(Kddt_h_g0, h(i,k), hp_a(i), dTe_term, dSe_term, & - dT_km1_t2, dS_km1_t2, dT_to_dPE(i,k), dS_to_dPE(i,k), & - dT_to_dPE_a(i,k-1), dS_to_dPE_a(i,k-1), & - pres_Z(i,K), dT_to_dColHt(i,k), dS_to_dColHt(i,k), & - dT_to_dColHt_a(i,k-1), dS_to_dColHt_a(i,k-1), & - PE_chg=PE_chg_g0, dPEc_dKd=dPEa_dKd_g0, dPE_max=PE_chg_max, & - dPEc_dKd_0=dPEc_dKd_Kd0 ) - else - call find_PE_chg(0.0, Kddt_h_g0, hp_a(i), h(i,k), & + if ((PE_chg_g0 < 0.0) .or. ((vstar == 0.0) .and. (dPEc_dKd_Kd0 < 0.0))) then + ! This column is convectively unstable. + if (PE_chg_max <= 0.0) then + ! Does MKE_src need to be included in the calculation of vstar here? + TKE_here = mech_TKE(i) + CS%wstar_ustar_coef*(conv_PErel(i)-PE_chg_max) + if (TKE_here > 0.0) then + if (CS%wT_mode==0) then + vstar = CS%vstar_scale_fac * (I_dtrho*TKE_here)**C1_3 + elseif (CS%wT_mode==1) then + Surface_Scale = max(0.05,1.-htot(i)/MLD_guess) + vstar = cs%vstar_scale_fac * (CS%vstar_surf_fac*U_Star + & + (CS%wstar_ustar_coef*conv_PErel(i)*I_dtrho)**C1_3)* & + Surface_Scale + endif + hbs_here = GV%H_to_Z * min(hb_hs(i,K), MixLen_shape(K)) + Mixing_Length_Used(k) = max(CS%min_mix_len,((h_tt*hbs_here)*vstar) / & + ((CS%Ekman_scale_coef * absf(i)) * (h_tt*hbs_here) + vstar)) + if (.not.CS%Use_MLD_Iteration) then + ! Note again (as prev) that using Mixing_Length_Used here + ! instead of redoing the computation will change answers... + Kd(i,k) = vstar * CS%vonKar * ((h_tt*hbs_here)*vstar) / & + ((CS%Ekman_scale_coef * absf(i)) * (h_tt*hbs_here) + vstar) + else + Kd(i,k) = vstar * CS%vonKar * Mixing_Length_Used(k) + endif + ! Compute the local enhnacement of K (perhaps due to Langmuir) + if (CS%LT_ENH_K_R16) then + Shape_Function = htot(i)/MLD_guess*(1.-htot(i)/MLD_guess)**2 + K_Enhancement = ( min( Max_K_Enhancement,1.+1./La ) - 1. ) + Kd(i,k) = Kd(i,K) * Shape_Function / Max_Shape_Function + endif + else + vstar = 0.0 ; Kd(i,k) = 0.0 + endif + Vstar_Used(k) = vstar + + if (CS%orig_PE_calc) then + call find_PE_chg_orig(Kd(i,k)*dt_h, h(i,k), hp_a(i), dTe_term, dSe_term, & + dT_km1_t2, dS_km1_t2, dT_to_dPE(i,k), dS_to_dPE(i,k), & + dT_to_dPE_a(i,k-1), dS_to_dPE_a(i,k-1), & + pres_Z(i,K), dT_to_dColHt(i,k), dS_to_dColHt(i,k), & + dT_to_dColHt_a(i,k-1), dS_to_dColHt_a(i,k-1), & + PE_chg=dPE_conv) + else + call find_PE_chg(0.0, Kd(i,k)*dt_h, hp_a(i), h(i,k), & Th_a(k-1), Sh_a(k-1), Th_b(k), Sh_b(k), & dT_to_dPE_a(i,k-1), dS_to_dPE_a(i,k-1), dT_to_dPE(i,k), dS_to_dPE(i,k), & pres_Z(i,K), dT_to_dColHt_a(i,k-1), dS_to_dColHt_a(i,k-1), & dT_to_dColHt(i,k), dS_to_dColHt(i,k), & - PE_chg=PE_chg_g0, dPEc_dKd=dPEa_dKd_g0, dPE_max=PE_chg_max, & - dPEc_dKd_0=dPEc_dKd_Kd0 ) - endif - - MKE_src = dMKE_max*(1.0 - exp(-Kddt_h_g0 * MKE2_Hharm)) - - if (pe_chg_g0 > 0.0) then - !Negative buoyancy (increases PE) - N2_dissipation = 1.+CS%N2_DISSIPATION_SCALE_NEG - else - !Positive buoyancy (decreases PE) - N2_dissipation = 1.+CS%N2_DISSIPATION_SCALE_POS - endif - - if ((PE_chg_g0 < 0.0) .or. ((vstar == 0.0) .and. (dPEc_dKd_Kd0 < 0.0))) then - ! This column is convectively unstable. - if (PE_chg_max <= 0.0) then - ! Does MKE_src need to be included in the calculation of vstar here? - TKE_here = mech_TKE(i) + CS%wstar_ustar_coef*(conv_PErel(i)-PE_chg_max) - if (TKE_here > 0.0) then - if (CS%wT_mode==0) then - vstar = CS%vstar_scale_fac * (I_dtrho*TKE_here)**C1_3 - elseif (CS%wT_mode==1) then - Surface_Scale = max(0.05,1.-htot(i)/MLD_guess) - vstar = cs%vstar_scale_fac * (CS%vstar_surf_fac*U_Star + & - (CS%wstar_ustar_coef*conv_PErel(i)*I_dtrho)**C1_3)* & - Surface_Scale + PE_chg=dPE_conv) endif - hbs_here = GV%H_to_Z * min(hb_hs(i,K), MixLen_shape(K)) - Mixing_Length_Used(k) = max(CS%min_mix_len,((h_tt*hbs_here)*vstar) / & - ((CS%Ekman_scale_coef * absf(i)) * (h_tt*hbs_here) + vstar)) - if (.not.CS%Use_MLD_Iteration) then - ! Note again (as prev) that using Mixing_Length_Used here - ! instead of redoing the computation will change answers... - Kd(i,k) = vstar * CS%vonKar * ((h_tt*hbs_here)*vstar) / & - ((CS%Ekman_scale_coef * absf(i)) * (h_tt*hbs_here) + vstar) + ! Should this be iterated to convergence for Kd? + if (dPE_conv > 0.0) then + Kd(i,k) = Kd_guess0 ; dPE_conv = PE_chg_g0 else - Kd(i,k) = vstar * CS%vonKar * Mixing_Length_Used(k) - endif - ! Compute the local enhnacement of K (perhaps due to Langmuir) - if (CS%LT_ENH_K_R16) then - Shape_Function = htot(i)/MLD_guess*(1.-htot(i)/MLD_guess)**2 - K_Enhancement = ( min( Max_K_Enhancement,1.+1./La ) - 1. ) - Kd(i,k) = Kd(i,K) * Shape_Function / Max_Shape_Function + MKE_src = dMKE_max*(1.0 - exp(-(Kd(i,k)*dt_h) * MKE2_Hharm)) endif else - vstar = 0.0 ; Kd(i,k) = 0.0 + ! The energy change does not vary monotonically with Kddt_h. Find the maximum? + Kd(i,k) = Kd_guess0 ; dPE_conv = PE_chg_g0 endif - Vstar_Used(k) = vstar - - if (CS%orig_PE_calc) then - call find_PE_chg_orig(Kd(i,k)*dt_h, h(i,k), hp_a(i), dTe_term, dSe_term, & - dT_km1_t2, dS_km1_t2, dT_to_dPE(i,k), dS_to_dPE(i,k), & - dT_to_dPE_a(i,k-1), dS_to_dPE_a(i,k-1), & - pres_Z(i,K), dT_to_dColHt(i,k), dS_to_dColHt(i,k), & - dT_to_dColHt_a(i,k-1), dS_to_dColHt_a(i,k-1), & - PE_chg=dPE_conv) - else - call find_PE_chg(0.0, Kd(i,k)*dt_h, hp_a(i), h(i,k), & - Th_a(k-1), Sh_a(k-1), Th_b(k), Sh_b(k), & - dT_to_dPE_a(i,k-1), dS_to_dPE_a(i,k-1), dT_to_dPE(i,k), dS_to_dPE(i,k), & - pres_Z(i,K), dT_to_dColHt_a(i,k-1), dS_to_dColHt_a(i,k-1), & - dT_to_dColHt(i,k), dS_to_dColHt(i,k), & - PE_chg=dPE_conv) + + conv_PErel(i) = conv_PErel(i) - dPE_conv + mech_TKE(i) = mech_TKE(i) + MKE_src + if (CS%TKE_diagnostics) then + dTKE_conv = dTKE_conv - CS%nstar*dPE_conv * IdtdR0 + dTKE_MKE = dTKE_MKE + MKE_src * IdtdR0 endif - ! Should this be iterated to convergence for Kd? - if (dPE_conv > 0.0) then - Kd(i,k) = Kd_guess0 ; dPE_conv = PE_chg_g0 - else - MKE_src = dMKE_max*(1.0 - exp(-(Kd(i,k)*dt_h) * MKE2_Hharm)) + if (sfc_connected(i)) then + CS%ML_depth(i,J) = CS%ML_depth(i,J) + GV%H_to_Z * h(i,k) + ! CS%ML_depth2(i,j) = CS%ML_depth2(i,J) + GV%H_to_Z * h(i,k) endif - else - ! The energy change does not vary monotonically with Kddt_h. Find the maximum? - Kd(i,k) = Kd_guess0 ; dPE_conv = PE_chg_g0 - endif - conv_PErel(i) = conv_PErel(i) - dPE_conv - mech_TKE(i) = mech_TKE(i) + MKE_src - if (CS%TKE_diagnostics) then - dTKE_conv = dTKE_conv - CS%nstar*dPE_conv * IdtdR0 - dTKE_MKE = dTKE_MKE + MKE_src * IdtdR0 - endif - if (sfc_connected(i)) then - CS%ML_depth(i,J) = CS%ML_depth(i,J) + GV%H_to_Z * h(i,k) - ! CS%ML_depth2(i,j) = CS%ML_depth2(i,J) + GV%H_to_Z * h(i,k) - endif - Kddt_h(K) = Kd(i,k)*dt_h - elseif (tot_TKE + (MKE_src - N2_DISSIPATION*PE_chg_g0) >= 0.0) then - ! There is energy to support the suggested mixing. Keep that estimate. - Kd(i,k) = Kd_guess0 - Kddt_h(K) = Kddt_h_g0 + Kddt_h(K) = Kd(i,k)*dt_h + elseif (tot_TKE + (MKE_src - N2_DISSIPATION*PE_chg_g0) >= 0.0) then + ! There is energy to support the suggested mixing. Keep that estimate. + Kd(i,k) = Kd_guess0 + Kddt_h(K) = Kddt_h_g0 - ! Reduce the mechanical and convective TKE proportionately. - tot_TKE = tot_TKE + MKE_src - TKE_reduc = 0.0 ! tot_TKE could be 0 if Convectively_stable is false. - if (tot_TKE > 0.0) TKE_reduc = (tot_TKE - N2_DISSIPATION*PE_chg_g0) & + ! Reduce the mechanical and convective TKE proportionately. + tot_TKE = tot_TKE + MKE_src + TKE_reduc = 0.0 ! tot_TKE could be 0 if Convectively_stable is false. + if (tot_TKE > 0.0) TKE_reduc = (tot_TKE - N2_DISSIPATION*PE_chg_g0) & / tot_TKE - if (CS%TKE_diagnostics) then - dTKE_mixing = dTKE_mixing - PE_chg_g0 * IdtdR0 - dTKE_MKE = dTKE_MKE + MKE_src * IdtdR0 - dTKE_conv_decay = dTKE_conv_decay + & - (1.0-TKE_reduc)*(CS%nstar-nstar_FC) * conv_PErel(i) * IdtdR0 - endif - tot_TKE = TKE_reduc*tot_TKE - mech_TKE(i) = TKE_reduc*(mech_TKE(i) + MKE_src) - conv_PErel(i) = TKE_reduc*conv_PErel(i) - if (sfc_connected(i)) then - CS%ML_depth(i,J) = CS%ML_depth(i,J) + GV%H_to_Z * h(i,k) - ! CS%ML_depth2(i,J) = CS%ML_depth2(i,J) + GV%H_to_Z * h(i,k) - endif - elseif (tot_TKE == 0.0) then - ! This can arise if nstar_FC = 0. - Kd(i,k) = 0.0 ; Kddt_h(K) = 0.0 - tot_TKE = 0.0 ; conv_PErel(i) = 0.0 ; mech_TKE(i) = 0.0 - sfc_disconnect = .true. - else - ! There is not enough energy to support the mixing, so reduce the - ! diffusivity to what can be supported. - Kddt_h_max = Kddt_h_g0 ; Kddt_h_min = 0.0 - TKE_left_max = tot_TKE + (MKE_src - N2_DISSIPATION*PE_chg_g0) - TKE_left_min = tot_TKE - - ! As a starting guess, take the minimum of a false position estimate - ! and a Newton's method estimate starting from Kddt_h = 0.0. - Kddt_h_guess = tot_TKE * Kddt_h_max / max( N2_DISSIPATION*PE_chg_g0 & - - MKE_src, Kddt_h_max * (dPEc_dKd_Kd0 - dMKE_max * & - MKE2_Hharm) ) - ! The above expression is mathematically the same as the following - ! except it is not susceptible to division by zero when - ! dPEc_dKd_Kd0 = dMKE_max = 0 . - ! Kddt_h_guess = tot_TKE * min( Kddt_h_max / (PE_chg_g0 - MKE_src), & - ! 1.0 / (dPEc_dKd_Kd0 - dMKE_max * MKE2_Hharm) ) - if (debug) then - TKE_left_itt(:) = 0.0 ; dPEa_dKd_itt(:) = 0.0 ; PE_chg_itt(:) = 0.0 - MKE_src_itt(:) = 0.0 ; Kddt_h_itt(:) = 0.0 - endif - do itt=1,max_itt - if (CS%orig_PE_calc) then - call find_PE_chg_orig(Kddt_h_guess, h(i,k), hp_a(i), dTe_term, dSe_term, & - dT_km1_t2, dS_km1_t2, dT_to_dPE(i,k), dS_to_dPE(i,k), & - dT_to_dPE_a(i,k-1), dS_to_dPE_a(i,k-1), & - pres_Z(i,K), dT_to_dColHt(i,k), dS_to_dColHt(i,k), & - dT_to_dColHt_a(i,k-1), dS_to_dColHt_a(i,k-1), & - PE_chg=PE_chg, dPEc_dKd=dPEc_dKd ) - else - call find_PE_chg(0.0, Kddt_h_guess, hp_a(i), h(i,k), & - Th_a(k-1), Sh_a(k-1), Th_b(k), Sh_b(k), & - dT_to_dPE_a(i,k-1), dS_to_dPE_a(i,k-1), dT_to_dPE(i,k), dS_to_dPE(i,k), & - pres_Z(i,K), dT_to_dColHt_a(i,k-1), dS_to_dColHt_a(i,k-1), & - dT_to_dColHt(i,k), dS_to_dColHt(i,k), & - PE_chg=dPE_conv) + if (CS%TKE_diagnostics) then + dTKE_mixing = dTKE_mixing - PE_chg_g0 * IdtdR0 + dTKE_MKE = dTKE_MKE + MKE_src * IdtdR0 + dTKE_conv_decay = dTKE_conv_decay + & + (1.0-TKE_reduc)*(CS%nstar-nstar_FC) * conv_PErel(i) * IdtdR0 + endif + tot_TKE = TKE_reduc*tot_TKE + mech_TKE(i) = TKE_reduc*(mech_TKE(i) + MKE_src) + conv_PErel(i) = TKE_reduc*conv_PErel(i) + if (sfc_connected(i)) then + CS%ML_depth(i,J) = CS%ML_depth(i,J) + GV%H_to_Z * h(i,k) endif - MKE_src = dMKE_max * (1.0 - exp(-MKE2_Hharm * Kddt_h_guess)) - dMKE_src_dK = dMKE_max * MKE2_Hharm * exp(-MKE2_Hharm * Kddt_h_guess) - TKE_left = tot_TKE + (MKE_src - N2_DISSIPATION*PE_chg) + elseif (tot_TKE == 0.0) then + ! This can arise if nstar_FC = 0. + Kd(i,k) = 0.0 ; Kddt_h(K) = 0.0 + tot_TKE = 0.0 ; conv_PErel(i) = 0.0 ; mech_TKE(i) = 0.0 + sfc_disconnect = .true. + else + ! There is not enough energy to support the mixing, so reduce the + ! diffusivity to what can be supported. + Kddt_h_max = Kddt_h_g0 ; Kddt_h_min = 0.0 + TKE_left_max = tot_TKE + (MKE_src - N2_DISSIPATION*PE_chg_g0) + TKE_left_min = tot_TKE + + ! As a starting guess, take the minimum of a false position estimate + ! and a Newton's method estimate starting from Kddt_h = 0.0. + Kddt_h_guess = tot_TKE * Kddt_h_max / max( N2_DISSIPATION*PE_chg_g0 & + - MKE_src, Kddt_h_max * (dPEc_dKd_Kd0 - dMKE_max * & + MKE2_Hharm) ) + ! The above expression is mathematically the same as the following + ! except it is not susceptible to division by zero when + ! dPEc_dKd_Kd0 = dMKE_max = 0 . + ! Kddt_h_guess = tot_TKE * min( Kddt_h_max / (PE_chg_g0 - MKE_src), & + ! 1.0 / (dPEc_dKd_Kd0 - dMKE_max * MKE2_Hharm) ) if (debug) then - Kddt_h_itt(itt) = Kddt_h_guess ; MKE_src_itt(itt) = MKE_src - PE_chg_itt(itt) = N2_DISSIPATION*PE_chg - TKE_left_itt(itt) = TKE_left - dPEa_dKd_itt(itt) = dPEc_dKd - endif - ! Store the new bounding values, bearing in mind that min and max - ! here refer to Kddt_h and dTKE_left/dKddt_h < 0: - if (TKE_left >= 0.0) then - Kddt_h_min = Kddt_h_guess ; TKE_left_min = TKE_left - else - Kddt_h_max = Kddt_h_guess ; TKE_left_max = TKE_left + TKE_left_itt(:) = 0.0 ; dPEa_dKd_itt(:) = 0.0 ; PE_chg_itt(:) = 0.0 + MKE_src_itt(:) = 0.0 ; Kddt_h_itt(:) = 0.0 endif + do itt=1,max_itt + if (CS%orig_PE_calc) then + call find_PE_chg_orig(Kddt_h_guess, h(i,k), hp_a(i), dTe_term, dSe_term, & + dT_km1_t2, dS_km1_t2, dT_to_dPE(i,k), dS_to_dPE(i,k), & + dT_to_dPE_a(i,k-1), dS_to_dPE_a(i,k-1), & + pres_Z(i,K), dT_to_dColHt(i,k), dS_to_dColHt(i,k), & + dT_to_dColHt_a(i,k-1), dS_to_dColHt_a(i,k-1), & + PE_chg=PE_chg, dPEc_dKd=dPEc_dKd ) + else + call find_PE_chg(0.0, Kddt_h_guess, hp_a(i), h(i,k), & + Th_a(k-1), Sh_a(k-1), Th_b(k), Sh_b(k), & + dT_to_dPE_a(i,k-1), dS_to_dPE_a(i,k-1), dT_to_dPE(i,k), dS_to_dPE(i,k), & + pres_Z(i,K), dT_to_dColHt_a(i,k-1), dS_to_dColHt_a(i,k-1), & + dT_to_dColHt(i,k), dS_to_dColHt(i,k), & + PE_chg=dPE_conv) + endif + MKE_src = dMKE_max * (1.0 - exp(-MKE2_Hharm * Kddt_h_guess)) + dMKE_src_dK = dMKE_max * MKE2_Hharm * exp(-MKE2_Hharm * Kddt_h_guess) + + TKE_left = tot_TKE + (MKE_src - N2_DISSIPATION*PE_chg) + if (debug) then + Kddt_h_itt(itt) = Kddt_h_guess ; MKE_src_itt(itt) = MKE_src + PE_chg_itt(itt) = N2_DISSIPATION*PE_chg + TKE_left_itt(itt) = TKE_left + dPEa_dKd_itt(itt) = dPEc_dKd + endif + ! Store the new bounding values, bearing in mind that min and max + ! here refer to Kddt_h and dTKE_left/dKddt_h < 0: + if (TKE_left >= 0.0) then + Kddt_h_min = Kddt_h_guess ; TKE_left_min = TKE_left + else + Kddt_h_max = Kddt_h_guess ; TKE_left_max = TKE_left + endif - ! Try to use Newton's method, but if it would go outside the bracketed - ! values use the false-position method instead. - use_Newt = .true. - if (dPEc_dKd*N2_DISSIPATION - dMKE_src_dK <= 0.0) then - use_Newt = .false. - else - dKddt_h_Newt = TKE_left / (dPEc_dKd*N2_DISSIPATION - dMKE_src_dK) - Kddt_h_Newt = Kddt_h_guess + dKddt_h_Newt - if ((Kddt_h_Newt > Kddt_h_max) .or. (Kddt_h_Newt < Kddt_h_min)) & + ! Try to use Newton's method, but if it would go outside the bracketed + ! values use the false-position method instead. + use_Newt = .true. + if (dPEc_dKd*N2_DISSIPATION - dMKE_src_dK <= 0.0) then use_Newt = .false. - endif + else + dKddt_h_Newt = TKE_left / (dPEc_dKd*N2_DISSIPATION - dMKE_src_dK) + Kddt_h_Newt = Kddt_h_guess + dKddt_h_Newt + if ((Kddt_h_Newt > Kddt_h_max) .or. (Kddt_h_Newt < Kddt_h_min)) & + use_Newt = .false. + endif - if (use_Newt) then - Kddt_h_next = Kddt_h_guess + dKddt_h_Newt - dKddt_h = dKddt_h_Newt - else - Kddt_h_next = (TKE_left_max * Kddt_h_min - Kddt_h_max * TKE_left_min) / & - (TKE_left_max - TKE_left_min) - dKddt_h = Kddt_h_next - Kddt_h_guess - endif + if (use_Newt) then + Kddt_h_next = Kddt_h_guess + dKddt_h_Newt + dKddt_h = dKddt_h_Newt + else + Kddt_h_next = (TKE_left_max * Kddt_h_min - Kddt_h_max * TKE_left_min) / & + (TKE_left_max - TKE_left_min) + dKddt_h = Kddt_h_next - Kddt_h_guess + endif - if ((abs(dKddt_h) < 1e-9*Kddt_h_guess) .or. (itt==max_itt)) then - ! Use the old value so that the energy calculation does not need to be repeated. - if (debug) num_itts(K) = itt - exit - else - Kddt_h_guess = Kddt_h_next + if ((abs(dKddt_h) < 1e-9*Kddt_h_guess) .or. (itt==max_itt)) then + ! Use the old value so that the energy calculation does not need to be repeated. + if (debug) num_itts(K) = itt + exit + else + Kddt_h_guess = Kddt_h_next + endif + enddo + Kd(i,K) = Kddt_h_guess / dt_h ; Kddt_h(K) = Kd(i,K)*dt_h + + ! All TKE should have been consumed. + if (CS%TKE_diagnostics) then + dTKE_mixing = dTKE_mixing - (tot_TKE + MKE_src) * IdtdR0 + dTKE_MKE = dTKE_MKE + MKE_src * IdtdR0 + dTKE_conv_decay = dTKE_conv_decay + & + (CS%nstar-nstar_FC) * conv_PErel(i) * IdtdR0 endif - enddo - Kd(i,K) = Kddt_h_guess / dt_h ; Kddt_h(K) = Kd(i,K)*dt_h - - ! All TKE should have been consumed. - if (CS%TKE_diagnostics) then - dTKE_mixing = dTKE_mixing - (tot_TKE + MKE_src) * IdtdR0 - dTKE_MKE = dTKE_MKE + MKE_src * IdtdR0 - dTKE_conv_decay = dTKE_conv_decay + & - (CS%nstar-nstar_FC) * conv_PErel(i) * IdtdR0 + + if (sfc_connected(i)) CS%ML_depth(i,J) = CS%ML_depth(i,J) + & + (PE_chg / PE_chg_g0) * GV%H_to_Z * h(i,k) + + tot_TKE = 0.0 ; mech_TKE(i) = 0.0 ; conv_PErel(i) = 0.0 + sfc_disconnect = .true. endif - if (sfc_connected(i)) CS%ML_depth(i,J) = CS%ML_depth(i,J) + & - (PE_chg / PE_chg_g0) * GV%H_to_Z * h(i,k) - tot_TKE = 0.0 ; mech_TKE(i) = 0.0 ; conv_PErel(i) = 0.0 - sfc_disconnect = .true. + Kddt_h(K) = Kd(i,K)*dt_h + ! At this point, the final value of Kddt_h(K) is known, so the + ! estimated properties for layer k-1 can be calculated. + b1 = 1.0 / (hp_a(i) + Kddt_h(K)) + c1(K) = Kddt_h(K) * b1 + if (CS%orig_PE_calc) then + dTe(k-1) = b1 * ( Kddt_h(K)*(T0(k)-T0(k-1)) + dTe_t2 ) + dSe(k-1) = b1 * ( Kddt_h(K)*(S0(k)-S0(k-1)) + dSe_t2 ) + endif + + hp_a(i) = h(i,k) + (hp_a(i) * b1) * Kddt_h(K) + dT_to_dPE_a(i,k) = dT_to_dPE(i,k) + c1(K)*dT_to_dPE_a(i,k-1) + dS_to_dPE_a(i,k) = dS_to_dPE(i,k) + c1(K)*dS_to_dPE_a(i,k-1) + dT_to_dColHt_a(i,k) = dT_to_dColHt(i,k) + c1(K)*dT_to_dColHt_a(i,k-1) + dS_to_dColHt_a(i,k) = dS_to_dColHt(i,k) + c1(K)*dS_to_dColHt_a(i,k-1) + + endif ! tot_TKT > 0.0 branch. Kddt_h(K) has been set. + + ! Store integrated velocities and thicknesses for MKE conversion calculations. + if (sfc_disconnect) then + ! There is no turbulence at this interface, so zero out the running sums. + uhtot(i) = u(i,k)*h(i,k) + vhtot(i) = v(i,k)*h(i,k) + htot(i) = h(i,k) + sfc_connected(i) = .false. + else + uhtot(i) = uhtot(i) + u(i,k)*h(i,k) + vhtot(i) = vhtot(i) + v(i,k)*h(i,k) + htot(i) = htot(i) + h(i,k) endif - Kddt_h(K) = Kd(i,K)*dt_h - ! At this point, the final value of Kddt_h(K) is known, so the - ! estimated properties for layer k-1 can be calculated. - b1 = 1.0 / (hp_a(i) + Kddt_h(K)) - c1(K) = Kddt_h(K) * b1 - if (CS%orig_PE_calc) then - dTe(k-1) = b1 * ( Kddt_h(K)*(T0(k)-T0(k-1)) + dTe_t2 ) - dSe(k-1) = b1 * ( Kddt_h(K)*(S0(k)-S0(k-1)) + dSe_t2 ) + if (debug) then + if (k==2) then + Te(1) = b1*(h(i,1)*T0(1)) + Se(1) = b1*(h(i,1)*S0(1)) + else + Te(k-1) = b1 * (h(i,k-1) * T0(k-1) + Kddt_h(K-1) * Te(k-2)) + Se(k-1) = b1 * (h(i,k-1) * S0(k-1) + Kddt_h(K-1) * Se(k-2)) + endif endif + enddo + Kd(i,nz+1) = 0.0 - hp_a(i) = h(i,k) + (hp_a(i) * b1) * Kddt_h(K) - dT_to_dPE_a(i,k) = dT_to_dPE(i,k) + c1(K)*dT_to_dPE_a(i,k-1) - dS_to_dPE_a(i,k) = dS_to_dPE(i,k) + c1(K)*dS_to_dPE_a(i,k-1) - dT_to_dColHt_a(i,k) = dT_to_dColHt(i,k) + c1(K)*dT_to_dColHt_a(i,k-1) - dS_to_dColHt_a(i,k) = dS_to_dColHt(i,k) + c1(K)*dS_to_dColHt_a(i,k-1) - - endif ! tot_TKT > 0.0 branch. Kddt_h(K) has been set. - - ! Store integrated velocities and thicknesses for MKE conversion calculations. - if (sfc_disconnect) then - ! There is no turbulence at this interface, so zero out the running sums. - uhtot(i) = u(i,k)*h(i,k) - vhtot(i) = v(i,k)*h(i,k) - htot(i) = h(i,k) - sfc_connected(i) = .false. - else - uhtot(i) = uhtot(i) + u(i,k)*h(i,k) - vhtot(i) = vhtot(i) + v(i,k)*h(i,k) - htot(i) = htot(i) + h(i,k) + if (debug) then + ! Complete the tridiagonal solve for Te. + b1 = 1.0 / hp_a(i) + Te(nz) = b1 * (h(i,nz) * T0(nz) + Kddt_h(nz) * Te(nz-1)) + Se(nz) = b1 * (h(i,nz) * S0(nz) + Kddt_h(nz) * Se(nz-1)) + do k=nz-1,1,-1 + Te(k) = Te(k) + c1(K+1)*Te(k+1) + Se(k) = Se(k) + c1(K+1)*Se(k+1) + enddo + endif + if (present(dT_expected)) then + do k=1,nz + dT_expected(i,j,k) = Te(k) - T0(k) + enddo + endif + if (present(dS_expected)) then + do k=1,nz + dS_expected(i,j,k) = Se(k) - S0(k) + enddo endif - if (debug) then - if (k==2) then - Te(1) = b1*(h(i,1)*T0(1)) - Se(1) = b1*(h(i,1)*S0(1)) - else - Te(k-1) = b1 * (h(i,k-1) * T0(k-1) + Kddt_h(K-1) * Te(k-2)) - Se(k-1) = b1 * (h(i,k-1) * S0(k-1) + Kddt_h(K-1) * Se(k-2)) - endif + dPE_debug = 0.0 + do k=1,nz + dPE_debug = dPE_debug + (dT_to_dPE(i,k) * (Te(k) - T0(k)) + & + dS_to_dPE(i,k) * (Se(k) - S0(k))) + enddo + mixing_debug = dPE_debug * IdtdR0 endif - enddo - Kd(i,nz+1) = 0.0 - - if (debug) then - ! Complete the tridiagonal solve for Te. - b1 = 1.0 / hp_a(i) - Te(nz) = b1 * (h(i,nz) * T0(nz) + Kddt_h(nz) * Te(nz-1)) - Se(nz) = b1 * (h(i,nz) * S0(nz) + Kddt_h(nz) * Se(nz-1)) - do k=nz-1,1,-1 - Te(k) = Te(k) + c1(K+1)*Te(k+1) - Se(k) = Se(k) + c1(K+1)*Se(k+1) - enddo - endif - if (present(dT_expected)) then - do k=1,nz ; dT_expected(i,j,k) = Te(k) - T0(k) ; enddo - endif - if (present(dS_expected)) then - do k=1,nz ; dS_expected(i,j,k) = Se(k) - S0(k) ; enddo - endif - if (debug) then - dPE_debug = 0.0 - do k=1,nz - dPE_debug = dPE_debug + (dT_to_dPE(i,k) * (Te(k) - T0(k)) + & - dS_to_dPE(i,k) * (Se(k) - S0(k))) - enddo - mixing_debug = dPE_debug * IdtdR0 - endif - k = nz ! This is here to allow a breakpoint to be set. - !/BGR - ! The following lines are used for the iteration - ! note the iteration has been altered to use the value predicted by - ! the TKE threshold (ML_DEPTH). This is because the MSTAR - ! is now dependent on the ML, and therefore the ML needs to be estimated - ! more precisely than the grid spacing. - !/ - ITmax(obl_it) = max_MLD ! Track max } - ITmin(obl_it) = min_MLD ! Track min } For debug purpose - ITguess(obl_it) = MLD_guess ! Track guess } - !/ - MLD_found = 0.0 ; FIRST_OBL = .true. - if (CS%Orig_MLD_iteration) then - !This is how the iteration was original conducted - do k=2,nz - if (FIRST_OBL) then !Breaks when OBL found - if ((Vstar_Used(k) > 1.e-10*US%m_to_Z) .and. k < nz) then - MLD_found = MLD_found + h(i,k-1)*GV%H_to_Z - else - FIRST_OBL = .false. - if (MLD_found - CS%MLD_tol > MLD_guess) then - min_MLD = MLD_guess - elseif ((MLD_guess - MLD_found) < max(CS%MLD_tol,h(i,k-1)*GV%H_to_Z)) then - OBL_CONVERGED = .true.!Break convergence loop - if (OBL_IT_STATS) then !Compute iteration statistics - MAXIT = max(MAXIT,obl_it) - MINIT = min(MINIT,obl_it) - SUMIT = SUMIT+obl_it - NUMIT = NUMIT+1 - print*,MAXIT,MINIT,SUMIT/NUMIT - endif - CS%ML_Depth2(i,j) = MLD_guess + k = nz ! This is here to allow a breakpoint to be set. + !/BGR + ! The following lines are used for the iteration + ! note the iteration has been altered to use the value predicted by + ! the TKE threshold (ML_DEPTH). This is because the MSTAR + ! is now dependent on the ML, and therefore the ML needs to be estimated + ! more precisely than the grid spacing. + !/ + ITmax(obl_it) = max_MLD ! Track max } + ITmin(obl_it) = min_MLD ! Track min } For debug purpose + ITguess(obl_it) = MLD_guess ! Track guess } + !/ + MLD_found = 0.0 ; FIRST_OBL = .true. + if (CS%Orig_MLD_iteration) then + !This is how the iteration was original conducted + do k=2,nz + if (FIRST_OBL) then !Breaks when OBL found + if ((Vstar_Used(k) > 1.e-10*US%m_to_Z) .and. k < nz) then + MLD_found = MLD_found + h(i,k-1)*GV%H_to_Z else - max_MLD = MLD_guess !We know this guess was too deep + FIRST_OBL = .false. + if (MLD_found - CS%MLD_tol > MLD_guess) then + min_MLD = MLD_guess + elseif ((MLD_guess - MLD_found) < max(CS%MLD_tol,h(i,k-1)*GV%H_to_Z)) then + OBL_CONVERGED = .true.!Break convergence loop + if (OBL_IT_STATS) then !Compute iteration statistics + MAXIT = max(MAXIT,obl_it) + MINIT = min(MINIT,obl_it) + SUMIT = SUMIT+obl_it + NUMIT = NUMIT+1 + print*,MAXIT,MINIT,SUMIT/NUMIT + endif + CS%ML_Depth2(i,j) = MLD_guess + else + max_MLD = MLD_guess !We know this guess was too deep + endif endif endif - endif - enddo - else - !New method uses ML_DEPTH as computed in ePBL routine - MLD_found = CS%ML_Depth(i,j) - if (MLD_found - CS%MLD_tol > MLD_guess) then - min_MLD = MLD_guess - elseif (abs(MLD_guess - MLD_found) < CS%MLD_tol) then - OBL_CONVERGED = .true.!Break convergence loop - if (OBL_IT_STATS) then !Compute iteration statistics - MAXIT = max(MAXIT,obl_it) - MINIT = min(MINIT,obl_it) - SUMIT = SUMIT+obl_it - NUMIT = NUMIT+1 - print*,MAXIT,MINIT,SUMIT/NUMIT - endif - CS%ML_Depth2(i,j) = MLD_guess + enddo else - max_MLD = MLD_guess !We know this guess was too deep + !New method uses ML_DEPTH as computed in ePBL routine + MLD_found = CS%ML_Depth(i,j) + if (MLD_found - CS%MLD_tol > MLD_guess) then + min_MLD = MLD_guess + elseif (abs(MLD_guess - MLD_found) < CS%MLD_tol) then + OBL_CONVERGED = .true.!Break convergence loop + if (OBL_IT_STATS) then !Compute iteration statistics + MAXIT = max(MAXIT,obl_it) + MINIT = min(MINIT,obl_it) + SUMIT = SUMIT+obl_it + NUMIT = NUMIT+1 + print*,MAXIT,MINIT,SUMIT/NUMIT + endif + CS%ML_Depth2(i,j) = MLD_guess + else + max_MLD = MLD_guess !We know this guess was too deep + endif endif + ! For next pass, guess average of minimum and maximum values. + MLD_guess = 0.5*(min_MLD + max_MLD) + ITresult(obl_it) = MLD_found endif - ! For next pass, guess average of minimum and maximum values. - MLD_guess = 0.5*(min_MLD + max_MLD) - ITresult(obl_it) = MLD_found - endif ; enddo ! Iteration loop for converged boundary layer thickness. + enddo ! Iteration loop for converged boundary layer thickness. if (.not.OBL_CONVERGED) then NOTCONVERGED=NOTCONVERGED+1 else @@ -1792,7 +1827,7 @@ subroutine find_PE_chg_orig(Kddt_h, h_k, b_den_1, dTe_term, dSe_term, & end subroutine find_PE_chg_orig -!> Finds mstar for ePBL +!> !> This subroutine finds the Mstar value for ePBL subroutine Find_Mstar(CS,US, Buoyancy_Flux, UStar, UStar_Mean,& BLD, Abs_Coriolis, MStar, Langmuir_Number,& MStar_LT, Enhance_MStar, Convect_Langmuir_Number) @@ -1814,11 +1849,11 @@ subroutine Find_Mstar(CS,US, Buoyancy_Flux, UStar, UStar_Mean,& Mstar !< Ouput mstar (Mixing/ustar**3) real, optional, intent(in) ::& Langmuir_Number !Langmuir number - real, optional, intent(out) ::& + real, optional, intent(out) ::& MStar_LT !< Additive mstar increase due to Langmuir turbulence - real, optional, intent(out) ::& + real, optional, intent(out) ::& Enhance_MStar !< Multiplicative mstar increase due to Langmuir turbulence - real, optional, intent(out) ::& + real, optional, intent(out) ::& Convect_Langmuir_number !< Langmuir number including buoyancy flux !/ Variables used in computing mstar @@ -1840,7 +1875,7 @@ subroutine Find_Mstar(CS,US, Buoyancy_Flux, UStar, UStar_Mean,& !real :: C_MO = 1. ! Constant in Stab_Scale for Monin-Obukhov !real :: C_EK = 2. ! Constant in Stab_Scale for Ekman length !delete This subroutine modifies the Mstar value if the Langmuir number is present subroutine Mstar_Langmuir(CS,US,abs_Coriolis,buoyancy_flux,ustar,BLD,Langmuir_Number,& mstar,enhance_mstar,mstar_lt, Convect_Langmuir_Number) type(energetic_PBL_CS), pointer :: CS !< Energetic_PBL control structure. From a84c0e034a75377b812b60ab4a0fe73bbc3b0dd7 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 4 Jun 2019 18:09:02 -0400 Subject: [PATCH 04/82] +Obsoleted USE_VISBECK_SLOPE_BUG Obsoleted the runtime parameter USE_VISBECK_SLOPE_BUG, which is no longer in use by any active experiments. This has been added to the list of obsolete parameters in MOM_obsolete_params, and any attempt to use this parameter will result in a fatal error. Also added units to the get_param call for KD_SMOOTH. All answers are bitwise identical in the MOM6-examples test cases, but there are minor changes to some MOM_parameter_doc files. --- src/diagnostics/MOM_obsolete_params.F90 | 1 + .../lateral/MOM_lateral_mixing_coeffs.F90 | 73 ++++++------------- 2 files changed, 22 insertions(+), 52 deletions(-) diff --git a/src/diagnostics/MOM_obsolete_params.F90 b/src/diagnostics/MOM_obsolete_params.F90 index 797db75240..d032d25514 100644 --- a/src/diagnostics/MOM_obsolete_params.F90 +++ b/src/diagnostics/MOM_obsolete_params.F90 @@ -200,6 +200,7 @@ subroutine find_obsolete_params(param_file) call obsolete_int(param_file, "SEAMOUNT_LENGTH_SCALE", hint="Use SEAMOUNT_X_LENGTH_SCALE instead.") call obsolete_logical(param_file, "MSTAR_FIXED", hint="Instead use MSTAR_MODE.") + call obsolete_logical(param_file, "USE_VISBECK_SLOPE_BUG", .false.) call obsolete_real(param_file, "MIN_Z_DIAG_INTERVAL") call obsolete_char(param_file, "Z_OUTPUT_GRID_FILE") diff --git a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 index 2a855f4416..f0b051b9f9 100644 --- a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 +++ b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 @@ -41,11 +41,6 @@ module MOM_lateral_mixing_coeffs !! of first baroclinic wave for calculating the resolution fn. logical :: khth_use_ebt_struct !< If true, uses the equivalent barotropic structure !! as the vertical structure of thickness diffusivity. - logical :: use_Visbeck_slope_bug !< If true, then retain a legacy bug in the calculation of weights - !! applied to isoneutral slopes. There was an erroneous k-indexing - !! for layer thicknesses. In addition, masking at coastlines was not - !! used which introduced potential restart issues. This flag will be - !! deprecated in a future release. logical :: calculate_cg1 !< If true, calls wave_speed() to calculate the first !! baroclinic wave speed and populate CS%cg1. !! This parameter is set depending on other parameters. @@ -475,26 +470,16 @@ subroutine calc_Visbeck_coeffs(h, slope_x, slope_y, N2_u, N2_v, G, GV, CS) H_geom = sqrt( Hdn * Hup ) !H_geom = H_geom * sqrt(N2) ! WKB-ish !H_geom = H_geom * N2 ! WKB-ish - if (CS%use_Visbeck_slope_bug) then - wSE = h(i+1,j,k)*h(i+1,j-1,k) * h(i+1,j,k)*h(i+1,j-1,k-1) - wNW = h(i ,j,k)*h(i ,j+1,k) * h(i ,j,k)*h(i ,j+1,k-1) - wNE = h(i+1,j,k)*h(i+1,j+1,k) * h(i+1,j,k)*h(i+1,j+1,k-1) - wSW = h(i ,j,k)*h(i ,j-1,k) * h(i ,j,k)*h(i ,j-1,k-1) - S2 = slope_x(I,j,K)**2 + ( & - (wNW*slope_y(i,J,K)**2+wSE*slope_y(i+1,J-1,K)**2) & - +(wNE*slope_y(i+1,J,K)**2+wSW*slope_y(i,J-1,K)**2) ) / & - ( ((wSE+wNW) + (wNE+wSW)) + GV%H_subroundoff**2 ) !### This should be **4 for consistent units. - else - wSE = G%mask2dCv(i+1,J-1) * ( (h(i+1,j,k)*h(i+1,j-1,k)) * (h(i+1,j,k-1)*h(i+1,j-1,k-1)) ) - wNW = G%mask2dCv(i ,J ) * ( (h(i ,j,k)*h(i ,j+1,k)) * (h(i ,j,k-1)*h(i ,j+1,k-1)) ) - wNE = G%mask2dCv(i+1,J ) * ( (h(i+1,j,k)*h(i+1,j+1,k)) * (h(i+1,j,k-1)*h(i+1,j+1,k-1)) ) - wSW = G%mask2dCv(i ,J-1) * ( (h(i ,j,k)*h(i ,j-1,k)) * (h(i ,j,k-1)*h(i ,j-1,k-1)) ) - S2 = slope_x(I,j,K)**2 + ( & - (wNW*slope_y(i,J,K)**2+wSE*slope_y(i+1,J-1,K)**2) & - +(wNE*slope_y(i+1,J,K)**2+wSW*slope_y(i,J-1,K)**2) ) / & - ( ((wSE+wNW) + (wNE+wSW)) + GV%H_subroundoff**4 ) - endif + wSE = G%mask2dCv(i+1,J-1) * ( (h(i+1,j,k)*h(i+1,j-1,k)) * (h(i+1,j,k-1)*h(i+1,j-1,k-1)) ) + wNW = G%mask2dCv(i ,J ) * ( (h(i ,j,k)*h(i ,j+1,k)) * (h(i ,j,k-1)*h(i ,j+1,k-1)) ) + wNE = G%mask2dCv(i+1,J ) * ( (h(i+1,j,k)*h(i+1,j+1,k)) * (h(i+1,j,k-1)*h(i+1,j+1,k-1)) ) + wSW = G%mask2dCv(i ,J-1) * ( (h(i ,j,k)*h(i ,j-1,k)) * (h(i ,j,k-1)*h(i ,j-1,k-1)) ) + S2 = slope_x(I,j,K)**2 + & + ((wNW*slope_y(i,J,K)**2 + wSE*slope_y(i+1,J-1,K)**2) + & + (wNE*slope_y(i+1,J,K)**2 + wSW*slope_y(i,J-1,K)**2) ) / & + ( ((wSE+wNW) + (wNE+wSW)) + GV%H_subroundoff**4 ) if (S2max>0.) S2 = S2 * S2max / (S2 + S2max) ! Limit S2 + N2 = max(0., N2_u(I,j,k)) CS%SN_u(I,j) = CS%SN_u(I,j) + sqrt( S2*N2 )*H_geom S2_u(I,j) = S2_u(I,j) + S2*H_geom @@ -521,26 +506,16 @@ subroutine calc_Visbeck_coeffs(h, slope_x, slope_y, N2_u, N2_v, G, GV, CS) H_geom = sqrt( Hdn * Hup ) !H_geom = H_geom * sqrt(N2) ! WKB-ish !H_geom = H_geom * N2 ! WKB-ish - if (CS%use_Visbeck_slope_bug) then - wSE = h(i,j ,k)*h(i+1,j ,k) * h(i,j ,k)*h(i+1,j ,k-1) - wNW = h(i,j+1,k)*h(i-1,j+1,k) * h(i,j+1,k)*h(i-1,j+1,k-1) - wNE = h(i,j+1,k)*h(i+1,j+1,k) * h(i,j+1,k)*h(i+1,j+1,k-1) - wSW = h(i,j ,k)*h(i-1,j ,k) * h(i,j ,k)*h(i-1,j ,k-1) - S2 = slope_y(i,J,K)**2 + ( & - (wSE*slope_x(I,j,K)**2+wNW*slope_x(I-1,j+1,K)**2) & - +(wNE*slope_x(I,j+1,K)**2+wSW*slope_x(I-1,j,K)**2) ) / & - ( ((wSE+wNW) + (wNE+wSW)) + GV%H_subroundoff**2 ) !### This should be **4 for consistent units. - else - wSE = G%mask2dCu(I,j) * ( (h(i,j ,k)*h(i+1,j ,k)) * (h(i,j ,k-1)*h(i+1,j ,k-1)) ) - wNW = G%mask2dCu(I-1,j+1) * ( (h(i,j+1,k)*h(i-1,j+1,k)) * (h(i,j+1,k-1)*h(i-1,j+1,k-1)) ) - wNE = G%mask2dCu(I,j+1) * ( (h(i,j+1,k)*h(i+1,j+1,k)) * (h(i,j+1,k-1)*h(i+1,j+1,k-1)) ) - wSW = G%mask2dCu(I-1,j) * ( (h(i,j ,k)*h(i-1,j ,k)) * (h(i,j ,k-1)*h(i-1,j ,k-1)) ) - S2 = slope_y(i,J,K)**2 + ( & - (wSE*slope_x(I,j,K)**2+wNW*slope_x(I-1,j+1,K)**2) & - +(wNE*slope_x(I,j+1,K)**2+wSW*slope_x(I-1,j,K)**2) ) / & - ( ((wSE+wNW) + (wNE+wSW)) + GV%H_subroundoff**4 ) !### This should be **4 for consistent units. - endif + wSE = G%mask2dCu(I,j) * ( (h(i,j ,k)*h(i+1,j ,k)) * (h(i,j ,k-1)*h(i+1,j ,k-1)) ) + wNW = G%mask2dCu(I-1,j+1) * ( (h(i,j+1,k)*h(i-1,j+1,k)) * (h(i,j+1,k-1)*h(i-1,j+1,k-1)) ) + wNE = G%mask2dCu(I,j+1) * ( (h(i,j+1,k)*h(i+1,j+1,k)) * (h(i,j+1,k-1)*h(i+1,j+1,k-1)) ) + wSW = G%mask2dCu(I-1,j) * ( (h(i,j ,k)*h(i-1,j ,k)) * (h(i,j ,k-1)*h(i-1,j ,k-1)) ) + S2 = slope_y(i,J,K)**2 + & + ((wSE*slope_x(I,j,K)**2 + wNW*slope_x(I-1,j+1,K)**2) + & + (wNE*slope_x(I,j+1,K)**2 + wSW*slope_x(I-1,j,K)**2) ) / & + ( ((wSE+wNW) + (wNE+wSW)) + GV%H_subroundoff**4 ) if (S2max>0.) S2 = S2 * S2max / (S2 + S2max) ! Limit S2 + N2 = max(0., N2_v(i,J,K)) CS%SN_v(i,J) = CS%SN_v(i,J) + sqrt( S2*N2 )*H_geom S2_v(i,J) = S2_v(i,J) + S2*H_geom @@ -747,7 +722,7 @@ subroutine VarMix_init(Time, G, GV, US, param_file, diag, CS) CS%calculate_Rd_dx = .false. CS%calculate_res_fns = .false. CS%calculate_Eady_growth_rate = .false. - absurdly_small_freq2 = 1e-34 !### Note the hard-coded dimensional parameter. + absurdly_small_freq2 = 1e-34 !### Note the hard-coded dimensional parameter in [s-2]. ! Read all relevant parameters and write them to the model log. call log_version(param_file, mdl, version, "") @@ -811,7 +786,7 @@ subroutine VarMix_init(Time, G, GV, US, param_file, diag, CS) call get_param(param_file, mdl, "RESOLN_N2_FILTER_DEPTH", N2_filter_depth, & "The depth below which N2 is monotonized to avoid stratification "//& "artifacts from altering the equivalent barotropic mode structure.",& - units='m', default=2000.) + units="m", default=2000.) allocate(CS%ebt_struct(isd:ied,jsd:jed,G%ke)) ; CS%ebt_struct(:,:,:) = 0.0 endif @@ -831,7 +806,7 @@ subroutine VarMix_init(Time, G, GV, US, param_file, diag, CS) call get_param(param_file, mdl, "KD_SMOOTH", CS%kappa_smooth, & "A diapycnal diffusivity that is used to interpolate "//& "more sensible values of T & S into thin layers.", & - default=1.0e-6, scale=US%m_to_Z**2) !### Add units argument. + units="m2 s-1", default=1.0e-6, scale=US%m_to_Z**2) endif if (CS%calculate_Eady_growth_rate) then @@ -930,12 +905,6 @@ subroutine VarMix_init(Time, G, GV, US, param_file, diag, CS) "velocity points from the thickness points; otherwise "//& "interpolate the wave speed and calculate the resolution "//& "function independently at each point.", default=.true.) - call get_param(param_file, mdl, "USE_VISBECK_SLOPE_BUG", CS%use_Visbeck_slope_bug, & - "If true, then retain a legacy bug in the calculation of weights "//& - "applied to isoneutral slopes. There was an erroneous k-indexing "//& - "for layer thicknesses. In addition, masking at coastlines was not "//& - "used which introduced potential restart issues. This flag will be "//& - "deprecated in a future release.", default=.false.) if (CS%interpolate_Res_fn) then if (CS%Res_coef_visc /= CS%Res_coef_khth) call MOM_error(FATAL, & "MOM_lateral_mixing_coeffs.F90, VarMix_init:"//& From 9a3f3e2842679cb804a2148a335815500e2b392a Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Wed, 5 Jun 2019 13:04:54 -0400 Subject: [PATCH 05/82] Removed KDML and HMIX from MOM_set_diffusivity Removed the unused runtime parameters KDML and HMIX_FIXED from the MOM_set_diffusivity module. These changes do not change answers, and they do not change MOM_parameter_doc files because these same parameters were already being logged in bkgnd_mixing_init, which is called just before the get_param calls that were eliminated. All answers are bitwise identical. --- .../vertical/MOM_set_diffusivity.F90 | 26 +------------------ 1 file changed, 1 insertion(+), 25 deletions(-) diff --git a/src/parameterizations/vertical/MOM_set_diffusivity.F90 b/src/parameterizations/vertical/MOM_set_diffusivity.F90 index 82d3eaa547..5d6feb8f44 100644 --- a/src/parameterizations/vertical/MOM_set_diffusivity.F90 +++ b/src/parameterizations/vertical/MOM_set_diffusivity.F90 @@ -81,9 +81,6 @@ module MOM_set_diffusivity !! Set to a negative value to have no limit. real :: Kd_add !< uniform diffusivity added everywhere without !! filtering or scaling [Z2 T-1 ~> m2 s-1]. - real :: Kdml !< mixed layer diapycnal diffusivity [Z2 T-1 ~> m2 s-1]. - !! when bulkmixedlayer==.false. - real :: Hmix !< mixed layer thickness [meter] when BULKMIXEDLAYER==.false. type(diag_ctrl), pointer :: diag => NULL() !< structure to regulate diagnostic output timing logical :: limit_dissipation !< If enabled, dissipation is limited to be larger @@ -1903,7 +1900,7 @@ subroutine set_diffusivity_init(Time, G, GV, US, param_file, diag, CS, int_tide_ ! These default values always need to be set. CS%BBL_mixing_as_max = .true. - CS%Kdml = 0.0 ; CS%cdrag = 0.003 ; CS%BBL_effic = 0.0 + CS%cdrag = 0.003 ; CS%BBL_effic = 0.0 CS%bulkmixedlayer = (GV%nkml > 0) ! Read all relevant parameters and write them to the model log. @@ -2057,27 +2054,6 @@ subroutine set_diffusivity_init(Time, G, GV, US, param_file, diag, CS, int_tide_ "set_diffusivity_init: KD_MAX must be set (positive) when "// & "USE_LOTW_BBL_DIFFUSIVITY=True.") - if (CS%bulkmixedlayer) then - ! Check that Kdml is not set when using bulk mixed layer - call get_param(param_file, mdl, "KDML", CS%Kdml, default=-1.) - if (CS%Kdml>0.) call MOM_error(FATAL, & - "set_diffusivity_init: KDML cannot be set when using"// & - "bulk mixed layer.") - CS%Kdml = CS%Kd ! This is not used with a bulk mixed layer, but also - ! cannot be a NaN. - else - ! ### This parameter is unused and is staged for deletion - call get_param(param_file, mdl, "KDML", CS%Kdml, & - "If BULKMIXEDLAYER is false, KDML is the elevated "//& - "diapycnal diffusivity in the topmost HMIX of fluid. "//& - "KDML is only used if BULKMIXEDLAYER is false.", & - units="m2 s-1", default=CS%Kd*US%Z2_T_to_m2_s, & - scale=US%m2_s_to_Z2_T) - call get_param(param_file, mdl, "HMIX_FIXED", CS%Hmix, & - "The prescribed depth over which the near-surface "//& - "viscosity and diffusivity are elevated when the bulk "//& - "mixed layer is not used.", units="m", fail_if_missing=.true.) - endif call get_param(param_file, mdl, "DEBUG", CS%debug, & "If true, write out verbose debugging data.", & default=.false., debuggingParam=.true.) From c6526689742df5740bf0ae223d6f7cec5554bbdb Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Wed, 5 Jun 2019 14:31:03 -0400 Subject: [PATCH 06/82] Replaced x**2.0 with x**2 Replaced real powers squaring values with integer powers at various places in the code. Fortunately, the answers do not change. --- src/ice_shelf/MOM_ice_shelf.F90 | 2 +- src/parameterizations/lateral/MOM_MEKE.F90 | 4 ++-- src/parameterizations/vertical/MOM_CVMix_KPP.F90 | 2 +- src/parameterizations/vertical/MOM_bkgnd_mixing.F90 | 7 ++++--- src/parameterizations/vertical/MOM_kappa_shear.F90 | 2 +- src/user/Idealized_Hurricane.F90 | 4 ++-- 6 files changed, 11 insertions(+), 10 deletions(-) diff --git a/src/ice_shelf/MOM_ice_shelf.F90 b/src/ice_shelf/MOM_ice_shelf.F90 index 5020a4cbe7..689b240c21 100644 --- a/src/ice_shelf/MOM_ice_shelf.F90 +++ b/src/ice_shelf/MOM_ice_shelf.F90 @@ -364,7 +364,7 @@ subroutine shelf_calc_flux(state, fluxes, Time, time_step, CS, forces) !### I think that CS%utide**1 should be CS%utide**2 fluxes%ustar_shelf(i,j) = MAX(CS%ustar_bg, US%m_to_Z * & - sqrt(CS%cdrag*((u_at_h**2.0 + v_at_h**2.0) + CS%utide(i,j)**1))) + sqrt(CS%cdrag*((u_at_h**2 + v_at_h**2) + CS%utide(i,j)**1))) ustar_h = US%Z_to_m*fluxes%ustar_shelf(i,j) diff --git a/src/parameterizations/lateral/MOM_MEKE.F90 b/src/parameterizations/lateral/MOM_MEKE.F90 index 78427dddf8..487b4afe30 100644 --- a/src/parameterizations/lateral/MOM_MEKE.F90 +++ b/src/parameterizations/lateral/MOM_MEKE.F90 @@ -356,7 +356,7 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h K4_here = CS%MEKE_K4 ! Limit Kh to avoid CFL violations. Inv_Kh_max = 64.0*sdt * (((G%dy_Cu(I,j)*G%IdxCu(I,j)) * & - max(G%IareaT(i,j),G%IareaT(i+1,j))))**2.0 + max(G%IareaT(i,j),G%IareaT(i+1,j))))**2 if (K4_here*Inv_Kh_max > 0.3) K4_here = 0.3 / Inv_Kh_max MEKE_uflux(I,j) = ((K4_here * (G%dy_Cu(I,j)*G%IdxCu(I,j))) * & @@ -367,7 +367,7 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h do J=js-1,je ; do i=is,ie K4_here = CS%MEKE_K4 Inv_Kh_max = 64.0*sdt * (((G%dx_Cv(i,J)*G%IdyCv(i,J)) * & - max(G%IareaT(i,j),G%IareaT(i,j+1))))**2.0 + max(G%IareaT(i,j),G%IareaT(i,j+1))))**2 if (K4_here*Inv_Kh_max > 0.3) K4_here = 0.3 / Inv_Kh_max MEKE_vflux(i,J) = ((K4_here * (G%dx_Cv(i,J)*G%IdyCv(i,J))) * & diff --git a/src/parameterizations/vertical/MOM_CVMix_KPP.F90 b/src/parameterizations/vertical/MOM_CVMix_KPP.F90 index f281a7b927..da112f379c 100644 --- a/src/parameterizations/vertical/MOM_CVMix_KPP.F90 +++ b/src/parameterizations/vertical/MOM_CVMix_KPP.F90 @@ -739,7 +739,7 @@ subroutine KPP_calculate(CS, G, GV, US, h, uStar, & Kviscosity(k) = Kviscosity(k) * LangEnhK elseif (CS%LT_K_SHAPE == LT_K_SCALED) then sigma = min(1.0,-iFaceHeight(k)/CS%OBLdepth(i,j)) - SigmaRatio = sigma * (1. - sigma)**2. / 0.148148037 + SigmaRatio = sigma * (1. - sigma)**2 / 0.148148037 if (CS%id_EnhK > 0) CS%EnhK(i,j,k) = (1.0 + (LangEnhK - 1.)*sigmaRatio) Kdiffusivity(k,1) = Kdiffusivity(k,1) * ( 1. + & ( LangEnhK - 1.)*sigmaRatio) diff --git a/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 b/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 index e941ec3eea..7e2d010da5 100644 --- a/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 +++ b/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 @@ -464,15 +464,16 @@ subroutine calculate_bkgnd_mixing(h, tv, N2_lay, Kd_lay, Kv, j, G, GV, US, CS) enddo ; enddo elseif (CS%horiz_varying_background) then + !### Note that there are lots of hrad-coded parameters here. do i=is,ie - bckgrnd_vdc_psis= CS%bckgrnd_vdc_psim*exp(-(0.4*(G%geoLatT(i,j)+28.9))**2.0) - bckgrnd_vdc_psin= CS%bckgrnd_vdc_psim*exp(-(0.4*(G%geoLatT(i,j)-28.9))**2.0) + bckgrnd_vdc_psis= CS%bckgrnd_vdc_psim * exp(-(0.4*(G%geoLatT(i,j)+28.9))**2) + bckgrnd_vdc_psin= CS%bckgrnd_vdc_psim * exp(-(0.4*(G%geoLatT(i,j)-28.9))**2) CS%kd_bkgnd(i,j,:) = CS%bckgrnd_vdc_eq + bckgrnd_vdc_psin + bckgrnd_vdc_psis if (G%geoLatT(i,j) < -10.0) then CS%kd_bkgnd(i,j,:) = CS%kd_bkgnd(i,j,:) + CS%bckgrnd_vdc1 elseif (G%geoLatT(i,j) <= 10.0) then - CS%kd_bkgnd(i,j,:) = CS%kd_bkgnd(i,j,:) + CS%bckgrnd_vdc1 * (G%geoLatT(i,j)/10.0)**2.0 + CS%kd_bkgnd(i,j,:) = CS%kd_bkgnd(i,j,:) + CS%bckgrnd_vdc1 * (G%geoLatT(i,j)/10.0)**2 else CS%kd_bkgnd(i,j,:) = CS%kd_bkgnd(i,j,:) + CS%bckgrnd_vdc1 endif diff --git a/src/parameterizations/vertical/MOM_kappa_shear.F90 b/src/parameterizations/vertical/MOM_kappa_shear.F90 index b5caeb2f53..2dc58cc403 100644 --- a/src/parameterizations/vertical/MOM_kappa_shear.F90 +++ b/src/parameterizations/vertical/MOM_kappa_shear.F90 @@ -1427,7 +1427,7 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, & real :: Ri_crit ! The critical shear Richardson number for shear- ! driven mixing. The theoretical value is 0.25. real :: q0 ! The background level of TKE [m2 s-2]. - real :: Ilambda2 ! 1.0 / CS%lambda**2. + real :: Ilambda2 ! 1.0 / CS%lambda**2 [nondim] real :: TKE_min ! The minimum value of shear-driven TKE that can be ! solved for [m2 s-2]. real :: kappa0 ! The background diapycnal diffusivity [Z2 s-1 ~> m2 s-1]. diff --git a/src/user/Idealized_Hurricane.F90 b/src/user/Idealized_Hurricane.F90 index 73d4a2ea1f..e76fc1dc5d 100644 --- a/src/user/Idealized_Hurricane.F90 +++ b/src/user/Idealized_Hurricane.F90 @@ -352,7 +352,7 @@ subroutine idealized_hurricane_wind_profile(CS, absf, YY, XX, UOCN, VOCN, Tx, Ty ! Implementing Holland (1980) parameteric wind profile - Radius = SQRT(XX**2.+YY**2.) + Radius = SQRT(XX**2 + YY**2) !/ BGR ! rkm - r converted to km for Holland prof. @@ -493,7 +493,7 @@ subroutine SCM_idealized_hurricane_wind_forcing(state, forces, day, G, US, CS) !/ BR ! Calculate x position as a function of time. xx = ( t0 - time_type_to_real(day)) * CS%hurr_translation_spd * cos(transdir) - r = sqrt(xx**2.+CS%DY_from_center**2.) + r = sqrt(xx**2 + CS%DY_from_center**2) !/ BR ! rkm - r converted to km for Holland prof. ! used in km due to error, correct implementation should From bf048da5706b611ec3784bf7c9828bfbe67e4cf4 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Thu, 6 Jun 2019 06:04:42 -0400 Subject: [PATCH 07/82] Reformatting in MOM_energetic_PBL Reformatted parts of the MOM_energetic_PBL code for greater clarity and consistency, and added comments documenting parts of the code. All answers are bitwise identical. --- .../vertical/MOM_energetic_PBL.F90 | 301 +++++++++--------- 1 file changed, 156 insertions(+), 145 deletions(-) diff --git a/src/parameterizations/vertical/MOM_energetic_PBL.F90 b/src/parameterizations/vertical/MOM_energetic_PBL.F90 index e4b294d3d8..0f2c028f82 100644 --- a/src/parameterizations/vertical/MOM_energetic_PBL.F90 +++ b/src/parameterizations/vertical/MOM_energetic_PBL.F90 @@ -176,7 +176,7 @@ module MOM_energetic_PBL diag_TKE_forcing, & !< The TKE sink required to mix surface penetrating shortwave heating [J m-2]. diag_TKE_mech_decay, & !< The decay of mechanical TKE [J m-2]. diag_TKE_conv_decay, & !< The decay of convective TKE [J m-2]. - diag_TKE_mixing,& !< The work done by TKE to deepen the mixed layer [J m-2]. + diag_TKE_mixing, & !< The work done by TKE to deepen the mixed layer [J m-2]. ! Additional output parameters also 2d ML_depth, & !< The mixed layer depth [Z ~> m]. (result after iteration step) ML_depth2, & !< The mixed layer depth [Z ~> m]. (guess for iteration step) @@ -564,7 +564,7 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS h_tt_min = 0.0 vonKar = 0.41 - mstar_mix=CS%MSTAR!Initialize to mstar + mstar_mix = CS%MSTAR !Initialize to mstar I_dtrho = 0.0 ; if (dt*GV%Rho0 > 0.0) I_dtrho = 1.0 / (dt*GV%Rho0) ! Determine whether to zero out diagnostics before accumulation. @@ -590,34 +590,34 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS endif -!!OMP parallel do default(none) shared(js,je,nz,is,ie,h_3d,u_3d,v_3d,tv,dt, & -!!OMP CS,G,GV,US,fluxes,IdtdR0, & -!!OMP TKE_forced,debug,H_neglect,dSV_dT, & -!!OMP dSV_dS,I_dtrho,C1_3,h_tt_min,vonKar, & -!!OMP max_itt,Kd_int) & +!!OMP parallel do default(none) shared(js,je,nz,is,ie,h_3d,u_3d,v_3d,tv,dt, & +!!OMP CS,G,GV,US,fluxes,IdtdR0, & +!!OMP TKE_forced,debug,H_neglect,dSV_dT, & +!!OMP dSV_dS,I_dtrho,C1_3,h_tt_min,vonKar, & +!!OMP max_itt,Kd_int) & !!OMP private(i,j,k,h,u,v,T,S,Kd,mech_TKE_k,conv_PErel_k, & !!OMP U_Star,absf,mech_TKE,conv_PErel,nstar_k, & -!!OMP h_sum,I_hs,h_bot,hb_hs,T0,S0,num_itts, & +!!OMP h_sum,I_hs,h_bot,hb_hs,T0,S0,num_itts, & !!OMP pres,pres_Z,dMass,dPres,dT_to_dPE,dS_to_dPE, & -!!OMP dT_to_dColHt,dS_to_dColHt,Kddt_h,hp_a, & -!!OMP Th_a,Sh_a,Th_b,Sh_b,dT_to_dPE_a,htot, & +!!OMP dT_to_dColHt,dS_to_dColHt,Kddt_h,hp_a, & +!!OMP Th_a,Sh_a,Th_b,Sh_b,dT_to_dPE_a,htot, & !!OMP dT_to_dColHt_a,dS_to_dColHt_a,uhtot,vhtot, & -!!OMP Idecay_len_TKE,exp_kh,nstar_FC,tot_TKE, & -!!OMP TKE_reduc,dTe_t2,dSe_t2,dTe,dSe,dt_h, & -!!OMP Convectively_stable,sfc_disconnect,b1, & -!!OMP c1,dT_km1_t2,dS_km1_t2,dTe_term, & -!!OMP dSe_term,MKE2_Hharm,vstar,h_tt,h_rsum, & -!!OMP Kd_guess0,Kddt_h_g0,dPEc_dKd_Kd0, & -!!OMP PE_chg_max,dPEa_dKd_g0,PE_chg_g0, & -!!OMP MKE_src,dPE_conv,Kddt_h_max,Kddt_h_min, & -!!OMP dTKE_conv, dTKE_forcing, dTKE_mixing, & +!!OMP Idecay_len_TKE,exp_kh,nstar_FC,tot_TKE, & +!!OMP TKE_reduc,dTe_t2,dSe_t2,dTe,dSe,dt_h, & +!!OMP Convectively_stable,sfc_disconnect,b1, & +!!OMP c1,dT_km1_t2,dS_km1_t2,dTe_term, & +!!OMP dSe_term,MKE2_Hharm,vstar,h_tt,h_rsum, & +!!OMP Kd_guess0,Kddt_h_g0,dPEc_dKd_Kd0, & +!!OMP PE_chg_max,dPEa_dKd_g0,PE_chg_g0, & +!!OMP MKE_src,dPE_conv,Kddt_h_max,Kddt_h_min, & +!!OMP dTKE_conv, dTKE_forcing, dTKE_mixing, & !!OMP dTKE_MKE,dTKE_mech_decay,dTKE_conv_decay,& -!!OMP TKE_left_max,TKE_left_min,Kddt_h_guess, & -!!OMP TKE_left_itt,dPEa_dKd_itt,PE_chg_itt, & -!!OMP MKE_src_itt,Kddt_h_itt,dPEc_dKd,PE_chg, & -!!OMP dMKE_src_dK,TKE_left,use_Newt, & -!!OMP dKddt_h_Newt,Kddt_h_Newt,Kddt_h_next, & -!!OMP dKddt_h,Te,Se,Hsfc_used,dS_to_dPE_a, & +!!OMP TKE_left_max,TKE_left_min,Kddt_h_guess, & +!!OMP TKE_left_itt,dPEa_dKd_itt,PE_chg_itt, & +!!OMP MKE_src_itt,Kddt_h_itt,dPEc_dKd,PE_chg, & +!!OMP dMKE_src_dK,TKE_left,use_Newt, & +!!OMP dKddt_h_Newt,Kddt_h_Newt,Kddt_h_next, & +!!OMP dKddt_h,Te,Se,Hsfc_used,dS_to_dPE_a, & !!OMP dMKE_max,sfc_connected,TKE_here) do j=js,je ! Copy the thicknesses and other fields to 2-d arrays. @@ -767,7 +767,7 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS OBL_CONVERGED = .false. ! Initialize ENHANCE_M to 1 and mstar_lt to 0 - ENHANCE_M=1.e0 + ENHANCE_M = 1.0 MSTAR_LT = 0.0 do OBL_IT=1,MAX_OBL_IT ; if (.not. OBL_CONVERGED) then @@ -777,6 +777,7 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS sfc_connected(i) = .true. + ! Determine mech_TKE and conv_PErel. if (CS%Mstar_Mode > 0) then ! Note the value of mech_TKE(i) now must be iterated over, so it is moved here ! First solve for the TKE to PE length scale @@ -797,8 +798,7 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS else !Asymptote to MSTAR_CAP as MLD_over_Stab -> infinity MSTAR_mix = CS%MSTAR_CAP - & - (CS%MSTAR_B2*(MLD_over_Stab-CS%MSTAR_XINT_UP)& - +CS%MSTAR_A2)**(CS%MSTAR_N) + (CS%MSTAR_B2*(MLD_over_Stab-CS%MSTAR_XINT_UP) + CS%MSTAR_A2)**(CS%MSTAR_N) endif else !No cap if negative cap value given. @@ -820,22 +820,27 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS MSTAR_MIX = max(mstar_STAB, min(1.25, mstar_ROT)) if (CS%MSTAR_CAP > 0.0) MSTAR_MIX = min(CS%MSTAR_CAP, MSTAR_MIX) elseif (CS%MSTAR_MODE.eq.CS%MSTAR_RH18) then - MSTAR_ROT = CS%RH18_MST_CN1 * ( 1.0 - ( 1.+CS%RH18_MST_CN2 * & + MSTAR_ROT = CS%RH18_MST_CN1 * ( 1.0 - ( 1. + CS%RH18_MST_CN2 * & exp( CS%RH18_MST_CN3 * MLD_GUESS * absf(i) / u_star) )**-1.0 ) - MSTAR_STAB = CS%RH18_MST_CS1 * (bf_stable**2*MLD_GUESS & - / ( u_star**5 * absf(i) ) ) **CS%RH18_MST_CS2 + ! Msr_term = CS%RH18_MST_CN2 * exp( CS%RH18_MST_CN3 * MLD_GUESS * absf(i) / u_star) ) + ! MStar_Rot = CS%RH18_MST_CN1 * (Msr_term / (1.0 + Msr_term)) + MSTAR_STAB = CS%RH18_MST_CS1 * & + (bf_stable**2 * MLD_GUESS / ( u_star**5 * absf(i) ) )**CS%RH18_MST_CS2 MSTAR_MIX = MSTAR_ROT + MSTAR_STAB endif!mstar_mode==1 or ==2 or ==3 ! Adjustment for unstable buoyancy flux. ! Convection reduces mechanical mixing because there ! is less density gradient to mix. (Statically unstable near surface) MSTAR_Conv_Adj = 1. - CS%CNV_MST_FAC * (-BF_Unstable + 1.e-10*US%m_to_Z**2) / & - ( (-Bf_Unstable + 1.e-10*US%m_to_Z**2) + & + ( (-Bf_Unstable + 1.e-10*US%m_to_Z**2) + & 2.0 *MSTAR_MIX * U_star**3 / MLD_guess ) ! MSTAR_Conv_Adj = 1. - CS%CNV_MST_FAC * ((-BF_Unstable + 1.e-10*US%m_to_Z**2)*MLD_guess) / & ! ( (-Bf_Unstable + 1.e-10*US%m_to_Z**2)*MLD_guess + & ! 2.0*MSTAR_MIX * U_star**3 ) + if (CS%USE_LT) then + ! Determine MSTAR_LT and ENHANCE_M (otherwise they remain 0.0 and 1.0), + ! along with LAmod for diagnostics. call get_Langmuir_Number( LA, G, GV, US, abs(MLD_guess), u_star_mean, i, j, & H=H(i,:), U_H=U(i,:), V_H=V(i,:), WAVES=WAVES) ! 2. Get parameters for modified LA @@ -845,7 +850,7 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS ! 3. Adjust LA based on various parameters. ! Assumes linear factors based on length scale ratios to adjust LA ! Note when these coefficients are set to 0 recovers simple LA. - LAmod = LA * (1.0 + max(-0.5,CS%LaC_MLDoEK * MLD_o_Ekman) + & + LAmod = LA * (1.0 + max(-0.5,CS%LaC_MLDoEK * MLD_o_Ekman) + & CS%LaC_EKoOB_stab * Ekman_o_Obukhov_stab + & CS%LaC_EKoOB_un * Ekman_o_Obukhov_un + & CS%LaC_MLDoOB_stab * MLD_o_Obukhov_stab + & @@ -864,10 +869,12 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS ENHANCE_M = 1.0 endif endif - !Reset mech_tke and conv_perel values (based on new mstar) + + !Reset mech_TKE and conv_PErel values (based on new mstar) mech_TKE(i) = ( MSTAR_mix * MSTAR_conv_adj * ENHANCE_M + MSTAR_LT) * & US%Z_to_m**3 * (dt*GV%Rho0*U_star**3) - conv_PErel(i) = 0.0 + + !### I suspect that these TKE_diagnostics are incorrectly summing over iterations. -RWH if (CS%TKE_diagnostics) then CS%diag_TKE_wind(i,j) = CS%diag_TKE_wind(i,j) + mech_TKE(i) * IdtdR0 if (TKE_forced(i,j,1) <= 0.0) then @@ -883,8 +890,9 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS if (TKE_forced(i,j,1) <= 0.0) then mech_TKE(i) = mech_TKE(i) + TKE_forced(i,j,1) if (mech_TKE(i) < 0.0) mech_TKE(i) = 0.0 + conv_PErel(i) = 0.0 else - conv_PErel(i) = conv_PErel(i) + TKE_forced(i,j,1) + conv_PErel(i) = TKE_forced(i,j,1) endif else mech_TKE(i) = mech_TKE_top(i)*ENHANCE_M ; conv_PErel(i) = conv_PErel_top(i) @@ -902,6 +910,7 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS enddo if (.not.CS%Use_MLD_Iteration) OBL_CONVERGED = .true. + ! Determine the mixing shape function, MixLen_shape. if ((.not.CS%Use_MLD_Iteration) .or. & (CS%transLay_scale >= 1.0) .or. (CS%transLay_scale < 0.0) ) then do K=1,nz+1 ; MixLen_shape(K) = 1.0 ; enddo @@ -920,7 +929,7 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS h_rsum = h_rsum + h(i,k-1)*GV%H_to_Z if (CS%MixLenExponent==2.0)then MixLen_shape(K) = CS%transLay_scale + (1.0 - CS%transLay_scale) * & - (max(0.0, (MLD_guess - h_rsum)*I_MLD) )**2!CS%MixLenExponent + (max(0.0, (MLD_guess - h_rsum)*I_MLD) )**2 !CS%MixLenExponent else MixLen_shape(K) = CS%transLay_scale + (1.0 - CS%transLay_scale) * & (max(0.0, (MLD_guess - h_rsum)*I_MLD) )**CS%MixLenExponent @@ -1128,9 +1137,9 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS Kd_guess0 = vstar * vonKar * Mixing_Length_Used(k) endif ! Compute the local enhnacement of K (perhaps due to Langmuir) - if (CS%LT_ENH_K_R16) then + if (CS%LT_ENH_K_R16) then !### K_Enhancement is not used, and this option is uncommon. Shape_Function = htot(i)/MLD_guess*(1.-htot(i)/MLD_guess)**2 - K_Enhancement = ( min( Max_K_Enhancement,1.+1./La ) - 1. ) + K_Enhancement = ( min( Max_K_Enhancement, 1. + 1./La ) - 1. ) Kd_guess0 = Kd_guess0 * Shape_Function / Max_Shape_Function endif else @@ -1193,7 +1202,7 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS Kd(i,k) = vstar * vonKar * Mixing_Length_Used(k) endif ! Compute the local enhnacement of K (perhaps due to Langmuir) - if (CS%LT_ENH_K_R16) then + if (CS%LT_ENH_K_R16) then !### K_Enhancement is not used, and this option is uncommon. Shape_Function = htot(i)/MLD_guess*(1.-htot(i)/MLD_guess)**2 K_Enhancement = ( min( Max_K_Enhancement,1.+1./La ) - 1. ) Kd(i,k) = Kd(i,K) * Shape_Function / Max_Shape_Function @@ -1278,7 +1287,7 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS ! As a starting guess, take the minimum of a false position estimate ! and a Newton's method estimate starting from Kddt_h = 0.0. Kddt_h_guess = tot_TKE * Kddt_h_max / max( N2_DISSIPATION*PE_chg_g0 & - - MKE_src, Kddt_h_max * (dPEc_dKd_Kd0 - dMKE_max * & + - MKE_src, Kddt_h_max * (dPEc_dKd_Kd0 - dMKE_max * & MKE2_Hharm) ) ! The above expression is mathematically the same as the following ! except it is not susceptible to division by zero when @@ -1460,13 +1469,13 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS min_MLD = MLD_guess elseif ((MLD_guess - MLD_found) < max(CS%MLD_tol,h(i,k-1)*GV%H_to_Z)) then OBL_CONVERGED = .true.!Break convergence loop - if (OBL_IT_STATS) then !Compute iteration statistics - MAXIT = max(MAXIT,obl_it) - MINIT = min(MINIT,obl_it) - SUMIT = SUMIT+obl_it - NUMIT = NUMIT+1 - print*,MAXIT,MINIT,SUMIT/NUMIT - endif + ! if (OBL_IT_STATS) then !Compute iteration statistics + ! MAXIT = max(MAXIT,obl_it) + ! MINIT = min(MINIT,obl_it) + ! SUMIT = SUMIT+obl_it + ! NUMIT = NUMIT+1 + ! print*,MAXIT,MINIT,SUMIT/NUMIT + ! endif CS%ML_Depth2(i,j) = MLD_guess else max_MLD = MLD_guess !We know this guess was too deep @@ -1481,13 +1490,13 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS min_MLD = MLD_guess elseif (abs(MLD_guess - MLD_found) < CS%MLD_tol) then OBL_CONVERGED = .true.!Break convergence loop - if (OBL_IT_STATS) then !Compute iteration statistics - MAXIT = max(MAXIT,obl_it) - MINIT = min(MINIT,obl_it) - SUMIT = SUMIT+obl_it - NUMIT = NUMIT+1 - print*,MAXIT,MINIT,SUMIT/NUMIT - endif + ! if (OBL_IT_STATS) then !Compute iteration statistics + ! MAXIT = max(MAXIT,obl_it) + ! MINIT = min(MINIT,obl_it) + ! SUMIT = SUMIT+obl_it + ! NUMIT = NUMIT+1 + ! print*,MAXIT,MINIT,SUMIT/NUMIT + ! endif CS%ML_Depth2(i,j) = MLD_guess else max_MLD = MLD_guess !We know this guess was too deep @@ -1510,7 +1519,7 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS !{ !print*,'Min/Max: ',ITmin(50),ITmax(50) !print*,'Guess/result: ',ITguess(50),ITresult(50) - !print*,'Stats on CPU: ',CONVERGED,NOTCONVERGED,& + !print*,'Stats on CPU: ',CONVERGED,NOTCONVERGED, & ! real(NOTCONVERGED)/real(CONVERGED) !} !stop !Kill if not converged during testing. @@ -1935,6 +1944,8 @@ subroutine energetic_PBL_get_MLD(CS, MLD, G, US, m_to_MLD_units) end subroutine energetic_PBL_get_MLD +!### The following two subroutines, ust_2_u10_coare3p5 and get_LA_windsea, appear not to be in use. + !> Computes wind speed from ustar_air based on COARE 3.5 Cd relationship subroutine ust_2_u10_coare3p5(USTair, U10, GV, US) real, intent(in) :: USTair !< Ustar in the air [m s-1]. @@ -1964,7 +1975,7 @@ subroutine ust_2_u10_coare3p5(USTair, U10, GV, US) alpha = min(0.028,0.0017 * u10 - 0.005) z0rough = alpha * USTair**2/(GV%g_Earth*US%m_to_Z) ! Compute z0rough from ustar guess z0=z0sm+z0rough - CD = ( vonkar / log(10/z0) )**2 ! Compute CD from derived roughness + CD = ( vonkar / log(10.0/z0) )**2 ! Compute CD from derived roughness u10 = USTair/sqrt(CD);!Compute new u10 from derived CD, while loop ! ends and checks for convergence...CT counter ! makes sure loop doesn't run away if function @@ -2071,7 +2082,7 @@ subroutine get_LA_windsea(ustar, hbl, GV, US, LA) else LA=1.e8 endif -endsubroutine Get_LA_windsea +end subroutine Get_LA_windsea !> This subroutine initializes the energetic_PBL module subroutine energetic_PBL_init(Time, G, GV, US, param_file, diag, CS) @@ -2094,7 +2105,7 @@ subroutine energetic_PBL_init(Time, G, GV, US, param_file, diag, CS) isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed if (associated(CS)) then - call MOM_error(WARNING, "mixedlayer_init called with an associated"// & + call MOM_error(WARNING, "mixedlayer_init called with an associated"//& "associated control structure.") return else ; allocate(CS) ; endif @@ -2110,74 +2121,74 @@ subroutine energetic_PBL_init(Time, G, GV, US, param_file, diag, CS) " 0 for constant MSTAR\n"//& " 1 for MSTAR w/ MLD in stabilizing limit\n"//& " 2 for MSTAR w/ L_E/L_O in stabilizing limit\n"//& - " 3 for MSTAR as in RH18.",& - "units=nondim",default=0) + " 3 for MSTAR as in RH18.", & + "units=nondim", default=0) call get_param(param_file, mdl, "MSTAR", CS%mstar, & "The ratio of the friction velocity cubed to the TKE "//& "input to the mixed layer.", "units=nondim", default=1.2) call get_param(param_file, mdl, "MIX_LEN_EXPONENT", CS%MixLenExponent, & "The exponent applied to the ratio of the distance to the MLD "//& - "and the MLD depth which determines the shape of the mixing length.",& + "and the MLD depth which determines the shape of the mixing length.", & "units=nondim", default=2.0) call get_param(param_file, mdl, "MSTAR_CAP", CS%mstar_cap, & "Maximum value of mstar allowed in model if non-negative "//& - "(used if MSTAR_MODE>0).",& + "(used if MSTAR_MODE>0).", & "units=nondim", default=-1.0) call get_param(param_file, mdl, "MSTAR_CONV_ADJ", CS%cnv_mst_fac, & "Factor used for reducing mstar during convection "//& - "due to reduction of stable density gradient.",& + "due to reduction of stable density gradient.", & "units=nondim", default=0.0) call get_param(param_file, mdl, "MSTAR_SLOPE", CS%mstar_slope, & "The slope of the linear relationship between mstar "//& - "and the length scale ratio (used if MSTAR_MODE=1).",& + "and the length scale ratio (used if MSTAR_MODE=1).", & "units=nondim", default=0.85) call get_param(param_file, mdl, "MSTAR_XINT", CS%mstar_xint, & "The value of the length scale ratio where the mstar "//& - "is linear above (used if MSTAR_MODE=1).",& + "is linear above (used if MSTAR_MODE=1).", & "units=nondim", default=-0.3) call get_param(param_file, mdl, "MSTAR_AT_XINT", CS%mstar_at_xint, & "The value of mstar at MSTAR_XINT "//& - "(used if MSTAR_MODE=1).",& + "(used if MSTAR_MODE=1).", & "units=nondim", default=0.095) call get_param(param_file, mdl, "MSTAR_FLATCAP", CS%MSTAR_FLATCAP, & "Set false to use asymptotic cap, defaults to true. "//& "(used only if MSTAR_MODE=1)"& - ,"units=nondim",default=.true.) + ,"units=nondim", default=.true.) call get_param(param_file, mdl, "MSTAR2_COEF1", CS%MSTAR_COEF, & "Coefficient in computing mstar when rotation and "//& "stabilizing effects are both important (used if MSTAR_MODE=2)"& - ,"units=nondim",default=0.3) + ,"units=nondim", default=0.3) call get_param(param_file, mdl, "MSTAR2_COEF2", CS%C_EK, & "Coefficient in computing mstar when only rotation limits "//& "the total mixing. (used only if MSTAR_MODE=2)"& - ,"units=nondim",default=0.085) - call get_param(param_file, mdl, "RH18_MST_CN1", CS%RH18_MST_CN1,& + ,"units=nondim", default=0.085) + call get_param(param_file, mdl, "RH18_MST_CN1", CS%RH18_MST_CN1, & "MSTAR_N coefficient 1 (outter-most coefficient for fit). \n"//& " The value of 0.275 is given in RH18. Increasing this \n"//& "coefficient increases MSTAR for all values of Hf/ust, but more \n"//& - "effectively at low values (weakly developed OSBLs).",& + "effectively at low values (weakly developed OSBLs).", & units="nondim", default=0.275) - call get_param(param_file, mdl, "RH18_MST_CN2", CS%RH18_MST_CN2,& + call get_param(param_file, mdl, "RH18_MST_CN2", CS%RH18_MST_CN2, & "MSTAR_N coefficient 2 (coefficient outside of exponential decay). \n"//& "The value of 8.0 is given in RH18. Increasing this coefficient \n"//& "increases MSTAR for all values of HF/ust, with a much more even \n"//& - "effect across a wide range of Hf/ust than CN1.",& - units="nondim",default=8.0) - call get_param(param_file, mdl, "RH18_MST_CN3", CS%RH18_MST_CN3,& + "effect across a wide range of Hf/ust than CN1.", & + units="nondim", default=8.0) + call get_param(param_file, mdl, "RH18_MST_CN3", CS%RH18_MST_CN3, & "MSTAR_N coefficient 3 (exponential decay coefficient). \n"//& "The value of -5.0 is given in RH18. Increasing this increases how \n"//& - "quickly the value of MSTAR decreases as Hf/ust increases.",& - units="nondim",default=-5.0) - call get_param(param_file, mdl, "RH18_MST_CS1", CS%RH18_MST_CS1,& + "quickly the value of MSTAR decreases as Hf/ust increases.", & + units="nondim", default=-5.0) + call get_param(param_file, mdl, "RH18_MST_CS1", CS%RH18_MST_CS1, & "MSTAR_S coefficient for RH18 in stabilizing limit. \n"//& "The value of 0.2 is given in RH18 and increasing it increases \n"//& - "MSTAR in the presence of a stabilizing surface buoyancy flux.",& - units="nondim",default=0.2) - call get_param(param_file, mdl, "RH18_MST_CS2", CS%RH18_MST_CS2,& + "MSTAR in the presence of a stabilizing surface buoyancy flux.", & + units="nondim", default=0.2) + call get_param(param_file, mdl, "RH18_MST_CS2", CS%RH18_MST_CS2, & "MSTAR_S exponent for RH18 in stabilizing limit. \n"//& "The value of 0.4 is given in RH18 and increasing it increases MSTAR \n"//& - "exponentially in the presence of a stabilizing surface buoyancy flux.",& - Units="nondim",default=0.4) + "exponentially in the presence of a stabilizing surface buoyancy flux.", & + Units="nondim", default=0.4) call get_param(param_file, mdl, "NSTAR", CS%nstar, & "The portion of the buoyant potential energy imparted by "//& "surface fluxes that is available to drive entrainment "//& @@ -2196,96 +2207,96 @@ subroutine energetic_PBL_init(Time, G, GV, US, param_file, diag, CS) ! "The minimum mixed layer depth if the mixed layer depth "//& ! "is determined dynamically.", units="m", default=0.0) - call get_param(param_file, mdl, "OMEGA",CS%omega, & + call get_param(param_file, mdl, "OMEGA", CS%omega, & "The rotation rate of the earth.", units="s-1", & default=7.2921e-5) - call get_param(param_file, mdl, "ML_USE_OMEGA", use_omega, & + call get_param(param_file, mdl, "ML_USE_OMEGA", use_omega, & "If true, use the absolute rotation rate instead of the "//& - "vertical component of rotation when setting the decay "// & + "vertical component of rotation when setting the decay "//& "scale for turbulence.", default=.false., do_not_log=.true.) omega_frac_dflt = 0.0 if (use_omega) then call MOM_error(WARNING, "ML_USE_OMEGA is depricated; use ML_OMEGA_FRAC=1.0 instead.") omega_frac_dflt = 1.0 endif - call get_param(param_file, mdl, "ML_OMEGA_FRAC", CS%omega_frac, & - "When setting the decay scale for turbulence, use this "// & + call get_param(param_file, mdl, "ML_OMEGA_FRAC", CS%omega_frac, & + "When setting the decay scale for turbulence, use this "//& "fraction of the absolute rotation rate blended with the "//& - "local value of f, as sqrt((1-of)*f^2 + of*4*omega^2).", & + "local value of f, as sqrt((1-of)*f^2 + of*4*omega^2).", & units="nondim", default=omega_frac_dflt) call get_param(param_file, mdl, "VSTAR_MODE", CS%vstar_mode, & "An integer switch for how to compute VSTAR. \n"//& " 0 for old vstar (TKE Remaining)^(1/3)\n"//& - " 1 for vstar from u* and w* (see Reichl & Hallberg 2018).",& - "units=nondim",default=0) - call get_param(param_file, mdl, "WSTAR_USTAR_COEF", CS%wstar_ustar_coef, & + " 1 for vstar from u* and w* (see Reichl & Hallberg 2018).", & + "units=nondim", default=0) + call get_param(param_file, mdl, "WSTAR_USTAR_COEF", CS%wstar_ustar_coef, & "A ratio relating the efficiency with which convectively "//& - "released energy is converted to a turbulent velocity, "// & + "released energy is converted to a turbulent velocity, "//& "relative to mechanically forced TKE. Making this larger "//& "increases the BL diffusivity", units="nondim", default=1.0) call get_param(param_file, mdl, "VSTAR_SCALE_FACTOR", CS%vstar_scale_fac, & - "An overall nondimensional scaling factor for v*. "// & - "Making this larger decreases the PBL diffusivity.", & + "An overall nondimensional scaling factor for v*. "//& + "Making this larger decreases the PBL diffusivity.", & units="nondim", default=1.0, scale=US%m_to_Z) - call get_param(param_file, mdl, "VSTAR_SURF_FAC", CS%vstar_surf_fac,& - "The proportionality times ustar to set vstar to at the surface.",& + call get_param(param_file, mdl, "VSTAR_SURF_FAC", CS%vstar_surf_fac, & + "The proportionality times ustar to set vstar to at the surface.", & "units=nondim", default=1.2) call get_param(param_file, mdl, "LT_ENHANCE_K_R16",CS%LT_ENH_K_R16, & "Logical flag to toggle on enhancing mixing coefficient in\n"//& "boundary layer due to Langmuir turbulence following Reichl\n"//& "et al., 2016. \n"//& "This approach is not recommended for use, as it is based\n"//& - "on a hurricane LES configuration and not known if it is general.",& - units="nondim",default=.false.) - call get_param(param_file, mdl, "EKMAN_SCALE_COEF", CS%Ekman_scale_coef, & - "A nondimensional scaling factor controlling the inhibition "// & + "on a hurricane LES configuration and not known if it is general.", & + units="nondim", default=.false.) + call get_param(param_file, mdl, "EKMAN_SCALE_COEF", CS%Ekman_scale_coef, & + "A nondimensional scaling factor controlling the inhibition "//& "of the diffusive length scale by rotation. Making this larger "//& "decreases the PBL diffusivity.", units="nondim", default=1.0) - call get_param(param_file, mdl, "USE_MLD_ITERATION", CS%USE_MLD_ITERATION, & - "A logical that specifies whether or not to use the "// & + call get_param(param_file, mdl, "USE_MLD_ITERATION", CS%USE_MLD_ITERATION, & + "A logical that specifies whether or not to use the "//& "distance to the bottom of the actively turbulent boundary "//& "layer to help set the EPBL length scale.", default=.false.) - call get_param(param_file, mdl, "ORIG_MLD_ITERATION", CS%ORIG_MLD_ITERATION, & - "A logical that specifies whether or not to use the "// & + call get_param(param_file, mdl, "ORIG_MLD_ITERATION", CS%ORIG_MLD_ITERATION, & + "A logical that specifies whether or not to use the "//& "old method for determining MLD depth in iteration, which "//& "is limited to resolution.", default=.true.) - call get_param(param_file, mdl, "MLD_ITERATION_GUESS", CS%MLD_ITERATION_GUESS, & - "A logical that specifies whether or not to use the "// & - "previous timestep MLD as a first guess in the MLD iteration. "// & + call get_param(param_file, mdl, "MLD_ITERATION_GUESS", CS%MLD_ITERATION_GUESS, & + "A logical that specifies whether or not to use the "//& + "previous timestep MLD as a first guess in the MLD iteration. "//& "The default is false to facilitate reproducibility.", default=.false.) - call get_param(param_file, mdl, "EPBL_MLD_TOLERANCE", CS%MLD_tol, & - "The tolerance for the iteratively determined mixed "// & + call get_param(param_file, mdl, "EPBL_MLD_TOLERANCE", CS%MLD_tol, & + "The tolerance for the iteratively determined mixed "//& "layer depth. This is only used with USE_MLD_ITERATION.", & units="meter", default=1.0, scale=US%m_to_Z) - call get_param(param_file, mdl, "EPBL_MIN_MIX_LEN", CS%min_mix_len, & + call get_param(param_file, mdl, "EPBL_MIN_MIX_LEN", CS%min_mix_len, & "The minimum mixing length scale that will be used "//& - "by ePBL. The default (0) does not set a minimum.", & + "by ePBL. The default (0) does not set a minimum.", & units="meter", default=0.0, scale=US%m_to_Z) - call get_param(param_file, mdl, "EPBL_ORIGINAL_PE_CALC", CS%orig_PE_calc, & - "If true, the ePBL code uses the original form of the "// & - "potential energy change code. Otherwise, the newer "// & - "version that can work with successive increments to the "// & + call get_param(param_file, mdl, "EPBL_ORIGINAL_PE_CALC", CS%orig_PE_calc, & + "If true, the ePBL code uses the original form of the "//& + "potential energy change code. Otherwise, the newer "//& + "version that can work with successive increments to the "//& "diffusivity in upward or downward passes is used.", default=.true.) call get_param(param_file, mdl, "EPBL_TRANSITION_SCALE", CS%transLay_scale, & - "A scale for the mixing length in the transition layer "// & + "A scale for the mixing length in the transition layer "//& "at the edge of the boundary layer as a fraction of the "//& "boundary layer thickness. The default is 0.1.", & units="nondim", default=0.1) if ( CS%USE_MLD_ITERATION .and. abs(CS%transLay_scale-0.5) >= 0.5) then - call MOM_error(FATAL, "If flag USE_MLD_ITERATION is true, then "// & + call MOM_error(FATAL, "If flag USE_MLD_ITERATION is true, then "//& "EPBL_TRANSITION should be greater than 0 and less than 1.") endif call get_param(param_file, mdl, "N2_DISSIPATION_POS", CS%N2_Dissipation_Scale_Pos, & - "A scale for the dissipation of TKE due to stratification "// & - "in the boundary layer, applied when local stratification "// & - "is positive. The default is 0, but should probably be ~0.4.", & + "A scale for the dissipation of TKE due to stratification "//& + "in the boundary layer, applied when local stratification "//& + "is positive. The default is 0, but should probably be ~0.4.", & units="nondim", default=0.0) - call get_param(param_file, mdl, "N2_DISSIPATION_NEG", CS%N2_Dissipation_Scale_Neg,& - "A scale for the dissipation of TKE due to stratification "// & - "in the boundary layer, applied when local stratification "// & - "is negative. The default is 0, but should probably be ~1.", & + call get_param(param_file, mdl, "N2_DISSIPATION_NEG", CS%N2_Dissipation_Scale_Neg, & + "A scale for the dissipation of TKE due to stratification "//& + "in the boundary layer, applied when local stratification "//& + "is negative. The default is 0, but should probably be ~1.", & units="nondim", default=0.0) - call get_param(param_file, mdl, "USE_LA_LI2016", USE_LA_Windsea, & + call get_param(param_file, mdl, "USE_LA_LI2016", USE_LA_Windsea, & "A logical to use the Li et al. 2016 (submitted) formula to "//& "determine the Langmuir number.", units="nondim", default=.false.) ! Note this can be activated in other ways, but this preserves the old method. @@ -2293,43 +2304,43 @@ subroutine energetic_PBL_init(Time, G, GV, US, param_file, diag, CS) CS%USE_LT = .true. else call get_param(param_file, mdl, "EPBL_LT", CS%USE_LT, & - "A logical to use a LT parameterization.", & + "A logical to use a LT parameterization.", & units="nondim", default=.false.) endif if (CS%USE_LT) then call get_param(param_file, mdl, "LT_ENHANCE", CS%LT_ENHANCE_FORM, & - "Integer for Langmuir number mode. \n"// & - " *Requires USE_LA_LI2016 to be set to True. \n"// & - "Options: 0 - No Langmuir \n"// & - " 1 - Van Roekel et al. 2014/Li et al., 2016 \n"// & - " 2 - Multiplied w/ adjusted La. \n"// & - " 3 - Added w/ adjusted La.", & + "Integer for Langmuir number mode. \n"//& + " *Requires USE_LA_LI2016 to be set to True. \n"//& + "Options: 0 - No Langmuir \n"//& + " 1 - Van Roekel et al. 2014/Li et al., 2016 \n"//& + " 2 - Multiplied w/ adjusted La. \n"//& + " 3 - Added w/ adjusted La.", & units="nondim", default=0) call get_param(param_file, mdl, "LT_ENHANCE_COEF", CS%LT_ENHANCE_COEF, & - "Coefficient for Langmuir enhancement if LT_ENHANCE > 1", & + "Coefficient for Langmuir enhancement if LT_ENHANCE > 1", & units="nondim", default=0.447) call get_param(param_file, mdl, "LT_ENHANCE_EXP", CS%LT_ENHANCE_EXP, & - "Exponent for Langmuir enhancement if LT_ENHANCE > 1", & + "Exponent for Langmuir enhancement if LT_ENHANCE > 1", & units="nondim", default=-1.33) - call get_param(param_file, mdl, "LT_MOD_LAC1", CS%LaC_MLDoEK, & + call get_param(param_file, mdl, "LT_MOD_LAC1", CS%LaC_MLDoEK, & "Coefficient for modification of Langmuir number due to "//& - "MLD approaching Ekman depth if LT_ENHANCE=2.", & + "MLD approaching Ekman depth if LT_ENHANCE=2.", & units="nondim", default=-0.87) call get_param(param_file, mdl, "LT_MOD_LAC2", CS%LaC_MLDoOB_stab, & - "Coefficient for modification of Langmuir number due to "// & - "MLD approaching stable Obukhov depth if LT_ENHANCE=2.", & + "Coefficient for modification of Langmuir number due to "//& + "MLD approaching stable Obukhov depth if LT_ENHANCE=2.", & units="nondim", default=0.0) call get_param(param_file, mdl, "LT_MOD_LAC3", CS%LaC_MLDoOB_un, & "Coefficient for modification of Langmuir number due to "//& "MLD approaching unstable Obukhov depth if LT_ENHANCE=2.", & units="nondim", default=0.0) call get_param(param_file, mdl, "LT_MOD_LAC4", CS%Lac_EKoOB_stab, & - "Coefficient for modification of Langmuir number due to "// & - "ratio of Ekman to stable Obukhov depth if LT_ENHANCE=2.", & + "Coefficient for modification of Langmuir number due to "//& + "ratio of Ekman to stable Obukhov depth if LT_ENHANCE=2.", & units="nondim", default=0.95) - call get_param(param_file, mdl, "LT_MOD_LAC5", CS%Lac_EKoOB_un, & - "Coefficient for modification of Langmuir number due to "// & - "ratio of Ekman to unstable Obukhov depth if LT_ENHANCE=2.",& + call get_param(param_file, mdl, "LT_MOD_LAC5", CS%Lac_EKoOB_un, & + "Coefficient for modification of Langmuir number due to "//& + "ratio of Ekman to unstable Obukhov depth if LT_ENHANCE=2.", & units="nondim", default=0.95) endif ! This gives a minimum decay scale that is typically much less than Angstrom. From 45dc3f604b6cc1bf6dd69a9b605d58afab1b00e6 Mon Sep 17 00:00:00 2001 From: Brandon Reichl Date: Thu, 6 Jun 2019 10:14:40 -0400 Subject: [PATCH 08/82] Formatting/comment updates in MOM_energetic_PBL.F90 --- .../vertical/MOM_energetic_PBL.F90 | 24 +++++++++---------- 1 file changed, 11 insertions(+), 13 deletions(-) diff --git a/src/parameterizations/vertical/MOM_energetic_PBL.F90 b/src/parameterizations/vertical/MOM_energetic_PBL.F90 index 6250762674..71ddc2731f 100644 --- a/src/parameterizations/vertical/MOM_energetic_PBL.F90 +++ b/src/parameterizations/vertical/MOM_energetic_PBL.F90 @@ -662,16 +662,16 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS if (fluxes%frac_shelf_h(i,j) > 0.0) & U_star = (1.0 - fluxes%frac_shelf_h(i,j)) * U_star + & fluxes%frac_shelf_h(i,j) * fluxes%ustar_shelf(i,j) - endif - if (U_Star < CS%ustar_min) U_Star = CS%ustar_min - if (CS%omega_frac >= 1.0) then - absf(i) = 2.0*CS%omega - else - absf(i) = 0.25*US%s_to_T*((abs(G%CoriolisBu(I,J)) + abs(G%CoriolisBu(I-1,J-1))) + & - (abs(G%CoriolisBu(I,J-1)) + abs(G%CoriolisBu(I-1,J)))) - if (CS%omega_frac > 0.0) & - absf(i) = sqrt(CS%omega_frac*4.0*CS%omega**2 + (1.0-CS%omega_frac)*absf(i)**2) - endif + endif + if (U_Star < CS%ustar_min) U_Star = CS%ustar_min + if (CS%omega_frac >= 1.0) then + absf(i) = 2.0*CS%omega + else + absf(i) = 0.25*US%s_to_T*((abs(G%CoriolisBu(I,J)) + abs(G%CoriolisBu(I-1,J-1))) + & + (abs(G%CoriolisBu(I,J-1)) + abs(G%CoriolisBu(I-1,J)))) + if (CS%omega_frac > 0.0) & + absf(i) = sqrt(CS%omega_frac*4.0*CS%omega**2 + (1.0-CS%omega_frac)*absf(i)**2) + endif ! endif ; enddo @@ -723,13 +723,11 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS min_MLD = 0.0 !/BGR: Add MLD_guess based on stored previous value. - ! note that this is different from ML_Depth already - ! computed by EPBL, need to figure out why. if (CS%MLD_iteration_guess .and. (CS%ML_Depth2(i,j) > 1.0*US%m_to_Z)) then !If prev value is present use for guess. MLD_guess = CS%ML_Depth2(i,j) else - !Otherwise guess middle of water column (or Stab_Scale if smaller). + !Otherwise guess middle of water column MLD_guess = 0.5 * (min_MLD+max_MLD) endif From 4483c26db9063455f9739546ecdef3932e3f470d Mon Sep 17 00:00:00 2001 From: Brandon Reichl Date: Thu, 6 Jun 2019 11:37:54 -0400 Subject: [PATCH 09/82] Updating comments in MOM_energetic_PBL.F90 --- .../vertical/MOM_energetic_PBL.F90 | 64 ++++++++----------- 1 file changed, 27 insertions(+), 37 deletions(-) diff --git a/src/parameterizations/vertical/MOM_energetic_PBL.F90 b/src/parameterizations/vertical/MOM_energetic_PBL.F90 index e123d7ccba..796706969e 100644 --- a/src/parameterizations/vertical/MOM_energetic_PBL.F90 +++ b/src/parameterizations/vertical/MOM_energetic_PBL.F90 @@ -414,9 +414,9 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS real :: vstar ! An in-situ turbulent velocity [m s-1]. real :: mstar_total ! The value of mstar used in ePBL real :: enhance_mstar ! An ehhancement to mstar (output for diagnostic) - real :: mstar_LT ! An addition to mstar (output for diagnostic) - real :: LA ! The value of the Langmuir number - real :: LAmod ! + real :: mstar_LT ! An addition to mstar (output for diagnostic) + real :: LA ! The value of the Langmuir number + real :: LAmod ! The modified Langmuir number by convection real :: hbs_here ! The local minimum of hb_hs and MixLen_shape, times a ! conversion factor from H to Z [Z H-1 ~> 1 or m3 kg-1]. real :: nstar_FC ! The fraction of conv_PErel that can be converted to mixing [nondim]. @@ -767,7 +767,7 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS endif !/ Apply MStar to get mech_TKE - !This bit of code preserves answers but should be eliminated. + !THIS BIT OF CODE IS NEEDED TO PRESERVE ANSWERS, BUT SHOULD BE DELETED if (CS%mstar_mode==0) then mech_TKE(i) = (dt*MSTAR_total*GV%Rho0) * US%Z_to_m**3 * U_star**3 else @@ -1829,30 +1829,18 @@ end subroutine find_PE_chg_orig subroutine Find_Mstar(CS,US, Buoyancy_Flux, UStar, UStar_Mean,& BLD, Abs_Coriolis, MStar, Langmuir_Number,& MStar_LT, Enhance_MStar, Convect_Langmuir_Number) - type(energetic_PBL_CS), pointer ::& - CS !< Energetic_PBL control structure. - type(unit_scale_type), intent(in) ::& - US !< A dimensional unit scaling type - real, intent(in) :: & - UStar !< ustar w/ gustiness - real, intent(in) ::& - UStar_Mean !< ustar w/o gustiness - real, intent(in) ::& - Abs_Coriolis !< abolute value of Coriolis parameter - real, intent(in) ::& - Buoyancy_Flux !< Buoyancy flux - real, intent(in) ::& - BLD !< boundary layer depth - real, intent(out) ::& - Mstar !< Ouput mstar (Mixing/ustar**3) - real, optional, intent(in) ::& - Langmuir_Number !Langmuir number - real, optional, intent(out) ::& - MStar_LT !< Additive mstar increase due to Langmuir turbulence - real, optional, intent(out) ::& - Enhance_MStar !< Multiplicative mstar increase due to Langmuir turbulence - real, optional, intent(out) ::& - Convect_Langmuir_number !< Langmuir number including buoyancy flux + type(energetic_PBL_CS), pointer :: CS !< Energetic_PBL control structure. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + real, intent(in) :: UStar !< ustar w/ gustiness + real, intent(in) :: UStar_Mean !< ustar w/o gustiness + real, intent(in) :: Abs_Coriolis !< abolute value of Coriolis parameter + real, intent(in) :: Buoyancy_Flux !< Buoyancy flux + real, intent(in) :: BLD !< boundary layer depth + real, intent(out) :: Mstar !< Ouput mstar (Mixing/ustar**3) + real, optional, intent(in) :: Langmuir_Number !Langmuir number + real, optional, intent(out) :: MStar_LT !< Additive mstar increase due to Langmuir turbulence + real, optional, intent(out) :: Enhance_MStar !< Multiplicative mstar increase due to Langmuir turbulence + real, optional, intent(out) :: Convect_Langmuir_number !< Langmuir number including buoyancy flux !/ Variables used in computing mstar real :: MStar_Conv_Red ! Adjustment made to mstar due to convection reducing mechanical mixing. @@ -1959,14 +1947,16 @@ end subroutine Find_Mstar subroutine Mstar_Langmuir(CS,US,abs_Coriolis,buoyancy_flux,ustar,BLD,Langmuir_Number,& mstar,enhance_mstar,mstar_lt, Convect_Langmuir_Number) type(energetic_PBL_CS), pointer :: CS !< Energetic_PBL control structure. - type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - real, intent(in) :: Abs_Coriolis - real, intent(in) :: Buoyancy_Flux - real, intent(in) :: UStar - real, intent(in) :: BLD - real, intent(in) :: Langmuir_Number - real, intent(inout) :: mstar - real, intent(out) :: enhance_mstar, mstar_LT, Convect_Langmuir_Number + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + real, intent(in) :: Abs_Coriolis !< abolute value of Coriolis parameter + real, intent(in) :: Buoyancy_Flux !< Buoyancy flux + real, intent(in) :: UStar !< ustar + real, intent(in) :: BLD !< boundary layer depth + real, intent(inout) :: Mstar !< Input/output mstar (Mixing/ustar**3) + real, intent(in) :: Langmuir_Number !Langmuir number + real, intent(out) :: MStar_LT !< Additive mstar increase due to Langmuir turbulence + real, intent(out) :: Enhance_MStar !< Multiplicative mstar increase due to Langmuir turbulence + real, intent(out) :: Convect_Langmuir_number !< Langmuir number including buoyancy flux !/ real :: iL_Ekman ! Inverse of Ekman length scale [Z-1 ~> m-1]. @@ -2397,7 +2387,7 @@ subroutine energetic_PBL_init(Time, G, GV, US, param_file, diag, CS) call get_param(param_file, mdl, "MIX_LEN_EXPONENT", CS%MixLenExponent, & "The exponent applied to the ratio of the distance to the MLD "//& "and the MLD depth which determines the shape of the mixing length. "//& - "This is only used if",& !BGR-finish comment " + "This is only used if USE_MLD_ITERATION is True.",& "units=nondim", default=2.0) From 14fc76e55aeeba6c2888f09b3a9eef2418d01b93 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Thu, 6 Jun 2019 13:18:29 -0400 Subject: [PATCH 10/82] Added parentheses to a sum in add_drag_diffusivity Added parentheses to a 3-term sum in add_drag_diffusivity, using the order that reproduces the answers with three compilers. All answers in the MOM6-examples test cases are bitwise identical. --- src/parameterizations/vertical/MOM_set_diffusivity.F90 | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/src/parameterizations/vertical/MOM_set_diffusivity.F90 b/src/parameterizations/vertical/MOM_set_diffusivity.F90 index 5d6feb8f44..aa843e3ad5 100644 --- a/src/parameterizations/vertical/MOM_set_diffusivity.F90 +++ b/src/parameterizations/vertical/MOM_set_diffusivity.F90 @@ -1282,8 +1282,7 @@ subroutine add_drag_diffusivity(h, u, v, tv, fluxes, visc, j, TKE_to_Kd, & elseif (Kd_lay(i,j,k) + (TKE_to_layer + TKE_Ray) * TKE_to_Kd(i,k) > & maxTKE(i,k) * TKE_to_Kd(i,k)) then TKE_here = ((TKE_to_layer + TKE_Ray) + Kd_lay(i,j,k) / TKE_to_Kd(i,k)) - maxTKE(i,k) - ! ### Non-bracketed ternary sum - TKE(i) = TKE(i) - TKE_here + TKE_Ray + TKE(i) = (TKE(i) - TKE_here) + TKE_Ray else TKE_here = TKE_to_layer + TKE_Ray TKE(i) = TKE(i) - TKE_to_layer From f5c9aa0f90730cf60b3d63efaf3f4cdeb0d7d5ad Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Mon, 10 Jun 2019 19:12:46 -0400 Subject: [PATCH 11/82] Code clean-up in MOM_energetic_PBL Various code clean-up in MOM_energetic_PBL, including the following: Corrected the indenting. Commented out some variables that were only of use for debugging during model development. Restored several lines that do simple assignments on a single line with semicolons. Followed MOM6 standards with regard to the non-use of argument names for non-optional arguments. Corrected the case of the K index for the interface variable Kd in a number of places. Added some comments documenting various options. Added units to the comments describing several subroutine arguments. All answers are bitwise identical and there are no changes to MOM_parameter_doc files. --- .../vertical/MOM_energetic_PBL.F90 | 563 +++++++++--------- 1 file changed, 278 insertions(+), 285 deletions(-) diff --git a/src/parameterizations/vertical/MOM_energetic_PBL.F90 b/src/parameterizations/vertical/MOM_energetic_PBL.F90 index dc2b407daa..3bc5e79c2b 100644 --- a/src/parameterizations/vertical/MOM_energetic_PBL.F90 +++ b/src/parameterizations/vertical/MOM_energetic_PBL.F90 @@ -412,11 +412,11 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS real :: U_Star_Mean ! The surface friction without gustiness [Z s-1 ~> m s-1]. real :: B_Flux ! The surface buoyancy flux [Z2 s-3 ~> m2 s-3] real :: vstar ! An in-situ turbulent velocity [m s-1]. - real :: mstar_total ! The value of mstar used in ePBL + real :: mstar_total ! The value of mstar used in ePBL [nondim] real :: enhance_mstar ! An ehhancement to mstar (output for diagnostic) - real :: mstar_LT ! An addition to mstar (output for diagnostic) - real :: LA ! The value of the Langmuir number - real :: LAmod ! The modified Langmuir number by convection + real :: mstar_LT ! An addition to mstar [nondim] (output for diagnostic) + real :: LA ! The value of the Langmuir number [nondim] + real :: LAmod ! The modified Langmuir number by convection [nondim] real :: hbs_here ! The local minimum of hb_hs and MixLen_shape, times a ! conversion factor from H to Z [Z H-1 ~> 1 or m3 kg-1]. real :: nstar_FC ! The fraction of conv_PErel that can be converted to mixing [nondim]. @@ -516,18 +516,20 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS ! e.g. M=12 for DEPTH=4000m and DZ=1m real, dimension(SZK_(GV)+1) :: Vstar_Used, & ! 1D arrays used to store Mixing_Length_Used ! Vstar and Mixing_Length + !/BGR - remaining variables are related to tracking iteration statistics. - logical :: OBL_IT_STATS=.false. ! Flag for computing OBL iteration statistics - REAL :: ITguess(20), ITresult(20),ITmax(20),ITmin(20) ! Flag for storing guess/result + ! logical :: OBL_IT_STATS=.false. ! Flag for computing OBL iteration statistics + ! real :: ITguess(20), ITresult(20),ITmax(20),ITmin(20) ! Flag for storing guess/result ! should have dim=MAX_OBL_IT - integer, save :: MAXIT=0 ! Stores maximum number of iterations - integer, save :: MINIT=1e8 ! Stores minimum number of iterations - integer, save :: SUMIT=0 ! Stores total iterations (summed over all) - integer, save :: NUMIT=0 ! Stores number of times iterated + ! integer, save :: MAXIT=0 ! Stores maximum number of iterations + ! integer, save :: MINIT=1e8 ! Stores minimum number of iterations + ! integer, save :: SUMIT=0 ! Stores total iterations (summed over all) + ! integer, save :: NUMIT=0 ! Stores number of times iterated !e.g. Average iterations = SUMIT/NUMIT - integer, save :: CONVERGED! - integer, save :: NOTCONVERGED! + ! integer, save :: CONVERGED! + ! integer, save :: NOTCONVERGED! !-End BGR iteration parameters----------------------------------------- + real :: N2_dissipation real :: Surface_Scale ! Surface decay scale for vstar real :: K_Enhancement ! A local enhancement of K, perhaps due to Langmuir turbulence @@ -652,192 +654,172 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS ! homogenizing the shortwave heating within that cell. This sets the energy ! and ustar and wstar available to drive mixing at the first interior ! interface. - do i=is,ie - if (G%mask2dT(i,j) > 0.5) then - - U_star = fluxes%ustar(i,j) - U_Star_Mean = fluxes%ustar_gustless(i,j) - B_Flux = buoy_flux(i,j) - if (associated(fluxes%ustar_shelf) .and. associated(fluxes%frac_shelf_h)) then - if (fluxes%frac_shelf_h(i,j) > 0.0) & - U_star = (1.0 - fluxes%frac_shelf_h(i,j)) * U_star + & - fluxes%frac_shelf_h(i,j) * fluxes%ustar_shelf(i,j) - endif - if (U_Star < CS%ustar_min) U_Star = CS%ustar_min - if (CS%omega_frac >= 1.0) then - absf(i) = 2.0*CS%omega - else - absf(i) = 0.25*US%s_to_T*((abs(G%CoriolisBu(I,J)) + abs(G%CoriolisBu(I-1,J-1))) + & - (abs(G%CoriolisBu(I,J-1)) + abs(G%CoriolisBu(I-1,J)))) - if (CS%omega_frac > 0.0) & - absf(i) = sqrt(CS%omega_frac*4.0*CS%omega**2 + (1.0-CS%omega_frac)*absf(i)**2) - endif + do i=is,ie ; if (G%mask2dT(i,j) > 0.5) then + + U_star = fluxes%ustar(i,j) + U_Star_Mean = fluxes%ustar_gustless(i,j) + B_Flux = buoy_flux(i,j) + if (associated(fluxes%ustar_shelf) .and. associated(fluxes%frac_shelf_h)) then + if (fluxes%frac_shelf_h(i,j) > 0.0) & + U_star = (1.0 - fluxes%frac_shelf_h(i,j)) * U_star + & + fluxes%frac_shelf_h(i,j) * fluxes%ustar_shelf(i,j) + endif + if (U_Star < CS%ustar_min) U_Star = CS%ustar_min + if (CS%omega_frac >= 1.0) then + absf(i) = 2.0*CS%omega + else + absf(i) = 0.25*US%s_to_T*((abs(G%CoriolisBu(I,J)) + abs(G%CoriolisBu(I-1,J-1))) + & + (abs(G%CoriolisBu(I,J-1)) + abs(G%CoriolisBu(I-1,J)))) + if (CS%omega_frac > 0.0) & + absf(i) = sqrt(CS%omega_frac*4.0*CS%omega**2 + (1.0-CS%omega_frac)*absf(i)**2) + endif ! endif ; enddo ! do i=is,ie ; if (G%mask2dT(i,j) > 0.5) then - h_sum(i) = H_neglect - do k=1,nz - h_sum(i) = h_sum(i) + h(i,k) - enddo - I_hs = 0.0 - if (h_sum(i) > 0.0) I_hs = 1.0 / h_sum(i) - h_bot = 0.0 - hb_hs(i,nz+1) = 0.0 - do k=nz,1,-1 - h_bot = h_bot + h(i,k) - hb_hs(i,K) = h_bot * I_hs - enddo + h_sum(i) = H_neglect + do k=1,nz + h_sum(i) = h_sum(i) + h(i,k) + enddo + I_hs = 0.0 + if (h_sum(i) > 0.0) I_hs = 1.0 / h_sum(i) + h_bot = 0.0 + hb_hs(i,nz+1) = 0.0 + do k=nz,1,-1 + h_bot = h_bot + h(i,k) + hb_hs(i,K) = h_bot * I_hs + enddo - pres(i,1) = 0.0 - pres_Z(i,1) = 0.0 - do k=1,nz - dMass = GV%H_to_kg_m2 * h(i,k) - dPres = (GV%g_Earth*US%m_to_Z) * dMass ! This is equivalent to GV%H_to_Pa * h(i,k) - dT_to_dPE(i,k) = (dMass * (pres(i,K) + 0.5*dPres)) * dSV_dT(i,j,k) - dS_to_dPE(i,k) = (dMass * (pres(i,K) + 0.5*dPres)) * dSV_dS(i,j,k) - dT_to_dColHt(i,k) = dMass * US%m_to_Z * dSV_dT(i,j,k) - dS_to_dColHt(i,k) = dMass * US%m_to_Z * dSV_dS(i,j,k) - - pres(i,K+1) = pres(i,K) + dPres - pres_Z(i,K+1) = US%Z_to_m * pres(i,K+1) - enddo + pres(i,1) = 0.0 + pres_Z(i,1) = 0.0 + do k=1,nz + dMass = GV%H_to_kg_m2 * h(i,k) + dPres = (GV%g_Earth*US%m_to_Z) * dMass ! This is equivalent to GV%H_to_Pa * h(i,k) + dT_to_dPE(i,k) = (dMass * (pres(i,K) + 0.5*dPres)) * dSV_dT(i,j,k) + dS_to_dPE(i,k) = (dMass * (pres(i,K) + 0.5*dPres)) * dSV_dS(i,j,k) + dT_to_dColHt(i,k) = dMass * US%m_to_Z * dSV_dT(i,j,k) + dS_to_dColHt(i,k) = dMass * US%m_to_Z * dSV_dS(i,j,k) + + pres(i,K+1) = pres(i,K) + dPres + pres_Z(i,K+1) = US%Z_to_m * pres(i,K+1) + enddo ! endif ; enddo ! Note the outer i-loop and inner k-loop loop order!!! ! do i=is,ie ; if (G%mask2dT(i,j) > 0.5) then - do k=1,nz - T0(k) = T(i,k) - S0(k) = S(i,k) - enddo + do k=1,nz ; T0(k) = T(i,k) ; S0(k) = S(i,k) ; enddo + + !/The following lines are for the iteration over MLD + ! max_MLD will initialized as ocean bottom depth + max_MLD = 0.0 ; do k=1,nz ; max_MLD = max_MLD + h(i,k)*GV%H_to_Z ; enddo + !min_MLD will initialize as 0. + min_MLD = 0.0 + + !/BGR: Add MLD_guess based on stored previous value. + if (CS%MLD_iteration_guess .and. (CS%ML_Depth2(i,j) > 1.0*US%m_to_Z)) then + !If prev value is present use for guess. + MLD_guess = CS%ML_Depth2(i,j) + else + !Otherwise guess middle of water column + MLD_guess = 0.5 * (min_MLD + max_MLD) + endif - !/The following lines are for the iteration over MLD - ! max_MLD will initialized as ocean bottom depth - max_MLD = 0.0 - do k=1,nz - max_MLD = max_MLD + h(i,k)*GV%H_to_Z - enddo - !min_MLD will initialize as 0. - min_MLD = 0.0 - - !/BGR: Add MLD_guess based on stored previous value. - if (CS%MLD_iteration_guess .and. (CS%ML_Depth2(i,j) > 1.0*US%m_to_Z)) then - !If prev value is present use for guess. - MLD_guess = CS%ML_Depth2(i,j) - else - !Otherwise guess middle of water column - MLD_guess = 0.5 * (min_MLD+max_MLD) - endif + ! Iterate up to MAX_OBL_IT times to determine a converged EPBL depth. + OBL_CONVERGED = .false. + + do OBL_IT=1,MAX_OBL_IT + + if (.not. OBL_CONVERGED) then + ! If not using MLD_Iteration flag loop to only execute once. + if (.not.CS%Use_MLD_Iteration) OBL_CONVERGED = .true. + + ! Reset ML_depth + CS%ML_depth(i,j) = h(i,1)*GV%H_to_Z + sfc_connected(i) = .true. + + !/ Here we get MStar, which is the ratio of convective TKE driven + ! mixing to UStar**3 + if (CS%Use_LT) then + call get_Langmuir_Number( LA, G, GV, US, abs(MLD_guess), u_star_mean, i, j, & + H=H(i,:), U_H=U(i,:), V_H=V(i,:), WAVES=WAVES) + call find_mstar(CS, US, b_flux, U_Star, U_Star_Mean, MLD_Guess, AbsF(i), & + MStar_total, Langmuir_Number = La, Convect_Langmuir_Number = LAmod,& + Enhance_MStar = Enhance_MStar, mstar_LT = mstar_LT) + else + call find_mstar(CS, US, b_flux, u_star, u_star_mean, MLD_guess, absf(i), mstar_total) + endif + + !/ Apply MStar to get mech_TKE + !THIS BIT OF CODE IS NEEDED TO PRESERVE ANSWERS, BUT SHOULD BE DELETED + ! if ((CS%old_answers) .and. (CS%mstar_mode==0)) then + if (CS%mstar_mode==0) then + mech_TKE(i) = (dt*MSTAR_total*GV%Rho0) * US%Z_to_m**3 * U_star**3 + else + mech_TKE(i) = MSTAR_total * US%Z_to_m**3 * (dt*GV%Rho0*U_star**3) + endif + + !### I suspect that these diagnostics are inconsistently summing over iterations. + if (CS%TKE_diagnostics) then + CS%diag_TKE_wind(i,j) = CS%diag_TKE_wind(i,j) + mech_TKE(i) * IdtdR0 + if (TKE_forced(i,j,1) <= 0.0) then + CS%diag_TKE_forcing(i,j) = CS%diag_TKE_forcing(i,j) + & + max(-mech_TKE(i), TKE_forced(i,j,1)) * IdtdR0 + ! CS%diag_TKE_unbalanced_forcing(i,j) = CS%diag_TKE_unbalanced_forcing(i,j) + & + ! min(0.0, TKE_forced(i,j,1) + mech_TKE(i)) * IdtdR0 + else + CS%diag_TKE_forcing(i,j) = CS%diag_TKE_forcing(i,j) + CS%nstar*TKE_forced(i,j,1) * IdtdR0 + endif + endif + + if (TKE_forced(i,j,1) <= 0.0) then + mech_TKE(i) = mech_TKE(i) + TKE_forced(i,j,1) + if (mech_TKE(i) < 0.0) mech_TKE(i) = 0.0 + conv_PErel(i) = 0.0 + else + conv_PErel(i) = TKE_forced(i,j,1) + endif + + if (CS%TKE_diagnostics) then + dTKE_conv = 0.0 ; dTKE_forcing = 0.0 ; dTKE_mixing = 0.0 + dTKE_MKE = 0.0 ; dTKE_mech_decay = 0.0 ; dTKE_conv_decay = 0.0 + endif + + ! Store in 1D arrays for output. + do k=1,nz + Vstar_Used(k) = 0. + Mixing_Length_Used(k) = 0. + enddo - ! Iterate up to MAX_OBL_IT times to determine a converged EPBL depth. - OBL_CONVERGED = .false. - - do OBL_IT=1,MAX_OBL_IT - - if (.not. OBL_CONVERGED) then - ! If not using MLD_Iteration flag loop to only execute once. - if (.not.CS%Use_MLD_Iteration) OBL_CONVERGED = .true. - - ! Reset ML_depth - CS%ML_depth(i,j) = h(i,1)*GV%H_to_Z - sfc_connected(i) = .true. - - !/ Here we get MStar, which is the ratio of convective TKE driven - ! mixing to UStar**3 - if (CS%Use_LT) then - call get_Langmuir_Number( LA, G, GV, US, abs(MLD_guess), u_star_mean, i, j, & - H=H(i,:), U_H=U(i,:), V_H=V(i,:), WAVES=WAVES) - call find_mstar(CS,& - US,& - Buoyancy_Flux = b_flux,& - UStar = U_Star,& - UStar_Mean = U_Star_Mean,& - BLD = MLD_Guess,& - Abs_Coriolis = AbsF(i),& - MStar = MStar_total,& - Langmuir_Number = La,& - Convect_Langmuir_Number = LAmod,& - Enhance_MStar = Enhance_MStar,& - mstar_LT = mstar_LT) - else - call find_mstar(CS,US, b_flux, u_star, u_star_mean,& - mld_guess, absf(i), mstar_total) - endif - - !/ Apply MStar to get mech_TKE - !THIS BIT OF CODE IS NEEDED TO PRESERVE ANSWERS, BUT SHOULD BE DELETED - if (CS%mstar_mode==0) then - mech_TKE(i) = (dt*MSTAR_total*GV%Rho0) * US%Z_to_m**3 * U_star**3 - else - mech_TKE(i) = MSTAR_total * US%Z_to_m**3 * (dt*GV%Rho0*U_star**3) - endif - - !### I suspect that these diagnostics are inconsistently summing over iterations. - if (CS%TKE_diagnostics) then - CS%diag_TKE_wind(i,j) = CS%diag_TKE_wind(i,j) + mech_TKE(i) * IdtdR0 - if (TKE_forced(i,j,1) <= 0.0) then - CS%diag_TKE_forcing(i,j) = CS%diag_TKE_forcing(i,j) + & - max(-mech_TKE(i), TKE_forced(i,j,1)) * IdtdR0 - ! CS%diag_TKE_unbalanced_forcing(i,j) = CS%diag_TKE_unbalanced_forcing(i,j) + & - ! min(0.0, TKE_forced(i,j,1) + mech_TKE(i)) * IdtdR0 - else - CS%diag_TKE_forcing(i,j) = CS%diag_TKE_forcing(i,j) + CS%nstar*TKE_forced(i,j,1) * IdtdR0 - endif - endif - - if (TKE_forced(i,j,1) <= 0.0) then - mech_TKE(i) = mech_TKE(i) + TKE_forced(i,j,1) - if (mech_TKE(i) < 0.0) mech_TKE(i) = 0.0 - conv_PErel(i) = 0.0 - else - conv_PErel(i) = TKE_forced(i,j,1) - endif - - if (CS%TKE_diagnostics) then - dTKE_conv = 0.0 ; dTKE_forcing = 0.0 ; dTKE_mixing = 0.0 - dTKE_MKE = 0.0 ; dTKE_mech_decay = 0.0 ; dTKE_conv_decay = 0.0 - endif - - ! Store in 1D arrays for output. - do k=1,nz - Vstar_Used(k) = 0. - Mixing_Length_Used(k) = 0. - enddo - - ! Determine the mixing shape function MixLen_shape. - if ((.not.CS%Use_MLD_Iteration) .or. & - (CS%transLay_scale >= 1.0) .or. (CS%transLay_scale < 0.0) ) then - do K=1,nz+1 - MixLen_shape(K) = 1.0 - enddo - elseif (MLD_guess <= 0.0) then - if (CS%transLay_scale > 0.0) then - do K=1,nz+1 - MixLen_shape(K) = CS%transLay_scale - enddo - else - do K=1,nz+1 - MixLen_shape(K) = 1.0 - enddo - endif - else - ! Reduce the mixing length based on MLD, with a quadratic - ! expression that follows KPP. - I_MLD = 1.0 / MLD_guess - h_rsum = 0.0 - MixLen_shape(1) = 1.0 - do K=2,nz+1 - h_rsum = h_rsum + h(i,k-1)*GV%H_to_Z - if (CS%MixLenExponent==2.0) then - MixLen_shape(K) = CS%transLay_scale + (1.0 - CS%transLay_scale) * & - (max(0.0, (MLD_guess - h_rsum)*I_MLD) )**2 ! CS%MixLenExponent - else - MixLen_shape(K) = CS%transLay_scale + (1.0 - CS%transLay_scale) * & - (max(0.0, (MLD_guess - h_rsum)*I_MLD) )**CS%MixLenExponent - endif - enddo + ! Determine the mixing shape function MixLen_shape. + if ((.not.CS%Use_MLD_Iteration) .or. & + (CS%transLay_scale >= 1.0) .or. (CS%transLay_scale < 0.0) ) then + do K=1,nz+1 + MixLen_shape(K) = 1.0 + enddo + elseif (MLD_guess <= 0.0) then + if (CS%transLay_scale > 0.0) then ; do K=1,nz+1 + MixLen_shape(K) = CS%transLay_scale + enddo ; else ; do K=1,nz+1 + MixLen_shape(K) = 1.0 + enddo ; endif + else + ! Reduce the mixing length based on MLD, with a quadratic + ! expression that follows KPP. + I_MLD = 1.0 / MLD_guess + h_rsum = 0.0 + MixLen_shape(1) = 1.0 + do K=2,nz+1 + h_rsum = h_rsum + h(i,k-1)*GV%H_to_Z + if (CS%MixLenExponent==2.0) then + MixLen_shape(K) = CS%transLay_scale + (1.0 - CS%transLay_scale) * & + (max(0.0, (MLD_guess - h_rsum)*I_MLD) )**2 ! CS%MixLenExponent + else + MixLen_shape(K) = CS%transLay_scale + (1.0 - CS%transLay_scale) * & + (max(0.0, (MLD_guess - h_rsum)*I_MLD) )**CS%MixLenExponent + endif + enddo endif Kd(i,1) = 0.0 ; Kddt_h(1) = 0.0 @@ -1054,20 +1036,20 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS if (CS%orig_PE_calc) then call find_PE_chg_orig(Kddt_h_g0, h(i,k), hp_a(i), dTe_term, dSe_term, & - dT_km1_t2, dS_km1_t2, dT_to_dPE(i,k), dS_to_dPE(i,k), & - dT_to_dPE_a(i,k-1), dS_to_dPE_a(i,k-1), & - pres_Z(i,K), dT_to_dColHt(i,k), dS_to_dColHt(i,k), & - dT_to_dColHt_a(i,k-1), dS_to_dColHt_a(i,k-1), & - PE_chg=PE_chg_g0, dPEc_dKd=dPEa_dKd_g0, dPE_max=PE_chg_max, & - dPEc_dKd_0=dPEc_dKd_Kd0 ) + dT_km1_t2, dS_km1_t2, dT_to_dPE(i,k), dS_to_dPE(i,k), & + dT_to_dPE_a(i,k-1), dS_to_dPE_a(i,k-1), & + pres_Z(i,K), dT_to_dColHt(i,k), dS_to_dColHt(i,k), & + dT_to_dColHt_a(i,k-1), dS_to_dColHt_a(i,k-1), & + PE_chg=PE_chg_g0, dPEc_dKd=dPEa_dKd_g0, dPE_max=PE_chg_max, & + dPEc_dKd_0=dPEc_dKd_Kd0 ) else call find_PE_chg(0.0, Kddt_h_g0, hp_a(i), h(i,k), & - Th_a(k-1), Sh_a(k-1), Th_b(k), Sh_b(k), & - dT_to_dPE_a(i,k-1), dS_to_dPE_a(i,k-1), dT_to_dPE(i,k), dS_to_dPE(i,k), & - pres_Z(i,K), dT_to_dColHt_a(i,k-1), dS_to_dColHt_a(i,k-1), & - dT_to_dColHt(i,k), dS_to_dColHt(i,k), & - PE_chg=PE_chg_g0, dPEc_dKd=dPEa_dKd_g0, dPE_max=PE_chg_max, & - dPEc_dKd_0=dPEc_dKd_Kd0 ) + Th_a(k-1), Sh_a(k-1), Th_b(k), Sh_b(k), & + dT_to_dPE_a(i,k-1), dS_to_dPE_a(i,k-1), dT_to_dPE(i,k), dS_to_dPE(i,k), & + pres_Z(i,K), dT_to_dColHt_a(i,k-1), dS_to_dColHt_a(i,k-1), & + dT_to_dColHt(i,k), dS_to_dColHt(i,k), & + PE_chg=PE_chg_g0, dPEc_dKd=dPEa_dKd_g0, dPE_max=PE_chg_max, & + dPEc_dKd_0=dPEc_dKd_Kd0 ) endif MKE_src = dMKE_max*(1.0 - exp(-Kddt_h_g0 * MKE2_Hharm)) @@ -1080,6 +1062,7 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS N2_dissipation = 1.+CS%N2_DISSIPATION_SCALE_POS endif + ! This block checks out different cases to determine Kd at the present interface. if ((PE_chg_g0 < 0.0) .or. ((vstar == 0.0) .and. (dPEc_dKd_Kd0 < 0.0))) then ! This column is convectively unstable. if (PE_chg_max <= 0.0) then @@ -1100,46 +1083,46 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS if (.not.CS%Use_MLD_Iteration) then ! Note again (as prev) that using Mixing_Length_Used here ! instead of redoing the computation will change answers... - Kd(i,k) = vstar * CS%vonKar * ((h_tt*hbs_here)*vstar) / & + Kd(i,K) = vstar * CS%vonKar * ((h_tt*hbs_here)*vstar) / & ((CS%Ekman_scale_coef * absf(i)) * (h_tt*hbs_here) + vstar) else - Kd(i,k) = vstar * CS%vonKar * Mixing_Length_Used(k) + Kd(i,K) = vstar * CS%vonKar * Mixing_Length_Used(k) endif ! Compute the local enhnacement of K (perhaps due to Langmuir) if (CS%LT_ENH_K_R16) then !### K_Enhancement is not used, and this option is uncommon. Shape_Function = htot(i)/MLD_guess*(1.-htot(i)/MLD_guess)**2 K_Enhancement = ( min( Max_K_Enhancement,1.+1./La ) - 1. ) - Kd(i,k) = Kd(i,K) * Shape_Function / Max_Shape_Function + Kd(i,K) = Kd(i,K) * Shape_Function / Max_Shape_Function endif else - vstar = 0.0 ; Kd(i,k) = 0.0 + vstar = 0.0 ; Kd(i,K) = 0.0 endif Vstar_Used(k) = vstar if (CS%orig_PE_calc) then - call find_PE_chg_orig(Kd(i,k)*dt_h, h(i,k), hp_a(i), dTe_term, dSe_term, & - dT_km1_t2, dS_km1_t2, dT_to_dPE(i,k), dS_to_dPE(i,k), & - dT_to_dPE_a(i,k-1), dS_to_dPE_a(i,k-1), & - pres_Z(i,K), dT_to_dColHt(i,k), dS_to_dColHt(i,k), & - dT_to_dColHt_a(i,k-1), dS_to_dColHt_a(i,k-1), & - PE_chg=dPE_conv) + call find_PE_chg_orig(Kd(i,K)*dt_h, h(i,k), hp_a(i), dTe_term, dSe_term, & + dT_km1_t2, dS_km1_t2, dT_to_dPE(i,k), dS_to_dPE(i,k), & + dT_to_dPE_a(i,k-1), dS_to_dPE_a(i,k-1), & + pres_Z(i,K), dT_to_dColHt(i,k), dS_to_dColHt(i,k), & + dT_to_dColHt_a(i,k-1), dS_to_dColHt_a(i,k-1), & + PE_chg=dPE_conv) else - call find_PE_chg(0.0, Kd(i,k)*dt_h, hp_a(i), h(i,k), & - Th_a(k-1), Sh_a(k-1), Th_b(k), Sh_b(k), & - dT_to_dPE_a(i,k-1), dS_to_dPE_a(i,k-1), dT_to_dPE(i,k), dS_to_dPE(i,k), & - pres_Z(i,K), dT_to_dColHt_a(i,k-1), dS_to_dColHt_a(i,k-1), & - dT_to_dColHt(i,k), dS_to_dColHt(i,k), & - PE_chg=dPE_conv) + call find_PE_chg(0.0, Kd(i,K)*dt_h, hp_a(i), h(i,k), & + Th_a(k-1), Sh_a(k-1), Th_b(k), Sh_b(k), & + dT_to_dPE_a(i,k-1), dS_to_dPE_a(i,k-1), dT_to_dPE(i,k), dS_to_dPE(i,k), & + pres_Z(i,K), dT_to_dColHt_a(i,k-1), dS_to_dColHt_a(i,k-1), & + dT_to_dColHt(i,k), dS_to_dColHt(i,k), & + PE_chg=dPE_conv) endif ! Should this be iterated to convergence for Kd? if (dPE_conv > 0.0) then - Kd(i,k) = Kd_guess0 ; dPE_conv = PE_chg_g0 + Kd(i,K) = Kd_guess0 ; dPE_conv = PE_chg_g0 else - MKE_src = dMKE_max*(1.0 - exp(-(Kd(i,k)*dt_h) * MKE2_Hharm)) + MKE_src = dMKE_max*(1.0 - exp(-(Kd(i,K)*dt_h) * MKE2_Hharm)) endif else ! The energy change does not vary monotonically with Kddt_h. Find the maximum? - Kd(i,k) = Kd_guess0 ; dPE_conv = PE_chg_g0 + Kd(i,K) = Kd_guess0 ; dPE_conv = PE_chg_g0 endif conv_PErel(i) = conv_PErel(i) - dPE_conv @@ -1153,10 +1136,11 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS ! CS%ML_depth2(i,j) = CS%ML_depth2(i,J) + GV%H_to_Z * h(i,k) endif - Kddt_h(K) = Kd(i,k)*dt_h + Kddt_h(K) = Kd(i,K)*dt_h elseif (tot_TKE + (MKE_src - N2_DISSIPATION*PE_chg_g0) >= 0.0) then - ! There is energy to support the suggested mixing. Keep that estimate. - Kd(i,k) = Kd_guess0 + ! This column is convctively stable and there is energy to support the suggested + ! mixing. Keep that estimate. + Kd(i,K) = Kd_guess0 Kddt_h(K) = Kddt_h_g0 ! Reduce the mechanical and convective TKE proportionately. @@ -1178,8 +1162,8 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS endif elseif (tot_TKE == 0.0) then - ! This can arise if nstar_FC = 0. - Kd(i,k) = 0.0 ; Kddt_h(K) = 0.0 + ! This can arise if nstar_FC = 0, but it is not common. + Kd(i,K) = 0.0 ; Kddt_h(K) = 0.0 tot_TKE = 0.0 ; conv_PErel(i) = 0.0 ; mech_TKE(i) = 0.0 sfc_disconnect = .true. else @@ -1264,7 +1248,7 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS else Kddt_h_guess = Kddt_h_next endif - enddo + enddo ! Inner iteration loop on itt. Kd(i,K) = Kddt_h_guess / dt_h ; Kddt_h(K) = Kd(i,K)*dt_h ! All TKE should have been consumed. @@ -1280,7 +1264,7 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS tot_TKE = 0.0 ; mech_TKE(i) = 0.0 ; conv_PErel(i) = 0.0 sfc_disconnect = .true. - endif + endif ! End of convective or forced mixing cases to determine Kd. Kddt_h(K) = Kd(i,K)*dt_h ! At this point, the final value of Kddt_h(K) is known, so the @@ -1361,9 +1345,9 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS ! is now dependent on the ML, and therefore the ML needs to be estimated ! more precisely than the grid spacing. !/ - ITmax(obl_it) = max_MLD ! Track max } - ITmin(obl_it) = min_MLD ! Track min } For debug purpose - ITguess(obl_it) = MLD_guess ! Track guess } + ! ITmax(obl_it) = max_MLD ! Track max } + ! ITmin(obl_it) = min_MLD ! Track min } For debug purpose + ! ITguess(obl_it) = MLD_guess ! Track guess } !/ MLD_found = 0.0 ; FIRST_OBL = .true. if (CS%Orig_MLD_iteration) then @@ -1413,14 +1397,14 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS endif ! For next pass, guess average of minimum and maximum values. MLD_guess = 0.5*(min_MLD + max_MLD) - ITresult(obl_it) = MLD_found + ! ITresult(obl_it) = MLD_found endif enddo ! Iteration loop for converged boundary layer thickness. - if (.not.OBL_CONVERGED) then - NOTCONVERGED=NOTCONVERGED+1 - else - CONVERGED=CONVERGED+1 - endif + ! if (.not.OBL_CONVERGED) then + ! NOTCONVERGED = NOTCONVERGED+1 + ! else + ! CONVERGED = CONVERGED+1 + ! endif if (CS%TKE_diagnostics) then CS%diag_TKE_MKE(i,j) = CS%diag_TKE_MKE(i,j) + dTKE_MKE @@ -1432,8 +1416,7 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS ! CS%diag_TKE_unbalanced_forcing(i,j) = CS%diag_TKE_unbalanced_forcing(i,j) + dTKE_unbalanced endif if (CS%Mixing_Diagnostics) then - !Write to 3-D for outputing Mixing length and - ! velocity scale. + ! Write to 3-D for outputing Mixing length and velocity scale. do k=1,nz CS%Mixing_Length(i,j,k) = Mixing_Length_Used(k) CS%Velocity_Scale(i,j,k) = Vstar_Used(k) @@ -1822,22 +1805,23 @@ subroutine find_PE_chg_orig(Kddt_h, h_k, b_den_1, dTe_term, dSe_term, & end subroutine find_PE_chg_orig -!> !> This subroutine finds the Mstar value for ePBL -subroutine Find_Mstar(CS,US, Buoyancy_Flux, UStar, UStar_Mean,& +!> This subroutine finds the Mstar value for ePBL +subroutine find_mstar(CS, US, Buoyancy_Flux, UStar, UStar_Mean,& BLD, Abs_Coriolis, MStar, Langmuir_Number,& MStar_LT, Enhance_MStar, Convect_Langmuir_Number) - type(energetic_PBL_CS), pointer :: CS !< Energetic_PBL control structure. - type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - real, intent(in) :: UStar !< ustar w/ gustiness - real, intent(in) :: UStar_Mean !< ustar w/o gustiness - real, intent(in) :: Abs_Coriolis !< abolute value of Coriolis parameter - real, intent(in) :: Buoyancy_Flux !< Buoyancy flux - real, intent(in) :: BLD !< boundary layer depth - real, intent(out) :: Mstar !< Ouput mstar (Mixing/ustar**3) - real, optional, intent(in) :: Langmuir_Number !Langmuir number - real, optional, intent(out) :: MStar_LT !< Additive mstar increase due to Langmuir turbulence - real, optional, intent(out) :: Enhance_MStar !< Multiplicative mstar increase due to Langmuir turbulence - real, optional, intent(out) :: Convect_Langmuir_number !< Langmuir number including buoyancy flux + type(energetic_PBL_CS), pointer :: CS !< Energetic_PBL control structure. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + real, intent(in) :: UStar !< ustar w/ gustiness [Z s-1 ~> m s-1] + real, intent(in) :: UStar_Mean !< ustar w/o gustiness [Z s-1 ~> m s-1] + real, intent(in) :: Abs_Coriolis !< abolute value of the Coriolis parameter [s-1] + real, intent(in) :: Buoyancy_Flux !< Buoyancy flux [Z2 s-3 ~> m2 s-3] + real, intent(in) :: BLD !< boundary layer depth [Z ~> m] + real, intent(out) :: Mstar !< Ouput mstar (Mixing/ustar**3) [nondim] + real, optional, intent(in) :: Langmuir_Number !< Langmuir number [nondim] + real, optional, intent(out) :: MStar_LT !< Additive mstar increase due to Langmuir turbulence [nondim] + real, optional, intent(out) :: Enhance_MStar !< Multiplicative mstar increase due to + !! Langmuir turbulence [nondim] + real, optional, intent(out) :: Convect_Langmuir_number !< Langmuir number including buoyancy flux [nondim] !/ Variables used in computing mstar real :: MStar_Conv_Red ! Adjustment made to mstar due to convection reducing mechanical mixing. @@ -1898,64 +1882,73 @@ subroutine Find_Mstar(CS,US, Buoyancy_Flux, UStar, UStar_Mean,& !delete absf(i) * MLD_guess) & - ! mstar_ROT = CS%C_EK * log(U_star / (absf(i) * MLD_guess)) + ! mstar_N = CS%C_EK * log(U_star / (Abs_Coriolis * MLD_guess)) + !endif + ! Here 1.25 is .5/von Karman, which gives the Obukhov limit. MStar = max(MStar_S, min(1.25, MStar_N)) if (CS%MStar_Cap > 0.0) MStar = min( CS%MStar_Cap,MStar ) - elseif ( CS%MStar_Mode.eq.MStar_from_RH18 ) then - ! MSN_term = CS%RH18_MStar_cn2 * exp( CS%RH18_mstar_CN3 * BLD * Abs_Coriolis / UStar) - ! MStar_N = (CS%RH18_MStar_cn1 * MSN_term) / ( 1. + MSN_term) + elseif ( CS%MStar_Mode == MStar_from_RH18 ) then + !if (CS%OldAnswers) then MStar_N = CS%RH18_MStar_cn1 * ( 1.0 - 1.0 / ( 1. + CS%RH18_MStar_cn2 * & exp( CS%RH18_mstar_CN3 * BLD * Abs_Coriolis / UStar) ) ) - MStar_S = CS%RH18_MStar_CS1 * ( max(0.0,Buoyancy_Flux)**2 * BLD & - / ( UStar**5 * Abs_Coriolis ) )**CS%RH18_mstar_cs2 + !else + ! MSN_term = CS%RH18_MStar_cn2 * exp( CS%RH18_mstar_CN3 * BLD * Abs_Coriolis / UStar) + ! MStar_N = (CS%RH18_MStar_cn1 * MSN_term) / ( 1. + MSN_term) + !endif + MStar_S = CS%RH18_MStar_CS1 * & + ( max(0.0,Buoyancy_Flux)**2 * BLD / ( UStar**5 * Abs_Coriolis ) )**CS%RH18_mstar_cs2 MStar = MStar_N + MStar_S - endif!mstar_mode + endif !mstar_mode !/ 2. Adjust mstar to account for convective turbulence + !if (CS%OldAnswers) then MStar_Conv_Red = 1. - CS%MStar_Convect_coef * (-min(0.0,Buoyancy_Flux) + 1.e-10*US%m_to_Z**2) / & ( (-min(0.0,Buoyancy_Flux) + 1.e-10*US%m_to_Z**2) + & 2.0 *MStar * ustar**3 / BLD ) - ! MSTAR_Conv_Adj = 1. - CS%mstar_convect_coef * ((-BF_Unstable + 1.e-10*US%m_to_Z**2)*MLD_guess) / & - ! ( (-Bf_Unstable + 1.e-10*US%m_to_Z**2)*MLD_guess + & - ! 2.0*MSTAR_MIX * U_star**3 ) + !else + ! MSCR_term1 = (min(0.0,Buoyancy_Flux) + 1.e-10*US%m_to_Z**2)*BLD + ! MSCR_term2 = 2.0*MStar * U_star**3 + ! MStar_Conv_Red = ((1.-CS%mstar_convect_coef) * MSCR_term1 + MSCR_term2) / (MSCR_term1 + MSCR_term2) + !endif !/3. Combine various mstar terms to get final value - MStar = MStar*MStar_Conv_Red + MStar = MStar * MStar_Conv_Red if (present(Langmuir_Number)) then - call mstar_Langmuir(CS,US,abs_Coriolis,buoyancy_flux,ustar,BLD,Langmuir_number,mstar, & - Enhance_MStar, mstar_lt,Convect_Langmuir_Number) + !### In this call, ustar was previously ustar_mean. Is this change deliberate? + call mstar_Langmuir(CS, US, abs_Coriolis, buoyancy_flux, ustar, BLD, Langmuir_number, mstar, & + Enhance_MStar, mstar_lt, Convect_Langmuir_Number) endif - return end subroutine Find_Mstar !> This subroutine modifies the Mstar value if the Langmuir number is present -subroutine Mstar_Langmuir(CS,US,abs_Coriolis,buoyancy_flux,ustar,BLD,Langmuir_Number,& - mstar,enhance_mstar,mstar_lt, Convect_Langmuir_Number) - type(energetic_PBL_CS), pointer :: CS !< Energetic_PBL control structure. - type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - real, intent(in) :: Abs_Coriolis !< abolute value of Coriolis parameter - real, intent(in) :: Buoyancy_Flux !< Buoyancy flux - real, intent(in) :: UStar !< ustar - real, intent(in) :: BLD !< boundary layer depth - real, intent(inout) :: Mstar !< Input/output mstar (Mixing/ustar**3) - real, intent(in) :: Langmuir_Number !Langmuir number - real, intent(out) :: MStar_LT !< Additive mstar increase due to Langmuir turbulence - real, intent(out) :: Enhance_MStar !< Multiplicative mstar increase due to Langmuir turbulence - real, intent(out) :: Convect_Langmuir_number !< Langmuir number including buoyancy flux +subroutine Mstar_Langmuir(CS, US, abs_Coriolis, buoyancy_flux, ustar, BLD, Langmuir_Number, & + mstar, enhance_mstar, mstar_lt, Convect_Langmuir_Number) + type(energetic_PBL_CS), pointer :: CS !< Energetic_PBL control structure. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + real, intent(in) :: Abs_Coriolis !< abolute value of the Coriolis parameter [s-1] + real, intent(in) :: Buoyancy_Flux !< Buoyancy flux [Z2 s-3 ~> m2 s-3] + real, intent(in) :: UStar !< Surface friction velocity with? gustiness [Z s-1 ~> m s-1] + real, intent(in) :: BLD !< boundary layer depth [Z ~> m] + real, intent(inout) :: Mstar !< Input/output mstar (Mixing/ustar**3) [nondim] + real, intent(in) :: Langmuir_Number !Langmuir number [nondim] + real, intent(out) :: MStar_LT !< Additive mstar increase due to Langmuir turbulence [nondim] + real, intent(out) :: Enhance_MStar !< Multiplicative mstar increase due to + !! Langmuir turbulence [nondim] + real, intent(out) :: Convect_Langmuir_number !< Langmuir number including buoyancy flux [nondim] !/ real :: iL_Ekman ! Inverse of Ekman length scale [Z-1 ~> m-1]. From 63b2061377660c39a0e1d30464d8b14e4fdd1572 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 11 Jun 2019 13:41:28 -0400 Subject: [PATCH 12/82] +Deleted unused code & options in MOM_energetic_PBL Eliminated unused code and options in MOM_energetic_PBL, including the recently added but as yet unused and incompletely implemented option LT_ENHANCE_K_R16 and the two duplicated subroutines ust_2_u10_coare3p5 and get_LA_windsea, which are available via the MOM_wave_interface module. Also eliminated code associated with mstar_mode == 1 and some debugging code. Fixed the accumulation of some TKE budget diagnostics when there are multiple iterations, and added comments with notes about additional changes. All answers are bitwise identical in the MOM6-examples test cases, but some of the MOM_parameter_doc.all files have had one entry deleted. --- .../vertical/MOM_energetic_PBL.F90 | 477 ++++-------------- 1 file changed, 93 insertions(+), 384 deletions(-) diff --git a/src/parameterizations/vertical/MOM_energetic_PBL.F90 b/src/parameterizations/vertical/MOM_energetic_PBL.F90 index 3bc5e79c2b..93ffbf34e4 100644 --- a/src/parameterizations/vertical/MOM_energetic_PBL.F90 +++ b/src/parameterizations/vertical/MOM_energetic_PBL.F90 @@ -114,24 +114,6 @@ module MOM_energetic_PBL !! dissipation of TKE produced by shear. This value is used if the option !! for using a fixed mstar is used. - !delete0 at fully developed Ekman depth. - !real :: mstar_xint_up !< Similar but for transition to asymptotic cap. - !real :: mstar_at_xint !< Intercept value of MSTAR at value where function - ! !! changes to linear transition. - !real :: mstar_exp = -2. !< Exponent in decay at negative and positive limits of MLD_over_STAB - !real :: mstar_a !< Coefficients of expressions for mstar in asymptotic limits, computed - ! !! to match the function value and slope at both ends of the linear fit - ! !! within the well constrained region. - !real :: mstar_a2 !< Coefficients of expressions for mstar in asymptotic limits. - !real :: mstar_b !< Coefficients of expressions for mstar in asymptotic limits. - !real :: mstar_b2 !< Coefficients of expressions for mstar in asymptotic limits. - !delete m-1]. real :: iL_Obukhov ! Inverse of Obukhov length scale [Z-1 ~> m-1]. @@ -601,35 +560,11 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS endif -!!OMP parallel do default(none) shared(js,je,nz,is,ie,h_3d,u_3d,v_3d,tv,dt, & +!!OMP parallel do default(private) shared(js,je,nz,is,ie,h_3d,u_3d,v_3d,tv,dt, & !!OMP CS,G,GV,US,fluxes,IdtdR0, & !!OMP TKE_forced,debug,H_neglect,dSV_dT, & !!OMP dSV_dS,I_dtrho,C1_3,h_tt_min,vonKar, & -!!OMP max_itt,Kd_int) & -!!OMP private(i,j,k,h,u,v,T,S,Kd,mech_TKE_k,conv_PErel_k, & -!!OMP U_Star,absf,mech_TKE,conv_PErel,nstar_k, & -!!OMP h_sum,I_hs,h_bot,hb_hs,T0,S0,num_itts, & -!!OMP pres,pres_Z,dMass,dPres,dT_to_dPE,dS_to_dPE, & -!!OMP dT_to_dColHt,dS_to_dColHt,Kddt_h,hp_a, & -!!OMP Th_a,Sh_a,Th_b,Sh_b,dT_to_dPE_a,htot, & -!!OMP dT_to_dColHt_a,dS_to_dColHt_a,uhtot,vhtot, & -!!OMP Idecay_len_TKE,exp_kh,nstar_FC,tot_TKE, & -!!OMP TKE_reduc,dTe_t2,dSe_t2,dTe,dSe,dt_h, & -!!OMP Convectively_stable,sfc_disconnect,b1, & -!!OMP c1,dT_km1_t2,dS_km1_t2,dTe_term, & -!!OMP dSe_term,MKE2_Hharm,vstar,h_tt,h_rsum, & -!!OMP Kd_guess0,Kddt_h_g0,dPEc_dKd_Kd0, & -!!OMP PE_chg_max,dPEa_dKd_g0,PE_chg_g0, & -!!OMP MKE_src,dPE_conv,Kddt_h_max,Kddt_h_min, & -!!OMP dTKE_conv, dTKE_forcing, dTKE_mixing, & -!!OMP dTKE_MKE,dTKE_mech_decay,dTKE_conv_decay,& -!!OMP TKE_left_max,TKE_left_min,Kddt_h_guess, & -!!OMP TKE_left_itt,dPEa_dKd_itt,PE_chg_itt, & -!!OMP MKE_src_itt,Kddt_h_itt,dPEc_dKd,PE_chg, & -!!OMP dMKE_src_dK,TKE_left,use_Newt, & -!!OMP dKddt_h_Newt,Kddt_h_Newt,Kddt_h_next, & -!!OMP dKddt_h,Te,Se,Hsfc_used,dS_to_dPE_a, & -!!OMP dMKE_max,sfc_connected,TKE_here) +!!OMP max_itt,Kd_int) do j=js,je ! Copy the thicknesses and other fields to 2-d arrays. do k=1,nz @@ -674,10 +609,6 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS absf(i) = sqrt(CS%omega_frac*4.0*CS%omega**2 + (1.0-CS%omega_frac)*absf(i)**2) endif -! endif ; enddo - -! do i=is,ie ; if (G%mask2dT(i,j) > 0.5) then - h_sum(i) = H_neglect do k=1,nz h_sum(i) = h_sum(i) + h(i,k) @@ -705,10 +636,6 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS pres_Z(i,K+1) = US%Z_to_m * pres(i,K+1) enddo -! endif ; enddo - - ! Note the outer i-loop and inner k-loop loop order!!! -! do i=is,ie ; if (G%mask2dT(i,j) > 0.5) then do k=1,nz ; T0(k) = T(i,k) ; S0(k) = S(i,k) ; enddo !/The following lines are for the iteration over MLD @@ -760,16 +687,16 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS mech_TKE(i) = MSTAR_total * US%Z_to_m**3 * (dt*GV%Rho0*U_star**3) endif - !### I suspect that these diagnostics are inconsistently summing over iterations. if (CS%TKE_diagnostics) then - CS%diag_TKE_wind(i,j) = CS%diag_TKE_wind(i,j) + mech_TKE(i) * IdtdR0 + dTKE_conv = 0.0 ; dTKE_mixing = 0.0 + dTKE_MKE = 0.0 ; dTKE_mech_decay = 0.0 ; dTKE_conv_decay = 0.0 + + dTKE_wind = mech_TKE(i) * IdtdR0 if (TKE_forced(i,j,1) <= 0.0) then - CS%diag_TKE_forcing(i,j) = CS%diag_TKE_forcing(i,j) + & - max(-mech_TKE(i), TKE_forced(i,j,1)) * IdtdR0 - ! CS%diag_TKE_unbalanced_forcing(i,j) = CS%diag_TKE_unbalanced_forcing(i,j) + & - ! min(0.0, TKE_forced(i,j,1) + mech_TKE(i)) * IdtdR0 + dTKE_forcing = max(-mech_TKE(i), TKE_forced(i,j,1)) * IdtdR0 + ! dTKE_unbalanced_forcing_term1 = min(0.0, TKE_forced(i,j,1) + mech_TKE(i)) * IdtdR0 else - CS%diag_TKE_forcing(i,j) = CS%diag_TKE_forcing(i,j) + CS%nstar*TKE_forced(i,j,1) * IdtdR0 + dTKE_forcing = CS%nstar*TKE_forced(i,j,1) * IdtdR0 endif endif @@ -781,10 +708,6 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS conv_PErel(i) = TKE_forced(i,j,1) endif - if (CS%TKE_diagnostics) then - dTKE_conv = 0.0 ; dTKE_forcing = 0.0 ; dTKE_mixing = 0.0 - dTKE_MKE = 0.0 ; dTKE_mech_decay = 0.0 ; dTKE_conv_decay = 0.0 - endif ! Store in 1D arrays for output. do k=1,nz @@ -1022,12 +945,6 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS else Kd_guess0 = vstar * CS%vonKar * Mixing_Length_Used(k) endif - ! Compute the local enhnacement of K (perhaps due to Langmuir) - if (CS%LT_ENH_K_R16) then !### K_Enhancement is not used, and this option is uncommon. - Shape_Function = htot(i)/MLD_guess*(1.-htot(i)/MLD_guess)**2 - K_Enhancement = ( min( Max_K_Enhancement,1.+1./La ) - 1. ) - Kd_guess0 = Kd_guess0 * Shape_Function / Max_Shape_Function - endif else vstar = 0.0 ; Kd_guess0 = 0.0 endif @@ -1088,12 +1005,6 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS else Kd(i,K) = vstar * CS%vonKar * Mixing_Length_Used(k) endif - ! Compute the local enhnacement of K (perhaps due to Langmuir) - if (CS%LT_ENH_K_R16) then !### K_Enhancement is not used, and this option is uncommon. - Shape_Function = htot(i)/MLD_guess*(1.-htot(i)/MLD_guess)**2 - K_Enhancement = ( min( Max_K_Enhancement,1.+1./La ) - 1. ) - Kd(i,K) = Kd(i,K) * Shape_Function / Max_Shape_Function - endif else vstar = 0.0 ; Kd(i,K) = 0.0 endif @@ -1344,16 +1255,11 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS ! the TKE threshold (ML_DEPTH). This is because the MSTAR ! is now dependent on the ML, and therefore the ML needs to be estimated ! more precisely than the grid spacing. - !/ - ! ITmax(obl_it) = max_MLD ! Track max } - ! ITmin(obl_it) = min_MLD ! Track min } For debug purpose - ! ITguess(obl_it) = MLD_guess ! Track guess } - !/ MLD_found = 0.0 ; FIRST_OBL = .true. if (CS%Orig_MLD_iteration) then - !This is how the iteration was original conducted + ! This is how the iteration was original conducted do k=2,nz - if (FIRST_OBL) then !Breaks when OBL found + if (FIRST_OBL) then ! Breaks when OBL found if ((Vstar_Used(k) > 1.e-10*US%m_to_Z) .and. k < nz) then MLD_found = MLD_found + h(i,k-1)*GV%H_to_Z else @@ -1361,17 +1267,10 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS if (MLD_found - CS%MLD_tol > MLD_guess) then min_MLD = MLD_guess elseif ((MLD_guess - MLD_found) < max(CS%MLD_tol,h(i,k-1)*GV%H_to_Z)) then - OBL_CONVERGED = .true.!Break convergence loop - ! if (OBL_IT_STATS) then !Compute iteration statistics - ! MAXIT = max(MAXIT,obl_it) - ! MINIT = min(MINIT,obl_it) - ! SUMIT = SUMIT+obl_it - ! NUMIT = NUMIT+1 - ! print*,MAXIT,MINIT,SUMIT/NUMIT - ! endif + OBL_CONVERGED = .true. ! Break convergence loop CS%ML_Depth2(i,j) = MLD_guess else - max_MLD = MLD_guess !We know this guess was too deep + max_MLD = MLD_guess ! We know this guess was too deep endif endif endif @@ -1382,38 +1281,26 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS if (MLD_found - CS%MLD_tol > MLD_guess) then min_MLD = MLD_guess elseif (abs(MLD_guess - MLD_found) < CS%MLD_tol) then - OBL_CONVERGED = .true.!Break convergence loop - ! if (OBL_IT_STATS) then !Compute iteration statistics - ! MAXIT = max(MAXIT,obl_it) - ! MINIT = min(MINIT,obl_it) - ! SUMIT = SUMIT+obl_it - ! NUMIT = NUMIT+1 - ! print*,MAXIT,MINIT,SUMIT/NUMIT - ! endif + OBL_CONVERGED = .true. ! Break convergence loop CS%ML_Depth2(i,j) = MLD_guess else - max_MLD = MLD_guess !We know this guess was too deep + max_MLD = MLD_guess ! We know this guess was too deep endif endif ! For next pass, guess average of minimum and maximum values. MLD_guess = 0.5*(min_MLD + max_MLD) - ! ITresult(obl_it) = MLD_found endif enddo ! Iteration loop for converged boundary layer thickness. - ! if (.not.OBL_CONVERGED) then - ! NOTCONVERGED = NOTCONVERGED+1 - ! else - ! CONVERGED = CONVERGED+1 - ! endif if (CS%TKE_diagnostics) then CS%diag_TKE_MKE(i,j) = CS%diag_TKE_MKE(i,j) + dTKE_MKE CS%diag_TKE_conv(i,j) = CS%diag_TKE_conv(i,j) + dTKE_conv CS%diag_TKE_forcing(i,j) = CS%diag_TKE_forcing(i,j) + dTKE_forcing + CS%diag_TKE_wind(i,j) = CS%diag_TKE_wind(i,j) + dTKE_wind CS%diag_TKE_mixing(i,j) = CS%diag_TKE_mixing(i,j) + dTKE_mixing CS%diag_TKE_mech_decay(i,j) = CS%diag_TKE_mech_decay(i,j) + dTKE_mech_decay CS%diag_TKE_conv_decay(i,j) = CS%diag_TKE_conv_decay(i,j) + dTKE_conv_decay - ! CS%diag_TKE_unbalanced_forcing(i,j) = CS%diag_TKE_unbalanced_forcing(i,j) + dTKE_unbalanced + ! CS%diag_TKE_unbalanced_forcing(i,j) = CS%diag_TKE_unbalanced_forcing(i,j) + dTKE_unbalanced_forcing_term1 + dTKE_unbalanced endif if (CS%Mixing_Diagnostics) then ! Write to 3-D for outputing Mixing length and velocity scale. @@ -1829,57 +1716,15 @@ subroutine find_mstar(CS, US, Buoyancy_Flux, UStar, UStar_Mean,& !/ Integer options for how to find mstar integer, parameter :: Use_Fixed_MStar = 0 !< The value of MSTAR_MODE to use a constant mstar - !delete integer, parameter :: MStar_from_BLD = 1 !< The value of MSTAR_MODE to base mstar on the ratio - !delete !! of the mixed layer depth to the Obukhov depth integer, parameter :: MStar_from_Ekman = 2 !< The value of MSTAR_MODE to base mstar on the ratio !! of the Ekman layer depth to the Obukhov depth integer, parameter :: MStar_from_RH18 = 3 !< The value of MSTAR_MODE to base mstar of of RH18 - !delete m]. - !real :: MLD_over_STAB ! Mixing layer depth divided by Stab_Scale - !real :: C_MO = 1. ! Constant in Stab_Scale for Monin-Obukhov - !real :: C_EK = 2. ! Constant in Stab_Scale for Ekman length - !delete -infinity (always) - ! mstar_total = (CS%MSTAR_B*(MLD_over_Stab)+CS%MSTAR_A)**(CS%mstar_exp) - ! else - ! if (CS%MSTAR_CAP>=0.) then - ! if (CS%MSTAR_FLATCAP .OR. (MLD_over_Stab <= CS%MSTAR_XINT_UP)) then - ! !If using flat cap (or if using asymptotic cap - ! ! but within linear regime we can make use of same code) - ! mstar_total = min(CS%MSTAR_CAP, & - ! CS%MSTAR_SLOPE*(MLD_over_Stab)+CS%MSTAR_AT_XINT) - ! else - ! !Asymptote to MSTAR_CAP as MLD_over_Stab -> infinity - ! mstar_total = CS%MSTAR_CAP - & - ! (CS%MSTAR_B2*(MLD_over_Stab-CS%MSTAR_XINT_UP)& - ! +CS%MSTAR_A2)**(CS%mstar_exp) - ! endif - ! else - ! !No cap if negative cap value given. - ! mstar_total = CS%MSTAR_SLOPE*(MLD_over_Stab)+CS%MSTAR_AT_XINT - ! endif - ! endif - !delete absf(i) * MLD_guess) & @@ -1908,7 +1753,7 @@ subroutine find_mstar(CS, US, Buoyancy_Flux, UStar, UStar_Mean,& ! MStar_N = (CS%RH18_MStar_cn1 * MSN_term) / ( 1. + MSN_term) !endif MStar_S = CS%RH18_MStar_CS1 * & - ( max(0.0,Buoyancy_Flux)**2 * BLD / ( UStar**5 * Abs_Coriolis ) )**CS%RH18_mstar_cs2 + ( max(0.0,Buoyancy_Flux)**2 * BLD / ( UStar**5 * max(Abs_Coriolis,1.e-10) ) )**CS%RH18_mstar_cs2 MStar = MStar_N + MStar_S endif !mstar_mode @@ -1918,7 +1763,7 @@ subroutine find_mstar(CS, US, Buoyancy_Flux, UStar, UStar_Mean,& ( (-min(0.0,Buoyancy_Flux) + 1.e-10*US%m_to_Z**2) + & 2.0 *MStar * ustar**3 / BLD ) !else - ! MSCR_term1 = (min(0.0,Buoyancy_Flux) + 1.e-10*US%m_to_Z**2)*BLD + ! MSCR_term1 = -BLD * min(0.0,Buoyancy_Flux) ! MSCR_term2 = 2.0*MStar * U_star**3 ! MStar_Conv_Red = ((1.-CS%mstar_convect_coef) * MSCR_term1 + MSCR_term2) / (MSCR_term1 + MSCR_term2) !endif @@ -1959,50 +1804,52 @@ subroutine Mstar_Langmuir(CS, US, abs_Coriolis, buoyancy_flux, ustar, BLD, Langm real :: MLD_o_Obukhov_un ! Ratios of length scales where MLD is boundary layer depth real :: Ekman_o_Obukhov_un ! > - !if (CS%OldAnswers) then - iL_Ekman = Abs_Coriolis / UStar - iL_Obukhov = Buoyancy_Flux*CS%vonkar / (UStar**3) - Ekman_o_Obukhov_stab = abs(max(0., iL_Obukhov / (iL_Ekman + 1.e-10*US%Z_to_m))) - Ekman_o_Obukhov_un = abs(min(0., iL_Obukhov / (iL_Ekman + 1.e-10*US%Z_to_m))) - !else - ! Max_ratio = 1.0e16 - ! Ekman_Obukhov = Max_ratio - ! if (abs(bflux*vonkar) < Max_ratio*(absf * ustar**2)) then - ! Ekman_Obukhov = buoy_flux(i,j)*vonkar / (absf(i) * U_star**2) - ! endif - ! if (bflux > 0.0) then - ! Ekman_o_Obukhov_stab = Ekman_Obukhov ; Ekman_o_Obukhov_un = 0.0 - ! else - ! Ekman_o_Obukhov_un = Ekman_Obukhov ; Ekman_o_Obukhov_stab = 0.0 - ! endif - !endif + ! Set default values for no Langmuir effects. + enhance_mstar = 1.0 ; mstar_LT = 0.0 - ! a. Get parameters for modified LA - MLD_o_Ekman = abs( BLD*iL_Ekman ) - MLD_o_Obukhov_stab = abs(max(0., BLD*iL_Obukhov)) - MLD_o_Obukhov_un = abs(min(0., BLD*iL_Obukhov)) - ! b. Adjust LA based on various parameters. - ! Assumes linear factors based on length scale ratios to adjust LA - ! Note when these coefficients are set to 0 recovers simple LA. - Convect_Langmuir_Number = Langmuir_Number * ( 1.0 + & - max(-0.5,CS%LaC_MLDoEK * MLD_o_Ekman) + & - CS%LaC_EKoOB_stab * Ekman_o_Obukhov_stab + & - CS%LaC_EKoOB_un * Ekman_o_Obukhov_un + & - CS%LaC_MLDoOB_stab * MLD_o_Obukhov_stab + & - CS%LaC_MLDoOB_un * MLD_o_Obukhov_un ) - if (CS%LT_Enhance_Form==2) then - ! Enhancement is multiplied (added mst_lt set to 0) - Enhance_mstar = min(CS%Max_Enhance_M, & - (1. + CS%LT_ENHANCE_COEF*Convect_Langmuir_Number**CS%LT_ENHANCE_EXP) ) - MSTAR_LT = 0.0 - elseif (CS%LT_ENHANCE_Form == 3) then - ! or Enhancement is additive (multiplied enhance_m set to 1) - mstar_LT = CS%LT_ENHANCE_COEF * Convect_Langmuir_Number**CS%LT_ENHANCE_EXP - enhance_mstar = 1.0 + if (CS%LT_Enhance_Form > 0) then + !if (CS%OldAnswers) then + iL_Ekman = Abs_Coriolis / UStar + iL_Obukhov = Buoyancy_Flux*CS%vonkar / (UStar**3) + Ekman_o_Obukhov_stab = abs(max(0., iL_Obukhov / (iL_Ekman + 1.e-10*US%Z_to_m))) + Ekman_o_Obukhov_un = abs(min(0., iL_Obukhov / (iL_Ekman + 1.e-10*US%Z_to_m))) + !else + ! Max_ratio = 1.0e16 + ! Ekman_Obukhov = Max_ratio + ! if (abs(bflux*vonkar) < Max_ratio*(absf * ustar**2)) then + ! Ekman_Obukhov = buoy_flux(i,j)*vonkar / (absf(i) * U_star**2) + ! endif + ! if (bflux > 0.0) then + ! Ekman_o_Obukhov_stab = Ekman_Obukhov ; Ekman_o_Obukhov_un = 0.0 + ! else + ! Ekman_o_Obukhov_un = Ekman_Obukhov ; Ekman_o_Obukhov_stab = 0.0 + ! endif + !endif + + ! a. Get parameters for modified LA + MLD_o_Ekman = abs( BLD*iL_Ekman ) + MLD_o_Obukhov_stab = abs(max(0., BLD*iL_Obukhov)) + MLD_o_Obukhov_un = abs(min(0., BLD*iL_Obukhov)) + ! b. Adjust LA based on various parameters. + ! Assumes linear factors based on length scale ratios to adjust LA + ! Note when these coefficients are set to 0 recovers simple LA. + Convect_Langmuir_Number = Langmuir_Number * & + ( 1.0 + max(-0.5, CS%LaC_MLDoEK * MLD_o_Ekman) + & + ((CS%LaC_EKoOB_stab * Ekman_o_Obukhov_stab + CS%LaC_EKoOB_un * Ekman_o_Obukhov_un) + & + (CS%LaC_MLDoOB_stab * MLD_o_Obukhov_stab + CS%LaC_MLDoOB_un * MLD_o_Obukhov_un)) ) + + if (CS%LT_Enhance_Form == 2) then + ! Enhancement is multiplied (added mst_lt set to 0) + Enhance_mstar = min(CS%Max_Enhance_M, & + (1. + CS%LT_ENHANCE_COEF*Convect_Langmuir_Number**CS%LT_ENHANCE_EXP) ) + elseif (CS%LT_ENHANCE_Form == 3) then + ! or Enhancement is additive (multiplied enhance_m set to 1) + mstar_LT = CS%LT_ENHANCE_COEF * Convect_Langmuir_Number**CS%LT_ENHANCE_EXP + endif endif mstar = mstar*enhance_mstar + mstar_LT - return + end subroutine Mstar_Langmuir @@ -2025,145 +1872,6 @@ subroutine energetic_PBL_get_MLD(CS, MLD, G, US, m_to_MLD_units) end subroutine energetic_PBL_get_MLD -!### The following two subroutines, ust_2_u10_coare3p5 and get_LA_windsea, appear not to be in use. - -!> Computes wind speed from ustar_air based on COARE 3.5 Cd relationship -subroutine ust_2_u10_coare3p5(USTair, U10, GV, US) - real, intent(in) :: USTair !< Ustar in the air [m s-1]. - type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure - type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - real, intent(out) :: U10 !< The 10 m wind speed [m s-1]. - - real, parameter :: vonkar = 0.4 - real, parameter :: nu=1e-6 - real :: z0sm, z0, z0rough, u10a, alpha, CD - integer :: CT - - ! Uses empirical formula for z0 to convert ustar_air to u10 based on the - ! COARE 3.5 paper (Edson et al., 2013) - !alpha=m*U10+b - !Note in Edson et al. 2013, eq. 13 m is given as 0.017. However, - ! m=0.0017 reproduces the curve in their figure 6. - - z0sm = 0.11 * nu / USTair; !Compute z0smooth from ustar guess - u10 = USTair/sqrt(0.001); !Guess for u10 - u10a = 1000 - - CT=0 - do while (abs(u10a/u10-1.)>0.001) - CT=CT+1 - u10a = u10 - alpha = min(0.028,0.0017 * u10 - 0.005) - z0rough = alpha * USTair**2/(GV%g_Earth*US%m_to_Z) ! Compute z0rough from ustar guess - z0=z0sm+z0rough - CD = ( vonkar / log(10.0/z0) )**2 ! Compute CD from derived roughness - u10 = USTair/sqrt(CD);!Compute new u10 from derived CD, while loop - ! ends and checks for convergence...CT counter - ! makes sure loop doesn't run away if function - ! doesn't converge. This code was produced offline - ! and converged rapidly (e.g. 2 cycles) - ! for ustar=0.0001:0.0001:10. - if (CT>20) then - u10 = USTair/sqrt(0.0015) ! I don't expect to get here, but just - ! in case it will output a reasonable value. - exit - endif - enddo - return -end subroutine ust_2_u10_coare3p5 - -!> This subroutine returns the Langmuir number, given ustar and the boundary -!! layer thickness, inclusion conversion to the 10m wind. -subroutine get_LA_windsea(ustar, hbl, GV, US, LA) - real, intent(in) :: ustar !< The water-side surface friction velocity [m s-1] - real, intent(in) :: hbl !< The ocean boundary layer depth [m] - type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure - type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - real, intent(out) :: LA !< The Langmuir number returned from this module -! Original description: -! This function returns the enhancement factor, given the 10-meter -! wind [m s-1], friction velocity [m s-1] and the boundary layer depth [m]. -! Update (Jan/25): -! Converted from function to subroutine, now returns Langmuir number. -! Computes 10m wind internally, so only ustar and hbl need passed to -! subroutine. -! -! Qing Li, 160606 -! BGR port from CVMix to MOM6 Jan/25/2017 -! BGR change output to LA from Efactor -! BGR remove u10 input - -! Input -! Local variables - ! parameters - real, parameter :: & - ! ratio of U19.5 to U10 (Holthuijsen, 2007) - u19p5_to_u10 = 1.075, & - ! ratio of mean frequency to peak frequency for - ! Pierson-Moskowitz spectrum (Webb, 2011) - fm_to_fp = 1.296, & - ! ratio of surface Stokes drift to U10 - us_to_u10 = 0.0162, & - ! loss ratio of Stokes transport - r_loss = 0.667 - real :: uStokes, hm0, fm, fp, vstokes, kphil, kstar - real :: z0, z0i, r1, r2, r3, r4, tmp, us_sl, lasl_sqr_i - real :: pi, u10 - pi = 4.0*atan(1.0) - if (ustar > 0.0) then - ! Computing u10 based on ustar and COARE 3.5 relationships - call ust_2_u10_coare3p5(ustar * sqrt(GV%Rho0/1.225), U10, GV, US) - ! surface Stokes drift - uStokes = us_to_u10*u10 - - ! significant wave height from Pierson-Moskowitz spectrum (Bouws, 1998) - hm0 = 0.0246 *u10**2 - - ! peak frequency (PM, Bouws, 1998) - tmp = 2.0 * PI * u19p5_to_u10 * u10 - fp = 0.877 * (GV%g_Earth*US%m_to_Z) / tmp - - ! mean frequency - fm = fm_to_fp * fp - - ! total Stokes transport (a factor r_loss is applied to account - ! for the effect of directional spreading, multidirectional waves - ! and the use of PM peak frequency and PM significant wave height - ! on estimating the Stokes transport) - vstokes = 0.125 * PI * r_loss * fm * hm0**2 - ! - ! the general peak wavenumber for Phillips' spectrum - ! (Breivik et al., 2016) with correction of directional spreading - kphil = 0.176 * uStokes / vstokes - ! - ! surface layer averaged Stokes dirft with Stokes drift profile - ! estimated from Phillips' spectrum (Breivik et al., 2016) - ! the directional spreading effect from Webb and Fox-Kemper, 2015 - ! is also included - kstar = kphil * 2.56 - ! surface layer - !z0 = 0.2 * abs(hbl) - !BGR hbl now adjusted by averaging ratio before function call. - z0 = abs(hbl) - z0i = 1.0 / z0 - ! term 1 to 4 - r1 = ( 0.151 / kphil * z0i -0.84 ) & - * ( 1.0 - exp(-2.0 * kphil * z0) ) - r2 = -( 0.84 + 0.0591 / kphil * z0i ) & - *sqrt( 2.0 * PI * kphil * z0 ) & - *erfc( sqrt( 2.0 * kphil * z0 ) ) - r3 = ( 0.0632 / kstar * z0i + 0.125 ) & - * (1.0 - exp(-2.0 * kstar * z0) ) - r4 = ( 0.125 + 0.0946 / kstar * z0i ) & - *sqrt( 2.0 * PI *kstar * z0) & - *erfc( sqrt( 2.0 * kstar * z0 ) ) - us_sl = uStokes * (0.715 + r1 + r2 + r3 + r4) - ! - LA = sqrt(ustar / us_sl) - else - LA=1.e8 - endif -end subroutine Get_LA_windsea !> This subroutine initializes the energetic_PBL module subroutine energetic_PBL_init(Time, G, GV, US, param_file, diag, CS) @@ -2225,6 +1933,7 @@ subroutine energetic_PBL_init(Time, G, GV, US, param_file, diag, CS) "potential energy change code. Otherwise, the newer "//& "version that can work with successive increments to the "//& "diffusivity in upward or downward passes is used.", default=.true.) + !### THE NEXT TWO CAN GO... call get_param(param_file, mdl, "N2_DISSIPATION_POS", CS%N2_Dissipation_Scale_Pos, & "A scale for the dissipation of TKE due to stratification "//& "in the boundary layer, applied when local stratification "//& @@ -2235,6 +1944,7 @@ subroutine energetic_PBL_init(Time, G, GV, US, param_file, diag, CS) "in the boundary layer, applied when local stratification "//& "is negative. The default is 0, but should probably be ~1.", & units="nondim", default=0.0) + call get_param(param_file, mdl, "MKE_TO_TKE_EFFIC", CS%MKE_to_TKE_effic, & "The efficiency with which mean kinetic energy released "//& "by mechanically forced entrainment of the mixed layer "//& @@ -2247,6 +1957,7 @@ subroutine energetic_PBL_init(Time, G, GV, US, param_file, diag, CS) !/2. Options related to setting MSTAR + !### Add new parameter MSTAR_SCHEME to replace MSTAR_MODE. call get_param(param_file, mdl, "MSTAR_MODE", CS%mstar_mode, & "An integer switch for how to compute MSTAR.\n"//& " 0 for constant MSTAR\n"//& @@ -2299,6 +2010,7 @@ subroutine energetic_PBL_init(Time, G, GV, US, param_file, diag, CS) "the total mixing. (used only if MSTAR_MODE=2)", & units="nondim", default=0.085) ! MSTAR_MODE==3 options + !### Only log if they will be used. call get_param(param_file, mdl, "RH18_MSTAR_CN1", CS%RH18_mstar_cn1,& "MSTAR_N coefficient 1 (outter-most coefficient for fit). "//& "The value of 0.275 is given in RH18. Increasing this "//& @@ -2340,6 +2052,7 @@ subroutine energetic_PBL_init(Time, G, GV, US, param_file, diag, CS) units="nondim", default=0.0) !/ Mixing Length Options + !### THIS DEFAULT SHOULD BECOME TRUE. call get_param(param_file, mdl, "USE_MLD_ITERATION", CS%USE_MLD_ITERATION, & "A logical that specifies whether or not to use the "//& "distance to the bottom of the actively turbulent boundary "//& @@ -2354,6 +2067,7 @@ subroutine energetic_PBL_init(Time, G, GV, US, param_file, diag, CS) "EPBL_TRANSITION should be greater than 0 and less than 1.") endif + !### Two test cases should be changed to allow this to be obsoleted. call get_param(param_file, mdl, "ORIG_MLD_ITERATION", CS%ORIG_MLD_ITERATION, & "A logical that specifies whether or not to use the "//& "old method for determining MLD depth in iteration, which "//& @@ -2385,6 +2099,7 @@ subroutine energetic_PBL_init(Time, G, GV, US, param_file, diag, CS) !/ Turbulent velocity scale in mixing coefficient + !### Replace this with EPBL_VEL_SCALE_SCHEME with names. call get_param(param_file, mdl, "EPBL_VEL_SCALE_MODE", CS%wT_mode, & "An integer switch for how to compute the turbulent velocity. \n"//& " 0 for old wT = (TKE Remaining)^(1/3)\n"//& @@ -2409,18 +2124,11 @@ subroutine energetic_PBL_init(Time, G, GV, US, param_file, diag, CS) !/ Options related to Langmuir turbulence - call get_param(param_file, mdl, "LT_ENHANCE_K_R16",CS%LT_ENH_K_R16, & - "Logical flag to toggle on enhancing mixing coefficient in "//& - "boundary layer due to Langmuir turbulence following Reichl "//& - "et al., 2016. "//& - "This approach is not recommended for use, as it is based "//& - "on a hurricane LES configuration and not known if it is general.", & - units="nondim",default=.false.) - call get_param(param_file, mdl, "USE_LA_LI2016", USE_LA_Windsea, & + call get_param(param_file, mdl, "USE_LA_LI2016", use_LA_Windsea, & "A logical to use the Li et al. 2016 (submitted) formula to "//& "determine the Langmuir number.", units="nondim", default=.false.) ! Note this can be activated in other ways, but this preserves the old method. - if (use_la_windsea) then + if (use_LA_windsea) then CS%USE_LT = .true. else call get_param(param_file, mdl, "EPBL_LT", CS%USE_LT, & @@ -2428,6 +2136,7 @@ subroutine energetic_PBL_init(Time, G, GV, US, param_file, diag, CS) units="nondim", default=.false.) endif if (CS%USE_LT) then + !### Add LT_ENHANCE_SCHEME. call get_param(param_file, mdl, "LT_ENHANCE", CS%LT_ENHANCE_FORM, & "Integer for Langmuir number mode. \n"//& " *Requires USE_LA_LI2016 to be set to True. \n"//& @@ -2437,31 +2146,31 @@ subroutine energetic_PBL_init(Time, G, GV, US, param_file, diag, CS) " 3 - Added w/ adjusted La.", & units="nondim", default=0) call get_param(param_file, mdl, "LT_ENHANCE_COEF", CS%LT_ENHANCE_COEF, & - "Coefficient for Langmuir enhancement if LT_ENHANCE > 1", & - units="nondim", default=0.447) + "Coefficient for Langmuir enhancement if LT_ENHANCE > 1", & + units="nondim", default=0.447) call get_param(param_file, mdl, "LT_ENHANCE_EXP", CS%LT_ENHANCE_EXP, & - "Exponent for Langmuir enhancement if LT_ENHANCE > 1", & - units="nondim", default=-1.33) + "Exponent for Langmuir enhancement if LT_ENHANCE > 1", & + units="nondim", default=-1.33) call get_param(param_file, mdl, "LT_MOD_LAC1", CS%LaC_MLDoEK, & - "Coefficient for modification of Langmuir number due to "//& - "MLD approaching Ekman depth if LT_ENHANCE=2.", & - units="nondim", default=-0.87) + "Coefficient for modification of Langmuir number due to "//& + "MLD approaching Ekman depth if LT_ENHANCE=2.", & + units="nondim", default=-0.87) call get_param(param_file, mdl, "LT_MOD_LAC2", CS%LaC_MLDoOB_stab, & - "Coefficient for modification of Langmuir number due to "//& - "MLD approaching stable Obukhov depth if LT_ENHANCE=2.", & - units="nondim", default=0.0) + "Coefficient for modification of Langmuir number due to "//& + "MLD approaching stable Obukhov depth if LT_ENHANCE=2.", & + units="nondim", default=0.0) call get_param(param_file, mdl, "LT_MOD_LAC3", CS%LaC_MLDoOB_un, & - "Coefficient for modification of Langmuir number due to "//& - "MLD approaching unstable Obukhov depth if LT_ENHANCE=2.", & - units="nondim", default=0.0) + "Coefficient for modification of Langmuir number due to "//& + "MLD approaching unstable Obukhov depth if LT_ENHANCE=2.", & + units="nondim", default=0.0) call get_param(param_file, mdl, "LT_MOD_LAC4", CS%Lac_EKoOB_stab, & - "Coefficient for modification of Langmuir number due to "//& - "ratio of Ekman to stable Obukhov depth if LT_ENHANCE=2.", & - units="nondim", default=0.95) + "Coefficient for modification of Langmuir number due to "//& + "ratio of Ekman to stable Obukhov depth if LT_ENHANCE=2.", & + units="nondim", default=0.95) call get_param(param_file, mdl, "LT_MOD_LAC5", CS%Lac_EKoOB_un, & - "Coefficient for modification of Langmuir number due to "//& - "ratio of Ekman to unstable Obukhov depth if LT_ENHANCE=2.", & - units="nondim", default=0.95) + "Coefficient for modification of Langmuir number due to "//& + "ratio of Ekman to unstable Obukhov depth if LT_ENHANCE=2.", & + units="nondim", default=0.95) endif From ab386bc896bfd326baa1dc05358c5533e971e413 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 11 Jun 2019 17:29:18 -0400 Subject: [PATCH 13/82] +Added EPBL_2018_ANSWERS Added the new run-time parameter EPBL_2018_ANSWERS and removed the unused runtime parameters N2_DISSIPATION_POS and N2_DISSIPATION_NEG. Also added flags to only log ePBL parameters when the options that use them are enabled. It has been verified that the answers in the MOM6-examples test cases do differ, but only slightly when EPBL_2018_ANSWERS=False. By default all answers are bitwise identical, but some run-time options have changed, as have the MOM_parameter_doc files. --- .../vertical/MOM_energetic_PBL.F90 | 247 ++++++++---------- 1 file changed, 102 insertions(+), 145 deletions(-) diff --git a/src/parameterizations/vertical/MOM_energetic_PBL.F90 b/src/parameterizations/vertical/MOM_energetic_PBL.F90 index 93ffbf34e4..17c8dd1e8f 100644 --- a/src/parameterizations/vertical/MOM_energetic_PBL.F90 +++ b/src/parameterizations/vertical/MOM_energetic_PBL.F90 @@ -96,16 +96,6 @@ module MOM_energetic_PBL !/ vertical decay related options real :: TKE_decay !< The ratio of the natural Ekman depth to the TKE decay scale [nondim]. - real :: N2_Dissipation_Scale_Neg !< A nondimensional scaling factor controlling the loss of TKE - !! due to enhanced dissipation in the presence of negative (unstable) - !! local stratification. This dissipation is applied to the available - !! TKE which includes both that generated at the surface and that - !! generated at depth. - real :: N2_Dissipation_Scale_Pos !< A nondimensional scaling factor controlling the loss of TKE - !! due to enhanced dissipation in the presence of positive (stable) - !! local stratification. This dissipation is applied to the available - !! TKE which includes both that generated at the surface and that - !! generated at depth. !/ mstar_mode == 0 real :: fixed_mstar !< Mstar is the ratio of the friction velocity cubed to the TKE available to @@ -159,7 +149,10 @@ module MOM_energetic_PBL type(time_type), pointer :: Time=>NULL() !< A pointer to the ocean model's clock. logical :: TKE_diagnostics = .false. !< If true, diagnostics of the TKE budget are being calculated. - logical :: orig_PE_calc = .true. !< If true, the ePBL code uses the original form of the + logical :: answers_2018 !< If true, use the order of arithmetic and expressions that recover the + !! answers from the end of 2018. Otherwise, use updated and more robust + !! forms of the same expressions. + logical :: orig_PE_calc !< If true, the ePBL code uses the original form of the !! potential energy change code. Otherwise, it uses a newer version !! that can work with successive increments to the diffusivity in !! upward or downward passes. @@ -205,6 +198,13 @@ module MOM_energetic_PBL !!@} end type energetic_PBL_CS +!>@{ Enumeration values for mstar_Scheme +integer, parameter :: Use_Fixed_MStar = 0 !< The value of MSTAR_MODE to use a constant mstar +integer, parameter :: MStar_from_Ekman = 2 !< The value of MSTAR_MODE to base mstar on the ratio + !! of the Ekman layer depth to the Obukhov depth +integer, parameter :: MStar_from_RH18 = 3 !< The value of MSTAR_MODE to base mstar of of RH18 +!!@} + contains !> This subroutine determines the diffusivities from the integrated energetics @@ -495,7 +495,6 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS real, dimension(SZK_(GV)+1) :: Vstar_Used, & ! 1D arrays used to store Mixing_Length_Used ! Vstar and Mixing_Length - real :: N2_dissipation real :: Surface_Scale ! Surface decay scale for vstar ! For output of MLD relations, if not using we should eliminate real :: iL_Ekman ! Inverse of Ekman length scale [Z-1 ~> m-1]. @@ -679,9 +678,7 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS endif !/ Apply MStar to get mech_TKE - !THIS BIT OF CODE IS NEEDED TO PRESERVE ANSWERS, BUT SHOULD BE DELETED - ! if ((CS%old_answers) .and. (CS%mstar_mode==0)) then - if (CS%mstar_mode==0) then + if ((CS%answers_2018) .and. (CS%mstar_mode==0)) then mech_TKE(i) = (dt*MSTAR_total*GV%Rho0) * US%Z_to_m**3 * U_star**3 else mech_TKE(i) = MSTAR_total * US%Z_to_m**3 * (dt*GV%Rho0*U_star**3) @@ -971,14 +968,6 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS MKE_src = dMKE_max*(1.0 - exp(-Kddt_h_g0 * MKE2_Hharm)) - if (pe_chg_g0 > 0.0) then - !Negative buoyancy (increases PE) - N2_dissipation = 1.+CS%N2_DISSIPATION_SCALE_NEG - else - !Positive buoyancy (decreases PE) - N2_dissipation = 1.+CS%N2_DISSIPATION_SCALE_POS - endif - ! This block checks out different cases to determine Kd at the present interface. if ((PE_chg_g0 < 0.0) .or. ((vstar == 0.0) .and. (dPEc_dKd_Kd0 < 0.0))) then ! This column is convectively unstable. @@ -1048,7 +1037,7 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS endif Kddt_h(K) = Kd(i,K)*dt_h - elseif (tot_TKE + (MKE_src - N2_DISSIPATION*PE_chg_g0) >= 0.0) then + elseif (tot_TKE + (MKE_src - PE_chg_g0) >= 0.0) then ! This column is convctively stable and there is energy to support the suggested ! mixing. Keep that estimate. Kd(i,K) = Kd_guess0 @@ -1057,8 +1046,7 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS ! Reduce the mechanical and convective TKE proportionately. tot_TKE = tot_TKE + MKE_src TKE_reduc = 0.0 ! tot_TKE could be 0 if Convectively_stable is false. - if (tot_TKE > 0.0) TKE_reduc = (tot_TKE - N2_DISSIPATION*PE_chg_g0) & - / tot_TKE + if (tot_TKE > 0.0) TKE_reduc = (tot_TKE - PE_chg_g0) / tot_TKE if (CS%TKE_diagnostics) then dTKE_mixing = dTKE_mixing - PE_chg_g0 * IdtdR0 dTKE_MKE = dTKE_MKE + MKE_src * IdtdR0 @@ -1081,13 +1069,13 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS ! There is not enough energy to support the mixing, so reduce the ! diffusivity to what can be supported. Kddt_h_max = Kddt_h_g0 ; Kddt_h_min = 0.0 - TKE_left_max = tot_TKE + (MKE_src - N2_DISSIPATION*PE_chg_g0) + TKE_left_max = tot_TKE + (MKE_src - PE_chg_g0) TKE_left_min = tot_TKE ! As a starting guess, take the minimum of a false position estimate ! and a Newton's method estimate starting from Kddt_h = 0.0. - Kddt_h_guess = tot_TKE * Kddt_h_max / max( N2_DISSIPATION*PE_chg_g0 & - - MKE_src, Kddt_h_max * (dPEc_dKd_Kd0 - dMKE_max * MKE2_Hharm) ) + Kddt_h_guess = tot_TKE * Kddt_h_max / max( PE_chg_g0 - MKE_src, & + Kddt_h_max * (dPEc_dKd_Kd0 - dMKE_max * MKE2_Hharm) ) ! The above expression is mathematically the same as the following ! except it is not susceptible to division by zero when ! dPEc_dKd_Kd0 = dMKE_max = 0 . @@ -1116,10 +1104,10 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS MKE_src = dMKE_max * (1.0 - exp(-MKE2_Hharm * Kddt_h_guess)) dMKE_src_dK = dMKE_max * MKE2_Hharm * exp(-MKE2_Hharm * Kddt_h_guess) - TKE_left = tot_TKE + (MKE_src - N2_DISSIPATION*PE_chg) + TKE_left = tot_TKE + (MKE_src - PE_chg) if (debug) then Kddt_h_itt(itt) = Kddt_h_guess ; MKE_src_itt(itt) = MKE_src - PE_chg_itt(itt) = N2_DISSIPATION*PE_chg + PE_chg_itt(itt) = PE_chg TKE_left_itt(itt) = TKE_left dPEa_dKd_itt(itt) = dPEc_dKd endif @@ -1134,10 +1122,10 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS ! Try to use Newton's method, but if it would go outside the bracketed ! values use the false-position method instead. use_Newt = .true. - if (dPEc_dKd*N2_DISSIPATION - dMKE_src_dK <= 0.0) then + if (dPEc_dKd - dMKE_src_dK <= 0.0) then use_Newt = .false. else - dKddt_h_Newt = TKE_left / (dPEc_dKd*N2_DISSIPATION - dMKE_src_dK) + dKddt_h_Newt = TKE_left / (dPEc_dKd - dMKE_src_dK) Kddt_h_Newt = Kddt_h_guess + dKddt_h_Newt if ((Kddt_h_Newt > Kddt_h_max) .or. (Kddt_h_Newt < Kddt_h_min)) & use_Newt = .false. @@ -1711,14 +1699,11 @@ subroutine find_mstar(CS, US, Buoyancy_Flux, UStar, UStar_Mean,& real, optional, intent(out) :: Convect_Langmuir_number !< Langmuir number including buoyancy flux [nondim] !/ Variables used in computing mstar - real :: MStar_Conv_Red ! Adjustment made to mstar due to convection reducing mechanical mixing. - real :: MStar_S, MStar_N ! Mstar in (S)tabilizing/(N)ot-stabilizing buoyancy flux + real :: MSN_term, MSCR_term1, MSCR_term2 ! Temporary terms [nondim] + real :: MStar_Conv_Red ! Adjustment made to mstar due to convection reducing mechanical mixing [nondim] + real :: MStar_S, MStar_N ! Mstar in (S)tabilizing/(N)ot-stabilizing buoyancy flux [nondim] !/ Integer options for how to find mstar - integer, parameter :: Use_Fixed_MStar = 0 !< The value of MSTAR_MODE to use a constant mstar - integer, parameter :: MStar_from_Ekman = 2 !< The value of MSTAR_MODE to base mstar on the ratio - !! of the Ekman layer depth to the Obukhov depth - integer, parameter :: MStar_from_RH18 = 3 !< The value of MSTAR_MODE to base mstar of of RH18 !/ @@ -1727,46 +1712,46 @@ subroutine find_mstar(CS, US, Buoyancy_Flux, UStar, UStar_Mean,& !/ 1. Get mstar elseif (CS%MSTAR_MODE == MStar_from_Ekman) then - !if (CS%OldAnswers) + if (CS%answers_2018) then ! The limit for the balance of rotation and stabilizing is f(L_Ekman,L_Obukhov) MStar_S = CS%MStar_coef*sqrt(max(0.0,Buoyancy_Flux) / UStar**2 / (Abs_Coriolis+1.e-10) ) ! The limit for rotation (Ekman length) limited mixing MStar_N = CS%C_Ek * log( max( 1.,UStar / (Abs_Coriolis+1.e-10) / BLD ) ) - !else + else ! The limit for the balance of rotation and stabilizing is f(L_Ekman,L_Obukhov) - ! mstar_S = CS%MSTAR_COEF*sqrt(Bf_Stable / (U_star**2 * max(Abs_Coriolis, 1.e-10))) + mstar_S = CS%MSTAR_COEF*sqrt(max(0.0,Buoyancy_Flux) / (Ustar**2 * max(Abs_Coriolis, 1.e-20))) ! The limit for rotation (Ekman length) limited mixing - ! mstar_N = 0.0 - ! if (Ustar > absf(i) * MLD_guess) & - ! mstar_N = CS%C_EK * log(U_star / (Abs_Coriolis * MLD_guess)) - !endif + mstar_N = 0.0 + if (Ustar > Abs_Coriolis * BLD) mstar_N = CS%C_EK * log(Ustar / (Abs_Coriolis * BLD)) + endif ! Here 1.25 is .5/von Karman, which gives the Obukhov limit. + !### Note the hard-code value here. MStar = max(MStar_S, min(1.25, MStar_N)) if (CS%MStar_Cap > 0.0) MStar = min( CS%MStar_Cap,MStar ) elseif ( CS%MStar_Mode == MStar_from_RH18 ) then - !if (CS%OldAnswers) then - MStar_N = CS%RH18_MStar_cn1 * ( 1.0 - 1.0 / ( 1. + CS%RH18_MStar_cn2 * & - exp( CS%RH18_mstar_CN3 * BLD * Abs_Coriolis / UStar) ) ) - !else - ! MSN_term = CS%RH18_MStar_cn2 * exp( CS%RH18_mstar_CN3 * BLD * Abs_Coriolis / UStar) - ! MStar_N = (CS%RH18_MStar_cn1 * MSN_term) / ( 1. + MSN_term) - !endif + if (CS%answers_2018) then + MStar_N = CS%RH18_MStar_cn1 * ( 1.0 - 1.0 / ( 1. + CS%RH18_MStar_cn2 * & + exp( CS%RH18_mstar_CN3 * BLD * Abs_Coriolis / UStar) ) ) + else + MSN_term = CS%RH18_MStar_cn2 * exp( CS%RH18_mstar_CN3 * BLD * Abs_Coriolis / UStar) + MStar_N = (CS%RH18_MStar_cn1 * MSN_term) / ( 1. + MSN_term) + endif MStar_S = CS%RH18_MStar_CS1 * & - ( max(0.0,Buoyancy_Flux)**2 * BLD / ( UStar**5 * max(Abs_Coriolis,1.e-10) ) )**CS%RH18_mstar_cs2 + ( max(0.0,Buoyancy_Flux)**2 * BLD / ( UStar**5 * max(Abs_Coriolis,1.e-20) ) )**CS%RH18_mstar_cs2 MStar = MStar_N + MStar_S endif !mstar_mode !/ 2. Adjust mstar to account for convective turbulence - !if (CS%OldAnswers) then - MStar_Conv_Red = 1. - CS%MStar_Convect_coef * (-min(0.0,Buoyancy_Flux) + 1.e-10*US%m_to_Z**2) / & + if (CS%answers_2018) then + MStar_Conv_Red = 1. - CS%MStar_Convect_coef * (-min(0.0,Buoyancy_Flux) + 1.e-10*US%m_to_Z**2) / & ( (-min(0.0,Buoyancy_Flux) + 1.e-10*US%m_to_Z**2) + & - 2.0 *MStar * ustar**3 / BLD ) - !else - ! MSCR_term1 = -BLD * min(0.0,Buoyancy_Flux) - ! MSCR_term2 = 2.0*MStar * U_star**3 - ! MStar_Conv_Red = ((1.-CS%mstar_convect_coef) * MSCR_term1 + MSCR_term2) / (MSCR_term1 + MSCR_term2) - !endif + 2.0 *MStar * Ustar**3 / BLD ) + else + MSCR_term1 = -BLD * min(0.0,Buoyancy_Flux) + MSCR_term2 = 2.0*MStar * Ustar**3 + MStar_Conv_Red = ((1.-CS%mstar_convect_coef) * MSCR_term1 + MSCR_term2) / (MSCR_term1 + MSCR_term2) + endif !/3. Combine various mstar terms to get final value MStar = MStar * MStar_Conv_Red @@ -1796,52 +1781,64 @@ subroutine Mstar_Langmuir(CS, US, abs_Coriolis, buoyancy_flux, ustar, BLD, Langm real, intent(out) :: Convect_Langmuir_number !< Langmuir number including buoyancy flux [nondim] !/ + real, parameter :: Max_ratio = 1.0e16 ! The maximum value of a nondimensional ratio. real :: iL_Ekman ! Inverse of Ekman length scale [Z-1 ~> m-1]. real :: iL_Obukhov ! Inverse of Obukhov length scale [Z-1 ~> m-1]. - real :: MLD_o_Ekman ! > - real :: MLD_o_Obukhov_stab ! Ratios of length scales where MLD is boundary layer depth - real :: Ekman_o_Obukhov_stab ! > - real :: MLD_o_Obukhov_un ! Ratios of length scales where MLD is boundary layer depth - real :: Ekman_o_Obukhov_un ! > + real :: I_ustar ! The Adcroft reciprocal of ustar [s Z-1 ~> s m-1] + real :: I_f ! The Adcroft reciprocal of the Coriolis parameter [s] + real :: MLD_Ekman ! The ratio of the mixed layer depth to the Ekman layer depth [nondim]. + real :: Ekman_Obukhov ! The Ekman layer thickness divided by the Obukhov depth [nondim]. + real :: MLD_Obukhov ! The mixed layer depth divided by the Obukhov depth [nondim]. + real :: MLD_Obukhov_stab ! Ratios of length scales where MLD is boundary layer depth [nondim]. + real :: Ekman_Obukhov_stab ! > + real :: MLD_Obukhov_un ! Ratios of length scales where MLD is boundary layer depth + real :: Ekman_Obukhov_un ! > ! Set default values for no Langmuir effects. enhance_mstar = 1.0 ; mstar_LT = 0.0 if (CS%LT_Enhance_Form > 0) then - !if (CS%OldAnswers) then - iL_Ekman = Abs_Coriolis / UStar - iL_Obukhov = Buoyancy_Flux*CS%vonkar / (UStar**3) - Ekman_o_Obukhov_stab = abs(max(0., iL_Obukhov / (iL_Ekman + 1.e-10*US%Z_to_m))) - Ekman_o_Obukhov_un = abs(min(0., iL_Obukhov / (iL_Ekman + 1.e-10*US%Z_to_m))) - !else - ! Max_ratio = 1.0e16 - ! Ekman_Obukhov = Max_ratio - ! if (abs(bflux*vonkar) < Max_ratio*(absf * ustar**2)) then - ! Ekman_Obukhov = buoy_flux(i,j)*vonkar / (absf(i) * U_star**2) - ! endif - ! if (bflux > 0.0) then - ! Ekman_o_Obukhov_stab = Ekman_Obukhov ; Ekman_o_Obukhov_un = 0.0 - ! else - ! Ekman_o_Obukhov_un = Ekman_Obukhov ; Ekman_o_Obukhov_stab = 0.0 - ! endif - !endif - ! a. Get parameters for modified LA - MLD_o_Ekman = abs( BLD*iL_Ekman ) - MLD_o_Obukhov_stab = abs(max(0., BLD*iL_Obukhov)) - MLD_o_Obukhov_un = abs(min(0., BLD*iL_Obukhov)) + if (CS%answers_2018) then + iL_Ekman = Abs_Coriolis / UStar + iL_Obukhov = Buoyancy_Flux*CS%vonkar / (UStar**3) + Ekman_Obukhov_stab = abs(max(0., iL_Obukhov / (iL_Ekman + 1.e-10*US%Z_to_m))) + Ekman_Obukhov_un = abs(min(0., iL_Obukhov / (iL_Ekman + 1.e-10*US%Z_to_m))) + MLD_Obukhov_stab = abs(max(0., BLD*iL_Obukhov)) + MLD_Obukhov_un = abs(min(0., BLD*iL_Obukhov)) + MLD_Ekman = abs( BLD*iL_Ekman ) + else + Ekman_Obukhov = Max_ratio ; MLD_Obukhov = Max_ratio ; MLD_Ekman = Max_ratio + I_f = 0.0 ; if (abs(abs_Coriolis) > 0.0) I_f = 1.0 / abs_Coriolis + I_ustar = 0.0 ; if (abs(Ustar) > 0.0) I_ustar = 1.0 / Ustar + if (abs(Buoyancy_Flux*CS%vonkar) < Max_ratio*(abs_Coriolis * Ustar**2)) & + Ekman_Obukhov = abs(Buoyancy_Flux*CS%vonkar) * (I_f * I_Ustar**2) + if (abs(BLD*Buoyancy_Flux*CS%vonkar) < Max_ratio*((UStar**3))) & + MLD_Obukhov = abs(BLD*Buoyancy_Flux*CS%vonkar) * (I_UStar**3) + if (BLD*Abs_Coriolis < Max_ratio*UStar) & + MLD_Ekman = BLD*Abs_Coriolis * I_UStar + + if (Buoyancy_Flux > 0.0) then + Ekman_Obukhov_stab = Ekman_Obukhov ; Ekman_Obukhov_un = 0.0 + MLD_Obukhov_stab = MLD_Obukhov ; MLD_Obukhov_un = 0.0 + else + Ekman_Obukhov_un = Ekman_Obukhov ; Ekman_Obukhov_stab = 0.0 + MLD_Obukhov_un = MLD_Obukhov ; MLD_Obukhov_stab = 0.0 + endif + endif + ! b. Adjust LA based on various parameters. ! Assumes linear factors based on length scale ratios to adjust LA ! Note when these coefficients are set to 0 recovers simple LA. Convect_Langmuir_Number = Langmuir_Number * & - ( 1.0 + max(-0.5, CS%LaC_MLDoEK * MLD_o_Ekman) + & - ((CS%LaC_EKoOB_stab * Ekman_o_Obukhov_stab + CS%LaC_EKoOB_un * Ekman_o_Obukhov_un) + & - (CS%LaC_MLDoOB_stab * MLD_o_Obukhov_stab + CS%LaC_MLDoOB_un * MLD_o_Obukhov_un)) ) + ( (1.0 + max(-0.5, CS%LaC_MLDoEK * MLD_Ekman)) + & + ((CS%LaC_EKoOB_stab * Ekman_Obukhov_stab + CS%LaC_EKoOB_un * Ekman_Obukhov_un) + & + (CS%LaC_MLDoOB_stab * MLD_Obukhov_stab + CS%LaC_MLDoOB_un * MLD_Obukhov_un)) ) if (CS%LT_Enhance_Form == 2) then ! Enhancement is multiplied (added mst_lt set to 0) Enhance_mstar = min(CS%Max_Enhance_M, & - (1. + CS%LT_ENHANCE_COEF*Convect_Langmuir_Number**CS%LT_ENHANCE_EXP) ) + (1. + CS%LT_ENHANCE_COEF * Convect_Langmuir_Number**CS%LT_ENHANCE_EXP) ) elseif (CS%LT_ENHANCE_Form == 3) then ! or Enhancement is additive (multiplied enhance_m set to 1) mstar_LT = CS%LT_ENHANCE_COEF * Convect_Langmuir_Number**CS%LT_ENHANCE_EXP @@ -1928,22 +1925,17 @@ subroutine energetic_PBL_init(Time, G, GV, US, param_file, diag, CS) "A nondimensional scaling factor controlling the inhibition "//& "of the diffusive length scale by rotation. Making this larger "//& "decreases the PBL diffusivity.", units="nondim", default=1.0) + call get_param(param_file, mdl, "EPBL_2018_ANSWERS", CS%answers_2018, & + "If true, use the order of arithmetic and expressions that recover the "//& + "answers from the end of 2018. Otherwise, use updated and more robust "//& + "forms of the same expressions.", default=.true.) + + call get_param(param_file, mdl, "EPBL_ORIGINAL_PE_CALC", CS%orig_PE_calc, & "If true, the ePBL code uses the original form of the "//& "potential energy change code. Otherwise, the newer "//& "version that can work with successive increments to the "//& "diffusivity in upward or downward passes is used.", default=.true.) - !### THE NEXT TWO CAN GO... - call get_param(param_file, mdl, "N2_DISSIPATION_POS", CS%N2_Dissipation_Scale_Pos, & - "A scale for the dissipation of TKE due to stratification "//& - "in the boundary layer, applied when local stratification "//& - "is positive. The default is 0, but should probably be ~0.4.", & - units="nondim", default=0.0) - call get_param(param_file, mdl, "N2_DISSIPATION_NEG", CS%N2_Dissipation_Scale_Neg,& - "A scale for the dissipation of TKE due to stratification "//& - "in the boundary layer, applied when local stratification "//& - "is negative. The default is 0, but should probably be ~1.", & - units="nondim", default=0.0) call get_param(param_file, mdl, "MKE_TO_TKE_EFFIC", CS%MKE_to_TKE_effic, & "The efficiency with which mean kinetic energy released "//& @@ -1965,14 +1957,12 @@ subroutine energetic_PBL_init(Time, G, GV, US, param_file, diag, CS) " 2 for OM4 MSTAR, which uses L_E/L_O in stabilizing limit\n"//& " 3 for MSTAR as in RH18.", & default=0) - !delete0).", & units="nondim", default=-1.0) - !delete Ekman depth - !CS%MSTAR_A = CS%MSTAR_AT_XINT**(1./CS%mstar_exp) - !CS%MSTAR_B = CS%MSTAR_SLOPE / (CS%MSTAR_EXP*CS%MSTAR_A**(CS%mstar_exp-1.)) - !Fitting coefficients to asymptote toward MSTAR_CAP - !*Fixed to begin asymptote at MSTAR_CAP-0.5 toward MSTAR_CAP - !CS%MSTAR_A2 = 0.5**(1./CS%mstar_exp) - !CS%MSTAR_B2 = -CS%MSTAR_SLOPE / (CS%mstar_exp*CS%MSTAR_A2**(CS%mstar_exp-1)) - !Compute value of X (referenced to MSTAR_XINT) where transition - ! to asymptotic regime based on value of X where MSTAR=MSTAR_CAP-0.5 - !CS%MSTAR_XINT_UP = (CS%MSTAR_CAP-0.5-CS%MSTAR_AT_XINT)/CS%MSTAR_SLOPE - !delete Clean up and deallocate memory associated with the energetic_PBL module. From 75d2fd3a426009baf61332ab6d6ab45e66d5b1e8 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Wed, 12 Jun 2019 09:39:46 -0400 Subject: [PATCH 14/82] Reduced ePBL array dimensions Eliminated the i-index in a number of the arrays in the ePBL code, in preparation to introduce a column-oriented subroutine at the heart of ePBL. Some diagnostics of mixed layer depths are now being set to 0 over land, but all answers are bitwise identical. --- .../vertical/MOM_energetic_PBL.F90 | 500 +++++++++--------- 1 file changed, 254 insertions(+), 246 deletions(-) diff --git a/src/parameterizations/vertical/MOM_energetic_PBL.F90 b/src/parameterizations/vertical/MOM_energetic_PBL.F90 index 17c8dd1e8f..d39207176f 100644 --- a/src/parameterizations/vertical/MOM_energetic_PBL.F90 +++ b/src/parameterizations/vertical/MOM_energetic_PBL.F90 @@ -213,7 +213,7 @@ module MOM_energetic_PBL !! is no stability limit on the time step. subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS, & dSV_dT, dSV_dS, TKE_forced, Buoy_Flux, dt_diag, last_call, & - dT_expected, dS_expected, waves ) + dT_expected, dS_expected, Waves ) type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type @@ -294,36 +294,39 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS ! Local variables real, dimension(SZI_(G),SZK_(GV)) :: & - h, & ! The layer thickness [H ~> m or kg m-2]. - T, & ! The layer temperatures [degC]. - S, & ! The layer salinities [ppt]. - u, & ! The zonal velocity [m s-1]. - v ! The meridional velocity [m s-1]. + h_2d, & ! A 2-d version of the layer thickness [H ~> m or kg m-2]. + T_2d, & ! A 2-d version of the layer temperatures [degC]. + S_2d, & ! A 2-d version of the layer salinities [ppt]. + u_2d, & ! A 2-d version of the zonal velocity [m s-1]. + v_2d ! A 2-d version of the meridional velocity [m s-1]. real, dimension(SZI_(G),SZK_(GV)+1) :: & + Kd_2d ! A 2-d version of the diapycnal diffusivity [Z2 s-1 ~> m2 s-1]. + real, dimension(SZK_(GV)) :: & + h, & ! The layer thickness [H ~> m or kg m-2]. + T0, & ! The initial layer temperatures [degC]. + S0, & ! The initial layer salinities [ppt]. + u, & ! The zonal velocity [m s-1]. + v ! The meridional velocity [m s-1]. + real, dimension(SZK_(GV)+1) :: & Kd, & ! The diapycnal diffusivity [Z2 s-1 ~> m2 s-1]. pres, & ! Interface pressures [Pa]. pres_Z, & ! Interface pressures with a rescaling factor to convert interface height ! movements into changes in column potential energy [J m-2 Z-1 ~> J m-3]. hb_hs ! The distance from the bottom over the thickness of the ! water column [nondim]. - real, dimension(SZI_(G)) :: & - mech_TKE, & ! The mechanically generated turbulent kinetic energy + real :: mech_TKE ! The mechanically generated turbulent kinetic energy ! available for mixing over a time step [J m-2 = kg s-2]. - conv_PErel, & ! The potential energy that has been convectively released + real :: conv_PErel ! The potential energy that has been convectively released ! during this timestep [J m-2 = kg s-2]. A portion nstar_FC ! of conv_PErel is available to drive mixing. - htot, & ! The total depth of the layers above an interface [H ~> m or kg m-2]. - uhtot, & ! The depth integrated zonal and meridional velocities in the - vhtot, & ! layers above [H m s-1 ~> m2 s-1 or kg m-1 s-1]. - mech_TKE_top, & ! The value of mech_TKE at the top of the column [J m-2]. - conv_PErel_top, & ! The value of conv_PErel at the top of the column [J m-2]. - - Idecay_len_TKE, & ! The inverse of a turbulence decay length scale [H-1 ~> m-1 or m2 kg-1]. - h_sum, & ! The total thickness of the water column [H ~> m or kg m-2]. - absf ! The absolute value of f [s-1]. + real :: htot ! The total depth of the layers above an interface [H ~> m or kg m-2]. + real :: uhtot ! The depth integrated zonal and meridional velocities in the + real :: vhtot ! layers above [H m s-1 ~> m2 s-1 or kg m-1 s-1]. + real :: Idecay_len_TKE ! The inverse of a turbulence decay length scale [H-1 ~> m-1 or m2 kg-1]. + real :: h_sum ! The total thickness of the water column [H ~> m or kg m-2]. + real :: absf ! The absolute value of f [s-1]. - - real, dimension(SZI_(G),SZK_(GV)) :: & + real, dimension(SZK_(GV)) :: & dT_to_dColHt, & ! Partial derivatives of the total column height with the temperature dS_to_dColHt, & ! and salinity changes within a layer [Z degC-1 ~> m degC-1] and [Z ppt-1 ~> m ppt-1]. dT_to_dPE, & ! Partial derivatives of column potential energy with the temperature @@ -336,11 +339,9 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS ! of mixing with layers higher in the water column, in ! units of [J m-2 degC-1] and [J m-2 ppt-1]. real, dimension(SZK_(GV)) :: & - T0, S0, & ! Initial values of T and S in the column, in [degC] and [ppt]. Te, Se, & ! Estimated final values of T and S in the column, in [degC] and [ppt]. c1, & ! c1 is used by the tridiagonal solver [nondim]. - dTe, dSe ! Running (1-way) estimates of temperature and salinity change. - real, dimension(SZK_(GV)) :: & + dTe, dSe, & ! Running (1-way) estimates of temperature and salinity change. Th_a, & ! An effective temperature times a thickness in the layer above, including implicit ! mixing effects with other yet higher layers [degC H ~> degC m or degC kg m-2]. Sh_a, & ! An effective salinity times a thickness in the layer above, including implicit @@ -349,10 +350,6 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS ! mixing effects with other yet lower layers [degC H ~> degC m or degC kg m-2]. Sh_b ! An effective salinity times a thickness in the layer below, including implicit ! mixing effects with other yet lower layers [ppt H ~> ppt m or ppt kg m-2]. - real, dimension(SZI_(G)) :: & - hp_a ! An effective pivot thickness of the layer including the effects - ! of coupling with layers above [H ~> m or kg m-2]. This is the first term - ! in the denominator of b1 in a downward-oriented tridiagonal solver. real, dimension(SZK_(GV)+1) :: & MixLen_shape, & ! A nondimensional shape factor for the mixing length that ! gives it an appropriate assymptotic value at the bottom of @@ -360,6 +357,9 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS Kddt_h ! The diapycnal diffusivity times a timestep divided by the ! average thicknesses around a layer [H ~> m or kg m-2]. real :: b1 ! b1 is inverse of the pivot used by the tridiagonal solver [H-1 ~> m-1 or m2 kg-1]. + real :: hp_a ! An effective pivot thickness of the layer including the effects + ! of coupling with layers above [H ~> m or kg m-2]. This is the first term + ! in the denominator of b1 in a downward-oriented tridiagonal solver. real :: h_neglect ! A thickness that is so small it is usually lost ! in roundoff and can be neglected [H ~> m or kg m-2]. real :: dMass ! The mass per unit area within a layer [kg m-2]. @@ -393,6 +393,8 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS real :: mstar_total ! The value of mstar used in ePBL [nondim] real :: enhance_mstar ! An ehhancement to mstar (output for diagnostic) real :: mstar_LT ! An addition to mstar [nondim] (output for diagnostic) + real :: MLD_last ! The final or previous value of the mixed layer depth [Z ~> m]. + real :: MLD_output ! The mixed layer depth output from this routine [Z ~> m]. real :: LA ! The value of the Langmuir number [nondim] real :: LAmod ! The modified Langmuir number by convection [nondim] real :: hbs_here ! The local minimum of hb_hs and MixLen_shape, times a @@ -438,14 +440,13 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS real :: Kddt_h_newt ! The Newton's method next guess for Kddt_h(K) [H ~> m or kg m-2]. real :: exp_kh ! The nondimensional decay of TKE across a layer [nondim]. logical :: use_Newt ! Use Newton's method for the next guess at Kddt_h(K). - logical :: convectively_stable - logical, dimension(SZI_(G)) :: & - sfc_connected ! If true the ocean is actively turbulent from the present + logical :: convectively_stable ! If true the water column is convectively stable at this interface. + logical :: sfc_connected ! If true the ocean is actively turbulent from the present ! interface all the way up to the surface. logical :: sfc_disconnect ! If true, any turbulence has become disconnected ! from the surface. -! The following is only used as a diagnostic. +! The following are only used for diagnostics. real :: dt__diag ! A copy of dt_diag (if present) or dt [s]. real :: IdtdR0 ! = 1.0 / (dt__diag * Rho0) [m3 kg-1 s-1]. real, dimension(SZI_(G),SZJ_(G)) :: & @@ -455,6 +456,7 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS ! Local column copies of energy change diagnostics, all [J m-2]. real :: dTKE_conv, dTKE_forcing, dTKE_wind, dTKE_mixing real :: dTKE_MKE, dTKE_mech_decay, dTKE_conv_decay + !---------------------------------------------------------------------- !/BGR added Aug24,2016 for adding iteration to get boundary layer depth ! - needed to compute new mixing length. @@ -505,9 +507,7 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS ! The following arrays are used only for debugging purposes. real :: dPE_debug, mixing_debug, taux2, tauy2 real, dimension(20) :: TKE_left_itt, PE_chg_itt, Kddt_h_itt, dPEa_dKd_itt, MKE_src_itt - real, dimension(SZI_(G),SZK_(GV)) :: & - mech_TKE_k, conv_PErel_k - real, dimension(SZK_(GV)) :: nstar_k + real, dimension(SZK_(GV)) :: mech_TKE_k, conv_PErel_k, nstar_k integer, dimension(SZK_(GV)) :: num_itts integer :: i, j, k, is, ie, js, je, nz, itt, max_itt @@ -566,21 +566,10 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS !!OMP max_itt,Kd_int) do j=js,je ! Copy the thicknesses and other fields to 2-d arrays. - do k=1,nz - do i=is,ie - h(i,k) = h_3d(i,j,k) + h_neglect ; u(i,k) = u_3d(i,j,k) ; v(i,k) = v_3d(i,j,k) - T(i,k) = tv%T(i,j,k) ; S(i,k) = tv%S(i,j,k) - Kd(i,K) = 0.0 - enddo - enddo - do i=is,ie - CS%ML_depth(i,j) = h(i,1)*GV%H_to_Z - sfc_connected(i) = .true. - enddo - - if (debug) then - mech_TKE_k(:,:) = 0.0 ; conv_PErel_k(:,:) = 0.0 - endif + do k=1,nz ; do i=is,ie + 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) + T_2d(i,k) = tv%T(i,j,k) ; S_2d(i,k) = tv%S(i,j,k) + enddo ; enddo ! Determine the initial mech_TKE and conv_PErel, including the energy required ! to mix surface heating through the topmost cell, the energy released by mixing @@ -590,6 +579,16 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS ! interface. do i=is,ie ; if (G%mask2dT(i,j) > 0.5) then + if (debug) then ; mech_TKE_k(:) = 0.0 ; conv_PErel_k(:) = 0.0 ; endif + + ! Copy the thicknesses and other fields to 1-d arrays. + do k=1,nz + h(k) = h_2d(i,k) + h_neglect ; u(k) = u_2d(i,k) ; v(k) = v_2d(i,k) + T0(k) = T_2d(i,k) ; S0(k) = S_2d(i,k) + enddo + do K=1,nz+1 ; Kd(K) = 0.0 ; enddo + + ! Make local copies of surface forcing and process them. U_star = fluxes%ustar(i,j) U_Star_Mean = fluxes%ustar_gustless(i,j) B_Flux = buoy_flux(i,j) @@ -600,46 +599,44 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS endif if (U_Star < CS%ustar_min) U_Star = CS%ustar_min if (CS%omega_frac >= 1.0) then - absf(i) = 2.0*CS%omega + absf = 2.0*CS%omega else - absf(i) = 0.25*US%s_to_T*((abs(G%CoriolisBu(I,J)) + abs(G%CoriolisBu(I-1,J-1))) + & + absf = 0.25*US%s_to_T*((abs(G%CoriolisBu(I,J)) + abs(G%CoriolisBu(I-1,J-1))) + & (abs(G%CoriolisBu(I,J-1)) + abs(G%CoriolisBu(I-1,J)))) if (CS%omega_frac > 0.0) & - absf(i) = sqrt(CS%omega_frac*4.0*CS%omega**2 + (1.0-CS%omega_frac)*absf(i)**2) + absf = sqrt(CS%omega_frac*4.0*CS%omega**2 + (1.0-CS%omega_frac)*absf**2) endif - h_sum(i) = H_neglect + pres(1) = 0.0 + pres_Z(1) = 0.0 do k=1,nz - h_sum(i) = h_sum(i) + h(i,k) + dMass = GV%H_to_kg_m2 * h(k) + dPres = (GV%g_Earth*US%m_to_Z) * dMass ! This is equivalent to GV%H_to_Pa * h(k) + dT_to_dPE(k) = (dMass * (pres(K) + 0.5*dPres)) * dSV_dT(i,j,k) + dS_to_dPE(k) = (dMass * (pres(K) + 0.5*dPres)) * dSV_dS(i,j,k) + dT_to_dColHt(k) = dMass * US%m_to_Z * dSV_dT(i,j,k) + dS_to_dColHt(k) = dMass * US%m_to_Z * dSV_dS(i,j,k) + + pres(K+1) = pres(K) + dPres + pres_Z(K+1) = US%Z_to_m * pres(K+1) enddo - I_hs = 0.0 - if (h_sum(i) > 0.0) I_hs = 1.0 / h_sum(i) + + + ! Determine the total thickness (h_sum) and the fractional distance from the bottom (hb_hs). + h_sum = H_neglect ; do k=1,nz ; h_sum = h_sum + h(k) ; enddo + I_hs = 0.0 ; if (h_sum > 0.0) I_hs = 1.0 / h_sum h_bot = 0.0 - hb_hs(i,nz+1) = 0.0 + hb_hs(nz+1) = 0.0 do k=nz,1,-1 - h_bot = h_bot + h(i,k) - hb_hs(i,K) = h_bot * I_hs + h_bot = h_bot + h(k) + hb_hs(K) = h_bot * I_hs enddo - pres(i,1) = 0.0 - pres_Z(i,1) = 0.0 - do k=1,nz - dMass = GV%H_to_kg_m2 * h(i,k) - dPres = (GV%g_Earth*US%m_to_Z) * dMass ! This is equivalent to GV%H_to_Pa * h(i,k) - dT_to_dPE(i,k) = (dMass * (pres(i,K) + 0.5*dPres)) * dSV_dT(i,j,k) - dS_to_dPE(i,k) = (dMass * (pres(i,K) + 0.5*dPres)) * dSV_dS(i,j,k) - dT_to_dColHt(i,k) = dMass * US%m_to_Z * dSV_dT(i,j,k) - dS_to_dColHt(i,k) = dMass * US%m_to_Z * dSV_dS(i,j,k) - - pres(i,K+1) = pres(i,K) + dPres - pres_Z(i,K+1) = US%Z_to_m * pres(i,K+1) - enddo - - do k=1,nz ; T0(k) = T(i,k) ; S0(k) = S(i,k) ; enddo + MLD_output = h(1)*GV%H_to_Z !/The following lines are for the iteration over MLD ! max_MLD will initialized as ocean bottom depth - max_MLD = 0.0 ; do k=1,nz ; max_MLD = max_MLD + h(i,k)*GV%H_to_Z ; enddo + max_MLD = 0.0 ; do k=1,nz ; max_MLD = max_MLD + h(k)*GV%H_to_Z ; enddo !min_MLD will initialize as 0. min_MLD = 0.0 @@ -654,6 +651,7 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS ! Iterate up to MAX_OBL_IT times to determine a converged EPBL depth. OBL_CONVERGED = .false. + sfc_connected = .true. do OBL_IT=1,MAX_OBL_IT @@ -662,47 +660,48 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS if (.not.CS%Use_MLD_Iteration) OBL_CONVERGED = .true. ! Reset ML_depth - CS%ML_depth(i,j) = h(i,1)*GV%H_to_Z - sfc_connected(i) = .true. + MLD_output = h(1)*GV%H_to_Z + sfc_connected = .true. !/ Here we get MStar, which is the ratio of convective TKE driven ! mixing to UStar**3 if (CS%Use_LT) then - call get_Langmuir_Number( LA, G, GV, US, abs(MLD_guess), u_star_mean, i, j, & - H=H(i,:), U_H=U(i,:), V_H=V(i,:), WAVES=WAVES) - call find_mstar(CS, US, b_flux, U_Star, U_Star_Mean, MLD_Guess, AbsF(i), & + call get_Langmuir_Number(LA, G, GV, US, abs(MLD_guess), u_star_mean, i, j, & + H=h, U_H=u, V_H=v, Waves=Waves) + call find_mstar(CS, US, b_flux, U_Star, U_Star_Mean, MLD_Guess, absf, & MStar_total, Langmuir_Number = La, Convect_Langmuir_Number = LAmod,& Enhance_MStar = Enhance_MStar, mstar_LT = mstar_LT) else - call find_mstar(CS, US, b_flux, u_star, u_star_mean, MLD_guess, absf(i), mstar_total) + call find_mstar(CS, US, b_flux, u_star, u_star_mean, MLD_guess, absf, mstar_total) endif !/ Apply MStar to get mech_TKE if ((CS%answers_2018) .and. (CS%mstar_mode==0)) then - mech_TKE(i) = (dt*MSTAR_total*GV%Rho0) * US%Z_to_m**3 * U_star**3 + mech_TKE = (dt*MSTAR_total*GV%Rho0) * US%Z_to_m**3 * U_star**3 else - mech_TKE(i) = MSTAR_total * US%Z_to_m**3 * (dt*GV%Rho0*U_star**3) + mech_TKE = MSTAR_total * US%Z_to_m**3 * (dt*GV%Rho0*U_star**3) endif if (CS%TKE_diagnostics) then dTKE_conv = 0.0 ; dTKE_mixing = 0.0 dTKE_MKE = 0.0 ; dTKE_mech_decay = 0.0 ; dTKE_conv_decay = 0.0 - dTKE_wind = mech_TKE(i) * IdtdR0 + dTKE_wind = mech_TKE * IdtdR0 if (TKE_forced(i,j,1) <= 0.0) then - dTKE_forcing = max(-mech_TKE(i), TKE_forced(i,j,1)) * IdtdR0 - ! dTKE_unbalanced_forcing_term1 = min(0.0, TKE_forced(i,j,1) + mech_TKE(i)) * IdtdR0 + dTKE_forcing = max(-mech_TKE, TKE_forced(i,j,1)) * IdtdR0 + ! dTKE_unbalanced = min(0.0, TKE_forced(i,j,1) + mech_TKE) * IdtdR0 else dTKE_forcing = CS%nstar*TKE_forced(i,j,1) * IdtdR0 + ! dTKE_unbalanced = 0.0 endif endif if (TKE_forced(i,j,1) <= 0.0) then - mech_TKE(i) = mech_TKE(i) + TKE_forced(i,j,1) - if (mech_TKE(i) < 0.0) mech_TKE(i) = 0.0 - conv_PErel(i) = 0.0 + mech_TKE = mech_TKE + TKE_forced(i,j,1) + if (mech_TKE < 0.0) mech_TKE = 0.0 + conv_PErel = 0.0 else - conv_PErel(i) = TKE_forced(i,j,1) + conv_PErel = TKE_forced(i,j,1) endif @@ -731,7 +730,7 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS h_rsum = 0.0 MixLen_shape(1) = 1.0 do K=2,nz+1 - h_rsum = h_rsum + h(i,k-1)*GV%H_to_Z + h_rsum = h_rsum + h(k-1)*GV%H_to_Z if (CS%MixLenExponent==2.0) then MixLen_shape(K) = CS%transLay_scale + (1.0 - CS%transLay_scale) * & (max(0.0, (MLD_guess - h_rsum)*I_MLD) )**2 ! CS%MixLenExponent @@ -742,15 +741,15 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS enddo endif - Kd(i,1) = 0.0 ; Kddt_h(1) = 0.0 - hp_a(i) = h(i,1) - dT_to_dPE_a(i,1) = dT_to_dPE(i,1) ; dT_to_dColHt_a(i,1) = dT_to_dColHt(i,1) - dS_to_dPE_a(i,1) = dS_to_dPE(i,1) ; dS_to_dColHt_a(i,1) = dS_to_dColHt(i,1) + Kd(1) = 0.0 ; Kddt_h(1) = 0.0 + hp_a = h(1) + dT_to_dPE_a(1) = dT_to_dPE(1) ; dT_to_dColHt_a(1) = dT_to_dColHt(1) + dS_to_dPE_a(1) = dS_to_dPE(1) ; dS_to_dColHt_a(1) = dS_to_dColHt(1) - htot(i) = h(i,1) ; uhtot(i) = u(i,1)*h(i,1) ; vhtot(i) = v(i,1)*h(i,1) + htot = h(1) ; uhtot = u(1)*h(1) ; vhtot = v(1)*h(1) if (debug) then - mech_TKE_k(i,1) = mech_TKE(i) ; conv_PErel_k(i,1) = conv_PErel(i) + mech_TKE_k(1) = mech_TKE ; conv_PErel_k(1) = conv_PErel nstar_k(:) = 0.0 ; nstar_k(1) = CS%nstar ; num_itts(:) = -1 endif @@ -762,38 +761,38 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS ! different rates. The following form is often used for mechanical ! stirring from the surface, perhaps due to breaking surface gravity ! waves and wind-driven turbulence. - Idecay_len_TKE(i) = (CS%TKE_decay * absf(i) / U_star) * GV%H_to_Z + Idecay_len_TKE = (CS%TKE_decay * absf / U_star) * GV%H_to_Z exp_kh = 1.0 - if (Idecay_len_TKE(i) > 0.0) exp_kh = exp(-h(i,k-1)*Idecay_len_TKE(i)) + if (Idecay_len_TKE > 0.0) exp_kh = exp(-h(k-1)*Idecay_len_TKE) if (CS%TKE_diagnostics) & - dTKE_mech_decay = dTKE_mech_decay + (exp_kh-1.0) * mech_TKE(i) * IdtdR0 - mech_TKE(i) = mech_TKE(i) * exp_kh + dTKE_mech_decay = dTKE_mech_decay + (exp_kh-1.0) * mech_TKE * IdtdR0 + mech_TKE = mech_TKE * exp_kh ! Accumulate any convectively released potential energy to contribute ! to wstar and to drive penetrating convection. if (TKE_forced(i,j,k) > 0.0) then - conv_PErel(i) = conv_PErel(i) + TKE_forced(i,j,k) + conv_PErel = conv_PErel + TKE_forced(i,j,k) if (CS%TKE_diagnostics) & dTKE_forcing = dTKE_forcing + CS%nstar*TKE_forced(i,j,k) * IdtdR0 endif if (debug) then - mech_TKE_k(i,K) = mech_TKE(i) ; conv_PErel_k(i,K) = conv_PErel(i) + mech_TKE_k(K) = mech_TKE ; conv_PErel_k(K) = conv_PErel endif ! Determine the total energy nstar_FC = CS%nstar - if (CS%nstar * conv_PErel(i) > 0.0) then + if (CS%nstar * conv_PErel > 0.0) then ! Here nstar is a function of the natural Rossby number 0.2/(1+0.2/Ro), based ! on a curve fit from the data of Wang (GRL, 2003). - ! Note: Ro = 1.0 / sqrt(0.5 * dt * Rho0 * (absf*htot(i))**3 / conv_PErel(i)) - nstar_FC = CS%nstar * conv_PErel(i) / (conv_PErel(i) + 0.2 * & - sqrt(0.5 * dt * GV%Rho0 * (absf(i)*(htot(i)*GV%H_to_m))**3 * conv_PErel(i))) + ! Note: Ro = 1.0 / sqrt(0.5 * dt * Rho0 * (absf*htot)**3 / conv_PErel) + nstar_FC = CS%nstar * conv_PErel / (conv_PErel + 0.2 * & + sqrt(0.5 * dt * GV%Rho0 * (absf*(htot*GV%H_to_m))**3 * conv_PErel)) endif if (debug) nstar_k(K) = nstar_FC - tot_TKE = mech_TKE(i) + nstar_FC * conv_PErel(i) + tot_TKE = mech_TKE + nstar_FC * conv_PErel ! For each interior interface, first discard the TKE to account for ! mixing of shortwave radiation through the next denser cell. @@ -803,12 +802,11 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS if (CS%TKE_diagnostics) then dTKE_mixing = dTKE_mixing + tot_TKE * IdtdR0 dTKE_forcing = dTKE_forcing - tot_TKE * IdtdR0 - ! dTKE_unbalanced_forcing = dTKE_unbalanced_forcing + & - ! (TKE_forced(i,j,k) + tot_TKE) * IdtdR0 + ! dTKE_unbalanced = dTKE_unbalanced + (TKE_forced(i,j,k) + tot_TKE) * IdtdR0 dTKE_conv_decay = dTKE_conv_decay + & - (CS%nstar-nstar_FC) * conv_PErel(i) * IdtdR0 + (CS%nstar-nstar_FC) * conv_PErel * IdtdR0 endif - tot_TKE = 0.0 ; mech_TKE(i) = 0.0 ; conv_PErel(i) = 0.0 + tot_TKE = 0.0 ; mech_TKE = 0.0 ; conv_PErel = 0.0 else ! Reduce the mechanical and convective TKE proportionately. TKE_reduc = (tot_TKE + TKE_forced(i,j,k)) / tot_TKE @@ -816,11 +814,11 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS dTKE_mixing = dTKE_mixing - TKE_forced(i,j,k) * IdtdR0 dTKE_forcing = dTKE_forcing + TKE_forced(i,j,k) * IdtdR0 dTKE_conv_decay = dTKE_conv_decay + & - (1.0-TKE_reduc)*(CS%nstar-nstar_FC) * conv_PErel(i) * IdtdR0 + (1.0-TKE_reduc)*(CS%nstar-nstar_FC) * conv_PErel * IdtdR0 endif tot_TKE = TKE_reduc*tot_TKE ! = tot_TKE + TKE_forced(i,j,k) - mech_TKE(i) = TKE_reduc*mech_TKE(i) - conv_PErel(i) = TKE_reduc*conv_PErel(i) + mech_TKE = TKE_reduc*mech_TKE + conv_PErel = TKE_reduc*conv_PErel endif endif @@ -833,7 +831,7 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS dSe_t2 = Kddt_h(K-1) * ((S0(k-2) - S0(k-1)) + dSe(k-2)) endif endif - dt_h = (GV%Z_to_H**2*dt) / max(0.5*(h(i,k-1)+h(i,k)), 1e-15*h_sum(i)) + dt_h = (GV%Z_to_H**2*dt) / max(0.5*(h(k-1)+h(k)), 1e-15*h_sum) ! This tests whether the layers above and below this interface are in ! a convetively stable configuration, without considering any effects of @@ -842,13 +840,13 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS ! mixing across interface K-1. The dT_to_dColHt here are effectively ! mass-weigted estimates of dSV_dT. Convectively_stable = ( 0.0 <= & - ( (dT_to_dColHt(i,k) + dT_to_dColHt(i,k-1) ) * (T0(k-1)-T0(k)) + & - (dS_to_dColHt(i,k) + dS_to_dColHt(i,k-1) ) * (S0(k-1)-S0(k)) ) ) + ( (dT_to_dColHt(k) + dT_to_dColHt(k-1) ) * (T0(k-1)-T0(k)) + & + (dS_to_dColHt(k) + dS_to_dColHt(k-1) ) * (S0(k-1)-S0(k)) ) ) - if ((mech_TKE(i) + conv_PErel(i)) <= 0.0 .and. Convectively_stable) then + if ((mech_TKE + conv_PErel) <= 0.0 .and. Convectively_stable) then ! Energy is already exhausted, so set Kd = 0 and cycle or exit? - tot_TKE = 0.0 ; mech_TKE(i) = 0.0 ; conv_PErel(i) = 0.0 - Kd(i,K) = 0.0 ; Kddt_h(K) = 0.0 + tot_TKE = 0.0 ; mech_TKE = 0.0 ; conv_PErel = 0.0 + Kd(K) = 0.0 ; Kddt_h(K) = 0.0 sfc_disconnect = .true. ! if (.not.debug) exit @@ -857,18 +855,18 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS ! tridiagonal solver for the whole column to be completed for debugging ! purposes, and also allows for something akin to convective adjustment ! in unstable interior regions? - b1 = 1.0 / hp_a(i) + b1 = 1.0 / hp_a c1(K) = 0.0 if (CS%orig_PE_calc) then dTe(k-1) = b1 * ( dTe_t2 ) dSe(k-1) = b1 * ( dSe_t2 ) endif - hp_a(i) = h(i,k) - dT_to_dPE_a(i,k) = dT_to_dPE(i,k) - dS_to_dPE_a(i,k) = dS_to_dPE(i,k) - dT_to_dColHt_a(i,k) = dT_to_dColHt(i,k) - dS_to_dColHt_a(i,k) = dS_to_dColHt(i,k) + hp_a = h(k) + dT_to_dPE_a(k) = dT_to_dPE(k) + dS_to_dPE_a(k) = dS_to_dPE(k) + dT_to_dColHt_a(k) = dT_to_dColHt(k) + dS_to_dColHt_a(k) = dS_to_dColHt(k) else ! tot_TKE > 0.0 or this is a potentially convectively unstable profile. sfc_disconnect = .false. @@ -881,20 +879,20 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS dS_km1_t2 = (S0(k)-S0(k-1)) else dT_km1_t2 = (T0(k)-T0(k-1)) - & - (Kddt_h(K-1) / hp_a(i)) * ((T0(k-2) - T0(k-1)) + dTe(k-2)) + (Kddt_h(K-1) / hp_a) * ((T0(k-2) - T0(k-1)) + dTe(k-2)) dS_km1_t2 = (S0(k)-S0(k-1)) - & - (Kddt_h(K-1) / hp_a(i)) * ((S0(k-2) - S0(k-1)) + dSe(k-2)) + (Kddt_h(K-1) / hp_a) * ((S0(k-2) - S0(k-1)) + dSe(k-2)) endif - dTe_term = dTe_t2 + hp_a(i) * (T0(k-1)-T0(k)) - dSe_term = dSe_t2 + hp_a(i) * (S0(k-1)-S0(k)) + dTe_term = dTe_t2 + hp_a * (T0(k-1)-T0(k)) + dSe_term = dSe_t2 + hp_a * (S0(k-1)-S0(k)) else if (K<=2) then - Th_a(k-1) = h(i,k-1) * T0(k-1) ; Sh_a(k-1) = h(i,k-1) * S0(k-1) + Th_a(k-1) = h(k-1) * T0(k-1) ; Sh_a(k-1) = h(k-1) * S0(k-1) else - Th_a(k-1) = h(i,k-1) * T0(k-1) + Kddt_h(K-1) * Te(k-2) - Sh_a(k-1) = h(i,k-1) * S0(k-1) + Kddt_h(K-1) * Se(k-2) + Th_a(k-1) = h(k-1) * T0(k-1) + Kddt_h(K-1) * Te(k-2) + Sh_a(k-1) = h(k-1) * S0(k-1) + Kddt_h(K-1) * Se(k-2) endif - Th_b(k) = h(i,k) * T0(k) ; Sh_b(k) = h(i,k) * S0(k) + Th_b(k) = h(k) * T0(k) ; Sh_b(k) = h(k) * S0(k) endif ! Using Pr=1 and the diffusivity at the bottom interface (once it is @@ -902,16 +900,16 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS ! extracted within a timestep and add a fraction CS%MKE_to_TKE_effic of ! this to the mTKE budget available for mixing in the next layer. - if ((CS%MKE_to_TKE_effic > 0.0) .and. (htot(i)*h(i,k) > 0.0)) then + if ((CS%MKE_to_TKE_effic > 0.0) .and. (htot*h(k) > 0.0)) then ! This is the energy that would be available from homogenizing the ! velocities between layer k and the layers above. dMKE_max = (GV%H_to_kg_m2 * CS%MKE_to_TKE_effic) * 0.5 * & - (h(i,k) / ((htot(i) + h(i,k))*htot(i))) * & - ((uhtot(i)-u(i,k)*htot(i))**2 + (vhtot(i)-v(i,k)*htot(i))**2) + (h(k) / ((htot + h(k))*htot)) * & + ((uhtot-u(k)*htot)**2 + (vhtot-v(k)*htot)**2) ! A fraction (1-exp(Kddt_h*MKE2_Hharm)) of this energy would be ! extracted by mixing with a finite viscosity. - MKE2_Hharm = (htot(i) + h(i,k) + 2.0*h_neglect) / & - ((htot(i)+h_neglect) * (h(i,k)+h_neglect)) + MKE2_Hharm = (htot + h(k) + 2.0*h_neglect) / & + ((htot+h_neglect) * (h(k)+h_neglect)) else dMKE_max = 0.0 MKE2_Hharm = 0.0 @@ -920,25 +918,25 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS ! At this point, Kddt_h(K) will be unknown because its value may depend ! on how much energy is available. mech_TKE might be negative due to ! contributions from TKE_forced. - h_tt = htot(i) + h_tt_min - TKE_here = mech_TKE(i) + CS%wstar_ustar_coef*conv_PErel(i) + h_tt = htot + h_tt_min + TKE_here = mech_TKE + CS%wstar_ustar_coef*conv_PErel if (TKE_here > 0.0) then if (CS%wT_mode==0) then vstar = CS%vstar_scale_fac * (I_dtrho*TKE_here)**C1_3 elseif (CS%wT_mode==1) then - Surface_Scale = max(0.05,1.-htot(i)/MLD_guess) + Surface_Scale = max(0.05, 1.0 - htot/MLD_guess) vstar = CS%vstar_scale_fac * (CS%vstar_surf_fac*U_Star + & - (CS%wstar_ustar_coef*conv_PErel(i)*I_dtrho)**C1_3)* & + (CS%wstar_ustar_coef*conv_PErel*I_dtrho)**C1_3)* & Surface_Scale endif - hbs_here = GV%H_to_Z * min(hb_hs(i,K), MixLen_shape(K)) + hbs_here = GV%H_to_Z * min(hb_hs(K), MixLen_shape(K)) Mixing_Length_Used(k) = MAX(CS%min_mix_len, ((h_tt*hbs_here)*vstar) / & - ((CS%Ekman_scale_coef * absf(i)) * (h_tt*hbs_here) + vstar)) + ((CS%Ekman_scale_coef * absf) * (h_tt*hbs_here) + vstar)) !Note setting Kd_guess0 to Mixing_Length_Used(K) here will ! change the answers. Therefore, skipping that. if (.not.CS%Use_MLD_Iteration) then Kd_guess0 = vstar * CS%vonKar * ((h_tt*hbs_here)*vstar) / & - ((CS%Ekman_scale_coef * absf(i)) * (h_tt*hbs_here) + vstar) + ((CS%Ekman_scale_coef * absf) * (h_tt*hbs_here) + vstar) else Kd_guess0 = vstar * CS%vonKar * Mixing_Length_Used(k) endif @@ -949,19 +947,19 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS Kddt_h_g0 = Kd_guess0*dt_h if (CS%orig_PE_calc) then - call find_PE_chg_orig(Kddt_h_g0, h(i,k), hp_a(i), dTe_term, dSe_term, & - dT_km1_t2, dS_km1_t2, dT_to_dPE(i,k), dS_to_dPE(i,k), & - dT_to_dPE_a(i,k-1), dS_to_dPE_a(i,k-1), & - pres_Z(i,K), dT_to_dColHt(i,k), dS_to_dColHt(i,k), & - dT_to_dColHt_a(i,k-1), dS_to_dColHt_a(i,k-1), & + call find_PE_chg_orig(Kddt_h_g0, h(k), hp_a, dTe_term, dSe_term, & + dT_km1_t2, dS_km1_t2, dT_to_dPE(k), dS_to_dPE(k), & + dT_to_dPE_a(k-1), dS_to_dPE_a(k-1), & + pres_Z(K), dT_to_dColHt(k), dS_to_dColHt(k), & + dT_to_dColHt_a(k-1), dS_to_dColHt_a(k-1), & PE_chg=PE_chg_g0, dPEc_dKd=dPEa_dKd_g0, dPE_max=PE_chg_max, & dPEc_dKd_0=dPEc_dKd_Kd0 ) else - call find_PE_chg(0.0, Kddt_h_g0, hp_a(i), h(i,k), & + call find_PE_chg(0.0, Kddt_h_g0, hp_a, h(k), & Th_a(k-1), Sh_a(k-1), Th_b(k), Sh_b(k), & - dT_to_dPE_a(i,k-1), dS_to_dPE_a(i,k-1), dT_to_dPE(i,k), dS_to_dPE(i,k), & - pres_Z(i,K), dT_to_dColHt_a(i,k-1), dS_to_dColHt_a(i,k-1), & - dT_to_dColHt(i,k), dS_to_dColHt(i,k), & + dT_to_dPE_a(k-1), dS_to_dPE_a(k-1), dT_to_dPE(k), dS_to_dPE(k), & + pres_Z(K), dT_to_dColHt_a(k-1), dS_to_dColHt_a(k-1), & + dT_to_dColHt(k), dS_to_dColHt(k), & PE_chg=PE_chg_g0, dPEc_dKd=dPEa_dKd_g0, dPE_max=PE_chg_max, & dPEc_dKd_0=dPEc_dKd_Kd0 ) endif @@ -973,74 +971,74 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS ! This column is convectively unstable. if (PE_chg_max <= 0.0) then ! Does MKE_src need to be included in the calculation of vstar here? - TKE_here = mech_TKE(i) + CS%wstar_ustar_coef*(conv_PErel(i)-PE_chg_max) + TKE_here = mech_TKE + CS%wstar_ustar_coef*(conv_PErel-PE_chg_max) if (TKE_here > 0.0) then if (CS%wT_mode==0) then vstar = CS%vstar_scale_fac * (I_dtrho*TKE_here)**C1_3 elseif (CS%wT_mode==1) then - Surface_Scale = max(0.05,1.-htot(i)/MLD_guess) + Surface_Scale = max(0.05, 1. - htot/MLD_guess) vstar = cs%vstar_scale_fac * (CS%vstar_surf_fac*U_Star + & - (CS%wstar_ustar_coef*conv_PErel(i)*I_dtrho)**C1_3)* & + (CS%wstar_ustar_coef*conv_PErel*I_dtrho)**C1_3)* & Surface_Scale endif - hbs_here = GV%H_to_Z * min(hb_hs(i,K), MixLen_shape(K)) + hbs_here = GV%H_to_Z * min(hb_hs(K), MixLen_shape(K)) Mixing_Length_Used(k) = max(CS%min_mix_len,((h_tt*hbs_here)*vstar) / & - ((CS%Ekman_scale_coef * absf(i)) * (h_tt*hbs_here) + vstar)) + ((CS%Ekman_scale_coef * absf) * (h_tt*hbs_here) + vstar)) if (.not.CS%Use_MLD_Iteration) then ! Note again (as prev) that using Mixing_Length_Used here ! instead of redoing the computation will change answers... - Kd(i,K) = vstar * CS%vonKar * ((h_tt*hbs_here)*vstar) / & - ((CS%Ekman_scale_coef * absf(i)) * (h_tt*hbs_here) + vstar) + Kd(K) = vstar * CS%vonKar * ((h_tt*hbs_here)*vstar) / & + ((CS%Ekman_scale_coef * absf) * (h_tt*hbs_here) + vstar) else - Kd(i,K) = vstar * CS%vonKar * Mixing_Length_Used(k) + Kd(K) = vstar * CS%vonKar * Mixing_Length_Used(k) endif else - vstar = 0.0 ; Kd(i,K) = 0.0 + vstar = 0.0 ; Kd(K) = 0.0 endif Vstar_Used(k) = vstar if (CS%orig_PE_calc) then - call find_PE_chg_orig(Kd(i,K)*dt_h, h(i,k), hp_a(i), dTe_term, dSe_term, & - dT_km1_t2, dS_km1_t2, dT_to_dPE(i,k), dS_to_dPE(i,k), & - dT_to_dPE_a(i,k-1), dS_to_dPE_a(i,k-1), & - pres_Z(i,K), dT_to_dColHt(i,k), dS_to_dColHt(i,k), & - dT_to_dColHt_a(i,k-1), dS_to_dColHt_a(i,k-1), & + call find_PE_chg_orig(Kd(K)*dt_h, h(k), hp_a, dTe_term, dSe_term, & + dT_km1_t2, dS_km1_t2, dT_to_dPE(k), dS_to_dPE(k), & + dT_to_dPE_a(k-1), dS_to_dPE_a(k-1), & + pres_Z(K), dT_to_dColHt(k), dS_to_dColHt(k), & + dT_to_dColHt_a(k-1), dS_to_dColHt_a(k-1), & PE_chg=dPE_conv) else - call find_PE_chg(0.0, Kd(i,K)*dt_h, hp_a(i), h(i,k), & + call find_PE_chg(0.0, Kd(K)*dt_h, hp_a, h(k), & Th_a(k-1), Sh_a(k-1), Th_b(k), Sh_b(k), & - dT_to_dPE_a(i,k-1), dS_to_dPE_a(i,k-1), dT_to_dPE(i,k), dS_to_dPE(i,k), & - pres_Z(i,K), dT_to_dColHt_a(i,k-1), dS_to_dColHt_a(i,k-1), & - dT_to_dColHt(i,k), dS_to_dColHt(i,k), & + dT_to_dPE_a(k-1), dS_to_dPE_a(k-1), dT_to_dPE(k), dS_to_dPE(k), & + pres_Z(K), dT_to_dColHt_a(k-1), dS_to_dColHt_a(k-1), & + dT_to_dColHt(k), dS_to_dColHt(k), & PE_chg=dPE_conv) endif ! Should this be iterated to convergence for Kd? if (dPE_conv > 0.0) then - Kd(i,K) = Kd_guess0 ; dPE_conv = PE_chg_g0 + Kd(K) = Kd_guess0 ; dPE_conv = PE_chg_g0 else - MKE_src = dMKE_max*(1.0 - exp(-(Kd(i,K)*dt_h) * MKE2_Hharm)) + MKE_src = dMKE_max*(1.0 - exp(-(Kd(K)*dt_h) * MKE2_Hharm)) endif else ! The energy change does not vary monotonically with Kddt_h. Find the maximum? - Kd(i,K) = Kd_guess0 ; dPE_conv = PE_chg_g0 + Kd(K) = Kd_guess0 ; dPE_conv = PE_chg_g0 endif - conv_PErel(i) = conv_PErel(i) - dPE_conv - mech_TKE(i) = mech_TKE(i) + MKE_src + conv_PErel = conv_PErel - dPE_conv + mech_TKE = mech_TKE + MKE_src if (CS%TKE_diagnostics) then dTKE_conv = dTKE_conv - CS%nstar*dPE_conv * IdtdR0 dTKE_MKE = dTKE_MKE + MKE_src * IdtdR0 endif - if (sfc_connected(i)) then - CS%ML_depth(i,J) = CS%ML_depth(i,J) + GV%H_to_Z * h(i,k) - ! CS%ML_depth2(i,j) = CS%ML_depth2(i,J) + GV%H_to_Z * h(i,k) + if (sfc_connected) then + MLD_output = MLD_output + GV%H_to_Z * h(k) + ! MLD_last = MLD_last + GV%H_to_Z * h(k) endif - Kddt_h(K) = Kd(i,K)*dt_h + Kddt_h(K) = Kd(K)*dt_h elseif (tot_TKE + (MKE_src - PE_chg_g0) >= 0.0) then ! This column is convctively stable and there is energy to support the suggested ! mixing. Keep that estimate. - Kd(i,K) = Kd_guess0 + Kd(K) = Kd_guess0 Kddt_h(K) = Kddt_h_g0 ! Reduce the mechanical and convective TKE proportionately. @@ -1051,19 +1049,19 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS dTKE_mixing = dTKE_mixing - PE_chg_g0 * IdtdR0 dTKE_MKE = dTKE_MKE + MKE_src * IdtdR0 dTKE_conv_decay = dTKE_conv_decay + & - (1.0-TKE_reduc)*(CS%nstar-nstar_FC) * conv_PErel(i) * IdtdR0 + (1.0-TKE_reduc)*(CS%nstar-nstar_FC) * conv_PErel * IdtdR0 endif tot_TKE = TKE_reduc*tot_TKE - mech_TKE(i) = TKE_reduc*(mech_TKE(i) + MKE_src) - conv_PErel(i) = TKE_reduc*conv_PErel(i) - if (sfc_connected(i)) then - CS%ML_depth(i,J) = CS%ML_depth(i,J) + GV%H_to_Z * h(i,k) + mech_TKE = TKE_reduc*(mech_TKE + MKE_src) + conv_PErel = TKE_reduc*conv_PErel + if (sfc_connected) then + MLD_output = MLD_output + GV%H_to_Z * h(k) endif elseif (tot_TKE == 0.0) then ! This can arise if nstar_FC = 0, but it is not common. - Kd(i,K) = 0.0 ; Kddt_h(K) = 0.0 - tot_TKE = 0.0 ; conv_PErel(i) = 0.0 ; mech_TKE(i) = 0.0 + Kd(K) = 0.0 ; Kddt_h(K) = 0.0 + tot_TKE = 0.0 ; conv_PErel = 0.0 ; mech_TKE = 0.0 sfc_disconnect = .true. else ! There is not enough energy to support the mixing, so reduce the @@ -1087,18 +1085,18 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS endif do itt=1,max_itt if (CS%orig_PE_calc) then - call find_PE_chg_orig(Kddt_h_guess, h(i,k), hp_a(i), dTe_term, dSe_term, & - dT_km1_t2, dS_km1_t2, dT_to_dPE(i,k), dS_to_dPE(i,k), & - dT_to_dPE_a(i,k-1), dS_to_dPE_a(i,k-1), & - pres_Z(i,K), dT_to_dColHt(i,k), dS_to_dColHt(i,k), & - dT_to_dColHt_a(i,k-1), dS_to_dColHt_a(i,k-1), & + call find_PE_chg_orig(Kddt_h_guess, h(k), hp_a, dTe_term, dSe_term, & + dT_km1_t2, dS_km1_t2, dT_to_dPE(k), dS_to_dPE(k), & + dT_to_dPE_a(k-1), dS_to_dPE_a(k-1), & + pres_Z(K), dT_to_dColHt(k), dS_to_dColHt(k), & + dT_to_dColHt_a(k-1), dS_to_dColHt_a(k-1), & PE_chg=PE_chg, dPEc_dKd=dPEc_dKd ) else - call find_PE_chg(0.0, Kddt_h_guess, hp_a(i), h(i,k), & + call find_PE_chg(0.0, Kddt_h_guess, hp_a, h(k), & Th_a(k-1), Sh_a(k-1), Th_b(k), Sh_b(k), & - dT_to_dPE_a(i,k-1), dS_to_dPE_a(i,k-1), dT_to_dPE(i,k), dS_to_dPE(i,k), & - pres_Z(i,K), dT_to_dColHt_a(i,k-1), dS_to_dColHt_a(i,k-1), & - dT_to_dColHt(i,k), dS_to_dColHt(i,k), & + dT_to_dPE_a(k-1), dS_to_dPE_a(k-1), dT_to_dPE(k), dS_to_dPE(k), & + pres_Z(K), dT_to_dColHt_a(k-1), dS_to_dColHt_a(k-1), & + dT_to_dColHt(k), dS_to_dColHt(k), & PE_chg=dPE_conv) endif MKE_src = dMKE_max * (1.0 - exp(-MKE2_Hharm * Kddt_h_guess)) @@ -1148,71 +1146,71 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS Kddt_h_guess = Kddt_h_next endif enddo ! Inner iteration loop on itt. - Kd(i,K) = Kddt_h_guess / dt_h ; Kddt_h(K) = Kd(i,K)*dt_h + Kd(K) = Kddt_h_guess / dt_h ; Kddt_h(K) = Kd(K)*dt_h ! All TKE should have been consumed. if (CS%TKE_diagnostics) then dTKE_mixing = dTKE_mixing - (tot_TKE + MKE_src) * IdtdR0 dTKE_MKE = dTKE_MKE + MKE_src * IdtdR0 dTKE_conv_decay = dTKE_conv_decay + & - (CS%nstar-nstar_FC) * conv_PErel(i) * IdtdR0 + (CS%nstar-nstar_FC) * conv_PErel * IdtdR0 endif - if (sfc_connected(i)) CS%ML_depth(i,J) = CS%ML_depth(i,J) + & - (PE_chg / PE_chg_g0) * GV%H_to_Z * h(i,k) + if (sfc_connected) MLD_output = MLD_output + & + (PE_chg / PE_chg_g0) * GV%H_to_Z * h(k) - tot_TKE = 0.0 ; mech_TKE(i) = 0.0 ; conv_PErel(i) = 0.0 + tot_TKE = 0.0 ; mech_TKE = 0.0 ; conv_PErel = 0.0 sfc_disconnect = .true. endif ! End of convective or forced mixing cases to determine Kd. - Kddt_h(K) = Kd(i,K)*dt_h + Kddt_h(K) = Kd(K)*dt_h ! At this point, the final value of Kddt_h(K) is known, so the ! estimated properties for layer k-1 can be calculated. - b1 = 1.0 / (hp_a(i) + Kddt_h(K)) + b1 = 1.0 / (hp_a + Kddt_h(K)) c1(K) = Kddt_h(K) * b1 if (CS%orig_PE_calc) then dTe(k-1) = b1 * ( Kddt_h(K)*(T0(k)-T0(k-1)) + dTe_t2 ) dSe(k-1) = b1 * ( Kddt_h(K)*(S0(k)-S0(k-1)) + dSe_t2 ) endif - hp_a(i) = h(i,k) + (hp_a(i) * b1) * Kddt_h(K) - dT_to_dPE_a(i,k) = dT_to_dPE(i,k) + c1(K)*dT_to_dPE_a(i,k-1) - dS_to_dPE_a(i,k) = dS_to_dPE(i,k) + c1(K)*dS_to_dPE_a(i,k-1) - dT_to_dColHt_a(i,k) = dT_to_dColHt(i,k) + c1(K)*dT_to_dColHt_a(i,k-1) - dS_to_dColHt_a(i,k) = dS_to_dColHt(i,k) + c1(K)*dS_to_dColHt_a(i,k-1) + hp_a = h(k) + (hp_a * b1) * Kddt_h(K) + dT_to_dPE_a(k) = dT_to_dPE(k) + c1(K)*dT_to_dPE_a(k-1) + dS_to_dPE_a(k) = dS_to_dPE(k) + c1(K)*dS_to_dPE_a(k-1) + dT_to_dColHt_a(k) = dT_to_dColHt(k) + c1(K)*dT_to_dColHt_a(k-1) + dS_to_dColHt_a(k) = dS_to_dColHt(k) + c1(K)*dS_to_dColHt_a(k-1) endif ! tot_TKT > 0.0 branch. Kddt_h(K) has been set. ! Store integrated velocities and thicknesses for MKE conversion calculations. if (sfc_disconnect) then ! There is no turbulence at this interface, so zero out the running sums. - uhtot(i) = u(i,k)*h(i,k) - vhtot(i) = v(i,k)*h(i,k) - htot(i) = h(i,k) - sfc_connected(i) = .false. + uhtot = u(k)*h(k) + vhtot = v(k)*h(k) + htot = h(k) + sfc_connected = .false. else - uhtot(i) = uhtot(i) + u(i,k)*h(i,k) - vhtot(i) = vhtot(i) + v(i,k)*h(i,k) - htot(i) = htot(i) + h(i,k) + uhtot = uhtot + u(k)*h(k) + vhtot = vhtot + v(k)*h(k) + htot = htot + h(k) endif if (debug) then if (k==2) then - Te(1) = b1*(h(i,1)*T0(1)) - Se(1) = b1*(h(i,1)*S0(1)) + Te(1) = b1*(h(1)*T0(1)) + Se(1) = b1*(h(1)*S0(1)) else - Te(k-1) = b1 * (h(i,k-1) * T0(k-1) + Kddt_h(K-1) * Te(k-2)) - Se(k-1) = b1 * (h(i,k-1) * S0(k-1) + Kddt_h(K-1) * Se(k-2)) + Te(k-1) = b1 * (h(k-1) * T0(k-1) + Kddt_h(K-1) * Te(k-2)) + Se(k-1) = b1 * (h(k-1) * S0(k-1) + Kddt_h(K-1) * Se(k-2)) endif endif enddo - Kd(i,nz+1) = 0.0 + Kd(nz+1) = 0.0 if (debug) then ! Complete the tridiagonal solve for Te. - b1 = 1.0 / hp_a(i) - Te(nz) = b1 * (h(i,nz) * T0(nz) + Kddt_h(nz) * Te(nz-1)) - Se(nz) = b1 * (h(i,nz) * S0(nz) + Kddt_h(nz) * Se(nz-1)) + b1 = 1.0 / hp_a + Te(nz) = b1 * (h(nz) * T0(nz) + Kddt_h(nz) * Te(nz-1)) + Se(nz) = b1 * (h(nz) * S0(nz) + Kddt_h(nz) * Se(nz-1)) do k=nz-1,1,-1 Te(k) = Te(k) + c1(K+1)*Te(k+1) Se(k) = Se(k) + c1(K+1)*Se(k+1) @@ -1231,8 +1229,8 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS if (debug) then dPE_debug = 0.0 do k=1,nz - dPE_debug = dPE_debug + (dT_to_dPE(i,k) * (Te(k) - T0(k)) + & - dS_to_dPE(i,k) * (Se(k) - S0(k))) + dPE_debug = dPE_debug + (dT_to_dPE(k) * (Te(k) - T0(k)) + & + dS_to_dPE(k) * (Se(k) - S0(k))) enddo mixing_debug = dPE_debug * IdtdR0 endif @@ -1249,14 +1247,14 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS do k=2,nz if (FIRST_OBL) then ! Breaks when OBL found if ((Vstar_Used(k) > 1.e-10*US%m_to_Z) .and. k < nz) then - MLD_found = MLD_found + h(i,k-1)*GV%H_to_Z + MLD_found = MLD_found + h(k-1)*GV%H_to_Z else FIRST_OBL = .false. if (MLD_found - CS%MLD_tol > MLD_guess) then min_MLD = MLD_guess - elseif ((MLD_guess - MLD_found) < max(CS%MLD_tol,h(i,k-1)*GV%H_to_Z)) then + elseif ((MLD_guess - MLD_found) < max(CS%MLD_tol, h(k-1)*GV%H_to_Z)) then OBL_CONVERGED = .true. ! Break convergence loop - CS%ML_Depth2(i,j) = MLD_guess + MLD_last = MLD_guess else max_MLD = MLD_guess ! We know this guess was too deep endif @@ -1265,12 +1263,12 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS enddo else !New method uses ML_DEPTH as computed in ePBL routine - MLD_found = CS%ML_Depth(i,j) + MLD_found = MLD_output if (MLD_found - CS%MLD_tol > MLD_guess) then min_MLD = MLD_guess elseif (abs(MLD_guess - MLD_found) < CS%MLD_tol) then OBL_CONVERGED = .true. ! Break convergence loop - CS%ML_Depth2(i,j) = MLD_guess + MLD_last = MLD_guess else max_MLD = MLD_guess ! We know this guess was too deep endif @@ -1280,6 +1278,13 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS endif enddo ! Iteration loop for converged boundary layer thickness. + ! Copy the diffusivities to a 2-d array. + do K=1,nz+1 + Kd_2d(i,K) = Kd(K) + enddo + CS%ML_Depth2(i,j) = MLD_last + CS%ML_depth(i,j) = MLD_output + if (CS%TKE_diagnostics) then CS%diag_TKE_MKE(i,j) = CS%diag_TKE_MKE(i,j) + dTKE_MKE CS%diag_TKE_conv(i,j) = CS%diag_TKE_conv(i,j) + dTKE_conv @@ -1288,7 +1293,7 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS CS%diag_TKE_mixing(i,j) = CS%diag_TKE_mixing(i,j) + dTKE_mixing CS%diag_TKE_mech_decay(i,j) = CS%diag_TKE_mech_decay(i,j) + dTKE_mech_decay CS%diag_TKE_conv_decay(i,j) = CS%diag_TKE_conv_decay(i,j) + dTKE_conv_decay - ! CS%diag_TKE_unbalanced_forcing(i,j) = CS%diag_TKE_unbalanced_forcing(i,j) + dTKE_unbalanced_forcing_term1 + dTKE_unbalanced + ! CS%diag_TKE_unbalanced_forcing(i,j) = CS%diag_TKE_unbalanced_forcing(i,j) + dTKE_unbalanced endif if (CS%Mixing_Diagnostics) then ! Write to 3-D for outputing Mixing length and velocity scale. @@ -1300,18 +1305,28 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS if (allocated(CS%Enhance_M)) CS%Enhance_M(i,j) = Enhance_mstar if (allocated(CS%mstar_mix)) CS%mstar_mix(i,j) = mstar_total if (allocated(CS%mstar_lt)) CS%mstar_lt(i,j) = MSTAR_LT - iL_Ekman = absf(i) / u_star + iL_Ekman = absf / u_star iL_Obukhov = b_flux*CS%vonkar / (u_star**3) if (allocated(CS%MLD_Obukhov)) CS%MLD_Obukhov(i,j) = MLD_guess * iL_Obukhov if (allocated(CS%MLD_Ekman)) CS%MLD_Ekman(i,j) = MLD_guess * iL_Ekman if (allocated(CS%Ekman_Obukhov)) CS%Ekman_Obukhov(i,j) = iL_Obukhov / (iL_Ekman + 1.e-10*US%Z_to_m) if (allocated(CS%La)) CS%La(i,j) = LA if (allocated(CS%La_mod)) CS%La_mod(i,j) = LAmod + if (CS%id_Hsfc_used > 0) then + Hsfc_used(i,j) = h(1)*GV%H_to_Z + do k=2,nz + if (Kd(K) > 0.0) Hsfc_used(i,j) = Hsfc_used(i,j) + h(k)*GV%H_to_Z + enddo + endif else ! End of the ocean-point part of the i-loop ! For masked points, Kd_int must still be set (to 0) because it has intent out. do K=1,nz+1 - Kd(i,K) = 0. + Kd_2d(i,K) = 0. enddo + CS%ML_depth(i,j) = 0.0 + CS%ML_Depth2(i,j) = 0.0 + + if (CS%id_Hsfc_used > 0) Hsfc_used(i,j) = 0.0 if (present(dT_expected)) then do k=1,nz ; dT_expected(i,j,k) = 0.0 ; enddo endif @@ -1320,15 +1335,8 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS endif endif ; enddo ! Close of i-loop - Note unusual loop order! - if (CS%id_Hsfc_used > 0) then - do i=is,ie ; Hsfc_used(i,j) = h(i,1)*GV%H_to_Z ; enddo - do k=2,nz ; do i=is,ie - if (Kd(i,K) > 0.0) Hsfc_used(i,j) = Hsfc_used(i,j) + h(i,k)*GV%H_to_Z - enddo ; enddo - endif - do K=1,nz+1 ; do i=is,ie - Kd_int(i,j,K) = Kd(i,K) + Kd_int(i,j,K) = Kd_2d(i,K) enddo ; enddo enddo ! j-loop @@ -1784,7 +1792,7 @@ subroutine Mstar_Langmuir(CS, US, abs_Coriolis, buoyancy_flux, ustar, BLD, Langm real, parameter :: Max_ratio = 1.0e16 ! The maximum value of a nondimensional ratio. real :: iL_Ekman ! Inverse of Ekman length scale [Z-1 ~> m-1]. real :: iL_Obukhov ! Inverse of Obukhov length scale [Z-1 ~> m-1]. - real :: I_ustar ! The Adcroft reciprocal of ustar [s Z-1 ~> s m-1] + real :: I_ustar ! The Adcroft reciprocal of ustar [s Z-1 ~> s m-1] real :: I_f ! The Adcroft reciprocal of the Coriolis parameter [s] real :: MLD_Ekman ! The ratio of the mixed layer depth to the Ekman layer depth [nondim]. real :: Ekman_Obukhov ! The Ekman layer thickness divided by the Obukhov depth [nondim]. From 853377e1569a6c38517c1bfc314de982a297ac95 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Wed, 12 Jun 2019 16:11:21 -0400 Subject: [PATCH 15/82] +(*)Eliminated ML_Depth2 from energetic_PBL_CS Eliminated the duplicated copy of the mixed layer depth from start of the final iteration, eliminated the semi-redundant diagnostics ePBL_OSBL, and changed to using the final estimate of the mixed layer depth for the first guess of the next timestep when MLD_ITERATION_GUESS is true. This later option would change answers, no MOM6-examples test cases use MLD_ITERATION_GUESS = True, and this option is recent and does not reproduce across restarts. This change alters some available_diags files, and could change answers in some cases (although this seems unlikely). --- .../vertical/MOM_energetic_PBL.F90 | 147 +++++++++--------- 1 file changed, 71 insertions(+), 76 deletions(-) diff --git a/src/parameterizations/vertical/MOM_energetic_PBL.F90 b/src/parameterizations/vertical/MOM_energetic_PBL.F90 index d39207176f..04b5eac954 100644 --- a/src/parameterizations/vertical/MOM_energetic_PBL.F90 +++ b/src/parameterizations/vertical/MOM_energetic_PBL.F90 @@ -162,6 +162,9 @@ module MOM_energetic_PBL type(diag_ctrl), pointer :: diag=>NULL() !< A structure that is used to regulate the !! timing of diagnostic output. + real, allocatable, dimension(:,:) :: & + ML_depth !< The mixed layer depth determined by active mixing in ePBL [Z ~> m]. + ! These are terms in the mixed layer TKE budget, all in [J m-2] = [kg s-2]. real, allocatable, dimension(:,:) :: & diag_TKE_wind, & !< The wind source of TKE [J m-2]. @@ -172,8 +175,6 @@ module MOM_energetic_PBL diag_TKE_conv_decay, & !< The decay of convective TKE [J m-2]. diag_TKE_mixing, & !< The work done by TKE to deepen the mixed layer [J m-2]. ! Additional output parameters also 2d - ML_depth, & !< The mixed layer depth [Z ~> m]. (result after iteration step) - ML_depth2, & !< The mixed layer depth [Z ~> m]. (guess for iteration step) Enhance_M, & !< The enhancement to the turbulent velocity scale [nondim] MSTAR_MIX, & !< Mstar used in EPBL [nondim] MSTAR_LT, & !< Mstar for Langmuir turbulence [nondim] @@ -192,7 +193,7 @@ module MOM_energetic_PBL integer :: id_TKE_mech_decay = -1, id_TKE_conv_decay = -1 integer :: id_Hsfc_used = -1 integer :: id_Mixing_Length = -1, id_Velocity_Scale = -1 - integer :: id_OSBL = -1, id_LT_Enhancement = -1, id_MSTAR_mix = -1 + integer :: id_LT_Enhancement = -1, id_MSTAR_mix = -1 integer :: id_mld_ekman = -1, id_mld_obukhov = -1, id_ekman_obukhov = -1 integer :: id_LA_mod = -1, id_LA = -1, id_MSTAR_LT = -1 !!@} @@ -234,8 +235,7 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS !! volume with salinity [m3 kg-1 ppt-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: TKE_forced !< The forcing requirements to homogenize the - !! forcing that has been applied to each layer - !! through each layer [J m-2]. + !! forcing that has been applied to each layer [J m-2]. type(thermo_var_ptrs), intent(inout) :: tv !< A structure containing pointers to any !! available thermodynamic fields. Absent fields !! have NULL ptrs. @@ -294,17 +294,23 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS ! Local variables real, dimension(SZI_(G),SZK_(GV)) :: & - h_2d, & ! A 2-d version of the layer thickness [H ~> m or kg m-2]. - T_2d, & ! A 2-d version of the layer temperatures [degC]. - S_2d, & ! A 2-d version of the layer salinities [ppt]. - u_2d, & ! A 2-d version of the zonal velocity [m s-1]. - v_2d ! A 2-d version of the meridional velocity [m s-1]. + h_2d, & ! A 2-d slice of the layer thickness [H ~> m or kg m-2]. + T_2d, & ! A 2-d slice of the layer temperatures [degC]. + S_2d, & ! A 2-d slice of the layer salinities [ppt]. + TKE_forced_2d, & ! A 2-d slice of TKE_forced [J m-2]. + dSV_dT_2d, & ! A 2-d slice of dSV_dT [m3 kg-1 degC-1]. + dSV_dS_2d, & ! A 2-d slice of dSV_dS [m3 kg-1 ppt-1]. + u_2d, & ! A 2-d slice of the zonal velocity [m s-1]. + v_2d ! A 2-d slice of the meridional velocity [m s-1]. real, dimension(SZI_(G),SZK_(GV)+1) :: & Kd_2d ! A 2-d version of the diapycnal diffusivity [Z2 s-1 ~> m2 s-1]. real, dimension(SZK_(GV)) :: & h, & ! The layer thickness [H ~> m or kg m-2]. T0, & ! The initial layer temperatures [degC]. S0, & ! The initial layer salinities [ppt]. + dSV_dT_1d, & ! The partial derivatives of specific volume with temperature [m3 kg-1 degC-1]. + dSV_dS_1d, & ! The partial derivatives of specific volume with salinity [m3 kg-1 ppt-1]. + TKE_forcing, & ! Forcing of the TKE in the layer coming from TKE_forced [J m-2]. u, & ! The zonal velocity [m s-1]. v ! The meridional velocity [m s-1]. real, dimension(SZK_(GV)+1) :: & @@ -348,8 +354,12 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS ! mixing effects with other yet higher layers [ppt H ~> ppt m or ppt kg m-2]. Th_b, & ! An effective temperature times a thickness in the layer below, including implicit ! mixing effects with other yet lower layers [degC H ~> degC m or degC kg m-2]. - Sh_b ! An effective salinity times a thickness in the layer below, including implicit + Sh_b, & ! An effective salinity times a thickness in the layer below, including implicit ! mixing effects with other yet lower layers [ppt H ~> ppt m or ppt kg m-2]. + dT_expect, & ! The layer temperature change that should be expected when the returned + ! diffusivities are applied [degC]. + dS_expect ! The layer salinity change that should be expected when the returned + ! diffusivities are applied [ppt]. real, dimension(SZK_(GV)+1) :: & MixLen_shape, & ! A nondimensional shape factor for the mixing length that ! gives it an appropriate assymptotic value at the bottom of @@ -393,7 +403,6 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS real :: mstar_total ! The value of mstar used in ePBL [nondim] real :: enhance_mstar ! An ehhancement to mstar (output for diagnostic) real :: mstar_LT ! An addition to mstar [nondim] (output for diagnostic) - real :: MLD_last ! The final or previous value of the mixed layer depth [Z ~> m]. real :: MLD_output ! The mixed layer depth output from this routine [Z ~> m]. real :: LA ! The value of the Langmuir number [nondim] real :: LAmod ! The modified Langmuir number by convection [nondim] @@ -560,15 +569,15 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS !!OMP parallel do default(private) shared(js,je,nz,is,ie,h_3d,u_3d,v_3d,tv,dt, & -!!OMP CS,G,GV,US,fluxes,IdtdR0, & -!!OMP TKE_forced,debug,H_neglect,dSV_dT, & -!!OMP dSV_dS,I_dtrho,C1_3,h_tt_min,vonKar, & +!!OMP CS,G,GV,US,fluxes,IdtdR0,debug,H_neglect, & +!!OMP TKE_forced,dSV_dT,dSV_dS,I_dtrho,C1_3,h_tt_min, & !!OMP max_itt,Kd_int) do j=js,je ! Copy the thicknesses and other fields to 2-d arrays. do k=1,nz ; do i=is,ie 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) - T_2d(i,k) = tv%T(i,j,k) ; S_2d(i,k) = tv%S(i,j,k) + T_2d(i,k) = tv%T(i,j,k) ; S_2d(i,k) = tv%S(i,j,k) ; TKE_forced_2d(i,k) = TKE_forced(i,j,k) + dSV_dT_2d(i,k) = dSV_dT(i,j,k) ; dSV_dS_2d(i,k) = dSV_dS(i,j,k) enddo ; enddo ! Determine the initial mech_TKE and conv_PErel, including the energy required @@ -579,12 +588,11 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS ! interface. do i=is,ie ; if (G%mask2dT(i,j) > 0.5) then - if (debug) then ; mech_TKE_k(:) = 0.0 ; conv_PErel_k(:) = 0.0 ; endif - ! Copy the thicknesses and other fields to 1-d arrays. do k=1,nz h(k) = h_2d(i,k) + h_neglect ; u(k) = u_2d(i,k) ; v(k) = v_2d(i,k) - T0(k) = T_2d(i,k) ; S0(k) = S_2d(i,k) + T0(k) = T_2d(i,k) ; S0(k) = S_2d(i,k) ; TKE_forcing(k) = TKE_forced_2d(i,k) + dSV_dT_1d(k) = dSV_dT_2d(i,k) ; dSV_dS_1d(k) = dSV_dS_2d(i,k) enddo do K=1,nz+1 ; Kd(K) = 0.0 ; enddo @@ -607,21 +615,27 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS absf = sqrt(CS%omega_frac*4.0*CS%omega**2 + (1.0-CS%omega_frac)*absf**2) endif + ! Perhaps provide a first guess for MLD based on a stored previous value. + MLD_guess = -1.0 + if (CS%MLD_iteration_guess .and. (CS%ML_Depth(i,j) > 0.0)) MLD_guess = CS%ML_Depth(i,j) + +! call ePBL_column(h, u, v, T0, S0, dSV_dT_1d, dSV_dS_1d, TKE_forcing, B_flux, absf, & +! u_star, u_star_mean, dt, MLD_guess, Kd, GV, US, CS, MLD_output, col_diags) + pres(1) = 0.0 pres_Z(1) = 0.0 do k=1,nz dMass = GV%H_to_kg_m2 * h(k) dPres = (GV%g_Earth*US%m_to_Z) * dMass ! This is equivalent to GV%H_to_Pa * h(k) - dT_to_dPE(k) = (dMass * (pres(K) + 0.5*dPres)) * dSV_dT(i,j,k) - dS_to_dPE(k) = (dMass * (pres(K) + 0.5*dPres)) * dSV_dS(i,j,k) - dT_to_dColHt(k) = dMass * US%m_to_Z * dSV_dT(i,j,k) - dS_to_dColHt(k) = dMass * US%m_to_Z * dSV_dS(i,j,k) + dT_to_dPE(k) = (dMass * (pres(K) + 0.5*dPres)) * dSV_dT_1d(k) + dS_to_dPE(k) = (dMass * (pres(K) + 0.5*dPres)) * dSV_dS_1d(k) + dT_to_dColHt(k) = dMass * US%m_to_Z * dSV_dT_1d(k) + dS_to_dColHt(k) = dMass * US%m_to_Z * dSV_dS_1d(k) pres(K+1) = pres(K) + dPres pres_Z(K+1) = US%Z_to_m * pres(K+1) enddo - ! Determine the total thickness (h_sum) and the fractional distance from the bottom (hb_hs). h_sum = H_neglect ; do k=1,nz ; h_sum = h_sum + h(k) ; enddo I_hs = 0.0 ; if (h_sum > 0.0) I_hs = 1.0 / h_sum @@ -640,14 +654,8 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS !min_MLD will initialize as 0. min_MLD = 0.0 - !/BGR: Add MLD_guess based on stored previous value. - if (CS%MLD_iteration_guess .and. (CS%ML_Depth2(i,j) > 1.0*US%m_to_Z)) then - !If prev value is present use for guess. - MLD_guess = CS%ML_Depth2(i,j) - else - !Otherwise guess middle of water column - MLD_guess = 0.5 * (min_MLD + max_MLD) - endif + ! If no first guess is provided for MLD, try the middle of the water column + if (MLD_guess <= min_MLD) MLD_guess = 0.5 * (min_MLD + max_MLD) ! Iterate up to MAX_OBL_IT times to determine a converged EPBL depth. OBL_CONVERGED = .false. @@ -659,6 +667,9 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS ! If not using MLD_Iteration flag loop to only execute once. if (.not.CS%Use_MLD_Iteration) OBL_CONVERGED = .true. + if (debug) then ; mech_TKE_k(:) = 0.0 ; conv_PErel_k(:) = 0.0 ; endif + + ! Reset ML_depth MLD_output = h(1)*GV%H_to_Z sfc_connected = .true. @@ -687,21 +698,21 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS dTKE_MKE = 0.0 ; dTKE_mech_decay = 0.0 ; dTKE_conv_decay = 0.0 dTKE_wind = mech_TKE * IdtdR0 - if (TKE_forced(i,j,1) <= 0.0) then - dTKE_forcing = max(-mech_TKE, TKE_forced(i,j,1)) * IdtdR0 - ! dTKE_unbalanced = min(0.0, TKE_forced(i,j,1) + mech_TKE) * IdtdR0 + if (TKE_forcing(1) <= 0.0) then + dTKE_forcing = max(-mech_TKE, TKE_forcing(1)) * IdtdR0 + ! dTKE_unbalanced = min(0.0, TKE_forcing(1) + mech_TKE) * IdtdR0 else - dTKE_forcing = CS%nstar*TKE_forced(i,j,1) * IdtdR0 + dTKE_forcing = CS%nstar*TKE_forcing(1) * IdtdR0 ! dTKE_unbalanced = 0.0 endif endif - if (TKE_forced(i,j,1) <= 0.0) then - mech_TKE = mech_TKE + TKE_forced(i,j,1) + if (TKE_forcing(1) <= 0.0) then + mech_TKE = mech_TKE + TKE_forcing(1) if (mech_TKE < 0.0) mech_TKE = 0.0 conv_PErel = 0.0 else - conv_PErel = TKE_forced(i,j,1) + conv_PErel = TKE_forcing(1) endif @@ -770,10 +781,10 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS ! Accumulate any convectively released potential energy to contribute ! to wstar and to drive penetrating convection. - if (TKE_forced(i,j,k) > 0.0) then - conv_PErel = conv_PErel + TKE_forced(i,j,k) + if (TKE_forcing(k) > 0.0) then + conv_PErel = conv_PErel + TKE_forcing(k) if (CS%TKE_diagnostics) & - dTKE_forcing = dTKE_forcing + CS%nstar*TKE_forced(i,j,k) * IdtdR0 + dTKE_forcing = dTKE_forcing + CS%nstar*TKE_forcing(k) * IdtdR0 endif if (debug) then @@ -796,27 +807,27 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS ! For each interior interface, first discard the TKE to account for ! mixing of shortwave radiation through the next denser cell. - if (TKE_forced(i,j,k) < 0.0) then - if (TKE_forced(i,j,k) + tot_TKE < 0.0) then + if (TKE_forcing(k) < 0.0) then + if (TKE_forcing(k) + tot_TKE < 0.0) then ! The shortwave requirements deplete all the energy in this layer. if (CS%TKE_diagnostics) then dTKE_mixing = dTKE_mixing + tot_TKE * IdtdR0 dTKE_forcing = dTKE_forcing - tot_TKE * IdtdR0 - ! dTKE_unbalanced = dTKE_unbalanced + (TKE_forced(i,j,k) + tot_TKE) * IdtdR0 + ! dTKE_unbalanced = dTKE_unbalanced + (TKE_forcing(k) + tot_TKE) * IdtdR0 dTKE_conv_decay = dTKE_conv_decay + & (CS%nstar-nstar_FC) * conv_PErel * IdtdR0 endif tot_TKE = 0.0 ; mech_TKE = 0.0 ; conv_PErel = 0.0 else ! Reduce the mechanical and convective TKE proportionately. - TKE_reduc = (tot_TKE + TKE_forced(i,j,k)) / tot_TKE + TKE_reduc = (tot_TKE + TKE_forcing(k)) / tot_TKE if (CS%TKE_diagnostics) then - dTKE_mixing = dTKE_mixing - TKE_forced(i,j,k) * IdtdR0 - dTKE_forcing = dTKE_forcing + TKE_forced(i,j,k) * IdtdR0 + dTKE_mixing = dTKE_mixing - TKE_forcing(k) * IdtdR0 + dTKE_forcing = dTKE_forcing + TKE_forcing(k) * IdtdR0 dTKE_conv_decay = dTKE_conv_decay + & (1.0-TKE_reduc)*(CS%nstar-nstar_FC) * conv_PErel * IdtdR0 endif - tot_TKE = TKE_reduc*tot_TKE ! = tot_TKE + TKE_forced(i,j,k) + tot_TKE = TKE_reduc*tot_TKE ! = tot_TKE + TKE_forcing(k) mech_TKE = TKE_reduc*mech_TKE conv_PErel = TKE_reduc*conv_PErel endif @@ -1031,7 +1042,6 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS endif if (sfc_connected) then MLD_output = MLD_output + GV%H_to_Z * h(k) - ! MLD_last = MLD_last + GV%H_to_Z * h(k) endif Kddt_h(K) = Kd(K)*dt_h @@ -1211,22 +1221,13 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS b1 = 1.0 / hp_a Te(nz) = b1 * (h(nz) * T0(nz) + Kddt_h(nz) * Te(nz-1)) Se(nz) = b1 * (h(nz) * S0(nz) + Kddt_h(nz) * Se(nz-1)) + dT_expect(nz) = Te(nz) - T0(nz) ; dS_expect(nz) = Se(nz) - S0(nz) do k=nz-1,1,-1 Te(k) = Te(k) + c1(K+1)*Te(k+1) Se(k) = Se(k) + c1(K+1)*Se(k+1) + dT_expect(k) = Te(k) - T0(k) ; dS_expect(k) = Se(k) - S0(k) enddo - endif - if (present(dT_expected)) then - do k=1,nz - dT_expected(i,j,k) = Te(k) - T0(k) - enddo - endif - if (present(dS_expected)) then - do k=1,nz - dS_expected(i,j,k) = Se(k) - S0(k) - enddo - endif - if (debug) then + dPE_debug = 0.0 do k=1,nz dPE_debug = dPE_debug + (dT_to_dPE(k) * (Te(k) - T0(k)) + & @@ -1254,7 +1255,6 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS min_MLD = MLD_guess elseif ((MLD_guess - MLD_found) < max(CS%MLD_tol, h(k-1)*GV%H_to_Z)) then OBL_CONVERGED = .true. ! Break convergence loop - MLD_last = MLD_guess else max_MLD = MLD_guess ! We know this guess was too deep endif @@ -1268,7 +1268,6 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS min_MLD = MLD_guess elseif (abs(MLD_guess - MLD_found) < CS%MLD_tol) then OBL_CONVERGED = .true. ! Break convergence loop - MLD_last = MLD_guess else max_MLD = MLD_guess ! We know this guess was too deep endif @@ -1282,9 +1281,15 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS do K=1,nz+1 Kd_2d(i,K) = Kd(K) enddo - CS%ML_Depth2(i,j) = MLD_last CS%ML_depth(i,j) = MLD_output + if (present(dT_expected)) then + do k=1,nz ; dT_expected(i,j,k) = dT_expect(k) ; enddo + endif + if (present(dS_expected)) then + do k=1,nz ; dS_expected(i,j,k) = dS_expect(k) ; enddo + endif + if (CS%TKE_diagnostics) then CS%diag_TKE_MKE(i,j) = CS%diag_TKE_MKE(i,j) + dTKE_MKE CS%diag_TKE_conv(i,j) = CS%diag_TKE_conv(i,j) + dTKE_conv @@ -1324,7 +1329,6 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS Kd_2d(i,K) = 0. enddo CS%ML_depth(i,j) = 0.0 - CS%ML_Depth2(i,j) = 0.0 if (CS%id_Hsfc_used > 0) Hsfc_used(i,j) = 0.0 if (present(dT_expected)) then @@ -1364,8 +1368,6 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS call post_data(CS%id_Mixing_Length, CS%Mixing_Length, CS%diag) if (CS%id_Velocity_Scale >0) & call post_data(CS%id_Velocity_Scale, CS%Velocity_Scale, CS%diag) - if (CS%id_OSBL >0) & - call post_data(CS%id_OSBL, CS%ML_Depth2, CS%diag) if (CS%id_LT_Enhancement >0) & call post_data(CS%id_LT_Enhancement, CS%Enhance_M, CS%diag) if (CS%id_MSTAR_MIX >0) & @@ -1733,8 +1735,7 @@ subroutine find_mstar(CS, US, Buoyancy_Flux, UStar, UStar_Mean,& if (Ustar > Abs_Coriolis * BLD) mstar_N = CS%C_EK * log(Ustar / (Abs_Coriolis * BLD)) endif - ! Here 1.25 is .5/von Karman, which gives the Obukhov limit. - !### Note the hard-code value here. + ! Here 1.25 is about .5/von Karman, which gives the Obukhov limit. MStar = max(MStar_S, min(1.25, MStar_N)) if (CS%MStar_Cap > 0.0) MStar = min( CS%MStar_Cap,MStar ) elseif ( CS%MStar_Mode == MStar_from_RH18 ) then @@ -2189,10 +2190,6 @@ subroutine energetic_PBL_init(Time, G, GV, US, param_file, diag, CS) Time, 'LT enhancement that is used.', 'nondim') CS%id_MSTAR_mix = register_diag_field('ocean_model', 'MSTAR', diag%axesT1, & Time, 'MSTAR that is used.', 'nondim') - CS%id_OSBL = register_diag_field('ocean_model', 'ePBL_OSBL', diag%axesT1, & - Time, 'ePBL Surface Boundary layer depth.', 'm', conversion=US%m_to_Z) - ! BGR (9/21/2017) Note that ePBL_OSBL is the guess for iteration step while ePBL_h_ML is - ! result from iteration step. CS%id_mld_ekman = register_diag_field('ocean_model', 'MLD_EKMAN', diag%axesT1, & Time, 'Boundary layer depth over Ekman length.', 'm') CS%id_mld_obukhov = register_diag_field('ocean_model', 'MLD_OBUKHOV', diag%axesT1, & @@ -2231,7 +2228,6 @@ subroutine energetic_PBL_init(Time, G, GV, US, param_file, diag, CS) CS%mixing_diagnostics = .true. endif call safe_alloc_alloc(CS%ML_depth, isd, ied, jsd, jed) - call safe_alloc_alloc(CS%ML_depth2, isd, ied, jsd, jed) if (max(CS%id_LT_Enhancement, CS%id_mstar_mix,CS%id_mld_ekman, & CS%id_ekman_obukhov, CS%id_mld_obukhov, CS%id_LA, CS%id_LA_mod, CS%id_MSTAR_LT ) >0) then call safe_alloc_alloc(CS%Mstar_mix, isd, ied, jsd, jed) @@ -2254,7 +2250,6 @@ subroutine energetic_PBL_end(CS) if (.not.associated(CS)) return if (allocated(CS%ML_depth)) deallocate(CS%ML_depth) - if (allocated(CS%ML_depth2)) deallocate(CS%ML_depth2) if (allocated(CS%Enhance_M)) deallocate(CS%Enhance_M) if (allocated(CS%MLD_EKMAN)) deallocate(CS%MLD_EKMAN) if (allocated(CS%MLD_OBUKHOV)) deallocate(CS%MLD_OBUKHOV) From bcb6b8855d9b54e36867651b7ca6b1c26a2c4a8f Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Wed, 12 Jun 2019 17:43:38 -0400 Subject: [PATCH 16/82] +Removed 5 diagnostics from ePBL Eliminated the infrequently used ePBL diagnostics ePBL_Hs_used, LT_Enhancement, MLD_EKMAN, MLD_OBUKHOV, and EKMAN_OBUKHOV, while MSTAR_LT includes all increases to mstar due ot Langmuir Turbulence, whether this is actually implemented via addition or rescaling. All answers are bitwise identical, but there are changes to the available_diags files. --- .../vertical/MOM_energetic_PBL.F90 | 166 +++++------------- 1 file changed, 44 insertions(+), 122 deletions(-) diff --git a/src/parameterizations/vertical/MOM_energetic_PBL.F90 b/src/parameterizations/vertical/MOM_energetic_PBL.F90 index 04b5eac954..dde55e0870 100644 --- a/src/parameterizations/vertical/MOM_energetic_PBL.F90 +++ b/src/parameterizations/vertical/MOM_energetic_PBL.F90 @@ -156,9 +156,6 @@ module MOM_energetic_PBL !! potential energy change code. Otherwise, it uses a newer version !! that can work with successive increments to the diffusivity in !! upward or downward passes. - logical :: Mixing_Diagnostics = .false. !< Will be true when outputting mixing - !! length and velocity scales - logical :: MSTAR_Diagnostics=.false. !< If true, utput diagnostics of the mstar calculation. type(diag_ctrl), pointer :: diag=>NULL() !< A structure that is used to regulate the !! timing of diagnostic output. @@ -174,13 +171,9 @@ module MOM_energetic_PBL diag_TKE_mech_decay, & !< The decay of mechanical TKE [J m-2]. diag_TKE_conv_decay, & !< The decay of convective TKE [J m-2]. diag_TKE_mixing, & !< The work done by TKE to deepen the mixed layer [J m-2]. - ! Additional output parameters also 2d - Enhance_M, & !< The enhancement to the turbulent velocity scale [nondim] + ! These additional diagnostics are also 2d. MSTAR_MIX, & !< Mstar used in EPBL [nondim] - MSTAR_LT, & !< Mstar for Langmuir turbulence [nondim] - MLD_EKMAN, & !< MLD over Ekman length [nondim] - MLD_OBUKHOV, & !< MLD over Obukhov length [nondim] - EKMAN_OBUKHOV, & !< Ekman over Obukhov length [nondim] + MSTAR_LT, & !< Mstar due to Langmuir turbulence [nondim] LA, & !< Langmuir number [nondim] LA_MOD !< Modified Langmuir number [nondim] @@ -191,11 +184,8 @@ module MOM_energetic_PBL integer :: id_ML_depth = -1, id_TKE_wind = -1, id_TKE_mixing = -1 integer :: id_TKE_MKE = -1, id_TKE_conv = -1, id_TKE_forcing = -1 integer :: id_TKE_mech_decay = -1, id_TKE_conv_decay = -1 - integer :: id_Hsfc_used = -1 integer :: id_Mixing_Length = -1, id_Velocity_Scale = -1 - integer :: id_LT_Enhancement = -1, id_MSTAR_mix = -1 - integer :: id_mld_ekman = -1, id_mld_obukhov = -1, id_ekman_obukhov = -1 - integer :: id_LA_mod = -1, id_LA = -1, id_MSTAR_LT = -1 + integer :: id_MSTAR_mix = -1, id_LA_mod = -1, id_LA = -1, id_MSTAR_LT = -1 !!@} end type energetic_PBL_CS @@ -401,8 +391,7 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS real :: B_Flux ! The surface buoyancy flux [Z2 s-3 ~> m2 s-3] real :: vstar ! An in-situ turbulent velocity [m s-1]. real :: mstar_total ! The value of mstar used in ePBL [nondim] - real :: enhance_mstar ! An ehhancement to mstar (output for diagnostic) - real :: mstar_LT ! An addition to mstar [nondim] (output for diagnostic) + real :: mstar_LT ! An addition to mstar due to Langmuir turbulence [nondim] (output for diagnostic) real :: MLD_output ! The mixed layer depth output from this routine [Z ~> m]. real :: LA ! The value of the Langmuir number [nondim] real :: LAmod ! The modified Langmuir number by convection [nondim] @@ -458,8 +447,6 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS ! The following are only used for diagnostics. real :: dt__diag ! A copy of dt_diag (if present) or dt [s]. real :: IdtdR0 ! = 1.0 / (dt__diag * Rho0) [m3 kg-1 s-1]. - real, dimension(SZI_(G),SZJ_(G)) :: & - Hsfc_used ! The thickness of the surface region [Z ~> m]. logical :: write_diags ! If true, write out diagnostics with this step. logical :: reset_diags ! If true, zero out the accumulated diagnostics. ! Local column copies of energy change diagnostics, all [J m-2]. @@ -507,9 +494,6 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS Mixing_Length_Used ! Vstar and Mixing_Length real :: Surface_Scale ! Surface decay scale for vstar - ! For output of MLD relations, if not using we should eliminate - real :: iL_Ekman ! Inverse of Ekman length scale [Z-1 ~> m-1]. - real :: iL_Obukhov ! Inverse of Obukhov length scale [Z-1 ~> m-1]. logical :: debug=.false. ! Change this hard-coded value for debugging. @@ -561,12 +545,9 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS enddo ; enddo endif !!OMP parallel do default(none) shared(CS) - if (CS%Mixing_Diagnostics) then - CS%Mixing_Length(:,:,:) = 0.0 - CS%Velocity_Scale(:,:,:) = 0.0 - endif endif - + ! if (CS%id_Mixing_Length>0) CS%Mixing_Length(:,:,:) = 0.0 + ! if (CS%id_Velocity_Scale>0) CS%Velocity_Scale(:,:,:) = 0.0 !!OMP parallel do default(private) shared(js,je,nz,is,ie,h_3d,u_3d,v_3d,tv,dt, & !!OMP CS,G,GV,US,fluxes,IdtdR0,debug,H_neglect, & @@ -680,8 +661,8 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS call get_Langmuir_Number(LA, G, GV, US, abs(MLD_guess), u_star_mean, i, j, & H=h, U_H=u, V_H=v, Waves=Waves) call find_mstar(CS, US, b_flux, U_Star, U_Star_Mean, MLD_Guess, absf, & - MStar_total, Langmuir_Number = La, Convect_Langmuir_Number = LAmod,& - Enhance_MStar = Enhance_MStar, mstar_LT = mstar_LT) + MStar_total, Langmuir_Number=La, Convect_Langmuir_Number=LAmod,& + mstar_LT=mstar_LT) else call find_mstar(CS, US, b_flux, u_star, u_star_mean, MLD_guess, absf, mstar_total) endif @@ -1300,29 +1281,17 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS CS%diag_TKE_conv_decay(i,j) = CS%diag_TKE_conv_decay(i,j) + dTKE_conv_decay ! CS%diag_TKE_unbalanced_forcing(i,j) = CS%diag_TKE_unbalanced_forcing(i,j) + dTKE_unbalanced endif - if (CS%Mixing_Diagnostics) then - ! Write to 3-D for outputing Mixing length and velocity scale. - do k=1,nz - CS%Mixing_Length(i,j,k) = Mixing_Length_Used(k) - CS%Velocity_Scale(i,j,k) = Vstar_Used(k) - enddo - endif - if (allocated(CS%Enhance_M)) CS%Enhance_M(i,j) = Enhance_mstar + ! Write to 3-D for outputing Mixing length and velocity scale. + if (CS%id_Mixing_Length>0) then ; do k=1,nz + CS%Mixing_Length(i,j,k) = Mixing_Length_Used(k) + enddo ; endif + if (CS%id_Velocity_Scale>0) then ; do k=1,nz + CS%Velocity_Scale(i,j,k) = Vstar_Used(k) + enddo ; endif if (allocated(CS%mstar_mix)) CS%mstar_mix(i,j) = mstar_total if (allocated(CS%mstar_lt)) CS%mstar_lt(i,j) = MSTAR_LT - iL_Ekman = absf / u_star - iL_Obukhov = b_flux*CS%vonkar / (u_star**3) - if (allocated(CS%MLD_Obukhov)) CS%MLD_Obukhov(i,j) = MLD_guess * iL_Obukhov - if (allocated(CS%MLD_Ekman)) CS%MLD_Ekman(i,j) = MLD_guess * iL_Ekman - if (allocated(CS%Ekman_Obukhov)) CS%Ekman_Obukhov(i,j) = iL_Obukhov / (iL_Ekman + 1.e-10*US%Z_to_m) if (allocated(CS%La)) CS%La(i,j) = LA if (allocated(CS%La_mod)) CS%La_mod(i,j) = LAmod - if (CS%id_Hsfc_used > 0) then - Hsfc_used(i,j) = h(1)*GV%H_to_Z - do k=2,nz - if (Kd(K) > 0.0) Hsfc_used(i,j) = Hsfc_used(i,j) + h(k)*GV%H_to_Z - enddo - endif else ! End of the ocean-point part of the i-loop ! For masked points, Kd_int must still be set (to 0) because it has intent out. do K=1,nz+1 @@ -1330,7 +1299,6 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS enddo CS%ML_depth(i,j) = 0.0 - if (CS%id_Hsfc_used > 0) Hsfc_used(i,j) = 0.0 if (present(dT_expected)) then do k=1,nz ; dT_expected(i,j,k) = 0.0 ; enddo endif @@ -1346,44 +1314,22 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS enddo ! j-loop if (write_diags) then - if (CS%id_ML_depth > 0) & - call post_data(CS%id_ML_depth, CS%ML_depth, CS%diag) - if (CS%id_TKE_wind > 0) & - call post_data(CS%id_TKE_wind, CS%diag_TKE_wind, CS%diag) - if (CS%id_TKE_MKE > 0) & - call post_data(CS%id_TKE_MKE, CS%diag_TKE_MKE, CS%diag) - if (CS%id_TKE_conv > 0) & - call post_data(CS%id_TKE_conv, CS%diag_TKE_conv, CS%diag) - if (CS%id_TKE_forcing > 0) & - call post_data(CS%id_TKE_forcing, CS%diag_TKE_forcing, CS%diag) - if (CS%id_TKE_mixing > 0) & - call post_data(CS%id_TKE_mixing, CS%diag_TKE_mixing, CS%diag) + if (CS%id_ML_depth > 0) call post_data(CS%id_ML_depth, CS%ML_depth, CS%diag) + if (CS%id_TKE_wind > 0) call post_data(CS%id_TKE_wind, CS%diag_TKE_wind, CS%diag) + if (CS%id_TKE_MKE > 0) call post_data(CS%id_TKE_MKE, CS%diag_TKE_MKE, CS%diag) + if (CS%id_TKE_conv > 0) call post_data(CS%id_TKE_conv, CS%diag_TKE_conv, CS%diag) + if (CS%id_TKE_forcing > 0) call post_data(CS%id_TKE_forcing, CS%diag_TKE_forcing, CS%diag) + if (CS%id_TKE_mixing > 0) call post_data(CS%id_TKE_mixing, CS%diag_TKE_mixing, CS%diag) if (CS%id_TKE_mech_decay > 0) & call post_data(CS%id_TKE_mech_decay, CS%diag_TKE_mech_decay, CS%diag) if (CS%id_TKE_conv_decay > 0) & call post_data(CS%id_TKE_conv_decay, CS%diag_TKE_conv_decay, CS%diag) - if (CS%id_Hsfc_used > 0) & - call post_data(CS%id_Hsfc_used, Hsfc_used, CS%diag) - if (CS%id_Mixing_Length > 0) & - call post_data(CS%id_Mixing_Length, CS%Mixing_Length, CS%diag) - if (CS%id_Velocity_Scale >0) & - call post_data(CS%id_Velocity_Scale, CS%Velocity_Scale, CS%diag) - if (CS%id_LT_Enhancement >0) & - call post_data(CS%id_LT_Enhancement, CS%Enhance_M, CS%diag) - if (CS%id_MSTAR_MIX >0) & - call post_data(CS%id_MSTAR_MIX, CS%MSTAR_MIX, CS%diag) - if (CS%id_MLD_OBUKHOV >0) & - call post_data(CS%id_MLD_Obukhov, CS%MLD_OBUKHOV, CS%diag) - if (CS%id_MLD_EKMAN >0) & - call post_data(CS%id_MLD_Ekman, CS%MLD_EKMAN, CS%diag) - if (CS%id_Ekman_Obukhov >0) & - call post_data(CS%id_Ekman_Obukhov, CS%Ekman_Obukhov, CS%diag) - if (CS%id_LA >0) & - call post_data(CS%id_LA, CS%LA, CS%diag) - if (CS%id_LA_MOD >0) & - call post_data(CS%id_LA_MOD, CS%LA_MOD, CS%diag) - if (CS%id_MSTAR_LT > 0) & - call post_data(CS%id_MSTAR_LT, CS%MSTAR_LT, CS%diag) + if (CS%id_Mixing_Length > 0) call post_data(CS%id_Mixing_Length, CS%Mixing_Length, CS%diag) + if (CS%id_Velocity_Scale >0) call post_data(CS%id_Velocity_Scale, CS%Velocity_Scale, CS%diag) + if (CS%id_MSTAR_MIX > 0) call post_data(CS%id_MSTAR_MIX, CS%MSTAR_MIX, CS%diag) + if (CS%id_LA > 0) call post_data(CS%id_LA, CS%LA, CS%diag) + if (CS%id_LA_MOD > 0) call post_data(CS%id_LA_MOD, CS%LA_MOD, CS%diag) + if (CS%id_MSTAR_LT > 0) call post_data(CS%id_MSTAR_LT, CS%MSTAR_LT, CS%diag) endif end subroutine energetic_PBL @@ -1693,7 +1639,7 @@ end subroutine find_PE_chg_orig !> This subroutine finds the Mstar value for ePBL subroutine find_mstar(CS, US, Buoyancy_Flux, UStar, UStar_Mean,& BLD, Abs_Coriolis, MStar, Langmuir_Number,& - MStar_LT, Enhance_MStar, Convect_Langmuir_Number) + MStar_LT, Convect_Langmuir_Number) type(energetic_PBL_CS), pointer :: CS !< Energetic_PBL control structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, intent(in) :: UStar !< ustar w/ gustiness [Z s-1 ~> m s-1] @@ -1703,9 +1649,7 @@ subroutine find_mstar(CS, US, Buoyancy_Flux, UStar, UStar_Mean,& real, intent(in) :: BLD !< boundary layer depth [Z ~> m] real, intent(out) :: Mstar !< Ouput mstar (Mixing/ustar**3) [nondim] real, optional, intent(in) :: Langmuir_Number !< Langmuir number [nondim] - real, optional, intent(out) :: MStar_LT !< Additive mstar increase due to Langmuir turbulence [nondim] - real, optional, intent(out) :: Enhance_MStar !< Multiplicative mstar increase due to - !! Langmuir turbulence [nondim] + real, optional, intent(out) :: MStar_LT !< Mstar increase due to Langmuir turbulence [nondim] real, optional, intent(out) :: Convect_Langmuir_number !< Langmuir number including buoyancy flux [nondim] !/ Variables used in computing mstar @@ -1768,14 +1712,14 @@ subroutine find_mstar(CS, US, Buoyancy_Flux, UStar, UStar_Mean,& if (present(Langmuir_Number)) then !### In this call, ustar was previously ustar_mean. Is this change deliberate? call mstar_Langmuir(CS, US, abs_Coriolis, buoyancy_flux, ustar, BLD, Langmuir_number, mstar, & - Enhance_MStar, mstar_lt, Convect_Langmuir_Number) + mstar_LT, Convect_Langmuir_Number) endif end subroutine Find_Mstar !> This subroutine modifies the Mstar value if the Langmuir number is present subroutine Mstar_Langmuir(CS, US, abs_Coriolis, buoyancy_flux, ustar, BLD, Langmuir_Number, & - mstar, enhance_mstar, mstar_lt, Convect_Langmuir_Number) + mstar, mstar_LT, Convect_Langmuir_Number) type(energetic_PBL_CS), pointer :: CS !< Energetic_PBL control structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, intent(in) :: Abs_Coriolis !< abolute value of the Coriolis parameter [s-1] @@ -1784,13 +1728,13 @@ subroutine Mstar_Langmuir(CS, US, abs_Coriolis, buoyancy_flux, ustar, BLD, Langm real, intent(in) :: BLD !< boundary layer depth [Z ~> m] real, intent(inout) :: Mstar !< Input/output mstar (Mixing/ustar**3) [nondim] real, intent(in) :: Langmuir_Number !Langmuir number [nondim] - real, intent(out) :: MStar_LT !< Additive mstar increase due to Langmuir turbulence [nondim] - real, intent(out) :: Enhance_MStar !< Multiplicative mstar increase due to - !! Langmuir turbulence [nondim] + real, intent(out) :: MStar_LT !< Mstar increase due to Langmuir turbulence [nondim] real, intent(out) :: Convect_Langmuir_number !< Langmuir number including buoyancy flux [nondim] !/ real, parameter :: Max_ratio = 1.0e16 ! The maximum value of a nondimensional ratio. + real :: enhance_mstar ! A multiplicative scaling of mstar due to Langmuir turbulence. + real :: mstar_LT_add ! A value that is added to mstar due to Langmuir turbulence. real :: iL_Ekman ! Inverse of Ekman length scale [Z-1 ~> m-1]. real :: iL_Obukhov ! Inverse of Obukhov length scale [Z-1 ~> m-1]. real :: I_ustar ! The Adcroft reciprocal of ustar [s Z-1 ~> s m-1] @@ -1804,7 +1748,7 @@ subroutine Mstar_Langmuir(CS, US, abs_Coriolis, buoyancy_flux, ustar, BLD, Langm real :: Ekman_Obukhov_un ! > ! Set default values for no Langmuir effects. - enhance_mstar = 1.0 ; mstar_LT = 0.0 + enhance_mstar = 1.0 ; mstar_LT_add = 0.0 if (CS%LT_Enhance_Form > 0) then ! a. Get parameters for modified LA @@ -1850,11 +1794,12 @@ subroutine Mstar_Langmuir(CS, US, abs_Coriolis, buoyancy_flux, ustar, BLD, Langm (1. + CS%LT_ENHANCE_COEF * Convect_Langmuir_Number**CS%LT_ENHANCE_EXP) ) elseif (CS%LT_ENHANCE_Form == 3) then ! or Enhancement is additive (multiplied enhance_m set to 1) - mstar_LT = CS%LT_ENHANCE_COEF * Convect_Langmuir_Number**CS%LT_ENHANCE_EXP + mstar_LT_add = CS%LT_ENHANCE_COEF * Convect_Langmuir_Number**CS%LT_ENHANCE_EXP endif endif - mstar = mstar*enhance_mstar + mstar_LT + mstar_LT = (enhance_mstar - 1.0)*mstar + mstar_LT_add ! Diagnose the full increase in mstar. + mstar = mstar*enhance_mstar + mstar_LT_add end subroutine Mstar_Langmuir @@ -2180,28 +2125,18 @@ subroutine energetic_PBL_init(Time, G, GV, US, param_file, diag, CS) Time, 'Mechanical energy decay sink of mixed layer TKE', 'm3 s-3') CS%id_TKE_conv_decay = register_diag_field('ocean_model', 'ePBL_TKE_conv_decay', diag%axesT1, & Time, 'Convective energy decay sink of mixed layer TKE', 'm3 s-3') - CS%id_Hsfc_used = register_diag_field('ocean_model', 'ePBL_Hs_used', diag%axesT1, & - Time, 'Surface region thickness that is used', 'm', conversion=US%m_to_Z) CS%id_Mixing_Length = register_diag_field('ocean_model', 'Mixing_Length', diag%axesTi, & Time, 'Mixing Length that is used', 'm', conversion=US%Z_to_m) CS%id_Velocity_Scale = register_diag_field('ocean_model', 'Velocity_Scale', diag%axesTi, & Time, 'Velocity Scale that is used.', 'm s-1', conversion=US%Z_to_m) - CS%id_LT_enhancement = register_diag_field('ocean_model', 'LT_Enhancement', diag%axesT1, & - Time, 'LT enhancement that is used.', 'nondim') CS%id_MSTAR_mix = register_diag_field('ocean_model', 'MSTAR', diag%axesT1, & - Time, 'MSTAR that is used.', 'nondim') - CS%id_mld_ekman = register_diag_field('ocean_model', 'MLD_EKMAN', diag%axesT1, & - Time, 'Boundary layer depth over Ekman length.', 'm') - CS%id_mld_obukhov = register_diag_field('ocean_model', 'MLD_OBUKHOV', diag%axesT1, & - Time, 'Boundary layer depth over Obukhov length.', 'm') - CS%id_ekman_obukhov = register_diag_field('ocean_model', 'EKMAN_OBUKHOV', diag%axesT1, & - Time, 'Ekman length over Obukhov length.', 'm') + Time, 'Total mstar that is used.', 'nondim') CS%id_LA = register_diag_field('ocean_model', 'LA', diag%axesT1, & Time, 'Langmuir number.', 'nondim') CS%id_LA_mod = register_diag_field('ocean_model', 'LA_MOD', diag%axesT1, & Time, 'Modified Langmuir number.', 'nondim') CS%id_MSTAR_LT = register_diag_field('ocean_model', 'MSTAR_LT', diag%axesT1, & - Time, 'MSTAR applied for LT effect.', 'nondim') + Time, 'Increase in mstar due to Langmuir Turbulence.', 'nondim') call get_param(param_file, mdl, "ENABLE_THERMODYNAMICS", use_temperature, & "If true, temperature and salinity are used as state "//& @@ -2220,21 +2155,12 @@ subroutine energetic_PBL_init(Time, G, GV, US, param_file, diag, CS) CS%TKE_diagnostics = .true. endif - if ((CS%id_Mixing_Length>0) .or. (CS%id_Velocity_Scale>0)) then - call safe_alloc_alloc(CS%Velocity_Scale,isd,ied,jsd,jed,GV%ke+1) - call safe_alloc_alloc(CS%Mixing_Length,isd,ied,jsd,jed,GV%ke+1) - CS%Velocity_Scale(:,:,:) = 0.0 - CS%Mixing_Length(:,:,:) = 0.0 - CS%mixing_diagnostics = .true. - endif + if (CS%id_Velocity_Scale>0) call safe_alloc_alloc(CS%Velocity_Scale, isd, ied, jsd, jed, GV%ke+1) + if (CS%id_Mixing_Length>0) call safe_alloc_alloc(CS%Mixing_Length, isd, ied, jsd, jed, GV%ke+1) + call safe_alloc_alloc(CS%ML_depth, isd, ied, jsd, jed) - if (max(CS%id_LT_Enhancement, CS%id_mstar_mix,CS%id_mld_ekman, & - CS%id_ekman_obukhov, CS%id_mld_obukhov, CS%id_LA, CS%id_LA_mod, CS%id_MSTAR_LT ) >0) then + if (max(CS%id_mstar_mix, CS%id_LA, CS%id_LA_mod, CS%id_MSTAR_LT ) >0) then call safe_alloc_alloc(CS%Mstar_mix, isd, ied, jsd, jed) - call safe_alloc_alloc(CS%Enhance_M, isd, ied, jsd, jed) - call safe_alloc_alloc(CS%MLD_EKMAN, isd, ied, jsd, jed) - call safe_alloc_alloc(CS%MLD_OBUKHOV, isd, ied, jsd, jed) - call safe_alloc_alloc(CS%EKMAN_OBUKHOV, isd, ied, jsd, jed) call safe_alloc_alloc(CS%LA, isd, ied, jsd, jed) call safe_alloc_alloc(CS%LA_MOD, isd, ied, jsd, jed) call safe_alloc_alloc(CS%MSTAR_LT, isd, ied, jsd, jed) @@ -2250,10 +2176,6 @@ subroutine energetic_PBL_end(CS) if (.not.associated(CS)) return if (allocated(CS%ML_depth)) deallocate(CS%ML_depth) - if (allocated(CS%Enhance_M)) deallocate(CS%Enhance_M) - if (allocated(CS%MLD_EKMAN)) deallocate(CS%MLD_EKMAN) - if (allocated(CS%MLD_OBUKHOV)) deallocate(CS%MLD_OBUKHOV) - if (allocated(CS%EKMAN_OBUKHOV)) deallocate(CS%EKMAN_OBUKHOV) if (allocated(CS%LA)) deallocate(CS%LA) if (allocated(CS%LA_MOD)) deallocate(CS%LA_MOD) if (allocated(CS%MSTAR_MIX)) deallocate(CS%MSTAR_MIX) From ea6d3553665a4c825c9cc3433064c7ec1744ad3c Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Thu, 13 Jun 2019 18:32:33 -0400 Subject: [PATCH 17/82] Added an internal type in MOM_energetic_PBL Added a type for convenience in passing around ePBL column diagnostics. All ansewrs are bitwise identical. --- .../vertical/MOM_energetic_PBL.F90 | 115 ++++++++++-------- 1 file changed, 64 insertions(+), 51 deletions(-) diff --git a/src/parameterizations/vertical/MOM_energetic_PBL.F90 b/src/parameterizations/vertical/MOM_energetic_PBL.F90 index dde55e0870..7d79fa86b5 100644 --- a/src/parameterizations/vertical/MOM_energetic_PBL.F90 +++ b/src/parameterizations/vertical/MOM_energetic_PBL.F90 @@ -196,6 +196,20 @@ module MOM_energetic_PBL integer, parameter :: MStar_from_RH18 = 3 !< The value of MSTAR_MODE to base mstar of of RH18 !!@} +!> A type for conveniently passing around ePBL diagnostics for a column. +type, public :: ePBL_column_diags ; private + !>@{ Local column copies of energy change diagnostics, all in [J m-2]. + real :: dTKE_conv, dTKE_forcing, dTKE_wind, dTKE_mixing + real :: dTKE_MKE, dTKE_mech_decay, dTKE_conv_decay + !!@} + real :: LA !< The value of the Langmuir number [nondim] + real :: LAmod !< The modified Langmuir number by convection [nondim] + real :: mstar !< The value of mstar used in ePBL [nondim] + real :: mstar_LT !< The portion of mstar due to Langmuir turbulence [nondim] + real, allocatable, dimension(:) :: dT_expect !< Expected temperature changes [degC] + real, allocatable, dimension(:) :: dS_expect !< Expected salinity changes [ppt] +end type ePBL_column_diags + contains !> This subroutine determines the diffusivities from the integrated energetics @@ -344,12 +358,8 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS ! mixing effects with other yet higher layers [ppt H ~> ppt m or ppt kg m-2]. Th_b, & ! An effective temperature times a thickness in the layer below, including implicit ! mixing effects with other yet lower layers [degC H ~> degC m or degC kg m-2]. - Sh_b, & ! An effective salinity times a thickness in the layer below, including implicit + Sh_b ! An effective salinity times a thickness in the layer below, including implicit ! mixing effects with other yet lower layers [ppt H ~> ppt m or ppt kg m-2]. - dT_expect, & ! The layer temperature change that should be expected when the returned - ! diffusivities are applied [degC]. - dS_expect ! The layer salinity change that should be expected when the returned - ! diffusivities are applied [ppt]. real, dimension(SZK_(GV)+1) :: & MixLen_shape, & ! A nondimensional shape factor for the mixing length that ! gives it an appropriate assymptotic value at the bottom of @@ -449,9 +459,6 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS real :: IdtdR0 ! = 1.0 / (dt__diag * Rho0) [m3 kg-1 s-1]. logical :: write_diags ! If true, write out diagnostics with this step. logical :: reset_diags ! If true, zero out the accumulated diagnostics. - ! Local column copies of energy change diagnostics, all [J m-2]. - real :: dTKE_conv, dTKE_forcing, dTKE_wind, dTKE_mixing - real :: dTKE_MKE, dTKE_mech_decay, dTKE_conv_decay !---------------------------------------------------------------------- !/BGR added Aug24,2016 for adding iteration to get boundary layer depth @@ -501,6 +508,7 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS real :: dPE_debug, mixing_debug, taux2, tauy2 real, dimension(20) :: TKE_left_itt, PE_chg_itt, Kddt_h_itt, dPEa_dKd_itt, MKE_src_itt real, dimension(SZK_(GV)) :: mech_TKE_k, conv_PErel_k, nstar_k + type(ePBL_column_diags) :: eCD ! A container for passing around diagnostics. integer, dimension(SZK_(GV)) :: num_itts integer :: i, j, k, is, ie, js, je, nz, itt, max_itt @@ -515,7 +523,9 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS "must now be used.") if (.NOT. associated(fluxes%ustar)) call MOM_error(FATAL, & "energetic_PBL: No surface TKE fluxes (ustar) defined in mixedlayer!") - if (present(dT_expected) .or. present(dS_expected)) debug = .true. + debug = .false. ; if (present(dT_expected) .or. present(dS_expected)) debug = .true. + + if (debug) allocate(eCD%dT_expect(nz), eCD%dS_expect(nz)) h_neglect = GV%H_subroundoff @@ -541,7 +551,7 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS CS%diag_TKE_wind(i,j) = 0.0 ; CS%diag_TKE_MKE(i,j) = 0.0 CS%diag_TKE_conv(i,j) = 0.0 ; CS%diag_TKE_forcing(i,j) = 0.0 CS%diag_TKE_mixing(i,j) = 0.0 ; CS%diag_TKE_mech_decay(i,j) = 0.0 - CS%diag_TKE_conv_decay(i,j) = 0.0 !; CS%diag_TKE_unbalanced_forcing(i,j) = 0.0 + CS%diag_TKE_conv_decay(i,j) = 0.0 !; CS%diag_TKE_unbalanced(i,j) = 0.0 enddo ; enddo endif !!OMP parallel do default(none) shared(CS) @@ -601,7 +611,7 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS if (CS%MLD_iteration_guess .and. (CS%ML_Depth(i,j) > 0.0)) MLD_guess = CS%ML_Depth(i,j) ! call ePBL_column(h, u, v, T0, S0, dSV_dT_1d, dSV_dS_1d, TKE_forcing, B_flux, absf, & -! u_star, u_star_mean, dt, MLD_guess, Kd, GV, US, CS, MLD_output, col_diags) +! u_star, u_star_mean, dt, MLD_guess, Kd, GV, US, CS, MLD_output, Waves, eCD) pres(1) = 0.0 pres_Z(1) = 0.0 @@ -675,16 +685,16 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS endif if (CS%TKE_diagnostics) then - dTKE_conv = 0.0 ; dTKE_mixing = 0.0 - dTKE_MKE = 0.0 ; dTKE_mech_decay = 0.0 ; dTKE_conv_decay = 0.0 + eCD%dTKE_conv = 0.0 ; eCD%dTKE_mixing = 0.0 + eCD%dTKE_MKE = 0.0 ; eCD%dTKE_mech_decay = 0.0 ; eCD%dTKE_conv_decay = 0.0 - dTKE_wind = mech_TKE * IdtdR0 + eCD%dTKE_wind = mech_TKE * IdtdR0 if (TKE_forcing(1) <= 0.0) then - dTKE_forcing = max(-mech_TKE, TKE_forcing(1)) * IdtdR0 - ! dTKE_unbalanced = min(0.0, TKE_forcing(1) + mech_TKE) * IdtdR0 + eCD%dTKE_forcing = max(-mech_TKE, TKE_forcing(1)) * IdtdR0 + ! eCD%dTKE_unbalanced = min(0.0, TKE_forcing(1) + mech_TKE) * IdtdR0 else - dTKE_forcing = CS%nstar*TKE_forcing(1) * IdtdR0 - ! dTKE_unbalanced = 0.0 + eCD%dTKE_forcing = CS%nstar*TKE_forcing(1) * IdtdR0 + ! eCD%dTKE_unbalanced = 0.0 endif endif @@ -757,7 +767,7 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS exp_kh = 1.0 if (Idecay_len_TKE > 0.0) exp_kh = exp(-h(k-1)*Idecay_len_TKE) if (CS%TKE_diagnostics) & - dTKE_mech_decay = dTKE_mech_decay + (exp_kh-1.0) * mech_TKE * IdtdR0 + eCD%dTKE_mech_decay = eCD%dTKE_mech_decay + (exp_kh-1.0) * mech_TKE * IdtdR0 mech_TKE = mech_TKE * exp_kh ! Accumulate any convectively released potential energy to contribute @@ -765,7 +775,7 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS if (TKE_forcing(k) > 0.0) then conv_PErel = conv_PErel + TKE_forcing(k) if (CS%TKE_diagnostics) & - dTKE_forcing = dTKE_forcing + CS%nstar*TKE_forcing(k) * IdtdR0 + eCD%dTKE_forcing = eCD%dTKE_forcing + CS%nstar*TKE_forcing(k) * IdtdR0 endif if (debug) then @@ -792,10 +802,10 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS if (TKE_forcing(k) + tot_TKE < 0.0) then ! The shortwave requirements deplete all the energy in this layer. if (CS%TKE_diagnostics) then - dTKE_mixing = dTKE_mixing + tot_TKE * IdtdR0 - dTKE_forcing = dTKE_forcing - tot_TKE * IdtdR0 - ! dTKE_unbalanced = dTKE_unbalanced + (TKE_forcing(k) + tot_TKE) * IdtdR0 - dTKE_conv_decay = dTKE_conv_decay + & + eCD%dTKE_mixing = eCD%dTKE_mixing + tot_TKE * IdtdR0 + eCD%dTKE_forcing = eCD%dTKE_forcing - tot_TKE * IdtdR0 + ! eCD%dTKE_unbalanced = eCD%dTKE_unbalanced + (TKE_forcing(k) + tot_TKE) * IdtdR0 + eCD%dTKE_conv_decay = eCD%dTKE_conv_decay + & (CS%nstar-nstar_FC) * conv_PErel * IdtdR0 endif tot_TKE = 0.0 ; mech_TKE = 0.0 ; conv_PErel = 0.0 @@ -803,9 +813,9 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS ! Reduce the mechanical and convective TKE proportionately. TKE_reduc = (tot_TKE + TKE_forcing(k)) / tot_TKE if (CS%TKE_diagnostics) then - dTKE_mixing = dTKE_mixing - TKE_forcing(k) * IdtdR0 - dTKE_forcing = dTKE_forcing + TKE_forcing(k) * IdtdR0 - dTKE_conv_decay = dTKE_conv_decay + & + eCD%dTKE_mixing = eCD%dTKE_mixing - TKE_forcing(k) * IdtdR0 + eCD%dTKE_forcing = eCD%dTKE_forcing + TKE_forcing(k) * IdtdR0 + eCD%dTKE_conv_decay = eCD%dTKE_conv_decay + & (1.0-TKE_reduc)*(CS%nstar-nstar_FC) * conv_PErel * IdtdR0 endif tot_TKE = TKE_reduc*tot_TKE ! = tot_TKE + TKE_forcing(k) @@ -1018,8 +1028,8 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS conv_PErel = conv_PErel - dPE_conv mech_TKE = mech_TKE + MKE_src if (CS%TKE_diagnostics) then - dTKE_conv = dTKE_conv - CS%nstar*dPE_conv * IdtdR0 - dTKE_MKE = dTKE_MKE + MKE_src * IdtdR0 + eCD%dTKE_conv = eCD%dTKE_conv - CS%nstar*dPE_conv * IdtdR0 + eCD%dTKE_MKE = eCD%dTKE_MKE + MKE_src * IdtdR0 endif if (sfc_connected) then MLD_output = MLD_output + GV%H_to_Z * h(k) @@ -1037,9 +1047,9 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS TKE_reduc = 0.0 ! tot_TKE could be 0 if Convectively_stable is false. if (tot_TKE > 0.0) TKE_reduc = (tot_TKE - PE_chg_g0) / tot_TKE if (CS%TKE_diagnostics) then - dTKE_mixing = dTKE_mixing - PE_chg_g0 * IdtdR0 - dTKE_MKE = dTKE_MKE + MKE_src * IdtdR0 - dTKE_conv_decay = dTKE_conv_decay + & + eCD%dTKE_mixing = eCD%dTKE_mixing - PE_chg_g0 * IdtdR0 + eCD%dTKE_MKE = eCD%dTKE_MKE + MKE_src * IdtdR0 + eCD%dTKE_conv_decay = eCD%dTKE_conv_decay + & (1.0-TKE_reduc)*(CS%nstar-nstar_FC) * conv_PErel * IdtdR0 endif tot_TKE = TKE_reduc*tot_TKE @@ -1141,9 +1151,9 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS ! All TKE should have been consumed. if (CS%TKE_diagnostics) then - dTKE_mixing = dTKE_mixing - (tot_TKE + MKE_src) * IdtdR0 - dTKE_MKE = dTKE_MKE + MKE_src * IdtdR0 - dTKE_conv_decay = dTKE_conv_decay + & + eCD%dTKE_mixing = eCD%dTKE_mixing - (tot_TKE + MKE_src) * IdtdR0 + eCD%dTKE_MKE = eCD%dTKE_MKE + MKE_src * IdtdR0 + eCD%dTKE_conv_decay = eCD%dTKE_conv_decay + & (CS%nstar-nstar_FC) * conv_PErel * IdtdR0 endif @@ -1202,11 +1212,11 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS b1 = 1.0 / hp_a Te(nz) = b1 * (h(nz) * T0(nz) + Kddt_h(nz) * Te(nz-1)) Se(nz) = b1 * (h(nz) * S0(nz) + Kddt_h(nz) * Se(nz-1)) - dT_expect(nz) = Te(nz) - T0(nz) ; dS_expect(nz) = Se(nz) - S0(nz) + eCD%dT_expect(nz) = Te(nz) - T0(nz) ; eCD%dS_expect(nz) = Se(nz) - S0(nz) do k=nz-1,1,-1 Te(k) = Te(k) + c1(K+1)*Te(k+1) Se(k) = Se(k) + c1(K+1)*Se(k+1) - dT_expect(k) = Te(k) - T0(k) ; dS_expect(k) = Se(k) - S0(k) + eCD%dT_expect(k) = Te(k) - T0(k) ; eCD%dS_expect(k) = Se(k) - S0(k) enddo dPE_debug = 0.0 @@ -1257,6 +1267,7 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS MLD_guess = 0.5*(min_MLD + max_MLD) endif enddo ! Iteration loop for converged boundary layer thickness. + eCD%LA = LA ; eCD%LAmod = LAmod ; eCD%mstar = mstar_total ; eCD%mstar_LT = mstar_LT ! Copy the diffusivities to a 2-d array. do K=1,nz+1 @@ -1265,21 +1276,21 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS CS%ML_depth(i,j) = MLD_output if (present(dT_expected)) then - do k=1,nz ; dT_expected(i,j,k) = dT_expect(k) ; enddo + do k=1,nz ; dT_expected(i,j,k) = eCD%dT_expect(k) ; enddo endif if (present(dS_expected)) then - do k=1,nz ; dS_expected(i,j,k) = dS_expect(k) ; enddo + do k=1,nz ; dS_expected(i,j,k) = eCD%dS_expect(k) ; enddo endif if (CS%TKE_diagnostics) then - CS%diag_TKE_MKE(i,j) = CS%diag_TKE_MKE(i,j) + dTKE_MKE - CS%diag_TKE_conv(i,j) = CS%diag_TKE_conv(i,j) + dTKE_conv - CS%diag_TKE_forcing(i,j) = CS%diag_TKE_forcing(i,j) + dTKE_forcing - CS%diag_TKE_wind(i,j) = CS%diag_TKE_wind(i,j) + dTKE_wind - CS%diag_TKE_mixing(i,j) = CS%diag_TKE_mixing(i,j) + dTKE_mixing - CS%diag_TKE_mech_decay(i,j) = CS%diag_TKE_mech_decay(i,j) + dTKE_mech_decay - CS%diag_TKE_conv_decay(i,j) = CS%diag_TKE_conv_decay(i,j) + dTKE_conv_decay - ! CS%diag_TKE_unbalanced_forcing(i,j) = CS%diag_TKE_unbalanced_forcing(i,j) + dTKE_unbalanced + CS%diag_TKE_MKE(i,j) = CS%diag_TKE_MKE(i,j) + eCD%dTKE_MKE + CS%diag_TKE_conv(i,j) = CS%diag_TKE_conv(i,j) + eCD%dTKE_conv + CS%diag_TKE_forcing(i,j) = CS%diag_TKE_forcing(i,j) + eCD%dTKE_forcing + CS%diag_TKE_wind(i,j) = CS%diag_TKE_wind(i,j) + eCD%dTKE_wind + CS%diag_TKE_mixing(i,j) = CS%diag_TKE_mixing(i,j) + eCD%dTKE_mixing + CS%diag_TKE_mech_decay(i,j) = CS%diag_TKE_mech_decay(i,j) + eCD%dTKE_mech_decay + CS%diag_TKE_conv_decay(i,j) = CS%diag_TKE_conv_decay(i,j) + eCD%dTKE_conv_decay + ! CS%diag_TKE_unbalanced(i,j) = CS%diag_TKE_unbalanced(i,j) + eCD%dTKE_unbalanced endif ! Write to 3-D for outputing Mixing length and velocity scale. if (CS%id_Mixing_Length>0) then ; do k=1,nz @@ -1288,10 +1299,10 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS if (CS%id_Velocity_Scale>0) then ; do k=1,nz CS%Velocity_Scale(i,j,k) = Vstar_Used(k) enddo ; endif - if (allocated(CS%mstar_mix)) CS%mstar_mix(i,j) = mstar_total - if (allocated(CS%mstar_lt)) CS%mstar_lt(i,j) = MSTAR_LT - if (allocated(CS%La)) CS%La(i,j) = LA - if (allocated(CS%La_mod)) CS%La_mod(i,j) = LAmod + if (allocated(CS%mstar_mix)) CS%mstar_mix(i,j) = eCD%mstar + if (allocated(CS%mstar_lt)) CS%mstar_lt(i,j) = eCD%mstar_LT + if (allocated(CS%La)) CS%La(i,j) = eCD%LA + if (allocated(CS%La_mod)) CS%La_mod(i,j) = eCD%LAmod else ! End of the ocean-point part of the i-loop ! For masked points, Kd_int must still be set (to 0) because it has intent out. do K=1,nz+1 @@ -1332,6 +1343,8 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS if (CS%id_MSTAR_LT > 0) call post_data(CS%id_MSTAR_LT, CS%MSTAR_LT, CS%diag) endif + if (debug) deallocate(eCD%dT_expect, eCD%dS_expect) + end subroutine energetic_PBL !> This subroutine calculates the change in potential energy and or derivatives From 798dec8a8a6ade48afc3ccbcbf9a305ecae45eb3 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Thu, 13 Jun 2019 18:52:52 -0400 Subject: [PATCH 18/82] +Added ePBL_column, but it is not yet called. Added the new subroutine ePBL_column in MOM_energetic_PBL.F90, but is it not being called yet. All answers are bitwise identical. --- .../vertical/MOM_energetic_PBL.F90 | 945 +++++++++++++++++- 1 file changed, 942 insertions(+), 3 deletions(-) diff --git a/src/parameterizations/vertical/MOM_energetic_PBL.F90 b/src/parameterizations/vertical/MOM_energetic_PBL.F90 index 7d79fa86b5..b41ef3ad31 100644 --- a/src/parameterizations/vertical/MOM_energetic_PBL.F90 +++ b/src/parameterizations/vertical/MOM_energetic_PBL.F90 @@ -255,8 +255,7 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS real, dimension(SZI_(G),SZJ_(G)), & intent(in) :: Buoy_Flux !< The surface buoyancy flux [Z2 s-3 ~> m2 s-3]. real, optional, intent(in) :: dt_diag !< The diagnostic time step, which may be less - !! than dt if there are two callse to - !! mixedlayer [s]. + !! than dt if there are two calls to mixedlayer [s]. logical, optional, intent(in) :: last_call !< If true, this is the last call to !! mixedlayer in the current time step, so !! diagnostics will be written. The default @@ -611,7 +610,8 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS if (CS%MLD_iteration_guess .and. (CS%ML_Depth(i,j) > 0.0)) MLD_guess = CS%ML_Depth(i,j) ! call ePBL_column(h, u, v, T0, S0, dSV_dT_1d, dSV_dS_1d, TKE_forcing, B_flux, absf, & -! u_star, u_star_mean, dt, MLD_guess, Kd, GV, US, CS, MLD_output, Waves, eCD) +! u_star, u_star_mean, dt, MLD_io, Kd, Vstar_Used, Mixing_Length_Used, GV, US, CS, eCD, & +! dt_diag=dt_diag, Waves=Waves, G=G, i=i, j=j) pres(1) = 0.0 pres_Z(1) = 0.0 @@ -1347,6 +1347,945 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS end subroutine energetic_PBL + + + + + + +!> This subroutine determines the diffusivities from the integrated energetics +!! mixed layer model for a single column of water. +subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, absf, & + u_star, u_star_mean, dt, MLD_io, Kd, mixvel, mixlen, GV, US, CS, eCD, & + dt_diag, Waves, G, i, j) + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + real, dimension(SZK_(GV)), intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]. + real, dimension(SZK_(GV)), intent(in) :: u !< Zonal velocities interpolated to h points + !! [m s-1]. + real, dimension(SZK_(GV)), intent(in) :: v !< Zonal velocities interpolated to h points + !! [m s-1]. + real, dimension(SZK_(GV)), intent(in) :: T0 !< The initial layer temperatures [degC]. + real, dimension(SZK_(GV)), intent(in) :: S0 !< The initial layer salinities [ppt]. + + real, dimension(SZK_(GV)), intent(in) :: dSV_dT !< The partial derivative of in-situ specific + !! volume with potential temperature + !! [m3 kg-1 degC-1]. + real, dimension(SZK_(GV)), intent(in) :: dSV_dS !< The partial derivative of in-situ specific + !! volume with salinity [m3 kg-1 ppt-1]. + real, dimension(SZK_(GV)), intent(in) :: TKE_forcing !< The forcing requirements to homogenize the + !! forcing that has been applied to each layer [J m-2]. + real, intent(in) :: B_flux !< The surface buoyancy flux [Z2 s-3 ~> m2 s-3] + real, intent(in) :: absf !< The absolute value of the Coriolis parameter [s-1]. + real, intent(in) :: u_star !< The surface friction velocity [Z s-1 ~> m s-1]. + real, intent(in) :: u_star_mean !< The surface friction velocity without any + !! contribution from unresolved gustiness [Z s-1 ~> m s-1]. + real, intent(inout) :: MLD_io !< A first guess at the mixed layer depth on input, and + !! the calculated mixed layer depth on output [Z ~> m]. + real, intent(in) :: dt !< Time increment [s]. + real, dimension(SZK_(GV)+1), & + intent(out) :: Kd !< The diagnosed diffusivities at interfaces + !! [Z2 s-1 ~> m2 s-1]. + real, dimension(SZK_(GV)+1), & + intent(out) :: mixvel !< The mixing velocity scale used in Kd + !! [Z s-1 ~> m s-1]. + real, dimension(SZK_(GV)+1), & + intent(out) :: mixlen !< The mixing length scale used in Kd [Z ~> m]. + type(energetic_PBL_CS), pointer :: CS !< The control structure returned by a previous + !! call to mixedlayer_init. + type(ePBL_column_diags), intent(inout) :: eCD !< A container for passing around diagnostics. + real, optional, intent(in) :: dt_diag !< The diagnostic time step, which may be less + !! than dt if there are two calls to mixedlayer [s]. + type(wave_parameters_CS), & + optional, pointer :: Waves !< Wave CS for Langmuir turbulence + type(ocean_grid_type), & + optional, intent(inout) :: G !< The ocean's grid structure. + integer, optional, intent(in) :: i !< The i-index to work on (used for Waves) + integer, optional, intent(in) :: j !< The i-index to work on (used for Waves) + +! This subroutine determines the diffusivities in a single column from the integrated energetics +! planetary boundary layer (ePBL) model. It assumes that heating, cooling and freshwater fluxes +! have already been applied. All calculations are done implicitly, and there +! is no stability limit on the time step. +! +! For each interior interface, first discard the TKE to account for mixing +! of shortwave radiation through the next denser cell. Next drive mixing based +! on the local? values of ustar + wstar, subject to available energy. This +! step sets the value of Kd(K). Any remaining energy is then subject to decay +! before being handed off to the next interface. mech_TKE and conv_PErel are treated +! separately for the purposes of decay, but are used proportionately to drive +! mixing. + + ! Local variables + real, dimension(SZK_(GV)+1) :: & + pres, & ! Interface pressures [Pa]. + pres_Z, & ! Interface pressures with a rescaling factor to convert interface height + ! movements into changes in column potential energy [J m-2 Z-1 ~> J m-3]. + hb_hs ! The distance from the bottom over the thickness of the + ! water column [nondim]. + real :: mech_TKE ! The mechanically generated turbulent kinetic energy + ! available for mixing over a time step [J m-2 = kg s-2]. + real :: conv_PErel ! The potential energy that has been convectively released + ! during this timestep [J m-2 = kg s-2]. A portion nstar_FC + ! of conv_PErel is available to drive mixing. + real :: htot ! The total depth of the layers above an interface [H ~> m or kg m-2]. + real :: uhtot ! The depth integrated zonal and meridional velocities in the + real :: vhtot ! layers above [H m s-1 ~> m2 s-1 or kg m-1 s-1]. + real :: Idecay_len_TKE ! The inverse of a turbulence decay length scale [H-1 ~> m-1 or m2 kg-1]. + real :: h_sum ! The total thickness of the water column [H ~> m or kg m-2]. +! real :: absf ! The absolute value of f [s-1]. + + real, dimension(SZK_(GV)) :: & + dT_to_dColHt, & ! Partial derivatives of the total column height with the temperature + dS_to_dColHt, & ! and salinity changes within a layer [Z degC-1 ~> m degC-1] and [Z ppt-1 ~> m ppt-1]. + dT_to_dPE, & ! Partial derivatives of column potential energy with the temperature + dS_to_dPE, & ! and salinity changes within a layer, in [J m-2 degC-1] and [J m-2 ppt-1]. + dT_to_dColHt_a, & ! Partial derivatives of the total column height with the temperature + dS_to_dColHt_a, & ! and salinity changes within a layer, including the implicit effects + ! of mixing with layers higher in the water colun [Z degC-1 ~> m degC-1] and [Z ppt-1 ~> m ppt-1]. + dT_to_dPE_a, & ! Partial derivatives of column potential energy with the temperature + dS_to_dPE_a ! and salinity changes within a layer, including the implicit effects + ! of mixing with layers higher in the water column, in + ! units of [J m-2 degC-1] and [J m-2 ppt-1]. + real, dimension(SZK_(GV)) :: & + Te, Se, & ! Estimated final values of T and S in the column, in [degC] and [ppt]. + c1, & ! c1 is used by the tridiagonal solver [nondim]. + dTe, dSe, & ! Running (1-way) estimates of temperature and salinity change. + Th_a, & ! An effective temperature times a thickness in the layer above, including implicit + ! mixing effects with other yet higher layers [degC H ~> degC m or degC kg m-2]. + Sh_a, & ! An effective salinity times a thickness in the layer above, including implicit + ! mixing effects with other yet higher layers [ppt H ~> ppt m or ppt kg m-2]. + Th_b, & ! An effective temperature times a thickness in the layer below, including implicit + ! mixing effects with other yet lower layers [degC H ~> degC m or degC kg m-2]. + Sh_b ! An effective salinity times a thickness in the layer below, including implicit + ! mixing effects with other yet lower layers [ppt H ~> ppt m or ppt kg m-2]. + real, dimension(SZK_(GV)+1) :: & + MixLen_shape, & ! A nondimensional shape factor for the mixing length that + ! gives it an appropriate assymptotic value at the bottom of + ! the boundary layer. + Kddt_h ! The diapycnal diffusivity times a timestep divided by the + ! average thicknesses around a layer [H ~> m or kg m-2]. + real :: b1 ! b1 is inverse of the pivot used by the tridiagonal solver [H-1 ~> m-1 or m2 kg-1]. + real :: hp_a ! An effective pivot thickness of the layer including the effects + ! of coupling with layers above [H ~> m or kg m-2]. This is the first term + ! in the denominator of b1 in a downward-oriented tridiagonal solver. + real :: h_neglect ! A thickness that is so small it is usually lost + ! in roundoff and can be neglected [H ~> m or kg m-2]. + real :: dMass ! The mass per unit area within a layer [kg m-2]. + real :: dPres ! The hydrostatic pressure change across a layer [Pa]. + real :: dMKE_max ! The maximum amount of mean kinetic energy that could be + ! converted to turbulent kinetic energy if the velocity in + ! the layer below an interface were homogenized with all of + ! the water above the interface [J m-2 = kg s-2]. + real :: MKE2_Hharm ! Twice the inverse of the harmonic mean of the thickness + ! of a layer and the thickness of the water above, used in + ! the MKE conversion equation [H-1 ~> m-1 or m2 kg-1]. + + real :: dt_h ! The timestep divided by the averages of the thicknesses around + ! a layer, times a thickness conversion factor [H s m-2 ~> s m-1 or kg s m-4]. + real :: h_bot ! The distance from the bottom [H ~> m or kg m-2]. + real :: h_rsum ! The running sum of h from the top [Z ~> m]. + real :: I_hs ! The inverse of h_sum [H-1 ~> m-1 or m2 kg-1]. + real :: I_MLD ! The inverse of the current value of MLD [Z-1 ~> m-1]. + real :: h_tt ! The distance from the surface or up to the next interface + ! that did not exhibit turbulent mixing from this scheme plus + ! a surface mixing roughness length given by h_tt_min [H ~> m or kg m-2]. + real :: h_tt_min ! A surface roughness length [H ~> m or kg m-2]. + + real :: C1_3 ! = 1/3. + real :: I_dtrho ! 1.0 / (dt * Rho0) in [m3 kg-1 s-1]. This is + ! used convert TKE back into ustar^3. +! real :: U_star ! The surface friction velocity [Z s-1 ~> m s-1]. +! real :: U_Star_Mean ! The surface friction without gustiness [Z s-1 ~> m s-1]. +! real :: B_Flux ! The surface buoyancy flux [Z2 s-3 ~> m2 s-3] + real :: vstar ! An in-situ turbulent velocity [m s-1]. + real :: mstar_total ! The value of mstar used in ePBL [nondim] + real :: mstar_LT ! An addition to mstar due to Langmuir turbulence [nondim] (output for diagnostic) + real :: MLD_output ! The mixed layer depth output from this routine [Z ~> m]. + real :: LA ! The value of the Langmuir number [nondim] + real :: LAmod ! The modified Langmuir number by convection [nondim] + real :: hbs_here ! The local minimum of hb_hs and MixLen_shape, times a + ! conversion factor from H to Z [Z H-1 ~> 1 or m3 kg-1]. + real :: nstar_FC ! The fraction of conv_PErel that can be converted to mixing [nondim]. + real :: TKE_reduc ! The fraction by which TKE and other energy fields are + ! reduced to support mixing [nondim]. between 0 and 1. + real :: tot_TKE ! The total TKE available to support mixing at interface K [J m-2]. + real :: TKE_here ! The total TKE at this point in the algorithm [J m-2]. + real :: dT_km1_t2 ! A diffusivity-independent term related to the temperature + ! change in the layer above the interface [degC]. + real :: dS_km1_t2 ! A diffusivity-independent term related to the salinity + ! change in the layer above the interface [ppt]. + real :: dTe_term ! A diffusivity-independent term related to the temperature + ! change in the layer below the interface [degC H ~> degC m or degC kg m-2]. + real :: dSe_term ! A diffusivity-independent term related to the salinity + ! change in the layer above the interface [ppt H ~> ppt m or ppt kg m-2]. + real :: dTe_t2 ! A part of dTe_term [degC H ~> degC m or degC kg m-2]. + real :: dSe_t2 ! A part of dSe_term [ppt H ~> ppt m or ppt kg m-2]. + real :: dPE_conv ! The convective change in column potential energy [J m-2]. + real :: MKE_src ! The mean kinetic energy source of TKE due to Kddt_h(K) [J m-2]. + real :: dMKE_src_dK ! The partial derivative of MKE_src with Kddt_h(K) [J m-2 H-1 ~> J m-3 or J kg-1]. + real :: Kd_guess0 ! A first guess of the diapycnal diffusivity [Z2 s-1 ~> m2 s-1]. + real :: PE_chg_g0 ! The potential energy change when Kd is Kd_guess0 [J m-2] + real :: dPEa_dKd_g0 + real :: Kddt_h_g0 ! The first guess diapycnal diffusivity times a timestep divided + ! by the average thicknesses around a layer [H ~> m or kg m-2]. + real :: PE_chg_max ! The maximum PE change for very large values of Kddt_h(K). + real :: dPEc_dKd_Kd0 ! The partial derivative of PE change with Kddt_h(K) + ! for very small values of Kddt_h(K) [J m-2 H-1 ~> J m-3 or J kg-1]. + real :: PE_chg ! The change in potential energy due to mixing at an + ! interface [J m-2], positive for the column increasing + ! in potential energy (i.e., consuming TKE). + real :: TKE_left ! The amount of turbulent kinetic energy left for the most + ! recent guess at Kddt_h(K) [J m-2]. + 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]. + real :: TKE_left_min, TKE_left_max ! Maximum and minimum values of TKE_left [J m-2]. + real :: Kddt_h_max, Kddt_h_min ! Maximum and minimum values of Kddt_h(K) [H ~> m or kg m-2]. + real :: Kddt_h_guess ! A guess at the value of Kddt_h(K) [H ~> m or kg m-2]. + real :: Kddt_h_next ! The next guess at the value of Kddt_h(K) [H ~> m or kg m-2]. + real :: dKddt_h ! The change between guesses at Kddt_h(K) [H ~> m or kg m-2]. + real :: dKddt_h_Newt ! The change between guesses at Kddt_h(K) with Newton's method [H ~> m or kg m-2]. + real :: Kddt_h_newt ! The Newton's method next guess for Kddt_h(K) [H ~> m or kg m-2]. + real :: exp_kh ! The nondimensional decay of TKE across a layer [nondim]. + logical :: use_Newt ! Use Newton's method for the next guess at Kddt_h(K). + logical :: convectively_stable ! If true the water column is convectively stable at this interface. + logical :: sfc_connected ! If true the ocean is actively turbulent from the present + ! interface all the way up to the surface. + logical :: sfc_disconnect ! If true, any turbulence has become disconnected + ! from the surface. + +! The following are only used for diagnostics. + real :: dt__diag ! A copy of dt_diag (if present) or dt [s]. + real :: IdtdR0 ! = 1.0 / (dt__diag * Rho0) [m3 kg-1 s-1]. + + !---------------------------------------------------------------------- + !/BGR added Aug24,2016 for adding iteration to get boundary layer depth + ! - needed to compute new mixing length. + real :: MLD_guess, MLD_found ! Mixing Layer depth guessed/found for iteration [Z ~> m]. + real :: min_MLD ! Iteration bounds [Z ~> m], which are adjusted at each step + real :: max_MLD ! - These are initialized based on surface/bottom + ! 1. The iteration guesses a value (possibly from prev step or neighbor). + ! 2. The iteration checks if value is converged, too shallow, or too deep. + ! 3. Based on result adjusts the Max/Min and searches through the water column. + ! - If using an accurate guess the iteration is very quick (e.g. if MLD doesn't + ! change over timestep). Otherwise it takes 5-10 passes, but has a high + ! convergence rate. Other iteration may be tried, but this method seems to + ! fail very rarely and the added cost is likely not significant. + ! Additionally, when it fails to converge it does so in a reasonable + ! manner giving a usable guess. When it does fail, it is due to convection + ! within the boundary layer. Likely, a new method e.g. surface_disconnect, + ! can improve this. + logical :: FIRST_OBL ! Flag for computing "found" Mixing layer depth + logical :: OBL_CONVERGED ! Flag for convergence of MLD + integer :: OBL_IT ! Iteration counter +!### This needs to be made into a run-time parameter. + integer :: MAX_OBL_IT=20 ! Set maximum number of iterations. Probably best as an input parameter, + ! but then may want to use allocatable arrays if storing guess/found + ! (as diagnostic); skipping for now. + ! In reality, the maximum number of guesses needed is set by: + ! DEPTH/2^M < DZ + ! where M is the number of guesses + ! e.g. M=12 for DEPTH=4000m and DZ=1m +! real, dimension(SZK_(GV)+1) :: Vstar_Used, & ! 1D arrays used to store +! Mixing_Length_Used ! Vstar and Mixing_Length + + real :: Surface_Scale ! Surface decay scale for vstar + + logical :: debug=.false. ! Change this hard-coded value for debugging. + + ! The following arrays are used only for debugging purposes. + real :: dPE_debug, mixing_debug, taux2, tauy2 + real, dimension(20) :: TKE_left_itt, PE_chg_itt, Kddt_h_itt, dPEa_dKd_itt, MKE_src_itt + real, dimension(SZK_(GV)) :: mech_TKE_k, conv_PErel_k, nstar_k + integer, dimension(SZK_(GV)) :: num_itts + + integer :: k, nz, itt, max_itt + + nz = GV%ke + + if (.not. associated(CS)) call MOM_error(FATAL, "energetic_PBL: "//& + "Module must be initialized before it is used.") + + debug = .false. ; if (allocated(eCD%dT_expect) .or. allocated(eCD%dS_expect)) debug = .true. + + h_neglect = GV%H_subroundoff + + if (.not.CS%Use_MLD_Iteration) MAX_OBL_IT=1 + C1_3 = 1.0 / 3.0 + dt__diag = dt ; if (present(dt_diag)) dt__diag = dt_diag + IdtdR0 = 1.0 / (dt__diag * GV%Rho0) + max_itt = 20 + + h_tt_min = 0.0 + I_dtrho = 0.0 ; if (dt*GV%Rho0 > 0.0) I_dtrho = 1.0 / (dt*GV%Rho0) + + MLD_guess = MLD_io + +! Determine the initial mech_TKE and conv_PErel, including the energy required +! to mix surface heating through the topmost cell, the energy released by mixing +! surface cooling & brine rejection down through the topmost cell, and +! homogenizing the shortwave heating within that cell. This sets the energy +! and ustar and wstar available to drive mixing at the first interior +! interface. + + do K=1,nz+1 ; Kd(K) = 0.0 ; enddo + + pres(1) = 0.0 + pres_Z(1) = 0.0 + do k=1,nz + dMass = GV%H_to_kg_m2 * h(k) + dPres = (GV%g_Earth*US%m_to_Z) * dMass ! This is equivalent to GV%H_to_Pa * h(k) + dT_to_dPE(k) = (dMass * (pres(K) + 0.5*dPres)) * dSV_dT(k) + dS_to_dPE(k) = (dMass * (pres(K) + 0.5*dPres)) * dSV_dS(k) + dT_to_dColHt(k) = dMass * US%m_to_Z * dSV_dT(k) + dS_to_dColHt(k) = dMass * US%m_to_Z * dSV_dS(k) + + pres(K+1) = pres(K) + dPres + pres_Z(K+1) = US%Z_to_m * pres(K+1) + enddo + + ! Determine the total thickness (h_sum) and the fractional distance from the bottom (hb_hs). + h_sum = H_neglect ; do k=1,nz ; h_sum = h_sum + h(k) ; enddo + I_hs = 0.0 ; if (h_sum > 0.0) I_hs = 1.0 / h_sum + h_bot = 0.0 + hb_hs(nz+1) = 0.0 + do k=nz,1,-1 + h_bot = h_bot + h(k) + hb_hs(K) = h_bot * I_hs + enddo + + MLD_output = h(1)*GV%H_to_Z + + !/The following lines are for the iteration over MLD + ! max_MLD will initialized as ocean bottom depth + max_MLD = 0.0 ; do k=1,nz ; max_MLD = max_MLD + h(k)*GV%H_to_Z ; enddo + !min_MLD will initialize as 0. + min_MLD = 0.0 + + ! If no first guess is provided for MLD, try the middle of the water column + if (MLD_guess <= min_MLD) MLD_guess = 0.5 * (min_MLD + max_MLD) + + ! Iterate up to MAX_OBL_IT times to determine a converged EPBL depth. + OBL_CONVERGED = .false. + sfc_connected = .true. + + do OBL_IT=1,MAX_OBL_IT + + if (.not. OBL_CONVERGED) then + ! If not using MLD_Iteration flag loop to only execute once. + if (.not.CS%Use_MLD_Iteration) OBL_CONVERGED = .true. + + if (debug) then ; mech_TKE_k(:) = 0.0 ; conv_PErel_k(:) = 0.0 ; endif + + + ! Reset ML_depth + MLD_output = h(1)*GV%H_to_Z + sfc_connected = .true. + + !/ Here we get MStar, which is the ratio of convective TKE driven + ! mixing to UStar**3 + if (CS%Use_LT) then + call get_Langmuir_Number(LA, G, GV, US, abs(MLD_guess), u_star_mean, i, j, & + H=h, U_H=u, V_H=v, Waves=Waves) + call find_mstar(CS, US, b_flux, U_Star, U_Star_Mean, MLD_Guess, absf, & + MStar_total, Langmuir_Number=La, Convect_Langmuir_Number=LAmod,& + mstar_LT=mstar_LT) + else + call find_mstar(CS, US, b_flux, u_star, u_star_mean, MLD_guess, absf, mstar_total) + endif + + !/ Apply MStar to get mech_TKE + if ((CS%answers_2018) .and. (CS%mstar_mode==0)) then + mech_TKE = (dt*MSTAR_total*GV%Rho0) * US%Z_to_m**3 * U_star**3 + else + mech_TKE = MSTAR_total * US%Z_to_m**3 * (dt*GV%Rho0*U_star**3) + endif + + if (CS%TKE_diagnostics) then + eCD%dTKE_conv = 0.0 ; eCD%dTKE_mixing = 0.0 + eCD%dTKE_MKE = 0.0 ; eCD%dTKE_mech_decay = 0.0 ; eCD%dTKE_conv_decay = 0.0 + + eCD%dTKE_wind = mech_TKE * IdtdR0 + if (TKE_forcing(1) <= 0.0) then + eCD%dTKE_forcing = max(-mech_TKE, TKE_forcing(1)) * IdtdR0 + ! eCD%dTKE_unbalanced = min(0.0, TKE_forcing(1) + mech_TKE) * IdtdR0 + else + eCD%dTKE_forcing = CS%nstar*TKE_forcing(1) * IdtdR0 + ! eCD%dTKE_unbalanced = 0.0 + endif + endif + + if (TKE_forcing(1) <= 0.0) then + mech_TKE = mech_TKE + TKE_forcing(1) + if (mech_TKE < 0.0) mech_TKE = 0.0 + conv_PErel = 0.0 + else + conv_PErel = TKE_forcing(1) + endif + + + ! Store in 1D arrays for output. + do K=1,nz+1 ; mixvel(K) = 0.0 ; mixlen(K) = 0.0 ; enddo + + ! Determine the mixing shape function MixLen_shape. + if ((.not.CS%Use_MLD_Iteration) .or. & + (CS%transLay_scale >= 1.0) .or. (CS%transLay_scale < 0.0) ) then + do K=1,nz+1 + MixLen_shape(K) = 1.0 + enddo + elseif (MLD_guess <= 0.0) then + if (CS%transLay_scale > 0.0) then ; do K=1,nz+1 + MixLen_shape(K) = CS%transLay_scale + enddo ; else ; do K=1,nz+1 + MixLen_shape(K) = 1.0 + enddo ; endif + else + ! Reduce the mixing length based on MLD, with a quadratic + ! expression that follows KPP. + I_MLD = 1.0 / MLD_guess + h_rsum = 0.0 + MixLen_shape(1) = 1.0 + do K=2,nz+1 + h_rsum = h_rsum + h(k-1)*GV%H_to_Z + if (CS%MixLenExponent==2.0) then + MixLen_shape(K) = CS%transLay_scale + (1.0 - CS%transLay_scale) * & + (max(0.0, (MLD_guess - h_rsum)*I_MLD) )**2 ! CS%MixLenExponent + else + MixLen_shape(K) = CS%transLay_scale + (1.0 - CS%transLay_scale) * & + (max(0.0, (MLD_guess - h_rsum)*I_MLD) )**CS%MixLenExponent + endif + enddo + endif + + Kd(1) = 0.0 ; Kddt_h(1) = 0.0 + hp_a = h(1) + dT_to_dPE_a(1) = dT_to_dPE(1) ; dT_to_dColHt_a(1) = dT_to_dColHt(1) + dS_to_dPE_a(1) = dS_to_dPE(1) ; dS_to_dColHt_a(1) = dS_to_dColHt(1) + + htot = h(1) ; uhtot = u(1)*h(1) ; vhtot = v(1)*h(1) + + if (debug) then + mech_TKE_k(1) = mech_TKE ; conv_PErel_k(1) = conv_PErel + nstar_k(:) = 0.0 ; nstar_k(1) = CS%nstar ; num_itts(:) = -1 + endif + + do K=2,nz + ! Apply dissipation to the TKE, here applied as an exponential decay + ! due to 3-d turbulent energy being lost to inefficient rotational modes. + + ! There should be several different "flavors" of TKE that decay at + ! different rates. The following form is often used for mechanical + ! stirring from the surface, perhaps due to breaking surface gravity + ! waves and wind-driven turbulence. + Idecay_len_TKE = (CS%TKE_decay * absf / U_star) * GV%H_to_Z + exp_kh = 1.0 + if (Idecay_len_TKE > 0.0) exp_kh = exp(-h(k-1)*Idecay_len_TKE) + if (CS%TKE_diagnostics) & + eCD%dTKE_mech_decay = eCD%dTKE_mech_decay + (exp_kh-1.0) * mech_TKE * IdtdR0 + mech_TKE = mech_TKE * exp_kh + + ! Accumulate any convectively released potential energy to contribute + ! to wstar and to drive penetrating convection. + if (TKE_forcing(k) > 0.0) then + conv_PErel = conv_PErel + TKE_forcing(k) + if (CS%TKE_diagnostics) & + eCD%dTKE_forcing = eCD%dTKE_forcing + CS%nstar*TKE_forcing(k) * IdtdR0 + endif + + if (debug) then + mech_TKE_k(K) = mech_TKE ; conv_PErel_k(K) = conv_PErel + endif + + ! Determine the total energy + nstar_FC = CS%nstar + if (CS%nstar * conv_PErel > 0.0) then + ! Here nstar is a function of the natural Rossby number 0.2/(1+0.2/Ro), based + ! on a curve fit from the data of Wang (GRL, 2003). + ! Note: Ro = 1.0 / sqrt(0.5 * dt * Rho0 * (absf*htot)**3 / conv_PErel) + nstar_FC = CS%nstar * conv_PErel / (conv_PErel + 0.2 * & + sqrt(0.5 * dt * GV%Rho0 * (absf*(htot*GV%H_to_m))**3 * conv_PErel)) + endif + + if (debug) nstar_k(K) = nstar_FC + + tot_TKE = mech_TKE + nstar_FC * conv_PErel + + ! For each interior interface, first discard the TKE to account for + ! mixing of shortwave radiation through the next denser cell. + if (TKE_forcing(k) < 0.0) then + if (TKE_forcing(k) + tot_TKE < 0.0) then + ! The shortwave requirements deplete all the energy in this layer. + if (CS%TKE_diagnostics) then + eCD%dTKE_mixing = eCD%dTKE_mixing + tot_TKE * IdtdR0 + eCD%dTKE_forcing = eCD%dTKE_forcing - tot_TKE * IdtdR0 + ! eCD%dTKE_unbalanced = eCD%dTKE_unbalanced + (TKE_forcing(k) + tot_TKE) * IdtdR0 + eCD%dTKE_conv_decay = eCD%dTKE_conv_decay + & + (CS%nstar-nstar_FC) * conv_PErel * IdtdR0 + endif + tot_TKE = 0.0 ; mech_TKE = 0.0 ; conv_PErel = 0.0 + else + ! Reduce the mechanical and convective TKE proportionately. + TKE_reduc = (tot_TKE + TKE_forcing(k)) / tot_TKE + if (CS%TKE_diagnostics) then + eCD%dTKE_mixing = eCD%dTKE_mixing - TKE_forcing(k) * IdtdR0 + eCD%dTKE_forcing = eCD%dTKE_forcing + TKE_forcing(k) * IdtdR0 + eCD%dTKE_conv_decay = eCD%dTKE_conv_decay + & + (1.0-TKE_reduc)*(CS%nstar-nstar_FC) * conv_PErel * IdtdR0 + endif + tot_TKE = TKE_reduc*tot_TKE ! = tot_TKE + TKE_forcing(k) + mech_TKE = TKE_reduc*mech_TKE + conv_PErel = TKE_reduc*conv_PErel + endif + endif + + ! Precalculate some temporary expressions that are independent of Kddt_h(K). + if (CS%orig_PE_calc) then + if (K==2) then + dTe_t2 = 0.0 ; dSe_t2 = 0.0 + else + dTe_t2 = Kddt_h(K-1) * ((T0(k-2) - T0(k-1)) + dTe(k-2)) + dSe_t2 = Kddt_h(K-1) * ((S0(k-2) - S0(k-1)) + dSe(k-2)) + endif + endif + dt_h = (GV%Z_to_H**2*dt) / max(0.5*(h(k-1)+h(k)), 1e-15*h_sum) + + ! This tests whether the layers above and below this interface are in + ! a convetively stable configuration, without considering any effects of + ! mixing at higher interfaces. It is an approximation to the more + ! complete test dPEc_dKd_Kd0 >= 0.0, that would include the effects of + ! mixing across interface K-1. The dT_to_dColHt here are effectively + ! mass-weigted estimates of dSV_dT. + Convectively_stable = ( 0.0 <= & + ( (dT_to_dColHt(k) + dT_to_dColHt(k-1) ) * (T0(k-1)-T0(k)) + & + (dS_to_dColHt(k) + dS_to_dColHt(k-1) ) * (S0(k-1)-S0(k)) ) ) + + if ((mech_TKE + conv_PErel) <= 0.0 .and. Convectively_stable) then + ! Energy is already exhausted, so set Kd = 0 and cycle or exit? + tot_TKE = 0.0 ; mech_TKE = 0.0 ; conv_PErel = 0.0 + Kd(K) = 0.0 ; Kddt_h(K) = 0.0 + sfc_disconnect = .true. + ! if (.not.debug) exit + + ! The estimated properties for layer k-1 can be calculated, using + ! greatly simplified expressions when Kddt_h = 0. This enables the + ! tridiagonal solver for the whole column to be completed for debugging + ! purposes, and also allows for something akin to convective adjustment + ! in unstable interior regions? + b1 = 1.0 / hp_a + c1(K) = 0.0 + if (CS%orig_PE_calc) then + dTe(k-1) = b1 * ( dTe_t2 ) + dSe(k-1) = b1 * ( dSe_t2 ) + endif + + hp_a = h(k) + dT_to_dPE_a(k) = dT_to_dPE(k) + dS_to_dPE_a(k) = dS_to_dPE(k) + dT_to_dColHt_a(k) = dT_to_dColHt(k) + dS_to_dColHt_a(k) = dS_to_dColHt(k) + + else ! tot_TKE > 0.0 or this is a potentially convectively unstable profile. + sfc_disconnect = .false. + + ! Precalculate some more temporary expressions that are independent of + ! Kddt_h(K). + if (CS%orig_PE_calc) then + if (K==2) then + dT_km1_t2 = (T0(k)-T0(k-1)) + dS_km1_t2 = (S0(k)-S0(k-1)) + else + dT_km1_t2 = (T0(k)-T0(k-1)) - & + (Kddt_h(K-1) / hp_a) * ((T0(k-2) - T0(k-1)) + dTe(k-2)) + dS_km1_t2 = (S0(k)-S0(k-1)) - & + (Kddt_h(K-1) / hp_a) * ((S0(k-2) - S0(k-1)) + dSe(k-2)) + endif + dTe_term = dTe_t2 + hp_a * (T0(k-1)-T0(k)) + dSe_term = dSe_t2 + hp_a * (S0(k-1)-S0(k)) + else + if (K<=2) then + Th_a(k-1) = h(k-1) * T0(k-1) ; Sh_a(k-1) = h(k-1) * S0(k-1) + else + Th_a(k-1) = h(k-1) * T0(k-1) + Kddt_h(K-1) * Te(k-2) + Sh_a(k-1) = h(k-1) * S0(k-1) + Kddt_h(K-1) * Se(k-2) + endif + Th_b(k) = h(k) * T0(k) ; Sh_b(k) = h(k) * S0(k) + endif + + ! Using Pr=1 and the diffusivity at the bottom interface (once it is + ! known), determine how much resolved mean kinetic energy (MKE) will be + ! extracted within a timestep and add a fraction CS%MKE_to_TKE_effic of + ! this to the mTKE budget available for mixing in the next layer. + + if ((CS%MKE_to_TKE_effic > 0.0) .and. (htot*h(k) > 0.0)) then + ! This is the energy that would be available from homogenizing the + ! velocities between layer k and the layers above. + dMKE_max = (GV%H_to_kg_m2 * CS%MKE_to_TKE_effic) * 0.5 * & + (h(k) / ((htot + h(k))*htot)) * & + ((uhtot-u(k)*htot)**2 + (vhtot-v(k)*htot)**2) + ! A fraction (1-exp(Kddt_h*MKE2_Hharm)) of this energy would be + ! extracted by mixing with a finite viscosity. + MKE2_Hharm = (htot + h(k) + 2.0*h_neglect) / & + ((htot+h_neglect) * (h(k)+h_neglect)) + else + dMKE_max = 0.0 + MKE2_Hharm = 0.0 + endif + + ! At this point, Kddt_h(K) will be unknown because its value may depend + ! on how much energy is available. mech_TKE might be negative due to + ! contributions from TKE_forced. + h_tt = htot + h_tt_min + TKE_here = mech_TKE + CS%wstar_ustar_coef*conv_PErel + if (TKE_here > 0.0) then + if (CS%wT_mode==0) then + vstar = CS%vstar_scale_fac * (I_dtrho*TKE_here)**C1_3 + elseif (CS%wT_mode==1) then + Surface_Scale = max(0.05, 1.0 - htot/MLD_guess) + vstar = CS%vstar_scale_fac * (CS%vstar_surf_fac*U_Star + & + (CS%wstar_ustar_coef*conv_PErel*I_dtrho)**C1_3)* & + Surface_Scale + endif + hbs_here = GV%H_to_Z * min(hb_hs(K), MixLen_shape(K)) + mixlen(K) = MAX(CS%min_mix_len, ((h_tt*hbs_here)*vstar) / & + ((CS%Ekman_scale_coef * absf) * (h_tt*hbs_here) + vstar)) + !Note setting Kd_guess0 to vstar * CS%vonKar * mixlen(K) here will + ! change the answers. Therefore, skipping that. + if (.not.CS%Use_MLD_Iteration) then + Kd_guess0 = vstar * CS%vonKar * ((h_tt*hbs_here)*vstar) / & + ((CS%Ekman_scale_coef * absf) * (h_tt*hbs_here) + vstar) + else + Kd_guess0 = vstar * CS%vonKar * mixlen(K) + endif + else + vstar = 0.0 ; Kd_guess0 = 0.0 + endif + mixvel(K) = vstar ! Track vstar + Kddt_h_g0 = Kd_guess0*dt_h + + if (CS%orig_PE_calc) then + call find_PE_chg_orig(Kddt_h_g0, h(k), hp_a, dTe_term, dSe_term, & + dT_km1_t2, dS_km1_t2, dT_to_dPE(k), dS_to_dPE(k), & + dT_to_dPE_a(k-1), dS_to_dPE_a(k-1), & + pres_Z(K), dT_to_dColHt(k), dS_to_dColHt(k), & + dT_to_dColHt_a(k-1), dS_to_dColHt_a(k-1), & + PE_chg=PE_chg_g0, dPEc_dKd=dPEa_dKd_g0, dPE_max=PE_chg_max, & + dPEc_dKd_0=dPEc_dKd_Kd0 ) + else + call find_PE_chg(0.0, Kddt_h_g0, hp_a, h(k), & + Th_a(k-1), Sh_a(k-1), Th_b(k), Sh_b(k), & + dT_to_dPE_a(k-1), dS_to_dPE_a(k-1), dT_to_dPE(k), dS_to_dPE(k), & + pres_Z(K), dT_to_dColHt_a(k-1), dS_to_dColHt_a(k-1), & + dT_to_dColHt(k), dS_to_dColHt(k), & + PE_chg=PE_chg_g0, dPEc_dKd=dPEa_dKd_g0, dPE_max=PE_chg_max, & + dPEc_dKd_0=dPEc_dKd_Kd0 ) + endif + + MKE_src = dMKE_max*(1.0 - exp(-Kddt_h_g0 * MKE2_Hharm)) + + ! This block checks out different cases to determine Kd at the present interface. + if ((PE_chg_g0 < 0.0) .or. ((vstar == 0.0) .and. (dPEc_dKd_Kd0 < 0.0))) then + ! This column is convectively unstable. + if (PE_chg_max <= 0.0) then + ! Does MKE_src need to be included in the calculation of vstar here? + TKE_here = mech_TKE + CS%wstar_ustar_coef*(conv_PErel-PE_chg_max) + if (TKE_here > 0.0) then + if (CS%wT_mode==0) then + vstar = CS%vstar_scale_fac * (I_dtrho*TKE_here)**C1_3 + elseif (CS%wT_mode==1) then + Surface_Scale = max(0.05, 1. - htot/MLD_guess) + vstar = cs%vstar_scale_fac * (CS%vstar_surf_fac*U_Star + & + (CS%wstar_ustar_coef*conv_PErel*I_dtrho)**C1_3)* & + Surface_Scale + endif + hbs_here = GV%H_to_Z * min(hb_hs(K), MixLen_shape(K)) + mixlen(K) = max(CS%min_mix_len, ((h_tt*hbs_here)*vstar) / & + ((CS%Ekman_scale_coef * absf) * (h_tt*hbs_here) + vstar)) + if (.not.CS%Use_MLD_Iteration) then + ! Note again (as prev) that using Mixing_Length_Used here + ! instead of redoing the computation will change answers... + Kd(K) = vstar * CS%vonKar * ((h_tt*hbs_here)*vstar) / & + ((CS%Ekman_scale_coef * absf) * (h_tt*hbs_here) + vstar) + else + Kd(K) = vstar * CS%vonKar * mixlen(K) + endif + else + vstar = 0.0 ; Kd(K) = 0.0 + endif + mixvel(K) = vstar + + if (CS%orig_PE_calc) then + call find_PE_chg_orig(Kd(K)*dt_h, h(k), hp_a, dTe_term, dSe_term, & + dT_km1_t2, dS_km1_t2, dT_to_dPE(k), dS_to_dPE(k), & + dT_to_dPE_a(k-1), dS_to_dPE_a(k-1), & + pres_Z(K), dT_to_dColHt(k), dS_to_dColHt(k), & + dT_to_dColHt_a(k-1), dS_to_dColHt_a(k-1), & + PE_chg=dPE_conv) + else + call find_PE_chg(0.0, Kd(K)*dt_h, hp_a, h(k), & + Th_a(k-1), Sh_a(k-1), Th_b(k), Sh_b(k), & + dT_to_dPE_a(k-1), dS_to_dPE_a(k-1), dT_to_dPE(k), dS_to_dPE(k), & + pres_Z(K), dT_to_dColHt_a(k-1), dS_to_dColHt_a(k-1), & + dT_to_dColHt(k), dS_to_dColHt(k), & + PE_chg=dPE_conv) + endif + ! Should this be iterated to convergence for Kd? + if (dPE_conv > 0.0) then + Kd(K) = Kd_guess0 ; dPE_conv = PE_chg_g0 + else + MKE_src = dMKE_max*(1.0 - exp(-(Kd(K)*dt_h) * MKE2_Hharm)) + endif + else + ! The energy change does not vary monotonically with Kddt_h. Find the maximum? + Kd(K) = Kd_guess0 ; dPE_conv = PE_chg_g0 + endif + + conv_PErel = conv_PErel - dPE_conv + mech_TKE = mech_TKE + MKE_src + if (CS%TKE_diagnostics) then + eCD%dTKE_conv = eCD%dTKE_conv - CS%nstar*dPE_conv * IdtdR0 + eCD%dTKE_MKE = eCD%dTKE_MKE + MKE_src * IdtdR0 + endif + if (sfc_connected) then + MLD_output = MLD_output + GV%H_to_Z * h(k) + endif + + Kddt_h(K) = Kd(K)*dt_h + elseif (tot_TKE + (MKE_src - PE_chg_g0) >= 0.0) then + ! This column is convctively stable and there is energy to support the suggested + ! mixing. Keep that estimate. + Kd(K) = Kd_guess0 + Kddt_h(K) = Kddt_h_g0 + + ! Reduce the mechanical and convective TKE proportionately. + tot_TKE = tot_TKE + MKE_src + TKE_reduc = 0.0 ! tot_TKE could be 0 if Convectively_stable is false. + if (tot_TKE > 0.0) TKE_reduc = (tot_TKE - PE_chg_g0) / tot_TKE + if (CS%TKE_diagnostics) then + eCD%dTKE_mixing = eCD%dTKE_mixing - PE_chg_g0 * IdtdR0 + eCD%dTKE_MKE = eCD%dTKE_MKE + MKE_src * IdtdR0 + eCD%dTKE_conv_decay = eCD%dTKE_conv_decay + & + (1.0-TKE_reduc)*(CS%nstar-nstar_FC) * conv_PErel * IdtdR0 + endif + tot_TKE = TKE_reduc*tot_TKE + mech_TKE = TKE_reduc*(mech_TKE + MKE_src) + conv_PErel = TKE_reduc*conv_PErel + if (sfc_connected) then + MLD_output = MLD_output + GV%H_to_Z * h(k) + endif + + elseif (tot_TKE == 0.0) then + ! This can arise if nstar_FC = 0, but it is not common. + Kd(K) = 0.0 ; Kddt_h(K) = 0.0 + tot_TKE = 0.0 ; conv_PErel = 0.0 ; mech_TKE = 0.0 + sfc_disconnect = .true. + else + ! There is not enough energy to support the mixing, so reduce the + ! diffusivity to what can be supported. + Kddt_h_max = Kddt_h_g0 ; Kddt_h_min = 0.0 + TKE_left_max = tot_TKE + (MKE_src - PE_chg_g0) + TKE_left_min = tot_TKE + + ! As a starting guess, take the minimum of a false position estimate + ! and a Newton's method estimate starting from Kddt_h = 0.0. + Kddt_h_guess = tot_TKE * Kddt_h_max / max( PE_chg_g0 - MKE_src, & + Kddt_h_max * (dPEc_dKd_Kd0 - dMKE_max * MKE2_Hharm) ) + ! The above expression is mathematically the same as the following + ! except it is not susceptible to division by zero when + ! dPEc_dKd_Kd0 = dMKE_max = 0 . + ! Kddt_h_guess = tot_TKE * min( Kddt_h_max / (PE_chg_g0 - MKE_src), & + ! 1.0 / (dPEc_dKd_Kd0 - dMKE_max * MKE2_Hharm) ) + if (debug) then + TKE_left_itt(:) = 0.0 ; dPEa_dKd_itt(:) = 0.0 ; PE_chg_itt(:) = 0.0 + MKE_src_itt(:) = 0.0 ; Kddt_h_itt(:) = 0.0 + endif + do itt=1,max_itt + if (CS%orig_PE_calc) then + call find_PE_chg_orig(Kddt_h_guess, h(k), hp_a, dTe_term, dSe_term, & + dT_km1_t2, dS_km1_t2, dT_to_dPE(k), dS_to_dPE(k), & + dT_to_dPE_a(k-1), dS_to_dPE_a(k-1), & + pres_Z(K), dT_to_dColHt(k), dS_to_dColHt(k), & + dT_to_dColHt_a(k-1), dS_to_dColHt_a(k-1), & + PE_chg=PE_chg, dPEc_dKd=dPEc_dKd ) + else + call find_PE_chg(0.0, Kddt_h_guess, hp_a, h(k), & + Th_a(k-1), Sh_a(k-1), Th_b(k), Sh_b(k), & + dT_to_dPE_a(k-1), dS_to_dPE_a(k-1), dT_to_dPE(k), dS_to_dPE(k), & + pres_Z(K), dT_to_dColHt_a(k-1), dS_to_dColHt_a(k-1), & + dT_to_dColHt(k), dS_to_dColHt(k), & + PE_chg=dPE_conv) + endif + MKE_src = dMKE_max * (1.0 - exp(-MKE2_Hharm * Kddt_h_guess)) + dMKE_src_dK = dMKE_max * MKE2_Hharm * exp(-MKE2_Hharm * Kddt_h_guess) + + TKE_left = tot_TKE + (MKE_src - PE_chg) + if (debug) then + Kddt_h_itt(itt) = Kddt_h_guess ; MKE_src_itt(itt) = MKE_src + PE_chg_itt(itt) = PE_chg + TKE_left_itt(itt) = TKE_left + dPEa_dKd_itt(itt) = dPEc_dKd + endif + ! Store the new bounding values, bearing in mind that min and max + ! here refer to Kddt_h and dTKE_left/dKddt_h < 0: + if (TKE_left >= 0.0) then + Kddt_h_min = Kddt_h_guess ; TKE_left_min = TKE_left + else + Kddt_h_max = Kddt_h_guess ; TKE_left_max = TKE_left + endif + + ! Try to use Newton's method, but if it would go outside the bracketed + ! values use the false-position method instead. + use_Newt = .true. + if (dPEc_dKd - dMKE_src_dK <= 0.0) then + use_Newt = .false. + else + dKddt_h_Newt = TKE_left / (dPEc_dKd - dMKE_src_dK) + Kddt_h_Newt = Kddt_h_guess + dKddt_h_Newt + if ((Kddt_h_Newt > Kddt_h_max) .or. (Kddt_h_Newt < Kddt_h_min)) & + use_Newt = .false. + endif + + if (use_Newt) then + Kddt_h_next = Kddt_h_guess + dKddt_h_Newt + dKddt_h = dKddt_h_Newt + else + Kddt_h_next = (TKE_left_max * Kddt_h_min - Kddt_h_max * TKE_left_min) / & + (TKE_left_max - TKE_left_min) + dKddt_h = Kddt_h_next - Kddt_h_guess + endif + + if ((abs(dKddt_h) < 1e-9*Kddt_h_guess) .or. (itt==max_itt)) then + ! Use the old value so that the energy calculation does not need to be repeated. + if (debug) num_itts(K) = itt + exit + else + Kddt_h_guess = Kddt_h_next + endif + enddo ! Inner iteration loop on itt. + Kd(K) = Kddt_h_guess / dt_h ; Kddt_h(K) = Kd(K)*dt_h + + ! All TKE should have been consumed. + if (CS%TKE_diagnostics) then + eCD%dTKE_mixing = eCD%dTKE_mixing - (tot_TKE + MKE_src) * IdtdR0 + eCD%dTKE_MKE = eCD%dTKE_MKE + MKE_src * IdtdR0 + eCD%dTKE_conv_decay = eCD%dTKE_conv_decay + & + (CS%nstar-nstar_FC) * conv_PErel * IdtdR0 + endif + + if (sfc_connected) MLD_output = MLD_output + & + (PE_chg / PE_chg_g0) * GV%H_to_Z * h(k) + + tot_TKE = 0.0 ; mech_TKE = 0.0 ; conv_PErel = 0.0 + sfc_disconnect = .true. + endif ! End of convective or forced mixing cases to determine Kd. + + Kddt_h(K) = Kd(K)*dt_h + ! At this point, the final value of Kddt_h(K) is known, so the + ! estimated properties for layer k-1 can be calculated. + b1 = 1.0 / (hp_a + Kddt_h(K)) + c1(K) = Kddt_h(K) * b1 + if (CS%orig_PE_calc) then + dTe(k-1) = b1 * ( Kddt_h(K)*(T0(k)-T0(k-1)) + dTe_t2 ) + dSe(k-1) = b1 * ( Kddt_h(K)*(S0(k)-S0(k-1)) + dSe_t2 ) + endif + + hp_a = h(k) + (hp_a * b1) * Kddt_h(K) + dT_to_dPE_a(k) = dT_to_dPE(k) + c1(K)*dT_to_dPE_a(k-1) + dS_to_dPE_a(k) = dS_to_dPE(k) + c1(K)*dS_to_dPE_a(k-1) + dT_to_dColHt_a(k) = dT_to_dColHt(k) + c1(K)*dT_to_dColHt_a(k-1) + dS_to_dColHt_a(k) = dS_to_dColHt(k) + c1(K)*dS_to_dColHt_a(k-1) + + endif ! tot_TKT > 0.0 branch. Kddt_h(K) has been set. + + ! Store integrated velocities and thicknesses for MKE conversion calculations. + if (sfc_disconnect) then + ! There is no turbulence at this interface, so zero out the running sums. + uhtot = u(k)*h(k) + vhtot = v(k)*h(k) + htot = h(k) + sfc_connected = .false. + else + uhtot = uhtot + u(k)*h(k) + vhtot = vhtot + v(k)*h(k) + htot = htot + h(k) + endif + + if (debug) then + if (k==2) then + Te(1) = b1*(h(1)*T0(1)) + Se(1) = b1*(h(1)*S0(1)) + else + Te(k-1) = b1 * (h(k-1) * T0(k-1) + Kddt_h(K-1) * Te(k-2)) + Se(k-1) = b1 * (h(k-1) * S0(k-1) + Kddt_h(K-1) * Se(k-2)) + endif + endif + enddo + Kd(nz+1) = 0.0 + + if (debug) then + ! Complete the tridiagonal solve for Te. + b1 = 1.0 / hp_a + Te(nz) = b1 * (h(nz) * T0(nz) + Kddt_h(nz) * Te(nz-1)) + Se(nz) = b1 * (h(nz) * S0(nz) + Kddt_h(nz) * Se(nz-1)) + eCD%dT_expect(nz) = Te(nz) - T0(nz) ; eCD%dS_expect(nz) = Se(nz) - S0(nz) + do k=nz-1,1,-1 + Te(k) = Te(k) + c1(K+1)*Te(k+1) + Se(k) = Se(k) + c1(K+1)*Se(k+1) + eCD%dT_expect(k) = Te(k) - T0(k) ; eCD%dS_expect(k) = Se(k) - S0(k) + enddo + + dPE_debug = 0.0 + do k=1,nz + dPE_debug = dPE_debug + (dT_to_dPE(k) * (Te(k) - T0(k)) + & + dS_to_dPE(k) * (Se(k) - S0(k))) + enddo + mixing_debug = dPE_debug * IdtdR0 + endif + k = nz ! This is here to allow a breakpoint to be set. + !/BGR + ! The following lines are used for the iteration + ! note the iteration has been altered to use the value predicted by + ! the TKE threshold (ML_DEPTH). This is because the MSTAR + ! is now dependent on the ML, and therefore the ML needs to be estimated + ! more precisely than the grid spacing. + MLD_found = 0.0 ; FIRST_OBL = .true. + if (CS%Orig_MLD_iteration) then + ! This is how the iteration was original conducted + do k=2,nz + if (FIRST_OBL) then ! Breaks when OBL found + if ((mixvel(K) > 1.e-10*US%m_to_Z) .and. k < nz) then + MLD_found = MLD_found + h(k-1)*GV%H_to_Z + else + FIRST_OBL = .false. + if (MLD_found - CS%MLD_tol > MLD_guess) then + min_MLD = MLD_guess + elseif ((MLD_guess - MLD_found) < max(CS%MLD_tol, h(k-1)*GV%H_to_Z)) then + OBL_CONVERGED = .true. ! Break convergence loop + else + max_MLD = MLD_guess ! We know this guess was too deep + endif + endif + endif + enddo + else + !New method uses ML_DEPTH as computed in ePBL routine + MLD_found = MLD_output + if (MLD_found - CS%MLD_tol > MLD_guess) then + min_MLD = MLD_guess + elseif (abs(MLD_guess - MLD_found) < CS%MLD_tol) then + OBL_CONVERGED = .true. ! Break convergence loop + else + max_MLD = MLD_guess ! We know this guess was too deep + endif + endif + ! For next pass, guess average of minimum and maximum values. + MLD_guess = 0.5*(min_MLD + max_MLD) + endif + enddo ! Iteration loop for converged boundary layer thickness. + eCD%LA = LA ; eCD%LAmod = LAmod ; eCD%mstar = mstar_total ; eCD%mstar_LT = mstar_LT + + MLD_io = MLD_output + +end subroutine ePBL_column + !> This subroutine calculates the change in potential energy and or derivatives !! for several changes in an interfaces's diapycnal diffusivity times a timestep. subroutine find_PE_chg(Kddt_h0, dKddt_h, hp_a, hp_b, Th_a, Sh_a, Th_b, Sh_b, & From 8f9d7e3131df17e558a92990a33e9367df8a00f3 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Fri, 14 Jun 2019 09:17:18 -0400 Subject: [PATCH 19/82] Call ePBL_column Added a call to ePBL_column and eliminated duplicated code from energetic_PBL. All answers are bitwise identical. --- .../vertical/MOM_energetic_PBL.F90 | 886 +----------------- 1 file changed, 20 insertions(+), 866 deletions(-) diff --git a/src/parameterizations/vertical/MOM_energetic_PBL.F90 b/src/parameterizations/vertical/MOM_energetic_PBL.F90 index b41ef3ad31..04ace1257d 100644 --- a/src/parameterizations/vertical/MOM_energetic_PBL.F90 +++ b/src/parameterizations/vertical/MOM_energetic_PBL.F90 @@ -318,199 +318,26 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS v ! The meridional velocity [m s-1]. real, dimension(SZK_(GV)+1) :: & Kd, & ! The diapycnal diffusivity [Z2 s-1 ~> m2 s-1]. - pres, & ! Interface pressures [Pa]. - pres_Z, & ! Interface pressures with a rescaling factor to convert interface height - ! movements into changes in column potential energy [J m-2 Z-1 ~> J m-3]. - hb_hs ! The distance from the bottom over the thickness of the - ! water column [nondim]. - real :: mech_TKE ! The mechanically generated turbulent kinetic energy - ! available for mixing over a time step [J m-2 = kg s-2]. - real :: conv_PErel ! The potential energy that has been convectively released - ! during this timestep [J m-2 = kg s-2]. A portion nstar_FC - ! of conv_PErel is available to drive mixing. - real :: htot ! The total depth of the layers above an interface [H ~> m or kg m-2]. - real :: uhtot ! The depth integrated zonal and meridional velocities in the - real :: vhtot ! layers above [H m s-1 ~> m2 s-1 or kg m-1 s-1]. - real :: Idecay_len_TKE ! The inverse of a turbulence decay length scale [H-1 ~> m-1 or m2 kg-1]. - real :: h_sum ! The total thickness of the water column [H ~> m or kg m-2]. - real :: absf ! The absolute value of f [s-1]. - - real, dimension(SZK_(GV)) :: & - dT_to_dColHt, & ! Partial derivatives of the total column height with the temperature - dS_to_dColHt, & ! and salinity changes within a layer [Z degC-1 ~> m degC-1] and [Z ppt-1 ~> m ppt-1]. - dT_to_dPE, & ! Partial derivatives of column potential energy with the temperature - dS_to_dPE, & ! and salinity changes within a layer, in [J m-2 degC-1] and [J m-2 ppt-1]. - dT_to_dColHt_a, & ! Partial derivatives of the total column height with the temperature - dS_to_dColHt_a, & ! and salinity changes within a layer, including the implicit effects - ! of mixing with layers higher in the water colun [Z degC-1 ~> m degC-1] and [Z ppt-1 ~> m ppt-1]. - dT_to_dPE_a, & ! Partial derivatives of column potential energy with the temperature - dS_to_dPE_a ! and salinity changes within a layer, including the implicit effects - ! of mixing with layers higher in the water column, in - ! units of [J m-2 degC-1] and [J m-2 ppt-1]. - real, dimension(SZK_(GV)) :: & - Te, Se, & ! Estimated final values of T and S in the column, in [degC] and [ppt]. - c1, & ! c1 is used by the tridiagonal solver [nondim]. - dTe, dSe, & ! Running (1-way) estimates of temperature and salinity change. - Th_a, & ! An effective temperature times a thickness in the layer above, including implicit - ! mixing effects with other yet higher layers [degC H ~> degC m or degC kg m-2]. - Sh_a, & ! An effective salinity times a thickness in the layer above, including implicit - ! mixing effects with other yet higher layers [ppt H ~> ppt m or ppt kg m-2]. - Th_b, & ! An effective temperature times a thickness in the layer below, including implicit - ! mixing effects with other yet lower layers [degC H ~> degC m or degC kg m-2]. - Sh_b ! An effective salinity times a thickness in the layer below, including implicit - ! mixing effects with other yet lower layers [ppt H ~> ppt m or ppt kg m-2]. - real, dimension(SZK_(GV)+1) :: & - MixLen_shape, & ! A nondimensional shape factor for the mixing length that - ! gives it an appropriate assymptotic value at the bottom of - ! the boundary layer. - Kddt_h ! The diapycnal diffusivity times a timestep divided by the - ! average thicknesses around a layer [H ~> m or kg m-2]. - real :: b1 ! b1 is inverse of the pivot used by the tridiagonal solver [H-1 ~> m-1 or m2 kg-1]. - real :: hp_a ! An effective pivot thickness of the layer including the effects - ! of coupling with layers above [H ~> m or kg m-2]. This is the first term - ! in the denominator of b1 in a downward-oriented tridiagonal solver. + mixvel, & ! A turbulent mixing veloxity [Z s-1 ~> m s-1]. + mixlen ! A turbulent mixing length [Z ~> m]. real :: h_neglect ! A thickness that is so small it is usually lost ! in roundoff and can be neglected [H ~> m or kg m-2]. - real :: dMass ! The mass per unit area within a layer [kg m-2]. - real :: dPres ! The hydrostatic pressure change across a layer [Pa]. - real :: dMKE_max ! The maximum amount of mean kinetic energy that could be - ! converted to turbulent kinetic energy if the velocity in - ! the layer below an interface were homogenized with all of - ! the water above the interface [J m-2 = kg s-2]. - real :: MKE2_Hharm ! Twice the inverse of the harmonic mean of the thickness - ! of a layer and the thickness of the water above, used in - ! the MKE conversion equation [H-1 ~> m-1 or m2 kg-1]. - - real :: dt_h ! The timestep divided by the averages of the thicknesses around - ! a layer, times a thickness conversion factor [H s m-2 ~> s m-1 or kg s m-4]. - real :: h_bot ! The distance from the bottom [H ~> m or kg m-2]. - real :: h_rsum ! The running sum of h from the top [Z ~> m]. - real :: I_hs ! The inverse of h_sum [H-1 ~> m-1 or m2 kg-1]. - real :: I_MLD ! The inverse of the current value of MLD [Z-1 ~> m-1]. - real :: h_tt ! The distance from the surface or up to the next interface - ! that did not exhibit turbulent mixing from this scheme plus - ! a surface mixing roughness length given by h_tt_min [H ~> m or kg m-2]. - real :: h_tt_min ! A surface roughness length [H ~> m or kg m-2]. - real :: C1_3 ! = 1/3. - real :: I_dtrho ! 1.0 / (dt * Rho0) in [m3 kg-1 s-1]. This is - ! used convert TKE back into ustar^3. + real :: absf ! The absolute value of f [s-1]. real :: U_star ! The surface friction velocity [Z s-1 ~> m s-1]. real :: U_Star_Mean ! The surface friction without gustiness [Z s-1 ~> m s-1]. real :: B_Flux ! The surface buoyancy flux [Z2 s-3 ~> m2 s-3] - real :: vstar ! An in-situ turbulent velocity [m s-1]. - real :: mstar_total ! The value of mstar used in ePBL [nondim] - real :: mstar_LT ! An addition to mstar due to Langmuir turbulence [nondim] (output for diagnostic) - real :: MLD_output ! The mixed layer depth output from this routine [Z ~> m]. - real :: LA ! The value of the Langmuir number [nondim] - real :: LAmod ! The modified Langmuir number by convection [nondim] - real :: hbs_here ! The local minimum of hb_hs and MixLen_shape, times a - ! conversion factor from H to Z [Z H-1 ~> 1 or m3 kg-1]. - real :: nstar_FC ! The fraction of conv_PErel that can be converted to mixing [nondim]. - real :: TKE_reduc ! The fraction by which TKE and other energy fields are - ! reduced to support mixing [nondim]. between 0 and 1. - real :: tot_TKE ! The total TKE available to support mixing at interface K [J m-2]. - real :: TKE_here ! The total TKE at this point in the algorithm [J m-2]. - real :: dT_km1_t2 ! A diffusivity-independent term related to the temperature - ! change in the layer above the interface [degC]. - real :: dS_km1_t2 ! A diffusivity-independent term related to the salinity - ! change in the layer above the interface [ppt]. - real :: dTe_term ! A diffusivity-independent term related to the temperature - ! change in the layer below the interface [degC H ~> degC m or degC kg m-2]. - real :: dSe_term ! A diffusivity-independent term related to the salinity - ! change in the layer above the interface [ppt H ~> ppt m or ppt kg m-2]. - real :: dTe_t2 ! A part of dTe_term [degC H ~> degC m or degC kg m-2]. - real :: dSe_t2 ! A part of dSe_term [ppt H ~> ppt m or ppt kg m-2]. - real :: dPE_conv ! The convective change in column potential energy [J m-2]. - real :: MKE_src ! The mean kinetic energy source of TKE due to Kddt_h(K) [J m-2]. - real :: dMKE_src_dK ! The partial derivative of MKE_src with Kddt_h(K) [J m-2 H-1 ~> J m-3 or J kg-1]. - real :: Kd_guess0 ! A first guess of the diapycnal diffusivity [Z2 s-1 ~> m2 s-1]. - real :: PE_chg_g0 ! The potential energy change when Kd is Kd_guess0 [J m-2] - real :: dPEa_dKd_g0 - real :: Kddt_h_g0 ! The first guess diapycnal diffusivity times a timestep divided - ! by the average thicknesses around a layer [H ~> m or kg m-2]. - real :: PE_chg_max ! The maximum PE change for very large values of Kddt_h(K). - real :: dPEc_dKd_Kd0 ! The partial derivative of PE change with Kddt_h(K) - ! for very small values of Kddt_h(K) [J m-2 H-1 ~> J m-3 or J kg-1]. - real :: PE_chg ! The change in potential energy due to mixing at an - ! interface [J m-2], positive for the column increasing - ! in potential energy (i.e., consuming TKE). - real :: TKE_left ! The amount of turbulent kinetic energy left for the most - ! recent guess at Kddt_h(K) [J m-2]. - 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]. - real :: TKE_left_min, TKE_left_max ! Maximum and minimum values of TKE_left [J m-2]. - real :: Kddt_h_max, Kddt_h_min ! Maximum and minimum values of Kddt_h(K) [H ~> m or kg m-2]. - real :: Kddt_h_guess ! A guess at the value of Kddt_h(K) [H ~> m or kg m-2]. - real :: Kddt_h_next ! The next guess at the value of Kddt_h(K) [H ~> m or kg m-2]. - real :: dKddt_h ! The change between guesses at Kddt_h(K) [H ~> m or kg m-2]. - real :: dKddt_h_Newt ! The change between guesses at Kddt_h(K) with Newton's method [H ~> m or kg m-2]. - real :: Kddt_h_newt ! The Newton's method next guess for Kddt_h(K) [H ~> m or kg m-2]. - real :: exp_kh ! The nondimensional decay of TKE across a layer [nondim]. - logical :: use_Newt ! Use Newton's method for the next guess at Kddt_h(K). - logical :: convectively_stable ! If true the water column is convectively stable at this interface. - logical :: sfc_connected ! If true the ocean is actively turbulent from the present - ! interface all the way up to the surface. - logical :: sfc_disconnect ! If true, any turbulence has become disconnected - ! from the surface. + real :: MLD_io ! The mixed layer depth found by ePBL_column [Z ~> m]. ! The following are only used for diagnostics. real :: dt__diag ! A copy of dt_diag (if present) or dt [s]. - real :: IdtdR0 ! = 1.0 / (dt__diag * Rho0) [m3 kg-1 s-1]. logical :: write_diags ! If true, write out diagnostics with this step. logical :: reset_diags ! If true, zero out the accumulated diagnostics. - !---------------------------------------------------------------------- - !/BGR added Aug24,2016 for adding iteration to get boundary layer depth - ! - needed to compute new mixing length. - real :: MLD_guess, MLD_found ! Mixing Layer depth guessed/found for iteration [Z ~> m]. - real :: max_MLD, min_MLD ! Iteration bounds [Z ~> m], which are adjusted at each step - ! - These are initialized based on surface/bottom - ! 1. The iteration guesses a value (possibly from - ! prev step or neighbor). - ! 2. The iteration checks if value is converged, - ! too shallow, or too deep. - ! 3. Based on result adjusts the Max/Min - ! and searches through the water column. - ! - If using an accurate guess the iteration - ! is very quick (e.g. if MLD doesn't change - ! over timestep). Otherwise it takes 5-10 - ! passes, but has a high convergence rate. - ! Other iteration may be tried, but this - ! method seems to rarely fail and the added - ! cost is likely not significant. Additionally, - ! when it fails it does so in a reasonable - ! manner giving a usable guess. When it - ! does fail, it is due to convection within - ! the boundary. Likely, a new method e.g. - ! surface_disconnect, can improve this. - logical :: FIRST_OBL ! Flag for computing "found" Mixing layer depth - logical :: OBL_CONVERGED ! Flag for convergence of MLD - integer :: OBL_IT ! Iteration counter -!### This needs to be made into a run-time parameters. - integer :: MAX_OBL_IT=20 ! Set maximum number of iterations. Probably - ! best as an input parameter, but then may want - ! to use allocatable arrays if storing - ! guess/found (as diagnostic); skipping for now. - ! In reality, the maximum number of guesses - ! needed is set by: - ! DEPTH/2^M < DZ - ! where M is the number of guesses - ! e.g. M=12 for DEPTH=4000m and DZ=1m - real, dimension(SZK_(GV)+1) :: Vstar_Used, & ! 1D arrays used to store - Mixing_Length_Used ! Vstar and Mixing_Length - - real :: Surface_Scale ! Surface decay scale for vstar - logical :: debug=.false. ! Change this hard-coded value for debugging. - - ! The following arrays are used only for debugging purposes. - real :: dPE_debug, mixing_debug, taux2, tauy2 - real, dimension(20) :: TKE_left_itt, PE_chg_itt, Kddt_h_itt, dPEa_dKd_itt, MKE_src_itt - real, dimension(SZK_(GV)) :: mech_TKE_k, conv_PErel_k, nstar_k type(ePBL_column_diags) :: eCD ! A container for passing around diagnostics. - integer, dimension(SZK_(GV)) :: num_itts - integer :: i, j, k, is, ie, js, je, nz, itt, max_itt + integer :: i, j, k, is, ie, js, je, nz is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke @@ -528,15 +355,10 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS h_neglect = GV%H_subroundoff - if (.not.CS%Use_MLD_Iteration) MAX_OBL_IT=1 - C1_3 = 1.0 / 3.0 +! if (.not.CS%Use_MLD_Iteration) MAX_OBL_IT=1 dt__diag = dt ; if (present(dt_diag)) dt__diag = dt_diag - IdtdR0 = 1.0 / (dt__diag * GV%Rho0) write_diags = .true. ; if (present(last_call)) write_diags = last_call - max_itt = 20 - h_tt_min = 0.0 - I_dtrho = 0.0 ; if (dt*GV%Rho0 > 0.0) I_dtrho = 1.0 / (dt*GV%Rho0) ! Determine whether to zero out diagnostics before accumulation. reset_diags = .true. @@ -553,15 +375,13 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS CS%diag_TKE_conv_decay(i,j) = 0.0 !; CS%diag_TKE_unbalanced(i,j) = 0.0 enddo ; enddo endif -!!OMP parallel do default(none) shared(CS) endif ! if (CS%id_Mixing_Length>0) CS%Mixing_Length(:,:,:) = 0.0 ! if (CS%id_Velocity_Scale>0) CS%Velocity_Scale(:,:,:) = 0.0 !!OMP parallel do default(private) shared(js,je,nz,is,ie,h_3d,u_3d,v_3d,tv,dt, & -!!OMP CS,G,GV,US,fluxes,IdtdR0,debug,H_neglect, & -!!OMP TKE_forced,dSV_dT,dSV_dS,I_dtrho,C1_3,h_tt_min, & -!!OMP max_itt,Kd_int) +!!OMP CS,G,GV,US,fluxes,debug, & +!!OMP TKE_forced,dSV_dT,dSV_dS,Kd_int) do j=js,je ! Copy the thicknesses and other fields to 2-d arrays. do k=1,nz ; do i=is,ie @@ -580,7 +400,7 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS ! Copy the thicknesses and other fields to 1-d arrays. do k=1,nz - h(k) = h_2d(i,k) + h_neglect ; u(k) = u_2d(i,k) ; v(k) = v_2d(i,k) + h(k) = h_2d(i,k) + GV%H_subroundoff ; u(k) = u_2d(i,k) ; v(k) = v_2d(i,k) T0(k) = T_2d(i,k) ; S0(k) = S_2d(i,k) ; TKE_forcing(k) = TKE_forced_2d(i,k) dSV_dT_1d(k) = dSV_dT_2d(i,k) ; dSV_dS_1d(k) = dSV_dS_2d(i,k) enddo @@ -606,674 +426,19 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS endif ! Perhaps provide a first guess for MLD based on a stored previous value. - MLD_guess = -1.0 - if (CS%MLD_iteration_guess .and. (CS%ML_Depth(i,j) > 0.0)) MLD_guess = CS%ML_Depth(i,j) - -! call ePBL_column(h, u, v, T0, S0, dSV_dT_1d, dSV_dS_1d, TKE_forcing, B_flux, absf, & -! u_star, u_star_mean, dt, MLD_io, Kd, Vstar_Used, Mixing_Length_Used, GV, US, CS, eCD, & -! dt_diag=dt_diag, Waves=Waves, G=G, i=i, j=j) - - pres(1) = 0.0 - pres_Z(1) = 0.0 - do k=1,nz - dMass = GV%H_to_kg_m2 * h(k) - dPres = (GV%g_Earth*US%m_to_Z) * dMass ! This is equivalent to GV%H_to_Pa * h(k) - dT_to_dPE(k) = (dMass * (pres(K) + 0.5*dPres)) * dSV_dT_1d(k) - dS_to_dPE(k) = (dMass * (pres(K) + 0.5*dPres)) * dSV_dS_1d(k) - dT_to_dColHt(k) = dMass * US%m_to_Z * dSV_dT_1d(k) - dS_to_dColHt(k) = dMass * US%m_to_Z * dSV_dS_1d(k) - - pres(K+1) = pres(K) + dPres - pres_Z(K+1) = US%Z_to_m * pres(K+1) - enddo - - ! Determine the total thickness (h_sum) and the fractional distance from the bottom (hb_hs). - h_sum = H_neglect ; do k=1,nz ; h_sum = h_sum + h(k) ; enddo - I_hs = 0.0 ; if (h_sum > 0.0) I_hs = 1.0 / h_sum - h_bot = 0.0 - hb_hs(nz+1) = 0.0 - do k=nz,1,-1 - h_bot = h_bot + h(k) - hb_hs(K) = h_bot * I_hs - enddo - - MLD_output = h(1)*GV%H_to_Z - - !/The following lines are for the iteration over MLD - ! max_MLD will initialized as ocean bottom depth - max_MLD = 0.0 ; do k=1,nz ; max_MLD = max_MLD + h(k)*GV%H_to_Z ; enddo - !min_MLD will initialize as 0. - min_MLD = 0.0 - - ! If no first guess is provided for MLD, try the middle of the water column - if (MLD_guess <= min_MLD) MLD_guess = 0.5 * (min_MLD + max_MLD) - - ! Iterate up to MAX_OBL_IT times to determine a converged EPBL depth. - OBL_CONVERGED = .false. - sfc_connected = .true. - - do OBL_IT=1,MAX_OBL_IT + MLD_io = -1.0 + if (CS%MLD_iteration_guess .and. (CS%ML_Depth(i,j) > 0.0)) MLD_io = CS%ML_Depth(i,j) - if (.not. OBL_CONVERGED) then - ! If not using MLD_Iteration flag loop to only execute once. - if (.not.CS%Use_MLD_Iteration) OBL_CONVERGED = .true. + call ePBL_column(h, u, v, T0, S0, dSV_dT_1d, dSV_dS_1d, TKE_forcing, B_flux, absf, & + u_star, u_star_mean, dt, MLD_io, Kd, mixvel, mixlen, GV, & + US, CS, eCD, dt_diag=dt_diag, Waves=Waves, G=G, i=i, j=j) - if (debug) then ; mech_TKE_k(:) = 0.0 ; conv_PErel_k(:) = 0.0 ; endif - - - ! Reset ML_depth - MLD_output = h(1)*GV%H_to_Z - sfc_connected = .true. - - !/ Here we get MStar, which is the ratio of convective TKE driven - ! mixing to UStar**3 - if (CS%Use_LT) then - call get_Langmuir_Number(LA, G, GV, US, abs(MLD_guess), u_star_mean, i, j, & - H=h, U_H=u, V_H=v, Waves=Waves) - call find_mstar(CS, US, b_flux, U_Star, U_Star_Mean, MLD_Guess, absf, & - MStar_total, Langmuir_Number=La, Convect_Langmuir_Number=LAmod,& - mstar_LT=mstar_LT) - else - call find_mstar(CS, US, b_flux, u_star, u_star_mean, MLD_guess, absf, mstar_total) - endif - - !/ Apply MStar to get mech_TKE - if ((CS%answers_2018) .and. (CS%mstar_mode==0)) then - mech_TKE = (dt*MSTAR_total*GV%Rho0) * US%Z_to_m**3 * U_star**3 - else - mech_TKE = MSTAR_total * US%Z_to_m**3 * (dt*GV%Rho0*U_star**3) - endif - - if (CS%TKE_diagnostics) then - eCD%dTKE_conv = 0.0 ; eCD%dTKE_mixing = 0.0 - eCD%dTKE_MKE = 0.0 ; eCD%dTKE_mech_decay = 0.0 ; eCD%dTKE_conv_decay = 0.0 - - eCD%dTKE_wind = mech_TKE * IdtdR0 - if (TKE_forcing(1) <= 0.0) then - eCD%dTKE_forcing = max(-mech_TKE, TKE_forcing(1)) * IdtdR0 - ! eCD%dTKE_unbalanced = min(0.0, TKE_forcing(1) + mech_TKE) * IdtdR0 - else - eCD%dTKE_forcing = CS%nstar*TKE_forcing(1) * IdtdR0 - ! eCD%dTKE_unbalanced = 0.0 - endif - endif - - if (TKE_forcing(1) <= 0.0) then - mech_TKE = mech_TKE + TKE_forcing(1) - if (mech_TKE < 0.0) mech_TKE = 0.0 - conv_PErel = 0.0 - else - conv_PErel = TKE_forcing(1) - endif - - - ! Store in 1D arrays for output. - do k=1,nz - Vstar_Used(k) = 0. - Mixing_Length_Used(k) = 0. - enddo - - ! Determine the mixing shape function MixLen_shape. - if ((.not.CS%Use_MLD_Iteration) .or. & - (CS%transLay_scale >= 1.0) .or. (CS%transLay_scale < 0.0) ) then - do K=1,nz+1 - MixLen_shape(K) = 1.0 - enddo - elseif (MLD_guess <= 0.0) then - if (CS%transLay_scale > 0.0) then ; do K=1,nz+1 - MixLen_shape(K) = CS%transLay_scale - enddo ; else ; do K=1,nz+1 - MixLen_shape(K) = 1.0 - enddo ; endif - else - ! Reduce the mixing length based on MLD, with a quadratic - ! expression that follows KPP. - I_MLD = 1.0 / MLD_guess - h_rsum = 0.0 - MixLen_shape(1) = 1.0 - do K=2,nz+1 - h_rsum = h_rsum + h(k-1)*GV%H_to_Z - if (CS%MixLenExponent==2.0) then - MixLen_shape(K) = CS%transLay_scale + (1.0 - CS%transLay_scale) * & - (max(0.0, (MLD_guess - h_rsum)*I_MLD) )**2 ! CS%MixLenExponent - else - MixLen_shape(K) = CS%transLay_scale + (1.0 - CS%transLay_scale) * & - (max(0.0, (MLD_guess - h_rsum)*I_MLD) )**CS%MixLenExponent - endif - enddo - endif - - Kd(1) = 0.0 ; Kddt_h(1) = 0.0 - hp_a = h(1) - dT_to_dPE_a(1) = dT_to_dPE(1) ; dT_to_dColHt_a(1) = dT_to_dColHt(1) - dS_to_dPE_a(1) = dS_to_dPE(1) ; dS_to_dColHt_a(1) = dS_to_dColHt(1) - - htot = h(1) ; uhtot = u(1)*h(1) ; vhtot = v(1)*h(1) - - if (debug) then - mech_TKE_k(1) = mech_TKE ; conv_PErel_k(1) = conv_PErel - nstar_k(:) = 0.0 ; nstar_k(1) = CS%nstar ; num_itts(:) = -1 - endif - - do K=2,nz - ! Apply dissipation to the TKE, here applied as an exponential decay - ! due to 3-d turbulent energy being lost to inefficient rotational modes. - - ! There should be several different "flavors" of TKE that decay at - ! different rates. The following form is often used for mechanical - ! stirring from the surface, perhaps due to breaking surface gravity - ! waves and wind-driven turbulence. - Idecay_len_TKE = (CS%TKE_decay * absf / U_star) * GV%H_to_Z - exp_kh = 1.0 - if (Idecay_len_TKE > 0.0) exp_kh = exp(-h(k-1)*Idecay_len_TKE) - if (CS%TKE_diagnostics) & - eCD%dTKE_mech_decay = eCD%dTKE_mech_decay + (exp_kh-1.0) * mech_TKE * IdtdR0 - mech_TKE = mech_TKE * exp_kh - - ! Accumulate any convectively released potential energy to contribute - ! to wstar and to drive penetrating convection. - if (TKE_forcing(k) > 0.0) then - conv_PErel = conv_PErel + TKE_forcing(k) - if (CS%TKE_diagnostics) & - eCD%dTKE_forcing = eCD%dTKE_forcing + CS%nstar*TKE_forcing(k) * IdtdR0 - endif - - if (debug) then - mech_TKE_k(K) = mech_TKE ; conv_PErel_k(K) = conv_PErel - endif - - ! Determine the total energy - nstar_FC = CS%nstar - if (CS%nstar * conv_PErel > 0.0) then - ! Here nstar is a function of the natural Rossby number 0.2/(1+0.2/Ro), based - ! on a curve fit from the data of Wang (GRL, 2003). - ! Note: Ro = 1.0 / sqrt(0.5 * dt * Rho0 * (absf*htot)**3 / conv_PErel) - nstar_FC = CS%nstar * conv_PErel / (conv_PErel + 0.2 * & - sqrt(0.5 * dt * GV%Rho0 * (absf*(htot*GV%H_to_m))**3 * conv_PErel)) - endif - - if (debug) nstar_k(K) = nstar_FC - - tot_TKE = mech_TKE + nstar_FC * conv_PErel - - ! For each interior interface, first discard the TKE to account for - ! mixing of shortwave radiation through the next denser cell. - if (TKE_forcing(k) < 0.0) then - if (TKE_forcing(k) + tot_TKE < 0.0) then - ! The shortwave requirements deplete all the energy in this layer. - if (CS%TKE_diagnostics) then - eCD%dTKE_mixing = eCD%dTKE_mixing + tot_TKE * IdtdR0 - eCD%dTKE_forcing = eCD%dTKE_forcing - tot_TKE * IdtdR0 - ! eCD%dTKE_unbalanced = eCD%dTKE_unbalanced + (TKE_forcing(k) + tot_TKE) * IdtdR0 - eCD%dTKE_conv_decay = eCD%dTKE_conv_decay + & - (CS%nstar-nstar_FC) * conv_PErel * IdtdR0 - endif - tot_TKE = 0.0 ; mech_TKE = 0.0 ; conv_PErel = 0.0 - else - ! Reduce the mechanical and convective TKE proportionately. - TKE_reduc = (tot_TKE + TKE_forcing(k)) / tot_TKE - if (CS%TKE_diagnostics) then - eCD%dTKE_mixing = eCD%dTKE_mixing - TKE_forcing(k) * IdtdR0 - eCD%dTKE_forcing = eCD%dTKE_forcing + TKE_forcing(k) * IdtdR0 - eCD%dTKE_conv_decay = eCD%dTKE_conv_decay + & - (1.0-TKE_reduc)*(CS%nstar-nstar_FC) * conv_PErel * IdtdR0 - endif - tot_TKE = TKE_reduc*tot_TKE ! = tot_TKE + TKE_forcing(k) - mech_TKE = TKE_reduc*mech_TKE - conv_PErel = TKE_reduc*conv_PErel - endif - endif - - ! Precalculate some temporary expressions that are independent of Kddt_h(K). - if (CS%orig_PE_calc) then - if (K==2) then - dTe_t2 = 0.0 ; dSe_t2 = 0.0 - else - dTe_t2 = Kddt_h(K-1) * ((T0(k-2) - T0(k-1)) + dTe(k-2)) - dSe_t2 = Kddt_h(K-1) * ((S0(k-2) - S0(k-1)) + dSe(k-2)) - endif - endif - dt_h = (GV%Z_to_H**2*dt) / max(0.5*(h(k-1)+h(k)), 1e-15*h_sum) - - ! This tests whether the layers above and below this interface are in - ! a convetively stable configuration, without considering any effects of - ! mixing at higher interfaces. It is an approximation to the more - ! complete test dPEc_dKd_Kd0 >= 0.0, that would include the effects of - ! mixing across interface K-1. The dT_to_dColHt here are effectively - ! mass-weigted estimates of dSV_dT. - Convectively_stable = ( 0.0 <= & - ( (dT_to_dColHt(k) + dT_to_dColHt(k-1) ) * (T0(k-1)-T0(k)) + & - (dS_to_dColHt(k) + dS_to_dColHt(k-1) ) * (S0(k-1)-S0(k)) ) ) - - if ((mech_TKE + conv_PErel) <= 0.0 .and. Convectively_stable) then - ! Energy is already exhausted, so set Kd = 0 and cycle or exit? - tot_TKE = 0.0 ; mech_TKE = 0.0 ; conv_PErel = 0.0 - Kd(K) = 0.0 ; Kddt_h(K) = 0.0 - sfc_disconnect = .true. - ! if (.not.debug) exit - - ! The estimated properties for layer k-1 can be calculated, using - ! greatly simplified expressions when Kddt_h = 0. This enables the - ! tridiagonal solver for the whole column to be completed for debugging - ! purposes, and also allows for something akin to convective adjustment - ! in unstable interior regions? - b1 = 1.0 / hp_a - c1(K) = 0.0 - if (CS%orig_PE_calc) then - dTe(k-1) = b1 * ( dTe_t2 ) - dSe(k-1) = b1 * ( dSe_t2 ) - endif - - hp_a = h(k) - dT_to_dPE_a(k) = dT_to_dPE(k) - dS_to_dPE_a(k) = dS_to_dPE(k) - dT_to_dColHt_a(k) = dT_to_dColHt(k) - dS_to_dColHt_a(k) = dS_to_dColHt(k) - - else ! tot_TKE > 0.0 or this is a potentially convectively unstable profile. - sfc_disconnect = .false. - - ! Precalculate some more temporary expressions that are independent of - ! Kddt_h(K). - if (CS%orig_PE_calc) then - if (K==2) then - dT_km1_t2 = (T0(k)-T0(k-1)) - dS_km1_t2 = (S0(k)-S0(k-1)) - else - dT_km1_t2 = (T0(k)-T0(k-1)) - & - (Kddt_h(K-1) / hp_a) * ((T0(k-2) - T0(k-1)) + dTe(k-2)) - dS_km1_t2 = (S0(k)-S0(k-1)) - & - (Kddt_h(K-1) / hp_a) * ((S0(k-2) - S0(k-1)) + dSe(k-2)) - endif - dTe_term = dTe_t2 + hp_a * (T0(k-1)-T0(k)) - dSe_term = dSe_t2 + hp_a * (S0(k-1)-S0(k)) - else - if (K<=2) then - Th_a(k-1) = h(k-1) * T0(k-1) ; Sh_a(k-1) = h(k-1) * S0(k-1) - else - Th_a(k-1) = h(k-1) * T0(k-1) + Kddt_h(K-1) * Te(k-2) - Sh_a(k-1) = h(k-1) * S0(k-1) + Kddt_h(K-1) * Se(k-2) - endif - Th_b(k) = h(k) * T0(k) ; Sh_b(k) = h(k) * S0(k) - endif - - ! Using Pr=1 and the diffusivity at the bottom interface (once it is - ! known), determine how much resolved mean kinetic energy (MKE) will be - ! extracted within a timestep and add a fraction CS%MKE_to_TKE_effic of - ! this to the mTKE budget available for mixing in the next layer. - - if ((CS%MKE_to_TKE_effic > 0.0) .and. (htot*h(k) > 0.0)) then - ! This is the energy that would be available from homogenizing the - ! velocities between layer k and the layers above. - dMKE_max = (GV%H_to_kg_m2 * CS%MKE_to_TKE_effic) * 0.5 * & - (h(k) / ((htot + h(k))*htot)) * & - ((uhtot-u(k)*htot)**2 + (vhtot-v(k)*htot)**2) - ! A fraction (1-exp(Kddt_h*MKE2_Hharm)) of this energy would be - ! extracted by mixing with a finite viscosity. - MKE2_Hharm = (htot + h(k) + 2.0*h_neglect) / & - ((htot+h_neglect) * (h(k)+h_neglect)) - else - dMKE_max = 0.0 - MKE2_Hharm = 0.0 - endif - - ! At this point, Kddt_h(K) will be unknown because its value may depend - ! on how much energy is available. mech_TKE might be negative due to - ! contributions from TKE_forced. - h_tt = htot + h_tt_min - TKE_here = mech_TKE + CS%wstar_ustar_coef*conv_PErel - if (TKE_here > 0.0) then - if (CS%wT_mode==0) then - vstar = CS%vstar_scale_fac * (I_dtrho*TKE_here)**C1_3 - elseif (CS%wT_mode==1) then - Surface_Scale = max(0.05, 1.0 - htot/MLD_guess) - vstar = CS%vstar_scale_fac * (CS%vstar_surf_fac*U_Star + & - (CS%wstar_ustar_coef*conv_PErel*I_dtrho)**C1_3)* & - Surface_Scale - endif - hbs_here = GV%H_to_Z * min(hb_hs(K), MixLen_shape(K)) - Mixing_Length_Used(k) = MAX(CS%min_mix_len, ((h_tt*hbs_here)*vstar) / & - ((CS%Ekman_scale_coef * absf) * (h_tt*hbs_here) + vstar)) - !Note setting Kd_guess0 to Mixing_Length_Used(K) here will - ! change the answers. Therefore, skipping that. - if (.not.CS%Use_MLD_Iteration) then - Kd_guess0 = vstar * CS%vonKar * ((h_tt*hbs_here)*vstar) / & - ((CS%Ekman_scale_coef * absf) * (h_tt*hbs_here) + vstar) - else - Kd_guess0 = vstar * CS%vonKar * Mixing_Length_Used(k) - endif - else - vstar = 0.0 ; Kd_guess0 = 0.0 - endif - Vstar_Used(k) = vstar ! Track vstar - Kddt_h_g0 = Kd_guess0*dt_h - - if (CS%orig_PE_calc) then - call find_PE_chg_orig(Kddt_h_g0, h(k), hp_a, dTe_term, dSe_term, & - dT_km1_t2, dS_km1_t2, dT_to_dPE(k), dS_to_dPE(k), & - dT_to_dPE_a(k-1), dS_to_dPE_a(k-1), & - pres_Z(K), dT_to_dColHt(k), dS_to_dColHt(k), & - dT_to_dColHt_a(k-1), dS_to_dColHt_a(k-1), & - PE_chg=PE_chg_g0, dPEc_dKd=dPEa_dKd_g0, dPE_max=PE_chg_max, & - dPEc_dKd_0=dPEc_dKd_Kd0 ) - else - call find_PE_chg(0.0, Kddt_h_g0, hp_a, h(k), & - Th_a(k-1), Sh_a(k-1), Th_b(k), Sh_b(k), & - dT_to_dPE_a(k-1), dS_to_dPE_a(k-1), dT_to_dPE(k), dS_to_dPE(k), & - pres_Z(K), dT_to_dColHt_a(k-1), dS_to_dColHt_a(k-1), & - dT_to_dColHt(k), dS_to_dColHt(k), & - PE_chg=PE_chg_g0, dPEc_dKd=dPEa_dKd_g0, dPE_max=PE_chg_max, & - dPEc_dKd_0=dPEc_dKd_Kd0 ) - endif - - MKE_src = dMKE_max*(1.0 - exp(-Kddt_h_g0 * MKE2_Hharm)) - - ! This block checks out different cases to determine Kd at the present interface. - if ((PE_chg_g0 < 0.0) .or. ((vstar == 0.0) .and. (dPEc_dKd_Kd0 < 0.0))) then - ! This column is convectively unstable. - if (PE_chg_max <= 0.0) then - ! Does MKE_src need to be included in the calculation of vstar here? - TKE_here = mech_TKE + CS%wstar_ustar_coef*(conv_PErel-PE_chg_max) - if (TKE_here > 0.0) then - if (CS%wT_mode==0) then - vstar = CS%vstar_scale_fac * (I_dtrho*TKE_here)**C1_3 - elseif (CS%wT_mode==1) then - Surface_Scale = max(0.05, 1. - htot/MLD_guess) - vstar = cs%vstar_scale_fac * (CS%vstar_surf_fac*U_Star + & - (CS%wstar_ustar_coef*conv_PErel*I_dtrho)**C1_3)* & - Surface_Scale - endif - hbs_here = GV%H_to_Z * min(hb_hs(K), MixLen_shape(K)) - Mixing_Length_Used(k) = max(CS%min_mix_len,((h_tt*hbs_here)*vstar) / & - ((CS%Ekman_scale_coef * absf) * (h_tt*hbs_here) + vstar)) - if (.not.CS%Use_MLD_Iteration) then - ! Note again (as prev) that using Mixing_Length_Used here - ! instead of redoing the computation will change answers... - Kd(K) = vstar * CS%vonKar * ((h_tt*hbs_here)*vstar) / & - ((CS%Ekman_scale_coef * absf) * (h_tt*hbs_here) + vstar) - else - Kd(K) = vstar * CS%vonKar * Mixing_Length_Used(k) - endif - else - vstar = 0.0 ; Kd(K) = 0.0 - endif - Vstar_Used(k) = vstar - - if (CS%orig_PE_calc) then - call find_PE_chg_orig(Kd(K)*dt_h, h(k), hp_a, dTe_term, dSe_term, & - dT_km1_t2, dS_km1_t2, dT_to_dPE(k), dS_to_dPE(k), & - dT_to_dPE_a(k-1), dS_to_dPE_a(k-1), & - pres_Z(K), dT_to_dColHt(k), dS_to_dColHt(k), & - dT_to_dColHt_a(k-1), dS_to_dColHt_a(k-1), & - PE_chg=dPE_conv) - else - call find_PE_chg(0.0, Kd(K)*dt_h, hp_a, h(k), & - Th_a(k-1), Sh_a(k-1), Th_b(k), Sh_b(k), & - dT_to_dPE_a(k-1), dS_to_dPE_a(k-1), dT_to_dPE(k), dS_to_dPE(k), & - pres_Z(K), dT_to_dColHt_a(k-1), dS_to_dColHt_a(k-1), & - dT_to_dColHt(k), dS_to_dColHt(k), & - PE_chg=dPE_conv) - endif - ! Should this be iterated to convergence for Kd? - if (dPE_conv > 0.0) then - Kd(K) = Kd_guess0 ; dPE_conv = PE_chg_g0 - else - MKE_src = dMKE_max*(1.0 - exp(-(Kd(K)*dt_h) * MKE2_Hharm)) - endif - else - ! The energy change does not vary monotonically with Kddt_h. Find the maximum? - Kd(K) = Kd_guess0 ; dPE_conv = PE_chg_g0 - endif - - conv_PErel = conv_PErel - dPE_conv - mech_TKE = mech_TKE + MKE_src - if (CS%TKE_diagnostics) then - eCD%dTKE_conv = eCD%dTKE_conv - CS%nstar*dPE_conv * IdtdR0 - eCD%dTKE_MKE = eCD%dTKE_MKE + MKE_src * IdtdR0 - endif - if (sfc_connected) then - MLD_output = MLD_output + GV%H_to_Z * h(k) - endif - - Kddt_h(K) = Kd(K)*dt_h - elseif (tot_TKE + (MKE_src - PE_chg_g0) >= 0.0) then - ! This column is convctively stable and there is energy to support the suggested - ! mixing. Keep that estimate. - Kd(K) = Kd_guess0 - Kddt_h(K) = Kddt_h_g0 - - ! Reduce the mechanical and convective TKE proportionately. - tot_TKE = tot_TKE + MKE_src - TKE_reduc = 0.0 ! tot_TKE could be 0 if Convectively_stable is false. - if (tot_TKE > 0.0) TKE_reduc = (tot_TKE - PE_chg_g0) / tot_TKE - if (CS%TKE_diagnostics) then - eCD%dTKE_mixing = eCD%dTKE_mixing - PE_chg_g0 * IdtdR0 - eCD%dTKE_MKE = eCD%dTKE_MKE + MKE_src * IdtdR0 - eCD%dTKE_conv_decay = eCD%dTKE_conv_decay + & - (1.0-TKE_reduc)*(CS%nstar-nstar_FC) * conv_PErel * IdtdR0 - endif - tot_TKE = TKE_reduc*tot_TKE - mech_TKE = TKE_reduc*(mech_TKE + MKE_src) - conv_PErel = TKE_reduc*conv_PErel - if (sfc_connected) then - MLD_output = MLD_output + GV%H_to_Z * h(k) - endif - - elseif (tot_TKE == 0.0) then - ! This can arise if nstar_FC = 0, but it is not common. - Kd(K) = 0.0 ; Kddt_h(K) = 0.0 - tot_TKE = 0.0 ; conv_PErel = 0.0 ; mech_TKE = 0.0 - sfc_disconnect = .true. - else - ! There is not enough energy to support the mixing, so reduce the - ! diffusivity to what can be supported. - Kddt_h_max = Kddt_h_g0 ; Kddt_h_min = 0.0 - TKE_left_max = tot_TKE + (MKE_src - PE_chg_g0) - TKE_left_min = tot_TKE - - ! As a starting guess, take the minimum of a false position estimate - ! and a Newton's method estimate starting from Kddt_h = 0.0. - Kddt_h_guess = tot_TKE * Kddt_h_max / max( PE_chg_g0 - MKE_src, & - Kddt_h_max * (dPEc_dKd_Kd0 - dMKE_max * MKE2_Hharm) ) - ! The above expression is mathematically the same as the following - ! except it is not susceptible to division by zero when - ! dPEc_dKd_Kd0 = dMKE_max = 0 . - ! Kddt_h_guess = tot_TKE * min( Kddt_h_max / (PE_chg_g0 - MKE_src), & - ! 1.0 / (dPEc_dKd_Kd0 - dMKE_max * MKE2_Hharm) ) - if (debug) then - TKE_left_itt(:) = 0.0 ; dPEa_dKd_itt(:) = 0.0 ; PE_chg_itt(:) = 0.0 - MKE_src_itt(:) = 0.0 ; Kddt_h_itt(:) = 0.0 - endif - do itt=1,max_itt - if (CS%orig_PE_calc) then - call find_PE_chg_orig(Kddt_h_guess, h(k), hp_a, dTe_term, dSe_term, & - dT_km1_t2, dS_km1_t2, dT_to_dPE(k), dS_to_dPE(k), & - dT_to_dPE_a(k-1), dS_to_dPE_a(k-1), & - pres_Z(K), dT_to_dColHt(k), dS_to_dColHt(k), & - dT_to_dColHt_a(k-1), dS_to_dColHt_a(k-1), & - PE_chg=PE_chg, dPEc_dKd=dPEc_dKd ) - else - call find_PE_chg(0.0, Kddt_h_guess, hp_a, h(k), & - Th_a(k-1), Sh_a(k-1), Th_b(k), Sh_b(k), & - dT_to_dPE_a(k-1), dS_to_dPE_a(k-1), dT_to_dPE(k), dS_to_dPE(k), & - pres_Z(K), dT_to_dColHt_a(k-1), dS_to_dColHt_a(k-1), & - dT_to_dColHt(k), dS_to_dColHt(k), & - PE_chg=dPE_conv) - endif - MKE_src = dMKE_max * (1.0 - exp(-MKE2_Hharm * Kddt_h_guess)) - dMKE_src_dK = dMKE_max * MKE2_Hharm * exp(-MKE2_Hharm * Kddt_h_guess) - - TKE_left = tot_TKE + (MKE_src - PE_chg) - if (debug) then - Kddt_h_itt(itt) = Kddt_h_guess ; MKE_src_itt(itt) = MKE_src - PE_chg_itt(itt) = PE_chg - TKE_left_itt(itt) = TKE_left - dPEa_dKd_itt(itt) = dPEc_dKd - endif - ! Store the new bounding values, bearing in mind that min and max - ! here refer to Kddt_h and dTKE_left/dKddt_h < 0: - if (TKE_left >= 0.0) then - Kddt_h_min = Kddt_h_guess ; TKE_left_min = TKE_left - else - Kddt_h_max = Kddt_h_guess ; TKE_left_max = TKE_left - endif - - ! Try to use Newton's method, but if it would go outside the bracketed - ! values use the false-position method instead. - use_Newt = .true. - if (dPEc_dKd - dMKE_src_dK <= 0.0) then - use_Newt = .false. - else - dKddt_h_Newt = TKE_left / (dPEc_dKd - dMKE_src_dK) - Kddt_h_Newt = Kddt_h_guess + dKddt_h_Newt - if ((Kddt_h_Newt > Kddt_h_max) .or. (Kddt_h_Newt < Kddt_h_min)) & - use_Newt = .false. - endif - - if (use_Newt) then - Kddt_h_next = Kddt_h_guess + dKddt_h_Newt - dKddt_h = dKddt_h_Newt - else - Kddt_h_next = (TKE_left_max * Kddt_h_min - Kddt_h_max * TKE_left_min) / & - (TKE_left_max - TKE_left_min) - dKddt_h = Kddt_h_next - Kddt_h_guess - endif - - if ((abs(dKddt_h) < 1e-9*Kddt_h_guess) .or. (itt==max_itt)) then - ! Use the old value so that the energy calculation does not need to be repeated. - if (debug) num_itts(K) = itt - exit - else - Kddt_h_guess = Kddt_h_next - endif - enddo ! Inner iteration loop on itt. - Kd(K) = Kddt_h_guess / dt_h ; Kddt_h(K) = Kd(K)*dt_h - - ! All TKE should have been consumed. - if (CS%TKE_diagnostics) then - eCD%dTKE_mixing = eCD%dTKE_mixing - (tot_TKE + MKE_src) * IdtdR0 - eCD%dTKE_MKE = eCD%dTKE_MKE + MKE_src * IdtdR0 - eCD%dTKE_conv_decay = eCD%dTKE_conv_decay + & - (CS%nstar-nstar_FC) * conv_PErel * IdtdR0 - endif - - if (sfc_connected) MLD_output = MLD_output + & - (PE_chg / PE_chg_g0) * GV%H_to_Z * h(k) - - tot_TKE = 0.0 ; mech_TKE = 0.0 ; conv_PErel = 0.0 - sfc_disconnect = .true. - endif ! End of convective or forced mixing cases to determine Kd. - - Kddt_h(K) = Kd(K)*dt_h - ! At this point, the final value of Kddt_h(K) is known, so the - ! estimated properties for layer k-1 can be calculated. - b1 = 1.0 / (hp_a + Kddt_h(K)) - c1(K) = Kddt_h(K) * b1 - if (CS%orig_PE_calc) then - dTe(k-1) = b1 * ( Kddt_h(K)*(T0(k)-T0(k-1)) + dTe_t2 ) - dSe(k-1) = b1 * ( Kddt_h(K)*(S0(k)-S0(k-1)) + dSe_t2 ) - endif - - hp_a = h(k) + (hp_a * b1) * Kddt_h(K) - dT_to_dPE_a(k) = dT_to_dPE(k) + c1(K)*dT_to_dPE_a(k-1) - dS_to_dPE_a(k) = dS_to_dPE(k) + c1(K)*dS_to_dPE_a(k-1) - dT_to_dColHt_a(k) = dT_to_dColHt(k) + c1(K)*dT_to_dColHt_a(k-1) - dS_to_dColHt_a(k) = dS_to_dColHt(k) + c1(K)*dS_to_dColHt_a(k-1) - - endif ! tot_TKT > 0.0 branch. Kddt_h(K) has been set. - - ! Store integrated velocities and thicknesses for MKE conversion calculations. - if (sfc_disconnect) then - ! There is no turbulence at this interface, so zero out the running sums. - uhtot = u(k)*h(k) - vhtot = v(k)*h(k) - htot = h(k) - sfc_connected = .false. - else - uhtot = uhtot + u(k)*h(k) - vhtot = vhtot + v(k)*h(k) - htot = htot + h(k) - endif - - if (debug) then - if (k==2) then - Te(1) = b1*(h(1)*T0(1)) - Se(1) = b1*(h(1)*S0(1)) - else - Te(k-1) = b1 * (h(k-1) * T0(k-1) + Kddt_h(K-1) * Te(k-2)) - Se(k-1) = b1 * (h(k-1) * S0(k-1) + Kddt_h(K-1) * Se(k-2)) - endif - endif - enddo - Kd(nz+1) = 0.0 - - if (debug) then - ! Complete the tridiagonal solve for Te. - b1 = 1.0 / hp_a - Te(nz) = b1 * (h(nz) * T0(nz) + Kddt_h(nz) * Te(nz-1)) - Se(nz) = b1 * (h(nz) * S0(nz) + Kddt_h(nz) * Se(nz-1)) - eCD%dT_expect(nz) = Te(nz) - T0(nz) ; eCD%dS_expect(nz) = Se(nz) - S0(nz) - do k=nz-1,1,-1 - Te(k) = Te(k) + c1(K+1)*Te(k+1) - Se(k) = Se(k) + c1(K+1)*Se(k+1) - eCD%dT_expect(k) = Te(k) - T0(k) ; eCD%dS_expect(k) = Se(k) - S0(k) - enddo - - dPE_debug = 0.0 - do k=1,nz - dPE_debug = dPE_debug + (dT_to_dPE(k) * (Te(k) - T0(k)) + & - dS_to_dPE(k) * (Se(k) - S0(k))) - enddo - mixing_debug = dPE_debug * IdtdR0 - endif - k = nz ! This is here to allow a breakpoint to be set. - !/BGR - ! The following lines are used for the iteration - ! note the iteration has been altered to use the value predicted by - ! the TKE threshold (ML_DEPTH). This is because the MSTAR - ! is now dependent on the ML, and therefore the ML needs to be estimated - ! more precisely than the grid spacing. - MLD_found = 0.0 ; FIRST_OBL = .true. - if (CS%Orig_MLD_iteration) then - ! This is how the iteration was original conducted - do k=2,nz - if (FIRST_OBL) then ! Breaks when OBL found - if ((Vstar_Used(k) > 1.e-10*US%m_to_Z) .and. k < nz) then - MLD_found = MLD_found + h(k-1)*GV%H_to_Z - else - FIRST_OBL = .false. - if (MLD_found - CS%MLD_tol > MLD_guess) then - min_MLD = MLD_guess - elseif ((MLD_guess - MLD_found) < max(CS%MLD_tol, h(k-1)*GV%H_to_Z)) then - OBL_CONVERGED = .true. ! Break convergence loop - else - max_MLD = MLD_guess ! We know this guess was too deep - endif - endif - endif - enddo - else - !New method uses ML_DEPTH as computed in ePBL routine - MLD_found = MLD_output - if (MLD_found - CS%MLD_tol > MLD_guess) then - min_MLD = MLD_guess - elseif (abs(MLD_guess - MLD_found) < CS%MLD_tol) then - OBL_CONVERGED = .true. ! Break convergence loop - else - max_MLD = MLD_guess ! We know this guess was too deep - endif - endif - ! For next pass, guess average of minimum and maximum values. - MLD_guess = 0.5*(min_MLD + max_MLD) - endif - enddo ! Iteration loop for converged boundary layer thickness. - eCD%LA = LA ; eCD%LAmod = LAmod ; eCD%mstar = mstar_total ; eCD%mstar_LT = mstar_LT ! Copy the diffusivities to a 2-d array. do K=1,nz+1 Kd_2d(i,K) = Kd(K) enddo - CS%ML_depth(i,j) = MLD_output + CS%ML_depth(i,j) = MLD_io if (present(dT_expected)) then do k=1,nz ; dT_expected(i,j,k) = eCD%dT_expect(k) ; enddo @@ -1294,10 +459,10 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS endif ! Write to 3-D for outputing Mixing length and velocity scale. if (CS%id_Mixing_Length>0) then ; do k=1,nz - CS%Mixing_Length(i,j,k) = Mixing_Length_Used(k) + CS%Mixing_Length(i,j,k) = mixlen(k) enddo ; endif if (CS%id_Velocity_Scale>0) then ; do k=1,nz - CS%Velocity_Scale(i,j,k) = Vstar_Used(k) + CS%Velocity_Scale(i,j,k) = mixvel(k) enddo ; endif if (allocated(CS%mstar_mix)) CS%mstar_mix(i,j) = eCD%mstar if (allocated(CS%mstar_lt)) CS%mstar_lt(i,j) = eCD%mstar_LT @@ -1349,10 +514,6 @@ end subroutine energetic_PBL - - - - !> This subroutine determines the diffusivities from the integrated energetics !! mixed layer model for a single column of water. subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, absf, & @@ -1425,7 +586,7 @@ subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, abs ! water column [nondim]. real :: mech_TKE ! The mechanically generated turbulent kinetic energy ! available for mixing over a time step [J m-2 = kg s-2]. - real :: conv_PErel ! The potential energy that has been convectively released + real :: conv_PErel ! The potential energy that has been convectively released ! during this timestep [J m-2 = kg s-2]. A portion nstar_FC ! of conv_PErel is available to drive mixing. real :: htot ! The total depth of the layers above an interface [H ~> m or kg m-2]. @@ -1433,7 +594,6 @@ subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, abs real :: vhtot ! layers above [H m s-1 ~> m2 s-1 or kg m-1 s-1]. real :: Idecay_len_TKE ! The inverse of a turbulence decay length scale [H-1 ~> m-1 or m2 kg-1]. real :: h_sum ! The total thickness of the water column [H ~> m or kg m-2]. -! real :: absf ! The absolute value of f [s-1]. real, dimension(SZK_(GV)) :: & dT_to_dColHt, & ! Partial derivatives of the total column height with the temperature @@ -1444,10 +604,9 @@ subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, abs dS_to_dColHt_a, & ! and salinity changes within a layer, including the implicit effects ! of mixing with layers higher in the water colun [Z degC-1 ~> m degC-1] and [Z ppt-1 ~> m ppt-1]. dT_to_dPE_a, & ! Partial derivatives of column potential energy with the temperature - dS_to_dPE_a ! and salinity changes within a layer, including the implicit effects + dS_to_dPE_a, & ! and salinity changes within a layer, including the implicit effects ! of mixing with layers higher in the water column, in ! units of [J m-2 degC-1] and [J m-2 ppt-1]. - real, dimension(SZK_(GV)) :: & Te, Se, & ! Estimated final values of T and S in the column, in [degC] and [ppt]. c1, & ! c1 is used by the tridiagonal solver [nondim]. dTe, dSe, & ! Running (1-way) estimates of temperature and salinity change. @@ -1495,9 +654,6 @@ subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, abs real :: C1_3 ! = 1/3. real :: I_dtrho ! 1.0 / (dt * Rho0) in [m3 kg-1 s-1]. This is ! used convert TKE back into ustar^3. -! real :: U_star ! The surface friction velocity [Z s-1 ~> m s-1]. -! real :: U_Star_Mean ! The surface friction without gustiness [Z s-1 ~> m s-1]. -! real :: B_Flux ! The surface buoyancy flux [Z2 s-3 ~> m2 s-3] real :: vstar ! An in-situ turbulent velocity [m s-1]. real :: mstar_total ! The value of mstar used in ePBL [nondim] real :: mstar_LT ! An addition to mstar due to Langmuir turbulence [nondim] (output for diagnostic) @@ -1585,8 +741,6 @@ subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, abs ! DEPTH/2^M < DZ ! where M is the number of guesses ! e.g. M=12 for DEPTH=4000m and DZ=1m -! real, dimension(SZK_(GV)+1) :: Vstar_Used, & ! 1D arrays used to store -! Mixing_Length_Used ! Vstar and Mixing_Length real :: Surface_Scale ! Surface decay scale for vstar @@ -2000,7 +1154,7 @@ subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, abs mixlen(K) = max(CS%min_mix_len, ((h_tt*hbs_here)*vstar) / & ((CS%Ekman_scale_coef * absf) * (h_tt*hbs_here) + vstar)) if (.not.CS%Use_MLD_Iteration) then - ! Note again (as prev) that using Mixing_Length_Used here + ! Note again (as prev) that using mixlen here ! instead of redoing the computation will change answers... Kd(K) = vstar * CS%vonKar * ((h_tt*hbs_here)*vstar) / & ((CS%Ekman_scale_coef * absf) * (h_tt*hbs_here) + vstar) From ef55110c238eac3945e9465690cce3424a0efbdf Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Mon, 17 Jun 2019 14:08:12 -0400 Subject: [PATCH 20/82] Add dimensional consistency testing to ePBL_column Do dimensional consistency testing for depth and time units in ePBL_column. Also modified comments to reflect the rescaled dimensions. All answers are bitwise identical. --- .../vertical/MOM_energetic_PBL.F90 | 443 +++++++++--------- 1 file changed, 231 insertions(+), 212 deletions(-) diff --git a/src/parameterizations/vertical/MOM_energetic_PBL.F90 b/src/parameterizations/vertical/MOM_energetic_PBL.F90 index 04ace1257d..63aa4cc10d 100644 --- a/src/parameterizations/vertical/MOM_energetic_PBL.F90 +++ b/src/parameterizations/vertical/MOM_energetic_PBL.F90 @@ -39,7 +39,7 @@ module MOM_energetic_PBL real :: omega !< The Earth's rotation rate [s-1]. real :: omega_frac !< When setting the decay scale for turbulence, use this fraction of !! the absolute rotation rate blended with the local value of f, as - !! sqrt((1-of)*f^2 + of*4*omega^2). + !! sqrt((1-of)*f^2 + of*4*omega^2) [nondim]. !/ Convection related terms real :: nstar !< The fraction of the TKE input to the mixed layer available to drive @@ -58,10 +58,10 @@ module MOM_energetic_PBL real :: MKE_to_TKE_effic !< The efficiency with which mean kinetic energy released by !! mechanically forced entrainment of the mixed layer is converted to !! TKE [nondim]. - real :: ustar_min !< A minimum value of ustar to avoid numerical problems [m s-1]. + real :: ustar_min !< A minimum value of ustar to avoid numerical problems [Z s-1 ~> m s-1]. !! If the value is small enough, this should not affect the solution. real :: Ekman_scale_coef !< A nondimensional scaling factor controlling the inhibition of the - !! diffusive length scale by rotation. Making this larger decreases + !! diffusive length scale by rotation. Making this larger decreases !! the diffusivity in the planetary boundary layer. real :: transLay_scale !< A scale for the mixing length in the transition layer !! at the edge of the boundary layer as a fraction of the @@ -82,9 +82,10 @@ module MOM_energetic_PBL !! mechanically forced turbulent kinetic energy [nondim]. !! Making this larger increases the diffusivity. real :: vstar_surf_fac !< If (wT_mode == 1) this is the proportionality coefficient between - !! ustar and the surface mechanical contribution to vstar + !! ustar and the surface mechanical contribution to vstar [nondim] real :: vstar_scale_fac !< An overall nondimensional scaling factor for vstar times a unit - !! conversion factor. Making this larger increases the diffusivity. + !! conversion factor [Z s T-1 m-1 ~> nondim]. Making this larger increases + !! the diffusivity. !mstar related options integer :: MStar_mode = 0 !< An coded integer to determine which formula is used to set mstar @@ -162,15 +163,16 @@ module MOM_energetic_PBL real, allocatable, dimension(:,:) :: & ML_depth !< The mixed layer depth determined by active mixing in ePBL [Z ~> m]. - ! These are terms in the mixed layer TKE budget, all in [J m-2] = [kg s-2]. + ! These are terms in the mixed layer TKE budget, all in [kg m-3 Z3 T-2 ~> J m-2] = [kg s-2]. real, allocatable, dimension(:,:) :: & - diag_TKE_wind, & !< The wind source of TKE [J m-2]. - diag_TKE_MKE, & !< The resolved KE source of TKE [J m-2]. - diag_TKE_conv, & !< The convective source of TKE [J m-2]. - diag_TKE_forcing, & !< The TKE sink required to mix surface penetrating shortwave heating [J m-2]. - diag_TKE_mech_decay, & !< The decay of mechanical TKE [J m-2]. - diag_TKE_conv_decay, & !< The decay of convective TKE [J m-2]. - diag_TKE_mixing, & !< The work done by TKE to deepen the mixed layer [J m-2]. + diag_TKE_wind, & !< The wind source of TKE [kg m-3 Z3 T-3 ~> W m-2]. + diag_TKE_MKE, & !< The resolved KE source of TKE [kg m-3 Z3 T-3 ~> W m-2]. + diag_TKE_conv, & !< The convective source of TKE [kg m-3 Z3 T-3 ~> W m-2]. + diag_TKE_forcing, & !< The TKE sink required to mix surface penetrating shortwave heating + !! [kg m-3 Z3 T-2 ~> W m-2]. + diag_TKE_mech_decay, & !< The decay of mechanical TKE [kg m-3 Z3 T-3 ~> W m-2]. + diag_TKE_conv_decay, & !< The decay of convective TKE [kg m-3 Z3 T-3 ~> W m-2]. + diag_TKE_mixing, & !< The work done by TKE to deepen the mixed layer [kg m-3 Z3 T-3 ~> W m-2]. ! These additional diagnostics are also 2d. MSTAR_MIX, & !< Mstar used in EPBL [nondim] MSTAR_LT, & !< Mstar due to Langmuir turbulence [nondim] @@ -198,7 +200,7 @@ module MOM_energetic_PBL !> A type for conveniently passing around ePBL diagnostics for a column. type, public :: ePBL_column_diags ; private - !>@{ Local column copies of energy change diagnostics, all in [J m-2]. + !>@{ Local column copies of energy change diagnostics, all in [kg m-3 Z3 T-3 ~> W m-2]. real :: dTKE_conv, dTKE_forcing, dTKE_wind, dTKE_mixing real :: dTKE_MKE, dTKE_mech_decay, dTKE_conv_decay !!@} @@ -300,33 +302,33 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS h_2d, & ! A 2-d slice of the layer thickness [H ~> m or kg m-2]. T_2d, & ! A 2-d slice of the layer temperatures [degC]. S_2d, & ! A 2-d slice of the layer salinities [ppt]. - TKE_forced_2d, & ! A 2-d slice of TKE_forced [J m-2]. + TKE_forced_2d, & ! A 2-d slice of TKE_forced [kg m-3 Z3 T-2 ~> J m-2]. dSV_dT_2d, & ! A 2-d slice of dSV_dT [m3 kg-1 degC-1]. dSV_dS_2d, & ! A 2-d slice of dSV_dS [m3 kg-1 ppt-1]. u_2d, & ! A 2-d slice of the zonal velocity [m s-1]. v_2d ! A 2-d slice of the meridional velocity [m s-1]. real, dimension(SZI_(G),SZK_(GV)+1) :: & - Kd_2d ! A 2-d version of the diapycnal diffusivity [Z2 s-1 ~> m2 s-1]. + Kd_2d ! A 2-d version of the diapycnal diffusivity [Z2 T-1 ~> m2 s-1]. real, dimension(SZK_(GV)) :: & h, & ! The layer thickness [H ~> m or kg m-2]. T0, & ! The initial layer temperatures [degC]. S0, & ! The initial layer salinities [ppt]. dSV_dT_1d, & ! The partial derivatives of specific volume with temperature [m3 kg-1 degC-1]. dSV_dS_1d, & ! The partial derivatives of specific volume with salinity [m3 kg-1 ppt-1]. - TKE_forcing, & ! Forcing of the TKE in the layer coming from TKE_forced [J m-2]. + TKE_forcing, & ! Forcing of the TKE in the layer coming from TKE_forced [kg m-3 Z3 T-2 ~> J m-2]. u, & ! The zonal velocity [m s-1]. v ! The meridional velocity [m s-1]. real, dimension(SZK_(GV)+1) :: & - Kd, & ! The diapycnal diffusivity [Z2 s-1 ~> m2 s-1]. - mixvel, & ! A turbulent mixing veloxity [Z s-1 ~> m s-1]. + Kd, & ! The diapycnal diffusivity [Z2 T-1 ~> m2 s-1]. + mixvel, & ! A turbulent mixing veloxity [Z T-1 ~> m s-1]. mixlen ! A turbulent mixing length [Z ~> m]. real :: h_neglect ! A thickness that is so small it is usually lost ! in roundoff and can be neglected [H ~> m or kg m-2]. - real :: absf ! The absolute value of f [s-1]. - real :: U_star ! The surface friction velocity [Z s-1 ~> m s-1]. - real :: U_Star_Mean ! The surface friction without gustiness [Z s-1 ~> m s-1]. - real :: B_Flux ! The surface buoyancy flux [Z2 s-3 ~> m2 s-3] + real :: absf ! The absolute value of f [T-1]. + real :: U_star ! The surface friction velocity [Z T-1 ~> m s-1]. + real :: U_Star_Mean ! The surface friction without gustiness [Z T-1 ~> m s-1]. + real :: B_Flux ! The surface buoyancy flux [Z2 T-3 ~> m2 s-3] real :: MLD_io ! The mixed layer depth found by ePBL_column [Z ~> m]. ! The following are only used for diagnostics. @@ -386,7 +388,8 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS ! Copy the thicknesses and other fields to 2-d arrays. do k=1,nz ; do i=is,ie 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) - T_2d(i,k) = tv%T(i,j,k) ; S_2d(i,k) = tv%S(i,j,k) ; TKE_forced_2d(i,k) = TKE_forced(i,j,k) + T_2d(i,k) = tv%T(i,j,k) ; S_2d(i,k) = tv%S(i,j,k) + TKE_forced_2d(i,k) = (US%m_to_Z**3 * US%T_to_s**2) * TKE_forced(i,j,k) dSV_dT_2d(i,k) = dSV_dT(i,j,k) ; dSV_dS_2d(i,k) = dSV_dS(i,j,k) enddo ; enddo @@ -407,20 +410,20 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS do K=1,nz+1 ; Kd(K) = 0.0 ; enddo ! Make local copies of surface forcing and process them. - U_star = fluxes%ustar(i,j) - U_Star_Mean = fluxes%ustar_gustless(i,j) - B_Flux = buoy_flux(i,j) + u_star = US%T_to_s*fluxes%ustar(i,j) + u_star_Mean = US%T_to_s*fluxes%ustar_gustless(i,j) + B_flux = US%T_to_s**3*buoy_flux(i,j) if (associated(fluxes%ustar_shelf) .and. associated(fluxes%frac_shelf_h)) then if (fluxes%frac_shelf_h(i,j) > 0.0) & - U_star = (1.0 - fluxes%frac_shelf_h(i,j)) * U_star + & - fluxes%frac_shelf_h(i,j) * fluxes%ustar_shelf(i,j) + u_star = (1.0 - fluxes%frac_shelf_h(i,j)) * u_star + & + fluxes%frac_shelf_h(i,j) * US%T_to_s*fluxes%ustar_shelf(i,j) endif - if (U_Star < CS%ustar_min) U_Star = CS%ustar_min + if (u_star < CS%ustar_min) u_star = CS%ustar_min if (CS%omega_frac >= 1.0) then absf = 2.0*CS%omega else - absf = 0.25*US%s_to_T*((abs(G%CoriolisBu(I,J)) + abs(G%CoriolisBu(I-1,J-1))) + & - (abs(G%CoriolisBu(I,J-1)) + abs(G%CoriolisBu(I-1,J)))) + absf = 0.25*((abs(G%CoriolisBu(I,J)) + abs(G%CoriolisBu(I-1,J-1))) + & + (abs(G%CoriolisBu(I,J-1)) + abs(G%CoriolisBu(I-1,J)))) if (CS%omega_frac > 0.0) & absf = sqrt(CS%omega_frac*4.0*CS%omega**2 + (1.0-CS%omega_frac)*absf**2) endif @@ -430,7 +433,7 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS if (CS%MLD_iteration_guess .and. (CS%ML_Depth(i,j) > 0.0)) MLD_io = CS%ML_Depth(i,j) call ePBL_column(h, u, v, T0, S0, dSV_dT_1d, dSV_dS_1d, TKE_forcing, B_flux, absf, & - u_star, u_star_mean, dt, MLD_io, Kd, mixvel, mixlen, GV, & + u_star, u_star_mean, dt*US%s_to_T, MLD_io, Kd, mixvel, mixlen, GV, & US, CS, eCD, dt_diag=dt_diag, Waves=Waves, G=G, i=i, j=j) @@ -462,7 +465,7 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS CS%Mixing_Length(i,j,k) = mixlen(k) enddo ; endif if (CS%id_Velocity_Scale>0) then ; do k=1,nz - CS%Velocity_Scale(i,j,k) = mixvel(k) + CS%Velocity_Scale(i,j,k) = US%s_to_T * mixvel(k) enddo ; endif if (allocated(CS%mstar_mix)) CS%mstar_mix(i,j) = eCD%mstar if (allocated(CS%mstar_lt)) CS%mstar_lt(i,j) = eCD%mstar_LT @@ -484,7 +487,7 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS endif ; enddo ! Close of i-loop - Note unusual loop order! do K=1,nz+1 ; do i=is,ie - Kd_int(i,j,K) = Kd_2d(i,K) + Kd_int(i,j,K) = US%s_to_T * Kd_2d(i,K) enddo ; enddo enddo ! j-loop @@ -535,15 +538,16 @@ subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, abs real, dimension(SZK_(GV)), intent(in) :: dSV_dS !< The partial derivative of in-situ specific !! volume with salinity [m3 kg-1 ppt-1]. real, dimension(SZK_(GV)), intent(in) :: TKE_forcing !< The forcing requirements to homogenize the - !! forcing that has been applied to each layer [J m-2]. - real, intent(in) :: B_flux !< The surface buoyancy flux [Z2 s-3 ~> m2 s-3] - real, intent(in) :: absf !< The absolute value of the Coriolis parameter [s-1]. - real, intent(in) :: u_star !< The surface friction velocity [Z s-1 ~> m s-1]. + !! forcing that has been applied to each layer + !! [kg m-3 Z3 T-2 ~> J m-2]. + real, intent(in) :: B_flux !< The surface buoyancy flux [Z2 T-3 ~> m2 s-3] + real, intent(in) :: absf !< The absolute value of the Coriolis parameter [T-1]. + real, intent(in) :: u_star !< The surface friction velocity [Z T-1 ~> m s-1]. real, intent(in) :: u_star_mean !< The surface friction velocity without any - !! contribution from unresolved gustiness [Z s-1 ~> m s-1]. + !! contribution from unresolved gustiness [Z T-1 ~> m s-1]. real, intent(inout) :: MLD_io !< A first guess at the mixed layer depth on input, and !! the calculated mixed layer depth on output [Z ~> m]. - real, intent(in) :: dt !< Time increment [s]. + real, intent(in) :: dt !< Time increment [T ~> s]. real, dimension(SZK_(GV)+1), & intent(out) :: Kd !< The diagnosed diffusivities at interfaces !! [Z2 s-1 ~> m2 s-1]. @@ -585,9 +589,9 @@ subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, abs hb_hs ! The distance from the bottom over the thickness of the ! water column [nondim]. real :: mech_TKE ! The mechanically generated turbulent kinetic energy - ! available for mixing over a time step [J m-2 = kg s-2]. + ! available for mixing over a time step [kg m-3 Z3 T-2 ~> J m-2]. real :: conv_PErel ! The potential energy that has been convectively released - ! during this timestep [J m-2 = kg s-2]. A portion nstar_FC + ! during this timestep [kg m-3 Z3 T-2 ~> J m-2]. A portion nstar_FC ! of conv_PErel is available to drive mixing. real :: htot ! The total depth of the layers above an interface [H ~> m or kg m-2]. real :: uhtot ! The depth integrated zonal and meridional velocities in the @@ -596,20 +600,31 @@ subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, abs real :: h_sum ! The total thickness of the water column [H ~> m or kg m-2]. real, dimension(SZK_(GV)) :: & - dT_to_dColHt, & ! Partial derivatives of the total column height with the temperature - dS_to_dColHt, & ! and salinity changes within a layer [Z degC-1 ~> m degC-1] and [Z ppt-1 ~> m ppt-1]. + dT_to_dColHt, & ! Partial derivative of the total column height with the temperature changes + ! within a layer [Z degC-1 ~> m degC-1]. + dS_to_dColHt, & ! Partial derivative of the total column height with the salinity changes + ! within a layer [Z ppt-1 ~> m ppt-1]. dT_to_dPE, & ! Partial derivatives of column potential energy with the temperature - dS_to_dPE, & ! and salinity changes within a layer, in [J m-2 degC-1] and [J m-2 ppt-1]. - dT_to_dColHt_a, & ! Partial derivatives of the total column height with the temperature - dS_to_dColHt_a, & ! and salinity changes within a layer, including the implicit effects - ! of mixing with layers higher in the water colun [Z degC-1 ~> m degC-1] and [Z ppt-1 ~> m ppt-1]. - dT_to_dPE_a, & ! Partial derivatives of column potential energy with the temperature - dS_to_dPE_a, & ! and salinity changes within a layer, including the implicit effects - ! of mixing with layers higher in the water column, in - ! units of [J m-2 degC-1] and [J m-2 ppt-1]. - Te, Se, & ! Estimated final values of T and S in the column, in [degC] and [ppt]. + ! changes within a layer, in [kg m-3 Z3 T-2 degC-1 ~> J m-2 degC-1]. + dS_to_dPE, & ! Partial derivatives of column potential energy with the salinity changes + ! within a layer, in [kg m-3 Z3 T-2 ppt-1 ~> J m-2 ppt-1]. + dT_to_dColHt_a, & ! Partial derivative of the total column height with the temperature changes + ! within a layer, including the implicit effects of mixing with layers higher + ! in the water column [Z degC-1 ~> m degC-1]. + dS_to_dColHt_a, & ! Partial derivative of the total column height with the salinity changes + ! within a layer, including the implicit effects of mixing with layers higher + ! in the water column [Z ppt-1 ~> m ppt-1]. + dT_to_dPE_a, & ! Partial derivatives of column potential energy with the temperature changes + ! within a layer, including the implicit effects of mixing with layers higher + ! in the water column [kg m-3 Z3 T-2 degC-1 ~> J m-2 degC-1]. + dS_to_dPE_a, & ! Partial derivative of column potential energy with the salinity changes + ! within a layer, including the implicit effects of mixing with layers higher + ! in the water column [kg m-3 Z3 T-2 ppt-1 ~> J m-2 ppt-1]. c1, & ! c1 is used by the tridiagonal solver [nondim]. - dTe, dSe, & ! Running (1-way) estimates of temperature and salinity change. + Te, & ! Estimated final values of T in the column [degC]. + Se, & ! Estimated final values of S in the column [ppt]. + dTe, & ! Running (1-way) estimates of temperature change [degC]. + dSe, & ! Running (1-way) estimates of salinity change [ppt]. Th_a, & ! An effective temperature times a thickness in the layer above, including implicit ! mixing effects with other yet higher layers [degC H ~> degC m or degC kg m-2]. Sh_a, & ! An effective salinity times a thickness in the layer above, including implicit @@ -635,7 +650,7 @@ subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, abs real :: dMKE_max ! The maximum amount of mean kinetic energy that could be ! converted to turbulent kinetic energy if the velocity in ! the layer below an interface were homogenized with all of - ! the water above the interface [J m-2 = kg s-2]. + ! the water above the interface [kg m-3 Z3 T-2 ~> J m-2]. real :: MKE2_Hharm ! Twice the inverse of the harmonic mean of the thickness ! of a layer and the thickness of the water above, used in ! the MKE conversion equation [H-1 ~> m-1 or m2 kg-1]. @@ -652,9 +667,9 @@ subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, abs real :: h_tt_min ! A surface roughness length [H ~> m or kg m-2]. real :: C1_3 ! = 1/3. - real :: I_dtrho ! 1.0 / (dt * Rho0) in [m3 kg-1 s-1]. This is - ! used convert TKE back into ustar^3. - real :: vstar ! An in-situ turbulent velocity [m s-1]. + real :: I_dtrho ! 1.0 / (dt * Rho0) times conversion factors in [m6 Z-3 kg-1 T2 s-3 ~> m3 kg-1 s-1]. + ! This is used convert TKE back into ustar^3. + real :: vstar ! An in-situ turbulent velocity [Z T-1 ~> m s-1]. real :: mstar_total ! The value of mstar used in ePBL [nondim] real :: mstar_LT ! An addition to mstar due to Langmuir turbulence [nondim] (output for diagnostic) real :: MLD_output ! The mixed layer depth output from this routine [Z ~> m]. @@ -665,8 +680,8 @@ subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, abs real :: nstar_FC ! The fraction of conv_PErel that can be converted to mixing [nondim]. real :: TKE_reduc ! The fraction by which TKE and other energy fields are ! reduced to support mixing [nondim]. between 0 and 1. - real :: tot_TKE ! The total TKE available to support mixing at interface K [J m-2]. - real :: TKE_here ! The total TKE at this point in the algorithm [J m-2]. + real :: tot_TKE ! The total TKE available to support mixing at interface K [kg m-3 Z3 T-2 ~> J m-2]. + real :: TKE_here ! The total TKE at this point in the algorithm [kg m-3 Z3 T-2 ~> J m-2]. real :: dT_km1_t2 ! A diffusivity-independent term related to the temperature ! change in the layer above the interface [degC]. real :: dS_km1_t2 ! A diffusivity-independent term related to the salinity @@ -677,24 +692,24 @@ subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, abs ! change in the layer above the interface [ppt H ~> ppt m or ppt kg m-2]. real :: dTe_t2 ! A part of dTe_term [degC H ~> degC m or degC kg m-2]. real :: dSe_t2 ! A part of dSe_term [ppt H ~> ppt m or ppt kg m-2]. - real :: dPE_conv ! The convective change in column potential energy [J m-2]. - real :: MKE_src ! The mean kinetic energy source of TKE due to Kddt_h(K) [J m-2]. - real :: dMKE_src_dK ! The partial derivative of MKE_src with Kddt_h(K) [J m-2 H-1 ~> J m-3 or J kg-1]. - real :: Kd_guess0 ! A first guess of the diapycnal diffusivity [Z2 s-1 ~> m2 s-1]. - real :: PE_chg_g0 ! The potential energy change when Kd is Kd_guess0 [J m-2] + real :: dPE_conv ! The convective change in column potential energy [kg m-3 Z3 T-2 ~> J m-2]. + real :: MKE_src ! The mean kinetic energy source of TKE due to Kddt_h(K) [kg m-3 Z3 T-2 ~> J m-2]. + 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]. + real :: Kd_guess0 ! A first guess of the diapycnal diffusivity [Z2 T-1 ~> m2 s-1]. + real :: PE_chg_g0 ! The potential energy change when Kd is Kd_guess0 [kg m-3 Z3 T-2 ~> J m-2] real :: dPEa_dKd_g0 real :: Kddt_h_g0 ! The first guess diapycnal diffusivity times a timestep divided ! by the average thicknesses around a layer [H ~> m or kg m-2]. - real :: PE_chg_max ! The maximum PE change for very large values of Kddt_h(K). + 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]. real :: dPEc_dKd_Kd0 ! The partial derivative of PE change with Kddt_h(K) - ! for very small values of Kddt_h(K) [J m-2 H-1 ~> J m-3 or J kg-1]. + ! for very small values of Kddt_h(K) [kg m-3 Z3 T-2 H-1 ~> J m-3 or J kg-1]. real :: PE_chg ! The change in potential energy due to mixing at an - ! interface [J m-2], positive for the column increasing + ! interface [kg m-3 Z3 T-2 ~> J m-2], positive for the column increasing ! in potential energy (i.e., consuming TKE). real :: TKE_left ! The amount of turbulent kinetic energy left for the most - ! recent guess at Kddt_h(K) [J m-2]. + ! recent guess at Kddt_h(K) [kg m-3 Z3 T-2 ~> J m-2]. 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]. - real :: TKE_left_min, TKE_left_max ! Maximum and minimum values of TKE_left [J m-2]. + real :: TKE_left_min, TKE_left_max ! Maximum and minimum values of TKE_left [kg m-3 Z3 T-2 ~> J m-2]. real :: Kddt_h_max, Kddt_h_min ! Maximum and minimum values of Kddt_h(K) [H ~> m or kg m-2]. real :: Kddt_h_guess ! A guess at the value of Kddt_h(K) [H ~> m or kg m-2]. real :: Kddt_h_next ! The next guess at the value of Kddt_h(K) [H ~> m or kg m-2]. @@ -702,6 +717,7 @@ subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, abs real :: dKddt_h_Newt ! The change between guesses at Kddt_h(K) with Newton's method [H ~> m or kg m-2]. real :: Kddt_h_newt ! The Newton's method next guess for Kddt_h(K) [H ~> m or kg m-2]. real :: exp_kh ! The nondimensional decay of TKE across a layer [nondim]. + real :: vstar_unit_scale ! A unit converion factor for turbulent velocities [Z T-1 s m-1 ~> 1] logical :: use_Newt ! Use Newton's method for the next guess at Kddt_h(K). logical :: convectively_stable ! If true the water column is convectively stable at this interface. logical :: sfc_connected ! If true the ocean is actively turbulent from the present @@ -710,8 +726,8 @@ subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, abs ! from the surface. ! The following are only used for diagnostics. - real :: dt__diag ! A copy of dt_diag (if present) or dt [s]. - real :: IdtdR0 ! = 1.0 / (dt__diag * Rho0) [m3 kg-1 s-1]. + real :: dt__diag ! A copy of dt_diag (if present) or dt [T]. + real :: I_dtdiag ! = 1.0 / dt__diag [T-1 ~> s-1]. !---------------------------------------------------------------------- !/BGR added Aug24,2016 for adding iteration to get boundary layer depth @@ -765,12 +781,13 @@ subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, abs if (.not.CS%Use_MLD_Iteration) MAX_OBL_IT=1 C1_3 = 1.0 / 3.0 - dt__diag = dt ; if (present(dt_diag)) dt__diag = dt_diag - IdtdR0 = 1.0 / (dt__diag * GV%Rho0) + dt__diag = dt ; if (present(dt_diag)) dt__diag = dt_diag * US%s_to_T + I_dtdiag = 1.0 / dt__diag max_itt = 20 h_tt_min = 0.0 - I_dtrho = 0.0 ; if (dt*GV%Rho0 > 0.0) I_dtrho = 1.0 / (dt*GV%Rho0) + 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) + vstar_unit_scale = US%m_to_Z * US%T_to_s MLD_guess = MLD_io @@ -787,7 +804,7 @@ subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, abs pres_Z(1) = 0.0 do k=1,nz dMass = GV%H_to_kg_m2 * h(k) - dPres = (GV%g_Earth*US%m_to_Z) * dMass ! This is equivalent to GV%H_to_Pa * h(k) + dPres = (US%m_to_Z**3*US%T_to_s**2) * (GV%g_Earth*US%m_to_Z) * dMass ! Equivalent to GV%H_to_Pa * h(k) dT_to_dPE(k) = (dMass * (pres(K) + 0.5*dPres)) * dSV_dT(k) dS_to_dPE(k) = (dMass * (pres(K) + 0.5*dPres)) * dSV_dS(k) dT_to_dColHt(k) = dMass * US%m_to_Z * dSV_dT(k) @@ -835,35 +852,34 @@ subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, abs MLD_output = h(1)*GV%H_to_Z sfc_connected = .true. - !/ Here we get MStar, which is the ratio of convective TKE driven - ! mixing to UStar**3 + !/ Here we get MStar, which is the ratio of convective TKE driven mixing to UStar**3 if (CS%Use_LT) then - call get_Langmuir_Number(LA, G, GV, US, abs(MLD_guess), u_star_mean, i, j, & + call get_Langmuir_Number(LA, G, GV, US, abs(MLD_guess), US%s_to_T*u_star_mean, i, j, & H=h, U_H=u, V_H=v, Waves=Waves) - call find_mstar(CS, US, b_flux, U_Star, U_Star_Mean, MLD_Guess, absf, & + call find_mstar(CS, US, B_flux, u_star, u_star_Mean, MLD_Guess, absf, & MStar_total, Langmuir_Number=La, Convect_Langmuir_Number=LAmod,& mstar_LT=mstar_LT) else - call find_mstar(CS, US, b_flux, u_star, u_star_mean, MLD_guess, absf, mstar_total) + call find_mstar(CS, US, B_flux, u_star, u_star_mean, MLD_guess, absf, mstar_total) endif !/ Apply MStar to get mech_TKE if ((CS%answers_2018) .and. (CS%mstar_mode==0)) then - mech_TKE = (dt*MSTAR_total*GV%Rho0) * US%Z_to_m**3 * U_star**3 + mech_TKE = (dt*MSTAR_total*GV%Rho0) * u_star**3 else - mech_TKE = MSTAR_total * US%Z_to_m**3 * (dt*GV%Rho0*U_star**3) + mech_TKE = MSTAR_total * (dt*GV%Rho0* u_star**3) endif if (CS%TKE_diagnostics) then eCD%dTKE_conv = 0.0 ; eCD%dTKE_mixing = 0.0 eCD%dTKE_MKE = 0.0 ; eCD%dTKE_mech_decay = 0.0 ; eCD%dTKE_conv_decay = 0.0 - eCD%dTKE_wind = mech_TKE * IdtdR0 + eCD%dTKE_wind = mech_TKE * I_dtdiag if (TKE_forcing(1) <= 0.0) then - eCD%dTKE_forcing = max(-mech_TKE, TKE_forcing(1)) * IdtdR0 - ! eCD%dTKE_unbalanced = min(0.0, TKE_forcing(1) + mech_TKE) * IdtdR0 + eCD%dTKE_forcing = max(-mech_TKE, TKE_forcing(1)) * I_dtdiag + ! eCD%dTKE_unbalanced = min(0.0, TKE_forcing(1) + mech_TKE) * I_dtdiag else - eCD%dTKE_forcing = CS%nstar*TKE_forcing(1) * IdtdR0 + eCD%dTKE_forcing = CS%nstar*TKE_forcing(1) * I_dtdiag ! eCD%dTKE_unbalanced = 0.0 endif endif @@ -930,11 +946,11 @@ subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, abs ! different rates. The following form is often used for mechanical ! stirring from the surface, perhaps due to breaking surface gravity ! waves and wind-driven turbulence. - Idecay_len_TKE = (CS%TKE_decay * absf / U_star) * GV%H_to_Z + Idecay_len_TKE = (CS%TKE_decay * absf / u_star) * GV%H_to_Z exp_kh = 1.0 if (Idecay_len_TKE > 0.0) exp_kh = exp(-h(k-1)*Idecay_len_TKE) if (CS%TKE_diagnostics) & - eCD%dTKE_mech_decay = eCD%dTKE_mech_decay + (exp_kh-1.0) * mech_TKE * IdtdR0 + eCD%dTKE_mech_decay = eCD%dTKE_mech_decay + (exp_kh-1.0) * mech_TKE * I_dtdiag mech_TKE = mech_TKE * exp_kh ! Accumulate any convectively released potential energy to contribute @@ -942,7 +958,7 @@ subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, abs if (TKE_forcing(k) > 0.0) then conv_PErel = conv_PErel + TKE_forcing(k) if (CS%TKE_diagnostics) & - eCD%dTKE_forcing = eCD%dTKE_forcing + CS%nstar*TKE_forcing(k) * IdtdR0 + eCD%dTKE_forcing = eCD%dTKE_forcing + CS%nstar*TKE_forcing(k) * I_dtdiag endif if (debug) then @@ -956,7 +972,7 @@ subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, abs ! on a curve fit from the data of Wang (GRL, 2003). ! Note: Ro = 1.0 / sqrt(0.5 * dt * Rho0 * (absf*htot)**3 / conv_PErel) nstar_FC = CS%nstar * conv_PErel / (conv_PErel + 0.2 * & - sqrt(0.5 * dt * GV%Rho0 * (absf*(htot*GV%H_to_m))**3 * conv_PErel)) + sqrt(0.5 * dt * GV%Rho0 * (absf*(htot*GV%H_to_Z))**3 * conv_PErel)) endif if (debug) nstar_k(K) = nstar_FC @@ -969,21 +985,20 @@ subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, abs if (TKE_forcing(k) + tot_TKE < 0.0) then ! The shortwave requirements deplete all the energy in this layer. if (CS%TKE_diagnostics) then - eCD%dTKE_mixing = eCD%dTKE_mixing + tot_TKE * IdtdR0 - eCD%dTKE_forcing = eCD%dTKE_forcing - tot_TKE * IdtdR0 - ! eCD%dTKE_unbalanced = eCD%dTKE_unbalanced + (TKE_forcing(k) + tot_TKE) * IdtdR0 - eCD%dTKE_conv_decay = eCD%dTKE_conv_decay + & - (CS%nstar-nstar_FC) * conv_PErel * IdtdR0 + eCD%dTKE_mixing = eCD%dTKE_mixing + tot_TKE * I_dtdiag + eCD%dTKE_forcing = eCD%dTKE_forcing - tot_TKE * I_dtdiag + ! eCD%dTKE_unbalanced = eCD%dTKE_unbalanced + (TKE_forcing(k) + tot_TKE) * I_dtdiag + eCD%dTKE_conv_decay = eCD%dTKE_conv_decay + (CS%nstar-nstar_FC) * conv_PErel * I_dtdiag endif tot_TKE = 0.0 ; mech_TKE = 0.0 ; conv_PErel = 0.0 else ! Reduce the mechanical and convective TKE proportionately. TKE_reduc = (tot_TKE + TKE_forcing(k)) / tot_TKE if (CS%TKE_diagnostics) then - eCD%dTKE_mixing = eCD%dTKE_mixing - TKE_forcing(k) * IdtdR0 - eCD%dTKE_forcing = eCD%dTKE_forcing + TKE_forcing(k) * IdtdR0 + eCD%dTKE_mixing = eCD%dTKE_mixing - TKE_forcing(k) * I_dtdiag + eCD%dTKE_forcing = eCD%dTKE_forcing + TKE_forcing(k) * I_dtdiag eCD%dTKE_conv_decay = eCD%dTKE_conv_decay + & - (1.0-TKE_reduc)*(CS%nstar-nstar_FC) * conv_PErel * IdtdR0 + (1.0-TKE_reduc)*(CS%nstar-nstar_FC) * conv_PErel * I_dtdiag endif tot_TKE = TKE_reduc*tot_TKE ! = tot_TKE + TKE_forcing(k) mech_TKE = TKE_reduc*mech_TKE @@ -1072,7 +1087,7 @@ subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, abs if ((CS%MKE_to_TKE_effic > 0.0) .and. (htot*h(k) > 0.0)) then ! This is the energy that would be available from homogenizing the ! velocities between layer k and the layers above. - dMKE_max = (GV%H_to_kg_m2 * CS%MKE_to_TKE_effic) * 0.5 * & + dMKE_max = (US%m_to_Z**3*US%T_to_s**2)*(GV%H_to_kg_m2 * CS%MKE_to_TKE_effic) * 0.5 * & (h(k) / ((htot + h(k))*htot)) * & ((uhtot-u(k)*htot)**2 + (vhtot-v(k)*htot)**2) ! A fraction (1-exp(Kddt_h*MKE2_Hharm)) of this energy would be @@ -1091,12 +1106,11 @@ subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, abs TKE_here = mech_TKE + CS%wstar_ustar_coef*conv_PErel if (TKE_here > 0.0) then if (CS%wT_mode==0) then - vstar = CS%vstar_scale_fac * (I_dtrho*TKE_here)**C1_3 + vstar = CS%vstar_scale_fac * vstar_unit_scale * (I_dtrho*TKE_here)**C1_3 elseif (CS%wT_mode==1) then Surface_Scale = max(0.05, 1.0 - htot/MLD_guess) - vstar = CS%vstar_scale_fac * (CS%vstar_surf_fac*U_Star + & - (CS%wstar_ustar_coef*conv_PErel*I_dtrho)**C1_3)* & - Surface_Scale + vstar = CS%vstar_scale_fac * Surface_Scale * (CS%vstar_surf_fac*u_star + & + vstar_unit_scale * (CS%wstar_ustar_coef*conv_PErel*I_dtrho)**C1_3) endif hbs_here = GV%H_to_Z * min(hb_hs(K), MixLen_shape(K)) mixlen(K) = MAX(CS%min_mix_len, ((h_tt*hbs_here)*vstar) / & @@ -1113,7 +1127,7 @@ subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, abs vstar = 0.0 ; Kd_guess0 = 0.0 endif mixvel(K) = vstar ! Track vstar - Kddt_h_g0 = Kd_guess0*dt_h + Kddt_h_g0 = Kd_guess0 * dt_h if (CS%orig_PE_calc) then call find_PE_chg_orig(Kddt_h_g0, h(k), hp_a, dTe_term, dSe_term, & @@ -1143,12 +1157,11 @@ subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, abs TKE_here = mech_TKE + CS%wstar_ustar_coef*(conv_PErel-PE_chg_max) if (TKE_here > 0.0) then if (CS%wT_mode==0) then - vstar = CS%vstar_scale_fac * (I_dtrho*TKE_here)**C1_3 + vstar = CS%vstar_scale_fac * vstar_unit_scale * (I_dtrho*TKE_here)**C1_3 elseif (CS%wT_mode==1) then Surface_Scale = max(0.05, 1. - htot/MLD_guess) - vstar = cs%vstar_scale_fac * (CS%vstar_surf_fac*U_Star + & - (CS%wstar_ustar_coef*conv_PErel*I_dtrho)**C1_3)* & - Surface_Scale + vstar = CS%vstar_scale_fac * Surface_Scale * (CS%vstar_surf_fac*u_star + & + vstar_unit_scale * (CS%wstar_ustar_coef*conv_PErel*I_dtrho)**C1_3) endif hbs_here = GV%H_to_Z * min(hb_hs(K), MixLen_shape(K)) mixlen(K) = max(CS%min_mix_len, ((h_tt*hbs_here)*vstar) / & @@ -1195,14 +1208,14 @@ subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, abs conv_PErel = conv_PErel - dPE_conv mech_TKE = mech_TKE + MKE_src if (CS%TKE_diagnostics) then - eCD%dTKE_conv = eCD%dTKE_conv - CS%nstar*dPE_conv * IdtdR0 - eCD%dTKE_MKE = eCD%dTKE_MKE + MKE_src * IdtdR0 + eCD%dTKE_conv = eCD%dTKE_conv - CS%nstar*dPE_conv * I_dtdiag + eCD%dTKE_MKE = eCD%dTKE_MKE + MKE_src * I_dtdiag endif if (sfc_connected) then MLD_output = MLD_output + GV%H_to_Z * h(k) endif - Kddt_h(K) = Kd(K)*dt_h + Kddt_h(K) = Kd(K) * dt_h elseif (tot_TKE + (MKE_src - PE_chg_g0) >= 0.0) then ! This column is convctively stable and there is energy to support the suggested ! mixing. Keep that estimate. @@ -1214,10 +1227,10 @@ subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, abs TKE_reduc = 0.0 ! tot_TKE could be 0 if Convectively_stable is false. if (tot_TKE > 0.0) TKE_reduc = (tot_TKE - PE_chg_g0) / tot_TKE if (CS%TKE_diagnostics) then - eCD%dTKE_mixing = eCD%dTKE_mixing - PE_chg_g0 * IdtdR0 - eCD%dTKE_MKE = eCD%dTKE_MKE + MKE_src * IdtdR0 + eCD%dTKE_mixing = eCD%dTKE_mixing - PE_chg_g0 * I_dtdiag + eCD%dTKE_MKE = eCD%dTKE_MKE + MKE_src * I_dtdiag eCD%dTKE_conv_decay = eCD%dTKE_conv_decay + & - (1.0-TKE_reduc)*(CS%nstar-nstar_FC) * conv_PErel * IdtdR0 + (1.0-TKE_reduc)*(CS%nstar-nstar_FC) * conv_PErel * I_dtdiag endif tot_TKE = TKE_reduc*tot_TKE mech_TKE = TKE_reduc*(mech_TKE + MKE_src) @@ -1314,24 +1327,24 @@ subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, abs Kddt_h_guess = Kddt_h_next endif enddo ! Inner iteration loop on itt. - Kd(K) = Kddt_h_guess / dt_h ; Kddt_h(K) = Kd(K)*dt_h + Kd(K) = Kddt_h_guess / dt_h ; Kddt_h(K) = Kd(K) * dt_h ! All TKE should have been consumed. if (CS%TKE_diagnostics) then - eCD%dTKE_mixing = eCD%dTKE_mixing - (tot_TKE + MKE_src) * IdtdR0 - eCD%dTKE_MKE = eCD%dTKE_MKE + MKE_src * IdtdR0 + eCD%dTKE_mixing = eCD%dTKE_mixing - (tot_TKE + MKE_src) * I_dtdiag + eCD%dTKE_MKE = eCD%dTKE_MKE + MKE_src * I_dtdiag eCD%dTKE_conv_decay = eCD%dTKE_conv_decay + & - (CS%nstar-nstar_FC) * conv_PErel * IdtdR0 + (CS%nstar-nstar_FC) * conv_PErel * I_dtdiag endif if (sfc_connected) MLD_output = MLD_output + & - (PE_chg / PE_chg_g0) * GV%H_to_Z * h(k) + (PE_chg / (PE_chg_g0)) * GV%H_to_Z * h(k) tot_TKE = 0.0 ; mech_TKE = 0.0 ; conv_PErel = 0.0 sfc_disconnect = .true. endif ! End of convective or forced mixing cases to determine Kd. - Kddt_h(K) = Kd(K)*dt_h + Kddt_h(K) = Kd(K) * dt_h ! At this point, the final value of Kddt_h(K) is known, so the ! estimated properties for layer k-1 can be calculated. b1 = 1.0 / (hp_a + Kddt_h(K)) @@ -1391,7 +1404,7 @@ subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, abs dPE_debug = dPE_debug + (dT_to_dPE(k) * (Te(k) - T0(k)) + & dS_to_dPE(k) * (Se(k) - S0(k))) enddo - mixing_debug = dPE_debug * IdtdR0 + mixing_debug = dPE_debug * I_dtdiag endif k = nz ! This is here to allow a breakpoint to be set. !/BGR @@ -1405,7 +1418,7 @@ subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, abs ! This is how the iteration was original conducted do k=2,nz if (FIRST_OBL) then ! Breaks when OBL found - if ((mixvel(K) > 1.e-10*US%m_to_Z) .and. k < nz) then + if ((mixvel(K) > 1.e-10*US%m_to_Z*US%T_to_s) .and. k < nz) then MLD_found = MLD_found + h(k-1)*GV%H_to_Z else FIRST_OBL = .false. @@ -1473,21 +1486,21 @@ subroutine find_PE_chg(Kddt_h0, dKddt_h, hp_a, hp_b, Th_a, Sh_a, Th_b, Sh_b, & !! below, including implicit mixing effects with other !! yet lower layers [degC H ~> degC m or degC kg m-2]. real, intent(in) :: dT_to_dPE_a !< A factor (pres_lay*mass_lay*dSpec_vol/dT) relating - !! a layer's temperature change to the change in column - !! potential energy, including all implicit diffusive changes - !! in the temperatures of all the layers above [J m-2 degC-1]. + !! a layer's temperature change to the change in column potential + !! energy, including all implicit diffusive changes in the + !! temperatures of all the layers above [kg m-3 Z3 T-2 degC-1 ~> J m-2 degC-1]. real, intent(in) :: dS_to_dPE_a !< A factor (pres_lay*mass_lay*dSpec_vol/dS) relating - !! a layer's salinity change to the change in column - !! potential energy, including all implicit diffusive changes - !! in the salinities of all the layers above [J m-2 ppt-1]. + !! a layer's salinity change to the change in column potential + !! energy, including all implicit diffusive changes in the + !! salinities of all the layers above [kg m-3 Z3 T-2 ppt-1 ~> J m-2 ppt-1]. real, intent(in) :: dT_to_dPE_b !< A factor (pres_lay*mass_lay*dSpec_vol/dT) relating - !! a layer's temperature change to the change in column - !! potential energy, including all implicit diffusive changes - !! in the temperatures of all the layers below [J m-2 degC-1]. + !! a layer's temperature change to the change in column potential + !! energy, including all implicit diffusive changes in the + !! temperatures of all the layers below [kg m-3 Z3 T-2 degC-1 ~> J m-2 degC-1]. real, intent(in) :: dS_to_dPE_b !< A factor (pres_lay*mass_lay*dSpec_vol/dS) relating - !! a layer's salinity change to the change in column - !! potential energy, including all implicit diffusive changes - !! in the salinities of all the layers below [J m-2 ppt-1]. + !! a layer's salinity change to the change in column potential + !! energy, including all implicit diffusive changes in the + !! salinities of all the layers below [kg m-3 Z3 T-2 ppt-1 ~> J m-2 ppt-1]. real, intent(in) :: pres_Z !< The rescaled hydrostatic interface pressure, which relates !! the changes in column thickness to the energy that is radiated !! as gravity waves and unavailable to drive mixing [J m-2 Z-1 ~> J m-3]. @@ -1509,27 +1522,28 @@ subroutine find_PE_chg(Kddt_h0, dKddt_h, hp_a, hp_b, Th_a, Sh_a, Th_b, Sh_b, & !! in the salinities of all the layers below [Z ppt-1 ~> m ppt-1]. real, optional, intent(out) :: PE_chg !< The change in column potential energy from applying - !! Kddt_h at the present interface [J m-2]. + !! Kddt_h at the present interface [kg m-3 Z3 T-2 ~> J m-2]. real, optional, intent(out) :: dPEc_dKd !< The partial derivative of PE_chg with Kddt_h !! [J m-2 H-1 ~> J m-3 or J kg-1]. real, optional, intent(out) :: dPE_max !< The maximum change in column potential energy that could !! be realizedd by applying a huge value of Kddt_h at the - !! present interface [J m-2]. + !! present interface [kg m-3 Z3 T-2 ~> J m-2]. real, optional, intent(out) :: dPEc_dKd_0 !< The partial derivative of PE_chg with Kddt_h in the - !! limit where Kddt_h = 0 [J m-2 H-1 ~> J m-3 or J kg-1]. + !! limit where Kddt_h = 0 [kg m-3 Z3 T-2 H-1 ~> J m-3 or J kg-1]. real, optional, intent(out) :: ColHt_cor !< The correction to PE_chg that is made due to a net - !! change in the column height [J m-2]. + !! change in the column height [kg m-3 Z3 T-2 ~> J m-2]. real :: hps ! The sum of the two effective pivot thicknesses [H ~> m or kg m-2]. real :: bdt1 ! A product of the two pivot thicknesses plus a diffusive term [H2 ~> m2 or kg2 m-4]. real :: dT_c ! The core term in the expressions for the temperature changes [degC H2 ~> degC m2 or degC kg2 m-4]. real :: dS_c ! The core term in the expressions for the salinity changes [ppt H2 ~> ppt m2 or ppt kg2 m-4]. real :: PEc_core ! The diffusivity-independent core term in the expressions - ! for the potential energy changes [J m-3]. + ! for the potential energy changes [kg m-3 Z2 T-2 ~> J m-3]. real :: ColHt_core ! The diffusivity-independent core term in the expressions - ! for the column height changes [J m-3]. + ! for the column height changes [H Z ~> m2 or kg m-1]. real :: ColHt_chg ! The change in the column height [H ~> m or kg m-2]. - real :: y1 ! A local temporary term, [H-3 ~> m-3 or m6 kg-3] or [H-4 ~> m-4 or m8 kg-4] in various contexts. + real :: y1_3 ! A local temporary term in [H-3 ~> m-3 or m6 kg-3]. + real :: y1_4 ! A local temporary term in [H-4 ~> m-4 or m8 kg-4]. ! The expression for the change in potential energy used here is derived ! from the expression for the final estimates of the changes in temperature @@ -1551,37 +1565,37 @@ subroutine find_PE_chg(Kddt_h0, dKddt_h, hp_a, hp_b, Th_a, Sh_a, Th_b, Sh_b, & if (present(PE_chg)) then ! Find the change in column potential energy due to the change in the ! diffusivity at this interface by dKddt_h. - y1 = dKddt_h / (bdt1 * (bdt1 + dKddt_h * hps)) - PE_chg = PEc_core * y1 - ColHt_chg = ColHt_core * y1 + y1_3 = dKddt_h / (bdt1 * (bdt1 + dKddt_h * hps)) + PE_chg = PEc_core * y1_3 + ColHt_chg = ColHt_core * y1_3 if (ColHt_chg < 0.0) PE_chg = PE_chg - pres_Z * ColHt_chg if (present(ColHt_cor)) ColHt_cor = -pres_Z * min(ColHt_chg, 0.0) elseif (present(ColHt_cor)) then - y1 = dKddt_h / (bdt1 * (bdt1 + dKddt_h * hps)) - ColHt_cor = -pres_Z * min(ColHt_core * y1, 0.0) + y1_3 = dKddt_h / (bdt1 * (bdt1 + dKddt_h * hps)) + ColHt_cor = -pres_Z * min(ColHt_core * y1_3, 0.0) endif if (present(dPEc_dKd)) then ! Find the derivative of the potential energy change with dKddt_h. - y1 = 1.0 / (bdt1 + dKddt_h * hps)**2 - dPEc_dKd = PEc_core * y1 - ColHt_chg = ColHt_core * y1 + y1_4 = 1.0 / (bdt1 + dKddt_h * hps)**2 + dPEc_dKd = PEc_core * y1_4 + ColHt_chg = ColHt_core * y1_4 if (ColHt_chg < 0.0) dPEc_dKd = dPEc_dKd - pres_Z * ColHt_chg endif if (present(dPE_max)) then ! This expression is the limit of PE_chg for infinite dKddt_h. - y1 = 1.0 / (bdt1 * hps) - dPE_max = PEc_core * y1 - ColHt_chg = ColHt_core * y1 + y1_3 = 1.0 / (bdt1 * hps) + dPE_max = PEc_core * y1_3 + ColHt_chg = ColHt_core * y1_3 if (ColHt_chg < 0.0) dPE_max = dPE_max - pres_Z * ColHt_chg endif if (present(dPEc_dKd_0)) then ! This expression is the limit of dPEc_dKd for dKddt_h = 0. - y1 = 1.0 / bdt1**2 - dPEc_dKd_0 = PEc_core * y1 - ColHt_chg = ColHt_core * y1 + y1_4 = 1.0 / bdt1**2 + dPEc_dKd_0 = PEc_core * y1_4 + ColHt_chg = ColHt_core * y1_4 if (ColHt_chg < 0.0) dPEc_dKd_0 = dPEc_dKd_0 - pres_Z * ColHt_chg endif @@ -1615,25 +1629,25 @@ subroutine find_PE_chg_orig(Kddt_h, h_k, b_den_1, dTe_term, dSe_term, & !! the changes in column thickness to the energy that is radiated !! as gravity waves and unavailable to drive mixing [J m-2 Z-1 ~> J m-3]. real, intent(in) :: dT_to_dPE_k !< A factor (pres_lay*mass_lay*dSpec_vol/dT) relating - !! a layer's temperature change to the change in column - !! potential energy, including all implicit diffusive changes - !! in the temperatures of all the layers below [J m-2 degC-1]. + !! a layer's temperature change to the change in column potential + !! energy, including all implicit diffusive changes in the + !! temperatures of all the layers below [kg m-3 Z3 T-2 degC-1 ~> J m-2 degC-1]. real, intent(in) :: dS_to_dPE_k !< A factor (pres_lay*mass_lay*dSpec_vol/dS) relating - !! a layer's salinity change to the change in column - !! potential energy, including all implicit diffusive changes - !! in the salinities of all the layers below [J m-2 ppt-1]. + !! a layer's salinity change to the change in column potential + !! energy, including all implicit diffusive changes in the + !! in the salinities of all the layers below [kg m-3 Z3 T-2 ppt-1 ~> J m-2 ppt-1]. real, intent(in) :: dT_to_dPEa !< A factor (pres_lay*mass_lay*dSpec_vol/dT) relating - !! a layer's temperature change to the change in column - !! potential energy, including all implicit diffusive changes - !! in the temperatures of all the layers above [J m-2 degC-1]. + !! a layer's temperature change to the change in column potential + !! energy, including all implicit diffusive changes in the + !! temperatures of all the layers above [kg m-3 Z3 T-2 degC-1 ~> J m-2 degC-1]. real, intent(in) :: dS_to_dPEa !< A factor (pres_lay*mass_lay*dSpec_vol/dS) relating - !! a layer's salinity change to the change in column - !! potential energy, including all implicit diffusive changes - !! in the salinities of all the layers above [J m-2 ppt-1]. + !! a layer's salinity change to the change in column potential + !! energy, including all implicit diffusive changes in the + !! salinities of all the layers above [kg m-3 Z3 T-2 ppt-1 ~> J m-2 ppt-1]. real, intent(in) :: dT_to_dColHt_k !< A factor (mass_lay*dSColHtc_vol/dT) relating !! a layer's temperature change to the change in column - !! height, including all implicit diffusive changes - !! in the temperatures of all the layers below [Z degC-1 ~> m degC-1]. + !! height, including all implicit diffusive changes in the + !! temperatures of all the layers below [Z degC-1 ~> m degC-1]. real, intent(in) :: dS_to_dColHt_k !< A factor (mass_lay*dSColHtc_vol/dS) relating !! a layer's salinity change to the change in column !! height, including all implicit diffusive changes @@ -1648,14 +1662,14 @@ subroutine find_PE_chg_orig(Kddt_h, h_k, b_den_1, dTe_term, dSe_term, & !! in the salinities of all the layers above [Z ppt-1 ~> m ppt-1]. real, optional, intent(out) :: PE_chg !< The change in column potential energy from applying - !! Kddt_h at the present interface [J m-2]. + !! Kddt_h at the present interface [kg m-3 Z3 T-2 ~> J m-2]. real, optional, intent(out) :: dPEc_dKd !< The partial derivative of PE_chg with Kddt_h - !! [J m-2 H-1 ~> J m-3 or J kg-1]. + !! [kg m-3 Z3 T-2 H-1 ~> J m-3 or J kg-1]. real, optional, intent(out) :: dPE_max !< The maximum change in column potential energy that could !! be realizedd by applying a huge value of Kddt_h at the - !! present interface [J m-2]. + !! present interface [kg m-3 Z3 T-2 ~> J m-2]. real, optional, intent(out) :: dPEc_dKd_0 !< The partial derivative of PE_chg with Kddt_h in the - !! limit where Kddt_h = 0 [J m-2 H-1 ~> J m-3 or J kg-1]. + !! limit where Kddt_h = 0 [kg m-3 Z3 T-2 H-1 ~> J m-3 or J kg-1]. ! This subroutine determines the total potential energy change due to mixing ! at an interface, including all of the implicit effects of the prescribed @@ -1748,10 +1762,10 @@ subroutine find_mstar(CS, US, Buoyancy_Flux, UStar, UStar_Mean,& MStar_LT, Convect_Langmuir_Number) type(energetic_PBL_CS), pointer :: CS !< Energetic_PBL control structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - real, intent(in) :: UStar !< ustar w/ gustiness [Z s-1 ~> m s-1] - real, intent(in) :: UStar_Mean !< ustar w/o gustiness [Z s-1 ~> m s-1] - real, intent(in) :: Abs_Coriolis !< abolute value of the Coriolis parameter [s-1] - real, intent(in) :: Buoyancy_Flux !< Buoyancy flux [Z2 s-3 ~> m2 s-3] + real, intent(in) :: UStar !< ustar w/ gustiness [Z T-1 ~> m s-1] + real, intent(in) :: UStar_Mean !< ustar w/o gustiness [Z T-1 ~> m s-1] + real, intent(in) :: Abs_Coriolis !< abolute value of the Coriolis parameter [T-1] + real, intent(in) :: Buoyancy_Flux !< Buoyancy flux [Z2 T-3 ~> m2 s-3] real, intent(in) :: BLD !< boundary layer depth [Z ~> m] real, intent(out) :: Mstar !< Ouput mstar (Mixing/ustar**3) [nondim] real, optional, intent(in) :: Langmuir_Number !< Langmuir number [nondim] @@ -1759,7 +1773,8 @@ subroutine find_mstar(CS, US, Buoyancy_Flux, UStar, UStar_Mean,& real, optional, intent(out) :: Convect_Langmuir_number !< Langmuir number including buoyancy flux [nondim] !/ Variables used in computing mstar - real :: MSN_term, MSCR_term1, MSCR_term2 ! Temporary terms [nondim] + real :: MSN_term ! Temporary terms [nondim] + real :: MSCR_term1, MSCR_term2 ! Temporary terms [Z3 T-3 ~> m3 s-3] real :: MStar_Conv_Red ! Adjustment made to mstar due to convection reducing mechanical mixing [nondim] real :: MStar_S, MStar_N ! Mstar in (S)tabilizing/(N)ot-stabilizing buoyancy flux [nondim] @@ -1774,12 +1789,13 @@ subroutine find_mstar(CS, US, Buoyancy_Flux, UStar, UStar_Mean,& if (CS%answers_2018) then ! The limit for the balance of rotation and stabilizing is f(L_Ekman,L_Obukhov) - MStar_S = CS%MStar_coef*sqrt(max(0.0,Buoyancy_Flux) / UStar**2 / (Abs_Coriolis+1.e-10) ) + MStar_S = CS%MStar_coef*sqrt(max(0.0,Buoyancy_Flux) / Ustar**2 / & + (Abs_Coriolis + 1.e-10*US%T_to_s) ) ! The limit for rotation (Ekman length) limited mixing - MStar_N = CS%C_Ek * log( max( 1.,UStar / (Abs_Coriolis+1.e-10) / BLD ) ) + MStar_N = CS%C_Ek * log( max( 1., Ustar / (Abs_Coriolis + 1.e-10*US%T_to_s) / BLD ) ) else ! The limit for the balance of rotation and stabilizing is f(L_Ekman,L_Obukhov) - mstar_S = CS%MSTAR_COEF*sqrt(max(0.0,Buoyancy_Flux) / (Ustar**2 * max(Abs_Coriolis, 1.e-20))) + mstar_S = CS%MSTAR_COEF*sqrt(max(0.0, Buoyancy_Flux) / (Ustar**2 * max(Abs_Coriolis, 1.e-20*US%T_to_s))) ! The limit for rotation (Ekman length) limited mixing mstar_N = 0.0 if (Ustar > Abs_Coriolis * BLD) mstar_N = CS%C_EK * log(Ustar / (Abs_Coriolis * BLD)) @@ -1793,21 +1809,21 @@ subroutine find_mstar(CS, US, Buoyancy_Flux, UStar, UStar_Mean,& MStar_N = CS%RH18_MStar_cn1 * ( 1.0 - 1.0 / ( 1. + CS%RH18_MStar_cn2 * & exp( CS%RH18_mstar_CN3 * BLD * Abs_Coriolis / UStar) ) ) else - MSN_term = CS%RH18_MStar_cn2 * exp( CS%RH18_mstar_CN3 * BLD * Abs_Coriolis / UStar) + MSN_term = CS%RH18_MStar_cn2 * exp( CS%RH18_mstar_CN3 * BLD * Abs_Coriolis / Ustar) MStar_N = (CS%RH18_MStar_cn1 * MSN_term) / ( 1. + MSN_term) endif - MStar_S = CS%RH18_MStar_CS1 * & - ( max(0.0,Buoyancy_Flux)**2 * BLD / ( UStar**5 * max(Abs_Coriolis,1.e-20) ) )**CS%RH18_mstar_cs2 + MStar_S = CS%RH18_MStar_CS1 * ( max(0.0, Buoyancy_Flux)**2 * BLD / & + ( Ustar**5 * max(Abs_Coriolis,1.e-20*US%T_to_s) ) )**CS%RH18_mstar_cs2 MStar = MStar_N + MStar_S endif !mstar_mode !/ 2. Adjust mstar to account for convective turbulence if (CS%answers_2018) then - MStar_Conv_Red = 1. - CS%MStar_Convect_coef * (-min(0.0,Buoyancy_Flux) + 1.e-10*US%m_to_Z**2) / & - ( (-min(0.0,Buoyancy_Flux) + 1.e-10*US%m_to_Z**2) + & + 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) / & + ( (-min(0.0,Buoyancy_Flux) + 1.e-10*US%T_to_s**3*US%m_to_Z**2) + & 2.0 *MStar * Ustar**3 / BLD ) else - MSCR_term1 = -BLD * min(0.0,Buoyancy_Flux) + MSCR_term1 = -BLD * min(0.0, Buoyancy_Flux) MSCR_term2 = 2.0*MStar * Ustar**3 MStar_Conv_Red = ((1.-CS%mstar_convect_coef) * MSCR_term1 + MSCR_term2) / (MSCR_term1 + MSCR_term2) endif @@ -1828,9 +1844,9 @@ subroutine Mstar_Langmuir(CS, US, abs_Coriolis, buoyancy_flux, ustar, BLD, Langm mstar, mstar_LT, Convect_Langmuir_Number) type(energetic_PBL_CS), pointer :: CS !< Energetic_PBL control structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - real, intent(in) :: Abs_Coriolis !< abolute value of the Coriolis parameter [s-1] - real, intent(in) :: Buoyancy_Flux !< Buoyancy flux [Z2 s-3 ~> m2 s-3] - real, intent(in) :: UStar !< Surface friction velocity with? gustiness [Z s-1 ~> m s-1] + real, intent(in) :: Abs_Coriolis !< Absolute value of the Coriolis parameter [T-1 ~> s-1] + real, intent(in) :: Buoyancy_Flux !< Buoyancy flux [Z2 T-3 ~> m2 s-3] + real, intent(in) :: UStar !< Surface friction velocity with? gustiness [Z T-1 ~> m s-1] real, intent(in) :: BLD !< boundary layer depth [Z ~> m] real, intent(inout) :: Mstar !< Input/output mstar (Mixing/ustar**3) [nondim] real, intent(in) :: Langmuir_Number !Langmuir number [nondim] @@ -1843,10 +1859,10 @@ subroutine Mstar_Langmuir(CS, US, abs_Coriolis, buoyancy_flux, ustar, BLD, Langm real :: mstar_LT_add ! A value that is added to mstar due to Langmuir turbulence. real :: iL_Ekman ! Inverse of Ekman length scale [Z-1 ~> m-1]. real :: iL_Obukhov ! Inverse of Obukhov length scale [Z-1 ~> m-1]. - real :: I_ustar ! The Adcroft reciprocal of ustar [s Z-1 ~> s m-1] - real :: I_f ! The Adcroft reciprocal of the Coriolis parameter [s] + real :: I_ustar ! The Adcroft reciprocal of ustar [T Z-1 ~> s m-1] + real :: I_f ! The Adcroft reciprocal of the Coriolis parameter [T ~> s] real :: MLD_Ekman ! The ratio of the mixed layer depth to the Ekman layer depth [nondim]. - real :: Ekman_Obukhov ! The Ekman layer thickness divided by the Obukhov depth [nondim]. + real :: Ekman_Obukhov ! The Ekman layer thickness divided by the Obukhov depth [nondim]. real :: MLD_Obukhov ! The mixed layer depth divided by the Obukhov depth [nondim]. real :: MLD_Obukhov_stab ! Ratios of length scales where MLD is boundary layer depth [nondim]. real :: Ekman_Obukhov_stab ! > @@ -1859,8 +1875,8 @@ subroutine Mstar_Langmuir(CS, US, abs_Coriolis, buoyancy_flux, ustar, BLD, Langm if (CS%LT_Enhance_Form > 0) then ! a. Get parameters for modified LA if (CS%answers_2018) then - iL_Ekman = Abs_Coriolis / UStar - iL_Obukhov = Buoyancy_Flux*CS%vonkar / (UStar**3) + iL_Ekman = Abs_Coriolis / Ustar + iL_Obukhov = Buoyancy_Flux*CS%vonkar / Ustar**3 Ekman_Obukhov_stab = abs(max(0., iL_Obukhov / (iL_Ekman + 1.e-10*US%Z_to_m))) Ekman_Obukhov_un = abs(min(0., iL_Obukhov / (iL_Ekman + 1.e-10*US%Z_to_m))) MLD_Obukhov_stab = abs(max(0., BLD*iL_Obukhov)) @@ -1872,10 +1888,10 @@ subroutine Mstar_Langmuir(CS, US, abs_Coriolis, buoyancy_flux, ustar, BLD, Langm I_ustar = 0.0 ; if (abs(Ustar) > 0.0) I_ustar = 1.0 / Ustar if (abs(Buoyancy_Flux*CS%vonkar) < Max_ratio*(abs_Coriolis * Ustar**2)) & Ekman_Obukhov = abs(Buoyancy_Flux*CS%vonkar) * (I_f * I_Ustar**2) - if (abs(BLD*Buoyancy_Flux*CS%vonkar) < Max_ratio*((UStar**3))) & - MLD_Obukhov = abs(BLD*Buoyancy_Flux*CS%vonkar) * (I_UStar**3) - if (BLD*Abs_Coriolis < Max_ratio*UStar) & - MLD_Ekman = BLD*Abs_Coriolis * I_UStar + if (abs(BLD*Buoyancy_Flux*CS%vonkar) < Max_ratio*Ustar**3) & + MLD_Obukhov = abs(BLD*Buoyancy_Flux*CS%vonkar) * I_Ustar**3 + if (BLD*Abs_Coriolis < Max_ratio*Ustar) & + MLD_Ekman = BLD*Abs_Coriolis * I_Ustar if (Buoyancy_Flux > 0.0) then Ekman_Obukhov_stab = Ekman_Obukhov ; Ekman_Obukhov_un = 0.0 @@ -1916,7 +1932,8 @@ subroutine energetic_PBL_get_MLD(CS, MLD, G, US, m_to_MLD_units) type(ocean_grid_type), intent(in) :: G !< Grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G)), intent(out) :: MLD !< Depth of ePBL active mixing layer [m or other units] - real, optional, intent(in) :: m_to_MLD_units !< A conversion factor to the desired units for MLD + real, optional, intent(in) :: m_to_MLD_units !< A conversion factor to the + !! desired units for MLD ! Local variables real :: scale ! A dimensional rescaling factor integer :: i,j @@ -1945,6 +1962,7 @@ subroutine energetic_PBL_init(Time, G, GV, US, param_file, diag, CS) # include "version_variable.h" character(len=40) :: mdl = "MOM_energetic_PBL" ! This module's name. real :: omega_frac_dflt + real :: Z3_T3_to_m3_s3 ! A conversion factor for work diagnostics [m3 T3 Z-3 s-3 ~> nondim] integer :: isd, ied, jsd, jed logical :: use_temperature, use_omega logical :: use_la_windsea @@ -1966,7 +1984,7 @@ subroutine energetic_PBL_init(Time, G, GV, US, param_file, diag, CS) !/1. General ePBL settings call get_param(param_file, mdl, "OMEGA", CS%omega, & "The rotation rate of the earth.", units="s-1", & - default=7.2921e-5) + default=7.2921e-5, scale=US%T_to_S) call get_param(param_file, mdl, "ML_USE_OMEGA", use_omega, & "If true, use the absolute rotation rate instead of the "//& "vertical component of rotation when setting the decay "//& @@ -2143,7 +2161,7 @@ subroutine energetic_PBL_init(Time, G, GV, US, param_file, diag, CS) call get_param(param_file, mdl, "VSTAR_SCALE_FACTOR", CS%vstar_scale_fac, & "An overall nondimensional scaling factor for wT. "//& "Making this larger decreases the PBL diffusivity.", & - units="nondim", default=1.0, scale=US%m_to_Z) + units="nondim", default=1.0) ! , scale=US%T_to_s*US%m_to_Z) ! call get_param(param_file, mdl, "EPBL_VEL_SCALE_FACTOR", CS%vstar_scale_fac, & ! "An overall nondimensional scaling factor for wT. "//& ! "Making this larger decreases the PBL diffusivity.", & @@ -2207,30 +2225,31 @@ subroutine energetic_PBL_init(Time, G, GV, US, param_file, diag, CS) !/ Logging parameters ! This gives a minimum decay scale that is typically much less than Angstrom. CS%ustar_min = 2e-4*CS%omega*(GV%Angstrom_Z + GV%H_to_Z*GV%H_subroundoff) - call log_param(param_file, mdl, "EPBL_USTAR_MIN", CS%ustar_min*US%Z_to_m, & + call log_param(param_file, mdl, "EPBL_USTAR_MIN", CS%ustar_min*US%Z_to_m*US%s_to_T, & "The (tiny) minimum friction velocity used within the "//& "ePBL code, derived from OMEGA and ANGSTROM.", units="m s-1") !/ Checking output flags + Z3_T3_to_m3_s3 = US%Z_to_m**3 * US%s_to_T**3 CS%id_ML_depth = register_diag_field('ocean_model', 'ePBL_h_ML', diag%axesT1, & Time, 'Surface boundary layer depth', 'm', conversion=US%Z_to_m, & cmor_long_name='Ocean Mixed Layer Thickness Defined by Mixing Scheme') CS%id_TKE_wind = register_diag_field('ocean_model', 'ePBL_TKE_wind', diag%axesT1, & - Time, 'Wind-stirring source of mixed layer TKE', 'm3 s-3') + Time, 'Wind-stirring source of mixed layer TKE', 'm3 s-3', conversion=Z3_T3_to_m3_s3) CS%id_TKE_MKE = register_diag_field('ocean_model', 'ePBL_TKE_MKE', diag%axesT1, & - Time, 'Mean kinetic energy source of mixed layer TKE', 'm3 s-3') + Time, 'Mean kinetic energy source of mixed layer TKE', 'm3 s-3', conversion=Z3_T3_to_m3_s3) CS%id_TKE_conv = register_diag_field('ocean_model', 'ePBL_TKE_conv', diag%axesT1, & - Time, 'Convective source of mixed layer TKE', 'm3 s-3') + Time, 'Convective source of mixed layer TKE', 'm3 s-3', conversion=Z3_T3_to_m3_s3) CS%id_TKE_forcing = register_diag_field('ocean_model', 'ePBL_TKE_forcing', diag%axesT1, & Time, 'TKE consumed by mixing surface forcing or penetrative shortwave radation '//& - 'through model layers', 'm3 s-3') + 'through model layers', 'm3 s-3', conversion=Z3_T3_to_m3_s3) CS%id_TKE_mixing = register_diag_field('ocean_model', 'ePBL_TKE_mixing', diag%axesT1, & - Time, 'TKE consumed by mixing that deepens the mixed layer', 'm3 s-3') + Time, 'TKE consumed by mixing that deepens the mixed layer', 'm3 s-3', conversion=Z3_T3_to_m3_s3) CS%id_TKE_mech_decay = register_diag_field('ocean_model', 'ePBL_TKE_mech_decay', diag%axesT1, & - Time, 'Mechanical energy decay sink of mixed layer TKE', 'm3 s-3') + Time, 'Mechanical energy decay sink of mixed layer TKE', 'm3 s-3', conversion=Z3_T3_to_m3_s3) CS%id_TKE_conv_decay = register_diag_field('ocean_model', 'ePBL_TKE_conv_decay', diag%axesT1, & - Time, 'Convective energy decay sink of mixed layer TKE', 'm3 s-3') + Time, 'Convective energy decay sink of mixed layer TKE', 'm3 s-3', conversion=Z3_T3_to_m3_s3) CS%id_Mixing_Length = register_diag_field('ocean_model', 'Mixing_Length', diag%axesTi, & Time, 'Mixing Length that is used', 'm', conversion=US%Z_to_m) CS%id_Velocity_Scale = register_diag_field('ocean_model', 'Velocity_Scale', diag%axesTi, & From e0d267118debb8ad663bca3fb9ef10a806b4150b Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 18 Jun 2019 10:00:02 -0400 Subject: [PATCH 21/82] +Change units of ustar in get_Langmuir_number Change units of ustar in get_Langmuir_number to [Z T-1], to concentrate the unit conversion factors for dimensional consistency testing in the MOM_wave_interface code. Also made some minor revisions in MOM_energetic_PBL to cancel out unit conversion factors. All answers are bitwise identical. --- .../vertical/MOM_CVMix_KPP.F90 | 2 +- .../vertical/MOM_energetic_PBL.F90 | 31 +++++++++---------- src/user/MOM_wave_interface.F90 | 17 +++++----- 3 files changed, 24 insertions(+), 26 deletions(-) diff --git a/src/parameterizations/vertical/MOM_CVMix_KPP.F90 b/src/parameterizations/vertical/MOM_CVMix_KPP.F90 index da112f379c..06494528e1 100644 --- a/src/parameterizations/vertical/MOM_CVMix_KPP.F90 +++ b/src/parameterizations/vertical/MOM_CVMix_KPP.F90 @@ -1073,7 +1073,7 @@ subroutine KPP_compute_BLD(CS, G, GV, US, h, Temp, Salt, u, v, EOS, uStar, buoyF if (CS%LT_K_ENHANCEMENT .or. CS%LT_VT2_ENHANCEMENT) then MLD_GUESS = max( 1.*US%m_to_Z, abs(US%m_to_Z*CS%OBLdepthprev(i,j) ) ) - call get_Langmuir_Number( LA, G, GV, US, MLD_guess, surfFricVel, i, j, & + call get_Langmuir_Number( LA, G, GV, US, MLD_guess, US%s_to_T*uStar(i,j), i, j, & H=H(i,j,:), U_H=U_H, V_H=V_H, WAVES=WAVES) CS%La_SL(i,j)=LA endif diff --git a/src/parameterizations/vertical/MOM_energetic_PBL.F90 b/src/parameterizations/vertical/MOM_energetic_PBL.F90 index 63aa4cc10d..e5343744e8 100644 --- a/src/parameterizations/vertical/MOM_energetic_PBL.F90 +++ b/src/parameterizations/vertical/MOM_energetic_PBL.F90 @@ -465,7 +465,7 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS CS%Mixing_Length(i,j,k) = mixlen(k) enddo ; endif if (CS%id_Velocity_Scale>0) then ; do k=1,nz - CS%Velocity_Scale(i,j,k) = US%s_to_T * mixvel(k) + CS%Velocity_Scale(i,j,k) = mixvel(k) enddo ; endif if (allocated(CS%mstar_mix)) CS%mstar_mix(i,j) = eCD%mstar if (allocated(CS%mstar_lt)) CS%mstar_lt(i,j) = eCD%mstar_LT @@ -583,9 +583,8 @@ subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, abs ! Local variables real, dimension(SZK_(GV)+1) :: & - pres, & ! Interface pressures [Pa]. pres_Z, & ! Interface pressures with a rescaling factor to convert interface height - ! movements into changes in column potential energy [J m-2 Z-1 ~> J m-3]. + ! movements into changes in column potential energy [kg m-3 Z2 T-2 ~> kg m-1 s-2]. hb_hs ! The distance from the bottom over the thickness of the ! water column [nondim]. real :: mech_TKE ! The mechanically generated turbulent kinetic energy @@ -645,8 +644,8 @@ subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, abs ! in the denominator of b1 in a downward-oriented tridiagonal solver. real :: h_neglect ! A thickness that is so small it is usually lost ! in roundoff and can be neglected [H ~> m or kg m-2]. - real :: dMass ! The mass per unit area within a layer [kg m-2]. - real :: dPres ! The hydrostatic pressure change across a layer [Pa]. + real :: dMass ! The mass per unit area within a layer [Z kg m-3 ~> kg m-2]. + real :: dPres ! The hydrostatic pressure change across a layer [kg m-3 Z2 T-2 ~> kg m-1 s-2 = Pa]. real :: dMKE_max ! The maximum amount of mean kinetic energy that could be ! converted to turbulent kinetic energy if the velocity in ! the layer below an interface were homogenized with all of @@ -800,18 +799,16 @@ subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, abs do K=1,nz+1 ; Kd(K) = 0.0 ; enddo - pres(1) = 0.0 pres_Z(1) = 0.0 do k=1,nz - dMass = GV%H_to_kg_m2 * h(k) - dPres = (US%m_to_Z**3*US%T_to_s**2) * (GV%g_Earth*US%m_to_Z) * dMass ! Equivalent to GV%H_to_Pa * h(k) - dT_to_dPE(k) = (dMass * (pres(K) + 0.5*dPres)) * dSV_dT(k) - dS_to_dPE(k) = (dMass * (pres(K) + 0.5*dPres)) * dSV_dS(k) - dT_to_dColHt(k) = dMass * US%m_to_Z * dSV_dT(k) - dS_to_dColHt(k) = dMass * US%m_to_Z * dSV_dS(k) - - pres(K+1) = pres(K) + dPres - pres_Z(K+1) = US%Z_to_m * pres(K+1) + dMass = US%m_to_Z * GV%H_to_kg_m2 * h(k) + dPres = (US%m_to_Z**2*US%T_to_s**2) * GV%g_Earth * dMass ! Equivalent to GV%H_to_Pa * h(k) with rescaling + dT_to_dPE(k) = (dMass * (pres_Z(K) + 0.5*dPres)) * dSV_dT(k) + dS_to_dPE(k) = (dMass * (pres_Z(K) + 0.5*dPres)) * dSV_dS(k) + dT_to_dColHt(k) = dMass * dSV_dT(k) + dS_to_dColHt(k) = dMass * dSV_dS(k) + + pres_Z(K+1) = pres_Z(K) + dPres enddo ! Determine the total thickness (h_sum) and the fractional distance from the bottom (hb_hs). @@ -854,7 +851,7 @@ subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, abs !/ Here we get MStar, which is the ratio of convective TKE driven mixing to UStar**3 if (CS%Use_LT) then - call get_Langmuir_Number(LA, G, GV, US, abs(MLD_guess), US%s_to_T*u_star_mean, i, j, & + call get_Langmuir_Number(LA, G, GV, US, abs(MLD_guess), u_star_mean, i, j, & H=h, U_H=u, V_H=v, Waves=Waves) call find_mstar(CS, US, B_flux, u_star, u_star_Mean, MLD_Guess, absf, & MStar_total, Langmuir_Number=La, Convect_Langmuir_Number=LAmod,& @@ -2253,7 +2250,7 @@ subroutine energetic_PBL_init(Time, G, GV, US, param_file, diag, CS) CS%id_Mixing_Length = register_diag_field('ocean_model', 'Mixing_Length', diag%axesTi, & Time, 'Mixing Length that is used', 'm', conversion=US%Z_to_m) CS%id_Velocity_Scale = register_diag_field('ocean_model', 'Velocity_Scale', diag%axesTi, & - Time, 'Velocity Scale that is used.', 'm s-1', conversion=US%Z_to_m) + Time, 'Velocity Scale that is used.', 'm s-1', conversion=US%Z_to_m*US%s_to_T) CS%id_MSTAR_mix = register_diag_field('ocean_model', 'MSTAR', diag%axesT1, & Time, 'Total mstar that is used.', 'nondim') CS%id_LA = register_diag_field('ocean_model', 'LA', diag%axesT1, & diff --git a/src/user/MOM_wave_interface.F90 b/src/user/MOM_wave_interface.F90 index ecf373681d..fd75171fb5 100644 --- a/src/user/MOM_wave_interface.F90 +++ b/src/user/MOM_wave_interface.F90 @@ -683,7 +683,7 @@ subroutine Update_Stokes_Drift(G, GV, US, CS, h, ustar) do ii = G%isc,G%iec do jj = G%jsc, G%jec Top = h(ii,jj,1)*GV%H_to_Z - call get_Langmuir_Number( La, G, GV, US, Top, US%Z_to_m*ustar(ii,jj), ii, jj, & + call get_Langmuir_Number( La, G, GV, US, Top, US%T_to_s*ustar(ii,jj), ii, jj, & H(ii,jj,:),Override_MA=.false.,WAVES=CS) CS%La_turb(ii,jj) = La enddo @@ -881,7 +881,7 @@ subroutine get_Langmuir_Number( LA, G, GV, US, HBL, ustar, i, j, & type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type integer, intent(in) :: i !< Meridional index of h-point integer, intent(in) :: j !< Zonal index of h-point - real, intent(in) :: ustar !< Friction velocity [Z s-1 ~> m s-1]. + real, intent(in) :: ustar !< Friction velocity [Z T-1 ~> m s-1]. real, intent(in) :: HBL !< (Positive) thickness of boundary layer [Z ~> m]. logical, optional, intent(in) :: Override_MA !< Override to use misalignment in LA !! calculation. This can be used if diagnostic @@ -901,7 +901,7 @@ subroutine get_Langmuir_Number( LA, G, GV, US, HBL, ustar, i, j, & !Local Variables real :: Top, bottom, midpoint real :: Dpt_LASL, ShearDirection, WaveDirection - real :: LA_STKx, LA_STKy, LA_STK + real :: LA_STKx, LA_STKy, LA_STK ! Stokes velocities in [m s-1] logical :: ContinueLoop, USE_MA real, dimension(SZK_(G)) :: US_H, VS_H real, dimension(NumBands) :: StkBand_X, StkBand_Y @@ -971,12 +971,13 @@ subroutine get_Langmuir_Number( LA, G, GV, US, HBL, ustar, i, j, & ! there is also no good reason to cap it here other then ! to prevent large enhancements in unconstrained parts of ! the curve fit parameterizations. - LA = max(WAVES%La_min, sqrt(US%Z_to_m*ustar / (LA_STK+1.e-10))) + ! Note the dimensional constant background Stokes velocity of 10^-10 m s-1. + LA = max(WAVES%La_min, sqrt(US%Z_to_m*US%s_to_T*ustar / (LA_STK+1.e-10))) endif if (Use_MA) then WaveDirection = atan2(LA_STKy, LA_STKx) - LA = LA / sqrt(max(1.e-8,cos( WaveDirection - ShearDirection))) + LA = LA / sqrt(max(1.e-8, cos( WaveDirection - ShearDirection))) endif return @@ -999,7 +1000,7 @@ end subroutine get_Langmuir_Number !! - BGR remove u10 input !! - BGR note: fixed parameter values should be changed to "get_params" subroutine get_StokesSL_LiFoxKemper(ustar, hbl, GV, US, UStokes_SL, LA) - real, intent(in) :: ustar !< water-side surface friction velocity [Z s-1 ~> m s-1]. + real, intent(in) :: ustar !< water-side surface friction velocity [Z T-1 ~> m s-1]. real, intent(in) :: hbl !< boundary layer depth [Z ~> m]. type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type @@ -1023,7 +1024,7 @@ subroutine get_StokesSL_LiFoxKemper(ustar, hbl, GV, US, UStokes_SL, LA) if (ustar > 0.0) then ! Computing u10 based on u_star and COARE 3.5 relationships - call ust_2_u10_coare3p5(US%Z_to_m*ustar*sqrt(GV%Rho0/1.225), u10, GV, US) + call ust_2_u10_coare3p5(US%Z_to_m*US%s_to_T*ustar*sqrt(GV%Rho0/1.225), u10, GV, US) ! surface Stokes drift UStokes = us_to_u10*u10 ! @@ -1068,7 +1069,7 @@ subroutine get_StokesSL_LiFoxKemper(ustar, hbl, GV, US, UStokes_SL, LA) sqrt( 2.0 * PI *kstar * z0) * & erfc( sqrt( 2.0 * kstar * z0 ) ) UStokes_sl = UStokes * (0.715 + r1 + r2 + r3 + r4) - LA = sqrt(US%Z_to_m*ustar / UStokes_sl) + LA = sqrt(US%Z_to_m*US%s_to_T*ustar / UStokes_sl) else UStokes_sl = 0.0 LA=1.e8 From 7c995db2b90505e30f6662288e1b74d7d8286ff3 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 18 Jun 2019 14:04:17 -0400 Subject: [PATCH 22/82] +Added EPBL_MSTAR_SCHEME and EPBL_LANGMUIR_SCHEME Replaced the enumerated runtime parameter MSTAR_MODE with the named EPBL_MSTAR_SCHEME and similarly for LT_ENHANCE and EPBL_LANGMUIR_SCHEME. The old names still work as before but with a warning message and the new names and values are logged. All answers are bitwise identical, but there are changes to the MOM_parameter_doc files. --- .../vertical/MOM_energetic_PBL.F90 | 299 +++++++++++------- 1 file changed, 185 insertions(+), 114 deletions(-) diff --git a/src/parameterizations/vertical/MOM_energetic_PBL.F90 b/src/parameterizations/vertical/MOM_energetic_PBL.F90 index e5343744e8..a599c42d68 100644 --- a/src/parameterizations/vertical/MOM_energetic_PBL.F90 +++ b/src/parameterizations/vertical/MOM_energetic_PBL.F90 @@ -7,10 +7,11 @@ module MOM_energetic_PBL use MOM_diag_mediator, only : post_data, register_diag_field, safe_alloc_alloc use MOM_diag_mediator, only : time_type, diag_ctrl use MOM_domains, only : create_group_pass, do_group_pass, group_pass_type -use MOM_error_handler, only : MOM_error, FATAL, WARNING +use MOM_error_handler, only : MOM_error, FATAL, WARNING, MOM_mesg use MOM_file_parser, only : get_param, log_param, log_version, param_file_type use MOM_forcing_type, only : forcing use MOM_grid, only : ocean_grid_type +use MOM_string_functions, only : uppercase use MOM_unit_scaling, only : unit_scale_type use MOM_variables, only : thermo_var_ptrs use MOM_verticalGrid, only : verticalGrid_type @@ -52,6 +53,8 @@ module MOM_energetic_PBL logical :: Orig_MLD_iteration=.false. !< False to use old MLD value logical :: MLD_iteration_guess=.false. !< False to default to guessing half the !! ocean depth for the iteration. + integer :: max_MLD_its !< The maximum number of iterations that can be used to find a + !! self-consistent mixed layer depth with Use_MLD_iteration. real :: MixLenExponent !< Exponent in the mixing length shape-function. !! 1 is law-of-the-wall at top and bottom, !! 2 is more KPP like. @@ -88,7 +91,7 @@ module MOM_energetic_PBL !! the diffusivity. !mstar related options - integer :: MStar_mode = 0 !< An coded integer to determine which formula is used to set mstar + integer :: mstar_scheme !< An encoded integer to determine which formula is used to set mstar logical :: MSTAR_FLATCAP=.true. !< Set false to use asymptotic mstar cap. real :: mstar_cap !< Since MSTAR is restoring undissipated energy to mixing, !! there must be a cap on how large it can be. This @@ -98,19 +101,19 @@ module MOM_energetic_PBL !/ vertical decay related options real :: TKE_decay !< The ratio of the natural Ekman depth to the TKE decay scale [nondim]. - !/ mstar_mode == 0 + !/ mstar_scheme == 0 real :: fixed_mstar !< Mstar is the ratio of the friction velocity cubed to the TKE available to !! drive entrainment, nondimensional. This quantity is the vertically !! integrated shear production minus the vertically integrated !! dissipation of TKE produced by shear. This value is used if the option !! for using a fixed mstar is used. - !/ mstar_mode == 2 - real :: C_EK = 0.17 !< MSTAR Coefficient in rotation limit for mstar_mode=2 - real :: MSTAR_COEF = 0.3 !< MSTAR coefficient in rotation/stabilizing balance for mstar_mode=2 + !/ mstar_scheme == 2 + real :: C_EK = 0.17 !< MSTAR Coefficient in rotation limit for mstar_scheme=OM4 + real :: MSTAR_COEF = 0.3 !< MSTAR coefficient in rotation/stabilizing balance for mstar_scheme=OM4 - !/ mstar_mode == 3 - real :: RH18_mstar_cN1 !< MSTAR_N coefficient 1 (outter-most coefficient for fit). + !/ mstar_scheme == 3 + real :: RH18_mstar_cN1 !< MSTAR_N coefficient 1 (outter-most coefficient for fit). !! Value of 0.275 in RH18. Increasing this !! coefficient increases mechanical mixing for all values of Hf/ust, !! but is most effective at low values (weakly developed OSBLs). @@ -192,10 +195,21 @@ module MOM_energetic_PBL end type energetic_PBL_CS !>@{ Enumeration values for mstar_Scheme -integer, parameter :: Use_Fixed_MStar = 0 !< The value of MSTAR_MODE to use a constant mstar -integer, parameter :: MStar_from_Ekman = 2 !< The value of MSTAR_MODE to base mstar on the ratio +integer, parameter :: Use_Fixed_MStar = 0 !< The value of mstar_scheme to use a constant mstar +integer, parameter :: MStar_from_Ekman = 2 !< The value of mstar_scheme to base mstar on the ratio !! of the Ekman layer depth to the Obukhov depth -integer, parameter :: MStar_from_RH18 = 3 !< The value of MSTAR_MODE to base mstar of of RH18 +integer, parameter :: MStar_from_RH18 = 3 !< The value of mstar_scheme to base mstar of of RH18 +integer, parameter :: No_Langmuir = 0 !< The value of LT_ENHANCE_FORM not use Langmuir turbolence. +integer, parameter :: Langmuir_rescale = 2 !< The value of LT_ENHANCE_FORM to use a multiplicative + !! rescaling of mstar to account for Langmuir turbulence. +integer, parameter :: Langmuir_add = 3 !< The value of LT_ENHANCE_FORM to add a contribution to + !! mstar from Langmuir turblence to other contributions. +character*(20), parameter :: CONSTANT_STRING = "CONSTANT" +character*(20), parameter :: OM4_STRING = "OM4" +character*(20), parameter :: RH18_STRING = "REICHL_H18" +character*(20), parameter :: NONE_STRING = "NONE" +character*(20), parameter :: RESCALED_STRING = "RESCALE" +character*(20), parameter :: ADDITIVE_STRING = "ADDITIVE" !!@} !> A type for conveniently passing around ePBL diagnostics for a column. @@ -287,15 +301,13 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS ! mixing. ! ! The key parameters for the mixed layer are found in the control structure. -! To use the classic constant mstar mixied layers choose MSTAR_MODE=0. +! To use the classic constant mstar mixied layers choose MSTAR_SCHEME=CONSTANT. ! The key parameters then include mstar, nstar, TKE_decay, and conv_decay. ! For the Oberhuber (1993) mixed layer,the values of these are: ! mstar = 1.25, nstar = 1, TKE_decay = 2.5, conv_decay = 0.5 ! TKE_decay is 1/kappa in eq. 28 of Oberhuber (1993), while conv_decay is 1/mu. ! For a traditional Kraus-Turner mixed layer, the values are: ! mstar = 1.25, nstar = 0.4, TKE_decay = 0.0, conv_decay = 0.0 -! To use the OM4 ePBL settings choose MSTAR_MODE=2. -! To use the Reichl and Hallberg, 2018 ! Local variables real, dimension(SZI_(G),SZK_(GV)) :: & @@ -357,7 +369,6 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS h_neglect = GV%H_subroundoff -! if (.not.CS%Use_MLD_Iteration) MAX_OBL_IT=1 dt__diag = dt ; if (present(dt_diag)) dt__diag = dt_diag write_diags = .true. ; if (present(last_call)) write_diags = last_call @@ -746,16 +757,8 @@ subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, abs ! within the boundary layer. Likely, a new method e.g. surface_disconnect, ! can improve this. logical :: FIRST_OBL ! Flag for computing "found" Mixing layer depth - logical :: OBL_CONVERGED ! Flag for convergence of MLD - integer :: OBL_IT ! Iteration counter -!### This needs to be made into a run-time parameter. - integer :: MAX_OBL_IT=20 ! Set maximum number of iterations. Probably best as an input parameter, - ! but then may want to use allocatable arrays if storing guess/found - ! (as diagnostic); skipping for now. - ! In reality, the maximum number of guesses needed is set by: - ! DEPTH/2^M < DZ - ! where M is the number of guesses - ! e.g. M=12 for DEPTH=4000m and DZ=1m + logical :: OBL_converged ! Flag for convergence of MLD + integer :: OBL_it ! Iteration counter real :: Surface_Scale ! Surface decay scale for vstar @@ -778,7 +781,6 @@ subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, abs h_neglect = GV%H_subroundoff - if (.not.CS%Use_MLD_Iteration) MAX_OBL_IT=1 C1_3 = 1.0 / 3.0 dt__diag = dt ; if (present(dt_diag)) dt__diag = dt_diag * US%s_to_T I_dtdiag = 1.0 / dt__diag @@ -832,19 +834,16 @@ subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, abs ! If no first guess is provided for MLD, try the middle of the water column if (MLD_guess <= min_MLD) MLD_guess = 0.5 * (min_MLD + max_MLD) - ! Iterate up to MAX_OBL_IT times to determine a converged EPBL depth. - OBL_CONVERGED = .false. - sfc_connected = .true. + ! Iterate to determine a converged EPBL depth. + OBL_converged = .false. + do OBL_it=1,CS%Max_MLD_Its - do OBL_IT=1,MAX_OBL_IT - - if (.not. OBL_CONVERGED) then + if (.not. OBL_converged) then ! If not using MLD_Iteration flag loop to only execute once. - if (.not.CS%Use_MLD_Iteration) OBL_CONVERGED = .true. + if (.not.CS%Use_MLD_iteration) OBL_converged = .true. if (debug) then ; mech_TKE_k(:) = 0.0 ; conv_PErel_k(:) = 0.0 ; endif - ! Reset ML_depth MLD_output = h(1)*GV%H_to_Z sfc_connected = .true. @@ -861,7 +860,7 @@ subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, abs endif !/ Apply MStar to get mech_TKE - if ((CS%answers_2018) .and. (CS%mstar_mode==0)) then + if ((CS%answers_2018) .and. (CS%mstar_scheme==Use_Fixed_MStar)) then mech_TKE = (dt*MSTAR_total*GV%Rho0) * u_star**3 else mech_TKE = MSTAR_total * (dt*GV%Rho0* u_star**3) @@ -894,7 +893,7 @@ subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, abs do K=1,nz+1 ; mixvel(K) = 0.0 ; mixlen(K) = 0.0 ; enddo ! Determine the mixing shape function MixLen_shape. - if ((.not.CS%Use_MLD_Iteration) .or. & + if ((.not.CS%Use_MLD_iteration) .or. & (CS%transLay_scale >= 1.0) .or. (CS%transLay_scale < 0.0) ) then do K=1,nz+1 MixLen_shape(K) = 1.0 @@ -1114,7 +1113,7 @@ subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, abs ((CS%Ekman_scale_coef * absf) * (h_tt*hbs_here) + vstar)) !Note setting Kd_guess0 to vstar * CS%vonKar * mixlen(K) here will ! change the answers. Therefore, skipping that. - if (.not.CS%Use_MLD_Iteration) then + if (.not.CS%Use_MLD_iteration) then Kd_guess0 = vstar * CS%vonKar * ((h_tt*hbs_here)*vstar) / & ((CS%Ekman_scale_coef * absf) * (h_tt*hbs_here) + vstar) else @@ -1163,7 +1162,7 @@ subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, abs hbs_here = GV%H_to_Z * min(hb_hs(K), MixLen_shape(K)) mixlen(K) = max(CS%min_mix_len, ((h_tt*hbs_here)*vstar) / & ((CS%Ekman_scale_coef * absf) * (h_tt*hbs_here) + vstar)) - if (.not.CS%Use_MLD_Iteration) then + if (.not.CS%Use_MLD_iteration) then ! Note again (as prev) that using mixlen here ! instead of redoing the computation will change answers... Kd(K) = vstar * CS%vonKar * ((h_tt*hbs_here)*vstar) / & @@ -1281,11 +1280,10 @@ subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, abs dMKE_src_dK = dMKE_max * MKE2_Hharm * exp(-MKE2_Hharm * Kddt_h_guess) TKE_left = tot_TKE + (MKE_src - PE_chg) - if (debug) then + if (debug .and. itt<=20) then Kddt_h_itt(itt) = Kddt_h_guess ; MKE_src_itt(itt) = MKE_src - PE_chg_itt(itt) = PE_chg + PE_chg_itt(itt) = PE_chg ; dPEa_dKd_itt(itt) = dPEc_dKd TKE_left_itt(itt) = TKE_left - dPEa_dKd_itt(itt) = dPEc_dKd endif ! Store the new bounding values, bearing in mind that min and max ! here refer to Kddt_h and dTKE_left/dKddt_h < 0: @@ -1410,9 +1408,9 @@ subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, abs ! the TKE threshold (ML_DEPTH). This is because the MSTAR ! is now dependent on the ML, and therefore the ML needs to be estimated ! more precisely than the grid spacing. - MLD_found = 0.0 ; FIRST_OBL = .true. if (CS%Orig_MLD_iteration) then - ! This is how the iteration was original conducted + ! This is how the iteration was originally conducted + MLD_found = 0.0 ; FIRST_OBL = .true. do k=2,nz if (FIRST_OBL) then ! Breaks when OBL found if ((mixvel(K) > 1.e-10*US%m_to_Z*US%T_to_s) .and. k < nz) then @@ -1422,7 +1420,7 @@ subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, abs if (MLD_found - CS%MLD_tol > MLD_guess) then min_MLD = MLD_guess elseif ((MLD_guess - MLD_found) < max(CS%MLD_tol, h(k-1)*GV%H_to_Z)) then - OBL_CONVERGED = .true. ! Break convergence loop + OBL_converged = .true. ! Break convergence loop else max_MLD = MLD_guess ! We know this guess was too deep endif @@ -1435,12 +1433,13 @@ subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, abs if (MLD_found - CS%MLD_tol > MLD_guess) then min_MLD = MLD_guess elseif (abs(MLD_guess - MLD_found) < CS%MLD_tol) then - OBL_CONVERGED = .true. ! Break convergence loop + OBL_converged = .true. ! Break convergence loop else max_MLD = MLD_guess ! We know this guess was too deep endif endif ! For next pass, guess average of minimum and maximum values. + !### We should try using the false position method instead of simple bisection. MLD_guess = 0.5*(min_MLD + max_MLD) endif enddo ! Iteration loop for converged boundary layer thickness. @@ -1779,10 +1778,10 @@ subroutine find_mstar(CS, US, Buoyancy_Flux, UStar, UStar_Mean,& !/ - if ( CS%MStar_Mode == Use_Fixed_MStar) then + if (CS%mstar_scheme == Use_Fixed_MStar) then MStar = CS%Fixed_MStar !/ 1. Get mstar - elseif (CS%MSTAR_MODE == MStar_from_Ekman) then + elseif (CS%mstar_scheme == MStar_from_Ekman) then if (CS%answers_2018) then ! The limit for the balance of rotation and stabilizing is f(L_Ekman,L_Obukhov) @@ -1801,7 +1800,7 @@ subroutine find_mstar(CS, US, Buoyancy_Flux, UStar, UStar_Mean,& ! Here 1.25 is about .5/von Karman, which gives the Obukhov limit. MStar = max(MStar_S, min(1.25, MStar_N)) if (CS%MStar_Cap > 0.0) MStar = min( CS%MStar_Cap,MStar ) - elseif ( CS%MStar_Mode == MStar_from_RH18 ) then + elseif ( CS%mstar_scheme == MStar_from_RH18 ) then if (CS%answers_2018) then MStar_N = CS%RH18_MStar_cn1 * ( 1.0 - 1.0 / ( 1. + CS%RH18_MStar_cn2 * & exp( CS%RH18_mstar_CN3 * BLD * Abs_Coriolis / UStar) ) ) @@ -1812,7 +1811,7 @@ subroutine find_mstar(CS, US, Buoyancy_Flux, UStar, UStar_Mean,& MStar_S = CS%RH18_MStar_CS1 * ( max(0.0, Buoyancy_Flux)**2 * BLD / & ( Ustar**5 * max(Abs_Coriolis,1.e-20*US%T_to_s) ) )**CS%RH18_mstar_cs2 MStar = MStar_N + MStar_S - endif !mstar_mode + endif !/ 2. Adjust mstar to account for convective turbulence if (CS%answers_2018) then @@ -1869,7 +1868,7 @@ subroutine Mstar_Langmuir(CS, US, abs_Coriolis, buoyancy_flux, ustar, BLD, Langm ! Set default values for no Langmuir effects. enhance_mstar = 1.0 ; mstar_LT_add = 0.0 - if (CS%LT_Enhance_Form > 0) then + if (CS%LT_Enhance_Form /= No_Langmuir) then ! a. Get parameters for modified LA if (CS%answers_2018) then iL_Ekman = Abs_Coriolis / Ustar @@ -1907,11 +1906,11 @@ subroutine Mstar_Langmuir(CS, US, abs_Coriolis, buoyancy_flux, ustar, BLD, Langm ((CS%LaC_EKoOB_stab * Ekman_Obukhov_stab + CS%LaC_EKoOB_un * Ekman_Obukhov_un) + & (CS%LaC_MLDoOB_stab * MLD_Obukhov_stab + CS%LaC_MLDoOB_un * MLD_Obukhov_un)) ) - if (CS%LT_Enhance_Form == 2) then + if (CS%LT_Enhance_Form == Langmuir_rescale) then ! Enhancement is multiplied (added mst_lt set to 0) Enhance_mstar = min(CS%Max_Enhance_M, & (1. + CS%LT_ENHANCE_COEF * Convect_Langmuir_Number**CS%LT_ENHANCE_EXP) ) - elseif (CS%LT_ENHANCE_Form == 3) then + elseif (CS%LT_ENHANCE_Form == Langmuir_add) then ! or Enhancement is additive (multiplied enhance_m set to 1) mstar_LT_add = CS%LT_ENHANCE_COEF * Convect_Langmuir_Number**CS%LT_ENHANCE_EXP endif @@ -1958,9 +1957,11 @@ subroutine energetic_PBL_init(Time, G, GV, US, param_file, diag, CS) ! This include declares and sets the variable "version". # include "version_variable.h" character(len=40) :: mdl = "MOM_energetic_PBL" ! This module's name. + character(len=20) :: tmpstr real :: omega_frac_dflt real :: Z3_T3_to_m3_s3 ! A conversion factor for work diagnostics [m3 T3 Z-3 s-3 ~> nondim] integer :: isd, ied, jsd, jed + integer :: mstar_mode, LT_enhance logical :: use_temperature, use_omega logical :: use_la_windsea isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed @@ -2024,65 +2025,94 @@ subroutine energetic_PBL_init(Time, G, GV, US, param_file, diag, CS) !/2. Options related to setting MSTAR - !### Add new parameter MSTAR_SCHEME to replace MSTAR_MODE. - call get_param(param_file, mdl, "MSTAR_MODE", CS%mstar_mode, & - "An integer switch for how to compute MSTAR.\n"//& - " 0 for constant MSTAR\n"//& - !delete " 1 for MSTAR w/ MLD in stabilizing limit\n"//& - " 2 for OM4 MSTAR, which uses L_E/L_O in stabilizing limit\n"//& - " 3 for MSTAR as in RH18.", & - default=0) - if (CS%mstar_mode==1) then - call MOM_error(FATAL, "You are using a legacy mstar mode in ePBL that has been "//& - "phased out. If you need to use this setting please "//& - "report this error, as the code supporting this option "//& - "is set to be deleted.") - end if + call get_param(param_file, mdl, "EPBL_MSTAR_SCHEME", tmpstr, & + "EPBL_MSTAR_SCHEME selects the method for setting mstar. Valid values are: \n"//& + "\t CONSTANT - Use a fixed mstar given by MSTAR \n"//& + "\t OM4 - Use L_Ekman/L_Obukhov in the sabilizing limit, as in OM4 \n"//& + "\t REICHL_H18 - Use the scheme documented in Reichl & Hallberg, 2018.", & + default=CONSTANT_STRING, do_not_log=.true.) + call get_param(param_file, mdl, "MSTAR_MODE", mstar_mode, default=-1) + if (mstar_mode == 0) then + tmpstr = CONSTANT_STRING + call MOM_error(WARNING, "Use EPBL_MSTAR_SCHEME = CONSTANT instead of the archaic MSTAR_MODE = 0.") + elseif (mstar_mode == 1) then + call MOM_error(FATAL, "You are using a legacy mstar mode in ePBL that has been phased out. "//& + "If you need to use this setting please report this error. Also use "//& + "EPBL_MSTAR_SCHEME to specify the scheme for mstar.") + elseif (mstar_mode == 2) then + tmpstr = OM4_STRING + call MOM_error(WARNING, "Use EPBL_MSTAR_SCHEME = OM4 instead of the archaic MSTAR_MODE = 2.") + elseif (mstar_mode == 3) then + tmpstr = RH18_STRING + call MOM_error(WARNING, "Use EPBL_MSTAR_SCHEME = REICHL_H18 instead of the archaic MSTAR_MODE = 3.") + elseif (mstar_mode > 3) then + call MOM_error(FATAL, "An unrecognized value of the obsolete parameter MSTAR_MODE was specified.") + endif + call log_param(param_file, mdl, "EPBL_MSTAR_SCHEME", tmpstr, & + "EPBL_MSTAR_SCHEME selects the method for setting mstar. Valid values are: \n"//& + "\t CONSTANT - Use a fixed mstar given by MSTAR \n"//& + "\t OM4 - Use L_Ekman/L_Obukhov in the sabilizing limit, as in OM4 \n"//& + "\t REICHL_H18 - Use the scheme documented in Reichl & Hallberg, 2018.", & + default=CONSTANT_STRING) + tmpstr = uppercase(tmpstr) + select case (tmpstr) + case (CONSTANT_STRING) + CS%mstar_Scheme = Use_Fixed_MStar + case (OM4_STRING) + CS%mstar_Scheme = MStar_from_Ekman + case (RH18_STRING) + CS%mstar_Scheme = MStar_from_RH18 + case default + call MOM_mesg('CoriolisAdv_init: EPBL_MSTAR_SCHEME ="'//trim(tmpstr)//'"', 0) + call MOM_error(FATAL, "energetic_PBL_init: Unrecognized setting "// & + "EPBL_MSTAR_SCHEME = "//trim(tmpstr)//" found in input file.") + end select + call get_param(param_file, mdl, "MSTAR", CS%fixed_mstar, & - "The ratio of the friction velocity cubed to the TKE "//& - "input to the mixed layer. This option is used if MSTAR_MODE "//& - "is set to 0.", units="nondim", default=1.2) + "The ratio of the friction velocity cubed to the TKE input to the "//& + "mixed layer. This option is used if EPBL_MSTAR_SCHEME = CONSTANT.", & + units="nondim", default=1.2, do_not_log=(CS%mstar_scheme/=Use_Fixed_MStar)) call get_param(param_file, mdl, "MSTAR_CAP", CS%mstar_cap, & - "If this value is non-negative, it sets a maximum value of mstar "//& - "allowed in model (used only if MSTAR_MODE>0).", & - units="nondim", default=-1.0) - ! MSTAR_MODE==2 options + "If this value is positive, it sets the maximum value of mstar "//& + "allowed in ePBL. (This is not used if EPBL_MSTAR_SCHEME = CONSTANT).", & + units="nondim", default=-1.0, do_not_log=(CS%mstar_scheme==Use_Fixed_MStar)) + ! mstar_scheme==MStar_from_Ekman options call get_param(param_file, mdl, "MSTAR2_COEF1", CS%MSTAR_COEF, & - "Coefficient in computing mstar when rotation and "//& - " stabilizing effects are both important (used if MSTAR_MODE=2).", & - units="nondim", default=0.3, do_not_log=(CS%MStar_Mode/=MStar_from_Ekman)) + "Coefficient in computing mstar when rotation and stabilizing "//& + "effects are both important (used if EPBL_MSTAR_SCHEME = OM4).", & + units="nondim", default=0.3, do_not_log=(CS%mstar_scheme/=MStar_from_Ekman)) call get_param(param_file, mdl, "MSTAR2_COEF2", CS%C_EK, & "Coefficient in computing mstar when only rotation limits "// & - "the total mixing. (used only if MSTAR_MODE=2)", & - units="nondim", default=0.085, do_not_log=(CS%MStar_Mode/=MStar_from_Ekman)) - ! MSTAR_MODE==3 options + "the total mixing (used if EPBL_MSTAR_SCHEME = OM4)", & + units="nondim", default=0.085, do_not_log=(CS%mstar_scheme/=MStar_from_Ekman)) + ! mstar_scheme==MStar_from_RH18 options call get_param(param_file, mdl, "RH18_MSTAR_CN1", CS%RH18_mstar_cn1,& "MSTAR_N coefficient 1 (outter-most coefficient for fit). "//& "The value of 0.275 is given in RH18. Increasing this "//& "coefficient increases MSTAR for all values of Hf/ust, but more "//& "effectively at low values (weakly developed OSBLs).", & - units="nondim", default=0.275, do_not_log=(CS%MStar_Mode/=MStar_from_RH18)) + units="nondim", default=0.275, do_not_log=(CS%mstar_scheme/=MStar_from_RH18)) call get_param(param_file, mdl, "RH18_MSTAR_CN2", CS%RH18_mstar_cn2,& "MSTAR_N coefficient 2 (coefficient outside of exponential decay). "//& "The value of 8.0 is given in RH18. Increasing this coefficient "//& "increases MSTAR for all values of HF/ust, with a much more even "//& "effect across a wide range of Hf/ust than CN1.", & - units="nondim", default=8.0, do_not_log=(CS%MStar_Mode/=MStar_from_RH18)) + units="nondim", default=8.0, do_not_log=(CS%mstar_scheme/=MStar_from_RH18)) call get_param(param_file, mdl, "RH18_MSTAR_CN3", CS%RH18_mstar_CN3,& "MSTAR_N coefficient 3 (exponential decay coefficient). "//& "The value of -5.0 is given in RH18. Increasing this increases how "//& "quickly the value of MSTAR decreases as Hf/ust increases.", & - units="nondim", default=-5.0, do_not_log=(CS%MStar_Mode/=MStar_from_RH18)) + units="nondim", default=-5.0, do_not_log=(CS%mstar_scheme/=MStar_from_RH18)) call get_param(param_file, mdl, "RH18_MSTAR_CS1", CS%RH18_mstar_cs1,& "MSTAR_S coefficient for RH18 in stabilizing limit. "//& - "The value of 0.2 is given in RH18 and increasing it increases"//& + "The value of 0.2 is given in RH18 and increasing it increases "//& "MSTAR in the presence of a stabilizing surface buoyancy flux.", & - units="nondim", default=0.2, do_not_log=(CS%MStar_Mode/=MStar_from_RH18)) + units="nondim", default=0.2, do_not_log=(CS%mstar_scheme/=MStar_from_RH18)) call get_param(param_file, mdl, "RH18_MSTAR_CS2", CS%RH18_mstar_cs2,& "MSTAR_S exponent for RH18 in stabilizing limit. "//& "The value of 0.4 is given in RH18 and increasing it increases MSTAR "//& "exponentially in the presence of a stabilizing surface buoyancy flux.", & - Units="nondim", default=0.4, do_not_log=(CS%MStar_Mode/=MStar_from_RH18)) + Units="nondim", default=0.4, do_not_log=(CS%mstar_scheme/=MStar_from_RH18)) !/ Convective turbulence related options @@ -2092,22 +2122,21 @@ subroutine energetic_PBL_init(Time, G, GV, US, param_file, diag, CS) "at the base of mixed layer when that energy is positive.", & units="nondim", default=0.2) call get_param(param_file, mdl, "MSTAR_CONV_ADJ", CS%mstar_convect_coef, & - "Coefficient used for reducing mstar during convection"//& - " due to reduction of stable density gradient.", & + "Coefficient used for reducing mstar during convection "//& + "due to reduction of stable density gradient.", & units="nondim", default=0.0) !/ Mixing Length Options !### THIS DEFAULT SHOULD BECOME TRUE. - call get_param(param_file, mdl, "USE_MLD_ITERATION", CS%USE_MLD_ITERATION, & + call get_param(param_file, mdl, "USE_MLD_ITERATION", CS%Use_MLD_iteration, & "A logical that specifies whether or not to use the "//& "distance to the bottom of the actively turbulent boundary "//& "layer to help set the EPBL length scale.", default=.false.) call get_param(param_file, mdl, "EPBL_TRANSITION_SCALE", CS%transLay_scale, & "A scale for the mixing length in the transition layer "//& "at the edge of the boundary layer as a fraction of the "//& - "boundary layer thickness. The default is 0.1.", & - units="nondim", default=0.1) - if ( CS%USE_MLD_ITERATION .and. abs(CS%transLay_scale-0.5) >= 0.5) then + "boundary layer thickness.", units="nondim", default=0.1) + if ( CS%Use_MLD_iteration .and. abs(CS%transLay_scale-0.5) >= 0.5) then call MOM_error(FATAL, "If flag USE_MLD_ITERATION is true, then "//& "EPBL_TRANSITION should be greater than 0 and less than 1.") endif @@ -2131,6 +2160,12 @@ subroutine energetic_PBL_init(Time, G, GV, US, param_file, diag, CS) "The tolerance for the iteratively determined mixed "//& "layer depth. This is only used with USE_MLD_ITERATION.", & units="meter", default=1.0, scale=US%m_to_Z) + call get_param(param_file, mdl, "EPBL_MLD_MAX_ITS", CS%max_MLD_its, & + "The maximum number of iterations that can be used to find a self-consistent "//& + "mixed layer depth. For now, due to the use of bisection, the maximum number "//& + "iteractions needed is set by Depth/2^MAX_ITS < EPBL_MLD_TOLERANCE.", & + default=20, do_not_log=.not.CS%Use_MLD_iteration) + if (.not.CS%Use_MLD_iteration) CS%Max_MLD_Its = 1 call get_param(param_file, mdl, "EPBL_MIN_MIX_LEN", CS%min_mix_len, & "The minimum mixing length scale that will be used "//& "by ePBL. The default (0) does not set a minimum.", & @@ -2181,41 +2216,77 @@ subroutine energetic_PBL_init(Time, G, GV, US, param_file, diag, CS) units="nondim", default=.false.) endif if (CS%USE_LT) then - !### Add LT_ENHANCE_SCHEME. - call get_param(param_file, mdl, "LT_ENHANCE", CS%LT_ENHANCE_FORM, & - "Integer for Langmuir number mode. \n"//& - " *Requires USE_LA_LI2016 to be set to True. \n"//& - "Options: 0 - No Langmuir \n"//& - " 1 - (removed) \n"//& - " 2 - Multiplied w/ adjusted La. \n"//& - " 3 - Added w/ adjusted La.", & - units="nondim", default=0) + call get_param(param_file, mdl, "EPBL_LANGMUIR_SCHEME", tmpstr, & + "EPBL_LANGMUIR_SCHEME selects the method for including Langmuir turbulence. "//& + "Valid values are: \n"//& + "\t NONE - Do not do any extra mixing due to Langmuir turbulence \n"//& + "\t RESCALE - Use a multiplicative rescaling of mstar to account for Langmuir turbulence \n"//& + "\t ADDITIVE - Add a Langmuir turblence contribution to mstar to other contributions", & + default=NONE_STRING, do_not_log=.true.) + call get_param(param_file, mdl, "LT_ENHANCE", LT_enhance, default=-1) + if (LT_ENHANCE == 0) then + tmpstr = NONE_STRING + call MOM_error(WARNING, "Use EPBL_LANGMUIR_SCHEME = NONE instead of the archaic LT_ENHANCE = 0.") + elseif (LT_ENHANCE == 1) then + call MOM_error(FATAL, "You are using a legacy LT_ENHANCE mode in ePBL that has been phased out. "//& + "If you need to use this setting please report this error. Also use "//& + "EPBL_LANGMUIR_SCHEME to specify the scheme for mstar.") + elseif (LT_ENHANCE == 2) then + tmpstr = RESCALED_STRING + call MOM_error(WARNING, "Use EPBL_LANGMUIR_SCHEME = RESCALE instead of the archaic LT_ENHANCE = 2.") + elseif (LT_ENHANCE == 3) then + tmpstr = ADDITIVE_STRING + call MOM_error(WARNING, "Use EPBL_LANGMUIR_SCHEME = ADDITIVE instead of the archaic LT_ENHANCE = 3.") + elseif (LT_ENHANCE > 3) then + call MOM_error(FATAL, "An unrecognized value of the obsolete parameter LT_ENHANCE was specified.") + endif + call log_param(param_file, mdl, "EPBL_LANGMUIR_SCHEME", tmpstr, & + "EPBL_LANGMUIR_SCHEME selects the method for including Langmuir turbulence. "//& + "Valid values are: \n"//& + "\t NONE - Do not do any extra mixing due to Langmuir turbulence \n"//& + "\t RESCALE - Use a multiplicative rescaling of mstar to account for Langmuir turbulence \n"//& + "\t ADDITIVE - Add a Langmuir turblence contribution to mstar to other contributions", & + default=NONE_STRING) + tmpstr = uppercase(tmpstr) + select case (tmpstr) + case (NONE_STRING) + CS%LT_enhance_form = No_Langmuir + case (RESCALED_STRING) + CS%LT_enhance_form = Langmuir_rescale + case (ADDITIVE_STRING) + CS%LT_enhance_form = Langmuir_add + case default + call MOM_mesg('CoriolisAdv_init: EPBL_LANGMUIR_SCHEME ="'//trim(tmpstr)//'"', 0) + call MOM_error(FATAL, "energetic_PBL_init: Unrecognized setting "// & + "EPBL_LANGMUIR_SCHEME = "//trim(tmpstr)//" found in input file.") + end select + call get_param(param_file, mdl, "LT_ENHANCE_COEF", CS%LT_ENHANCE_COEF, & - "Coefficient for Langmuir enhancement if LT_ENHANCE > 1", & - units="nondim", default=0.447) + "Coefficient for Langmuir enhancement of mstar", & + units="nondim", default=0.447, do_not_log=(CS%LT_enhance_form==No_Langmuir)) call get_param(param_file, mdl, "LT_ENHANCE_EXP", CS%LT_ENHANCE_EXP, & - "Exponent for Langmuir enhancement if LT_ENHANCE > 1", & - units="nondim", default=-1.33) + "Exponent for Langmuir enhancementt of mstar", & + units="nondim", default=-1.33, do_not_log=(CS%LT_enhance_form==No_Langmuir)) call get_param(param_file, mdl, "LT_MOD_LAC1", CS%LaC_MLDoEK, & "Coefficient for modification of Langmuir number due to "//& - "MLD approaching Ekman depth if LT_ENHANCE=2.", & - units="nondim", default=-0.87) + "MLD approaching Ekman depth.", & + units="nondim", default=-0.87, do_not_log=(CS%LT_enhance_form==No_Langmuir)) call get_param(param_file, mdl, "LT_MOD_LAC2", CS%LaC_MLDoOB_stab, & "Coefficient for modification of Langmuir number due to "//& - "MLD approaching stable Obukhov depth if LT_ENHANCE=2.", & - units="nondim", default=0.0) + "MLD approaching stable Obukhov depth.", & + units="nondim", default=0.0, do_not_log=(CS%LT_enhance_form==No_Langmuir)) call get_param(param_file, mdl, "LT_MOD_LAC3", CS%LaC_MLDoOB_un, & "Coefficient for modification of Langmuir number due to "//& - "MLD approaching unstable Obukhov depth if LT_ENHANCE=2.", & - units="nondim", default=0.0) + "MLD approaching unstable Obukhov depth.", & + units="nondim", default=0.0, do_not_log=(CS%LT_enhance_form==No_Langmuir)) call get_param(param_file, mdl, "LT_MOD_LAC4", CS%Lac_EKoOB_stab, & "Coefficient for modification of Langmuir number due to "//& - "ratio of Ekman to stable Obukhov depth if LT_ENHANCE=2.", & - units="nondim", default=0.95) + "ratio of Ekman to stable Obukhov depth.", & + units="nondim", default=0.95, do_not_log=(CS%LT_enhance_form==No_Langmuir)) call get_param(param_file, mdl, "LT_MOD_LAC5", CS%Lac_EKoOB_un, & "Coefficient for modification of Langmuir number due to "//& - "ratio of Ekman to unstable Obukhov depth if LT_ENHANCE=2.", & - units="nondim", default=0.95) + "ratio of Ekman to unstable Obukhov depth.", & + units="nondim", default=0.95, do_not_log=(CS%LT_enhance_form==No_Langmuir)) endif From 93a7d94ef62cdc55dcad49e947e152c7d007a7f4 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 18 Jun 2019 17:24:44 -0400 Subject: [PATCH 23/82] +Add EPBL_VEL_SCALE_SCHEME & EPBL_VEL_SCALE_FACTOR Replaced the enumerated runtime parameter EPBL_VEL_SCALE_MODE with the named EPBL_VEL_SCALE_SCHEME. Also renamed VSTAR_SCALE_FACTOR as EPBL_VEL_SCALE_FACTOR, properly obsoleting the name VSTAR_SCALE_FACTOR. All answers are bitwise identical, but there are changes to the MOM_parameter_doc files. --- src/diagnostics/MOM_obsolete_params.F90 | 2 + .../vertical/MOM_energetic_PBL.F90 | 88 +++++++++++++------ 2 files changed, 61 insertions(+), 29 deletions(-) diff --git a/src/diagnostics/MOM_obsolete_params.F90 b/src/diagnostics/MOM_obsolete_params.F90 index d032d25514..21612770c2 100644 --- a/src/diagnostics/MOM_obsolete_params.F90 +++ b/src/diagnostics/MOM_obsolete_params.F90 @@ -159,6 +159,8 @@ subroutine find_obsolete_params(param_file) call obsolete_real(param_file, "RINO_CRIT_EQ") call obsolete_real(param_file, "SHEARMIX_RATE_EQ") + call obsolete_real(param_file, "VSTAR_SCALE_FACTOR", hint="Use EPBL_VEL_SCALE_FACTOR instead.") + call obsolete_logical(param_file, "CONTINUITY_PPM", .true.) call obsolete_logical(param_file, "USE_LOCAL_PREF", .true.) diff --git a/src/parameterizations/vertical/MOM_energetic_PBL.F90 b/src/parameterizations/vertical/MOM_energetic_PBL.F90 index a599c42d68..abb63e5d2e 100644 --- a/src/parameterizations/vertical/MOM_energetic_PBL.F90 +++ b/src/parameterizations/vertical/MOM_energetic_PBL.F90 @@ -76,15 +76,15 @@ module MOM_energetic_PBL !! The default (0) does not set a minimum. !/ Velocity scale terms - integer :: wT_mode !< An integer marking the chosen method for finding wT - !! (the turbulent velocity scale) . - !! wT_mode = 0 is the original (TKE_remaining)^1/3 - !! wT_mode = 1 is the version described by Reichl and Hallberg, 2018 + integer :: wT_scheme !< An enumerated value indicating the method for finding the turbulent + !! velocity scale. There are currently two options: + !! wT_mwT_from_cRoot_TKE is the original (TKE_remaining)^1/3 + !! wT_from_RH18 is the version described by Reichl and Hallberg, 2018 real :: wstar_ustar_coef !< A ratio relating the efficiency with which convectively released !! energy is converted to a turbulent velocity, relative to !! mechanically forced turbulent kinetic energy [nondim]. !! Making this larger increases the diffusivity. - real :: vstar_surf_fac !< If (wT_mode == 1) this is the proportionality coefficient between + real :: vstar_surf_fac !< If (wT_scheme == wT_from_RH18) this is the proportionality coefficient between !! ustar and the surface mechanical contribution to vstar [nondim] real :: vstar_scale_fac !< An overall nondimensional scaling factor for vstar times a unit !! conversion factor [Z s T-1 m-1 ~> nondim]. Making this larger increases @@ -204,9 +204,15 @@ module MOM_energetic_PBL !! rescaling of mstar to account for Langmuir turbulence. integer, parameter :: Langmuir_add = 3 !< The value of LT_ENHANCE_FORM to add a contribution to !! mstar from Langmuir turblence to other contributions. +integer, parameter :: wT_from_cRoot_TKE = 0 !< Use a constant times the cube root of remaining TKE + !! to calculate the turbulent velocity. +integer, parameter :: wT_from_RH18 = 1 !< Use a scheme based on a combination of w* and v* as + !! documented in Reichl & Hallberg (2018) to calculate + !! the turbulent velocity. character*(20), parameter :: CONSTANT_STRING = "CONSTANT" character*(20), parameter :: OM4_STRING = "OM4" character*(20), parameter :: RH18_STRING = "REICHL_H18" +character*(20), parameter :: ROOT_TKE_STRING = "CUBE_ROOT_TKE" character*(20), parameter :: NONE_STRING = "NONE" character*(20), parameter :: RESCALED_STRING = "RESCALE" character*(20), parameter :: ADDITIVE_STRING = "ADDITIVE" @@ -1101,9 +1107,9 @@ subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, abs h_tt = htot + h_tt_min TKE_here = mech_TKE + CS%wstar_ustar_coef*conv_PErel if (TKE_here > 0.0) then - if (CS%wT_mode==0) then + if (CS%wT_scheme==wT_from_cRoot_TKE) then vstar = CS%vstar_scale_fac * vstar_unit_scale * (I_dtrho*TKE_here)**C1_3 - elseif (CS%wT_mode==1) then + elseif (CS%wT_scheme==wT_from_RH18) then Surface_Scale = max(0.05, 1.0 - htot/MLD_guess) vstar = CS%vstar_scale_fac * Surface_Scale * (CS%vstar_surf_fac*u_star + & vstar_unit_scale * (CS%wstar_ustar_coef*conv_PErel*I_dtrho)**C1_3) @@ -1152,9 +1158,9 @@ subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, abs ! Does MKE_src need to be included in the calculation of vstar here? TKE_here = mech_TKE + CS%wstar_ustar_coef*(conv_PErel-PE_chg_max) if (TKE_here > 0.0) then - if (CS%wT_mode==0) then + if (CS%wT_scheme==wT_from_cRoot_TKE) then vstar = CS%vstar_scale_fac * vstar_unit_scale * (I_dtrho*TKE_here)**C1_3 - elseif (CS%wT_mode==1) then + elseif (CS%wT_scheme==wT_from_RH18) then Surface_Scale = max(0.05, 1. - htot/MLD_guess) vstar = CS%vstar_scale_fac * Surface_Scale * (CS%vstar_surf_fac*u_star + & vstar_unit_scale * (CS%wstar_ustar_coef*conv_PErel*I_dtrho)**C1_3) @@ -1961,7 +1967,7 @@ subroutine energetic_PBL_init(Time, G, GV, US, param_file, diag, CS) real :: omega_frac_dflt real :: Z3_T3_to_m3_s3 ! A conversion factor for work diagnostics [m3 T3 Z-3 s-3 ~> nondim] integer :: isd, ied, jsd, jed - integer :: mstar_mode, LT_enhance + integer :: mstar_mode, LT_enhance, wT_mode logical :: use_temperature, use_omega logical :: use_la_windsea isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed @@ -2063,7 +2069,7 @@ subroutine energetic_PBL_init(Time, G, GV, US, param_file, diag, CS) case (RH18_STRING) CS%mstar_Scheme = MStar_from_RH18 case default - call MOM_mesg('CoriolisAdv_init: EPBL_MSTAR_SCHEME ="'//trim(tmpstr)//'"', 0) + call MOM_mesg('energetic_PBL_init: EPBL_MSTAR_SCHEME ="'//trim(tmpstr)//'"', 0) call MOM_error(FATAL, "energetic_PBL_init: Unrecognized setting "// & "EPBL_MSTAR_SCHEME = "//trim(tmpstr)//" found in input file.") end select @@ -2177,32 +2183,56 @@ subroutine energetic_PBL_init(Time, G, GV, US, param_file, diag, CS) "This is only used if USE_MLD_ITERATION is True.", & units="nondim", default=2.0) - !/ Turbulent velocity scale in mixing coefficient - !### Replace this with EPBL_VEL_SCALE_SCHEME with names. - call get_param(param_file, mdl, "EPBL_VEL_SCALE_MODE", CS%wT_mode, & - "An integer switch for how to compute the turbulent velocity. \n"//& - " 0 for old wT = (TKE Remaining)^(1/3)\n"//& - " 1 for new wT = v* + w* -see Reichl & Hallberg 2018.", & - units="nondim", default=0) + call get_param(param_file, mdl, "EPBL_VEL_SCALE_SCHEME", tmpstr, & + "Selects the method for translating TKE into turbulent velocities. "//& + "Valid values are: \n"//& + "\t CUBE_ROOT_TKE - A constant times the cube root of remaining TKE. \n"//& + "\t REICHL_H18 - Use the scheme based on a combination of w* and v* as \n"//& + "\t documented in Reichl & Hallberg, 2018.", & + default=ROOT_TKE_STRING, do_not_log=.true.) + call get_param(param_file, mdl, "EPBL_VEL_SCALE_MODE", wT_mode, default=-1) + if (wT_mode == 0) then + tmpstr = ROOT_TKE_STRING + call MOM_error(WARNING, "Use EPBL_VEL_SCALE_SCHEME = CUBE_ROOT_TKE instead of the archaic EPBL_VEL_SCALE_MODE = 0.") + elseif (wT_mode == 1) then + tmpstr = RH18_STRING + call MOM_error(WARNING, "Use EPBL_VEL_SCALE_SCHEME = REICHL_H18 instead of the archaic EPBL_VEL_SCALE_MODE = 1.") + elseif (wT_mode >= 2) then + call MOM_error(FATAL, "An unrecognized value of the obsolete parameter EPBL_VEL_SCALE_MODE was specified.") + endif + call log_param(param_file, mdl, "EPBL_VEL_SCALE_SCHEME", tmpstr, & + "Selects the method for translating TKE into turbulent velocities. "//& + "Valid values are: \n"//& + "\t CUBE_ROOT_TKE - A constant times the cube root of remaining TKE. \n"//& + "\t REICHL_H18 - Use the scheme based on a combination of w* and v* as \n"//& + "\t documented in Reichl & Hallberg, 2018.", & + default=ROOT_TKE_STRING) + tmpstr = uppercase(tmpstr) + select case (tmpstr) + case (ROOT_TKE_STRING) + CS%wT_scheme = wT_from_cRoot_TKE + case (RH18_STRING) + CS%wT_scheme = wT_from_RH18 + case default + call MOM_mesg('energetic_PBL_init: EPBL_VEL_SCALE_SCHEME ="'//trim(tmpstr)//'"', 0) + call MOM_error(FATAL, "energetic_PBL_init: Unrecognized setting "// & + "EPBL_VEL_SCALE_SCHEME = "//trim(tmpstr)//" found in input file.") + end select + call get_param(param_file, mdl, "WSTAR_USTAR_COEF", CS%wstar_ustar_coef, & "A ratio relating the efficiency with which convectively "//& "released energy is converted to a turbulent velocity, "//& "relative to mechanically forced TKE. Making this larger "//& "increases the BL diffusivity", units="nondim", default=1.0) - call get_param(param_file, mdl, "VSTAR_SCALE_FACTOR", CS%vstar_scale_fac, & + call get_param(param_file, mdl, "EPBL_VEL_SCALE_FACTOR", CS%vstar_scale_fac, & "An overall nondimensional scaling factor for wT. "//& - "Making this larger decreases the PBL diffusivity.", & - units="nondim", default=1.0) ! , scale=US%T_to_s*US%m_to_Z) -! call get_param(param_file, mdl, "EPBL_VEL_SCALE_FACTOR", CS%vstar_scale_fac, & -! "An overall nondimensional scaling factor for wT. "//& -! "Making this larger decreases the PBL diffusivity.", & -! units="nondim", default=1.0, scale=US%m_to_Z) + "Making this larger increases the PBL diffusivity.", & + units="nondim", default=1.0) call get_param(param_file, mdl, "VSTAR_SURF_FAC", CS%vstar_surf_fac,& "The proportionality times ustar to set vstar at the surface.", & units="nondim", default=1.2) - !/ Options related to Langmuir turbulence call get_param(param_file, mdl, "USE_LA_LI2016", use_LA_Windsea, & "A logical to use the Li et al. 2016 (submitted) formula to "//& @@ -2212,8 +2242,8 @@ subroutine energetic_PBL_init(Time, G, GV, US, param_file, diag, CS) CS%USE_LT = .true. else call get_param(param_file, mdl, "EPBL_LT", CS%USE_LT, & - "A logical to use a LT parameterization.", & - units="nondim", default=.false.) + "A logical to use a LT parameterization.", & + units="nondim", default=.false.) endif if (CS%USE_LT) then call get_param(param_file, mdl, "EPBL_LANGMUIR_SCHEME", tmpstr, & @@ -2256,7 +2286,7 @@ subroutine energetic_PBL_init(Time, G, GV, US, param_file, diag, CS) case (ADDITIVE_STRING) CS%LT_enhance_form = Langmuir_add case default - call MOM_mesg('CoriolisAdv_init: EPBL_LANGMUIR_SCHEME ="'//trim(tmpstr)//'"', 0) + call MOM_mesg('energetic_PBL_init: EPBL_LANGMUIR_SCHEME ="'//trim(tmpstr)//'"', 0) call MOM_error(FATAL, "energetic_PBL_init: Unrecognized setting "// & "EPBL_LANGMUIR_SCHEME = "//trim(tmpstr)//" found in input file.") end select From 2288502f59f09204b151db5085298eef89cb41dc Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Wed, 19 Jun 2019 07:06:03 -0400 Subject: [PATCH 24/82] +Added new runtime option SET_VISC_2018_ANSWERS Added a new runtime parameters to enable the use of a more robust algorithm for the the iterative calculation of the open face lengths when the minimum layer thickness is 0. Answers change minorly in some test casess when this new option is set to false. By default all answers are bitwise identical, but the MOM_parameter_doc.all files have a new entry. --- .../vertical/MOM_set_viscosity.F90 | 32 ++++++++++++------- 1 file changed, 20 insertions(+), 12 deletions(-) diff --git a/src/parameterizations/vertical/MOM_set_viscosity.F90 b/src/parameterizations/vertical/MOM_set_viscosity.F90 index 1265067ef2..3918c4235a 100644 --- a/src/parameterizations/vertical/MOM_set_viscosity.F90 +++ b/src/parameterizations/vertical/MOM_set_viscosity.F90 @@ -81,6 +81,9 @@ module MOM_set_visc real :: omega_frac !< When setting the decay scale for turbulence, use !! this fraction of the absolute rotation rate blended !! with the local value of f, as sqrt((1-of)*f^2 + of*4*omega^2). + logical :: answers_2018 !< If true, use the order of arithmetic and expressions that recover the + !! answers from the end of 2018. Otherwise, use updated and more robust + !! forms of the same expressions. logical :: debug !< If true, write verbose checksums for debugging purposes. type(ocean_OBC_type), pointer :: OBC => NULL() !< Open boundaries control structure type(diag_ctrl), pointer :: diag => NULL() !< A structure that is used to @@ -770,18 +773,19 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, symmetrize) dV_dL2 = 0.5*(slope+a) - a*L0 ; dVol = (vol-Vol_0) ! dV_dL2 = 0.5*(slope+a) - a*L0 ; dVol = max(vol-Vol_0, 0.0) - !### The following code is more robust when GV%Angstrom_H=0, but it - !### changes answers. - ! Vol_tol = max(0.5*GV%Angstrom_H + GV%H_subroundoff, 1e-14*vol) - ! Vol_quit = max(0.9*GV%Angstrom_H + GV%H_subroundoff, 1e-14*vol) - - ! if (dVol <= 0.0) then - ! L(K) = L0 - ! Vol_err = 0.5*(L(K)*L(K))*(slope + a_3*(3.0-4.0*L(K))) - vol - ! elseif (a*a*dVol**3 < Vol_tol*dV_dL2**2 * & - ! (dV_dL2*Vol_tol - 2.0*a*L0*dVol)) then - if (a*a*dVol**3 < GV%Angstrom_H*dV_dL2**2 * & - (0.25*dV_dL2*GV%Angstrom_H - a*L0*dVol)) then + ! The following code is more robust when GV%Angstrom_H=0, but it changes answers. + if (.not.CS%answers_2018) then + Vol_tol = max(0.5*GV%Angstrom_H + GV%H_subroundoff, 1e-14*vol) + Vol_quit = max(0.9*GV%Angstrom_H + GV%H_subroundoff, 1e-14*vol) + endif + + if ((.not.CS%answers_2018) .and. (dVol <= 0.0)) then + L(K) = L0 + Vol_err = 0.5*(L(K)*L(K))*(slope + a_3*(3.0-4.0*L(K))) - vol + elseif ( ((.not.CS%answers_2018) .and. & + (a*a*dVol**3 < Vol_tol*dV_dL2**2 *(dV_dL2*Vol_tol - 2.0*a*L0*dVol))) .or. & + (CS%answers_2018 .and. (a*a*dVol**3 < GV%Angstrom_H*dV_dL2**2 * & + (0.25*dV_dL2*GV%Angstrom_H - a*L0*dVol) )) ) then ! One iteration of Newton's method should give an estimate ! that is accurate to within Vol_tol. L(K) = sqrt(L0*L0 + dVol / dV_dL2) @@ -1811,6 +1815,10 @@ subroutine set_visc_init(Time, G, GV, US, param_file, diag, visc, CS, restart_CS call log_version(param_file, mdl, version, "") CS%RiNo_mix = .false. ; use_CVMix_ddiff = .false. differential_diffusion = .false. + call get_param(param_file, mdl, "SET_VISC_2018_ANSWERS", CS%answers_2018, & + "If true, use the order of arithmetic and expressions that recover the "//& + "answers from the end of 2018. Otherwise, use updated and more robust "//& + "forms of the same expressions.", default=.true.) call get_param(param_file, mdl, "BOTTOMDRAGLAW", CS%bottomdraglaw, & "If true, the bottom stress is calculated with a drag "//& "law of the form c_drag*|u|*u. The velocity magnitude "//& From 6c9a442f6d24c6c8f12199e693066f9017e3eee7 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Wed, 19 Jun 2019 18:54:03 -0400 Subject: [PATCH 25/82] +Added ML_RAD_BUG and SET_DIFF_2018_ANSWERS Added a two new runtime parameters, ML_RAD_BUG and SET_DIFF_2018_ANSWERS, to correct a bug in the calculation of the TKE available to drive mixing with the ML_RADIATION scheme, and to avoid the redundant calculation mathematically equivalent expressions via direct division or multiplication by a reciprocal in find_TKE_to_Kd. Also corrected a vertical loop extent in legacy_diabatic, with no apparent consequences. Answers change slightly in some test cases when SET_DIFF_2018_ANSWERS is set to false, and more substantially when ML_RADIATION is true and ML_RAD_BUG is false. By default all answers are bitwise identical, but the MOM_parameter_doc.all files have a new entry. --- .../vertical/MOM_diabatic_driver.F90 | 10 ++-- .../vertical/MOM_set_diffusivity.F90 | 54 ++++++++++++++----- 2 files changed, 43 insertions(+), 21 deletions(-) diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index e21192bfae..f09f8745c7 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -1561,14 +1561,10 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en if (CS%use_CVMix_conv) then call calculate_CVMix_conv(h, tv, G, GV, US, CS%CVMix_conv_csp, Hml) - !!!!!!!! GMM, the following needs to be checked !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - !### The vertical extent here is more limited that Kv_slow or Kd_int; it might be k=1,nz+1. - do k=1,nz ; do j=js,je ; do i=is,ie - Kd_int(i,j,K) = Kd_int(i,j,K) + US%T_to_s * CS%CVMix_conv_csp%kd_conv(i,j,k) - visc%Kv_slow(i,j,k) = visc%Kv_slow(i,j,k) + CS%CVMix_conv_csp%kv_conv(i,j,k) + do K=1,nz+1 ; do j=js,je ; do i=is,ie + Kd_int(i,j,K) = Kd_int(i,j,K) + US%T_to_s * CS%CVMix_conv_csp%kd_conv(i,j,K) + visc%Kv_slow(i,j,K) = visc%Kv_slow(i,j,K) + CS%CVMix_conv_csp%kv_conv(i,j,K) enddo ; enddo ; enddo - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - endif if (CS%useKPP) then diff --git a/src/parameterizations/vertical/MOM_set_diffusivity.F90 b/src/parameterizations/vertical/MOM_set_diffusivity.F90 index aa843e3ad5..6dd01eaa93 100644 --- a/src/parameterizations/vertical/MOM_set_diffusivity.F90 +++ b/src/parameterizations/vertical/MOM_set_diffusivity.F90 @@ -113,6 +113,9 @@ module MOM_set_diffusivity real :: ML_rad_coeff !< coefficient, which scales MSTAR*USTAR^3 to !! obtain energy available for mixing below !! mixed layer base [nondim] + logical :: ML_rad_bug !< If true use code with a bug that reduces the energy available + !! in the transition layer by a factor of the inverse of the energy + !! deposition lenthscale (in m). logical :: ML_rad_TKE_decay !< If true, apply same exponential decay !! to ML_rad as applied to the other surface !! sources of TKE in the mixed layer code. @@ -143,6 +146,10 @@ module MOM_set_diffusivity real :: Max_salt_diff_salt_fingers !< max salt diffusivity for salt fingers [Z2 T-1 ~> m2 s-1] real :: Kv_molecular !< molecular visc for double diff convect [Z2 T-1 ~> m2 s-1] + logical :: answers_2018 !< If true, use the order of arithmetic and expressions that recover the + !! answers from the end of 2018. Otherwise, use updated and more robust + !! forms of the same expressions. + character(len=200) :: inputdir !< The directory in which input files are found type(user_change_diff_CS), pointer :: user_change_diff_CSp => NULL() !< Control structure for a child module type(Kappa_shear_CS), pointer :: kappaShear_CSp => NULL() !< Control structure for a child module @@ -667,8 +674,8 @@ subroutine find_TKE_to_Kd(h, tv, dRho_int, N2_lay, j, dt, G, GV, US, CS, & ! above or below [Z ~> m]. real :: dRho_lay ! density change across a layer [kg m-3] real :: Omega2 ! rotation rate squared [T-2 ~> s-2] - real :: G_Rho0 ! gravitation accel divided by Bouss ref density [m4 T-2 kg-1 -> m4 s-2 kg-1] - real :: G_IRho0 ! ### Alternate calculation of G_Rho0 for reproducibility + real :: G_Rho0 ! gravitation accel divided by Bouss ref density [Z m3 T-2 kg-1 -> m4 s-2 kg-1] + real :: G_IRho0 ! Alternate calculation of G_Rho0 for reproducibility [Z m3 T-2 kg-1 -> m4 s-2 kg-1] real :: I_Rho0 ! inverse of Boussinesq reference density [m3 kg-1] real :: I_dt ! 1/dt [T-1] real :: H_neglect ! negligibly small thickness [H ~> m or kg m-2] @@ -681,12 +688,13 @@ subroutine find_TKE_to_Kd(h, tv, dRho_int, N2_lay, j, dt, G, GV, US, CS, & I_dt = 1.0 / dt Omega2 = CS%omega**2 H_neglect = GV%H_subroundoff - ! ### G_Rho0 and G_IRho0 are mathematically identical but give different - ! numerical values. We compute both values for now, but they should be - ! consolidated at some point. G_Rho0 = (GV%g_Earth * US%m_to_Z**2 * US%T_to_s**2) / GV%Rho0 - I_Rho0 = 1.0 / GV%Rho0 - G_IRho0 = (GV%g_Earth * US%m_to_Z**2 * US%T_to_s**2) * I_Rho0 + if (CS%answers_2018) then + I_Rho0 = 1.0 / GV%Rho0 + G_IRho0 = (GV%g_Earth * US%m_to_Z**2 * US%T_to_s**2) * I_Rho0 + else + G_IRho0 = G_Rho0 + endif ! Simple but coordinate-independent estimate of Kd/TKE if (CS%simple_TKE_to_Kd) then @@ -1584,14 +1592,23 @@ subroutine add_MLrad_diffusivity(h, fluxes, j, G, GV, US, CS, Kd_lay, TKE_to_Kd, do_any = .false. do i=is,ie ; if (do_i(i)) then dzL = GV%H_to_Z*h(i,j,k) ; z1 = dzL*I_decay(i) - if (z1 > 1e-5) then - !### I think that this might be dimensionally inconsistent, but untested. -RWH - Kd_mlr = (TKE_ml_flux(i) * TKE_to_Kd(i,k)) * & ! Units of Z2 T-1 ? - US%m_to_Z * ((1.0 - exp(-z1)) / dzL) ! Units of m-1 ? + if (CS%ML_Rad_bug) then + !### These expresssions are dimensionally inconsistent. -RWH + ! This is supposed to be the integrated energy deposited in the layer, + ! not the average over the layer as in these expressions. + if (z1 > 1e-5) then + Kd_mlr = (TKE_ml_flux(i) * TKE_to_Kd(i,k)) * & ! Units of Z2 T-1 + US%m_to_Z * ((1.0 - exp(-z1)) / dzL) ! Units of m-1 + else + Kd_mlr = (TKE_ml_flux(i) * TKE_to_Kd(i,k)) * & ! Units of Z2 T-1 + US%m_to_Z * (I_decay(i) * (1.0 - z1 * (0.5 - C1_6*z1))) ! Units of m-1 + endif else - !### I think that this might be dimensionally inconsistent, but untested. -RWH - Kd_mlr = (TKE_ml_flux(i) * TKE_to_Kd(i,k)) * & ! Units of Z2 T-1 ? - US%m_to_Z * (I_decay(i) * (1.0 - z1 * (0.5 - C1_6*z1))) ! Units of m-1 ? + if (z1 > 1e-5) then + Kd_mlr = (TKE_ml_flux(i) * TKE_to_Kd(i,k)) * (1.0 - exp(-z1)) + else + Kd_mlr = (TKE_ml_flux(i) * TKE_to_Kd(i,k)) * (z1 * (1.0 - z1 * (0.5 - C1_6*z1))) + endif endif Kd_mlr = min(Kd_mlr, CS%ML_rad_kd_max) Kd_lay(i,j,k) = Kd_lay(i,j,k) + Kd_mlr @@ -1916,6 +1933,11 @@ subroutine set_diffusivity_init(Time, G, GV, US, param_file, diag, CS, int_tide_ "The rotation rate of the earth.", units="s-1", & default=7.2921e-5, scale=US%T_to_s) + call get_param(param_file, mdl, "SET_DIFF_2018_ANSWERS", CS%answers_2018, & + "If true, use the order of arithmetic and expressions that recover the "//& + "answers from the end of 2018. Otherwise, use updated and more robust "//& + "forms of the same expressions.", default=.true.) + call get_param(param_file, mdl, "ML_RADIATION", CS%ML_radiation, & "If true, allow a fraction of TKE available from wind "//& "work to penetrate below the base of the mixed layer "//& @@ -1931,6 +1953,10 @@ subroutine set_diffusivity_init(Time, G, GV, US, param_file, diag, CS, int_tide_ "depth for turbulence below the base of the mixed layer. "//& "This is only used if ML_RADIATION is true.", units="nondim", & default=0.2) + call get_param(param_file, mdl, "ML_RAD_BUG", CS%ML_rad_bug, & + "If true use code with a bug that reduces the energy available "//& + "in the transition layer by a factor of the inverse of the energy "//& + "deposition lenthscale (in m).", default=.true.) call get_param(param_file, mdl, "ML_RAD_KD_MAX", CS%ML_rad_kd_max, & "The maximum diapycnal diffusivity due to turbulence "//& "radiated from the base of the mixed layer. "//& From eb5f06c20f7a1d36ab35aa07d733937c8bfe7f09 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Fri, 21 Jun 2019 11:51:34 -0400 Subject: [PATCH 26/82] +Extended dimensional scaling of vertical params Extended the dimensional scaling test in vertical parameterization code. Rescaled SkinBuoyFlux and cTKE in applyBoundaryFluxesInOut and pass these rescaled fluxes to energetic_PBL. Rescaled Kd_ePBL returned from energetic_PBL. Pass rescaled timesteps to energetic_PBL and entrainment_diffusive, and canceled out rescaling factors inside of entrainment_diffusive. All answers are bitwise identical. --- .../vertical/MOM_diabatic_aux.F90 | 14 +++--- .../vertical/MOM_diabatic_driver.F90 | 42 +++++++++--------- .../vertical/MOM_energetic_PBL.F90 | 43 +++++++++---------- .../vertical/MOM_entrain_diffusive.F90 | 28 +++++------- 4 files changed, 59 insertions(+), 68 deletions(-) diff --git a/src/parameterizations/vertical/MOM_diabatic_aux.F90 b/src/parameterizations/vertical/MOM_diabatic_aux.F90 index 5259d4ed25..8052111f73 100644 --- a/src/parameterizations/vertical/MOM_diabatic_aux.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_aux.F90 @@ -791,7 +791,7 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, US, dt, fluxes, optics, h, tv, & !! heat and freshwater fluxes is applied [m]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & optional, intent(out) :: cTKE !< Turbulent kinetic energy requirement to mix - !! forcing through each layer [W m-2] + !! forcing through each layer [kg m-3 Z3 T-2 ~> J m-2] real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & optional, intent(out) :: dSV_dT !< Partial derivative of specific volume with !! potential temperature [m3 kg-1 degC-1]. @@ -799,7 +799,7 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, US, dt, fluxes, optics, h, tv, & optional, intent(out) :: dSV_dS !< Partial derivative of specific volume with !! salinity [m3 kg-1 ppt-1]. real, dimension(SZI_(G),SZJ_(G)), & - optional, intent(out) :: SkinBuoyFlux !< Buoyancy flux at surface [Z2 s-3 ~> m2 s-3]. + optional, intent(out) :: SkinBuoyFlux !< Buoyancy flux at surface [Z2 T-3 ~> m2 s-3]. ! Local variables integer, parameter :: maxGroundings = 5 @@ -859,7 +859,7 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, US, dt, fluxes, optics, h, tv, & calculate_buoyancy = present(SkinBuoyFlux) if (calculate_buoyancy) SkinBuoyFlux(:,:) = 0.0 ! I_G_Earth = 1.0 / GV%g_Earth - g_Hconv2 = GV%H_to_Pa * GV%H_to_kg_m2 + g_Hconv2 = (US%m_to_Z**3 * US%T_to_s**2) * GV%H_to_Pa * GV%H_to_kg_m2 if (present(cTKE)) cTKE(:,:,:) = 0.0 if (calculate_buoyancy) then @@ -1049,7 +1049,7 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, US, dt, fluxes, optics, h, tv, & ! rivermix_depth = The prescribed depth over which to mix river inflow ! drho_ds = The gradient of density wrt salt at the ambient surface salinity. ! Sriver = 0 (i.e. rivers are assumed to be pure freshwater) - RivermixConst = -0.5*(CS%rivermix_depth*dt)*GV%Z_to_H*GV%H_to_Pa + RivermixConst = -0.5*(CS%rivermix_depth*dt)*(US%m_to_Z**3 * US%T_to_s**2) * GV%Z_to_H*GV%H_to_Pa cTKE(i,j,k) = cTKE(i,j,k) + max(0.0, RivermixConst*dSV_dS(i,j,1) * & (fluxes%lrunoff(i,j) + fluxes%frunoff(i,j)) * tv%S(i,j,1)) @@ -1061,7 +1061,7 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, US, dt, fluxes, optics, h, tv, & if (h2d(i,k) > 0.0) then if (calculate_energetics .and. (dThickness > 0.)) then ! Calculate the energy required to mix the newly added water over - ! the topmost grid cell. ###CHECK THE SIGNS!!! + ! the topmost grid cell. cTKE(i,j,k) = cTKE(i,j,k) + 0.5*g_Hconv2*(hOld*dThickness) * & ((T2d(i,k) - Temp_in) * dSV_dT(i,j,k) + (tv%S(i,j,k) - Salin_in) * dSV_dS(i,j,k)) endif @@ -1198,7 +1198,7 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, US, dt, fluxes, optics, h, tv, & .false., .true., T2d, Pen_SW_bnd, TKE=pen_TKE_2d, dSV_dT=dSV_dT_2d) k = 1 ! For setting break-points. do k=1,nz ; do i=is,ie - cTKE(i,j,k) = cTKE(i,j,k) + pen_TKE_2d(i,k) + cTKE(i,j,k) = cTKE(i,j,k) + (US%m_to_Z**3 * US%T_to_s**2) * pen_TKE_2d(i,k) enddo ; enddo else call absorbRemainingSW(G, GV, h2d, opacityBand, nsw, j, dt, H_limit_fluxes, & @@ -1265,7 +1265,7 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, US, dt, fluxes, optics, h, tv, & ! 3. Convert to a buoyancy flux, excluding penetrating SW heating ! BGR-Jul 5, 2017: The contribution of SW heating here needs investigated for ePBL. do i=is,ie - SkinBuoyFlux(i,j) = - GoRho * GV%H_to_Z * US%m_to_Z**2 * ( & + SkinBuoyFlux(i,j) = - GoRho * GV%H_to_Z * US%m_to_Z**2 * US%T_to_s**3 * ( & dRhodS(i) * (netSalt_rate(i) - tv%S(i,j,1)*netMassInOut_rate(i)) + & dRhodT(i) * ( netHeat_rate(i) + netPen(i,1)) ) ! m^2/s^3 enddo diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index f09f8745c7..9884e3a51f 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -304,14 +304,14 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & ! [H ~> m or kg m-2] dSV_dT, & ! The partial derivatives of specific volume with temperature dSV_dS, & ! and salinity in [m3 kg-1 degC-1] and [m3 kg-1 ppt-1]. - cTKE, & ! convective TKE requirements for each layer [J/m^2]. + cTKE, & ! convective TKE requirements for each layer [kg m-3 Z3 T-2 ~> J m-2]. u_h, & ! zonal and meridional velocities at thickness points after v_h ! entrainment [m s-1] real, dimension(SZI_(G),SZJ_(G),CS%nMode) :: & cn ! baroclinic gravity wave speeds real, dimension(SZI_(G),SZJ_(G)) :: & Rcv_ml, & ! coordinate density of mixed layer, used for applying sponges - SkinBuoyFlux! 2d surface buoyancy flux [Z2 s-3 ~> m2 s-3], used by ePBL + SkinBuoyFlux! 2d surface buoyancy flux [Z2 T-3 ~> m2 s-3], used by ePBL real, dimension(SZI_(G),SZJ_(G),G%ke) :: h_diag ! diagnostic array for thickness real, dimension(SZI_(G),SZJ_(G),G%ke) :: temp_diag ! diagnostic array for temp real, dimension(SZI_(G),SZJ_(G),G%ke) :: saln_diag ! diagnostic array for salinity @@ -330,7 +330,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & Kd_int, & ! diapycnal diffusivity of interfaces [Z2 T-1 ~> m2 s-1] Kd_heat, & ! diapycnal diffusivity of heat [Z2 s-1 ~> m2 s-1] Kd_salt, & ! diapycnal diffusivity of salt and passive tracers [Z2 s-1 ~> m2 s-1] - Kd_ePBL, & ! test array of diapycnal diffusivities at interfaces [Z2 s-1 ~> m2 s-1] + Kd_ePBL, & ! test array of diapycnal diffusivities at interfaces [Z2 T-1 ~> m2 s-1] eta, & ! Interface heights before diapycnal mixing [m]. Tdif_flx, & ! diffusive diapycnal heat flux across interfaces [degC m s-1] Tadv_flx, & ! advective diapycnal heat flux across interfaces [degC m s-1] @@ -737,7 +737,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & endif call find_uv_at_h(u, v, h, u_h, v_h, G, GV) - call energetic_PBL(h, u_h, v_h, tv, fluxes, dt, Kd_ePBL, G, GV, US, & + call energetic_PBL(h, u_h, v_h, tv, fluxes, US%s_to_T*dt, Kd_ePBL, G, GV, US, & CS%energetic_PBL_CSp, dSV_dT, dSV_dS, cTKE, SkinBuoyFlux, waves=waves) if (associated(Hml)) then @@ -754,11 +754,11 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & do K=2,nz ; do j=js,je ; do i=is,ie !### These expressesions assume a Prandtl number of 1. if (CS%ePBL_is_additive) then - Kd_add_here = Kd_ePBL(i,j,K) - visc%Kv_shear(i,j,K) = visc%Kv_shear(i,j,K) + Kd_ePBL(i,j,K) + Kd_add_here = US%s_to_T*Kd_ePBL(i,j,K) + visc%Kv_shear(i,j,K) = visc%Kv_shear(i,j,K) + US%s_to_T*Kd_ePBL(i,j,K) else - Kd_add_here = max(Kd_ePBL(i,j,K) - visc%Kd_shear(i,j,K), 0.0) - visc%Kv_shear(i,j,K) = max(visc%Kv_shear(i,j,K), Kd_ePBL(i,j,K)) + Kd_add_here = max(US%s_to_T*Kd_ePBL(i,j,K) - visc%Kd_shear(i,j,K), 0.0) + visc%Kv_shear(i,j,K) = max(visc%Kv_shear(i,j,K), US%s_to_T*Kd_ePBL(i,j,K)) endif Kd_heat(i,j,K) = Kd_heat(i,j,K) + Kd_add_here @@ -771,7 +771,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & call hchksum(eb_t, "after ePBL eb_t",G%HI,haloshift=0, scale=GV%H_to_m) call hchksum(ea_s, "after ePBL ea_s",G%HI,haloshift=0, scale=GV%H_to_m) call hchksum(eb_s, "after ePBL eb_s",G%HI,haloshift=0, scale=GV%H_to_m) - call hchksum(Kd_ePBL, "after ePBL Kd_ePBL", G%HI, haloshift=0, scale=US%Z_to_m**2) + call hchksum(Kd_ePBL, "after ePBL Kd_ePBL", G%HI, haloshift=0, scale=US%s_to_T*US%Z_to_m**2) endif else @@ -1158,7 +1158,7 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en ! [H ~> m or kg m-2] dSV_dT, & ! The partial derivative of specific volume with temperature [m3 kg-1 degC-1] dSV_dS, & ! The partial derivative of specific volume with salinity [m3 kg-1 ppt-1]. - cTKE, & ! convective TKE requirements for each layer [J m-2]. + cTKE, & ! convective TKE requirements for each layer [kg m-3 Z3 T-2 ~> J m-2]. u_h, & ! zonal and meridional velocities at thickness points after v_h ! entrainment [m s-1] @@ -1167,7 +1167,7 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en real, dimension(SZI_(G),SZJ_(G)) :: & Rcv_ml, & ! coordinate density of mixed layer, used for applying sponges - SkinBuoyFlux! 2d surface buoyancy flux [m2 s-3], used by ePBL + SkinBuoyFlux! 2d surface buoyancy flux [Z2 T-3 ~> m2 s-3], used by ePBL real, dimension(SZI_(G),SZJ_(G),G%ke) :: h_diag ! diagnostic array for thickness real, dimension(SZI_(G),SZJ_(G),G%ke) :: temp_diag ! diagnostic array for temp real, dimension(SZI_(G),SZJ_(G),G%ke) :: saln_diag ! diagnostic array for salinity @@ -1186,7 +1186,7 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en Kd_int, & ! diapycnal diffusivity of interfaces [Z2 T-1 ~> m2 s-1] Kd_heat, & ! diapycnal diffusivity of heat [Z2 s-1 ~> m2 s-1] Kd_salt, & ! diapycnal diffusivity of salt and passive tracers [Z2 s-1 ~> m2 s-1] - Kd_ePBL, & ! test array of diapycnal diffusivities at interfaces [Z2 s-1 ~> m2 s-1] + Kd_ePBL, & ! test array of diapycnal diffusivities at interfaces [Z2 T-1 ~> m2 s-1] eta, & ! Interface heights before diapycnal mixing [m]. Tdif_flx, & ! diffusive diapycnal heat flux across interfaces [degC m s-1] Tadv_flx, & ! advective diapycnal heat flux across interfaces [degC m s-1] @@ -1627,7 +1627,7 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en !$OMP private(hval) do k=2,nz ; do j=js,je ; do i=is,ie hval=1.0/(h_neglect + 0.5*(h(i,j,k-1) + h(i,j,k))) - ea(i,j,k) = (GV%Z_to_H**2) * dt * hval * (US%s_to_T * Kd_int(i,j,K)) + ea(i,j,k) = (GV%Z_to_H**2) * US%s_to_T*dt * hval * Kd_int(i,j,K) eb(i,j,k-1) = ea(i,j,k) enddo ; enddo ; enddo do j=js,je ; do i=is,ie @@ -1641,7 +1641,7 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en call cpu_clock_begin(id_clock_entrain) ! Calculate appropriately limited diapycnal mass fluxes to account ! for diapycnal diffusion and advection. Sets: ea, eb. Changes: kb - call Entrainment_diffusive(u, v, h, tv, fluxes, dt, G, GV, US, CS%entrain_diffusive_CSp, & + call Entrainment_diffusive(h, tv, fluxes, US%s_to_T*dt, G, GV, US, CS%entrain_diffusive_CSp, & ea, eb, kb, Kd_lay=Kd_lay, Kd_int=Kd_int) call cpu_clock_end(id_clock_entrain) if (showCallTree) call callTree_waypoint("done with Entrainment_diffusive (diabatic)") @@ -1690,7 +1690,7 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en endif call find_uv_at_h(u, v, h, u_h, v_h, G, GV) - call energetic_PBL(h, u_h, v_h, tv, fluxes, dt, Kd_ePBL, G, GV, US, & + call energetic_PBL(h, u_h, v_h, tv, fluxes, US%s_to_T*dt, Kd_ePBL, G, GV, US, & CS%energetic_PBL_CSp, dSV_dT, dSV_dS, cTKE, SkinBuoyFlux, waves=waves) ! If visc%MLD exists, copy the ePBL's MLD into it @@ -1704,11 +1704,11 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en do K=2,nz ; do j=js,je ; do i=is,ie if (CS%ePBL_is_additive) then - Kd_add_here = Kd_ePBL(i,j,K) - visc%Kv_shear(i,j,K) = visc%Kv_shear(i,j,K) + Kd_ePBL(i,j,K) + Kd_add_here = US%s_to_T*Kd_ePBL(i,j,K) + visc%Kv_shear(i,j,K) = visc%Kv_shear(i,j,K) + US%s_to_T*Kd_ePBL(i,j,K) else - Kd_add_here = max(Kd_ePBL(i,j,K) - visc%Kd_shear(i,j,K), 0.0) - visc%Kv_shear(i,j,K) = max(visc%Kv_shear(i,j,K), Kd_ePBL(i,j,K)) + Kd_add_here = max(US%s_to_T*Kd_ePBL(i,j,K) - visc%Kd_shear(i,j,K), 0.0) + visc%Kv_shear(i,j,K) = max(visc%Kv_shear(i,j,K), US%s_to_T*Kd_ePBL(i,j,K)) endif Ent_int = Kd_add_here * (GV%Z_to_H**2 * dt) / & (0.5*(h(i,j,k-1) + h(i,j,k)) + h_neglect) @@ -1725,7 +1725,7 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en if (CS%debug) then call hchksum(ea, "after ePBL ea",G%HI,haloshift=0, scale=GV%H_to_m) call hchksum(eb, "after ePBL eb",G%HI,haloshift=0, scale=GV%H_to_m) - call hchksum(Kd_ePBL, "after ePBL Kd_ePBL", G%HI, haloshift=0, scale=US%Z_to_m**2) + call hchksum(Kd_ePBL, "after ePBL Kd_ePBL", G%HI, haloshift=0, scale=US%Z_to_m**2*US%s_to_T) endif else @@ -2995,7 +2995,7 @@ subroutine diabatic_driver_init(Time, G, GV, US, param_file, useALEalgorithm, di 'Total diapycnal diffusivity at interfaces', 'm2 s-1', conversion=US%Z2_T_to_m2_s) if (CS%use_energetic_PBL) then CS%id_Kd_ePBL = register_diag_field('ocean_model', 'Kd_ePBL', diag%axesTi, Time, & - 'ePBL diapycnal diffusivity at interfaces', 'm2 s-1', conversion=US%Z_to_m**2) + 'ePBL diapycnal diffusivity at interfaces', 'm2 s-1', conversion=US%Z_to_m**2*US%s_to_T) endif CS%id_Kd_heat = register_diag_field('ocean_model', 'Kd_heat', diag%axesTi, Time, & diff --git a/src/parameterizations/vertical/MOM_energetic_PBL.F90 b/src/parameterizations/vertical/MOM_energetic_PBL.F90 index abb63e5d2e..631e9d7144 100644 --- a/src/parameterizations/vertical/MOM_energetic_PBL.F90 +++ b/src/parameterizations/vertical/MOM_energetic_PBL.F90 @@ -37,7 +37,7 @@ module MOM_energetic_PBL !/ Constants real :: VonKar = 0.41 !< The von Karman coefficient. This should be runtime, but because !! it is runtime in KPP and set to 0.4 it might change answers. - real :: omega !< The Earth's rotation rate [s-1]. + real :: omega !< The Earth's rotation rate [T-1]. real :: omega_frac !< When setting the decay scale for turbulence, use this fraction of !! the absolute rotation rate blended with the local value of f, as !! sqrt((1-of)*f^2 + of*4*omega^2) [nondim]. @@ -61,7 +61,7 @@ module MOM_energetic_PBL real :: MKE_to_TKE_effic !< The efficiency with which mean kinetic energy released by !! mechanically forced entrainment of the mixed layer is converted to !! TKE [nondim]. - real :: ustar_min !< A minimum value of ustar to avoid numerical problems [Z s-1 ~> m s-1]. + real :: ustar_min !< A minimum value of ustar to avoid numerical problems [Z T-1 ~> m s-1]. !! If the value is small enough, this should not affect the solution. real :: Ekman_scale_coef !< A nondimensional scaling factor controlling the inhibition of the !! diffusive length scale by rotation. Making this larger decreases @@ -183,7 +183,7 @@ module MOM_energetic_PBL LA_MOD !< Modified Langmuir number [nondim] real, allocatable, dimension(:,:,:) :: & - Velocity_Scale, & !< The velocity scale used in getting Kd [Z s-1 ~> m s-1] + Velocity_Scale, & !< The velocity scale used in getting Kd [Z T-1 ~> m s-1] Mixing_Length !< The length scale used in getting Kd [Z ~> m] !>@{ Diagnostic IDs integer :: id_ML_depth = -1, id_TKE_wind = -1, id_TKE_mixing = -1 @@ -239,7 +239,7 @@ module MOM_energetic_PBL !! have already been applied. All calculations are done implicitly, and there !! is no stability limit on the time step. subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS, & - dSV_dT, dSV_dS, TKE_forced, Buoy_Flux, dt_diag, last_call, & + dSV_dT, dSV_dS, TKE_forced, buoy_flux, dt_diag, last_call, & dT_expected, dS_expected, Waves ) type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. @@ -261,23 +261,24 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS !! volume with salinity [m3 kg-1 ppt-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: TKE_forced !< The forcing requirements to homogenize the - !! forcing that has been applied to each layer [J m-2]. + !! forcing that has been applied to each layer + !! [kg m-3 Z3 T-2 ~> J m-2]. type(thermo_var_ptrs), intent(inout) :: tv !< A structure containing pointers to any !! available thermodynamic fields. Absent fields !! have NULL ptrs. type(forcing), intent(inout) :: fluxes !< A structure containing pointers to any !! possible forcing fields. Unused fields have !! NULL ptrs. - real, intent(in) :: dt !< Time increment [s]. + real, intent(in) :: dt !< Time increment [T ~> s]. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), & intent(out) :: Kd_int !< The diagnosed diffusivities at interfaces !! [Z2 s-1 ~> m2 s-1]. type(energetic_PBL_CS), pointer :: CS !< The control structure returned by a previous !! call to mixedlayer_init. real, dimension(SZI_(G),SZJ_(G)), & - intent(in) :: Buoy_Flux !< The surface buoyancy flux [Z2 s-3 ~> m2 s-3]. + intent(in) :: buoy_flux !< The surface buoyancy flux [Z2 T-3 ~> m2 s-3]. real, optional, intent(in) :: dt_diag !< The diagnostic time step, which may be less - !! than dt if there are two calls to mixedlayer [s]. + !! than dt if there are two calls to mixedlayer [T ~> s]. logical, optional, intent(in) :: last_call !< If true, this is the last call to !! mixedlayer in the current time step, so !! diagnostics will be written. The default @@ -350,7 +351,7 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS real :: MLD_io ! The mixed layer depth found by ePBL_column [Z ~> m]. ! The following are only used for diagnostics. - real :: dt__diag ! A copy of dt_diag (if present) or dt [s]. + real :: dt__diag ! A copy of dt_diag (if present) or dt [T ~> s]. logical :: write_diags ! If true, write out diagnostics with this step. logical :: reset_diags ! If true, zero out the accumulated diagnostics. @@ -406,7 +407,7 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS do k=1,nz ; do i=is,ie 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) T_2d(i,k) = tv%T(i,j,k) ; S_2d(i,k) = tv%S(i,j,k) - TKE_forced_2d(i,k) = (US%m_to_Z**3 * US%T_to_s**2) * TKE_forced(i,j,k) + TKE_forced_2d(i,k) = TKE_forced(i,j,k) dSV_dT_2d(i,k) = dSV_dT(i,j,k) ; dSV_dS_2d(i,k) = dSV_dS(i,j,k) enddo ; enddo @@ -429,7 +430,7 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS ! Make local copies of surface forcing and process them. u_star = US%T_to_s*fluxes%ustar(i,j) u_star_Mean = US%T_to_s*fluxes%ustar_gustless(i,j) - B_flux = US%T_to_s**3*buoy_flux(i,j) + B_flux = buoy_flux(i,j) if (associated(fluxes%ustar_shelf) .and. associated(fluxes%frac_shelf_h)) then if (fluxes%frac_shelf_h(i,j) > 0.0) & u_star = (1.0 - fluxes%frac_shelf_h(i,j)) * u_star + & @@ -450,7 +451,7 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS if (CS%MLD_iteration_guess .and. (CS%ML_Depth(i,j) > 0.0)) MLD_io = CS%ML_Depth(i,j) call ePBL_column(h, u, v, T0, S0, dSV_dT_1d, dSV_dS_1d, TKE_forcing, B_flux, absf, & - u_star, u_star_mean, dt*US%s_to_T, MLD_io, Kd, mixvel, mixlen, GV, & + u_star, u_star_mean, dt, MLD_io, Kd, mixvel, mixlen, GV, & US, CS, eCD, dt_diag=dt_diag, Waves=Waves, G=G, i=i, j=j) @@ -490,9 +491,7 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS if (allocated(CS%La_mod)) CS%La_mod(i,j) = eCD%LAmod else ! End of the ocean-point part of the i-loop ! For masked points, Kd_int must still be set (to 0) because it has intent out. - do K=1,nz+1 - Kd_2d(i,K) = 0. - enddo + do K=1,nz+1 ; Kd_2d(i,K) = 0. ; enddo CS%ML_depth(i,j) = 0.0 if (present(dT_expected)) then @@ -503,9 +502,7 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS endif endif ; enddo ! Close of i-loop - Note unusual loop order! - do K=1,nz+1 ; do i=is,ie - Kd_int(i,j,K) = US%s_to_T * Kd_2d(i,K) - enddo ; enddo + do K=1,nz+1 ; do i=is,ie ; Kd_int(i,j,K) = Kd_2d(i,K) ; enddo ; enddo enddo ! j-loop @@ -567,17 +564,17 @@ subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, abs real, intent(in) :: dt !< Time increment [T ~> s]. real, dimension(SZK_(GV)+1), & intent(out) :: Kd !< The diagnosed diffusivities at interfaces - !! [Z2 s-1 ~> m2 s-1]. + !! [Z2 T-1 ~> m2 s-1]. real, dimension(SZK_(GV)+1), & intent(out) :: mixvel !< The mixing velocity scale used in Kd - !! [Z s-1 ~> m s-1]. + !! [Z T-1 ~> m s-1]. real, dimension(SZK_(GV)+1), & intent(out) :: mixlen !< The mixing length scale used in Kd [Z ~> m]. type(energetic_PBL_CS), pointer :: CS !< The control structure returned by a previous !! call to mixedlayer_init. type(ePBL_column_diags), intent(inout) :: eCD !< A container for passing around diagnostics. real, optional, intent(in) :: dt_diag !< The diagnostic time step, which may be less - !! than dt if there are two calls to mixedlayer [s]. + !! than dt if there are two calls to mixedlayer [T ~> s]. type(wave_parameters_CS), & optional, pointer :: Waves !< Wave CS for Langmuir turbulence type(ocean_grid_type), & @@ -672,7 +669,7 @@ subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, abs ! the MKE conversion equation [H-1 ~> m-1 or m2 kg-1]. real :: dt_h ! The timestep divided by the averages of the thicknesses around - ! a layer, times a thickness conversion factor [H s m-2 ~> s m-1 or kg s m-4]. + ! a layer, times a thickness conversion factor [H T m-2 ~> s m-1 or kg s m-4]. real :: h_bot ! The distance from the bottom [H ~> m or kg m-2]. real :: h_rsum ! The running sum of h from the top [Z ~> m]. real :: I_hs ! The inverse of h_sum [H-1 ~> m-1 or m2 kg-1]. @@ -788,7 +785,7 @@ subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, abs h_neglect = GV%H_subroundoff C1_3 = 1.0 / 3.0 - dt__diag = dt ; if (present(dt_diag)) dt__diag = dt_diag * US%s_to_T + dt__diag = dt ; if (present(dt_diag)) dt__diag = dt_diag I_dtdiag = 1.0 / dt__diag max_itt = 20 diff --git a/src/parameterizations/vertical/MOM_entrain_diffusive.F90 b/src/parameterizations/vertical/MOM_entrain_diffusive.F90 index 34b48257bb..17c90dad2f 100644 --- a/src/parameterizations/vertical/MOM_entrain_diffusive.F90 +++ b/src/parameterizations/vertical/MOM_entrain_diffusive.F90 @@ -48,15 +48,11 @@ module MOM_entrain_diffusive !! the buoyancy flux in a layer and inversely proportional to the density !! differences between layers. The scheme that is used here is described in !! detail in Hallberg, Mon. Wea. Rev. 2000. -subroutine entrainment_diffusive(u, v, h, tv, fluxes, dt, G, GV, US, CS, ea, eb, & +subroutine entrainment_diffusive(h, tv, fluxes, dt, G, GV, US, CS, ea, eb, & kb_out, Kd_Lay, Kd_int) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & - intent(in) :: u !< The zonal velocity [m s-1]. - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - intent(in) :: v !< The meridional velocity [m s-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]. type(thermo_var_ptrs), intent(in) :: tv !< A structure containing pointers to any available @@ -64,7 +60,7 @@ subroutine entrainment_diffusive(u, v, h, tv, fluxes, dt, G, GV, US, CS, ea, eb, !! ptrs. type(forcing), intent(in) :: fluxes !< A structure of surface fluxes that may !! be used. - real, intent(in) :: dt !< The time increment [s]. + real, intent(in) :: dt !< The time increment [T ~> s]. type(entrain_diffusive_CS), pointer :: CS !< The control structure returned by a previous !! call to entrain_diffusive_init. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & @@ -175,7 +171,7 @@ subroutine entrainment_diffusive(u, v, h, tv, fluxes, dt, G, GV, US, CS, ea, eb, real :: dRHo ! The change in locally referenced potential density between ! the layers above and below an interface [kg m-3]. real :: g_2dt ! 0.5 * G_Earth / dt, times unit conversion factors - ! [m3 H-2 s-3 ~> m s-3 or m7 kg-2 s-3]. + ! [m3 H-2 s-2 T-1 ~> m s-3 or m7 kg-2 s-3]. real, dimension(SZI_(G)) :: & pressure, & ! The pressure at an interface [Pa]. T_eos, S_eos, & ! The potential temperature and salinity at which to @@ -197,7 +193,7 @@ subroutine entrainment_diffusive(u, v, h, tv, fluxes, dt, G, GV, US, CS, ea, eb, real :: ea_cor ! The corrective adjustment to eakb [H ~> m or kg m-2]. real :: h1 ! The layer thickness after entrainment through the ! interface below is taken into account [H ~> m or kg m-2]. - real :: Idt ! The inverse of the time step [s-1]. + real :: Idt ! The inverse of the time step [T-1 ~> s-1]. logical :: do_any logical :: do_i(SZI_(G)), did_i(SZI_(G)), reiterate, correct_density @@ -271,25 +267,23 @@ subroutine entrainment_diffusive(u, v, h, tv, fluxes, dt, G, GV, US, CS, ea, eb, if (present(Kd_Lay)) then do k=1,nz ; do i=is,ie - dtKd(i,k) = GV%Z_to_H**2 * (dt * (US%s_to_T * Kd_lay(i,j,k))) + dtKd(i,k) = GV%Z_to_H**2 * (dt * Kd_lay(i,j,k)) enddo ; enddo if (present(Kd_int)) then do K=1,nz+1 ; do i=is,ie - dtKd_int(i,K) = GV%Z_to_H**2 * (dt * (US%s_to_T * Kd_int(i,j,K))) + dtKd_int(i,K) = GV%Z_to_H**2 * (dt * Kd_int(i,j,K)) enddo ; enddo else do K=2,nz ; do i=is,ie - dtKd_int(i,K) = GV%Z_to_H**2 * (0.5 * dt & - * (US%s_to_T * (Kd_lay(i,j,k-1) + Kd_lay(i,j,k)))) + dtKd_int(i,K) = GV%Z_to_H**2 * (0.5 * dt * (Kd_lay(i,j,k-1) + Kd_lay(i,j,k))) enddo ; enddo endif else ! Kd_int must be present, or there already would have been an error. do k=1,nz ; do i=is,ie - dtKd(i,k) = GV%Z_to_H**2 * (0.5 * dt & - * (US%T_to_s * (Kd_int(i,j,K)+Kd_int(i,j,K+1)))) + dtKd(i,k) = GV%Z_to_H**2 * (0.5 * dt * (Kd_int(i,j,K)+Kd_int(i,j,K+1))) enddo ; enddo dO K=1,nz+1 ; do i=is,ie - dtKd_int(i,K) = GV%Z_to_H**2 * (dt * (US%T_to_s * Kd_int(i,j,K))) + dtKd_int(i,K) = GV%Z_to_H**2 * (dt * Kd_int(i,j,K)) enddo ; enddo endif @@ -2132,9 +2126,9 @@ subroutine entrain_diffusive_init(Time, G, GV, US, param_file, diag, CS) units="m", default=MAX(100.0*GV%Angstrom_m,1.0e-4*sqrt(dt*Kd)), scale=GV%m_to_H) CS%id_Kd = register_diag_field('ocean_model', 'Kd_effective', diag%axesTL, Time, & - 'Diapycnal diffusivity as applied', 'm2 s-1', conversion=US%Z_to_m**2) + 'Diapycnal diffusivity as applied', 'm2 s-1', conversion=US%Z_to_m**2*US%s_to_T) CS%id_diff_work = register_diag_field('ocean_model', 'diff_work', diag%axesTi, Time, & - 'Work actually done by diapycnal diffusion across each interface', 'W m-2', conversion=US%Z_to_m) + 'Work actually done by diapycnal diffusion across each interface', 'W m-2', conversion=US%Z_to_m*US%s_to_T) end subroutine entrain_diffusive_init From 5590d6b3e9b3ed78c032494bf5caaa7d79692fdc Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Fri, 21 Jun 2019 15:56:24 -0400 Subject: [PATCH 27/82] +Added dimensional testing for diffusivities Added rescaling of time units for dimensional consistency testing of diffusivities for heat and salt, including the values returned from CVMix_KPP. All answers are bitwise identical. --- .../vertical/MOM_CVMix_KPP.F90 | 26 ++--- .../vertical/MOM_diabatic_driver.F90 | 102 +++++++++--------- 2 files changed, 64 insertions(+), 64 deletions(-) diff --git a/src/parameterizations/vertical/MOM_CVMix_KPP.F90 b/src/parameterizations/vertical/MOM_CVMix_KPP.F90 index 06494528e1..10ff57f528 100644 --- a/src/parameterizations/vertical/MOM_CVMix_KPP.F90 +++ b/src/parameterizations/vertical/MOM_CVMix_KPP.F90 @@ -499,7 +499,7 @@ logical function KPP_init(paramFile, G, GV, US, diag, Time, CS, passive, Waves) CS%id_Kt_KPP = register_diag_field('ocean_model', 'KPP_Kheat', diag%axesTi, Time, & 'Heat diffusivity due to KPP, as calculated by [CVMix] KPP', 'm2/s') CS%id_Kd_in = register_diag_field('ocean_model', 'KPP_Kd_in', diag%axesTi, Time, & - 'Diffusivity passed to KPP', 'm2/s', conversion=US%Z_to_m**2) + 'Diffusivity passed to KPP', 'm2/s', conversion=US%Z2_T_to_m2_s) CS%id_Ks_KPP = register_diag_field('ocean_model', 'KPP_Ksalt', diag%axesTi, Time, & 'Salt diffusivity due to KPP, as calculated by [CVMix] KPP', 'm2/s') CS%id_Kv_KPP = register_diag_field('ocean_model', 'KPP_Kv', diag%axesTi, Time, & @@ -594,10 +594,10 @@ subroutine KPP_calculate(CS, G, GV, US, h, uStar, & real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(in) :: buoyFlux !< Surface buoyancy flux [m2 s-3] real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(inout) :: Kt !< (in) Vertical diffusivity of heat w/o KPP !! (out) Vertical diffusivity including KPP - !! [Z2 s-1 ~> m2 s-1] + !! [Z2 T-1 ~> m2 s-1] real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(inout) :: Ks !< (in) Vertical diffusivity of salt w/o KPP !! (out) Vertical diffusivity including KPP - !! [Z2 s-1 ~> m2 s-1] + !! [Z2 T-1 ~> m2 s-1] real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(inout) :: Kv !< (in) Vertical viscosity w/o KPP !! (out) Vertical viscosity including KPP !! [Z2 s-1 ~> m2 s-1] @@ -626,8 +626,8 @@ subroutine KPP_calculate(CS, G, GV, US, h, uStar, & call hchksum(h, "KPP in: h",G%HI,haloshift=0, scale=GV%H_to_m) call hchksum(uStar, "KPP in: uStar",G%HI,haloshift=0, scale=US%Z_to_m) call hchksum(buoyFlux, "KPP in: buoyFlux",G%HI,haloshift=0) - call hchksum(Kt, "KPP in: Kt",G%HI,haloshift=0, scale=US%Z_to_m**2) - call hchksum(Ks, "KPP in: Ks",G%HI,haloshift=0, scale=US%Z_to_m**2) + call hchksum(Kt, "KPP in: Kt",G%HI,haloshift=0, scale=US%Z2_T_to_m2_s) + call hchksum(Ks, "KPP in: Ks",G%HI,haloshift=0, scale=US%Z2_T_to_m2_s) endif #endif @@ -683,8 +683,8 @@ subroutine KPP_calculate(CS, G, GV, US, h, uStar, & Kdiffusivity(:,:) = 0. ! Diffusivities for heat and salt [m2 s-1] Kviscosity(:) = 0. ! Viscosity [m2 s-1] else - Kdiffusivity(:,1) = US%Z_to_m**2 * Kt(i,j,:) - Kdiffusivity(:,2) = US%Z_to_m**2 * Ks(i,j,:) + Kdiffusivity(:,1) = US%Z_to_m**2*US%T_to_s * Kt(i,j,:) + Kdiffusivity(:,2) = US%Z_to_m**2*US%T_to_s * Ks(i,j,:) Kviscosity(:) = US%Z_to_m**2 * Kv(i,j,:) endif @@ -828,15 +828,15 @@ subroutine KPP_calculate(CS, G, GV, US, h, uStar, & if (.not. CS%passiveMode) then if (CS%KPPisAdditive) then do k=1, G%ke+1 - Kt(i,j,k) = Kt(i,j,k) + US%m_to_Z**2 * Kdiffusivity(k,1) - Ks(i,j,k) = Ks(i,j,k) + US%m_to_Z**2 * Kdiffusivity(k,2) + Kt(i,j,k) = Kt(i,j,k) + US%m2_s_to_Z2_T * Kdiffusivity(k,1) + Ks(i,j,k) = Ks(i,j,k) + US%m2_s_to_Z2_T * Kdiffusivity(k,2) Kv(i,j,k) = Kv(i,j,k) + US%m_to_Z**2 * Kviscosity(k) if (CS%Stokes_Mixing) Waves%KvS(i,j,k) = US%Z_to_m**2 * Kv(i,j,k) enddo else ! KPP replaces prior diffusivity when former is non-zero do k=1, G%ke+1 - if (Kdiffusivity(k,1) /= 0.) Kt(i,j,k) = US%m_to_Z**2 * Kdiffusivity(k,1) - if (Kdiffusivity(k,2) /= 0.) Ks(i,j,k) = US%m_to_Z**2 * Kdiffusivity(k,2) + if (Kdiffusivity(k,1) /= 0.) Kt(i,j,k) = US%m2_s_to_Z2_T * Kdiffusivity(k,1) + if (Kdiffusivity(k,2) /= 0.) Ks(i,j,k) = US%m2_s_to_Z2_T * Kdiffusivity(k,2) if (Kviscosity(k) /= 0.) Kv(i,j,k) = US%m_to_Z**2 * Kviscosity(k) if (CS%Stokes_Mixing) Waves%KvS(i,j,k) = US%Z_to_m**2 * Kv(i,j,k) enddo @@ -851,8 +851,8 @@ subroutine KPP_calculate(CS, G, GV, US, h, uStar, & #ifdef __DO_SAFETY_CHECKS__ if (CS%debug) then - call hchksum(Kt, "KPP out: Kt", G%HI, haloshift=0, scale=US%Z_to_m**2) - call hchksum(Ks, "KPP out: Ks", G%HI, haloshift=0, scale=US%Z_to_m**2) + call hchksum(Kt, "KPP out: Kt", G%HI, haloshift=0, scale=US%Z2_T_to_m2_s) + call hchksum(Ks, "KPP out: Ks", G%HI, haloshift=0, scale=US%Z2_T_to_m2_s) endif #endif diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index 9884e3a51f..d77b3d5311 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -151,11 +151,11 @@ module MOM_diabatic_driver !! operating. real :: Kd_BBL_tr !< A bottom boundary layer tracer diffusivity that !! will allow for explicitly specified bottom fluxes - !! [Z2 s-1 ~> m2 s-1]. The entrainment at the bottom is at + !! [Z2 T-1 ~> m2 s-1]. The entrainment at the bottom is at !! least sqrt(Kd_BBL_tr*dt) over the same distance. real :: Kd_min_tr !< A minimal diffusivity that should always be !! applied to tracers, especially in massless layers - !! near the bottom [Z2 s-1 ~> m2 s-1]. + !! near the bottom [Z2 T-1 ~> m2 s-1]. real :: minimum_forcing_depth = 0.001 !< The smallest depth over which heat and freshwater !! fluxes are applied [m]. real :: evap_CFL_limit = 0.8 !< The largest fraction of a layer that can be @@ -328,8 +328,8 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), target :: & Kd_int, & ! diapycnal diffusivity of interfaces [Z2 T-1 ~> m2 s-1] - Kd_heat, & ! diapycnal diffusivity of heat [Z2 s-1 ~> m2 s-1] - Kd_salt, & ! diapycnal diffusivity of salt and passive tracers [Z2 s-1 ~> m2 s-1] + Kd_heat, & ! diapycnal diffusivity of heat [Z2 T-1 ~> m2 s-1] + Kd_salt, & ! diapycnal diffusivity of salt and passive tracers [Z2 T-1 ~> m2 s-1] Kd_ePBL, & ! test array of diapycnal diffusivities at interfaces [Z2 T-1 ~> m2 s-1] eta, & ! Interface heights before diapycnal mixing [m]. Tdif_flx, & ! diffusive diapycnal heat flux across interfaces [degC m s-1] @@ -385,7 +385,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & integer :: ig, jg ! global indices for testing testing itide point source (BDM) logical :: avg_enabled ! for testing internal tides (BDM) - real :: Kd_add_here ! An added diffusivity [Z2 s-1 ~> m2 s-1]. + real :: Kd_add_here ! An added diffusivity [Z2 T-1 ~> m2 s-1]. is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB @@ -571,20 +571,20 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & !$OMP parallel do default(shared) do k=1,nz+1 ; do j=js,je ; do i=is,ie - Kd_salt(i,j,k) = US%s_to_T * Kd_int(i,j,K) - Kd_heat(i,j,k) = US%s_to_T * Kd_int(i,j,K) + Kd_salt(i,j,k) = Kd_int(i,j,K) + Kd_heat(i,j,k) = Kd_int(i,j,K) enddo ; enddo ; enddo ! Add contribution from double diffusion if (associated(visc%Kd_extra_S)) then !$OMP parallel do default(shared) do k=1,nz+1 ; do j=js,je ; do i=is,ie - Kd_salt(i,j,k) = Kd_salt(i,j,k) + visc%Kd_extra_S(i,j,k) + Kd_salt(i,j,k) = Kd_salt(i,j,k) + US%T_to_s*visc%Kd_extra_S(i,j,k) enddo ; enddo ; enddo endif if (associated(visc%Kd_extra_T)) then !$OMP parallel do default(shared) do k=1,nz+1 ; do j=js,je ; do i=is,ie - Kd_heat(i,j,k) = Kd_heat(i,j,k) + visc%Kd_extra_T(i,j,k) + Kd_heat(i,j,k) = Kd_heat(i,j,k) + US%T_to_s*visc%Kd_extra_T(i,j,k) enddo ; enddo ; enddo endif @@ -592,8 +592,8 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & call MOM_state_chksum("after set_diffusivity ", u, v, h, G, GV, haloshift=0) call MOM_forcing_chksum("after set_diffusivity ", fluxes, G, US, haloshift=0) call MOM_thermovar_chksum("after set_diffusivity ", tv, G) - call hchksum(Kd_heat, "after set_diffusivity Kd_heat", G%HI, haloshift=0, scale=US%Z_to_m**2) - call hchksum(Kd_salt, "after set_diffusivity Kd_salt", G%HI, haloshift=0, scale=US%Z_to_m**2) + call hchksum(Kd_heat, "after set_diffusivity Kd_heat", G%HI, haloshift=0, scale=US%Z2_T_to_m2_s) + call hchksum(Kd_salt, "after set_diffusivity Kd_salt", G%HI, haloshift=0, scale=US%Z2_T_to_m2_s) endif if (CS%useKPP) then @@ -616,7 +616,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & fluxes%ustar, CS%KPP_buoy_flux, Waves=Waves) call KPP_calculate(CS%KPP_CSp, G, GV, US, h, fluxes%ustar, CS%KPP_buoy_flux, Kd_heat, & - Kd_salt, visc%Kv_shear, CS%KPP_NLTheat, CS%KPP_NLTscalar, Waves=Waves) + Kd_salt, visc%Kv_shear, CS%KPP_NLTheat, CS%KPP_NLTscalar, Waves=Waves) if (associated(Hml)) then !$OMP parallel default(shared) @@ -633,8 +633,8 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & call MOM_state_chksum("after KPP", u, v, h, G, GV, haloshift=0) call MOM_forcing_chksum("after KPP", fluxes, G, US, haloshift=0) call MOM_thermovar_chksum("after KPP", tv, G) - call hchksum(Kd_heat, "after KPP Kd_heat", G%HI, haloshift=0, scale=US%Z_to_m**2) - call hchksum(Kd_salt, "after KPP Kd_salt", G%HI, haloshift=0, scale=US%Z_to_m**2) + call hchksum(Kd_heat, "after KPP Kd_heat", G%HI, haloshift=0, scale=US%Z2_T_to_m2_s) + call hchksum(Kd_salt, "after KPP Kd_salt", G%HI, haloshift=0, scale=US%Z2_T_to_m2_s) endif endif ! endif for KPP @@ -680,8 +680,8 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & if (.not. CS%useKPP) then !$OMP parallel do default(shared) do K=2,nz ; do j=js,je ; do i=is,ie - Kd_heat(i,j,K) = Kd_heat(i,j,K) + visc%Kd_extra_T(i,j,K) - Kd_salt(i,j,K) = Kd_salt(i,j,K) + visc%Kd_extra_S(i,j,K) + Kd_heat(i,j,K) = Kd_heat(i,j,K) + US%T_to_s*visc%Kd_extra_T(i,j,K) + Kd_salt(i,j,K) = Kd_salt(i,j,K) + US%T_to_s*visc%Kd_extra_S(i,j,K) enddo ; enddo ; enddo endif @@ -693,8 +693,8 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & ! Increment vertical diffusion and viscosity due to convection !$OMP parallel do default(shared) do k=1,nz+1 ; do j=js,je ; do i=is,ie - Kd_heat(i,j,k) = Kd_heat(i,j,k) + CS%CVMix_conv_csp%kd_conv(i,j,k) - Kd_salt(i,j,k) = Kd_salt(i,j,k) + CS%CVMix_conv_csp%kd_conv(i,j,k) + Kd_heat(i,j,k) = Kd_heat(i,j,k) + US%T_to_s*CS%CVMix_conv_csp%kd_conv(i,j,k) + Kd_salt(i,j,k) = Kd_salt(i,j,k) + US%T_to_s*CS%CVMix_conv_csp%kd_conv(i,j,k) if (CS%useKPP) then visc%Kv_shear(i,j,k) = visc%Kv_shear(i,j,k) + CS%CVMix_conv_csp%kv_conv(i,j,k) else @@ -754,10 +754,10 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & do K=2,nz ; do j=js,je ; do i=is,ie !### These expressesions assume a Prandtl number of 1. if (CS%ePBL_is_additive) then - Kd_add_here = US%s_to_T*Kd_ePBL(i,j,K) + Kd_add_here = Kd_ePBL(i,j,K) visc%Kv_shear(i,j,K) = visc%Kv_shear(i,j,K) + US%s_to_T*Kd_ePBL(i,j,K) else - Kd_add_here = max(US%s_to_T*Kd_ePBL(i,j,K) - visc%Kd_shear(i,j,K), 0.0) + Kd_add_here = max(Kd_ePBL(i,j,K) - US%T_to_s*visc%Kd_shear(i,j,K), 0.0) visc%Kv_shear(i,j,K) = max(visc%Kv_shear(i,j,K), US%s_to_T*Kd_ePBL(i,j,K)) endif @@ -771,7 +771,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & call hchksum(eb_t, "after ePBL eb_t",G%HI,haloshift=0, scale=GV%H_to_m) call hchksum(ea_s, "after ePBL ea_s",G%HI,haloshift=0, scale=GV%H_to_m) call hchksum(eb_s, "after ePBL eb_s",G%HI,haloshift=0, scale=GV%H_to_m) - call hchksum(Kd_ePBL, "after ePBL Kd_ePBL", G%HI, haloshift=0, scale=US%s_to_T*US%Z_to_m**2) + call hchksum(Kd_ePBL, "after ePBL Kd_ePBL", G%HI, haloshift=0, scale=US%Z2_T_to_m2_s) endif else @@ -839,9 +839,9 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & !$OMP parallel do default(shared) private(hval) do k=2,nz ; do j=js,je ; do i=is,ie hval = 1.0 / (h_neglect + 0.5*(h(i,j,k-1) + h(i,j,k))) - ea_t(i,j,k) = (GV%Z_to_H**2) * dt * hval * Kd_heat(i,j,k) + ea_t(i,j,k) = (GV%Z_to_H**2) * US%s_to_T*dt * hval * Kd_heat(i,j,k) eb_t(i,j,k-1) = ea_t(i,j,k) - ea_s(i,j,k) = (GV%Z_to_H**2) * dt * hval * Kd_salt(i,j,k) + ea_s(i,j,k) = (GV%Z_to_H**2) * US%s_to_T*dt * hval * Kd_salt(i,j,k) eb_s(i,j,k-1) = ea_s(i,j,k) enddo ; enddo ; enddo do j=js,je ; do i=is,ie @@ -925,7 +925,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & call cpu_clock_begin(id_clock_tracers) if (CS%mix_boundary_tracers) then - Tr_ea_BBL = GV%Z_to_H * sqrt(dt*CS%Kd_BBL_tr) + Tr_ea_BBL = GV%Z_to_H * sqrt(dt*US%s_to_T*CS%Kd_BBL_tr) !$OMP parallel do default(shared) private(htot,in_boundary,add_ent) do j=js,je do i=is,ie @@ -944,7 +944,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & ! in the calculation of the fluxes in the first place. Kd_min_tr ! should be much less than the values that have been set in Kd_lay, ! perhaps a molecular diffusivity. - add_ent = ((dt * CS%Kd_min_tr) * GV%Z_to_H**2) * & + add_ent = ((dt*US%s_to_T * CS%Kd_min_tr) * GV%Z_to_H**2) * & ((h(i,j,k-1)+h(i,j,k)+h_neglect) / & (h(i,j,k-1)*h(i,j,k)+h_neglect2)) - & 0.5*(ea_s(i,j,k) + eb_s(i,j,k-1)) @@ -1184,8 +1184,8 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), target :: & Kd_int, & ! diapycnal diffusivity of interfaces [Z2 T-1 ~> m2 s-1] - Kd_heat, & ! diapycnal diffusivity of heat [Z2 s-1 ~> m2 s-1] - Kd_salt, & ! diapycnal diffusivity of salt and passive tracers [Z2 s-1 ~> m2 s-1] + Kd_heat, & ! diapycnal diffusivity of heat [Z2 s-T ~> m2 s-1] + Kd_salt, & ! diapycnal diffusivity of salt and passive tracers [Z2 T-1 ~> m2 s-1] Kd_ePBL, & ! test array of diapycnal diffusivities at interfaces [Z2 T-1 ~> m2 s-1] eta, & ! Interface heights before diapycnal mixing [m]. Tdif_flx, & ! diffusive diapycnal heat flux across interfaces [degC m s-1] @@ -1241,7 +1241,7 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en integer :: ig, jg ! global indices for testing testing itide point source (BDM) logical :: avg_enabled ! for testing internal tides (BDM) - real :: Kd_add_here ! An added diffusivity [Z2 s-1 ~> m2 s-1]. + real :: Kd_add_here ! An added diffusivity [Z2 T-1 ~> m2 s-1]. is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB @@ -1495,19 +1495,19 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en !$OMP parallel do default(shared) do k=1,nz+1 ; do j=js,je ; do i=is,ie - Kd_salt(i,j,k) = US%s_to_T * Kd_int(i,j,K) - Kd_heat(i,j,k) = US%s_to_T * Kd_int(i,j,K) + Kd_salt(i,j,k) = Kd_int(i,j,K) + Kd_heat(i,j,k) = Kd_int(i,j,K) enddo ; enddo ; enddo if (associated(visc%Kd_extra_S)) then !$OMP parallel do default(shared) do k=1,nz+1 ; do j=js,je ; do i=is,ie - Kd_salt(i,j,k) = Kd_salt(i,j,k) + visc%Kd_extra_S(i,j,k) + Kd_salt(i,j,k) = Kd_salt(i,j,k) + US%T_to_s*visc%Kd_extra_S(i,j,k) enddo ; enddo ; enddo endif if (associated(visc%Kd_extra_T)) then !$OMP parallel do default(shared) do k=1,nz+1 ; do j=js,je ; do i=is,ie - Kd_heat(i,j,k) = Kd_heat(i,j,k) + visc%Kd_extra_T(i,j,k) + Kd_heat(i,j,k) = Kd_heat(i,j,k) + US%T_to_s*visc%Kd_extra_T(i,j,k) enddo ; enddo ; enddo endif @@ -1527,18 +1527,18 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en if (.not. CS%KPPisPassive) then !$OMP parallel do default(shared) do k=1,nz+1 ; do j=js,je ; do i=is,ie - Kd_int(i,j,K) = US%T_to_s * min( Kd_salt(i,j,k), Kd_heat(i,j,k) ) + Kd_int(i,j,K) = min( Kd_salt(i,j,k), Kd_heat(i,j,k) ) enddo ; enddo ; enddo if (associated(visc%Kd_extra_S)) then !$OMP parallel do default(shared) do k=1,nz+1 ; do j=js,je ; do i=is,ie - visc%Kd_extra_S(i,j,k) = (Kd_salt(i,j,k) - US%s_to_T * Kd_int(i,j,K)) + visc%Kd_extra_S(i,j,k) = US%s_to_T*(Kd_salt(i,j,k) - Kd_int(i,j,K)) enddo ; enddo ; enddo endif if (associated(visc%Kd_extra_T)) then !$OMP parallel do default(shared) do k=1,nz+1 ; do j=js,je ; do i=is,ie - visc%Kd_extra_T(i,j,k) = (Kd_heat(i,j,k) - US%s_to_T * Kd_int(i,j,K)) + visc%Kd_extra_T(i,j,k) = US%s_to_T*(Kd_heat(i,j,k) - Kd_int(i,j,K)) enddo ; enddo ; enddo endif endif ! not passive @@ -1606,8 +1606,8 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en ! CS%useKPP==.true. already has extra_T and extra_S included if (.not. CS%useKPP) then do K=2,nz ; do j=js,je ; do i=is,ie - Kd_heat(i,j,K) = Kd_heat(i,j,K) + visc%Kd_extra_T(i,j,K) - Kd_salt(i,j,K) = Kd_salt(i,j,K) + visc%Kd_extra_S(i,j,K) + Kd_heat(i,j,K) = Kd_heat(i,j,K) + US%T_to_s*visc%Kd_extra_T(i,j,K) + Kd_salt(i,j,K) = Kd_salt(i,j,K) + US%T_to_s*visc%Kd_extra_S(i,j,K) enddo ; enddo ; enddo endif @@ -1704,28 +1704,28 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en do K=2,nz ; do j=js,je ; do i=is,ie if (CS%ePBL_is_additive) then - Kd_add_here = US%s_to_T*Kd_ePBL(i,j,K) + Kd_add_here = Kd_ePBL(i,j,K) visc%Kv_shear(i,j,K) = visc%Kv_shear(i,j,K) + US%s_to_T*Kd_ePBL(i,j,K) else - Kd_add_here = max(US%s_to_T*Kd_ePBL(i,j,K) - visc%Kd_shear(i,j,K), 0.0) + Kd_add_here = max(Kd_ePBL(i,j,K) - US%T_to_s*visc%Kd_shear(i,j,K), 0.0) visc%Kv_shear(i,j,K) = max(visc%Kv_shear(i,j,K), US%s_to_T*Kd_ePBL(i,j,K)) endif - Ent_int = Kd_add_here * (GV%Z_to_H**2 * dt) / & + Ent_int = Kd_add_here * (GV%Z_to_H**2 * US%s_to_T*dt) / & (0.5*(h(i,j,k-1) + h(i,j,k)) + h_neglect) eb(i,j,k-1) = eb(i,j,k-1) + Ent_int ea(i,j,k) = ea(i,j,k) + Ent_int - Kd_int(i,j,K) = Kd_int(i,j,K) + US%T_to_s * Kd_add_here + Kd_int(i,j,K) = Kd_int(i,j,K) + Kd_add_here ! for diagnostics - Kd_heat(i,j,K) = Kd_heat(i,j,K) + US%T_to_s * Kd_int(i,j,K) - Kd_salt(i,j,K) = Kd_salt(i,j,K) + US%T_to_s * Kd_int(i,j,K) + Kd_heat(i,j,K) = Kd_heat(i,j,K) + Kd_int(i,j,K) + Kd_salt(i,j,K) = Kd_salt(i,j,K) + Kd_int(i,j,K) enddo ; enddo ; enddo if (CS%debug) then call hchksum(ea, "after ePBL ea",G%HI,haloshift=0, scale=GV%H_to_m) call hchksum(eb, "after ePBL eb",G%HI,haloshift=0, scale=GV%H_to_m) - call hchksum(Kd_ePBL, "after ePBL Kd_ePBL", G%HI, haloshift=0, scale=US%Z_to_m**2*US%s_to_T) + call hchksum(Kd_ePBL, "after ePBL Kd_ePBL", G%HI, haloshift=0, scale=US%Z2_T_to_m2_s) endif else @@ -2047,7 +2047,7 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en ! mixing of passive tracers from massless boundary layers to interior call cpu_clock_begin(id_clock_tracers) if (CS%mix_boundary_tracers) then - Tr_ea_BBL = sqrt(dt*CS%Kd_BBL_tr) !### I think this needs GV%Z_to_H + Tr_ea_BBL = sqrt(dt*US%s_to_T*CS%Kd_BBL_tr) !### I think this needs GV%Z_to_H !$OMP parallel do default(shared) private(htot,in_boundary,add_ent) do j=js,je do i=is,ie @@ -2066,7 +2066,7 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en ! in the calculation of the fluxes in the first place. Kd_min_tr ! should be much less than the values that have been set in Kd_lay, ! perhaps a molecular diffusivity. - add_ent = ((dt * CS%Kd_min_tr) * GV%Z_to_H**2) * & + add_ent = ((dt*US%s_to_T * CS%Kd_min_tr) * GV%Z_to_H**2) * & ((h(i,j,k-1)+h(i,j,k)+h_neglect) / & (h(i,j,k-1)*h(i,j,k)+h_neglect2)) - & 0.5*(ea(i,j,k) + eb(i,j,k-1)) @@ -2870,12 +2870,12 @@ subroutine diabatic_driver_init(Time, G, GV, US, param_file, useALEalgorithm, di call get_param(param_file, mdl, "KD_MIN_TR", CS%Kd_min_tr, & "A minimal diffusivity that should always be applied to "//& "tracers, especially in massless layers near the bottom. "//& - "The default is 0.1*KD.", units="m2 s-1", default=0.1*Kd, scale=US%m_to_Z**2) + "The default is 0.1*KD.", units="m2 s-1", default=0.1*Kd, scale=US%m2_s_to_Z2_T) call get_param(param_file, mdl, "KD_BBL_TR", CS%Kd_BBL_tr, & "A bottom boundary layer tracer diffusivity that will "//& "allow for explicitly specified bottom fluxes. The "//& "entrainment at the bottom is at least sqrt(Kd_BBL_tr*dt) "//& - "over the same distance.", units="m2 s-1", default=0., scale=US%m_to_Z**2) + "over the same distance.", units="m2 s-1", default=0., scale=US%m2_s_to_Z2_T) endif call get_param(param_file, mdl, "TRACER_TRIDIAG", CS%tracer_tridiag, & @@ -2995,16 +2995,16 @@ subroutine diabatic_driver_init(Time, G, GV, US, param_file, useALEalgorithm, di 'Total diapycnal diffusivity at interfaces', 'm2 s-1', conversion=US%Z2_T_to_m2_s) if (CS%use_energetic_PBL) then CS%id_Kd_ePBL = register_diag_field('ocean_model', 'Kd_ePBL', diag%axesTi, Time, & - 'ePBL diapycnal diffusivity at interfaces', 'm2 s-1', conversion=US%Z_to_m**2*US%s_to_T) + 'ePBL diapycnal diffusivity at interfaces', 'm2 s-1', conversion=US%Z2_T_to_m2_s) endif CS%id_Kd_heat = register_diag_field('ocean_model', 'Kd_heat', diag%axesTi, Time, & - 'Total diapycnal diffusivity for heat at interfaces', 'm2 s-1', conversion=US%Z_to_m**2, & + 'Total diapycnal diffusivity for heat at interfaces', 'm2 s-1', conversion=US%Z2_T_to_m2_s, & cmor_field_name='difvho', & cmor_standard_name='ocean_vertical_heat_diffusivity', & cmor_long_name='Ocean vertical heat diffusivity') CS%id_Kd_salt = register_diag_field('ocean_model', 'Kd_salt', diag%axesTi, Time, & - 'Total diapycnal diffusivity for salt at interfaces', 'm2 s-1', conversion=US%Z_to_m**2, & + 'Total diapycnal diffusivity for salt at interfaces', 'm2 s-1', conversion=US%Z2_T_to_m2_s, & cmor_field_name='difvso', & cmor_standard_name='ocean_vertical_salt_diffusivity', & cmor_long_name='Ocean vertical salt diffusivity') From e9cf2cd6288afc8bc97227047f107210fcfc7c7b Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Mon, 24 Jun 2019 13:29:53 -0400 Subject: [PATCH 28/82] +Added dimensional testing for more diffusivities Added rescaling of time units for dimensional consistency testing of extra diffusivities for heat and salt and turbulent diffusivities, including the values returned from CVMix_shear and MOM_kappa_shear, and the values used in differential_diffuse_T_S. Also added the ability to change the scaling of time units across restart files. All answers are bitwise identical. --- src/core/MOM.F90 | 6 ++- src/core/MOM_variables.F90 | 6 +-- .../vertical/MOM_CVMix_ddiff.F90 | 12 ++--- .../vertical/MOM_CVMix_shear.F90 | 8 +-- .../vertical/MOM_diabatic_aux.F90 | 4 +- .../vertical/MOM_diabatic_driver.F90 | 36 ++++++------- .../vertical/MOM_kappa_shear.F90 | 38 +++++++------- .../vertical/MOM_set_diffusivity.F90 | 22 ++++---- .../vertical/MOM_set_viscosity.F90 | 15 ++++-- .../vertical/MOM_tidal_mixing.F90 | 50 +++++++++---------- 10 files changed, 105 insertions(+), 92 deletions(-) diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index de7f01421d..6e313f0967 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -2634,7 +2634,11 @@ subroutine set_restart_fields(GV, US, param_file, CS, restart_CSp) call register_restart_field(US%m_to_Z_restart, "m_to_Z", .false., restart_CSp, & "Height unit conversion factor", "Z meter-1") call register_restart_field(GV%m_to_H_restart, "m_to_H", .false., restart_CSp, & - "Thickness unit conversion factor", "Z meter-1") + "Thickness unit conversion factor", "H meter-1") + call register_restart_field(US%m_to_Z_restart, "m_to_L", .false., restart_CSp, & + "Length unit conversion factor", "L meter-1") + call register_restart_field(US%s_to_T_restart, "s_to_T", .false., restart_CSp, & + "Time unit conversion factor", "T second-1") end subroutine set_restart_fields diff --git a/src/core/MOM_variables.F90 b/src/core/MOM_variables.F90 index 3748684fd4..698986c7c0 100644 --- a/src/core/MOM_variables.F90 +++ b/src/core/MOM_variables.F90 @@ -235,16 +235,16 @@ module MOM_variables Ray_v => NULL() !< The Rayleigh drag velocity to be applied to each layer at v-points [Z s-1 ~> m s-1]. real, pointer, dimension(:,:,:) :: Kd_extra_T => NULL() !< The extra diffusivity of temperature due to double diffusion relative to the - !! diffusivity of density [Z2 s-1 ~> m2 s-1]. + !! diffusivity of density [Z2 T-1 ~> m2 s-1]. real, pointer, dimension(:,:,:) :: Kd_extra_S => NULL() !< The extra diffusivity of salinity due to double diffusion relative to the - !! diffusivity of density [Z2 s-1 ~> m2 s-1]. + !! diffusivity of density [Z2 T-1 ~> m2 s-1]. ! One of Kd_extra_T and Kd_extra_S is always 0. Kd_extra_S is positive for salt fingering; ! Kd_extra_T is positive for double diffusive convection. They are only allocated if ! DOUBLE_DIFFUSION is true. real, pointer, dimension(:,:,:) :: Kd_shear => NULL() !< The shear-driven turbulent diapycnal diffusivity at the interfaces between layers - !! in tracer columns [Z2 s-1 ~> m2 s-1]. + !! in tracer columns [Z2 T-1 ~> m2 s-1]. real, pointer, dimension(:,:,:) :: Kv_shear => NULL() !< The shear-driven turbulent vertical viscosity at the interfaces between layers !! in tracer columns [Z2 s-1 ~> m2 s-1]. diff --git a/src/parameterizations/vertical/MOM_CVMix_ddiff.F90 b/src/parameterizations/vertical/MOM_CVMix_ddiff.F90 index 4f535197a7..57400e31bf 100644 --- a/src/parameterizations/vertical/MOM_CVMix_ddiff.F90 +++ b/src/parameterizations/vertical/MOM_CVMix_ddiff.F90 @@ -138,10 +138,10 @@ logical function CVMix_ddiff_init(Time, G, GV, US, param_file, diag, CS) CS%diag => diag CS%id_KT_extra = register_diag_field('ocean_model','KT_extra',diag%axesTi,Time, & - 'Double-diffusive diffusivity for temperature', 'm2 s-1', conversion=US%Z_to_m**2) + 'Double-diffusive diffusivity for temperature', 'm2 s-1', conversion=US%Z2_T_to_m2_s) CS%id_KS_extra = register_diag_field('ocean_model','KS_extra',diag%axesTi,Time, & - 'Double-diffusive diffusivity for salinity', 'm2 s-1', conversion=US%Z_to_m**2) + 'Double-diffusive diffusivity for salinity', 'm2 s-1', conversion=US%Z2_T_to_m2_s) CS%id_R_rho = register_diag_field('ocean_model','R_rho',diag%axesTi,Time, & 'Double-diffusion density ratio', 'nondim') @@ -170,9 +170,9 @@ subroutine compute_ddiff_coeffs(h, tv, G, GV, US, j, Kd_T, Kd_S, CS) real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness [H ~> m or kg m-2]. type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamics structure. real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(out) :: Kd_T !< Interface double diffusion diapycnal - !! diffusivity for temp [Z2 s-1 ~> m2 s-1]. + !! diffusivity for temp [Z2 T-1 ~> m2 s-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(out) :: Kd_S !< Interface double diffusion diapycnal - !! diffusivity for salt [Z2 s-1 ~> m2 s-1]. + !! diffusivity for salt [Z2 T-1 ~> m2 s-1]. type(CVMix_ddiff_cs), pointer :: CS !< The control structure returned !! by a previous call to CVMix_ddiff_init. integer, intent(in) :: j !< Meridional grid indice. @@ -275,8 +275,8 @@ subroutine compute_ddiff_coeffs(h, tv, G, GV, US, j, Kd_T, Kd_S, CS) nlev=G%ke, & max_nlev=G%ke) do K=1,G%ke+1 - Kd_T(i,j,K) = US%m_to_Z**2 * Kd1_T(K) - Kd_S(i,j,K) = US%m_to_Z**2 * Kd1_S(K) + Kd_T(i,j,K) = US%m2_s_to_Z2_T * Kd1_T(K) + Kd_S(i,j,K) = US%m2_s_to_Z2_T * Kd1_S(K) enddo ! Do not apply mixing due to convection within the boundary layer diff --git a/src/parameterizations/vertical/MOM_CVMix_shear.F90 b/src/parameterizations/vertical/MOM_CVMix_shear.F90 index 9e0f6ca708..c949ff3cc6 100644 --- a/src/parameterizations/vertical/MOM_CVMix_shear.F90 +++ b/src/parameterizations/vertical/MOM_CVMix_shear.F90 @@ -65,7 +65,7 @@ subroutine calculate_CVMix_shear(u_H, v_H, h, tv, kd, kv, G, GV, US, CS ) real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness [H ~> m or kg m-2]. type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamics structure. real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(out) :: kd !< The vertical diffusivity at each interface - !! (not layer!) [Z2 s-1 ~> m2 s-1]. + !! (not layer!) [Z2 T-1 ~> m2 s-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(out) :: kv !< The vertical viscosity at each interface !! (not layer!) [Z2 s-1 ~> m2 s-1]. type(CVMix_shear_cs), pointer :: CS !< The control structure returned by a previous call to @@ -157,7 +157,7 @@ subroutine calculate_CVMix_shear(u_H, v_H, h, tv, kd, kv, G, GV, US, CS ) do K=1,G%ke+1 Kvisc(K) = US%Z_to_m**2 * kv(i,j,K) - Kdiff(K) = US%Z_to_m**2 * kd(i,j,K) + Kdiff(K) = US%Z2_T_to_m2_s * kd(i,j,K) enddo ! Call to CVMix wrapper for computing interior mixing coefficients. @@ -168,7 +168,7 @@ subroutine calculate_CVMix_shear(u_H, v_H, h, tv, kd, kv, G, GV, US, CS ) max_nlev=G%ke) do K=1,G%ke+1 kv(i,j,K) = US%m_to_Z**2 * Kvisc(K) - kd(i,j,K) = US%m_to_Z**2 * Kdiff(K) + kd(i,j,K) = US%m2_s_to_Z2_T * Kdiff(K) enddo enddo enddo @@ -289,7 +289,7 @@ logical function CVMix_shear_init(Time, G, GV, US, param_file, diag, CS) endif CS%id_kd = register_diag_field('ocean_model', 'kd_shear_CVMix', diag%axesTi, Time, & - 'Vertical diffusivity added by MOM_CVMix_shear module', 'm2/s', conversion=US%Z_to_m**2) + 'Vertical diffusivity added by MOM_CVMix_shear module', 'm2/s', conversion=US%Z2_T_to_m2_s) CS%id_kv = register_diag_field('ocean_model', 'kv_shear_CVMix', diag%axesTi, Time, & 'Vertical viscosity added by MOM_CVMix_shear module', 'm2/s', conversion=US%Z_to_m**2) diff --git a/src/parameterizations/vertical/MOM_diabatic_aux.F90 b/src/parameterizations/vertical/MOM_diabatic_aux.F90 index 8052111f73..5899e35b76 100644 --- a/src/parameterizations/vertical/MOM_diabatic_aux.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_aux.F90 @@ -216,7 +216,7 @@ subroutine differential_diffuse_T_S(h, tv, visc, dt, G, GV) !! available thermodynamic fields. type(vertvisc_type), intent(in) :: visc !< Structure containing vertical viscosities, bottom !! boundary layer properies, and related fields. - real, intent(in) :: dt !< Time increment [s]. + real, intent(in) :: dt !< Time increment [T ~> s]. ! local variables real, dimension(SZI_(G)) :: & @@ -235,7 +235,7 @@ subroutine differential_diffuse_T_S(h, tv, visc, dt, G, GV) real :: b_denom_T ! The first term in the denominators for the expressions real :: b_denom_S ! for b1_T and b1_S, both [H ~> m or kg m-2]. real, dimension(:,:,:), pointer :: T=>NULL(), S=>NULL() - real, dimension(:,:,:), pointer :: Kd_T=>NULL(), Kd_S=>NULL() ! Diffusivities [Z2 s-1 ~> m2 s-1]. + real, dimension(:,:,:), pointer :: Kd_T=>NULL(), Kd_S=>NULL() ! Diffusivities [Z2 T-1 ~> m2 s-1]. integer :: i, j, k, is, ie, js, je, nz is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index d77b3d5311..02e5879e06 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -578,13 +578,13 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & if (associated(visc%Kd_extra_S)) then !$OMP parallel do default(shared) do k=1,nz+1 ; do j=js,je ; do i=is,ie - Kd_salt(i,j,k) = Kd_salt(i,j,k) + US%T_to_s*visc%Kd_extra_S(i,j,k) + Kd_salt(i,j,k) = Kd_salt(i,j,k) + visc%Kd_extra_S(i,j,k) enddo ; enddo ; enddo endif if (associated(visc%Kd_extra_T)) then !$OMP parallel do default(shared) do k=1,nz+1 ; do j=js,je ; do i=is,ie - Kd_heat(i,j,k) = Kd_heat(i,j,k) + US%T_to_s*visc%Kd_extra_T(i,j,k) + Kd_heat(i,j,k) = Kd_heat(i,j,k) + visc%Kd_extra_T(i,j,k) enddo ; enddo ; enddo endif @@ -669,7 +669,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & CS%use_CVMix_ddiff) then call cpu_clock_begin(id_clock_differential_diff) - call differential_diffuse_T_S(h, tv, visc, dt, G, GV) + call differential_diffuse_T_S(h, tv, visc, dt*US%s_to_T, G, GV) call cpu_clock_end(id_clock_differential_diff) if (showCallTree) call callTree_waypoint("done with differential_diffuse_T_S (diabatic)") @@ -680,8 +680,8 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & if (.not. CS%useKPP) then !$OMP parallel do default(shared) do K=2,nz ; do j=js,je ; do i=is,ie - Kd_heat(i,j,K) = Kd_heat(i,j,K) + US%T_to_s*visc%Kd_extra_T(i,j,K) - Kd_salt(i,j,K) = Kd_salt(i,j,K) + US%T_to_s*visc%Kd_extra_S(i,j,K) + Kd_heat(i,j,K) = Kd_heat(i,j,K) + visc%Kd_extra_T(i,j,K) + Kd_salt(i,j,K) = Kd_salt(i,j,K) + visc%Kd_extra_S(i,j,K) enddo ; enddo ; enddo endif @@ -757,7 +757,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & Kd_add_here = Kd_ePBL(i,j,K) visc%Kv_shear(i,j,K) = visc%Kv_shear(i,j,K) + US%s_to_T*Kd_ePBL(i,j,K) else - Kd_add_here = max(Kd_ePBL(i,j,K) - US%T_to_s*visc%Kd_shear(i,j,K), 0.0) + Kd_add_here = max(Kd_ePBL(i,j,K) - visc%Kd_shear(i,j,K), 0.0) visc%Kv_shear(i,j,K) = max(visc%Kv_shear(i,j,K), US%s_to_T*Kd_ePBL(i,j,K)) endif @@ -962,7 +962,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & endif if (associated(visc%Kd_extra_S)) then ; if (visc%Kd_extra_S(i,j,k) > 0.0) then - add_ent = ((dt * visc%Kd_extra_S(i,j,k)) * GV%Z_to_H**2) / & + add_ent = ((dt*US%s_to_T * visc%Kd_extra_S(i,j,k)) * GV%Z_to_H**2) / & (0.5 * (h(i,j,k-1) + h(i,j,k)) + & h_neglect) ebtr(i,j,k-1) = ebtr(i,j,k-1) + add_ent @@ -988,7 +988,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & !$OMP parallel do default(shared) private(add_ent) do k=nz,2,-1 ; do j=js,je ; do i=is,ie if (visc%Kd_extra_S(i,j,k) > 0.0) then - add_ent = ((dt * visc%Kd_extra_S(i,j,k)) * GV%Z_to_H**2) / & + add_ent = ((dt*US%s_to_T * visc%Kd_extra_S(i,j,k)) * GV%Z_to_H**2) / & (0.5 * (h(i,j,k-1) + h(i,j,k)) + & h_neglect) else @@ -1501,13 +1501,13 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en if (associated(visc%Kd_extra_S)) then !$OMP parallel do default(shared) do k=1,nz+1 ; do j=js,je ; do i=is,ie - Kd_salt(i,j,k) = Kd_salt(i,j,k) + US%T_to_s*visc%Kd_extra_S(i,j,k) + Kd_salt(i,j,k) = Kd_salt(i,j,k) + visc%Kd_extra_S(i,j,k) enddo ; enddo ; enddo endif if (associated(visc%Kd_extra_T)) then !$OMP parallel do default(shared) do k=1,nz+1 ; do j=js,je ; do i=is,ie - Kd_heat(i,j,k) = Kd_heat(i,j,k) + US%T_to_s*visc%Kd_extra_T(i,j,k) + Kd_heat(i,j,k) = Kd_heat(i,j,k) + visc%Kd_extra_T(i,j,k) enddo ; enddo ; enddo endif @@ -1532,13 +1532,13 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en if (associated(visc%Kd_extra_S)) then !$OMP parallel do default(shared) do k=1,nz+1 ; do j=js,je ; do i=is,ie - visc%Kd_extra_S(i,j,k) = US%s_to_T*(Kd_salt(i,j,k) - Kd_int(i,j,K)) + visc%Kd_extra_S(i,j,k) = (Kd_salt(i,j,k) - Kd_int(i,j,K)) enddo ; enddo ; enddo endif if (associated(visc%Kd_extra_T)) then !$OMP parallel do default(shared) do k=1,nz+1 ; do j=js,je ; do i=is,ie - visc%Kd_extra_T(i,j,k) = US%s_to_T*(Kd_heat(i,j,k) - Kd_int(i,j,K)) + visc%Kd_extra_T(i,j,k) = (Kd_heat(i,j,k) - Kd_int(i,j,K)) enddo ; enddo ; enddo endif endif ! not passive @@ -1597,7 +1597,7 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en if (associated(visc%Kd_extra_T) .and. associated(visc%Kd_extra_S) .and. associated(tv%T)) then call cpu_clock_begin(id_clock_differential_diff) - call differential_diffuse_T_S(h, tv, visc, dt, G, GV) + call differential_diffuse_T_S(h, tv, visc, dt*US%s_to_T, G, GV) call cpu_clock_end(id_clock_differential_diff) if (showCallTree) call callTree_waypoint("done with differential_diffuse_T_S (diabatic)") if (CS%debugConservation) call MOM_state_stats('differential_diffuse_T_S', u, v, h, tv%T, tv%S, G) @@ -1606,8 +1606,8 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en ! CS%useKPP==.true. already has extra_T and extra_S included if (.not. CS%useKPP) then do K=2,nz ; do j=js,je ; do i=is,ie - Kd_heat(i,j,K) = Kd_heat(i,j,K) + US%T_to_s*visc%Kd_extra_T(i,j,K) - Kd_salt(i,j,K) = Kd_salt(i,j,K) + US%T_to_s*visc%Kd_extra_S(i,j,K) + Kd_heat(i,j,K) = Kd_heat(i,j,K) + visc%Kd_extra_T(i,j,K) + Kd_salt(i,j,K) = Kd_salt(i,j,K) + visc%Kd_extra_S(i,j,K) enddo ; enddo ; enddo endif @@ -1707,7 +1707,7 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en Kd_add_here = Kd_ePBL(i,j,K) visc%Kv_shear(i,j,K) = visc%Kv_shear(i,j,K) + US%s_to_T*Kd_ePBL(i,j,K) else - Kd_add_here = max(Kd_ePBL(i,j,K) - US%T_to_s*visc%Kd_shear(i,j,K), 0.0) + Kd_add_here = max(Kd_ePBL(i,j,K) - visc%Kd_shear(i,j,K), 0.0) visc%Kv_shear(i,j,K) = max(visc%Kv_shear(i,j,K), US%s_to_T*Kd_ePBL(i,j,K)) endif Ent_int = Kd_add_here * (GV%Z_to_H**2 * US%s_to_T*dt) / & @@ -2083,7 +2083,7 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en ebtr(i,j,k-1) = eb(i,j,k-1) ; eatr(i,j,k) = ea(i,j,k) endif if (associated(visc%Kd_extra_S)) then ; if (visc%Kd_extra_S(i,j,k) > 0.0) then - add_ent = ((dt * visc%Kd_extra_S(i,j,k)) * GV%Z_to_H**2) / & + add_ent = ((dt*US%s_to_T * visc%Kd_extra_S(i,j,k)) * GV%Z_to_H**2) / & (0.25 * ((h(i,j,k-1) + h(i,j,k)) + (hold(i,j,k-1) + hold(i,j,k))) + & h_neglect) ebtr(i,j,k-1) = ebtr(i,j,k-1) + add_ent @@ -2114,7 +2114,7 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en !$OMP parallel do default(shared) private(add_ent) do k=nz,2,-1 ; do j=js,je ; do i=is,ie if (visc%Kd_extra_S(i,j,k) > 0.0) then - add_ent = ((dt * visc%Kd_extra_S(i,j,k)) * GV%Z_to_H**2) / & + add_ent = ((dt*US%s_to_T * visc%Kd_extra_S(i,j,k)) * GV%Z_to_H**2) / & (0.25 * ((h(i,j,k-1) + h(i,j,k)) + (hold(i,j,k-1) + hold(i,j,k))) + & h_neglect) else diff --git a/src/parameterizations/vertical/MOM_kappa_shear.F90 b/src/parameterizations/vertical/MOM_kappa_shear.F90 index 2dc58cc403..bdbcd4dbdd 100644 --- a/src/parameterizations/vertical/MOM_kappa_shear.F90 +++ b/src/parameterizations/vertical/MOM_kappa_shear.F90 @@ -109,7 +109,7 @@ subroutine Calculate_kappa_shear(u_in, v_in, h, tv, p_surf, kappa_io, tke_io, & real, dimension(:,:), pointer :: p_surf !< The pressure at the ocean surface [Pa] (or NULL). real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), & intent(inout) :: kappa_io !< The diapycnal diffusivity at each interface - !! (not layer!) [Z2 s-1 ~> m2 s-1]. Initially this is the + !! (not layer!) [Z2 T-1 ~> m2 s-1]. Initially this is the !! value from the previous timestep, which may !! accelerate the iteration toward convergence. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), & @@ -299,7 +299,7 @@ subroutine Calculate_kappa_shear(u_in, v_in, h, tv, p_surf, kappa_io, tke_io, & if (new_kappa) then do K=1,nzc+1 ; kappa(K) = US%m_to_Z**2*1.0 ; enddo else - do K=1,nzc+1 ; kappa(K) = kappa_2d(i,K) ; enddo + do K=1,nzc+1 ; kappa(K) = US%s_to_T*kappa_2d(i,K) ; enddo endif call kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & @@ -310,18 +310,18 @@ subroutine Calculate_kappa_shear(u_in, v_in, h, tv, p_surf, kappa_io, tke_io, & ! Extrapolate from the vertically reduced grid back to the original layers. if (nz == nzc) then do K=1,nz+1 - kappa_2d(i,K) = kappa_avg(K) + kappa_2d(i,K) = US%T_to_s*kappa_avg(K) !### Should this be tke_avg? tke_2d(i,K) = tke(K) enddo else do K=1,nz+1 if (kf(K) == 0.0) then - kappa_2d(i,K) = kappa_avg(kc(K)) + kappa_2d(i,K) = US%T_to_s*kappa_avg(kc(K)) tke_2d(i,K) = tke_avg(kc(K)) else - kappa_2d(i,K) = (1.0-kf(K)) * kappa_avg(kc(K)) + & - kf(K) * kappa_avg(kc(K)+1) + kappa_2d(i,K) = (1.0-kf(K)) * US%T_to_s*kappa_avg(kc(K)) + & + kf(K) * US%T_to_s*kappa_avg(kc(K)+1) tke_2d(i,K) = (1.0-kf(K)) * tke_avg(kc(K)) + & kf(K) * tke_avg(kc(K)+1) endif @@ -353,7 +353,7 @@ subroutine Calculate_kappa_shear(u_in, v_in, h, tv, p_surf, kappa_io, tke_io, & do K=1,nz+1 ; do i=is,ie kappa_io(i,j,K) = G%mask2dT(i,j) * kappa_2d(i,K) tke_io(i,j,K) = G%mask2dT(i,j) * tke_2d(i,K) - kv_io(i,j,K) = ( G%mask2dT(i,j) * kappa_2d(i,K) ) * CS%Prandtl_turb + kv_io(i,j,K) = ( G%mask2dT(i,j) * US%s_to_T*kappa_2d(i,K) ) * CS%Prandtl_turb #ifdef ADD_DIAGNOSTICS I_Ld2_3d(i,j,K) = I_Ld2_2d(i,K) dz_Int_3d(i,j,K) = dz_Int_2d(i,K) @@ -363,7 +363,7 @@ subroutine Calculate_kappa_shear(u_in, v_in, h, tv, p_surf, kappa_io, tke_io, & enddo ! end of j-loop if (CS%debug) then - call hchksum(kappa_io, "kappa", G%HI, scale=US%Z_to_m**2) + call hchksum(kappa_io, "kappa", G%HI, scale=US%Z2_T_to_m2_s) call hchksum(tke_io, "tke", G%HI) endif @@ -400,7 +400,7 @@ subroutine Calc_kappa_shear_vertex(u_in, v_in, h, T_in, S_in, tv, p_surf, kappa_ !! (or NULL). real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), & intent(out) :: kappa_io !< The diapycnal diffusivity at each interface - !! (not layer!) [Z2 s-1 ~> m2 s-1]. + !! (not layer!) [Z2 T-1 ~> m2 s-1]. real, dimension(SZIB_(G),SZJB_(G),SZK_(GV)+1), & intent(inout) :: tke_io !< The turbulent kinetic energy per unit mass at !! each interface (not layer!) [m2 s-2]. @@ -423,7 +423,7 @@ subroutine Calc_kappa_shear_vertex(u_in, v_in, h, T_in, S_in, tv, p_surf, kappa_ h_2d, & ! A 2-D version of h, but converted to m. u_2d, v_2d, T_2d, S_2d, rho_2d ! 2-D versions of u_in, v_in, T, S, and rho. real, dimension(SZIB_(G),SZK_(GV)+1,2) :: & - kappa_2d ! Quasi 2-D versions of kappa_io [Z2 s-1 ~> m2 s-1]. + kappa_2d ! Quasi 2-D versions of kappa_io [Z2 T-1 ~> m2 s-1]. real, dimension(SZIB_(G),SZK_(GV)+1) :: & tke_2d ! 2-D version tke_io [m2 s-2]. real, dimension(SZK_(GV)) :: & @@ -540,7 +540,7 @@ subroutine Calc_kappa_shear_vertex(u_in, v_in, h, T_in, S_in, tv, p_surf, kappa_ rho_2d(I,k) = GV%Rlay(k) enddo ; enddo ; endif if (.not.new_kappa) then ; do K=1,nz+1 ; do I=IsB,IeB - kappa_2d(I,K,J2) = kv_io(I,J,K) * I_Prandtl + kappa_2d(I,K,J2) = US%T_to_s*kv_io(I,J,K) * I_Prandtl enddo ; enddo ; endif !--------------------------------------- @@ -624,7 +624,7 @@ subroutine Calc_kappa_shear_vertex(u_in, v_in, h, T_in, S_in, tv, p_surf, kappa_ if (new_kappa) then do K=1,nzc+1 ; kappa(K) = US%m_to_Z**2*1.0 ; enddo else - do K=1,nzc+1 ; kappa(K) = kappa_2d(I,K,J2) ; enddo + do K=1,nzc+1 ; kappa(K) = US%s_to_T*kappa_2d(I,K,J2) ; enddo endif call kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & @@ -635,18 +635,18 @@ subroutine Calc_kappa_shear_vertex(u_in, v_in, h, T_in, S_in, tv, p_surf, kappa_ ! Extrapolate from the vertically reduced grid back to the original layers. if (nz == nzc) then do K=1,nz+1 - kappa_2d(I,K,J2) = kappa_avg(K) + kappa_2d(I,K,J2) = US%T_to_s*kappa_avg(K) !### Should this be tke_avg? tke_2d(I,K) = tke(K) enddo else do K=1,nz+1 if (kf(K) == 0.0) then - kappa_2d(I,K,J2) = kappa_avg(kc(K)) + kappa_2d(I,K,J2) = US%T_to_s*kappa_avg(kc(K)) tke_2d(I,K) = tke_avg(kc(K)) else - kappa_2d(I,K,J2) = (1.0-kf(K)) * kappa_avg(kc(K)) + & - kf(K) * kappa_avg(kc(K)+1) + kappa_2d(I,K,J2) = (1.0-kf(K)) * US%T_to_s*kappa_avg(kc(K)) + & + kf(K) * US%T_to_s*kappa_avg(kc(K)+1) tke_2d(I,K) = (1.0-kf(K)) * tke_avg(kc(K)) + & kf(K) * tke_avg(kc(K)+1) endif @@ -677,7 +677,7 @@ subroutine Calc_kappa_shear_vertex(u_in, v_in, h, T_in, S_in, tv, p_surf, kappa_ do K=1,nz+1 ; do I=IsB,IeB tke_io(I,J,K) = G%mask2dBu(I,J) * tke_2d(I,K) - kv_io(I,J,K) = ( G%mask2dBu(I,J) * kappa_2d(I,K,J2) ) * CS%Prandtl_turb + kv_io(I,J,K) = ( G%mask2dBu(I,J) * US%s_to_T*kappa_2d(I,K,J2) ) * CS%Prandtl_turb #ifdef ADD_DIAGNOSTICS I_Ld2_3d(I,J,K) = I_Ld2_2d(I,K) dz_Int_3d(I,J,K) = dz_Int_2d(I,K) @@ -693,7 +693,7 @@ subroutine Calc_kappa_shear_vertex(u_in, v_in, h, T_in, S_in, tv, p_surf, kappa_ enddo ! end of J-loop if (CS%debug) then - call hchksum(kappa_io, "kappa", G%HI, scale=US%Z_to_m**2) + call hchksum(kappa_io, "kappa", G%HI, scale=US%Z2_T_to_m2_s) call Bchksum(tke_io, "tke", G%HI) endif @@ -2123,7 +2123,7 @@ function kappa_shear_init(Time, G, GV, US, param_file, diag, CS) CS%diag => diag CS%id_Kd_shear = register_diag_field('ocean_model','Kd_shear',diag%axesTi,Time, & - 'Shear-driven Diapycnal Diffusivity', 'm2 s-1', conversion=US%Z_to_m**2) + 'Shear-driven Diapycnal Diffusivity', 'm2 s-1', conversion=US%Z2_T_to_m2_s) CS%id_TKE = register_diag_field('ocean_model','TKE_shear',diag%axesTi,Time, & 'Shear-driven Turbulent Kinetic Energy', 'm2 s-2') #ifdef ADD_DIAGNOSTICS diff --git a/src/parameterizations/vertical/MOM_set_diffusivity.F90 b/src/parameterizations/vertical/MOM_set_diffusivity.F90 index 6dd01eaa93..67e9bbe8fa 100644 --- a/src/parameterizations/vertical/MOM_set_diffusivity.F90 +++ b/src/parameterizations/vertical/MOM_set_diffusivity.F90 @@ -356,7 +356,7 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & visc%TKE_turb, visc%Kv_shear_Bu, dt, G, GV, US, CS%kappaShear_CSp) if (associated(visc%Kv_shear)) visc%Kv_shear(:,:,:) = 0.0 ! needed for other parameterizations if (CS%debug) then - call hchksum(visc%Kd_shear, "after calc_KS_vert visc%Kd_shear", G%HI, scale=US%Z_to_m**2) + call hchksum(visc%Kd_shear, "after calc_KS_vert visc%Kd_shear", G%HI, scale=US%Z2_T_to_m2_s) call Bchksum(visc%Kv_shear_Bu, "after calc_KS_vert visc%Kv_shear_Bu", G%HI, scale=US%Z_to_m**2) call Bchksum(visc%TKE_turb, "after calc_KS_vert visc%TKE_turb", G%HI) endif @@ -366,7 +366,7 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & call calculate_kappa_shear(u_h, v_h, h, tv, fluxes%p_surf, visc%Kd_shear, visc%TKE_turb, & visc%Kv_shear, dt, G, GV, US, CS%kappaShear_CSp) if (CS%debug) then - call hchksum(visc%Kd_shear, "after calc_KS visc%Kd_shear", G%HI, scale=US%Z_to_m**2) + call hchksum(visc%Kd_shear, "after calc_KS visc%Kd_shear", G%HI, scale=US%Z2_T_to_m2_s) call hchksum(visc%Kv_shear, "after calc_KS visc%Kv_shear", G%HI, scale=US%Z_to_m**2) call hchksum(visc%TKE_turb, "after calc_KS visc%TKE_turb", G%HI) endif @@ -377,7 +377,7 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & !NOTE{BGR}: this needs to be cleaned up. It works in 1D case, but has not been tested outside. call calculate_CVMix_shear(u_h, v_h, h, tv, visc%Kd_shear, visc%Kv_shear, G, GV, US, CS%CVMix_shear_CSp) if (CS%debug) then - call hchksum(visc%Kd_shear, "after CVMix_shear visc%Kd_shear", G%HI, scale=US%Z_to_m**2) + call hchksum(visc%Kd_shear, "after CVMix_shear visc%Kd_shear", G%HI, scale=US%Z2_T_to_m2_s) call hchksum(visc%Kv_shear, "after CVMix_shear visc%Kv_shear", G%HI, scale=US%Z_to_m**2) endif elseif (associated(visc%Kv_shear)) then @@ -412,12 +412,12 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & if (KS_extra(i,K) > KT_extra(i,K)) then ! salt fingering Kd_lay(i,j,k-1) = Kd_lay(i,j,k-1) + 0.5 * KT_extra(i,K) Kd_lay(i,j,k) = Kd_lay(i,j,k) + 0.5 * KT_extra(i,K) - visc%Kd_extra_S(i,j,k) = US%s_to_T * (KS_extra(i,K) - KT_extra(i,K)) + visc%Kd_extra_S(i,j,k) = (KS_extra(i,K) - KT_extra(i,K)) visc%Kd_extra_T(i,j,k) = 0.0 elseif (KT_extra(i,K) > 0.0) then ! double-diffusive convection Kd_lay(i,j,k-1) = Kd_lay(i,j,k-1) + 0.5 * KS_extra(i,K) Kd_lay(i,j,k) = Kd_lay(i,j,k) + 0.5 * KS_extra(i,K) - visc%Kd_extra_T(i,j,k) = US%s_to_T * (KT_extra(i,K) - KS_extra(i,K)) + visc%Kd_extra_T(i,j,k) = (KT_extra(i,K) - KS_extra(i,K)) visc%Kd_extra_S(i,j,k) = 0.0 else ! There is no double diffusion at this interface. visc%Kd_extra_T(i,j,k) = 0.0 @@ -445,15 +445,15 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & if (CS%useKappaShear .or. CS%use_CVMix_shear) then if (present(Kd_int)) then do K=2,nz ; do i=is,ie - Kd_int(i,j,K) = (US%T_to_s * visc%Kd_shear(i,j,K)) + 0.5 * (Kd_lay(i,j,k-1) + Kd_lay(i,j,k)) + Kd_int(i,j,K) = visc%Kd_shear(i,j,K) + 0.5 * (Kd_lay(i,j,k-1) + Kd_lay(i,j,k)) enddo ; enddo do i=is,ie - Kd_int(i,j,1) = US%T_to_s * visc%Kd_shear(i,j,1) ! This isn't actually used. It could be 0. + Kd_int(i,j,1) = visc%Kd_shear(i,j,1) ! This isn't actually used. It could be 0. Kd_int(i,j,nz+1) = 0.0 enddo endif do k=1,nz ; do i=is,ie - Kd_lay(i,j,k) = Kd_lay(i,j,k) + 0.5 * US%T_to_s * (visc%Kd_shear(i,j,K) + visc%Kd_shear(i,j,K+1)) + Kd_lay(i,j,k) = Kd_lay(i,j,k) + 0.5 * (visc%Kd_shear(i,j,K) + visc%Kd_shear(i,j,K+1)) enddo ; enddo else if (present(Kd_int)) then @@ -530,11 +530,11 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & call hchksum(Kd_lay ,"Kd_lay", G%HI, haloshift=0, & scale=US%Z2_T_to_m2_s) - if (CS%useKappaShear) call hchksum(visc%Kd_shear, "Turbulent Kd", G%HI, haloshift=0, scale=US%Z_to_m**2) + if (CS%useKappaShear) call hchksum(visc%Kd_shear, "Turbulent Kd", G%HI, haloshift=0, scale=US%Z2_T_to_m2_s) if (CS%use_CVMix_ddiff) then - call hchksum(visc%Kd_extra_T, "MOM_set_diffusivity: Kd_extra_T", G%HI, haloshift=0, scale=US%Z_to_m**2) - call hchksum(visc%Kd_extra_S, "MOM_set_diffusivity: Kd_extra_S", G%HI, haloshift=0, scale=US%Z_to_m**2) + call hchksum(visc%Kd_extra_T, "MOM_set_diffusivity: Kd_extra_T", G%HI, haloshift=0, scale=US%Z2_T_to_m2_s) + call hchksum(visc%Kd_extra_S, "MOM_set_diffusivity: Kd_extra_S", G%HI, haloshift=0, scale=US%Z2_T_to_m2_s) endif if (associated(visc%kv_bbl_u) .and. associated(visc%kv_bbl_v)) then diff --git a/src/parameterizations/vertical/MOM_set_viscosity.F90 b/src/parameterizations/vertical/MOM_set_viscosity.F90 index 3918c4235a..9fad0c8f2e 100644 --- a/src/parameterizations/vertical/MOM_set_viscosity.F90 +++ b/src/parameterizations/vertical/MOM_set_viscosity.F90 @@ -1786,7 +1786,9 @@ subroutine set_visc_init(Time, G, GV, US, param_file, diag, visc, CS, restart_CS real :: Kv_background real :: omega_frac_dflt real :: Z_rescale ! A rescaling factor for heights from the representation in - ! a reastart fole to the internal representation in this run. + ! a restart file to the internal representation in this run. + real :: I_T_rescale ! A rescaling factor for time from the internal representation in this run + ! to the representation in a restart file. integer :: i, j, k, is, ie, js, je, n integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB, nz logical :: use_kappa_shear, adiabatic, use_omega @@ -2037,14 +2039,21 @@ subroutine set_visc_init(Time, G, GV, US, param_file, diag, visc, CS, restart_CS call register_restart_field_as_obsolete('Kd_turb','Kd_shear', restart_CS) call register_restart_field_as_obsolete('Kv_turb','Kv_shear', restart_CS) - if ((US%m_to_Z_restart /= 0.0) .and. (US%m_to_Z_restart /= US%m_to_Z)) then + if ((US%m_to_Z_restart /= 0.0) .and. (US%m_to_Z_restart /= US%m_to_Z)) & Z_rescale = US%m_to_Z / US%m_to_Z_restart + + if ((US%s_to_T_restart /= 0.0) .and. (US%s_to_T_restart /= US%s_to_T)) & + I_T_rescale = US%s_to_T_restart / US%s_to_T + + if (Z_rescale**2*I_T_rescale /= 1.0) then if (associated(visc%Kd_shear)) then ; if (query_initialized(visc%Kd_shear, "Kd_shear", restart_CS)) then do k=1,nz+1 ; do j=js,je ; do i=is,ie - visc%Kd_shear(i,j,k) = Z_rescale**2 * visc%Kd_shear(i,j,k) + visc%Kd_shear(i,j,k) = Z_rescale**2*I_T_rescale * visc%Kd_shear(i,j,k) enddo ; enddo ; enddo endif ; endif + endif + if (Z_rescale /= 1.0) then if (associated(visc%Kv_shear)) then ; if (query_initialized(visc%Kv_shear, "Kv_shear", restart_CS)) then do k=1,nz+1 ; do j=js,je ; do i=is,ie visc%Kv_shear(i,j,k) = Z_rescale**2 * visc%Kv_shear(i,j,k) diff --git a/src/parameterizations/vertical/MOM_tidal_mixing.F90 b/src/parameterizations/vertical/MOM_tidal_mixing.F90 index 024c3125e7..3078653694 100644 --- a/src/parameterizations/vertical/MOM_tidal_mixing.F90 +++ b/src/parameterizations/vertical/MOM_tidal_mixing.F90 @@ -42,9 +42,9 @@ module MOM_tidal_mixing !> Containers for tidal mixing diagnostics type, public :: tidal_mixing_diags ; private real, pointer, dimension(:,:,:) :: & - Kd_itidal => NULL(),& !< internal tide diffusivity at interfaces [Z2 s-1 ~> m2 s-1]. + Kd_itidal => NULL(),& !< internal tide diffusivity at interfaces [Z2 T-1 ~> m2 s-1]. Fl_itidal => NULL(),& !< vertical flux of tidal turbulent dissipation [Z3 T-3 ~> m3 s-3] - Kd_Niku => NULL(),& !< lee-wave diffusivity at interfaces [Z2 s-1 ~> m2 s-1]. + Kd_Niku => NULL(),& !< lee-wave diffusivity at interfaces [Z2 T-1 ~> m2 s-1]. Kd_Niku_work => NULL(),& !< layer integrated work by lee-wave driven mixing [kg Z3 m-3 T-3 ~> W m-2] Kd_Itidal_Work => NULL(),& !< layer integrated work by int tide driven mixing [kg Z3 m-3 T-3 ~> W m-2] Kd_Lowmode_Work => NULL(),& !< layer integrated work by low mode driven mixing [kg Z3 m-3 T-3 ~> W m-2] @@ -54,7 +54,7 @@ module MOM_tidal_mixing real, pointer, dimension(:,:,:) :: tidal_qe_md => NULL() !< Input tidal energy dissipated locally, !! interpolated to model vertical coordinate [W m-3?] real, pointer, dimension(:,:,:) :: Kd_lowmode => NULL() !< internal tide diffusivity at interfaces - !! due to propagating low modes [Z2 s-1 ~> m2 s-1]. + !! due to propagating low modes [Z2 T-1 ~> m2 s-1]. real, pointer, dimension(:,:,:) :: Fl_lowmode => NULL() !< vertical flux of tidal turbulent !! dissipation due to propagating low modes [Z3 T-3 ~> m3 s-3] real, pointer, dimension(:,:) :: & @@ -557,7 +557,7 @@ logical function tidal_mixing_init(Time, G, GV, US, param_file, diag, CS) CS%Lowmode_itidal_dissipation) then CS%id_Kd_itidal = register_diag_field('ocean_model','Kd_itides',diag%axesTi,Time, & - 'Internal Tide Driven Diffusivity', 'm2 s-1', conversion=US%Z_to_m**2) + 'Internal Tide Driven Diffusivity', 'm2 s-1', conversion=US%Z2_T_to_m2_s) if (CS%use_CVMix_tidal) then CS%id_N2_int = register_diag_field('ocean_model','N2_int',diag%axesTi,Time, & @@ -580,7 +580,7 @@ logical function tidal_mixing_init(Time, G, GV, US, param_file, diag, CS) CS%id_Kd_lowmode = register_diag_field('ocean_model','Kd_lowmode',diag%axesTi,Time, & 'Internal Tide Driven Diffusivity (from propagating low modes)', & - 'm2 s-1', conversion=US%Z_to_m**2) + 'm2 s-1', conversion=US%Z2_T_to_m2_s) CS%id_Fl_itidal = register_diag_field('ocean_model','Fl_itides',diag%axesTi,Time, & 'Vertical flux of tidal turbulent dissipation', & @@ -619,7 +619,7 @@ logical function tidal_mixing_init(Time, G, GV, US, param_file, diag, CS) CS%id_TKE_leewave = register_diag_field('ocean_model','TKE_leewave',diag%axesT1,Time, & 'Lee wave Driven Turbulent Kinetic Energy', 'W m-2', conversion=(US%Z_to_m**3*US%s_to_T**3)) CS%id_Kd_Niku = register_diag_field('ocean_model','Kd_Nikurashin',diag%axesTi,Time, & - 'Lee Wave Driven Diffusivity', 'm2 s-1', conversion=US%Z_to_m**2) + 'Lee Wave Driven Diffusivity', 'm2 s-1', conversion=US%Z2_T_to_m2_s) endif endif ! S%use_CVMix_tidal endif @@ -669,7 +669,7 @@ subroutine calculate_tidal_mixing(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, US, C call calculate_CVMix_tidal(h, j, G, GV, US, CS, N2_int, Kd_lay, Kv) else call add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, & - G, GV, US, CS, N2_lay, Kd_lay, Kd_int, US%s_to_T*Kd_max) + G, GV, US, CS, N2_lay, Kd_lay, Kd_int, Kd_max) endif endif end subroutine calculate_tidal_mixing @@ -778,7 +778,7 @@ subroutine calculate_CVMix_tidal(h, j, G, GV, US, CS, N2_int, Kd_lay, Kv) ! diagnostics if (associated(dd%Kd_itidal)) then - dd%Kd_itidal(i,j,:) = Kd_tidal(:) + dd%Kd_itidal(i,j,:) = US%m2_s_to_Z2_T*Kd_tidal(:) endif if (associated(dd%N2_int)) then dd%N2_int(i,j,:) = N2_int(i,:) @@ -880,7 +880,7 @@ subroutine calculate_CVMix_tidal(h, j, G, GV, US, CS, N2_int, Kd_lay, Kv) ! diagnostics if (associated(dd%Kd_itidal)) then - dd%Kd_itidal(i,j,:) = Kd_tidal(:) + dd%Kd_itidal(i,j,:) = US%m2_s_to_Z2_T*Kd_tidal(:) endif if (associated(dd%N2_int)) then dd%N2_int(i,j,:) = N2_int(i,:) @@ -939,7 +939,7 @@ subroutine add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, US, !! [Z2 T-1 ~> m2 s-1]. real, intent(in) :: Kd_max !< The maximum increment for diapycnal !! diffusivity due to TKE-based processes - !! [Z2 s-1 ~> m2 s-1]. + !! [Z2 T-1 ~> m2 s-1]. !! Set this to a negative value to have no limit. ! local @@ -971,7 +971,7 @@ subroutine add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, US, z_from_bot_WKB ! WKB scaled distance from bottom [Z ~> m]. real :: I_rho0 ! 1 / RHO0 [m3 kg-1] - real :: Kd_add ! diffusivity to add in a layer [Z2 s-1 ~> m2 s-1]. + real :: Kd_add ! diffusivity to add in a layer [Z2 T-1 ~> m2 s-1]. real :: TKE_itide_lay ! internal tide TKE imparted to a layer (from barotropic) [Z3 T-3 ~> m3 s-3] real :: TKE_Niku_lay ! lee-wave TKE imparted to a layer [Z3 T-3 ~> m3 s-3] real :: TKE_lowmode_lay ! internal tide TKE imparted to a layer (from low mode) [Z3 T-3 ~> m3 s-3] (BDM) @@ -1178,21 +1178,21 @@ subroutine add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, US, TKE_lowmode_rem(i) = TKE_lowmode_rem(i) - TKE_lowmode_lay ! Convert power to diffusivity - Kd_add = US%s_to_T * TKE_to_Kd(i,k) * (TKE_itide_lay + TKE_Niku_lay + TKE_lowmode_lay) + Kd_add = TKE_to_Kd(i,k) * (TKE_itide_lay + TKE_Niku_lay + TKE_lowmode_lay) if (Kd_max >= 0.0) Kd_add = min(Kd_add, Kd_max) - Kd_lay(i,j,k) = Kd_lay(i,j,k) + (US%T_to_s * Kd_add) + Kd_lay(i,j,k) = Kd_lay(i,j,k) + Kd_add if (present(Kd_int)) then - Kd_int(i,j,K) = Kd_int(i,j,K) + 0.5 * (US%T_to_s * Kd_add) - Kd_int(i,j,K+1) = Kd_int(i,j,K+1) + 0.5 * (US%T_to_s * Kd_add) + Kd_int(i,j,K) = Kd_int(i,j,K) + 0.5 * Kd_add + Kd_int(i,j,K+1) = Kd_int(i,j,K+1) + 0.5 * Kd_add endif ! diagnostics if (associated(dd%Kd_itidal)) then ! If at layers, dd%Kd_itidal is just TKE_to_Kd(i,k) * TKE_itide_lay ! The following sets the interface diagnostics. - Kd_add = US%s_to_T * TKE_to_Kd(i,k) * TKE_itide_lay + Kd_add = TKE_to_Kd(i,k) * TKE_itide_lay if (Kd_max >= 0.0) Kd_add = min(Kd_add, Kd_max) if (k>1) dd%Kd_itidal(i,j,K) = dd%Kd_itidal(i,j,K) + 0.5*Kd_add if (k= 0.0) Kd_add = min(Kd_add, Kd_max) if (k>1) dd%Kd_Niku(i,j,K) = dd%Kd_Niku(i,j,K) + 0.5*Kd_add if (k= 0.0) Kd_add = min(Kd_add, Kd_max) if (k>1) dd%Kd_lowmode(i,j,K) = dd%Kd_lowmode(i,j,K) + 0.5*Kd_add if (k= 0.0) Kd_add = min(Kd_add, Kd_max) - Kd_lay(i,j,k) = Kd_lay(i,j,k) + (US%T_to_s * Kd_add) + Kd_lay(i,j,k) = Kd_lay(i,j,k) + Kd_add if (present(Kd_int)) then - Kd_int(i,j,K) = Kd_int(i,j,K) + 0.5 * (US%T_to_s * Kd_add) - Kd_int(i,j,K+1) = Kd_int(i,j,K+1) + 0.5 * (US%T_to_s * Kd_add) + Kd_int(i,j,K) = Kd_int(i,j,K) + 0.5 * Kd_add + Kd_int(i,j,K+1) = Kd_int(i,j,K+1) + 0.5 * Kd_add endif ! diagnostics if (associated(dd%Kd_itidal)) then ! If at layers, this is just dd%Kd_itidal(i,j,K) = TKE_to_Kd(i,k) * TKE_itide_lay ! The following sets the interface diagnostics. - Kd_add = US%s_to_T * TKE_to_Kd(i,k) * TKE_itide_lay + Kd_add = TKE_to_Kd(i,k) * TKE_itide_lay if (Kd_max >= 0.0) Kd_add = min(Kd_add, Kd_max) if (k>1) dd%Kd_itidal(i,j,K) = dd%Kd_itidal(i,j,K) + 0.5*Kd_add if (k= 0.0) Kd_add = min(Kd_add, Kd_max) if (k>1) dd%Kd_Niku(i,j,K) = dd%Kd_Niku(i,j,K) + 0.5*Kd_add if (k= 0.0) Kd_add = min(Kd_add, Kd_max) if (k>1) dd%Kd_lowmode(i,j,K) = dd%Kd_lowmode(i,j,K) + 0.5*Kd_add if (k Date: Mon, 24 Jun 2019 15:17:37 -0400 Subject: [PATCH 29/82] +Yet more dimensional testing for diffusivities Added rescaling of time units for dimensional consistency testing of the background diffusivities and the CVMix convective diffusivities, including the values returned from calculate_CVMix_conv. All answers are bitwise identical. --- .../vertical/MOM_CVMix_conv.F90 | 10 +- .../vertical/MOM_bkgnd_mixing.F90 | 110 ++++++++---------- .../vertical/MOM_diabatic_driver.F90 | 14 +-- 3 files changed, 63 insertions(+), 71 deletions(-) diff --git a/src/parameterizations/vertical/MOM_CVMix_conv.F90 b/src/parameterizations/vertical/MOM_CVMix_conv.F90 index 1a9cb890ef..cb5a5bad07 100644 --- a/src/parameterizations/vertical/MOM_CVMix_conv.F90 +++ b/src/parameterizations/vertical/MOM_CVMix_conv.F90 @@ -42,7 +42,7 @@ module MOM_CVMix_conv ! Diagnostics arrays real, allocatable, dimension(:,:,:) :: N2 !< Squared Brunt-Vaisala frequency [s-2] - real, allocatable, dimension(:,:,:) :: kd_conv !< Diffusivity added by convection [m2 s-1] + real, allocatable, dimension(:,:,:) :: kd_conv !< Diffusivity added by convection [Z2 T-1 ~> m2 s-1] real, allocatable, dimension(:,:,:) :: kv_conv !< Viscosity added by convection [m2 s-1] end type CVMix_conv_cs @@ -134,7 +134,7 @@ logical function CVMix_conv_init(Time, G, GV, US, param_file, diag, CS) CS%id_N2 = register_diag_field('ocean_model', 'N2_conv', diag%axesTi, Time, & 'Square of Brunt-Vaisala frequency used by MOM_CVMix_conv module', '1/s2') CS%id_kd_conv = register_diag_field('ocean_model', 'kd_conv', diag%axesTi, Time, & - 'Additional diffusivity added by MOM_CVMix_conv module', 'm2/s', conversion=US%Z_to_m**2) + 'Additional diffusivity added by MOM_CVMix_conv module', 'm2/s', conversion=US%Z2_T_to_m2_s) CS%id_kv_conv = register_diag_field('ocean_model', 'kv_conv', diag%axesTi, Time, & 'Additional viscosity added by MOM_CVMix_conv module', 'm2/s', conversion=US%Z_to_m**2) @@ -232,7 +232,7 @@ subroutine calculate_CVMix_conv(h, tv, G, GV, US, CS, hbl) do K=1,G%ke+1 CS%kv_conv(i,j,K) = US%m_to_Z**2 * kv_col(K) - CS%kd_conv(i,j,K) = US%m_to_Z**2 * kd_col(K) + CS%Kd_conv(i,j,K) = US%m2_s_to_Z2_T * kd_col(K) enddo ! Do not apply mixing due to convection within the boundary layer do k=1,kOBL @@ -245,8 +245,8 @@ subroutine calculate_CVMix_conv(h, tv, G, GV, US, CS, hbl) if (CS%debug) then call hchksum(CS%N2, "MOM_CVMix_conv: N2",G%HI,haloshift=0) - call hchksum(CS%kd_conv, "MOM_CVMix_conv: kd_conv",G%HI,haloshift=0) - call hchksum(CS%kv_conv, "MOM_CVMix_conv: kv_conv",G%HI,haloshift=0) + call hchksum(CS%kd_conv, "MOM_CVMix_conv: kd_conv",G%HI,haloshift=0,scale=US%Z2_T_to_m2_s) + call hchksum(CS%kv_conv, "MOM_CVMix_conv: kv_conv",G%HI,haloshift=0,scale=US%Z_to_m**2) endif ! send diagnostics to post_data diff --git a/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 b/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 index 7e2d010da5..987557310b 100644 --- a/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 +++ b/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 @@ -47,15 +47,15 @@ module MOM_bkgnd_mixing real :: Bryan_Lewis_c4 !< The depth where diffusivity is Bryan_Lewis_bl1 in the !! Bryan-Lewis profile [m] real :: bckgrnd_vdc1 !< Background diffusivity (Ledwell) when - !! horiz_varying_background=.true. + !! horiz_varying_background=.true. [Z2 T-1 ~> m2 s-1] real :: bckgrnd_vdc_eq !< Equatorial diffusivity (Gregg) when - !! horiz_varying_background=.true. + !! horiz_varying_background=.true. [Z2 T-1 ~> m2 s-1] real :: bckgrnd_vdc_psim !< Max. PSI induced diffusivity (MacKinnon) when - !! horiz_varying_background=.true. - real :: bckgrnd_vdc_ban !< Banda Sea diffusivity (Gordon) when - !! horiz_varying_background=.true. - real :: Kd_min !< minimum diapycnal diffusivity [Z2 s-1 ~> m2 s-1] - real :: Kd !< interior diapycnal diffusivity [Z2 s-1 ~> m2 s-1] + !! horiz_varying_background=.true. [Z2 T-1 ~> m2 s-1] + real :: bckgrnd_vdc_Banda !< Banda Sea diffusivity (Gordon) when + !! horiz_varying_background=.true. [Z2 T-1 ~> m2 s-1] + real :: Kd_min !< minimum diapycnal diffusivity [Z2 T-1 ~> m2 s-1] + real :: Kd !< interior diapycnal diffusivity [Z2 T-1 ~> m2 s-1] real :: N0_2Omega !< ratio of the typical Buoyancy frequency to !! twice the Earth's rotation period, used with the !! Henyey scaling from the mixing @@ -64,7 +64,7 @@ module MOM_bkgnd_mixing real :: Kd_tanh_lat_scale !< A nondimensional scaling for the range of !! diffusivities with Kd_tanh_lat_fn. Valid values !! are in the range of -2 to 2; 0.4 reproduces CM2M. - real :: Kdml !< mixed layer diapycnal diffusivity [Z2 s-1 ~> m2 s-1] + real :: Kdml !< mixed layer diapycnal diffusivity [Z2 T-1 ~> m2 s-1] !! when bulkmixedlayer==.false. real :: Hmix !< mixed layer thickness [Z ~> m] when bulkmixedlayer==.false. logical :: Kd_tanh_lat_fn !< If true, use the tanh dependence of Kd_sfc on @@ -100,9 +100,9 @@ module MOM_bkgnd_mixing integer :: id_kd_bkgnd = -1 !< Diagnotic IDs integer :: id_kv_bkgnd = -1 !< Diagnostic IDs - real, allocatable, dimension(:,:) :: Kd_sfc !< surface value of the diffusivity [Z2 s-1 ~> m2 s-1] + real, allocatable, dimension(:,:) :: Kd_sfc !< surface value of the diffusivity [Z2 T-1 ~> m2 s-1] ! Diagnostics arrays - real, allocatable, dimension(:,:,:) :: kd_bkgnd !< Background diffusivity [Z2 s-1 ~> m2 s-1] + real, allocatable, dimension(:,:,:) :: kd_bkgnd !< Background diffusivity [Z2 T-1 ~> m2 s-1] real, allocatable, dimension(:,:,:) :: kv_bkgnd !< Background viscosity [Z2 s-1 ~> m2 s-1] character(len=40) :: bkgnd_scheme_str = "none" !< Background scheme identifier @@ -146,7 +146,7 @@ subroutine bkgnd_mixing_init(Time, G, GV, US, param_file, diag, CS) call get_param(param_file, mdl, "KD", CS%Kd, & "The background diapycnal diffusivity of density in the "//& "interior. Zero or the molecular value, ~1e-7 m2 s-1, "//& - "may be used.", units="m2 s-1", scale=US%m_to_Z**2, fail_if_missing=.true.) + "may be used.", units="m2 s-1", scale=US%m2_s_to_Z2_T, fail_if_missing=.true.) call get_param(param_file, mdl, "KV", Kv, & "The background kinematic viscosity in the interior. "//& @@ -155,7 +155,7 @@ subroutine bkgnd_mixing_init(Time, G, GV, US, param_file, diag, CS) call get_param(param_file, mdl, "KD_MIN", CS%Kd_min, & "The minimum diapycnal diffusivity.", & - units="m2 s-1", default=0.01*CS%Kd*US%Z_to_m**2, scale=US%m_to_Z**2) + units="m2 s-1", default=0.01*CS%Kd*US%Z2_T_to_m2_s, scale=US%m2_s_to_Z2_T) ! The following is needed to set one of the choices of vertical background mixing @@ -175,7 +175,7 @@ subroutine bkgnd_mixing_init(Time, G, GV, US, param_file, diag, CS) "If BULKMIXEDLAYER is false, KDML is the elevated "//& "diapycnal diffusivity in the topmost HMIX of fluid. "//& "KDML is only used if BULKMIXEDLAYER is false.", & - units="m2 s-1", default=CS%Kd*US%Z_to_m**2, scale=US%m_to_Z**2) + units="m2 s-1", default=CS%Kd*US%Z2_T_to_m2_s, scale=US%m2_s_to_Z2_T) call get_param(param_file, mdl, "HMIX_FIXED", CS%Hmix, & "The prescribed depth over which the near-surface "//& "viscosity and diffusivity are elevated when the bulk "//& @@ -194,30 +194,25 @@ subroutine bkgnd_mixing_init(Time, G, GV, US, param_file, diag, CS) if (CS%Bryan_Lewis_diffusivity) then call check_bkgnd_scheme(CS, "BRYAN_LEWIS_DIFFUSIVITY") - call get_param(param_file, mdl, "BRYAN_LEWIS_C1", & - CS%Bryan_Lewis_c1, & + call get_param(param_file, mdl, "BRYAN_LEWIS_C1", CS%Bryan_Lewis_c1, & "The vertical diffusivity values for Bryan-Lewis profile at |z|=D.", & units="m2 s-1", fail_if_missing=.true.) - call get_param(param_file, mdl, "BRYAN_LEWIS_C2", & - CS%Bryan_Lewis_c2, & + call get_param(param_file, mdl, "BRYAN_LEWIS_C2", CS%Bryan_Lewis_c2, & "The amplitude of variation in diffusivity for the Bryan-Lewis profile", & units="m2 s-1", fail_if_missing=.true.) - call get_param(param_file, mdl, "BRYAN_LEWIS_C3", & - CS%Bryan_Lewis_c3, & + call get_param(param_file, mdl, "BRYAN_LEWIS_C3", CS%Bryan_Lewis_c3, & "The inverse length scale for transition region in the Bryan-Lewis profile", & units="m-1", fail_if_missing=.true.) - call get_param(param_file, mdl, "BRYAN_LEWIS_C4", & - CS%Bryan_Lewis_c4, & + call get_param(param_file, mdl, "BRYAN_LEWIS_C4", CS%Bryan_Lewis_c4, & "The depth where diffusivity is BRYAN_LEWIS_C1 in the Bryan-Lewis profile",& units="m", fail_if_missing=.true.) endif ! CS%Bryan_Lewis_diffusivity - call get_param(param_file, mdl, "HORIZ_VARYING_BACKGROUND", & - CS%horiz_varying_background, & + call get_param(param_file, mdl, "HORIZ_VARYING_BACKGROUND", CS%horiz_varying_background, & "If true, apply vertically uniform, latitude-dependent background "//& "diffusivity, as described in Danabasoglu et al., 2012", & default=.false.) @@ -225,25 +220,21 @@ subroutine bkgnd_mixing_init(Time, G, GV, US, param_file, diag, CS) if (CS%horiz_varying_background) then call check_bkgnd_scheme(CS, "HORIZ_VARYING_BACKGROUND") - call get_param(param_file, mdl, "BCKGRND_VDC1", & - CS%bckgrnd_vdc1, & + call get_param(param_file, mdl, "BCKGRND_VDC1", CS%bckgrnd_vdc1, & "Background diffusivity (Ledwell) when HORIZ_VARYING_BACKGROUND=True", & - units="m2 s-1",default = 0.16e-04, scale=US%m_to_Z**2) + units="m2 s-1",default = 0.16e-04, scale=US%m2_s_to_Z2_T) - call get_param(param_file, mdl, "BCKGRND_VDC_EQ", & - CS%bckgrnd_vdc_eq, & + call get_param(param_file, mdl, "BCKGRND_VDC_EQ", CS%bckgrnd_vdc_eq, & "Equatorial diffusivity (Gregg) when HORIZ_VARYING_BACKGROUND=True", & - units="m2 s-1",default = 0.01e-04, scale=US%m_to_Z**2) + units="m2 s-1",default = 0.01e-04, scale=US%m2_s_to_Z2_T) - call get_param(param_file, mdl, "BCKGRND_VDC_PSIM", & - CS%bckgrnd_vdc_psim, & + call get_param(param_file, mdl, "BCKGRND_VDC_PSIM", CS%bckgrnd_vdc_psim, & "Max. PSI induced diffusivity (MacKinnon) when HORIZ_VARYING_BACKGROUND=True", & - units="m2 s-1",default = 0.13e-4, scale=US%m_to_Z**2) + units="m2 s-1",default = 0.13e-4, scale=US%m2_s_to_Z2_T) - call get_param(param_file, mdl, "BCKGRND_VDC_BAN", & - CS%bckgrnd_vdc_ban, & + call get_param(param_file, mdl, "BCKGRND_VDC_BAN", CS%bckgrnd_vdc_Banda, & "Banda Sea diffusivity (Gordon) when HORIZ_VARYING_BACKGROUND=True", & - units="m2 s-1",default = 1.0e-4, scale=US%m_to_Z**2) + units="m2 s-1",default = 1.0e-4, scale=US%m2_s_to_Z2_T) endif call get_param(param_file, mdl, "PRANDTL_BKGND", CS%prandtl_bkgnd, & @@ -254,7 +245,7 @@ subroutine bkgnd_mixing_init(Time, G, GV, US, param_file, diag, CS) if (CS%Bryan_Lewis_diffusivity .or. CS%horiz_varying_background) then prandtl_bkgnd_comp = CS%prandtl_bkgnd - if (CS%Kd /= 0.0) prandtl_bkgnd_comp = Kv/CS%Kd + if (CS%Kd /= 0.0) prandtl_bkgnd_comp = Kv/(US%s_to_T*CS%Kd) if ( abs(CS%prandtl_bkgnd - prandtl_bkgnd_comp)>1.e-14) then call MOM_error(FATAL,"set_diffusivity_init: The provided KD, KV,"//& @@ -308,14 +299,14 @@ subroutine bkgnd_mixing_init(Time, G, GV, US, param_file, diag, CS) ! call closeParameterBlock(param_file) ! allocate arrays and set them to zero - allocate(CS%kd_bkgnd(SZI_(G), SZJ_(G), SZK_(G)+1)); CS%kd_bkgnd(:,:,:) = 0. + allocate(CS%Kd_bkgnd(SZI_(G), SZJ_(G), SZK_(G)+1)); CS%kd_bkgnd(:,:,:) = 0. allocate(CS%kv_bkgnd(SZI_(G), SZJ_(G), SZK_(G)+1)); CS%kv_bkgnd(:,:,:) = 0. allocate(CS%Kd_sfc(SZI_(G), SZJ_(G))); CS%Kd_sfc(:,:) = 0. ! Register diagnostics CS%diag => diag CS%id_kd_bkgnd = register_diag_field('ocean_model', 'Kd_bkgnd', diag%axesTi, Time, & - 'Background diffusivity added by MOM_bkgnd_mixing module', 'm2/s', conversion=US%Z_to_m**2) + 'Background diffusivity added by MOM_bkgnd_mixing module', 'm2/s', conversion=US%Z2_T_to_m2_s) CS%id_kv_bkgnd = register_diag_field('ocean_model', 'Kv_bkgnd', diag%axesTi, Time, & 'Background viscosity added by MOM_bkgnd_mixing module', 'm2/s', conversion=US%Z_to_m**2) @@ -370,7 +361,7 @@ subroutine sfc_bkgnd_mixing(G, US, CS) enddo ; enddo endif - if (CS%debug) call hchksum(CS%Kd_sfc,"After sfc_bkgnd_mixing: Kd_sfc",G%HI,haloshift=0, scale=US%Z_to_m**2) + if (CS%debug) call hchksum(CS%Kd_sfc,"After sfc_bkgnd_mixing: Kd_sfc",G%HI,haloshift=0, scale=US%Z2_T_to_m2_s) end subroutine sfc_bkgnd_mixing @@ -407,8 +398,8 @@ subroutine calculate_bkgnd_mixing(h, tv, N2_lay, Kd_lay, Kv, j, G, GV, US, CS) real :: deg_to_rad !< factor converting degrees to radians, pi/180. real :: abs_sin !< absolute value of sine of latitude [nondim] real :: epsilon - real :: bckgrnd_vdc_psin !< PSI diffusivity in northern hemisphere - real :: bckgrnd_vdc_psis !< PSI diffusivity in southern hemisphere + real :: bckgrnd_vdc_psin !< PSI diffusivity in northern hemisphere [Z2 T-1 ~> m2 s-1] + real :: bckgrnd_vdc_psis !< PSI diffusivity in southern hemisphere [Z2 T-1 ~> m2 s-1] integer :: i, k, is, ie, js, je, nz is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke @@ -440,7 +431,7 @@ subroutine calculate_bkgnd_mixing(h, tv, N2_lay, Kd_lay, Kv, j, G, GV, US, CS) ! Update Kd and Kv. do K=1,nz+1 CS%Kv_bkgnd(i,j,K) = US%m_to_Z**2*Kv_col(K) - CS%Kd_bkgnd(i,j,K) = US%m_to_Z**2*Kd_col(K) + CS%Kd_bkgnd(i,j,K) = US%m2_s_to_Z2_T*Kd_col(K) enddo do k=1,nz Kd_lay(i,j,k) = Kd_lay(i,j,k) + 0.5 * US%m2_s_to_Z2_T * (Kd_col(K) + Kd_col(K+1)) @@ -456,7 +447,7 @@ subroutine calculate_bkgnd_mixing(h, tv, N2_lay, Kd_lay, Kv, j, G, GV, US, CS) if (depth_c <= CS%Hmix) then ; CS%Kd_bkgnd(i,j,k) = CS%Kdml elseif (depth_c >= 2.0*CS%Hmix) then ; CS%Kd_bkgnd(i,j,k) = CS%Kd_sfc(i,j) else - Kd_lay(i,j,k) = US%T_to_s * ((CS%Kd_sfc(i,j) - CS%Kdml) * I_Hmix) * depth_c + & + Kd_lay(i,j,k) = ((CS%Kd_sfc(i,j) - CS%Kdml) * I_Hmix) * depth_c + & (2.0*CS%Kdml - CS%Kd_sfc(i,j)) endif @@ -464,46 +455,47 @@ subroutine calculate_bkgnd_mixing(h, tv, N2_lay, Kd_lay, Kv, j, G, GV, US, CS) enddo ; enddo elseif (CS%horiz_varying_background) then - !### Note that there are lots of hrad-coded parameters here. + !### Note that there are lots of hard-coded parameters (mostly latitudes and longitudes) here. do i=is,ie - bckgrnd_vdc_psis= CS%bckgrnd_vdc_psim * exp(-(0.4*(G%geoLatT(i,j)+28.9))**2) - bckgrnd_vdc_psin= CS%bckgrnd_vdc_psim * exp(-(0.4*(G%geoLatT(i,j)-28.9))**2) - CS%kd_bkgnd(i,j,:) = CS%bckgrnd_vdc_eq + bckgrnd_vdc_psin + bckgrnd_vdc_psis + bckgrnd_vdc_psis = CS%bckgrnd_vdc_psim * exp(-(0.4*(G%geoLatT(i,j)+28.9))**2) + bckgrnd_vdc_psin = CS%bckgrnd_vdc_psim * exp(-(0.4*(G%geoLatT(i,j)-28.9))**2) + !### Add parentheses. + CS%Kd_bkgnd(i,j,:) = CS%bckgrnd_vdc_eq + bckgrnd_vdc_psin + bckgrnd_vdc_psis if (G%geoLatT(i,j) < -10.0) then - CS%kd_bkgnd(i,j,:) = CS%kd_bkgnd(i,j,:) + CS%bckgrnd_vdc1 + CS%Kd_bkgnd(i,j,:) = CS%Kd_bkgnd(i,j,:) + CS%bckgrnd_vdc1 elseif (G%geoLatT(i,j) <= 10.0) then - CS%kd_bkgnd(i,j,:) = CS%kd_bkgnd(i,j,:) + CS%bckgrnd_vdc1 * (G%geoLatT(i,j)/10.0)**2 + CS%Kd_bkgnd(i,j,:) = CS%Kd_bkgnd(i,j,:) + CS%bckgrnd_vdc1 * (G%geoLatT(i,j)/10.0)**2 else - CS%kd_bkgnd(i,j,:) = CS%kd_bkgnd(i,j,:) + CS%bckgrnd_vdc1 + CS%Kd_bkgnd(i,j,:) = CS%Kd_bkgnd(i,j,:) + CS%bckgrnd_vdc1 endif ! North Banda Sea if ( (G%geoLatT(i,j) < -1.0) .and. (G%geoLatT(i,j) > -4.0) .and. & ( mod(G%geoLonT(i,j)+360.0,360.0) > 103.0) .and. & ( mod(G%geoLonT(i,j)+360.0,360.0) < 134.0) ) then - CS%kd_bkgnd(i,j,:) = CS%bckgrnd_vdc_ban + CS%Kd_bkgnd(i,j,:) = CS%bckgrnd_vdc_Banda endif ! Middle Banda Sea if ( (G%geoLatT(i,j) <= -4.0) .and. (G%geoLatT(i,j) > -7.0) .and. & ( mod(G%geoLonT(i,j)+360.0,360.0) > 106.0) .and. & ( mod(G%geoLonT(i,j)+360.0,360.0) < 140.0) ) then - CS%kd_bkgnd(i,j,:) = CS%bckgrnd_vdc_ban + CS%Kd_bkgnd(i,j,:) = CS%bckgrnd_vdc_Banda endif ! South Banda Sea if ( (G%geoLatT(i,j) <= -7.0) .and. (G%geoLatT(i,j) > -8.3) .and. & ( mod(G%geoLonT(i,j)+360.0,360.0) > 111.0) .and. & ( mod(G%geoLonT(i,j)+360.0,360.0) < 142.0) ) then - CS%kd_bkgnd(i,j,:) = CS%bckgrnd_vdc_ban + CS%Kd_bkgnd(i,j,:) = CS%bckgrnd_vdc_Banda endif ! Compute kv_bkgnd - CS%kv_bkgnd(i,j,:) = CS%kd_bkgnd(i,j,:) * CS%prandtl_bkgnd + CS%kv_bkgnd(i,j,:) = US%s_to_T*CS%Kd_bkgnd(i,j,:) * CS%prandtl_bkgnd ! Update Kd (uniform profile; no interpolation needed) - Kd_lay(i,j,:) = US%T_to_s * CS%kd_bkgnd(i,j,1) + Kd_lay(i,j,:) = CS%Kd_bkgnd(i,j,1) enddo @@ -513,13 +505,13 @@ subroutine calculate_bkgnd_mixing(h, tv, N2_lay, Kd_lay, Kv, j, G, GV, US, CS) abs_sin = max(epsilon,abs(sin(G%geoLatT(i,j)*deg_to_rad))) N_2Omega = max(abs_sin,sqrt(US%s_to_T**2 * N2_lay(i,k))*I_2Omega) N02_N2 = (CS%N0_2Omega/N_2Omega)**2 - Kd_lay(i,j,k) = US%T_to_s * max(CS%Kd_min, CS%Kd_sfc(i,j) * & + Kd_lay(i,j,k) = max(CS%Kd_min, CS%Kd_sfc(i,j) * & ((abs_sin * invcosh(N_2Omega/abs_sin)) * I_x30)*N02_N2) enddo ; enddo else do k=1,nz ; do i=is,ie - Kd_lay(i,j,k) = US%T_to_s * CS%Kd_sfc(i,j) + Kd_lay(i,j,k) = CS%Kd_sfc(i,j) enddo ; enddo endif @@ -529,8 +521,8 @@ subroutine calculate_bkgnd_mixing(h, tv, N2_lay, Kd_lay, Kv, j, G, GV, US, CS) CS%kd_bkgnd(i,j,1) = 0.0; CS%kv_bkgnd(i,j,1) = 0.0 CS%kd_bkgnd(i,j,nz+1) = 0.0; CS%kv_bkgnd(i,j,nz+1) = 0.0 do k=2,nz - CS%Kd_bkgnd(i,j,k) = US%s_to_T * (0.5*(Kd_lay(i,j,K-1) + Kd_lay(i,j,K))) - CS%Kv_bkgnd(i,j,k) = CS%Kd_bkgnd(i,j,k) * CS%prandtl_bkgnd + CS%Kd_bkgnd(i,j,k) = 0.5*(Kd_lay(i,j,K-1) + Kd_lay(i,j,K)) + CS%Kv_bkgnd(i,j,k) = US%s_to_T*CS%Kd_bkgnd(i,j,k) * CS%prandtl_bkgnd enddo enddo endif diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index 02e5879e06..d7072d0e1c 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -693,8 +693,8 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & ! Increment vertical diffusion and viscosity due to convection !$OMP parallel do default(shared) do k=1,nz+1 ; do j=js,je ; do i=is,ie - Kd_heat(i,j,k) = Kd_heat(i,j,k) + US%T_to_s*CS%CVMix_conv_csp%kd_conv(i,j,k) - Kd_salt(i,j,k) = Kd_salt(i,j,k) + US%T_to_s*CS%CVMix_conv_csp%kd_conv(i,j,k) + Kd_heat(i,j,k) = Kd_heat(i,j,k) + CS%CVMix_conv_csp%kd_conv(i,j,k) + Kd_salt(i,j,k) = Kd_salt(i,j,k) + CS%CVMix_conv_csp%kd_conv(i,j,k) if (CS%useKPP) then visc%Kv_shear(i,j,k) = visc%Kv_shear(i,j,k) + CS%CVMix_conv_csp%kv_conv(i,j,k) else @@ -1562,7 +1562,7 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en call calculate_CVMix_conv(h, tv, G, GV, US, CS%CVMix_conv_csp, Hml) do K=1,nz+1 ; do j=js,je ; do i=is,ie - Kd_int(i,j,K) = Kd_int(i,j,K) + US%T_to_s * CS%CVMix_conv_csp%kd_conv(i,j,K) + Kd_int(i,j,K) = Kd_int(i,j,K) + CS%CVMix_conv_csp%kd_conv(i,j,K) visc%Kv_slow(i,j,K) = visc%Kv_slow(i,j,K) + CS%CVMix_conv_csp%kv_conv(i,j,K) enddo ; enddo ; enddo endif @@ -1571,10 +1571,10 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en call cpu_clock_begin(id_clock_kpp) if (CS%debug) then - call hchksum(CS%KPP_temp_flux, "before KPP_applyNLT netHeat",G%HI,haloshift=0, scale=GV%H_to_m) - call hchksum(CS%KPP_salt_flux, "before KPP_applyNLT netSalt",G%HI,haloshift=0, scale=GV%H_to_m) - call hchksum(CS%KPP_NLTheat, "before KPP_applyNLT NLTheat",G%HI,haloshift=0) - call hchksum(CS%KPP_NLTscalar, "before KPP_applyNLT NLTscalar",G%HI,haloshift=0) + call hchksum(CS%KPP_temp_flux, "before KPP_applyNLT netHeat", G%HI, haloshift=0, scale=GV%H_to_m) + call hchksum(CS%KPP_salt_flux, "before KPP_applyNLT netSalt", G%HI, haloshift=0, scale=GV%H_to_m) + call hchksum(CS%KPP_NLTheat, "before KPP_applyNLT NLTheat", G%HI, haloshift=0) + call hchksum(CS%KPP_NLTscalar, "before KPP_applyNLT NLTscalar", G%HI, haloshift=0) endif ! Apply non-local transport of heat and salt ! Changes: tv%T, tv%S From badeb508c2ab79613a3963a50e0a2aa49aa98b64 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Mon, 24 Jun 2019 16:44:52 -0400 Subject: [PATCH 30/82] +Added dimensional testing for shared viscosities Added rescaling of time units for dimensional consistency testing of shared viscosities, including visc%Kv_shear and visc%Kv_slow and the values returned from CVMix_conv and CVMix_shear. All answers are bitwise identical. --- src/core/MOM_variables.F90 | 6 ++--- .../vertical/MOM_CVMix_KPP.F90 | 16 ++++++------ .../vertical/MOM_CVMix_conv.F90 | 8 +++--- .../vertical/MOM_CVMix_shear.F90 | 8 +++--- .../vertical/MOM_diabatic_driver.F90 | 8 +++--- .../vertical/MOM_kappa_shear.F90 | 10 +++---- .../vertical/MOM_set_diffusivity.F90 | 6 ++--- .../vertical/MOM_set_viscosity.F90 | 26 ++++++++++--------- .../vertical/MOM_vert_friction.F90 | 22 ++++++++-------- 9 files changed, 56 insertions(+), 54 deletions(-) diff --git a/src/core/MOM_variables.F90 b/src/core/MOM_variables.F90 index 698986c7c0..24e3210958 100644 --- a/src/core/MOM_variables.F90 +++ b/src/core/MOM_variables.F90 @@ -247,13 +247,13 @@ module MOM_variables !! in tracer columns [Z2 T-1 ~> m2 s-1]. real, pointer, dimension(:,:,:) :: Kv_shear => NULL() !< The shear-driven turbulent vertical viscosity at the interfaces between layers - !! in tracer columns [Z2 s-1 ~> m2 s-1]. + !! in tracer columns [Z2 T-1 ~> m2 s-1]. real, pointer, dimension(:,:,:) :: Kv_shear_Bu => NULL() !< The shear-driven turbulent vertical viscosity at the interfaces between layers in - !! corner columns [Z2 s-1 ~> m2 s-1]. + !! corner columns [Z2 T-1 ~> m2 s-1]. real, pointer, dimension(:,:,:) :: Kv_slow => NULL() !< The turbulent vertical viscosity component due to "slow" processes (e.g., tidal, - !! background, convection etc) [Z2 s-1 ~> m2 s-1]. + !! background, convection etc) [Z2 T-1 ~> m2 s-1]. real, pointer, dimension(:,:,:) :: TKE_turb => NULL() !< The turbulent kinetic energy per unit mass at the interfaces [m2 s-2]. !! This may be at the tracer or corner points diff --git a/src/parameterizations/vertical/MOM_CVMix_KPP.F90 b/src/parameterizations/vertical/MOM_CVMix_KPP.F90 index 10ff57f528..22e69077fb 100644 --- a/src/parameterizations/vertical/MOM_CVMix_KPP.F90 +++ b/src/parameterizations/vertical/MOM_CVMix_KPP.F90 @@ -600,7 +600,7 @@ subroutine KPP_calculate(CS, G, GV, US, h, uStar, & !! [Z2 T-1 ~> m2 s-1] real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(inout) :: Kv !< (in) Vertical viscosity w/o KPP !! (out) Vertical viscosity including KPP - !! [Z2 s-1 ~> m2 s-1] + !! [Z2 T-1 ~> m2 s-1] real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(inout) :: nonLocalTransHeat !< Temp non-local transport [m s-1] real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(inout) :: nonLocalTransScalar !< scalar non-local transport [m s-1] @@ -683,9 +683,9 @@ subroutine KPP_calculate(CS, G, GV, US, h, uStar, & Kdiffusivity(:,:) = 0. ! Diffusivities for heat and salt [m2 s-1] Kviscosity(:) = 0. ! Viscosity [m2 s-1] else - Kdiffusivity(:,1) = US%Z_to_m**2*US%T_to_s * Kt(i,j,:) - Kdiffusivity(:,2) = US%Z_to_m**2*US%T_to_s * Ks(i,j,:) - Kviscosity(:) = US%Z_to_m**2 * Kv(i,j,:) + Kdiffusivity(:,1) = US%Z2_T_to_m2_s * Kt(i,j,:) + Kdiffusivity(:,2) = US%Z2_T_to_m2_s * Ks(i,j,:) + Kviscosity(:) = US%Z2_T_to_m2_s * Kv(i,j,:) endif call CVMix_coeffs_kpp(Kviscosity(:), & ! (inout) Total viscosity [m2 s-1] @@ -830,15 +830,15 @@ subroutine KPP_calculate(CS, G, GV, US, h, uStar, & do k=1, G%ke+1 Kt(i,j,k) = Kt(i,j,k) + US%m2_s_to_Z2_T * Kdiffusivity(k,1) Ks(i,j,k) = Ks(i,j,k) + US%m2_s_to_Z2_T * Kdiffusivity(k,2) - Kv(i,j,k) = Kv(i,j,k) + US%m_to_Z**2 * Kviscosity(k) - if (CS%Stokes_Mixing) Waves%KvS(i,j,k) = US%Z_to_m**2 * Kv(i,j,k) + Kv(i,j,k) = Kv(i,j,k) + US%m2_s_to_Z2_T * Kviscosity(k) + if (CS%Stokes_Mixing) Waves%KvS(i,j,k) = US%Z_to_m**2*US%s_to_T * Kv(i,j,k) enddo else ! KPP replaces prior diffusivity when former is non-zero do k=1, G%ke+1 if (Kdiffusivity(k,1) /= 0.) Kt(i,j,k) = US%m2_s_to_Z2_T * Kdiffusivity(k,1) if (Kdiffusivity(k,2) /= 0.) Ks(i,j,k) = US%m2_s_to_Z2_T * Kdiffusivity(k,2) - if (Kviscosity(k) /= 0.) Kv(i,j,k) = US%m_to_Z**2 * Kviscosity(k) - if (CS%Stokes_Mixing) Waves%KvS(i,j,k) = US%Z_to_m**2 * Kv(i,j,k) + if (Kviscosity(k) /= 0.) Kv(i,j,k) = US%m2_s_to_Z2_T * Kviscosity(k) + if (CS%Stokes_Mixing) Waves%KvS(i,j,k) = US%Z_to_m**2*US%s_to_T * Kv(i,j,k) enddo endif endif diff --git a/src/parameterizations/vertical/MOM_CVMix_conv.F90 b/src/parameterizations/vertical/MOM_CVMix_conv.F90 index cb5a5bad07..026bffe34c 100644 --- a/src/parameterizations/vertical/MOM_CVMix_conv.F90 +++ b/src/parameterizations/vertical/MOM_CVMix_conv.F90 @@ -43,7 +43,7 @@ module MOM_CVMix_conv ! Diagnostics arrays real, allocatable, dimension(:,:,:) :: N2 !< Squared Brunt-Vaisala frequency [s-2] real, allocatable, dimension(:,:,:) :: kd_conv !< Diffusivity added by convection [Z2 T-1 ~> m2 s-1] - real, allocatable, dimension(:,:,:) :: kv_conv !< Viscosity added by convection [m2 s-1] + real, allocatable, dimension(:,:,:) :: kv_conv !< Viscosity added by convection [Z2 T-1 ~> m2 s-1] end type CVMix_conv_cs @@ -136,7 +136,7 @@ logical function CVMix_conv_init(Time, G, GV, US, param_file, diag, CS) CS%id_kd_conv = register_diag_field('ocean_model', 'kd_conv', diag%axesTi, Time, & 'Additional diffusivity added by MOM_CVMix_conv module', 'm2/s', conversion=US%Z2_T_to_m2_s) CS%id_kv_conv = register_diag_field('ocean_model', 'kv_conv', diag%axesTi, Time, & - 'Additional viscosity added by MOM_CVMix_conv module', 'm2/s', conversion=US%Z_to_m**2) + 'Additional viscosity added by MOM_CVMix_conv module', 'm2/s', conversion=US%Z2_T_to_m2_s) call CVMix_init_conv(convect_diff=CS%kd_conv_const, & convect_visc=CS%kv_conv_const, & @@ -231,7 +231,7 @@ subroutine calculate_CVMix_conv(h, tv, G, GV, US, CS, hbl) OBL_ind=kOBL) do K=1,G%ke+1 - CS%kv_conv(i,j,K) = US%m_to_Z**2 * kv_col(K) + CS%kv_conv(i,j,K) = US%m2_s_to_Z2_T * kv_col(K) CS%Kd_conv(i,j,K) = US%m2_s_to_Z2_T * kd_col(K) enddo ! Do not apply mixing due to convection within the boundary layer @@ -246,7 +246,7 @@ subroutine calculate_CVMix_conv(h, tv, G, GV, US, CS, hbl) if (CS%debug) then call hchksum(CS%N2, "MOM_CVMix_conv: N2",G%HI,haloshift=0) call hchksum(CS%kd_conv, "MOM_CVMix_conv: kd_conv",G%HI,haloshift=0,scale=US%Z2_T_to_m2_s) - call hchksum(CS%kv_conv, "MOM_CVMix_conv: kv_conv",G%HI,haloshift=0,scale=US%Z_to_m**2) + call hchksum(CS%kv_conv, "MOM_CVMix_conv: kv_conv",G%HI,haloshift=0,scale=US%m2_s_to_Z2_T) endif ! send diagnostics to post_data diff --git a/src/parameterizations/vertical/MOM_CVMix_shear.F90 b/src/parameterizations/vertical/MOM_CVMix_shear.F90 index c949ff3cc6..a93f3a7169 100644 --- a/src/parameterizations/vertical/MOM_CVMix_shear.F90 +++ b/src/parameterizations/vertical/MOM_CVMix_shear.F90 @@ -67,7 +67,7 @@ subroutine calculate_CVMix_shear(u_H, v_H, h, tv, kd, kv, G, GV, US, CS ) real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(out) :: kd !< The vertical diffusivity at each interface !! (not layer!) [Z2 T-1 ~> m2 s-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(out) :: kv !< The vertical viscosity at each interface - !! (not layer!) [Z2 s-1 ~> m2 s-1]. + !! (not layer!) [Z2 T-1 ~> m2 s-1]. type(CVMix_shear_cs), pointer :: CS !< The control structure returned by a previous call to !! CVMix_shear_init. ! Local variables @@ -156,7 +156,7 @@ subroutine calculate_CVMix_shear(u_H, v_H, h, tv, kd, kv, G, GV, US, CS ) endif do K=1,G%ke+1 - Kvisc(K) = US%Z_to_m**2 * kv(i,j,K) + Kvisc(K) = US%Z2_T_to_m2_s * kv(i,j,K) Kdiff(K) = US%Z2_T_to_m2_s * kd(i,j,K) enddo @@ -167,7 +167,7 @@ subroutine calculate_CVMix_shear(u_H, v_H, h, tv, kd, kv, G, GV, US, CS ) nlev=G%ke, & max_nlev=G%ke) do K=1,G%ke+1 - kv(i,j,K) = US%m_to_Z**2 * Kvisc(K) + kv(i,j,K) = US%m2_s_to_Z2_T * Kvisc(K) kd(i,j,K) = US%m2_s_to_Z2_T * Kdiff(K) enddo enddo @@ -291,7 +291,7 @@ logical function CVMix_shear_init(Time, G, GV, US, param_file, diag, CS) CS%id_kd = register_diag_field('ocean_model', 'kd_shear_CVMix', diag%axesTi, Time, & 'Vertical diffusivity added by MOM_CVMix_shear module', 'm2/s', conversion=US%Z2_T_to_m2_s) CS%id_kv = register_diag_field('ocean_model', 'kv_shear_CVMix', diag%axesTi, Time, & - 'Vertical viscosity added by MOM_CVMix_shear module', 'm2/s', conversion=US%Z_to_m**2) + 'Vertical viscosity added by MOM_CVMix_shear module', 'm2/s', conversion=US%Z2_T_to_m2_s) end function CVMix_shear_init diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index d7072d0e1c..2855e7460b 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -755,10 +755,10 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & !### These expressesions assume a Prandtl number of 1. if (CS%ePBL_is_additive) then Kd_add_here = Kd_ePBL(i,j,K) - visc%Kv_shear(i,j,K) = visc%Kv_shear(i,j,K) + US%s_to_T*Kd_ePBL(i,j,K) + visc%Kv_shear(i,j,K) = visc%Kv_shear(i,j,K) + Kd_ePBL(i,j,K) else Kd_add_here = max(Kd_ePBL(i,j,K) - visc%Kd_shear(i,j,K), 0.0) - visc%Kv_shear(i,j,K) = max(visc%Kv_shear(i,j,K), US%s_to_T*Kd_ePBL(i,j,K)) + visc%Kv_shear(i,j,K) = max(visc%Kv_shear(i,j,K), Kd_ePBL(i,j,K)) endif Kd_heat(i,j,K) = Kd_heat(i,j,K) + Kd_add_here @@ -1705,10 +1705,10 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en if (CS%ePBL_is_additive) then Kd_add_here = Kd_ePBL(i,j,K) - visc%Kv_shear(i,j,K) = visc%Kv_shear(i,j,K) + US%s_to_T*Kd_ePBL(i,j,K) + visc%Kv_shear(i,j,K) = visc%Kv_shear(i,j,K) + Kd_ePBL(i,j,K) else Kd_add_here = max(Kd_ePBL(i,j,K) - visc%Kd_shear(i,j,K), 0.0) - visc%Kv_shear(i,j,K) = max(visc%Kv_shear(i,j,K), US%s_to_T*Kd_ePBL(i,j,K)) + visc%Kv_shear(i,j,K) = max(visc%Kv_shear(i,j,K), Kd_ePBL(i,j,K)) endif Ent_int = Kd_add_here * (GV%Z_to_H**2 * US%s_to_T*dt) / & (0.5*(h(i,j,k-1) + h(i,j,k)) + h_neglect) diff --git a/src/parameterizations/vertical/MOM_kappa_shear.F90 b/src/parameterizations/vertical/MOM_kappa_shear.F90 index bdbcd4dbdd..b184790360 100644 --- a/src/parameterizations/vertical/MOM_kappa_shear.F90 +++ b/src/parameterizations/vertical/MOM_kappa_shear.F90 @@ -120,7 +120,7 @@ subroutine Calculate_kappa_shear(u_in, v_in, h, tv, p_surf, kappa_io, tke_io, & !! toward convergence. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), & intent(inout) :: kv_io !< The vertical viscosity at each interface - !! (not layer!) [Z2 s-1 ~> m2 s-1]. This discards any + !! (not layer!) [Z2 T-1 ~> m2 s-1]. This discards any !! previous value (i.e. it is intent out) and !! simply sets Kv = Prandtl * Kd_shear real, intent(in) :: dt !< Time increment [s]. @@ -353,7 +353,7 @@ subroutine Calculate_kappa_shear(u_in, v_in, h, tv, p_surf, kappa_io, tke_io, & do K=1,nz+1 ; do i=is,ie kappa_io(i,j,K) = G%mask2dT(i,j) * kappa_2d(i,K) tke_io(i,j,K) = G%mask2dT(i,j) * tke_2d(i,K) - kv_io(i,j,K) = ( G%mask2dT(i,j) * US%s_to_T*kappa_2d(i,K) ) * CS%Prandtl_turb + kv_io(i,j,K) = ( G%mask2dT(i,j) * kappa_2d(i,K) ) * CS%Prandtl_turb #ifdef ADD_DIAGNOSTICS I_Ld2_3d(i,j,K) = I_Ld2_2d(i,K) dz_Int_3d(i,j,K) = dz_Int_2d(i,K) @@ -408,7 +408,7 @@ subroutine Calc_kappa_shear_vertex(u_in, v_in, h, T_in, S_in, tv, p_surf, kappa_ !! timestep, which may accelerate the iteration !! toward convergence. real, dimension(SZIB_(G),SZJB_(G),SZK_(GV)+1), & - intent(inout) :: kv_io !< The vertical viscosity at each interface [Z2 s-1 ~> m2 s-1]. + intent(inout) :: kv_io !< The vertical viscosity at each interface [Z2 T-1 ~> m2 s-1]. !! The previous value is used to initialize kappa !! in the vertex columes as Kappa = Kv/Prandtl !! to accelerate the iteration toward covergence. @@ -540,7 +540,7 @@ subroutine Calc_kappa_shear_vertex(u_in, v_in, h, T_in, S_in, tv, p_surf, kappa_ rho_2d(I,k) = GV%Rlay(k) enddo ; enddo ; endif if (.not.new_kappa) then ; do K=1,nz+1 ; do I=IsB,IeB - kappa_2d(I,K,J2) = US%T_to_s*kv_io(I,J,K) * I_Prandtl + kappa_2d(I,K,J2) = kv_io(I,J,K) * I_Prandtl enddo ; enddo ; endif !--------------------------------------- @@ -677,7 +677,7 @@ subroutine Calc_kappa_shear_vertex(u_in, v_in, h, T_in, S_in, tv, p_surf, kappa_ do K=1,nz+1 ; do I=IsB,IeB tke_io(I,J,K) = G%mask2dBu(I,J) * tke_2d(I,K) - kv_io(I,J,K) = ( G%mask2dBu(I,J) * US%s_to_T*kappa_2d(I,K,J2) ) * CS%Prandtl_turb + kv_io(I,J,K) = ( G%mask2dBu(I,J) * kappa_2d(I,K,J2) ) * CS%Prandtl_turb #ifdef ADD_DIAGNOSTICS I_Ld2_3d(I,J,K) = I_Ld2_2d(I,K) dz_Int_3d(I,J,K) = dz_Int_2d(I,K) diff --git a/src/parameterizations/vertical/MOM_set_diffusivity.F90 b/src/parameterizations/vertical/MOM_set_diffusivity.F90 index 67e9bbe8fa..a7cd3a534f 100644 --- a/src/parameterizations/vertical/MOM_set_diffusivity.F90 +++ b/src/parameterizations/vertical/MOM_set_diffusivity.F90 @@ -357,7 +357,7 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & if (associated(visc%Kv_shear)) visc%Kv_shear(:,:,:) = 0.0 ! needed for other parameterizations if (CS%debug) then call hchksum(visc%Kd_shear, "after calc_KS_vert visc%Kd_shear", G%HI, scale=US%Z2_T_to_m2_s) - call Bchksum(visc%Kv_shear_Bu, "after calc_KS_vert visc%Kv_shear_Bu", G%HI, scale=US%Z_to_m**2) + call Bchksum(visc%Kv_shear_Bu, "after calc_KS_vert visc%Kv_shear_Bu", G%HI, scale=US%Z2_T_to_m2_s) call Bchksum(visc%TKE_turb, "after calc_KS_vert visc%TKE_turb", G%HI) endif else @@ -367,7 +367,7 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & visc%Kv_shear, dt, G, GV, US, CS%kappaShear_CSp) if (CS%debug) then call hchksum(visc%Kd_shear, "after calc_KS visc%Kd_shear", G%HI, scale=US%Z2_T_to_m2_s) - call hchksum(visc%Kv_shear, "after calc_KS visc%Kv_shear", G%HI, scale=US%Z_to_m**2) + call hchksum(visc%Kv_shear, "after calc_KS visc%Kv_shear", G%HI, scale=US%Z2_T_to_m2_s) call hchksum(visc%TKE_turb, "after calc_KS visc%TKE_turb", G%HI) endif endif @@ -378,7 +378,7 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & call calculate_CVMix_shear(u_h, v_h, h, tv, visc%Kd_shear, visc%Kv_shear, G, GV, US, CS%CVMix_shear_CSp) if (CS%debug) then call hchksum(visc%Kd_shear, "after CVMix_shear visc%Kd_shear", G%HI, scale=US%Z2_T_to_m2_s) - call hchksum(visc%Kv_shear, "after CVMix_shear visc%Kv_shear", G%HI, scale=US%Z_to_m**2) + call hchksum(visc%Kv_shear, "after CVMix_shear visc%Kv_shear", G%HI, scale=US%Z2_T_to_m2_s) endif elseif (associated(visc%Kv_shear)) then visc%Kv_shear(:,:,:) = 0.0 ! needed if calculate_kappa_shear is not enabled diff --git a/src/parameterizations/vertical/MOM_set_viscosity.F90 b/src/parameterizations/vertical/MOM_set_viscosity.F90 index 9fad0c8f2e..5b9588b17c 100644 --- a/src/parameterizations/vertical/MOM_set_viscosity.F90 +++ b/src/parameterizations/vertical/MOM_set_viscosity.F90 @@ -1785,10 +1785,12 @@ subroutine set_visc_init(Time, G, GV, US, param_file, diag, visc, CS, restart_CS real :: Csmag_chan_dflt, smag_const1, TKE_decay_dflt, bulk_Ri_ML_dflt real :: Kv_background real :: omega_frac_dflt - real :: Z_rescale ! A rescaling factor for heights from the representation in - ! a restart file to the internal representation in this run. - real :: I_T_rescale ! A rescaling factor for time from the internal representation in this run - ! to the representation in a restart file. + real :: Z_rescale ! A rescaling factor for heights from the representation in + ! a restart file to the internal representation in this run. + real :: I_T_rescale ! A rescaling factor for time from the internal representation in this run + ! to the representation in a restart file. + real :: Z2_T_rescale ! A rescaling factor for vertical diffusivities and viscosities from the + ! representation in a restart file to the internal representation in this run. integer :: i, j, k, is, ie, js, je, n integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB, nz logical :: use_kappa_shear, adiabatic, use_omega @@ -2039,36 +2041,36 @@ subroutine set_visc_init(Time, G, GV, US, param_file, diag, visc, CS, restart_CS call register_restart_field_as_obsolete('Kd_turb','Kd_shear', restart_CS) call register_restart_field_as_obsolete('Kv_turb','Kv_shear', restart_CS) + Z_rescale = 1.0 if ((US%m_to_Z_restart /= 0.0) .and. (US%m_to_Z_restart /= US%m_to_Z)) & Z_rescale = US%m_to_Z / US%m_to_Z_restart - + I_T_rescale = 1.0 if ((US%s_to_T_restart /= 0.0) .and. (US%s_to_T_restart /= US%s_to_T)) & I_T_rescale = US%s_to_T_restart / US%s_to_T + Z2_T_rescale = Z_rescale**2*I_T_rescale - if (Z_rescale**2*I_T_rescale /= 1.0) then + if (Z2_T_rescale /= 1.0) then if (associated(visc%Kd_shear)) then ; if (query_initialized(visc%Kd_shear, "Kd_shear", restart_CS)) then do k=1,nz+1 ; do j=js,je ; do i=is,ie - visc%Kd_shear(i,j,k) = Z_rescale**2*I_T_rescale * visc%Kd_shear(i,j,k) + visc%Kd_shear(i,j,k) = Z2_T_rescale * visc%Kd_shear(i,j,k) enddo ; enddo ; enddo endif ; endif - endif - if (Z_rescale /= 1.0) then if (associated(visc%Kv_shear)) then ; if (query_initialized(visc%Kv_shear, "Kv_shear", restart_CS)) then do k=1,nz+1 ; do j=js,je ; do i=is,ie - visc%Kv_shear(i,j,k) = Z_rescale**2 * visc%Kv_shear(i,j,k) + visc%Kv_shear(i,j,k) = Z2_T_rescale * visc%Kv_shear(i,j,k) enddo ; enddo ; enddo endif ; endif if (associated(visc%Kv_shear_Bu)) then ; if (query_initialized(visc%Kv_shear_Bu, "Kv_shear_Bu", restart_CS)) then do k=1,nz+1 ; do j=js,je ; do i=is,ie - visc%Kv_shear_Bu(i,j,k) = Z_rescale**2 * visc%Kv_shear_Bu(i,j,k) + visc%Kv_shear_Bu(i,j,k) = Z2_T_rescale * visc%Kv_shear_Bu(i,j,k) enddo ; enddo ; enddo endif ; endif if (associated(visc%Kv_slow)) then ; if (query_initialized(visc%Kv_slow, "Kv_slow", restart_CS)) then do k=1,nz+1 ; do j=js,je ; do i=is,ie - visc%Kv_slow(i,j,k) = Z_rescale**2 * visc%Kv_slow(i,j,k) + visc%Kv_slow(i,j,k) = Z2_T_rescale * visc%Kv_slow(i,j,k) enddo ; enddo ; enddo endif ; endif endif diff --git a/src/parameterizations/vertical/MOM_vert_friction.F90 b/src/parameterizations/vertical/MOM_vert_friction.F90 index 31294778b4..1ebf825b92 100644 --- a/src/parameterizations/vertical/MOM_vert_friction.F90 +++ b/src/parameterizations/vertical/MOM_vert_friction.F90 @@ -1074,7 +1074,7 @@ subroutine find_coupling_coef(a_cpl, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, kv_tbl, & ! The viscosity in a top boundary layer under ice [Z2 s-1 ~> m2 s-1]. tbl_thick real, dimension(SZIB_(G),SZK_(GV)) :: & - Kv_add ! A viscosity to add [Z2 s-1 ~> m2 s-1]. + Kv_add ! A viscosity to add [Z2 T-1 ~> m2 s-1]. real :: h_shear ! The distance over which shears occur [H ~> m or kg m-2]. real :: r ! A thickness to compare with Hbbl [H ~> m or kg m-2]. real :: visc_ml ! The mixed layer viscosity [Z2 s-1 ~> m2 s-1]. @@ -1157,7 +1157,7 @@ subroutine find_coupling_coef(a_cpl, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, endif ; enddo endif do K=2,nz ; do i=is,ie ; if (do_i(i)) then - a_cpl(i,K) = a_cpl(i,K) + Kv_add(i,K) + a_cpl(i,K) = a_cpl(i,K) + US%s_to_T*Kv_add(i,K) endif ; enddo ; enddo else do K=2,nz ; do i=is,ie ; if (do_i(i)) then @@ -1173,7 +1173,7 @@ subroutine find_coupling_coef(a_cpl, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, endif ; enddo endif do K=2,nz ; do i=is,ie ; if (do_i(i)) then - a_cpl(i,K) = a_cpl(i,K) + Kv_add(i,K) + a_cpl(i,K) = a_cpl(i,K) + US%s_to_T*Kv_add(i,K) endif ; enddo ; enddo endif endif @@ -1181,11 +1181,11 @@ subroutine find_coupling_coef(a_cpl, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, if (associated(visc%Kv_shear_Bu)) then if (work_on_u) then do K=2,nz ; do I=Is,Ie ; If (do_i(I)) then - a_cpl(I,K) = a_cpl(I,K) + (2.*0.5)*(visc%Kv_shear_Bu(I,J-1,k) + visc%Kv_shear_Bu(I,J,k)) + a_cpl(I,K) = a_cpl(I,K) + (2.*0.5)*(US%s_to_T*visc%Kv_shear_Bu(I,J-1,k) + US%s_to_T*visc%Kv_shear_Bu(I,J,k)) endif ; enddo ; enddo else do K=2,nz ; do i=is,ie ; if (do_i(i)) then - a_cpl(i,K) = a_cpl(i,K) + (2.*0.5)*(visc%Kv_shear_Bu(I-1,J,k) + visc%Kv_shear_Bu(I,J,k)) + a_cpl(i,K) = a_cpl(i,K) + (2.*0.5)*(US%s_to_T*visc%Kv_shear_Bu(I-1,J,k) + US%s_to_T*visc%Kv_shear_Bu(I,J,k)) endif ; enddo ; enddo endif endif @@ -1195,19 +1195,19 @@ subroutine find_coupling_coef(a_cpl, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, ! GMM/ A factor of 2 is also needed here, see comment above from BGR. if (work_on_u) then do K=2,nz ; do i=is,ie ; if (do_i(i)) then - Kv_add(i,K) = Kv_add(i,K) + 1.0 * (visc%Kv_slow(i,j,k) + visc%Kv_slow(i+1,j,k)) + Kv_add(I,K) = Kv_add(I,K) + 1.0 * (visc%Kv_slow(i,j,k) + visc%Kv_slow(i+1,j,k)) endif ; enddo ; enddo if (do_OBCs) then do I=is,ie ; if (do_i(I) .and. (OBC%segnum_u(I,j) /= OBC_NONE)) then if (OBC%segment(OBC%segnum_u(I,j))%direction == OBC_DIRECTION_E) then - do K=2,nz ; Kv_add(i,K) = Kv_add(i,K) + 2. * visc%Kv_slow(i,j,k) ; enddo + do K=2,nz ; Kv_add(I,K) = Kv_add(I,K) + 2. * visc%Kv_slow(i,j,k) ; enddo elseif (OBC%segment(OBC%segnum_u(I,j))%direction == OBC_DIRECTION_W) then - do K=2,nz ; Kv_add(i,K) = Kv_add(i,K) + 2. * visc%Kv_slow(i+1,j,k) ; enddo + do K=2,nz ; Kv_add(I,K) = Kv_add(I,K) + 2. * visc%Kv_slow(i+1,j,k) ; enddo endif endif ; enddo endif do K=2,nz ; do i=is,ie ; if (do_i(i)) then - a_cpl(i,K) = a_cpl(i,K) + Kv_add(i,K) + a_cpl(I,K) = a_cpl(I,K) + US%s_to_T*Kv_add(I,K) endif ; enddo ; enddo else do K=2,nz ; do i=is,ie ; if (do_i(i)) then @@ -1224,7 +1224,7 @@ subroutine find_coupling_coef(a_cpl, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, endif ; enddo endif do K=2,nz ; do i=is,ie ; if (do_i(i)) then - a_cpl(i,K) = a_cpl(i,K) + Kv_add(i,K) + a_cpl(i,K) = a_cpl(i,K) + US%s_to_T*Kv_add(i,K) endif ; enddo ; enddo endif endif @@ -1735,7 +1735,7 @@ subroutine vertvisc_init(MIS, Time, G, GV, US, param_file, diag, ADp, dirs, & ALLOC_(CS%h_v(isd:ied,JsdB:JedB,nz)) ; CS%h_v(:,:,:) = 0.0 CS%id_Kv_slow = register_diag_field('ocean_model', 'Kv_slow', diag%axesTi, Time, & - 'Slow varying vertical viscosity', 'm2 s-1', conversion=US%Z_to_m**2) + 'Slow varying vertical viscosity', 'm2 s-1', conversion=US%Z2_T_to_m2_s) CS%id_Kv_u = register_diag_field('ocean_model', 'Kv_u', diag%axesCuL, Time, & 'Total vertical viscosity at u-points', 'm2 s-1', conversion=US%Z_to_m**2) From b2c6bab09d89e8cf9b53d8ce984f4bb27642a2a1 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 25 Jun 2019 02:04:36 -0400 Subject: [PATCH 31/82] +Added dimensional testing for BBL viscosities Added rescaling of time units for dimensional consistency testing of the shared boundary layer viscosities, visc%Kv_BBL_[uv] and visc%Kv_TBL_[uv], along with some of the internal variables in MOM_set_diffusivity.F90. All answers are bitwise identical. --- src/core/MOM_variables.F90 | 8 +- src/parameterizations/lateral/MOM_MEKE.F90 | 4 +- .../vertical/MOM_set_diffusivity.F90 | 6 +- .../vertical/MOM_set_viscosity.F90 | 84 +++++++++---------- .../vertical/MOM_vert_friction.F90 | 8 +- 5 files changed, 55 insertions(+), 55 deletions(-) diff --git a/src/core/MOM_variables.F90 b/src/core/MOM_variables.F90 index 24e3210958..ac7408879a 100644 --- a/src/core/MOM_variables.F90 +++ b/src/core/MOM_variables.F90 @@ -203,8 +203,8 @@ module MOM_variables real, pointer, dimension(:,:) :: & bbl_thick_u => NULL(), & !< The bottom boundary layer thickness at the u-points [Z ~> m]. bbl_thick_v => NULL(), & !< The bottom boundary layer thickness at the v-points [Z ~> m]. - kv_bbl_u => NULL(), & !< The bottom boundary layer viscosity at the u-points [Z2 s-1 ~> m2 s-1]. - kv_bbl_v => NULL(), & !< The bottom boundary layer viscosity at the v-points [Z2 s-1 ~> m2 s-1]. + kv_bbl_u => NULL(), & !< The bottom boundary layer viscosity at the u-points [Z2 T-1 ~> m2 s-1]. + kv_bbl_v => NULL(), & !< The bottom boundary layer viscosity at the v-points [Z2 T-1 ~> m2 s-1]. ustar_BBL => NULL() !< The turbulence velocity in the bottom boundary layer at h points [Z s-1 ~> m s-1]. real, pointer, dimension(:,:) :: TKE_BBL => NULL() !< A term related to the bottom boundary layer source of turbulent kinetic @@ -218,9 +218,9 @@ module MOM_variables real, pointer, dimension(:,:) :: tbl_thick_shelf_v => NULL() !< Thickness of the viscous top boundary layer under ice shelves at v-points [Z ~> m]. real, pointer, dimension(:,:) :: kv_tbl_shelf_u => NULL() - !< Viscosity in the viscous top boundary layer under ice shelves at u-points [Z2 s-1 ~> m2 s-1]. + !< Viscosity in the viscous top boundary layer under ice shelves at u-points [Z2 T-1 ~> m2 s-1]. real, pointer, dimension(:,:) :: kv_tbl_shelf_v => NULL() - !< Viscosity in the viscous top boundary layer under ice shelves at v-points [Z2 s-1 ~> m2 s-1]. + !< Viscosity in the viscous top boundary layer under ice shelves at v-points [Z2 T-1 ~> m2 s-1]. real, pointer, dimension(:,:) :: nkml_visc_u => NULL() !< The number of layers in the viscous surface mixed layer at u-points [nondim]. !! This is not an integer because there may be fractional layers, and it is stored in diff --git a/src/parameterizations/lateral/MOM_MEKE.F90 b/src/parameterizations/lateral/MOM_MEKE.F90 index 487b4afe30..94efce7c22 100644 --- a/src/parameterizations/lateral/MOM_MEKE.F90 +++ b/src/parameterizations/lateral/MOM_MEKE.F90 @@ -216,13 +216,13 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h do j=js,je ; do I=is-1,ie drag_vel_u(I,j) = 0.0 if ((G%mask2dCu(I,j) > 0.0) .and. (visc%bbl_thick_u(I,j) > 0.0)) & - drag_vel_u(I,j) = US%Z_to_m*visc%kv_bbl_u(I,j) / visc%bbl_thick_u(I,j) + drag_vel_u(I,j) = US%Z_to_m*US%s_to_T*visc%Kv_bbl_u(I,j) / visc%bbl_thick_u(I,j) enddo ; enddo !$OMP parallel do default(shared) do J=js-1,je ; do i=is,ie drag_vel_v(i,J) = 0.0 if ((G%mask2dCv(i,J) > 0.0) .and. (visc%bbl_thick_v(i,J) > 0.0)) & - drag_vel_v(i,J) = US%Z_to_m*visc%kv_bbl_v(i,J) / visc%bbl_thick_v(i,J) + drag_vel_v(i,J) = US%Z_to_m*US%s_to_T*visc%Kv_bbl_v(i,J) / visc%bbl_thick_v(i,J) enddo ; enddo !$OMP parallel do default(shared) diff --git a/src/parameterizations/vertical/MOM_set_diffusivity.F90 b/src/parameterizations/vertical/MOM_set_diffusivity.F90 index a7cd3a534f..85b58c9b95 100644 --- a/src/parameterizations/vertical/MOM_set_diffusivity.F90 +++ b/src/parameterizations/vertical/MOM_set_diffusivity.F90 @@ -539,7 +539,7 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & if (associated(visc%kv_bbl_u) .and. associated(visc%kv_bbl_v)) then call uvchksum("BBL Kv_bbl_[uv]", visc%kv_bbl_u, visc%kv_bbl_v, & - G%HI, 0, symmetric=.true., scale=US%Z_to_m**2) + G%HI, 0, symmetric=.true., scale=US%Z2_T_to_m2_s) endif if (associated(visc%bbl_thick_u) .and. associated(visc%bbl_thick_v)) then @@ -1694,7 +1694,7 @@ subroutine set_BBL_TKE(u, v, h, fluxes, visc, G, GV, US, CS) ! vertical decay scale. do i=is,ie ; if ((G%mask2dCv(i,J) > 0.5) .and. (cdrag_sqrt*visc%bbl_thick_v(i,J) > 0.0)) then do_i(i) = .true. ; vhtot(i) = 0.0 ; htot(i) = 0.0 - vstar(i,J) = visc%kv_bbl_v(i,J) / (cdrag_sqrt*visc%bbl_thick_v(i,J)) + vstar(i,J) = US%s_to_T*visc%Kv_bbl_v(i,J) / (cdrag_sqrt*visc%bbl_thick_v(i,J)) else do_i(i) = .false. ; vstar(i,J) = 0.0 ; htot(i) = 0.0 endif ; enddo @@ -1724,7 +1724,7 @@ subroutine set_BBL_TKE(u, v, h, fluxes, visc, G, GV, US, CS) do j=js,je do I=is-1,ie ; if ((G%mask2dCu(I,j) > 0.5) .and. (cdrag_sqrt*visc%bbl_thick_u(I,j) > 0.0)) then do_i(I) = .true. ; uhtot(I) = 0.0 ; htot(I) = 0.0 - ustar(I) = visc%kv_bbl_u(I,j) / (cdrag_sqrt*visc%bbl_thick_u(I,j)) + ustar(I) = US%s_to_T*visc%Kv_bbl_u(I,j) / (cdrag_sqrt*visc%bbl_thick_u(I,j)) else do_i(I) = .false. ; ustar(I) = 0.0 ; htot(I) = 0.0 endif ; enddo diff --git a/src/parameterizations/vertical/MOM_set_viscosity.F90 b/src/parameterizations/vertical/MOM_set_viscosity.F90 index 5b9588b17c..b6de50ffa9 100644 --- a/src/parameterizations/vertical/MOM_set_viscosity.F90 +++ b/src/parameterizations/vertical/MOM_set_viscosity.F90 @@ -55,7 +55,7 @@ module MOM_set_visc !! in calculating the near-surface velocity [H ~> m or kg m-2]. real :: Htbl_shelf_min !< The minimum surface boundary layer thickness [H ~> m or kg m-2]. real :: KV_BBL_min !< The minimum viscosity in the bottom boundary layer [Z2 s-1 ~> m2 s-1]. - real :: KV_TBL_min !< The minimum viscosity in the top boundary layer [Z2 s-1 ~> m2 s-1]. + real :: KV_TBL_min !< The minimum viscosity in the top boundary layer [Z2 T-1 ~> m2 s-1]. logical :: bottomdraglaw !< If true, the bottom stress is calculated with a !! drag law c_drag*|u|*u. The velocity magnitude !! may be an assumed value or it may be based on the @@ -72,9 +72,9 @@ module MOM_set_visc !! determine the mixed layer thickness for viscosity. real :: bulk_Ri_ML !< The bulk mixed layer used to determine the !! thickness of the viscous mixed layer. Nondim. - real :: omega !< The Earth's rotation rate [s-1]. + real :: omega !< The Earth's rotation rate [T-1]. real :: ustar_min !< A minimum value of ustar to avoid numerical - !! problems [Z s-1 ~> m s-1]. If the value is small enough, + !! problems [Z T-1 ~> m s-1]. If the value is small enough, !! this should not affect the solution. real :: TKE_decay !< The ratio of the natural Ekman depth to the TKE !! decay scale, nondimensional. @@ -129,7 +129,7 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, symmetrize) ! Local variables real, dimension(SZIB_(G)) :: & - ustar, & ! The bottom friction velocity [Z s-1 ~> m s-1]. + ustar, & ! The bottom friction velocity [Z T-1 ~> m s-1]. T_EOS, & ! The temperature used to calculate the partial derivatives ! of density with T and S [degC]. S_EOS, & ! The salinity used to calculate the partial derivatives @@ -521,9 +521,9 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, symmetrize) enddo ! end of k loop if (.not.CS%linear_drag .and. (hwtot > 0.0)) then - ustar(i) = cdrag_sqrt_Z*hutot/hwtot + ustar(i) = cdrag_sqrt_Z*US%T_to_s*hutot/hwtot else - ustar(i) = cdrag_sqrt_Z*CS%drag_bg_vel + ustar(i) = cdrag_sqrt_Z*US%T_to_s*CS%drag_bg_vel endif if (use_BBL_EOS) then ; if (hwtot > 0.0) then @@ -533,7 +533,7 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, symmetrize) endif ; endif endif ; enddo else - do i=is,ie ; ustar(i) = cdrag_sqrt_Z*CS%drag_bg_vel ; enddo + do i=is,ie ; ustar(i) = cdrag_sqrt_Z*US%T_to_s*CS%drag_bg_vel ; enddo endif ! Not linear_drag if (use_BBL_EOS) then @@ -551,7 +551,7 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, symmetrize) do i=is,ie ; if (do_i(i)) then ! The 400.0 in this expression is the square of a constant proposed ! by Killworth and Edwards, 1999, in equation (2.20). - ustarsq = Rho0x400_G * ustar(i)**2 + ustarsq = Rho0x400_G * US%s_to_T**2 * ustar(i)**2 htot = 0.0 ! This block of code calculates the thickness of a stratification @@ -635,7 +635,7 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, symmetrize) if (CS%cdrag * U_bg_sq <= 0.0) then ! This avoids NaNs and overflows, and could be used in all cases, ! but is not bitwise identical to the current code. - ustH = ustar(i)*GV%Z_to_H ; root = sqrt(0.25*ustH**2 + (htot*C2f)**2) + ustH = US%s_to_T*ustar(i)*GV%Z_to_H ; root = sqrt(0.25*ustH**2 + (htot*C2f)**2) if (htot*ustH <= (CS%BBL_thick_min+h_neglect) * (0.5*ustH + root)) then bbl_thick = CS%BBL_thick_min else @@ -643,7 +643,7 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, symmetrize) endif else bbl_thick = htot / (0.5 + sqrt(0.25 + htot*htot*C2f*C2f/ & - ((ustar(i)*ustar(i)) * (GV%Z_to_H**2) ))) + ((US%s_to_T**2*ustar(i)*ustar(i)) * (GV%Z_to_H**2) ))) if (bbl_thick < CS%BBL_thick_min) bbl_thick = CS%BBL_thick_min endif @@ -859,11 +859,11 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, symmetrize) bbl_thick_Z = bbl_thick * GV%H_to_Z if (m==1) then - visc%kv_bbl_u(I,j) = max(CS%KV_BBL_min, & + visc%Kv_bbl_u(I,j) = max(CS%Kv_BBL_min, & cdrag_sqrt*ustar(i)*bbl_thick_Z*BBL_visc_frac) visc%bbl_thick_u(I,j) = bbl_thick_Z else - visc%kv_bbl_v(i,J) = max(CS%KV_BBL_min, & + visc%Kv_bbl_v(i,J) = max(CS%Kv_BBL_min, & cdrag_sqrt*ustar(i)*bbl_thick_Z*BBL_visc_frac) visc%bbl_thick_v(i,J) = bbl_thick_Z endif @@ -873,10 +873,10 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, symmetrize) ! the correct stress when the shear occurs over bbl_thick. bbl_thick_Z = bbl_thick * GV%H_to_Z if (m==1) then - visc%kv_bbl_u(I,j) = max(CS%KV_BBL_min, cdrag_sqrt*ustar(i)*bbl_thick_Z) + visc%Kv_bbl_u(I,j) = max(CS%Kv_BBL_min, cdrag_sqrt*ustar(i)*bbl_thick_Z) visc%bbl_thick_u(I,j) = bbl_thick_Z else - visc%kv_bbl_v(i,J) = max(CS%KV_BBL_min, cdrag_sqrt*ustar(i)*bbl_thick_Z) + visc%Kv_bbl_v(i,J) = max(CS%Kv_BBL_min, cdrag_sqrt*ustar(i)*bbl_thick_Z) visc%bbl_thick_v(i,J) = bbl_thick_Z endif endif @@ -901,7 +901,7 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, symmetrize) if (associated(visc%Ray_u) .and. associated(visc%Ray_v)) & call uvchksum("Ray [uv]", visc%Ray_u, visc%Ray_v, G%HI, haloshift=0, scale=US%Z_to_m) if (associated(visc%kv_bbl_u) .and. associated(visc%kv_bbl_v)) & - call uvchksum("kv_bbl_[uv]", visc%kv_bbl_u, visc%kv_bbl_v, G%HI, haloshift=0, scale=US%Z_to_m**2) + call uvchksum("kv_bbl_[uv]", visc%kv_bbl_u, visc%kv_bbl_v, G%HI, haloshift=0, scale=US%Z2_T_to_m2_s) if (associated(visc%bbl_thick_u) .and. associated(visc%bbl_thick_v)) & call uvchksum("bbl_thick_[uv]", visc%bbl_thick_u, & visc%bbl_thick_v, G%HI, haloshift=0, scale=US%Z_to_m) @@ -1040,7 +1040,7 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS, symmetri ! (roughly the base of the mixed layer) with temperature [kg m-3 degC-1]. dR_dS, & ! Partial derivative of the density at the base of layer nkml ! (roughly the base of the mixed layer) with salinity [kg m-3 ppt-1]. - ustar, & ! The surface friction velocity under ice shelves [Z s-1 ~> m s-1]. + ustar, & ! The surface friction velocity under ice shelves [Z T-1 ~> m s-1]. press, & ! The pressure at which dR_dT and dR_dS are evaluated [Pa]. T_EOS, & ! The potential temperature at which dR_dT and dR_dS are evaluated [degC] S_EOS ! The salinity at which dR_dT and dR_dS are evaluated [ppt]. @@ -1206,12 +1206,12 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS, symmetri vhtot(I) = 0.25 * dt_Rho0 * ((forces%tauy(i,J) + forces%tauy(i+1,J-1)) + & (forces%tauy(i,J-1) + forces%tauy(i+1,J))) - if (CS%omega_frac >= 1.0) then ; absf = 2.0*CS%omega ; else + if (CS%omega_frac >= 1.0) then ; absf = 2.0*US%s_to_T*CS%omega ; else absf = 0.5*US%s_to_T*(abs(G%CoriolisBu(I,J)) + abs(G%CoriolisBu(I,J-1))) if (CS%omega_frac > 0.0) & - absf = sqrt(CS%omega_frac*4.0*CS%omega**2 + (1.0-CS%omega_frac)*absf**2) + absf = sqrt(CS%omega_frac*4.0*US%s_to_T**2*CS%omega**2 + (1.0-CS%omega_frac)*absf**2) endif - U_star = max(CS%ustar_min, 0.5 * (forces%ustar(i,j) + forces%ustar(i+1,j))) + U_star = max(US%s_to_T*CS%ustar_min, 0.5 * (forces%ustar(i,j) + forces%ustar(i+1,j))) Idecay_len_TKE(I) = ((absf / U_star) * CS%TKE_decay) * GV%H_to_Z endif enddo @@ -1336,9 +1336,9 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS, symmetri enddo ; endif if ((.not.CS%linear_drag) .and. (hwtot > 0.0)) then - ustar(I) = cdrag_sqrt_Z*hutot/hwtot + ustar(I) = cdrag_sqrt_Z*US%T_to_s*hutot/hwtot else - ustar(I) = cdrag_sqrt_Z*CS%drag_bg_vel + ustar(I) = cdrag_sqrt_Z*US%T_to_s*CS%drag_bg_vel endif if (use_EOS) then ; if (hwtot > 0.0) then @@ -1356,7 +1356,7 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS, symmetri do I=Isq,Ieq ; if (do_i(I)) then ! The 400.0 in this expression is the square of a constant proposed ! by Killworth and Edwards, 1999, in equation (2.20). - ustarsq = Rho0x400_G * ustar(i)**2 + ustarsq = Rho0x400_G * US%s_to_T**2 * ustar(i)**2 htot(i) = 0.0 if (use_EOS) then Thtot(i) = 0.0 ; Shtot(i) = 0.0 @@ -1410,14 +1410,14 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS, symmetri !visc%tbl_thick_shelf_u(I,j) = GV%H_to_Z * max(CS%Htbl_shelf_min, & ! htot(I) / (0.5 + sqrt(0.25 + & - ! (htot(i)*US%s_to_T*(G%CoriolisBu(I,J-1)+G%CoriolisBu(I,J)))**2 / & + ! (htot(i)*(G%CoriolisBu(I,J-1)+G%CoriolisBu(I,J)))**2 / & ! (ustar(i)*GV%Z_to_H)**2 )) ) - ustar1 = ustar(i)*GV%Z_to_H - h2f2 = (htot(i)*US%s_to_T*(G%CoriolisBu(I,J-1)+G%CoriolisBu(I,J)) + h_neglect*CS%Omega)**2 + ustar1 = US%s_to_T*ustar(i)*GV%Z_to_H + h2f2 = (htot(i)*US%s_to_T*(G%CoriolisBu(I,J-1)+G%CoriolisBu(I,J)) + h_neglect*US%s_to_T*CS%omega)**2 tbl_thick_Z = GV%H_to_Z * max(CS%Htbl_shelf_min, & ( htot(I)*ustar1 ) / ( 0.5*ustar1 + sqrt((0.5*ustar1)**2 + h2f2 ) ) ) visc%tbl_thick_shelf_u(I,j) = tbl_thick_Z - visc%kv_tbl_shelf_u(I,j) = max(CS%KV_TBL_min, cdrag_sqrt*ustar(i)*tbl_thick_Z) + visc%Kv_tbl_shelf_u(I,j) = max(CS%Kv_TBL_min, cdrag_sqrt*ustar(i)*tbl_thick_Z) endif ; enddo ! I-loop endif ! do_any_shelf @@ -1441,13 +1441,13 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS, symmetri uhtot(i) = 0.25 * dt_Rho0 * ((forces%taux(I,j) + forces%taux(I-1,j+1)) + & (forces%taux(I-1,j) + forces%taux(I,j+1))) - if (CS%omega_frac >= 1.0) then ; absf = 2.0*CS%omega ; else + if (CS%omega_frac >= 1.0) then ; absf = 2.0*US%s_to_T*CS%omega ; else absf = 0.5*US%s_to_T*(abs(G%CoriolisBu(I-1,J)) + abs(G%CoriolisBu(I,J))) if (CS%omega_frac > 0.0) & - absf = sqrt(CS%omega_frac*4.0*CS%omega**2 + (1.0-CS%omega_frac)*absf**2) + absf = sqrt(CS%omega_frac*4.0*US%s_to_T**2*CS%omega**2 + (1.0-CS%omega_frac)*absf**2) endif - U_star = max(CS%ustar_min, 0.5 * (forces%ustar(i,j) + forces%ustar(i,j+1))) + U_star = max(US%s_to_T*CS%ustar_min, 0.5 * (forces%ustar(i,j) + forces%ustar(i,j+1))) Idecay_len_TKE(i) = ((absf / U_star) * CS%TKE_decay) * GV%H_to_Z endif @@ -1573,9 +1573,9 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS, symmetri enddo ; endif if (.not.CS%linear_drag) then ; if (hwtot > 0.0) then - ustar(i) = cdrag_sqrt_Z*hutot/hwtot + ustar(i) = cdrag_sqrt_Z*US%T_to_s*hutot/hwtot else - ustar(i) = cdrag_sqrt_Z*CS%drag_bg_vel + ustar(i) = cdrag_sqrt_Z*US%T_to_s*CS%drag_bg_vel endif ; endif if (use_EOS) then ; if (hwtot > 0.0) then @@ -1593,7 +1593,7 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS, symmetri do i=is,ie ; if (do_i(i)) then ! The 400.0 in this expression is the square of a constant proposed ! by Killworth and Edwards, 1999, in equation (2.20). - ustarsq = Rho0x400_G * ustar(i)**2 + ustarsq = Rho0x400_G * US%s_to_T**2 * ustar(i)**2 htot(i) = 0.0 if (use_EOS) then Thtot(i) = 0.0 ; Shtot(i) = 0.0 @@ -1647,14 +1647,14 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS, symmetri !visc%tbl_thick_shelf_v(i,J) = GV%H_to_Z * max(CS%Htbl_shelf_min, & ! htot(i) / (0.5 + sqrt(0.25 + & - ! (htot(i)*US%s_to_T*(G%CoriolisBu(I-1,J)+G%CoriolisBu(I,J)))**2 / & + ! (htot(i)*(G%CoriolisBu(I-1,J)+G%CoriolisBu(I,J)))**2 / & ! (ustar(i)*GV%Z_to_H)**2 )) ) - ustar1 = ustar(i)*GV%Z_to_H - h2f2 = (htot(i)*US%s_to_T*(G%CoriolisBu(I-1,J)+G%CoriolisBu(I,J)) + h_neglect*CS%Omega)**2 + ustar1 = US%s_to_T*ustar(i)*GV%Z_to_H + h2f2 = (htot(i)*US%s_to_T*(G%CoriolisBu(I-1,J)+G%CoriolisBu(I,J)) + h_neglect*US%s_to_T*CS%omega)**2 tbl_thick_Z = GV%H_to_Z * max(CS%Htbl_shelf_min, & ( htot(i)*ustar1 ) / ( 0.5*ustar1 + sqrt((0.5*ustar1)**2 + h2f2 ) ) ) visc%tbl_thick_shelf_v(i,J) = tbl_thick_Z - visc%kv_tbl_shelf_v(i,J) = max(CS%KV_TBL_min, cdrag_sqrt*ustar(i)*tbl_thick_Z) + visc%Kv_tbl_shelf_v(i,J) = max(CS%Kv_TBL_min, cdrag_sqrt*ustar(i)*tbl_thick_Z) endif ; enddo ! i-loop endif ! do_any_shelf @@ -1896,13 +1896,13 @@ subroutine set_visc_init(Time, G, GV, US, param_file, diag, visc, CS, restart_CS units="nondim", default=omega_frac_dflt) call get_param(param_file, mdl, "OMEGA", CS%omega, & "The rotation rate of the earth.", units="s-1", & - default=7.2921e-5) + default=7.2921e-5, scale=US%T_to_s) ! This give a minimum decay scale that is typically much less than Angstrom. CS%ustar_min = 2e-4*CS%omega*(GV%Angstrom_Z + GV%H_to_Z*GV%H_subroundoff) else call get_param(param_file, mdl, "OMEGA", CS%omega, & "The rotation rate of the earth.", units="s-1", & - default=7.2921e-5) + default=7.2921e-5, scale=US%T_to_s) endif call get_param(param_file, mdl, "HBBL", CS%Hbbl, & @@ -1971,10 +1971,10 @@ subroutine set_visc_init(Time, G, GV, US, param_file, diag, visc, CS, restart_CS call get_param(param_file, mdl, "KV_BBL_MIN", CS%KV_BBL_min, & "The minimum viscosities in the bottom boundary layer.", & - units="m2 s-1", default=Kv_background, scale=US%m_to_Z**2) + units="m2 s-1", default=Kv_background, scale=US%m2_s_to_Z2_T) call get_param(param_file, mdl, "KV_TBL_MIN", CS%KV_TBL_min, & "The minimum viscosities in the top boundary layer.", & - units="m2 s-1", default=Kv_background, scale=US%m_to_Z**2) + units="m2 s-1", default=Kv_background, scale=US%m2_s_to_Z2_T) if (CS%Channel_drag) then call get_param(param_file, mdl, "SMAG_LAP_CONST", smag_const1, default=-1.0) @@ -2009,11 +2009,11 @@ subroutine set_visc_init(Time, G, GV, US, param_file, diag, visc, CS, restart_CS CS%id_bbl_thick_u = register_diag_field('ocean_model', 'bbl_thick_u', & diag%axesCu1, Time, 'BBL thickness at u points', 'm', conversion=US%Z_to_m) CS%id_kv_bbl_u = register_diag_field('ocean_model', 'kv_bbl_u', diag%axesCu1, & - Time, 'BBL viscosity at u points', 'm2 s-1', conversion=US%Z_to_m**2) + Time, 'BBL viscosity at u points', 'm2 s-1', conversion=US%Z2_T_to_m2_s) CS%id_bbl_thick_v = register_diag_field('ocean_model', 'bbl_thick_v', & diag%axesCv1, Time, 'BBL thickness at v points', 'm', conversion=US%Z_to_m) CS%id_kv_bbl_v = register_diag_field('ocean_model', 'kv_bbl_v', diag%axesCv1, & - Time, 'BBL viscosity at v points', 'm2 s-1', conversion=US%Z_to_m**2) + Time, 'BBL viscosity at v points', 'm2 s-1', conversion=US%Z2_T_to_m2_s) endif if (CS%Channel_drag) then allocate(visc%Ray_u(IsdB:IedB,jsd:jed,nz)) ; visc%Ray_u = 0.0 diff --git a/src/parameterizations/vertical/MOM_vert_friction.F90 b/src/parameterizations/vertical/MOM_vert_friction.F90 index 1ebf825b92..d688d1c38d 100644 --- a/src/parameterizations/vertical/MOM_vert_friction.F90 +++ b/src/parameterizations/vertical/MOM_vert_friction.F90 @@ -676,7 +676,7 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, US, CS, OBC) do I=Isq,Ieq ; do_i(I) = (G%mask2dCu(I,j) > 0) ; enddo if (CS%bottomdraglaw) then ; do I=Isq,Ieq - kv_bbl(I) = visc%kv_bbl_u(I,j) + kv_bbl(I) = US%s_to_T*visc%Kv_bbl_u(I,j) bbl_thick(I) = visc%bbl_thick_u(I,j) * GV%Z_to_H if (do_i(I)) I_Hbbl(I) = 1.0 / (bbl_thick(I) + h_neglect) enddo ; endif @@ -843,7 +843,7 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, US, CS, OBC) do i=is,ie ; do_i(i) = (G%mask2dCv(i,J) > 0) ; enddo if (CS%bottomdraglaw) then ; do i=is,ie - kv_bbl(i) = visc%kv_bbl_v(i,J) + kv_bbl(i) = US%s_to_T*visc%Kv_bbl_v(i,J) bbl_thick(i) = visc%bbl_thick_v(i,J) * GV%Z_to_H if (do_i(i)) I_Hbbl(i) = 1.0 / bbl_thick(i) enddo ; endif @@ -1256,10 +1256,10 @@ subroutine find_coupling_coef(a_cpl, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, ! Set the coefficients to include the no-slip surface stress. do i=is,ie ; if (do_i(i)) then if (work_on_u) then - kv_tbl(i) = visc%kv_tbl_shelf_u(I,j) + kv_tbl(i) = US%s_to_T*visc%Kv_tbl_shelf_u(I,j) tbl_thick(i) = visc%tbl_thick_shelf_u(I,j) * GV%Z_to_H else - kv_tbl(i) = visc%kv_tbl_shelf_v(i,J) + kv_tbl(i) = US%s_to_T*visc%Kv_tbl_shelf_v(i,J) tbl_thick(i) = visc%tbl_thick_shelf_v(i,J) * GV%Z_to_H endif z_t(i) = 0.0 From 6f259d67ab4c8a7674030a30131727158285e97c Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 25 Jun 2019 04:10:42 -0400 Subject: [PATCH 32/82] +Added dimensional testing in MOM_set_viscosity.F90 Added rescaling of time units for dimensional consistency testing of various internal variables in MOM_set_viscosity.F90 and MOM_tidal_mixing.F90, as well as the viscosities in MOM_bkgnd_mixing.F90 and MOM_set_diffusivity.F90. All answers are bitwise identical. --- .../vertical/MOM_bkgnd_mixing.F90 | 20 +++---- .../vertical/MOM_set_diffusivity.F90 | 2 +- .../vertical/MOM_set_viscosity.F90 | 60 +++++++++---------- .../vertical/MOM_tidal_mixing.F90 | 60 +++++++++---------- 4 files changed, 71 insertions(+), 71 deletions(-) diff --git a/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 b/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 index 987557310b..641430bb02 100644 --- a/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 +++ b/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 @@ -125,7 +125,7 @@ subroutine bkgnd_mixing_init(Time, G, GV, US, param_file, diag, CS) type(bkgnd_mixing_cs), pointer :: CS !< This module's control structure. ! Local variables - real :: Kv ! The interior vertical viscosity [m2 s-1] - read to set prandtl + real :: Kv ! The interior vertical viscosity [Z2 T-1 ~> m2 s-1] - read to set prandtl ! number unless it is provided as a parameter real :: prandtl_bkgnd_comp ! Kv/CS%Kd. Gets compared with user-specified prandtl_bkgnd. @@ -151,7 +151,7 @@ subroutine bkgnd_mixing_init(Time, G, GV, US, param_file, diag, CS) call get_param(param_file, mdl, "KV", Kv, & "The background kinematic viscosity in the interior. "//& "The molecular value, ~1e-6 m2 s-1, may be used.", & - units="m2 s-1", fail_if_missing=.true.) + units="m2 s-1", scale=US%m2_s_to_Z2_T, fail_if_missing=.true.) call get_param(param_file, mdl, "KD_MIN", CS%Kd_min, & "The minimum diapycnal diffusivity.", & @@ -245,7 +245,7 @@ subroutine bkgnd_mixing_init(Time, G, GV, US, param_file, diag, CS) if (CS%Bryan_Lewis_diffusivity .or. CS%horiz_varying_background) then prandtl_bkgnd_comp = CS%prandtl_bkgnd - if (CS%Kd /= 0.0) prandtl_bkgnd_comp = Kv/(US%s_to_T*CS%Kd) + if (CS%Kd /= 0.0) prandtl_bkgnd_comp = Kv/CS%Kd if ( abs(CS%prandtl_bkgnd - prandtl_bkgnd_comp)>1.e-14) then call MOM_error(FATAL,"set_diffusivity_init: The provided KD, KV,"//& @@ -308,7 +308,7 @@ subroutine bkgnd_mixing_init(Time, G, GV, US, param_file, diag, CS) CS%id_kd_bkgnd = register_diag_field('ocean_model', 'Kd_bkgnd', diag%axesTi, Time, & 'Background diffusivity added by MOM_bkgnd_mixing module', 'm2/s', conversion=US%Z2_T_to_m2_s) CS%id_kv_bkgnd = register_diag_field('ocean_model', 'Kv_bkgnd', diag%axesTi, Time, & - 'Background viscosity added by MOM_bkgnd_mixing module', 'm2/s', conversion=US%Z_to_m**2) + 'Background viscosity added by MOM_bkgnd_mixing module', 'm2/s', conversion=US%Z2_T_to_m2_s) end subroutine bkgnd_mixing_init @@ -379,7 +379,7 @@ subroutine calculate_bkgnd_mixing(h, tv, N2_lay, Kd_lay, Kv, j, G, GV, US, CS) real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: Kd_lay !< Diapycnal diffusivity of each layer !! [Z2 T-1 ~> m2 s-1]. real, dimension(:,:,:), pointer :: Kv !< The "slow" vertical viscosity at each interface - !! (not layer!) [Z2 s-1 ~> m2 s-1] + !! (not layer!) [Z2 T-1 ~> m2 s-1] integer, intent(in) :: j !< Meridional grid index type(bkgnd_mixing_cs), pointer :: CS !< The control structure returned by !! a previous call to bkgnd_mixing_init. @@ -430,7 +430,7 @@ subroutine calculate_bkgnd_mixing(h, tv, N2_lay, Kd_lay, Kv, j, G, GV, US, CS) ! Update Kd and Kv. do K=1,nz+1 - CS%Kv_bkgnd(i,j,K) = US%m_to_Z**2*Kv_col(K) + CS%Kv_bkgnd(i,j,K) = US%m2_s_to_Z2_T*Kv_col(K) CS%Kd_bkgnd(i,j,K) = US%m2_s_to_Z2_T*Kd_col(K) enddo do k=1,nz @@ -492,7 +492,7 @@ subroutine calculate_bkgnd_mixing(h, tv, N2_lay, Kd_lay, Kv, j, G, GV, US, CS) endif ! Compute kv_bkgnd - CS%kv_bkgnd(i,j,:) = US%s_to_T*CS%Kd_bkgnd(i,j,:) * CS%prandtl_bkgnd + CS%kv_bkgnd(i,j,:) = CS%Kd_bkgnd(i,j,:) * CS%prandtl_bkgnd ! Update Kd (uniform profile; no interpolation needed) Kd_lay(i,j,:) = CS%Kd_bkgnd(i,j,1) @@ -502,8 +502,8 @@ subroutine calculate_bkgnd_mixing(h, tv, N2_lay, Kd_lay, Kv, j, G, GV, US, CS) elseif (CS%Henyey_IGW_background_new) then I_x30 = 2.0 / invcosh(CS%N0_2Omega*2.0) ! This is evaluated at 30 deg. do k=1,nz ; do i=is,ie - abs_sin = max(epsilon,abs(sin(G%geoLatT(i,j)*deg_to_rad))) - N_2Omega = max(abs_sin,sqrt(US%s_to_T**2 * N2_lay(i,k))*I_2Omega) + abs_sin = max(epsilon, abs(sin(G%geoLatT(i,j)*deg_to_rad))) + N_2Omega = max(abs_sin, sqrt(US%s_to_T**2 * N2_lay(i,k))*I_2Omega) N02_N2 = (CS%N0_2Omega/N_2Omega)**2 Kd_lay(i,j,k) = max(CS%Kd_min, CS%Kd_sfc(i,j) * & ((abs_sin * invcosh(N_2Omega/abs_sin)) * I_x30)*N02_N2) @@ -522,7 +522,7 @@ subroutine calculate_bkgnd_mixing(h, tv, N2_lay, Kd_lay, Kv, j, G, GV, US, CS) CS%kd_bkgnd(i,j,nz+1) = 0.0; CS%kv_bkgnd(i,j,nz+1) = 0.0 do k=2,nz CS%Kd_bkgnd(i,j,k) = 0.5*(Kd_lay(i,j,K-1) + Kd_lay(i,j,K)) - CS%Kv_bkgnd(i,j,k) = US%s_to_T*CS%Kd_bkgnd(i,j,k) * CS%prandtl_bkgnd + CS%Kv_bkgnd(i,j,k) = CS%Kd_bkgnd(i,j,k) * CS%prandtl_bkgnd enddo enddo endif diff --git a/src/parameterizations/vertical/MOM_set_diffusivity.F90 b/src/parameterizations/vertical/MOM_set_diffusivity.F90 index 85b58c9b95..3da2a58a97 100644 --- a/src/parameterizations/vertical/MOM_set_diffusivity.F90 +++ b/src/parameterizations/vertical/MOM_set_diffusivity.F90 @@ -295,7 +295,7 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & ! If nothing else is specified, this will be the value used. Kd_lay(:,:,:) = CS%Kd Kd_int(:,:,:) = CS%Kd - if (associated(visc%Kv_slow)) visc%Kv_slow(:,:,:) = US%s_to_T * CS%Kv + if (associated(visc%Kv_slow)) visc%Kv_slow(:,:,:) = CS%Kv ! Set up arrays for diagnostics. diff --git a/src/parameterizations/vertical/MOM_set_viscosity.F90 b/src/parameterizations/vertical/MOM_set_viscosity.F90 index b6de50ffa9..8af4bcb90c 100644 --- a/src/parameterizations/vertical/MOM_set_viscosity.F90 +++ b/src/parameterizations/vertical/MOM_set_viscosity.F90 @@ -182,7 +182,7 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, symmetrize) ! the present layer [H ~> m or kg m-2]. real :: bbl_thick ! The thickness of the bottom boundary layer [H ~> m or kg m-2]. real :: bbl_thick_Z ! The thickness of the bottom boundary layer [Z ~> m]. - real :: C2f ! C2f = 2*f at velocity points. + real :: C2f ! C2f = 2*f at velocity points [T-1 ~> s-1]. real :: U_bg_sq ! The square of an assumed background ! velocity, for calculating the mean @@ -198,7 +198,7 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, symmetrize) ! of the bottom [H ~> m or kg m-2]. real :: v_at_u, u_at_v ! v at a u point or vice versa [m s-1]. real :: Rho0x400_G ! 400*Rho0/G_Earth, times unit conversion factors - ! [kg s2 H m-3 Z-2 ~> kg s2 m-4 or kg2 s2 m-7]. + ! [kg T2 H m-3 Z-2 ~> kg s2 m-4 or kg2 s2 m-7]. ! The 400 is a constant proposed by Killworth and Edwards, 1999. real, dimension(SZI_(G),SZJ_(G),max(GV%nk_rho_varies,1)) :: & Rml ! The mixed layer coordinate density [kg m-3]. @@ -243,8 +243,8 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, symmetrize) ! evaluated at L=L0 [H ~> m or kg m-2]. real :: h_neglect ! A thickness that is so small it is usually lost ! in roundoff and can be neglected [H ~> m or kg m-2]. - real :: ustH ! ustar converted to units of H s-1 [H s-1 ~> m s-1 or kg m-2 s-1]. - real :: root ! A temporary variable [H s-1 ~> m s-1 or kg m-2 s-1]. + real :: ustH ! ustar converted to units of H T-1 [H T-1 ~> m s-1 or kg m-2 s-1]. + real :: root ! A temporary variable [H T-1 ~> m s-1 or kg m-2 s-1]. real :: Cell_width ! The transverse width of the velocity cell [m]. real :: Rayleigh ! A nondimensional value that is multiplied by the layer's @@ -269,7 +269,7 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, symmetrize) Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB nkmb = GV%nk_rho_varies ; nkml = GV%nkml h_neglect = GV%H_subroundoff - Rho0x400_G = 400.0*(GV%Rho0/GV%g_Earth) * US%Z_to_m**2 * GV%Z_to_H + Rho0x400_G = 400.0*(GV%Rho0/GV%g_Earth) * US%s_to_T**2*US%Z_to_m**2 * GV%Z_to_H Vol_quit = 0.9*GV%Angstrom_H + h_neglect C2pi_3 = 8.0*atan(1.0)/3.0 @@ -551,7 +551,7 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, symmetrize) do i=is,ie ; if (do_i(i)) then ! The 400.0 in this expression is the square of a constant proposed ! by Killworth and Edwards, 1999, in equation (2.20). - ustarsq = Rho0x400_G * US%s_to_T**2 * ustar(i)**2 + ustarsq = Rho0x400_G * ustar(i)**2 htot = 0.0 ! This block of code calculates the thickness of a stratification @@ -629,13 +629,13 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, symmetrize) ! The bottom boundary layer thickness is found by solving the same ! equation as in Killworth and Edwards: (h/h_f)^2 + h/h_N = 1. - if (m==1) then ; C2f = US%s_to_T*(G%CoriolisBu(I,J-1)+G%CoriolisBu(I,J)) - else ; C2f = US%s_to_T*(G%CoriolisBu(I-1,J)+G%CoriolisBu(I,J)) ; endif + if (m==1) then ; C2f = G%CoriolisBu(I,J-1) + G%CoriolisBu(I,J) + else ; C2f = G%CoriolisBu(I-1,J) + G%CoriolisBu(I,J) ; endif if (CS%cdrag * U_bg_sq <= 0.0) then ! This avoids NaNs and overflows, and could be used in all cases, ! but is not bitwise identical to the current code. - ustH = US%s_to_T*ustar(i)*GV%Z_to_H ; root = sqrt(0.25*ustH**2 + (htot*C2f)**2) + ustH = ustar(i)*GV%Z_to_H ; root = sqrt(0.25*ustH**2 + (htot*C2f)**2) if (htot*ustH <= (CS%BBL_thick_min+h_neglect) * (0.5*ustH + root)) then bbl_thick = CS%BBL_thick_min else @@ -643,7 +643,7 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, symmetrize) endif else bbl_thick = htot / (0.5 + sqrt(0.25 + htot*htot*C2f*C2f/ & - ((US%s_to_T**2*ustar(i)*ustar(i)) * (GV%Z_to_H**2) ))) + ((ustar(i)*ustar(i)) * (GV%Z_to_H**2)) ) ) if (bbl_thick < CS%BBL_thick_min) bbl_thick = CS%BBL_thick_min endif @@ -1105,15 +1105,15 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS, symmetri ! the quadratic surface drag [m2 s-2]. real :: h_tiny ! A very small thickness [H ~> m or kg m-2]. Layers that are less than ! h_tiny can not be the deepest in the viscous mixed layer. - real :: absf ! The absolute value of f averaged to velocity points, s-1. - real :: U_star ! The friction velocity at velocity points [Z s-1 ~> m s-1]. + real :: absf ! The absolute value of f averaged to velocity points [T-1 ~> s-1]. + real :: U_star ! The friction velocity at velocity points [Z T-1 ~> m s-1]. real :: h_neglect ! A thickness that is so small it is usually lost ! in roundoff and can be neglected [H ~> m or kg m-2]. real :: Rho0x400_G ! 400*Rho0/G_Earth, times unit conversion factors - ! [kg s2 H m-3 Z-2 ~> kg s2 m-4 or kg2 s2 m-7]. + ! [kg T2 H m-3 Z-2 ~> kg s2 m-4 or kg2 s2 m-7]. ! The 400 is a constant proposed by Killworth and Edwards, 1999. - real :: ustar1 ! ustar [H s-1 ~> m s-1 or kg m-2 s-1] - real :: h2f2 ! (h*2*f)^2 [H2 s-2 ~> m2 s-2 or kg2 m-4 s-2] + real :: ustar1 ! ustar [H T-1 ~> m s-1 or kg m-2 s-1] + real :: h2f2 ! (h*2*f)^2 [H2 T-2 ~> m2 s-2 or kg2 m-4 s-2] logical :: use_EOS, do_any, do_any_shelf, do_i(SZIB_(G)) integer :: i, j, k, is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz, K2, nkmb, nkml, n type(ocean_OBC_type), pointer :: OBC => NULL() @@ -1131,7 +1131,7 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS, symmetri Jsq = js-1 ; Isq = is-1 endif ; endif - Rho0x400_G = 400.0*(GV%Rho0/GV%g_Earth) * US%Z_to_m**2 * GV%Z_to_H + Rho0x400_G = 400.0*(GV%Rho0/GV%g_Earth) * US%s_to_T**2*US%Z_to_m**2 * GV%Z_to_H U_bg_sq = CS%drag_bg_vel * CS%drag_bg_vel cdrag_sqrt = sqrt(CS%cdrag) cdrag_sqrt_Z = US%m_to_Z * sqrt(CS%cdrag) @@ -1206,12 +1206,12 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS, symmetri vhtot(I) = 0.25 * dt_Rho0 * ((forces%tauy(i,J) + forces%tauy(i+1,J-1)) + & (forces%tauy(i,J-1) + forces%tauy(i+1,J))) - if (CS%omega_frac >= 1.0) then ; absf = 2.0*US%s_to_T*CS%omega ; else - absf = 0.5*US%s_to_T*(abs(G%CoriolisBu(I,J)) + abs(G%CoriolisBu(I,J-1))) + if (CS%omega_frac >= 1.0) then ; absf = 2.0*CS%omega ; else + absf = 0.5*(abs(G%CoriolisBu(I,J)) + abs(G%CoriolisBu(I,J-1))) if (CS%omega_frac > 0.0) & - absf = sqrt(CS%omega_frac*4.0*US%s_to_T**2*CS%omega**2 + (1.0-CS%omega_frac)*absf**2) + absf = sqrt(CS%omega_frac*4.0*CS%omega**2 + (1.0-CS%omega_frac)*absf**2) endif - U_star = max(US%s_to_T*CS%ustar_min, 0.5 * (forces%ustar(i,j) + forces%ustar(i+1,j))) + U_star = max(CS%ustar_min, 0.5 * US%T_to_s*(forces%ustar(i,j) + forces%ustar(i+1,j))) Idecay_len_TKE(I) = ((absf / U_star) * CS%TKE_decay) * GV%H_to_Z endif enddo @@ -1356,7 +1356,7 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS, symmetri do I=Isq,Ieq ; if (do_i(I)) then ! The 400.0 in this expression is the square of a constant proposed ! by Killworth and Edwards, 1999, in equation (2.20). - ustarsq = Rho0x400_G * US%s_to_T**2 * ustar(i)**2 + ustarsq = Rho0x400_G * ustar(i)**2 htot(i) = 0.0 if (use_EOS) then Thtot(i) = 0.0 ; Shtot(i) = 0.0 @@ -1412,8 +1412,8 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS, symmetri ! htot(I) / (0.5 + sqrt(0.25 + & ! (htot(i)*(G%CoriolisBu(I,J-1)+G%CoriolisBu(I,J)))**2 / & ! (ustar(i)*GV%Z_to_H)**2 )) ) - ustar1 = US%s_to_T*ustar(i)*GV%Z_to_H - h2f2 = (htot(i)*US%s_to_T*(G%CoriolisBu(I,J-1)+G%CoriolisBu(I,J)) + h_neglect*US%s_to_T*CS%omega)**2 + ustar1 = ustar(i)*GV%Z_to_H + h2f2 = (htot(i)*(G%CoriolisBu(I,J-1)+G%CoriolisBu(I,J)) + h_neglect*CS%omega)**2 tbl_thick_Z = GV%H_to_Z * max(CS%Htbl_shelf_min, & ( htot(I)*ustar1 ) / ( 0.5*ustar1 + sqrt((0.5*ustar1)**2 + h2f2 ) ) ) visc%tbl_thick_shelf_u(I,j) = tbl_thick_Z @@ -1441,13 +1441,13 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS, symmetri uhtot(i) = 0.25 * dt_Rho0 * ((forces%taux(I,j) + forces%taux(I-1,j+1)) + & (forces%taux(I-1,j) + forces%taux(I,j+1))) - if (CS%omega_frac >= 1.0) then ; absf = 2.0*US%s_to_T*CS%omega ; else - absf = 0.5*US%s_to_T*(abs(G%CoriolisBu(I-1,J)) + abs(G%CoriolisBu(I,J))) + if (CS%omega_frac >= 1.0) then ; absf = 2.0*CS%omega ; else + absf = 0.5*(abs(G%CoriolisBu(I-1,J)) + abs(G%CoriolisBu(I,J))) if (CS%omega_frac > 0.0) & - absf = sqrt(CS%omega_frac*4.0*US%s_to_T**2*CS%omega**2 + (1.0-CS%omega_frac)*absf**2) + absf = sqrt(CS%omega_frac*4.0*CS%omega**2 + (1.0-CS%omega_frac)*absf**2) endif - U_star = max(US%s_to_T*CS%ustar_min, 0.5 * (forces%ustar(i,j) + forces%ustar(i,j+1))) + U_star = max(CS%ustar_min, 0.5 * US%T_to_s*(forces%ustar(i,j) + forces%ustar(i,j+1))) Idecay_len_TKE(i) = ((absf / U_star) * CS%TKE_decay) * GV%H_to_Z endif @@ -1593,7 +1593,7 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS, symmetri do i=is,ie ; if (do_i(i)) then ! The 400.0 in this expression is the square of a constant proposed ! by Killworth and Edwards, 1999, in equation (2.20). - ustarsq = Rho0x400_G * US%s_to_T**2 * ustar(i)**2 + ustarsq = Rho0x400_G * ustar(i)**2 htot(i) = 0.0 if (use_EOS) then Thtot(i) = 0.0 ; Shtot(i) = 0.0 @@ -1649,8 +1649,8 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS, symmetri ! htot(i) / (0.5 + sqrt(0.25 + & ! (htot(i)*(G%CoriolisBu(I-1,J)+G%CoriolisBu(I,J)))**2 / & ! (ustar(i)*GV%Z_to_H)**2 )) ) - ustar1 = US%s_to_T*ustar(i)*GV%Z_to_H - h2f2 = (htot(i)*US%s_to_T*(G%CoriolisBu(I-1,J)+G%CoriolisBu(I,J)) + h_neglect*US%s_to_T*CS%omega)**2 + ustar1 = ustar(i)*GV%Z_to_H + h2f2 = (htot(i)*(G%CoriolisBu(I-1,J)+G%CoriolisBu(I,J)) + h_neglect*CS%omega)**2 tbl_thick_Z = GV%H_to_Z * max(CS%Htbl_shelf_min, & ( htot(i)*ustar1 ) / ( 0.5*ustar1 + sqrt((0.5*ustar1)**2 + h2f2 ) ) ) visc%tbl_thick_shelf_v(i,J) = tbl_thick_Z diff --git a/src/parameterizations/vertical/MOM_tidal_mixing.F90 b/src/parameterizations/vertical/MOM_tidal_mixing.F90 index 3078653694..1d07e0095d 100644 --- a/src/parameterizations/vertical/MOM_tidal_mixing.F90 +++ b/src/parameterizations/vertical/MOM_tidal_mixing.F90 @@ -59,8 +59,8 @@ module MOM_tidal_mixing !! dissipation due to propagating low modes [Z3 T-3 ~> m3 s-3] real, pointer, dimension(:,:) :: & TKE_itidal_used => NULL(),& !< internal tide TKE input at ocean bottom [kg Z3 m-3 T-3 ~> W m-2] - N2_bot => NULL(),& !< bottom squared buoyancy frequency [s-2] - N2_meanz => NULL(),& !< vertically averaged buoyancy frequency [s-2] + N2_bot => NULL(),& !< bottom squared buoyancy frequency [T-2 ~> s-2] + N2_meanz => NULL(),& !< vertically averaged buoyancy frequency [T-2 ~> s-2] Polzin_decay_scale_scaled => NULL(),& !< vertical scale of decay for tidal dissipation Polzin_decay_scale => NULL(),& !< vertical decay scale for tidal diss with Polzin [m] Simmons_coeff_2d => NULL() !< The Simmons et al mixing coefficient @@ -112,7 +112,7 @@ module MOM_tidal_mixing real :: Nbotref_Polzin !< Reference value for the buoyancy frequency at the !! ocean bottom used in Polzin formulation of the - !! vertical scale of decay of tidal dissipation [s-1] + !! vertical scale of decay of tidal dissipation [T-1 ~> s-1] real :: Polzin_decay_scale_factor !< Scaling factor for the decay length scale !! of the tidal dissipation profile in Polzin [nondim] real :: Polzin_decay_scale_max_factor !< The decay length scale of tidal dissipation @@ -148,7 +148,7 @@ module MOM_tidal_mixing !! [kg Z3 m-3 T-3 ~> W m-2] real, pointer, dimension(:,:) :: TKE_itidal => NULL() !< The internal Turbulent Kinetic Energy input divided !! by the bottom stratfication [kg Z3 m-3 T-2 ~> J m-2]. - real, pointer, dimension(:,:) :: Nb => NULL() !< The near bottom buoyancy frequency [s-1]. + real, pointer, dimension(:,:) :: Nb => NULL() !< The near bottom buoyancy frequency [T-1 ~> s-1]. real, pointer, dimension(:,:) :: mask_itidal => NULL() !< A mask of where internal tide energy is input real, pointer, dimension(:,:) :: h2 => NULL() !< Squared bottom depth variance [m2]. real, pointer, dimension(:,:) :: tideamp => NULL() !< RMS tidal amplitude [m s-1] @@ -359,7 +359,7 @@ logical function tidal_mixing_init(Time, G, GV, US, param_file, diag, CS) "reference value of the buoyancy frequency at the ocean "//& "bottom in the Polzin formulation for the vertical "//& "scale of decay for the tidal energy dissipation.", & - units="s-1", default=9.61e-4) + units="s-1", default=9.61e-4, scale=US%T_to_s) call get_param(param_file, mdl, "POLZIN_DECAY_SCALE_FACTOR", & CS%Polzin_decay_scale_factor, & "When the Polzin decay profile is used, this is a "//& @@ -576,7 +576,7 @@ logical function tidal_mixing_init(Time, G, GV, US, param_file, diag, CS) CS%id_TKE_itidal = register_diag_field('ocean_model','TKE_itidal',diag%axesT1,Time, & 'Internal Tide Driven Turbulent Kinetic Energy', 'W m-2', conversion=(US%Z_to_m**3*US%s_to_T**3)) CS%id_Nb = register_diag_field('ocean_model','Nb',diag%axesT1,Time, & - 'Bottom Buoyancy Frequency', 's-1') + 'Bottom Buoyancy Frequency', 's-1', conversion=US%s_to_T) CS%id_Kd_lowmode = register_diag_field('ocean_model','Kd_lowmode',diag%axesTi,Time, & 'Internal Tide Driven Diffusivity (from propagating low modes)', & @@ -600,10 +600,10 @@ logical function tidal_mixing_init(Time, G, GV, US, param_file, diag, CS) 'scaled by N2_bot/N2_meanz', 'm', conversion=US%Z_to_m) CS%id_N2_bot = register_diag_field('ocean_model','N2_b',diag%axesT1,Time, & - 'Bottom Buoyancy frequency squared', 's-2') + 'Bottom Buoyancy frequency squared', 's-2', conversion=US%s_to_T**2) - CS%id_N2_meanz = register_diag_field('ocean_model','N2_meanz',diag%axesT1,Time, & - 'Buoyancy frequency squared averaged over the water column', 's-2') + CS%id_N2_meanz = register_diag_field('ocean_model','N2_meanz', diag%axesT1, Time, & + 'Buoyancy frequency squared averaged over the water column', 's-2', conversion=US%s_to_T**2) CS%id_Kd_Itidal_Work = register_diag_field('ocean_model','Kd_Itidal_Work',diag%axesTL,Time, & 'Work done by Internal Tide Diapycnal Mixing', 'W m-2', conversion=(US%Z_to_m**3*US%s_to_T**3)) @@ -662,7 +662,7 @@ subroutine calculate_tidal_mixing(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, US, C !! [Z2 T-1 ~> m2 s-1]. !! Set this to a negative value to have no limit. real, dimension(:,:,:), pointer :: Kv !< The "slow" vertical viscosity at each interface - !! (not layer!) [Z2 s-1 ~> m2 s-1]. + !! (not layer!) [Z2 T-1 ~> m2 s-1]. if (CS%Int_tide_dissipation .or. CS%Lee_wave_dissipation .or. CS%Lowmode_itidal_dissipation) then if (CS%use_CVMix_tidal) then @@ -690,10 +690,10 @@ subroutine calculate_CVMix_tidal(h, j, G, GV, US, CS, N2_int, Kd_lay, Kv) real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(inout) :: Kd_lay!< The diapycnal diffusivities in the layers [Z2 T-1 ~> m2 s-1]. real, dimension(:,:,:), pointer :: Kv !< The "slow" vertical viscosity at each interface - !! (not layer!) [Z2 s-1 ~> m2 s-1]. + !! (not layer!) [Z2 T-1 ~> m2 s-1]. ! Local variables - real, dimension(SZK_(G)+1) :: Kd_tidal ! tidal diffusivity [m2/s] - real, dimension(SZK_(G)+1) :: Kv_tidal ! tidal viscosity [m2/s] + real, dimension(SZK_(G)+1) :: Kd_tidal ! tidal diffusivity [m2 s-1] + real, dimension(SZK_(G)+1) :: Kv_tidal ! tidal viscosity [m2 s-1] real, dimension(SZK_(G)+1) :: vert_dep ! vertical deposition real, dimension(SZK_(G)+1) :: iFaceHeight ! Height of interfaces [m] real, dimension(SZK_(G)+1) :: SchmittnerSocn @@ -772,7 +772,7 @@ subroutine calculate_CVMix_tidal(h, j, G, GV, US, CS, N2_int, Kd_lay, Kv) ! Update viscosity with the proper unit conversion. if (associated(Kv)) then do k=1,G%ke+1 - Kv(i,j,k) = Kv(i,j,k) + US%m_to_Z**2 * Kv_tidal(k) ! Rescale from m2 s-1 to Z2 s-1. + Kv(i,j,k) = Kv(i,j,k) + US%m2_s_to_Z2_T * Kv_tidal(k) ! Rescale from m2 s-1 to Z2 T-1. enddo endif @@ -874,7 +874,7 @@ subroutine calculate_CVMix_tidal(h, j, G, GV, US, CS, N2_int, Kd_lay, Kv) ! Update viscosity if (associated(Kv)) then do k=1,G%ke+1 - Kv(i,j,k) = Kv(i,j,k) + US%m_to_Z**2 * Kv_tidal(k) ! Rescale from m2 s-1 to Z2 s-1. + Kv(i,j,k) = Kv(i,j,k) + US%m2_s_to_Z2_T * Kv_tidal(k) ! Rescale from m2 s-1 to Z2 T-1. enddo endif @@ -959,7 +959,7 @@ subroutine add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, US, ! multiplied by N2_bot/N2_meanz to be coherent with the WKB scaled z ! z*=int(N2/N2_bot) * N2_bot/N2_meanz = int(N2/N2_meanz) ! z0_Polzin_scaled = z0_Polzin * N2_bot/N2_meanz - N2_meanz, & ! vertically averaged squared buoyancy frequency [s-2] for WKB scaling + N2_meanz, & ! vertically averaged squared buoyancy frequency [T-2] for WKB scaling TKE_itidal_rem, & ! remaining internal tide TKE (from barotropic source) [Z3 T-3 ~> m3 s-3] TKE_Niku_rem, & ! remaining lee-wave TKE [Z3 T-3 ~> m3 s-3] TKE_lowmode_rem, & ! remaining internal tide TKE (from propagating low mode source) [Z3 T-3 ~> m3 s-3] (BDM) @@ -1013,8 +1013,8 @@ subroutine add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, US, Izeta_lee = 1.0 / max(CS%Int_tide_decay_scale*CS%Decay_scale_factor_lee, & GV%H_subroundoff*GV%H_to_Z) do i=is,ie - CS%Nb(i,j) = sqrt(US%s_to_T**2 * N2_bot(i)) - if (associated(dd%N2_bot)) dd%N2_bot(i,j) = US%s_to_T**2 * N2_bot(i) + CS%Nb(i,j) = sqrt(N2_bot(i)) + if (associated(dd%N2_bot)) dd%N2_bot(i,j) = N2_bot(i) if ( CS%Int_tide_dissipation ) then if (Izeta*htot(i) > 1.0e-14) then ! L'Hospital's version of Adcroft's reciprocal rule. Inv_int(i) = 1.0 / (1.0 - exp(-Izeta*htot(i))) @@ -1037,9 +1037,9 @@ subroutine add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, US, ! Polzin: if ( use_Polzin ) then ! WKB scaling of the vertical coordinate - do i=is,ie ; N2_meanz(i)=0.0 ; enddo + do i=is,ie ; N2_meanz(i) = 0.0 ; enddo do k=1,nz ; do i=is,ie - N2_meanz(i) = N2_meanz(i) + (US%s_to_T**2 * N2_lay(i,k)) * GV%H_to_Z * h(i,j,k) + N2_meanz(i) = N2_meanz(i) + N2_lay(i,k) * GV%H_to_Z * h(i,j,k) enddo ; enddo do i=is,ie N2_meanz(i) = N2_meanz(i) / (htot(i) + GV%H_subroundoff*GV%H_to_Z) @@ -1050,21 +1050,21 @@ subroutine add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, US, do i=is,ie ; htot_WKB(i) = htot(i) ; enddo ! do i=is,ie ; htot_WKB(i) = 0.0 ; enddo ! do k=1,nz ; do i=is,ie -! htot_WKB(i) = htot_WKB(i) + GV%H_to_Z*h(i,j,k) * (US%s_to_T**2 * N2_lay(i,k)) / N2_meanz(i) +! htot_WKB(i) = htot_WKB(i) + GV%H_to_Z*h(i,j,k) * N2_lay(i,k) / N2_meanz(i) ! enddo ; enddo ! htot_WKB(i) = htot(i) ! Nearly equivalent and simpler do i=is,ie - CS%Nb(i,j) = sqrt(US%s_to_T**2 * N2_bot(i)) + CS%Nb(i,j) = sqrt(N2_bot(i)) !### In the code below 1.0e-14 is a dimensional constant in [s-3] if ((CS%tideamp(i,j) > 0.0) .and. & - (CS%kappa_itides**2 * CS%h2(i,j) * CS%Nb(i,j)**3 > 1.0e-14) ) then + (CS%kappa_itides**2 * CS%h2(i,j) * CS%Nb(i,j)**3 > 1.0e-14*US%T_to_s**3) ) then z0_polzin(i) = CS%Polzin_decay_scale_factor * CS%Nu_Polzin * & CS%Nbotref_Polzin**2 * CS%tideamp(i,j) / & - ( CS%kappa_itides**2 * CS%h2(i,j) * US%T_to_s * CS%Nb(i,j)**3 ) + ( CS%kappa_itides**2 * CS%h2(i,j) * CS%Nb(i,j)**3 ) if (z0_polzin(i) < CS%Polzin_min_decay_scale) & z0_polzin(i) = CS%Polzin_min_decay_scale - if (N2_meanz(i) > 1.0e-14 ) then !### Here 1.0e-14 has dimensions of s-2. + if (N2_meanz(i) > 1.0e-14*US%T_to_s**2 ) then !### Here 1.0e-14 has dimensions of s-2. z0_polzin_scaled(i) = z0_polzin(i)*CS%Nb(i,j)**2 / N2_meanz(i) else z0_polzin_scaled(i) = CS%Polzin_decay_scale_max_factor * htot(i) @@ -1106,8 +1106,8 @@ subroutine add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, US, z_from_bot(i) = GV%H_to_Z*h(i,j,nz) ! Use the new formulation for WKB scaling. N2 is referenced to its vertical mean. - if (N2_meanz(i) > 1.0e-14 ) then !### Avoid using this dimensional constant. - z_from_bot_WKB(i) = GV%H_to_Z*h(i,j,nz) * (US%s_to_T**2 * N2_lay(i,nz)) / N2_meanz(i) + if (N2_meanz(i) > 1.0e-14*US%T_to_s**2 ) then !### Avoid using this dimensional constant. + z_from_bot_WKB(i) = GV%H_to_Z*h(i,j,nz) * N2_lay(i,nz) / N2_meanz(i) else ; z_from_bot_WKB(i) = 0 ; endif enddo endif ! Polzin @@ -1116,7 +1116,7 @@ subroutine add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, US, ! Both Polzin and Simmons: do i=is,ie ! Dissipation of locally trapped internal tide (non-propagating high modes) - TKE_itidal_bot(i) = min(CS%TKE_itidal(i,j)*US%T_to_s*CS%Nb(i,j), CS%TKE_itide_max) + TKE_itidal_bot(i) = min(CS%TKE_itidal(i,j)*CS%Nb(i,j), CS%TKE_itide_max) if (associated(dd%TKE_itidal_used)) & dd%TKE_itidal_used(i,j) = TKE_itidal_bot(i) TKE_itidal_bot(i) = (I_rho0 * CS%Mu_itides * CS%Gamma_itides) * TKE_itidal_bot(i) @@ -1233,9 +1233,9 @@ subroutine add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, US, do k=nz-1,2,-1 ; do i=is,ie if (max_TKE(i,k) <= 0.0) cycle z_from_bot(i) = z_from_bot(i) + GV%H_to_Z*h(i,j,k) - if (N2_meanz(i) > 1.0e-14 ) then + if (N2_meanz(i) > 1.0e-14*US%T_to_s**2 ) then z_from_bot_WKB(i) = z_from_bot_WKB(i) & - + GV%H_to_Z * h(i,j,k) * (US%s_to_T**2 * N2_lay(i,k)) / N2_meanz(i) + + GV%H_to_Z * h(i,j,k) * N2_lay(i,k) / N2_meanz(i) else ; z_from_bot_WKB(i) = 0 ; endif ! Fraction of bottom flux predicted to reach top of this layer From ae1795dbeacfe96ec76321631073f26015f43949 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 25 Jun 2019 05:20:44 -0400 Subject: [PATCH 33/82] (*)Set I_2Omega with HENYEY_IGW_BACKGROUND_NEW Set the variable I_2Omega when HENYEY_IGW_BACKGROUND_NEW=True. This had not previously been set, but had been used, so I can only assume that this option was not being tested by anyone. The answers in the MOM6-examples test cases are bitwise identical, but this should change answers whenever HENYEY_IGW_BACKGROUND_NEW = True. --- .../vertical/MOM_bkgnd_mixing.F90 | 20 ++++++++++++------- 1 file changed, 13 insertions(+), 7 deletions(-) diff --git a/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 b/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 index 641430bb02..0cbe700518 100644 --- a/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 +++ b/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 @@ -56,6 +56,7 @@ module MOM_bkgnd_mixing !! horiz_varying_background=.true. [Z2 T-1 ~> m2 s-1] real :: Kd_min !< minimum diapycnal diffusivity [Z2 T-1 ~> m2 s-1] real :: Kd !< interior diapycnal diffusivity [Z2 T-1 ~> m2 s-1] + real :: omega !< The Earth's rotation rate [T-1 ~> s-1]. real :: N0_2Omega !< ratio of the typical Buoyancy frequency to !! twice the Earth's rotation period, used with the !! Henyey scaling from the mixing @@ -274,11 +275,15 @@ subroutine bkgnd_mixing_init(Time, G, GV, US, param_file, diag, CS) "diffusivity (KD) is specified along with "//trim(CS%bkgnd_scheme_str)) endif - if (CS%Henyey_IGW_background) & + if (CS%Henyey_IGW_background) then call get_param(param_file, mdl, "HENYEY_N0_2OMEGA", CS%N0_2Omega, & "The ratio of the typical Buoyancy frequency to twice "//& "the Earth's rotation period, used with the Henyey "//& "scaling from the mixing.", units="nondim", default=20.0) + call get_param(param_file, mdl, "OMEGA", CS%omega, & + "The rotation rate of the earth.", units="s-1", & + default=7.2921e-5, scale=US%T_to_s) + endif call get_param(param_file, mdl, "KD_TANH_LAT_FN", & CS%Kd_tanh_lat_fn, & @@ -391,13 +396,13 @@ subroutine calculate_bkgnd_mixing(h, tv, N2_lay, Kd_lay, Kv, j, G, GV, US, CS) real, dimension(SZI_(G)) :: depth !< distance from surface of an interface [Z ~> m] real :: depth_c !< depth of the center of a layer [Z ~> m] real :: I_Hmix !< inverse of fixed mixed layer thickness [Z-1 ~> m-1] - real :: I_2Omega !< 1/(2 Omega) [s] - real :: N_2Omega - real :: N02_N2 - real :: I_x30 !< 2/acos(2) = 1/(sin(30 deg) * acosh(1/sin(30 deg))) + real :: I_2Omega !< 1/(2 Omega) [T ~> s] + real :: N_2Omega ! The ratio of the stratification to the Earth's rotation rate [nondim] + real :: N02_N2 ! The ratio a reference stratification to the actual stratification [nondim] + real :: I_x30 !< 2/acos(2) = 1/(sin(30 deg) * acosh(1/sin(30 deg))) real :: deg_to_rad !< factor converting degrees to radians, pi/180. real :: abs_sin !< absolute value of sine of latitude [nondim] - real :: epsilon + real :: epsilon ! The minimum value of the sine of latitude [nondim] real :: bckgrnd_vdc_psin !< PSI diffusivity in northern hemisphere [Z2 T-1 ~> m2 s-1] real :: bckgrnd_vdc_psis !< PSI diffusivity in southern hemisphere [Z2 T-1 ~> m2 s-1] integer :: i, k, is, ie, js, je, nz @@ -501,9 +506,10 @@ subroutine calculate_bkgnd_mixing(h, tv, N2_lay, Kd_lay, Kv, j, G, GV, US, CS) elseif (CS%Henyey_IGW_background_new) then I_x30 = 2.0 / invcosh(CS%N0_2Omega*2.0) ! This is evaluated at 30 deg. + I_2Omega = 0.5 / CS%omega do k=1,nz ; do i=is,ie abs_sin = max(epsilon, abs(sin(G%geoLatT(i,j)*deg_to_rad))) - N_2Omega = max(abs_sin, sqrt(US%s_to_T**2 * N2_lay(i,k))*I_2Omega) + N_2Omega = max(abs_sin, sqrt(N2_lay(i,k))*I_2Omega) N02_N2 = (CS%N0_2Omega/N_2Omega)**2 Kd_lay(i,j,k) = max(CS%Kd_min, CS%Kd_sfc(i,j) * & ((abs_sin * invcosh(N_2Omega/abs_sin)) * I_x30)*N02_N2) From 3834188a898ae21d7d0fcd16fb32b972243c0e60 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 25 Jun 2019 05:42:56 -0400 Subject: [PATCH 34/82] +Added dimensional testing in MOM_vert_friction.F90 Added rescaling of time units for dimensional consistency testing of various internal variables in MOM_vert_friction.F90. This also includes adding a new unit_scale_type argument to vertvisc_remnant. All answers are bitwise identical. --- src/core/MOM_dynamics_split_RK2.F90 | 6 +- .../vertical/MOM_vert_friction.F90 | 155 +++++++++--------- 2 files changed, 80 insertions(+), 81 deletions(-) diff --git a/src/core/MOM_dynamics_split_RK2.F90 b/src/core/MOM_dynamics_split_RK2.F90 index d862fae71d..a0bd44b51a 100644 --- a/src/core/MOM_dynamics_split_RK2.F90 +++ b/src/core/MOM_dynamics_split_RK2.F90 @@ -483,7 +483,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & call uvchksum("before vertvisc: up", up, vp, G%HI, haloshift=0, symmetric=sym) endif call vertvisc_coef(up, vp, h, forces, visc, dt, G, GV, US, CS%vertvisc_CSp, CS%OBC) - call vertvisc_remnant(visc, CS%visc_rem_u, CS%visc_rem_v, dt, G, GV, CS%vertvisc_CSp) + call vertvisc_remnant(visc, CS%visc_rem_u, CS%visc_rem_v, dt, G, GV, US, CS%vertvisc_CSp) call cpu_clock_end(id_clock_vertvisc) if (showCallTree) call callTree_wayPoint("done with vertvisc_coef (step_MOM_dyn_split_RK2)") @@ -587,7 +587,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & call start_group_pass(CS%pass_uvp, G%Domain, clock=id_clock_pass) call cpu_clock_begin(id_clock_vertvisc) endif - call vertvisc_remnant(visc, CS%visc_rem_u, CS%visc_rem_v, dt_pred, G, GV, CS%vertvisc_CSp) + call vertvisc_remnant(visc, CS%visc_rem_u, CS%visc_rem_v, dt_pred, G, GV, US, CS%vertvisc_CSp) call cpu_clock_end(id_clock_vertvisc) call do_group_pass(CS%pass_visc_rem, G%Domain, clock=id_clock_pass) @@ -782,7 +782,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & call start_group_pass(CS%pass_uv, G%Domain, clock=id_clock_pass) call cpu_clock_begin(id_clock_vertvisc) endif - call vertvisc_remnant(visc, CS%visc_rem_u, CS%visc_rem_v, dt, G, GV, CS%vertvisc_CSp) + call vertvisc_remnant(visc, CS%visc_rem_u, CS%visc_rem_v, dt, G, GV, US, CS%vertvisc_CSp) call cpu_clock_end(id_clock_vertvisc) if (showCallTree) call callTree_wayPoint("done with vertvisc (step_MOM_dyn_split_RK2)") diff --git a/src/parameterizations/vertical/MOM_vert_friction.F90 b/src/parameterizations/vertical/MOM_vert_friction.F90 index d688d1c38d..3bcf99ca1a 100644 --- a/src/parameterizations/vertical/MOM_vert_friction.F90 +++ b/src/parameterizations/vertical/MOM_vert_friction.F90 @@ -40,11 +40,11 @@ module MOM_vert_friction real :: Hmix !< The mixed layer thickness in thickness units [H ~> m or kg m-2]. real :: Hmix_stress !< The mixed layer thickness over which the wind !! stress is applied with direct_stress [H ~> m or kg m-2]. - real :: Kvml !< The mixed layer vertical viscosity [Z2 s-1 ~> m2 s-1]. - real :: Kv !< The interior vertical viscosity [Z2 s-1 ~> m2 s-1]. + real :: Kvml !< The mixed layer vertical viscosity [Z2 T-1 ~> m2 s-1]. + real :: Kv !< The interior vertical viscosity [Z2 T-1 ~> m2 s-1]. real :: Hbbl !< The static bottom boundary layer thickness [H ~> m or kg m-2]. real :: Kvbbl !< The vertical viscosity in the bottom boundary - !! layer [Z2 s-1 ~> m2 s-1]. + !! layer [Z2 T-1 ~> m2 s-1]. real :: maxvel !< Velocity components greater than maxvel are truncated [m s-1]. real :: vel_underflow !< Velocity components smaller than vel_underflow @@ -65,17 +65,17 @@ module MOM_vert_friction type(time_type) :: rampStartTime !< The time at which the ramping of CFL_trunc starts real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_,NK_INTERFACE_) :: & - a_u !< The u-drag coefficient across an interface [Z s-1 ~> m s-1]. + a_u !< The u-drag coefficient across an interface [Z T-1 ~> m s-1]. real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_,NKMEM_) :: & h_u !< The effective layer thickness at u-points [H ~> m or kg m-2]. real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_,NK_INTERFACE_) :: & - a_v !< The v-drag coefficient across an interface [Z s-1 ~> m s-1]. + a_v !< The v-drag coefficient across an interface [Z T-1 ~> m s-1]. real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_,NKMEM_) :: & h_v !< The effective layer thickness at v-points [H ~> m or kg m-2]. real, pointer, dimension(:,:) :: a1_shelf_u => NULL() !< The u-momentum coupling coefficient under - !! ice shelves [Z s-1 ~> m s-1]. Retained to determine stress under shelves. + !! ice shelves [Z T-1 ~> m s-1]. Retained to determine stress under shelves. real, pointer, dimension(:,:) :: a1_shelf_v => NULL() !< The v-momentum coupling coefficient under - !! ice shelves [Z s-1 ~> m s-1]. Retained to determine stress under shelves. + !! ice shelves [Z T-1 ~> m s-1]. Retained to determine stress under shelves. logical :: split !< If true, use the split time stepping scheme. logical :: bottomdraglaw !< If true, the bottom stress is calculated with a @@ -177,7 +177,7 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, US, CS, & real :: b1(SZIB_(G)) ! A variable used by the tridiagonal solver [H-1 ~> m-1 or m2 kg-1]. real :: c1(SZIB_(G),SZK_(G)) ! A variable used by the tridiagonal solver [nondim]. real :: d1(SZIB_(G)) ! d1=1-c1 is used by the tridiagonal solver [nondim]. - real :: Ray(SZIB_(G),SZK_(G)) ! Ray is the Rayleigh-drag velocity [Z s-1 ~> m s-1]. + real :: Ray(SZIB_(G),SZK_(G)) ! Ray is the Rayleigh-drag velocity [Z T-1 ~> m s-1]. real :: b_denom_1 ! The first term in the denominator of b1 [H ~> m or kg m-2]. real :: Hmix ! The mixed layer thickness over which stress @@ -187,7 +187,7 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, US, CS, & real :: dt_Rho0 ! The time step divided by the mean density [s m3 kg-1]. real :: Rho0 ! A density used to convert drag laws into stress in Pa [kg m-3]. real :: dt_Z_to_H ! The time step times the conversion from Z to the - ! units of thickness - [s H Z-1 ~> s or s kg m-3]. + ! units of thickness - [T H Z-1 ~> s or s kg m-3]. real :: h_neglect ! A thickness that is so small it is usually lost ! in roundoff and can be neglected [H ~> m or kg m-2]. @@ -212,7 +212,7 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, US, CS, & I_Hmix = 1.0 / Hmix endif dt_Rho0 = dt/GV%H_to_kg_m2 - dt_Z_to_H = dt*GV%Z_to_H + dt_Z_to_H = US%s_to_T*dt*GV%Z_to_H Rho0 = GV%Rho0 h_neglect = GV%H_subroundoff Idt = 1.0 / dt @@ -266,7 +266,7 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, US, CS, & enddo ; endif ! direct_stress if (CS%Channel_drag) then ; do k=1,nz ; do I=Isq,Ieq - Ray(I,k) = visc%Ray_u(I,j,k) + Ray(I,k) = US%T_to_s*visc%Ray_u(I,j,k) enddo ; enddo ; endif ! perform forward elimination on the tridiagonal system @@ -318,15 +318,15 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, US, CS, & enddo ; enddo ; endif if (associated(visc%taux_shelf)) then ; do I=Isq,Ieq - visc%taux_shelf(I,j) = -Rho0*CS%a1_shelf_u(I,j)*u(I,j,1) ! - u_shelf? + visc%taux_shelf(I,j) = -Rho0*US%s_to_T*CS%a1_shelf_u(I,j)*u(I,j,1) ! - u_shelf? enddo ; endif if (PRESENT(taux_bot)) then do I=Isq,Ieq - taux_bot(I,j) = Rho0 * (u(I,j,nz)*CS%a_u(I,j,nz+1)) + taux_bot(I,j) = Rho0 * (u(I,j,nz)*US%s_to_T*CS%a_u(I,j,nz+1)) enddo if (CS%Channel_drag) then ; do k=1,nz ; do I=Isq,Ieq - taux_bot(I,j) = taux_bot(I,j) + Rho0 * (Ray(I,k)*u(I,j,k)) + taux_bot(I,j) = taux_bot(I,j) + Rho0 * (US%s_to_T*Ray(I,k)*u(I,j,k)) enddo ; enddo ; endif endif @@ -374,7 +374,7 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, US, CS, & enddo ; endif ! direct_stress if (CS%Channel_drag) then ; do k=1,nz ; do i=is,ie - Ray(i,k) = visc%Ray_v(i,J,k) + Ray(i,k) = US%T_to_s*visc%Ray_v(i,J,k) enddo ; enddo ; endif do i=is,ie ; if (do_i(i)) then @@ -385,7 +385,7 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, US, CS, & endif ; enddo do k=2,nz ; do i=is,ie ; if (do_i(i)) then c1(i,k) = dt_Z_to_H * CS%a_v(i,J,K) * b1(i) - b_denom_1 = CS%h_v(i,J,k) + dt_Z_to_H * (Ray(i,k) + CS%a_v(i,J,K)*d1(i)) + b_denom_1 = CS%h_v(i,J,k) + dt_Z_to_H * (Ray(i,k) + CS%a_v(i,J,K)*d1(i)) b1(i) = 1.0 / (b_denom_1 + dt_Z_to_H * CS%a_v(i,J,K+1)) d1(i) = b_denom_1 * b1(i) v(i,J,k) = (CS%h_v(i,J,k) * v(i,J,k) + dt_Z_to_H * CS%a_v(i,J,K) * v(i,J,k-1)) * b1(i) @@ -399,15 +399,15 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, US, CS, & enddo ; enddo ; endif if (associated(visc%tauy_shelf)) then ; do i=is,ie - visc%tauy_shelf(i,J) = -Rho0*CS%a1_shelf_v(i,J)*v(i,J,1) ! - v_shelf? + visc%tauy_shelf(i,J) = -Rho0*US%s_to_T*CS%a1_shelf_v(i,J)*v(i,J,1) ! - v_shelf? enddo ; endif if (present(tauy_bot)) then do i=is,ie - tauy_bot(i,J) = Rho0 * (v(i,J,nz)*CS%a_v(i,J,nz+1)) + tauy_bot(i,J) = Rho0 * (v(i,J,nz)*US%s_to_T*CS%a_v(i,J,nz+1)) enddo if (CS%Channel_drag) then ; do k=1,nz ; do i=is,ie - tauy_bot(i,J) = tauy_bot(i,J) + Rho0 * (Ray(i,k)*v(i,J,k)) + tauy_bot(i,J) = tauy_bot(i,J) + Rho0 * (US%s_to_T*Ray(i,k)*v(i,J,k)) enddo ; enddo ; endif endif @@ -455,7 +455,7 @@ end subroutine vertvisc !! after a time-step of viscosity, and the fraction of a time-step's !! worth of barotropic acceleration that a layer experiences after !! viscosity is applied. -subroutine vertvisc_remnant(visc, visc_rem_u, visc_rem_v, dt, G, GV, CS) +subroutine vertvisc_remnant(visc, visc_rem_u, visc_rem_v, dt, G, GV, US, CS) type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure type(vertvisc_type), intent(in) :: visc !< Viscosities and bottom drag @@ -468,6 +468,7 @@ subroutine vertvisc_remnant(visc, visc_rem_u, visc_rem_v, dt, G, GV, CS) !! barotopic acceleration that a layer experiences after !! viscosity is applied in the meridional direction [nondim] real, intent(in) :: dt !< Time increment [s] + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(vertvisc_CS), pointer :: CS !< Vertical viscosity control structure ! Local variables @@ -475,10 +476,10 @@ subroutine vertvisc_remnant(visc, visc_rem_u, visc_rem_v, dt, G, GV, CS) real :: b1(SZIB_(G)) ! A variable used by the tridiagonal solver [H-1 ~> m-1 or m2 kg-1]. real :: c1(SZIB_(G),SZK_(G)) ! A variable used by the tridiagonal solver [nondim]. real :: d1(SZIB_(G)) ! d1=1-c1 is used by the tridiagonal solver [nondim]. - real :: Ray(SZIB_(G),SZK_(G)) ! Ray is the Rayleigh-drag velocity times the time step [m]. + real :: Ray(SZIB_(G),SZK_(G)) ! Ray is the Rayleigh-drag velocity [Z T-1 ~> m s-1]. real :: b_denom_1 ! The first term in the denominator of b1 [H ~> m or kg m-2]. real :: dt_Z_to_H ! The time step times the conversion from Z to the - ! units of thickness [s H Z-1 ~> s or s kg m-3]. + ! units of thickness [T H Z-1 ~> s or s kg m-3]. logical :: do_i(SZIB_(G)) integer :: i, j, k, is, ie, Isq, Ieq, Jsq, Jeq, nz @@ -488,7 +489,7 @@ subroutine vertvisc_remnant(visc, visc_rem_u, visc_rem_v, dt, G, GV, CS) if (.not.associated(CS)) call MOM_error(FATAL,"MOM_vert_friction(visc): "// & "Module must be initialized before it is used.") - dt_Z_to_H = dt*GV%Z_to_H + dt_Z_to_H = US%s_to_T*dt*GV%Z_to_H do k=1,nz ; do i=Isq,Ieq ; Ray(i,k) = 0.0 ; enddo ; enddo @@ -500,7 +501,7 @@ subroutine vertvisc_remnant(visc, visc_rem_u, visc_rem_v, dt, G, GV, CS) do I=Isq,Ieq ; do_i(I) = (G%mask2dCu(I,j) > 0) ; enddo if (CS%Channel_drag) then ; do k=1,nz ; do I=Isq,Ieq - Ray(I,k) = visc%Ray_u(I,j,k) + Ray(I,k) = US%T_to_s*visc%Ray_u(I,j,k) enddo ; enddo ; endif do I=Isq,Ieq ; if (do_i(I)) then @@ -531,7 +532,7 @@ subroutine vertvisc_remnant(visc, visc_rem_u, visc_rem_v, dt, G, GV, CS) do i=is,ie ; do_i(i) = (G%mask2dCv(i,J) > 0) ; enddo if (CS%Channel_drag) then ; do k=1,nz ; do i=is,ie - Ray(i,k) = visc%Ray_v(i,J,k) + Ray(i,k) = US%T_to_s*visc%Ray_v(i,J,k) enddo ; enddo ; endif do i=is,ie ; if (do_i(i)) then @@ -542,7 +543,7 @@ subroutine vertvisc_remnant(visc, visc_rem_u, visc_rem_v, dt, G, GV, CS) endif ; enddo do k=2,nz ; do i=is,ie ; if (do_i(i)) then c1(i,k) = dt_Z_to_H * CS%a_v(i,J,K)*b1(i) - b_denom_1 = CS%h_v(i,J,k) + dt_Z_to_H * (Ray(i,k) + CS%a_v(i,J,K)*d1(i)) + b_denom_1 = CS%h_v(i,J,k) + dt_Z_to_H * (Ray(i,k) + CS%a_v(i,J,K)*d1(i)) b1(i) = 1.0 / (b_denom_1 + dt_Z_to_H * CS%a_v(i,J,K+1)) d1(i) = b_denom_1 * b1(i) visc_rem_v(i,J,k) = (CS%h_v(i,J,k) + dt_Z_to_H * CS%a_v(i,J,K) * visc_rem_v(i,J,k-1)) * b1(i) @@ -592,14 +593,14 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, US, CS, OBC) hvel, & ! hvel is the thickness used at a velocity grid point [H ~> m or kg m-2]. hvel_shelf ! The equivalent of hvel under shelves [H ~> m or kg m-2]. real, dimension(SZIB_(G),SZK_(G)+1) :: & - a_cpl, & ! The drag coefficients across interfaces [Z s-1 ~> m s-1]. a_cpl times + a_cpl, & ! The drag coefficients across interfaces [Z T-1 ~> m s-1]. a_cpl times ! the velocity difference gives the stress across an interface. a_shelf, & ! The drag coefficients across interfaces in water columns under - ! ice shelves [Z s-1 ~> m s-1]. + ! ice shelves [Z T-1 ~> m s-1]. z_i ! An estimate of each interface's height above the bottom, ! normalized by the bottom boundary layer thickness, nondim. real, dimension(SZIB_(G)) :: & - kv_bbl, & ! The bottom boundary layer viscosity [Z2 s-1 ~> m2 s-1]. + kv_bbl, & ! The bottom boundary layer viscosity [Z2 T-1 ~> m2 s-1]. bbl_thick, & ! The bottom boundary layer thickness [H ~> m or kg m-2]. I_Hbbl, & ! The inverse of the bottom boundary layer thickness [H-1 ~> m-1 or m2 kg-1]. I_Htbl, & ! The inverse of the top boundary layer thickness [H-1 ~> m-1 or m2 kg-1]. @@ -613,8 +614,8 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, US, CS, OBC) h_ml ! The mixed layer depth [H ~> m or kg m-2]. real, allocatable, dimension(:,:) :: hML_u ! Diagnostic of the mixed layer depth at u points [H ~> m or kg m-2]. real, allocatable, dimension(:,:) :: hML_v ! Diagnostic of the mixed layer depth at v points [H ~> m or kg m-2]. - real, allocatable, dimension(:,:,:) :: Kv_u !< Total vertical viscosity at u-points [Z2 s-1 ~> m2 s-1]. - real, allocatable, dimension(:,:,:) :: Kv_v !< Total vertical viscosity at v-points [Z2 s-1 ~> m2 s-1]. + real, allocatable, dimension(:,:,:) :: Kv_u !< Total vertical viscosity at u-points [Z2 T-1 ~> m2 s-1]. + real, allocatable, dimension(:,:,:) :: Kv_v !< Total vertical viscosity at v-points [Z2 T-1 ~> m2 s-1]. real :: zcol(SZI_(G)) ! The height of an interface at h-points [H ~> m or kg m-2]. real :: botfn ! A function which goes from 1 at the bottom to 0 much more ! than Hbbl into the interior. @@ -676,7 +677,7 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, US, CS, OBC) do I=Isq,Ieq ; do_i(I) = (G%mask2dCu(I,j) > 0) ; enddo if (CS%bottomdraglaw) then ; do I=Isq,Ieq - kv_bbl(I) = US%s_to_T*visc%Kv_bbl_u(I,j) + kv_bbl(I) = visc%Kv_bbl_u(I,j) bbl_thick(I) = visc%bbl_thick_u(I,j) * GV%Z_to_H if (do_i(I)) I_Hbbl(I) = 1.0 / (bbl_thick(I) + h_neglect) enddo ; endif @@ -843,7 +844,7 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, US, CS, OBC) do i=is,ie ; do_i(i) = (G%mask2dCv(i,J) > 0) ; enddo if (CS%bottomdraglaw) then ; do i=is,ie - kv_bbl(i) = US%s_to_T*visc%Kv_bbl_v(i,J) + kv_bbl(i) = visc%Kv_bbl_v(i,J) bbl_thick(i) = visc%bbl_thick_v(i,J) * GV%Z_to_H if (do_i(i)) I_Hbbl(i) = 1.0 / bbl_thick(i) enddo ; endif @@ -1004,9 +1005,9 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, US, CS, OBC) if (CS%debug) then call uvchksum("vertvisc_coef h_[uv]", CS%h_u, & - CS%h_v, G%HI,haloshift=0, scale=GV%H_to_m) + CS%h_v, G%HI,haloshift=0, scale=GV%H_to_m*US%s_to_T) call uvchksum("vertvisc_coef a_[uv]", CS%a_u, & - CS%a_v, G%HI, haloshift=0, scale=US%Z_to_m) + CS%a_v, G%HI, haloshift=0, scale=US%Z_to_m*US%s_to_T) if (allocated(hML_u) .and. allocated(hML_v)) & call uvchksum("vertvisc_coef hML_[uv]", hML_u, hML_v, & G%HI, haloshift=0, scale=GV%H_to_m) @@ -1037,7 +1038,7 @@ subroutine find_coupling_coef(a_cpl, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZIB_(G),SZK_(GV)+1), & - intent(out) :: a_cpl !< Coupling coefficient across interfaces [Z s-1 ~> m s-1]. + intent(out) :: a_cpl !< Coupling coefficient across interfaces [Z T-1 ~> m s-1]. real, dimension(SZIB_(G),SZK_(GV)), & intent(in) :: hvel !< Thickness at velocity points [H ~> m or kg m-2] logical, dimension(SZIB_(G)), & @@ -1046,7 +1047,7 @@ subroutine find_coupling_coef(a_cpl, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, intent(in) :: h_harm !< Harmonic mean of thicknesses around a velocity !! grid point [H ~> m or kg m-2] real, dimension(SZIB_(G)), intent(in) :: bbl_thick !< Bottom boundary layer thickness [H ~> m or kg m-2] - real, dimension(SZIB_(G)), intent(in) :: kv_bbl !< Bottom boundary layer viscosity [Z2 s-1 ~> m2 s-1]. + real, dimension(SZIB_(G)), intent(in) :: kv_bbl !< Bottom boundary layer viscosity [Z2 T-1 ~> m2 s-1]. real, dimension(SZIB_(G),SZK_(GV)+1), & intent(in) :: z_i !< Estimate of interface heights above the bottom, !! normalized by the bottom boundary layer thickness @@ -1065,29 +1066,29 @@ subroutine find_coupling_coef(a_cpl, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, ! Local variables real, dimension(SZIB_(G)) :: & - u_star, & ! ustar at a velocity point [Z s-1 ~> m s-1]. - absf, & ! The average of the neighboring absolute values of f [s-1]. + u_star, & ! ustar at a velocity point [Z T-1 ~> m s-1]. + absf, & ! The average of the neighboring absolute values of f [T-1 ~> s-1]. ! h_ml, & ! The mixed layer depth [H ~> m or kg m-2]. nk_visc, & ! The (real) interface index of the base of mixed layer. z_t, & ! The distance from the top, sometimes normalized ! by Hmix, [H ~> m or kg m-2] or [nondim]. - kv_tbl, & ! The viscosity in a top boundary layer under ice [Z2 s-1 ~> m2 s-1]. + kv_TBL, & ! The viscosity in a top boundary layer under ice [Z2 T-1 ~> m2 s-1]. tbl_thick real, dimension(SZIB_(G),SZK_(GV)) :: & Kv_add ! A viscosity to add [Z2 T-1 ~> m2 s-1]. real :: h_shear ! The distance over which shears occur [H ~> m or kg m-2]. real :: r ! A thickness to compare with Hbbl [H ~> m or kg m-2]. - real :: visc_ml ! The mixed layer viscosity [Z2 s-1 ~> m2 s-1]. + real :: visc_ml ! The mixed layer viscosity [Z2 T-1 ~> m2 s-1]. real :: I_Hmix ! The inverse of the mixed layer thickness [H-1 ~> m-1 or m2 kg-1]. real :: a_ml ! The layer coupling coefficient across an interface in - ! the mixed layer [m s-1]. - real :: I_amax ! The inverse of the maximum coupling coefficient [Z-1 ~> m-1].??? + ! the mixed layer [Z T-1 ~> m s-1]. + real :: I_amax ! The inverse of the maximum coupling coefficient [T s-1 Z-1 ~> m-1].??? real :: temp1 ! A temporary variable [H Z ~> m2 or kg m-1] real :: h_neglect ! A thickness that is so small it is usually lost ! in roundoff and can be neglected [H ~> m or kg m-2]. - real :: z2 ! A copy of z_i, nondim. - real :: topfn - real :: a_top + real :: z2 ! A copy of z_i [nondim] + real :: topfn ! A function that is 1 at the top and small far from it [nondim] + real :: a_top ! Twice a viscosity associated with the top boundary layer [Z2 T-1 ~> m2 s-1] logical :: do_shelf, do_OBCs integer :: i, k, is, ie, max_nk integer :: nz @@ -1103,7 +1104,7 @@ subroutine find_coupling_coef(a_cpl, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, ! The maximum coupling coefficent was originally introduced to avoid ! truncation error problems in the tridiagonal solver. Effectively, the 1e-10 ! sets the maximum coupling coefficient increment to 1e10 m per timestep. - I_amax = (1.0e-10*US%Z_to_m) * dt + I_amax = (1.0e-10*US%Z_to_m) * dt*US%s_to_T do_shelf = .false. ; if (present(shelf)) do_shelf = shelf do_OBCs = .false. @@ -1157,7 +1158,7 @@ subroutine find_coupling_coef(a_cpl, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, endif ; enddo endif do K=2,nz ; do i=is,ie ; if (do_i(i)) then - a_cpl(i,K) = a_cpl(i,K) + US%s_to_T*Kv_add(i,K) + a_cpl(i,K) = a_cpl(i,K) + Kv_add(i,K) endif ; enddo ; enddo else do K=2,nz ; do i=is,ie ; if (do_i(i)) then @@ -1173,7 +1174,7 @@ subroutine find_coupling_coef(a_cpl, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, endif ; enddo endif do K=2,nz ; do i=is,ie ; if (do_i(i)) then - a_cpl(i,K) = a_cpl(i,K) + US%s_to_T*Kv_add(i,K) + a_cpl(i,K) = a_cpl(i,K) + Kv_add(i,K) endif ; enddo ; enddo endif endif @@ -1181,11 +1182,11 @@ subroutine find_coupling_coef(a_cpl, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, if (associated(visc%Kv_shear_Bu)) then if (work_on_u) then do K=2,nz ; do I=Is,Ie ; If (do_i(I)) then - a_cpl(I,K) = a_cpl(I,K) + (2.*0.5)*(US%s_to_T*visc%Kv_shear_Bu(I,J-1,k) + US%s_to_T*visc%Kv_shear_Bu(I,J,k)) + a_cpl(I,K) = a_cpl(I,K) + (2.*0.5)*(visc%Kv_shear_Bu(I,J-1,k) + visc%Kv_shear_Bu(I,J,k)) endif ; enddo ; enddo else do K=2,nz ; do i=is,ie ; if (do_i(i)) then - a_cpl(i,K) = a_cpl(i,K) + (2.*0.5)*(US%s_to_T*visc%Kv_shear_Bu(I-1,J,k) + US%s_to_T*visc%Kv_shear_Bu(I,J,k)) + a_cpl(i,K) = a_cpl(i,K) + (2.*0.5)*(visc%Kv_shear_Bu(I-1,J,k) + visc%Kv_shear_Bu(I,J,k)) endif ; enddo ; enddo endif endif @@ -1207,7 +1208,7 @@ subroutine find_coupling_coef(a_cpl, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, endif ; enddo endif do K=2,nz ; do i=is,ie ; if (do_i(i)) then - a_cpl(I,K) = a_cpl(I,K) + US%s_to_T*Kv_add(I,K) + a_cpl(I,K) = a_cpl(I,K) + Kv_add(I,K) endif ; enddo ; enddo else do K=2,nz ; do i=is,ie ; if (do_i(i)) then @@ -1224,7 +1225,7 @@ subroutine find_coupling_coef(a_cpl, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, endif ; enddo endif do K=2,nz ; do i=is,ie ; if (do_i(i)) then - a_cpl(i,K) = a_cpl(i,K) + US%s_to_T*Kv_add(i,K) + a_cpl(i,K) = a_cpl(i,K) + Kv_add(i,K) endif ; enddo ; enddo endif endif @@ -1248,7 +1249,7 @@ subroutine find_coupling_coef(a_cpl, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, h_shear = hvel(i,k) + hvel(i,k-1) + h_neglect endif - ! Up to this point a_cpl has had units of Z2 s-1, but now is converted to Z s-1. + ! Up to this point a_cpl has had units of Z2 T-1, but now is converted to Z T-1. a_cpl(i,K) = a_cpl(i,K) / (h_shear*GV%H_to_Z + I_amax*a_cpl(i,K)) endif ; enddo ; enddo ! i & k loops @@ -1256,19 +1257,19 @@ subroutine find_coupling_coef(a_cpl, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, ! Set the coefficients to include the no-slip surface stress. do i=is,ie ; if (do_i(i)) then if (work_on_u) then - kv_tbl(i) = US%s_to_T*visc%Kv_tbl_shelf_u(I,j) + kv_TBL(i) = visc%Kv_tbl_shelf_u(I,j) tbl_thick(i) = visc%tbl_thick_shelf_u(I,j) * GV%Z_to_H else - kv_tbl(i) = US%s_to_T*visc%Kv_tbl_shelf_v(i,J) + kv_TBL(i) = visc%Kv_tbl_shelf_v(i,J) tbl_thick(i) = visc%tbl_thick_shelf_v(i,J) * GV%Z_to_H endif z_t(i) = 0.0 ! If a_cpl(i,1) were not already 0, it would be added here. if (0.5*hvel(i,1) > tbl_thick(i)) then - a_cpl(i,1) = kv_tbl(i) / (tbl_thick(i) *GV%H_to_Z + I_amax*kv_tbl(i)) + a_cpl(i,1) = kv_TBL(i) / (tbl_thick(i) *GV%H_to_Z + I_amax*kv_TBL(i)) else - a_cpl(i,1) = kv_tbl(i) / (0.5*hvel(i,1)*GV%H_to_Z + I_amax*kv_tbl(i)) + a_cpl(i,1) = kv_TBL(i) / (0.5*hvel(i,1)*GV%H_to_Z + I_amax*kv_TBL(i)) endif endif ; enddo @@ -1283,7 +1284,7 @@ subroutine find_coupling_coef(a_cpl, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, h_shear = r endif - a_top = 2.0 * topfn * kv_tbl(i) + a_top = 2.0 * topfn * kv_TBL(i) a_cpl(i,K) = a_cpl(i,K) + a_top / (h_shear*GV%H_to_Z + I_amax*a_top) endif ; enddo ; enddo elseif (CS%dynamic_viscous_ML .or. (GV%nkml>0)) then @@ -1291,12 +1292,12 @@ subroutine find_coupling_coef(a_cpl, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, do i=is,ie ; if (do_i(i)) then if (GV%nkml>0) nk_visc(i) = real(GV%nkml+1) if (work_on_u) then - u_star(I) = 0.5*(forces%ustar(i,j) + forces%ustar(i+1,j)) - absf(I) = 0.5*US%s_to_T*(abs(G%CoriolisBu(I,J-1)) + abs(G%CoriolisBu(I,J))) + u_star(I) = US%T_to_s*0.5*(forces%ustar(i,j) + forces%ustar(i+1,j)) + absf(I) = 0.5*(abs(G%CoriolisBu(I,J-1)) + abs(G%CoriolisBu(I,J))) if (CS%dynamic_viscous_ML) nk_visc(I) = visc%nkml_visc_u(I,j) + 1 else - u_star(i) = 0.5*(forces%ustar(i,j) + forces%ustar(i,j+1)) - absf(i) = 0.5*US%s_to_T*(abs(G%CoriolisBu(I-1,J)) + abs(G%CoriolisBu(I,J))) + u_star(i) = US%T_to_s*0.5*(forces%ustar(i,j) + forces%ustar(i,j+1)) + absf(i) = 0.5*(abs(G%CoriolisBu(I-1,J)) + abs(G%CoriolisBu(I,J))) if (CS%dynamic_viscous_ML) nk_visc(i) = visc%nkml_visc_v(i,J) + 1 endif h_ml(i) = h_neglect ; z_t(i) = 0.0 @@ -1306,16 +1307,16 @@ subroutine find_coupling_coef(a_cpl, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, if (do_OBCS) then ; if (work_on_u) then do I=is,ie ; if (do_i(I) .and. (OBC%segnum_u(I,j) /= OBC_NONE)) then if (OBC%segment(OBC%segnum_u(I,j))%direction == OBC_DIRECTION_E) & - u_star(I) = forces%ustar(i,j) + u_star(I) = US%T_to_s*forces%ustar(i,j) if (OBC%segment(OBC%segnum_u(I,j))%direction == OBC_DIRECTION_W) & - u_star(I) = forces%ustar(i+1,j) + u_star(I) = US%T_to_s*forces%ustar(i+1,j) endif ; enddo else do i=is,ie ; if (do_i(i) .and. (OBC%segnum_v(i,J) /= OBC_NONE)) then if (OBC%segment(OBC%segnum_v(i,J))%direction == OBC_DIRECTION_N) & - u_star(i) = forces%ustar(i,j) + u_star(i) = US%T_to_s*forces%ustar(i,j) if (OBC%segment(OBC%segnum_v(i,J))%direction == OBC_DIRECTION_S) & - u_star(i) = forces%ustar(i,j+1) + u_star(i) = US%T_to_s*forces%ustar(i,j+1) endif ; enddo endif ; endif @@ -1333,10 +1334,8 @@ subroutine find_coupling_coef(a_cpl, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, temp1 = (z_t(i)*h_ml(i) - z_t(i)*z_t(i))*GV%H_to_Z ! This viscosity is set to go to 0 at the mixed layer top and bottom (in a log-layer) ! and be further limited by rotation to give the natural Ekman length. - visc_ml = u_star(i) * 0.41 * (temp1*u_star(i)) / & - (absf(i)*temp1 + h_ml(i)*u_star(i)) - a_ml = 4.0*visc_ml / ((hvel(i,k)+hvel(i,k-1) + h_neglect) * GV%H_to_Z + & - 2.0*I_amax* visc_ml) + visc_ml = u_star(i) * 0.41 * (temp1*u_star(i)) / (absf(i)*temp1 + h_ml(i)*u_star(i)) + a_ml = 4.0*visc_ml / ((hvel(i,k)+hvel(i,k-1) + h_neglect) * GV%H_to_Z + 2.0*I_amax*visc_ml) ! Choose the largest estimate of a. if (a_ml > a_cpl(i,K)) a_cpl(i,K) = a_ml endif ; endif ; enddo ; enddo @@ -1663,18 +1662,18 @@ subroutine vertvisc_init(MIS, Time, G, GV, US, param_file, diag, ADp, dirs, & call get_param(param_file, mdl, "KV", CS%Kv, & "The background kinematic viscosity in the interior. "//& "The molecular value, ~1e-6 m2 s-1, may be used.", & - units="m2 s-1", fail_if_missing=.true., scale=US%m_to_Z**2, unscaled=Kv_dflt) + units="m2 s-1", fail_if_missing=.true., scale=US%m2_s_to_Z2_T, unscaled=Kv_dflt) if (GV%nkml < 1) call get_param(param_file, mdl, "KVML", CS%Kvml, & "The kinematic viscosity in the mixed layer. A typical "//& "value is ~1e-2 m2 s-1. KVML is not used if "//& "BULKMIXEDLAYER is true. The default is set by KV.", & - units="m2 s-1", default=Kv_dflt, scale=US%m_to_Z**2) + units="m2 s-1", default=Kv_dflt, scale=US%m2_s_to_Z2_T) if (.not.CS%bottomdraglaw) call get_param(param_file, mdl, "KVBBL", CS%Kvbbl, & "The kinematic viscosity in the benthic boundary layer. "//& "A typical value is ~1e-2 m2 s-1. KVBBL is not used if "//& "BOTTOMDRAGLAW is true. The default is set by KV.", & - units="m2 s-1", default=Kv_dflt, scale=US%m_to_Z**2) + units="m2 s-1", default=Kv_dflt, scale=US%m2_s_to_Z2_T) call get_param(param_file, mdl, "HBBL", CS%Hbbl, & "The thickness of a bottom boundary layer with a "//& "viscosity of KVBBL if BOTTOMDRAGLAW is not defined, or "//& @@ -1738,16 +1737,16 @@ subroutine vertvisc_init(MIS, Time, G, GV, US, param_file, diag, ADp, dirs, & 'Slow varying vertical viscosity', 'm2 s-1', conversion=US%Z2_T_to_m2_s) CS%id_Kv_u = register_diag_field('ocean_model', 'Kv_u', diag%axesCuL, Time, & - 'Total vertical viscosity at u-points', 'm2 s-1', conversion=US%Z_to_m**2) + 'Total vertical viscosity at u-points', 'm2 s-1', conversion=US%Z2_T_to_m2_s) CS%id_Kv_v = register_diag_field('ocean_model', 'Kv_v', diag%axesCvL, Time, & - 'Total vertical viscosity at v-points', 'm2 s-1', conversion=US%Z_to_m**2) + 'Total vertical viscosity at v-points', 'm2 s-1', conversion=US%Z2_T_to_m2_s) CS%id_au_vv = register_diag_field('ocean_model', 'au_visc', diag%axesCui, Time, & - 'Zonal Viscous Vertical Coupling Coefficient', 'm s-1', conversion=US%Z_to_m) + 'Zonal Viscous Vertical Coupling Coefficient', 'm s-1', conversion=US%Z_to_m*US%s_to_T) CS%id_av_vv = register_diag_field('ocean_model', 'av_visc', diag%axesCvi, Time, & - 'Meridional Viscous Vertical Coupling Coefficient', 'm s-1', conversion=US%Z_to_m) + 'Meridional Viscous Vertical Coupling Coefficient', 'm s-1', conversion=US%Z_to_m*US%s_to_T) CS%id_h_u = register_diag_field('ocean_model', 'Hu_visc', diag%axesCuL, Time, & 'Thickness at Zonal Velocity Points for Viscosity', thickness_units) From 7ee45c453afaace34e133445f6a7a3be27d2e785 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 25 Jun 2019 06:35:30 -0400 Subject: [PATCH 35/82] +Added dimensional rescaling of visc%Ray_u Added dimensional rescaling in time of visc%Ray_u and visc%Ray_v for consistency testing. All answers are bitwise identical. --- src/core/MOM_variables.F90 | 4 ++-- src/parameterizations/vertical/MOM_set_diffusivity.F90 | 6 +++--- src/parameterizations/vertical/MOM_set_viscosity.F90 | 10 +++++----- src/parameterizations/vertical/MOM_vert_friction.F90 | 8 ++++---- 4 files changed, 14 insertions(+), 14 deletions(-) diff --git a/src/core/MOM_variables.F90 b/src/core/MOM_variables.F90 index ac7408879a..fd9cc0378f 100644 --- a/src/core/MOM_variables.F90 +++ b/src/core/MOM_variables.F90 @@ -231,8 +231,8 @@ module MOM_variables real, pointer, dimension(:,:) :: & MLD => NULL() !< Instantaneous active mixing layer depth [H ~> m or kg m-2]. real, pointer, dimension(:,:,:) :: & - Ray_u => NULL(), & !< The Rayleigh drag velocity to be applied to each layer at u-points [Z s-1 ~> m s-1]. - Ray_v => NULL() !< The Rayleigh drag velocity to be applied to each layer at v-points [Z s-1 ~> m s-1]. + Ray_u => NULL(), & !< The Rayleigh drag velocity to be applied to each layer at u-points [Z T-1 ~> m s-1]. + Ray_v => NULL() !< The Rayleigh drag velocity to be applied to each layer at v-points [Z T-1 ~> m s-1]. real, pointer, dimension(:,:,:) :: Kd_extra_T => NULL() !< The extra diffusivity of temperature due to double diffusion relative to the !! diffusivity of density [Z2 T-1 ~> m2 s-1]. diff --git a/src/parameterizations/vertical/MOM_set_diffusivity.F90 b/src/parameterizations/vertical/MOM_set_diffusivity.F90 index 3da2a58a97..7db244e111 100644 --- a/src/parameterizations/vertical/MOM_set_diffusivity.F90 +++ b/src/parameterizations/vertical/MOM_set_diffusivity.F90 @@ -548,7 +548,7 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & endif if (associated(visc%Ray_u) .and. associated(visc%Ray_v)) then - call uvchksum("Ray_[uv]", visc%Ray_u, visc%Ray_v, G%HI, 0, symmetric=.true., scale=US%Z_to_m) + call uvchksum("Ray_[uv]", visc%Ray_u, visc%Ray_v, G%HI, 0, symmetric=.true., scale=US%Z_to_m*US%s_to_T) endif endif @@ -1255,7 +1255,7 @@ subroutine add_drag_diffusivity(h, u, v, tv, fluxes, visc, j, TKE_to_Kd, & ! TKE_Ray has been initialized to 0 above. if (Rayleigh_drag) TKE_Ray = 0.5*CS%BBL_effic * G%IareaT(i,j) * & - US%m_to_Z**2 * US%T_to_s**3 * & + US%m_to_Z**2 * US%T_to_s**2 * & ((G%areaCu(I-1,j) * visc%Ray_u(I-1,j,k) * u(I-1,j,k)**2 + & G%areaCu(I,j) * visc%Ray_u(I,j,k) * u(I,j,k)**2) + & (G%areaCv(i,J-1) * visc%Ray_v(i,J-1,k) * v(i,J-1,k)**2 + & @@ -1434,7 +1434,7 @@ subroutine add_LOTW_BBL_diffusivity(h, u, v, tv, fluxes, visc, j, N2_int, & ! Add in additional energy input from bottom-drag against slopes (sides) if (Rayleigh_drag) TKE_remaining = TKE_remaining + & - US%m_to_Z**2 * US%T_to_s**3 * & + US%m_to_Z**2 * US%T_to_s**2 * & 0.5*CS%BBL_effic * G%IareaT(i,j) * & ((G%areaCu(I-1,j) * visc%Ray_u(I-1,j,k) * u(I-1,j,k)**2 + & G%areaCu(I,j) * visc%Ray_u(I,j,k) * u(I,j,k)**2) + & diff --git a/src/parameterizations/vertical/MOM_set_viscosity.F90 b/src/parameterizations/vertical/MOM_set_viscosity.F90 index 8af4bcb90c..d55c7e33cf 100644 --- a/src/parameterizations/vertical/MOM_set_viscosity.F90 +++ b/src/parameterizations/vertical/MOM_set_viscosity.F90 @@ -72,7 +72,7 @@ module MOM_set_visc !! determine the mixed layer thickness for viscosity. real :: bulk_Ri_ML !< The bulk mixed layer used to determine the !! thickness of the viscous mixed layer. Nondim. - real :: omega !< The Earth's rotation rate [T-1]. + real :: omega !< The Earth's rotation rate [T-1 ~> s-1]. real :: ustar_min !< A minimum value of ustar to avoid numerical !! problems [Z T-1 ~> m s-1]. If the value is small enough, !! this should not affect the solution. @@ -844,13 +844,13 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, symmetrize) if (m==1) then if (Rayleigh > 0.0) then v_at_u = set_v_at_u(v, h, G, i, j, k, mask_v, OBC) - visc%Ray_u(I,j,k) = Rayleigh*sqrt(u(I,j,k)*u(I,j,k) + & + visc%Ray_u(I,j,k) = Rayleigh*US%T_to_s*sqrt(u(I,j,k)*u(I,j,k) + & v_at_u*v_at_u + U_bg_sq) else ; visc%Ray_u(I,j,k) = 0.0 ; endif else if (Rayleigh > 0.0) then u_at_v = set_u_at_v(u, h, G, i, j, k, mask_u, OBC) - visc%Ray_v(i,J,k) = Rayleigh*sqrt(v(i,J,k)*v(i,J,k) + & + visc%Ray_v(i,J,k) = Rayleigh*US%T_to_s*sqrt(v(i,J,k)*v(i,J,k) + & u_at_v*u_at_v + U_bg_sq) else ; visc%Ray_v(i,J,k) = 0.0 ; endif endif @@ -2019,9 +2019,9 @@ subroutine set_visc_init(Time, G, GV, US, param_file, diag, visc, CS, restart_CS allocate(visc%Ray_u(IsdB:IedB,jsd:jed,nz)) ; visc%Ray_u = 0.0 allocate(visc%Ray_v(isd:ied,JsdB:JedB,nz)) ; visc%Ray_v = 0.0 CS%id_Ray_u = register_diag_field('ocean_model', 'Rayleigh_u', diag%axesCuL, & - Time, 'Rayleigh drag velocity at u points', 'm s-1', conversion=US%Z_to_m) + Time, 'Rayleigh drag velocity at u points', 'm s-1', conversion=US%Z_to_m*US%s_to_T) CS%id_Ray_v = register_diag_field('ocean_model', 'Rayleigh_v', diag%axesCvL, & - Time, 'Rayleigh drag velocity at v points', 'm s-1', conversion=US%Z_to_m) + Time, 'Rayleigh drag velocity at v points', 'm s-1', conversion=US%Z_to_m*US%s_to_T) endif if (use_CVMix_ddiff .or. differential_diffusion) then diff --git a/src/parameterizations/vertical/MOM_vert_friction.F90 b/src/parameterizations/vertical/MOM_vert_friction.F90 index 3bcf99ca1a..47170fe169 100644 --- a/src/parameterizations/vertical/MOM_vert_friction.F90 +++ b/src/parameterizations/vertical/MOM_vert_friction.F90 @@ -266,7 +266,7 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, US, CS, & enddo ; endif ! direct_stress if (CS%Channel_drag) then ; do k=1,nz ; do I=Isq,Ieq - Ray(I,k) = US%T_to_s*visc%Ray_u(I,j,k) + Ray(I,k) = visc%Ray_u(I,j,k) enddo ; enddo ; endif ! perform forward elimination on the tridiagonal system @@ -374,7 +374,7 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, US, CS, & enddo ; endif ! direct_stress if (CS%Channel_drag) then ; do k=1,nz ; do i=is,ie - Ray(i,k) = US%T_to_s*visc%Ray_v(i,J,k) + Ray(i,k) = visc%Ray_v(i,J,k) enddo ; enddo ; endif do i=is,ie ; if (do_i(i)) then @@ -501,7 +501,7 @@ subroutine vertvisc_remnant(visc, visc_rem_u, visc_rem_v, dt, G, GV, US, CS) do I=Isq,Ieq ; do_i(I) = (G%mask2dCu(I,j) > 0) ; enddo if (CS%Channel_drag) then ; do k=1,nz ; do I=Isq,Ieq - Ray(I,k) = US%T_to_s*visc%Ray_u(I,j,k) + Ray(I,k) = visc%Ray_u(I,j,k) enddo ; enddo ; endif do I=Isq,Ieq ; if (do_i(I)) then @@ -532,7 +532,7 @@ subroutine vertvisc_remnant(visc, visc_rem_u, visc_rem_v, dt, G, GV, US, CS) do i=is,ie ; do_i(i) = (G%mask2dCv(i,J) > 0) ; enddo if (CS%Channel_drag) then ; do k=1,nz ; do i=is,ie - Ray(i,k) = US%T_to_s*visc%Ray_v(i,J,k) + Ray(i,k) = visc%Ray_v(i,J,k) enddo ; enddo ; endif do i=is,ie ; if (do_i(i)) then From 949f6222d931e01ba4d54670a0c23fbc2f8a845a Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 25 Jun 2019 06:58:05 -0400 Subject: [PATCH 36/82] Added dt_in_T to diabatic and legacy_diabatic Added a new internal timestep variable in time units, dt_in_T, to two routines in MOM_diabatic_driver.F90. It is anticipated that this variable will eventually disappear once the dimensional consistency testing for time is complete. Also applied dimensional rescaling in MOM_diapyc_energy_req. All answers are bitwise identical. --- .../vertical/MOM_diabatic_driver.F90 | 42 ++++++++++--------- .../vertical/MOM_diapyc_energy_req.F90 | 14 +++---- 2 files changed, 30 insertions(+), 26 deletions(-) diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index 2855e7460b..b1d8bf0974 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -378,6 +378,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & real :: Ent_int ! The diffusive entrainment rate at an interface [H ~> m or kg m-2] real :: dt_mix ! amount of time over which to apply mixing [s] real :: Idt ! inverse time step [s-1] + real :: dt_in_T ! The time step converted to T units [T ~> s] integer :: dir_flag ! An integer encoding the directions in which to do halo updates. logical :: showCallTree ! If true, show the call tree @@ -422,6 +423,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & if (dt < 0.0) call MOM_error(FATAL, "MOM_diabatic_driver: "// & "diabatic was called with a negative timestep.") Idt = 1.0 / dt + dt_in_T = dt * US%s_to_T if (.not. associated(CS)) call MOM_error(FATAL, "MOM_diabatic_driver: "// & "Module must be initialized before it is used.") @@ -433,7 +435,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & if (CS%debugConservation) call MOM_state_stats('Start of diabatic', u, v, h, tv%T, tv%S, G) if (CS%debug_energy_req) & - call diapyc_energy_req_test(h, dt, tv, G, GV, US, CS%diapyc_en_rec_CSp) + call diapyc_energy_req_test(h, dt_in_T, tv, G, GV, US, CS%diapyc_en_rec_CSp) call cpu_clock_begin(id_clock_set_diffusivity) @@ -669,7 +671,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & CS%use_CVMix_ddiff) then call cpu_clock_begin(id_clock_differential_diff) - call differential_diffuse_T_S(h, tv, visc, dt*US%s_to_T, G, GV) + call differential_diffuse_T_S(h, tv, visc, dt_in_T, G, GV) call cpu_clock_end(id_clock_differential_diff) if (showCallTree) call callTree_waypoint("done with differential_diffuse_T_S (diabatic)") @@ -737,7 +739,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & endif call find_uv_at_h(u, v, h, u_h, v_h, G, GV) - call energetic_PBL(h, u_h, v_h, tv, fluxes, US%s_to_T*dt, Kd_ePBL, G, GV, US, & + call energetic_PBL(h, u_h, v_h, tv, fluxes, dt_in_T, Kd_ePBL, G, GV, US, & CS%energetic_PBL_CSp, dSV_dT, dSV_dS, cTKE, SkinBuoyFlux, waves=waves) if (associated(Hml)) then @@ -839,9 +841,9 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & !$OMP parallel do default(shared) private(hval) do k=2,nz ; do j=js,je ; do i=is,ie hval = 1.0 / (h_neglect + 0.5*(h(i,j,k-1) + h(i,j,k))) - ea_t(i,j,k) = (GV%Z_to_H**2) * US%s_to_T*dt * hval * Kd_heat(i,j,k) + ea_t(i,j,k) = (GV%Z_to_H**2) * dt_in_T * hval * Kd_heat(i,j,k) eb_t(i,j,k-1) = ea_t(i,j,k) - ea_s(i,j,k) = (GV%Z_to_H**2) * US%s_to_T*dt * hval * Kd_salt(i,j,k) + ea_s(i,j,k) = (GV%Z_to_H**2) * dt_in_T * hval * Kd_salt(i,j,k) eb_s(i,j,k-1) = ea_s(i,j,k) enddo ; enddo ; enddo do j=js,je ; do i=is,ie @@ -925,7 +927,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & call cpu_clock_begin(id_clock_tracers) if (CS%mix_boundary_tracers) then - Tr_ea_BBL = GV%Z_to_H * sqrt(dt*US%s_to_T*CS%Kd_BBL_tr) + Tr_ea_BBL = GV%Z_to_H * sqrt(dt_in_T*CS%Kd_BBL_tr) !$OMP parallel do default(shared) private(htot,in_boundary,add_ent) do j=js,je do i=is,ie @@ -944,7 +946,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & ! in the calculation of the fluxes in the first place. Kd_min_tr ! should be much less than the values that have been set in Kd_lay, ! perhaps a molecular diffusivity. - add_ent = ((dt*US%s_to_T * CS%Kd_min_tr) * GV%Z_to_H**2) * & + add_ent = ((dt_in_T * CS%Kd_min_tr) * GV%Z_to_H**2) * & ((h(i,j,k-1)+h(i,j,k)+h_neglect) / & (h(i,j,k-1)*h(i,j,k)+h_neglect2)) - & 0.5*(ea_s(i,j,k) + eb_s(i,j,k-1)) @@ -962,7 +964,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & endif if (associated(visc%Kd_extra_S)) then ; if (visc%Kd_extra_S(i,j,k) > 0.0) then - add_ent = ((dt*US%s_to_T * visc%Kd_extra_S(i,j,k)) * GV%Z_to_H**2) / & + add_ent = ((dt_in_T * visc%Kd_extra_S(i,j,k)) * GV%Z_to_H**2) / & (0.5 * (h(i,j,k-1) + h(i,j,k)) + & h_neglect) ebtr(i,j,k-1) = ebtr(i,j,k-1) + add_ent @@ -988,7 +990,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & !$OMP parallel do default(shared) private(add_ent) do k=nz,2,-1 ; do j=js,je ; do i=is,ie if (visc%Kd_extra_S(i,j,k) > 0.0) then - add_ent = ((dt*US%s_to_T * visc%Kd_extra_S(i,j,k)) * GV%Z_to_H**2) / & + add_ent = ((dt_in_T * visc%Kd_extra_S(i,j,k)) * GV%Z_to_H**2) / & (0.5 * (h(i,j,k-1) + h(i,j,k)) + & h_neglect) else @@ -1234,6 +1236,7 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en real :: Ent_int ! The diffusive entrainment rate at an interface [H ~> m or kg m-2]. real :: dt_mix ! amount of time over which to apply mixing [s] real :: Idt ! inverse time step [s-1] + real :: dt_in_T ! The time step converted to T units [T ~> s] integer :: dir_flag ! An integer encoding the directions in which to do halo updates. logical :: showCallTree ! If true, show the call tree @@ -1275,6 +1278,7 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en if (dt < 0.0) call MOM_error(FATAL, "MOM_diabatic_driver: "// & "legacy_diabatic was called with a negative timestep.") Idt = 1.0 / dt + dt_in_T = dt * US%s_to_T if (.not. associated(CS)) call MOM_error(FATAL, "MOM_diabatic_driver: "// & "Module must be initialized before it is used.") @@ -1286,7 +1290,7 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en if (CS%debugConservation) call MOM_state_stats('Start of diabatic', u, v, h, tv%T, tv%S, G) if (CS%debug_energy_req) & - call diapyc_energy_req_test(h, dt, tv, G, GV, US, CS%diapyc_en_rec_CSp) + call diapyc_energy_req_test(h, dt_in_T, tv, G, GV, US, CS%diapyc_en_rec_CSp) call cpu_clock_begin(id_clock_set_diffusivity) call set_BBL_TKE(u, v, h, fluxes, visc, G, GV, US, CS%set_diff_CSp) @@ -1597,7 +1601,7 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en if (associated(visc%Kd_extra_T) .and. associated(visc%Kd_extra_S) .and. associated(tv%T)) then call cpu_clock_begin(id_clock_differential_diff) - call differential_diffuse_T_S(h, tv, visc, dt*US%s_to_T, G, GV) + call differential_diffuse_T_S(h, tv, visc, dt_in_T, G, GV) call cpu_clock_end(id_clock_differential_diff) if (showCallTree) call callTree_waypoint("done with differential_diffuse_T_S (diabatic)") if (CS%debugConservation) call MOM_state_stats('differential_diffuse_T_S', u, v, h, tv%T, tv%S, G) @@ -1627,7 +1631,7 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en !$OMP private(hval) do k=2,nz ; do j=js,je ; do i=is,ie hval=1.0/(h_neglect + 0.5*(h(i,j,k-1) + h(i,j,k))) - ea(i,j,k) = (GV%Z_to_H**2) * US%s_to_T*dt * hval * Kd_int(i,j,K) + ea(i,j,k) = (GV%Z_to_H**2) * dt_in_T * hval * Kd_int(i,j,K) eb(i,j,k-1) = ea(i,j,k) enddo ; enddo ; enddo do j=js,je ; do i=is,ie @@ -1641,7 +1645,7 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en call cpu_clock_begin(id_clock_entrain) ! Calculate appropriately limited diapycnal mass fluxes to account ! for diapycnal diffusion and advection. Sets: ea, eb. Changes: kb - call Entrainment_diffusive(h, tv, fluxes, US%s_to_T*dt, G, GV, US, CS%entrain_diffusive_CSp, & + call Entrainment_diffusive(h, tv, fluxes, dt_in_T, G, GV, US, CS%entrain_diffusive_CSp, & ea, eb, kb, Kd_lay=Kd_lay, Kd_int=Kd_int) call cpu_clock_end(id_clock_entrain) if (showCallTree) call callTree_waypoint("done with Entrainment_diffusive (diabatic)") @@ -1690,7 +1694,7 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en endif call find_uv_at_h(u, v, h, u_h, v_h, G, GV) - call energetic_PBL(h, u_h, v_h, tv, fluxes, US%s_to_T*dt, Kd_ePBL, G, GV, US, & + call energetic_PBL(h, u_h, v_h, tv, fluxes, dt_in_T, Kd_ePBL, G, GV, US, & CS%energetic_PBL_CSp, dSV_dT, dSV_dS, cTKE, SkinBuoyFlux, waves=waves) ! If visc%MLD exists, copy the ePBL's MLD into it @@ -1710,7 +1714,7 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en Kd_add_here = max(Kd_ePBL(i,j,K) - visc%Kd_shear(i,j,K), 0.0) visc%Kv_shear(i,j,K) = max(visc%Kv_shear(i,j,K), Kd_ePBL(i,j,K)) endif - Ent_int = Kd_add_here * (GV%Z_to_H**2 * US%s_to_T*dt) / & + Ent_int = Kd_add_here * (GV%Z_to_H**2 * dt_in_T) / & (0.5*(h(i,j,k-1) + h(i,j,k)) + h_neglect) eb(i,j,k-1) = eb(i,j,k-1) + Ent_int ea(i,j,k) = ea(i,j,k) + Ent_int @@ -2047,7 +2051,7 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en ! mixing of passive tracers from massless boundary layers to interior call cpu_clock_begin(id_clock_tracers) if (CS%mix_boundary_tracers) then - Tr_ea_BBL = sqrt(dt*US%s_to_T*CS%Kd_BBL_tr) !### I think this needs GV%Z_to_H + Tr_ea_BBL = sqrt(dt_in_T*CS%Kd_BBL_tr) !### I think this needs GV%Z_to_H !$OMP parallel do default(shared) private(htot,in_boundary,add_ent) do j=js,je do i=is,ie @@ -2066,7 +2070,7 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en ! in the calculation of the fluxes in the first place. Kd_min_tr ! should be much less than the values that have been set in Kd_lay, ! perhaps a molecular diffusivity. - add_ent = ((dt*US%s_to_T * CS%Kd_min_tr) * GV%Z_to_H**2) * & + add_ent = ((dt_in_T * CS%Kd_min_tr) * GV%Z_to_H**2) * & ((h(i,j,k-1)+h(i,j,k)+h_neglect) / & (h(i,j,k-1)*h(i,j,k)+h_neglect2)) - & 0.5*(ea(i,j,k) + eb(i,j,k-1)) @@ -2083,7 +2087,7 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en ebtr(i,j,k-1) = eb(i,j,k-1) ; eatr(i,j,k) = ea(i,j,k) endif if (associated(visc%Kd_extra_S)) then ; if (visc%Kd_extra_S(i,j,k) > 0.0) then - add_ent = ((dt*US%s_to_T * visc%Kd_extra_S(i,j,k)) * GV%Z_to_H**2) / & + add_ent = ((dt_in_T * visc%Kd_extra_S(i,j,k)) * GV%Z_to_H**2) / & (0.25 * ((h(i,j,k-1) + h(i,j,k)) + (hold(i,j,k-1) + hold(i,j,k))) + & h_neglect) ebtr(i,j,k-1) = ebtr(i,j,k-1) + add_ent @@ -2114,7 +2118,7 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en !$OMP parallel do default(shared) private(add_ent) do k=nz,2,-1 ; do j=js,je ; do i=is,ie if (visc%Kd_extra_S(i,j,k) > 0.0) then - add_ent = ((dt*US%s_to_T * visc%Kd_extra_S(i,j,k)) * GV%Z_to_H**2) / & + add_ent = ((dt_in_T * visc%Kd_extra_S(i,j,k)) * GV%Z_to_H**2) / & (0.25 * ((h(i,j,k-1) + h(i,j,k)) + (hold(i,j,k-1) + hold(i,j,k))) + & h_neglect) else diff --git a/src/parameterizations/vertical/MOM_diapyc_energy_req.F90 b/src/parameterizations/vertical/MOM_diapyc_energy_req.F90 index 3d9fb3c6c7..ff63d86ea9 100644 --- a/src/parameterizations/vertical/MOM_diapyc_energy_req.F90 +++ b/src/parameterizations/vertical/MOM_diapyc_energy_req.F90 @@ -55,17 +55,17 @@ subroutine diapyc_energy_req_test(h_3d, dt, tv, G, GV, US, CS, Kd_int) type(thermo_var_ptrs), intent(inout) :: tv !< A structure containing pointers to any !! available thermodynamic fields. !! Absent fields have NULL ptrs. - real, intent(in) :: dt !< The amount of time covered by this call [s]. + real, intent(in) :: dt !< The amount of time covered by this call [T ~> s]. type(diapyc_energy_req_CS), pointer :: CS !< This module's control structure. real, dimension(G%isd:G%ied,G%jsd:G%jed,GV%ke+1), & - optional, intent(in) :: Kd_int !< Interface diffusivities [Z2 s-1 ~> m2 s-1]. + optional, intent(in) :: Kd_int !< Interface diffusivities [Z2 T-1 ~> m2 s-1]. ! Local variables real, dimension(GV%ke) :: & T0, S0, & ! T0 & S0 are columns of initial temperatures and salinities [degC] and g/kg. h_col ! h_col is a column of thicknesses h at tracer points [H ~> m or kg m-2]. real, dimension(GV%ke+1) :: & - Kd, & ! A column of diapycnal diffusivities at interfaces [Z2 s-1 ~> m2 s-1]. + Kd, & ! A column of diapycnal diffusivities at interfaces [Z2 T-1 ~> m2 s-1]. h_top, h_bot ! Distances from the top or bottom [H ~> m or kg m-2]. real :: ustar, absf, htot real :: energy_Kd ! The energy used by diapycnal mixing [W m-2]. @@ -94,8 +94,8 @@ subroutine diapyc_energy_req_test(h_3d, dt, tv, G, GV, US, CS, Kd_int) h_bot(K) = h_bot(K+1) + h_col(k) enddo - ustar = 0.01*US%m_to_Z ! Change this to being an input parameter? - absf = 0.25*US%s_to_T*((abs(G%CoriolisBu(I-1,J-1)) + abs(G%CoriolisBu(I,J))) + & + ustar = 0.01*US%m_to_Z*US%T_to_s ! Change this to being an input parameter? + absf = 0.25*((abs(G%CoriolisBu(I-1,J-1)) + abs(G%CoriolisBu(I,J))) + & (abs(G%CoriolisBu(I-1,J-1)) + abs(G%CoriolisBu(I,J)))) Kd(1) = 0.0 ; Kd(nz+1) = 0.0 do K=2,nz @@ -127,8 +127,8 @@ subroutine diapyc_energy_req_calc(h_in, T_in, S_in, Kd, energy_Kd, dt, tv, & real, dimension(GV%ke), intent(in) :: T_in !< The layer temperatures [degC]. real, dimension(GV%ke), intent(in) :: S_in !< The layer salinities [ppt]. real, dimension(GV%ke+1), intent(in) :: Kd !< The interfaces diapycnal diffusivities - !! [Z2 s-1 ~> m2 s-1]. - real, intent(in) :: dt !< The amount of time covered by this call [s]. + !! [Z2 T-1 ~> m2 s-1]. + real, intent(in) :: dt !< The amount of time covered by this call [T ~> s]. real, intent(out) :: energy_Kd !< The column-integrated rate of energy !! consumption by diapycnal diffusion [W m-2]. type(thermo_var_ptrs), intent(inout) :: tv !< A structure containing pointers to any From 7d9651c67b40b37561afb18a8031df3af52ec0cf Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 25 Jun 2019 08:48:39 -0400 Subject: [PATCH 37/82] +Added dimensional testing for visc$ustar_BBL Added rescaling of time units for dimensional consistency testing of visc$ustar_BBL and some related internal variables in MOM_set_diffusivity.F90. All answers are bitwise identical. --- src/core/MOM_variables.F90 | 2 +- .../vertical/MOM_set_diffusivity.F90 | 14 +++++++------- 2 files changed, 8 insertions(+), 8 deletions(-) diff --git a/src/core/MOM_variables.F90 b/src/core/MOM_variables.F90 index fd9cc0378f..2202e53f32 100644 --- a/src/core/MOM_variables.F90 +++ b/src/core/MOM_variables.F90 @@ -205,7 +205,7 @@ module MOM_variables bbl_thick_v => NULL(), & !< The bottom boundary layer thickness at the v-points [Z ~> m]. kv_bbl_u => NULL(), & !< The bottom boundary layer viscosity at the u-points [Z2 T-1 ~> m2 s-1]. kv_bbl_v => NULL(), & !< The bottom boundary layer viscosity at the v-points [Z2 T-1 ~> m2 s-1]. - ustar_BBL => NULL() !< The turbulence velocity in the bottom boundary layer at h points [Z s-1 ~> m s-1]. + ustar_BBL => NULL() !< The turbulence velocity in the bottom boundary layer at h points [Z T-1 ~> m s-1]. real, pointer, dimension(:,:) :: TKE_BBL => NULL() !< A term related to the bottom boundary layer source of turbulent kinetic !! energy, currently in [Z3 T-3 ~> m3 s-3], but may at some time be changed diff --git a/src/parameterizations/vertical/MOM_set_diffusivity.F90 b/src/parameterizations/vertical/MOM_set_diffusivity.F90 index 7db244e111..a5012cd3e2 100644 --- a/src/parameterizations/vertical/MOM_set_diffusivity.F90 +++ b/src/parameterizations/vertical/MOM_set_diffusivity.F90 @@ -1181,7 +1181,7 @@ subroutine add_drag_diffusivity(h, u, v, tv, fluxes, visc, j, TKE_to_Kd, & ! Any turbulence that makes it into the mixed layers is assumed ! to be relatively small and is discarded. do i=is,ie - ustar_h = US%T_to_s * visc%ustar_BBL(i,j) + ustar_h = visc%ustar_BBL(i,j) if (associated(fluxes%ustar_tidal)) & ustar_h = ustar_h + (US%m_to_Z * US%T_to_s * fluxes%ustar_tidal(i,j)) absf = 0.25 * ((abs(G%CoriolisBu(I-1,J-1)) + abs(G%CoriolisBu(I,J))) + & @@ -1398,7 +1398,7 @@ subroutine add_LOTW_BBL_diffusivity(h, u, v, tv, fluxes, visc, j, N2_int, & (abs(G%CoriolisBu(I-1,J)) + abs(G%CoriolisBu(I,J-1)))) ! Non-zero on equator! ! u* at the bottom [m s-1]. - ustar = US%T_to_s * visc%ustar_BBL(i,j) + ustar = visc%ustar_BBL(i,j) ustar2 = ustar**2 ! In add_drag_diffusivity(), fluxes%ustar_tidal is added in. This might be double counting ! since ustar_BBL should already include all contributions to u*? -AJA @@ -1653,13 +1653,13 @@ subroutine set_BBL_TKE(u, v, h, fluxes, visc, G, GV, US, CS) real, dimension(SZIB_(G)) :: & uhtot, & ! running integral of u in the BBL [Z m s-1 ~> m2 s-1] - ustar, & ! bottom boundary layer turbulence speed [Z s-1 ~> m s-1]. + ustar, & ! bottom boundary layer turbulence speed [Z T-1 ~> m s-1]. u2_bbl ! square of the mean zonal velocity in the BBL [m2 s-2] real :: vhtot(SZI_(G)) ! running integral of v in the BBL [Z m s-1 ~> m2 s-1] real, dimension(SZI_(G),SZJB_(G)) :: & - vstar, & ! ustar at at v-points [Z s-1 ~> m s-1]. + vstar, & ! ustar at at v-points [Z T-1 ~> m s-1]. v2_bbl ! square of average meridional velocity in BBL [m2 s-2] real :: cdrag_sqrt ! square root of the drag coefficient [nondim] @@ -1694,7 +1694,7 @@ subroutine set_BBL_TKE(u, v, h, fluxes, visc, G, GV, US, CS) ! vertical decay scale. do i=is,ie ; if ((G%mask2dCv(i,J) > 0.5) .and. (cdrag_sqrt*visc%bbl_thick_v(i,J) > 0.0)) then do_i(i) = .true. ; vhtot(i) = 0.0 ; htot(i) = 0.0 - vstar(i,J) = US%s_to_T*visc%Kv_bbl_v(i,J) / (cdrag_sqrt*visc%bbl_thick_v(i,J)) + vstar(i,J) = visc%Kv_bbl_v(i,J) / (cdrag_sqrt*visc%bbl_thick_v(i,J)) else do_i(i) = .false. ; vstar(i,J) = 0.0 ; htot(i) = 0.0 endif ; enddo @@ -1724,7 +1724,7 @@ subroutine set_BBL_TKE(u, v, h, fluxes, visc, G, GV, US, CS) do j=js,je do I=is-1,ie ; if ((G%mask2dCu(I,j) > 0.5) .and. (cdrag_sqrt*visc%bbl_thick_u(I,j) > 0.0)) then do_i(I) = .true. ; uhtot(I) = 0.0 ; htot(I) = 0.0 - ustar(I) = US%s_to_T*visc%Kv_bbl_u(I,j) / (cdrag_sqrt*visc%bbl_thick_u(I,j)) + ustar(I) = visc%Kv_bbl_u(I,j) / (cdrag_sqrt*visc%bbl_thick_u(I,j)) else do_i(I) = .false. ; ustar(I) = 0.0 ; htot(I) = 0.0 endif ; enddo @@ -1755,7 +1755,7 @@ subroutine set_BBL_TKE(u, v, h, fluxes, visc, G, GV, US, CS) G%areaCu(I,j)*(ustar(I)*ustar(I))) + & (G%areaCv(i,J-1)*(vstar(i,J-1)*vstar(i,J-1)) + & G%areaCv(i,J)*(vstar(i,J)*vstar(i,J))) ) ) - visc%TKE_BBL(i,j) = US%T_to_s**3 * US%m_to_Z**2 * & + visc%TKE_BBL(i,j) = US%T_to_s**2 * US%m_to_Z**2 * & (((G%areaCu(I-1,j)*(ustar(I-1)*u2_bbl(I-1)) + & G%areaCu(I,j) * (ustar(I)*u2_bbl(I))) + & (G%areaCv(i,J-1)*(vstar(i,J-1)*v2_bbl(i,J-1)) + & From a61882338285d3393f32350c19b82ccdb7962ab0 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 25 Jun 2019 16:26:51 -0400 Subject: [PATCH 38/82] Partial dimensional testing in MOM_kappa_shear Added partial dimensional testing in time in MOM_kappa_shear, and modified the code so the DEBUG code and the ADD_DIAGNOSTICS code compile and work when these macros are enabled in the code. All answers are bitwise identical. --- .../vertical/MOM_kappa_shear.F90 | 395 ++++++++---------- 1 file changed, 180 insertions(+), 215 deletions(-) diff --git a/src/parameterizations/vertical/MOM_kappa_shear.F90 b/src/parameterizations/vertical/MOM_kappa_shear.F90 index b184790360..8612c19e8b 100644 --- a/src/parameterizations/vertical/MOM_kappa_shear.F90 +++ b/src/parameterizations/vertical/MOM_kappa_shear.F90 @@ -147,9 +147,9 @@ subroutine Calculate_kappa_shear(u_in, v_in, h, tv, p_surf, kappa_io, tke_io, & T0xdz, & ! The initial temperature times dz [degC Z ~> degC m]. S0xdz ! The initial salinity times dz [ppt Z ~> ppt m]. real, dimension(SZK_(GV)+1) :: & - kappa, & ! The shear-driven diapycnal diffusivity at an interface [Z2 s-1 ~> m2 s-1]. + kappa, & ! The shear-driven diapycnal diffusivity at an interface [Z2 T-1 ~> m2 s-1]. tke, & ! The Turbulent Kinetic Energy per unit mass at an interface [m2 s-2]. - kappa_avg, & ! The time-weighted average of kappa [Z2 s-1 ~> m2 s-1]. + kappa_avg, & ! The time-weighted average of kappa [Z2 T-1 ~> m2 s-1]. tke_avg ! The time-weighted average of TKE [m2 s-2]. real :: f2 ! The squared Coriolis parameter of each column [s-2]. real :: surface_pres ! The top surface pressure [Pa]. @@ -172,34 +172,18 @@ subroutine Calculate_kappa_shear(u_in, v_in, h, tv, p_surf, kappa_io, tke_io, & ! Diagnostics that should be deleted? #ifdef ADD_DIAGNOSTICS real, dimension(SZK_(GV)+1) :: & ! Additional diagnostics. - I_Ld2_1d + I_Ld2_1d, dz_Int_1d real, dimension(SZI_(G),SZK_(GV)+1) :: & ! 2-D versions of diagnostics. I_Ld2_2d, dz_Int_2d real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1) :: & ! 3-D versions of diagnostics. I_Ld2_3d, dz_Int_3d -#endif -#ifdef DEBUG - integer :: max_debug_itt ; parameter(max_debug_itt=20) - real :: wt(SZK_(GV)+1), wt_tot, I_wt_tot, wt_itt - real, dimension(SZK_(GV)+1) :: & - Ri_k, tke_prev, dtke, dkap, dtke_norm, & - ksrc_av ! The average through the iterations of k_src [s-1]. - real, dimension(SZK_(GV)+1,0:max_debug_itt) :: & - tke_it1, N2_it1, Sh2_it1, ksrc_it1, kappa_it1, kprev_it1 - real, dimension(SZK_(GV)+1,1:max_debug_itt) :: & - dkappa_it1, wt_it1, K_Q_it1, d_dkappa_it1, dkappa_norm - real, dimension(SZK_(GV),0:max_debug_itt) :: & - u_it1, v_it1, rho_it1, T_it1, S_it1 - real, dimension(0:max_debug_itt) :: & - dk_wt_it1, dkpos_wt_it1, dkneg_wt_it1, k_mag - real, dimension(max_debug_itt) :: dt_it1 #endif is = G%isc ; ie = G%iec; js = G%jsc ; je = G%jec ; nz = GV%ke use_temperature = .false. ; if (associated(tv%T)) use_temperature = .true. new_kappa = .true. ; if (present(initialize_all)) new_kappa = initialize_all - k0dt = dt*CS%kappa_0 + k0dt = dt*US%s_to_T*CS%kappa_0 dz_massless = 0.1*sqrt(k0dt) !$OMP parallel do default(private) shared(js,je,is,ie,nz,h,u_in,v_in,use_temperature,new_kappa, & @@ -293,50 +277,50 @@ subroutine Calculate_kappa_shear(u_in, v_in, h, tv, p_surf, kappa_io, tke_io, & (G%CoriolisBu(I,J-1)**2 + G%CoriolisBu(I-1,J)**2)) surface_pres = 0.0 ; if (associated(p_surf)) surface_pres = p_surf(i,j) - ! ---------------------------------------------------- + ! ---------------------------------------------------- I_Ld2_1d, dz_Int_1d + ! Set the initial guess for kappa, here defined at interfaces. ! ---------------------------------------------------- if (new_kappa) then - do K=1,nzc+1 ; kappa(K) = US%m_to_Z**2*1.0 ; enddo + do K=1,nzc+1 ; kappa(K) = US%m2_s_to_Z2_T*1.0 ; enddo else - do K=1,nzc+1 ; kappa(K) = US%s_to_T*kappa_2d(i,K) ; enddo + do K=1,nzc+1 ; kappa(K) = kappa_2d(i,K) ; enddo endif +#ifdef ADD_DIAGNOSTICS + call kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & + dz, u0xdz, v0xdz, T0xdz, S0xdz, kappa_avg, & + tke_avg, tv, CS, GV, US, I_Ld2_1d, dz_Int_1d) +#else call kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & dz, u0xdz, v0xdz, T0xdz, S0xdz, kappa_avg, & tke_avg, tv, CS, GV, US) +#endif ! call cpu_clock_begin(id_clock_setup) ! Extrapolate from the vertically reduced grid back to the original layers. if (nz == nzc) then do K=1,nz+1 - kappa_2d(i,K) = US%T_to_s*kappa_avg(K) + kappa_2d(i,K) = kappa_avg(K) !### Should this be tke_avg? tke_2d(i,K) = tke(K) enddo else do K=1,nz+1 if (kf(K) == 0.0) then - kappa_2d(i,K) = US%T_to_s*kappa_avg(kc(K)) + kappa_2d(i,K) = kappa_avg(kc(K)) tke_2d(i,K) = tke_avg(kc(K)) else - kappa_2d(i,K) = (1.0-kf(K)) * US%T_to_s*kappa_avg(kc(K)) + & - kf(K) * US%T_to_s*kappa_avg(kc(K)+1) + kappa_2d(i,K) = (1.0-kf(K)) * kappa_avg(kc(K)) + & + kf(K) * kappa_avg(kc(K)+1) tke_2d(i,K) = (1.0-kf(K)) * tke_avg(kc(K)) + & kf(K) * tke_avg(kc(K)+1) endif enddo endif #ifdef ADD_DIAGNOSTICS - I_Ld2_2d(i,1) = 0.0 ; dz_Int_2d(i,1) = dz_Int(1) - do K=2,nzc - I_Ld2_2d(i,K) = I_L2_bdry(K) + & - (N2(K) / CS%lambda**2 + f2) * Z2_to_L2 / (max(TKE(K),1e-30)) - dz_Int_2d(i,K) = dz_Int(K) - enddo - I_Ld2_2d(i,nzc+1) = 0.0 ; dz_Int_2d(i,nzc+1) = dz_Int(nzc+1) - do K=nzc+2,nz+1 - I_Ld2_2d(i,K) = 0.0 ; dz_Int_2d(i,K) = 0.0 + do K=1,nz+1 + I_Ld2_2d(i,K) = I_Ld2_1d(K) ; dz_Int_2d(i,K) = dz_Int_1d(K) enddo #endif ! call cpu_clock_end(id_clock_setup) @@ -344,8 +328,7 @@ subroutine Calculate_kappa_shear(u_in, v_in, h, tv, p_surf, kappa_io, tke_io, & do K=1,nz+1 kappa_2d(i,K) = 0.0 ; tke_2d(i,K) = 0.0 #ifdef ADD_DIAGNOSTICS - I_Ld2_2d(i,K) = 0.0 - dz_Int_2d(i,K) = dz_Int(K) + I_Ld2_2d(i,K) = 0.0 ; dz_Int_2d(i,K) = 0.0 #endif enddo endif ; enddo ! i-loop @@ -355,8 +338,7 @@ subroutine Calculate_kappa_shear(u_in, v_in, h, tv, p_surf, kappa_io, tke_io, & tke_io(i,j,K) = G%mask2dT(i,j) * tke_2d(i,K) kv_io(i,j,K) = ( G%mask2dT(i,j) * kappa_2d(i,K) ) * CS%Prandtl_turb #ifdef ADD_DIAGNOSTICS - I_Ld2_3d(i,j,K) = I_Ld2_2d(i,K) - dz_Int_3d(i,j,K) = dz_Int_2d(i,K) + I_Ld2_3d(i,j,K) = I_Ld2_2d(i,K) ; dz_Int_3d(i,j,K) = dz_Int_2d(i,K) #endif enddo ; enddo @@ -438,9 +420,9 @@ subroutine Calc_kappa_shear_vertex(u_in, v_in, h, T_in, S_in, tv, p_surf, kappa_ T0xdz, & ! The initial temperature times dz [degC Z ~> degC m]. S0xdz ! The initial salinity times dz [ppt Z ~> ppt m]. real, dimension(SZK_(GV)+1) :: & - kappa, & ! The shear-driven diapycnal diffusivity at an interface [Z2 s-1 ~> m2 s-1]. + kappa, & ! The shear-driven diapycnal diffusivity at an interface [Z2 T-1 ~> m2 s-1]. tke, & ! The Turbulent Kinetic Energy per unit mass at an interface [m2 s-2]. - kappa_avg, & ! The time-weighted average of kappa [Z2 s-1 ~> m2 s-1]. + kappa_avg, & ! The time-weighted average of kappa [Z2 T-1 ~> m2 s-1]. tke_avg ! The time-weighted average of TKE [m2 s-2]. real :: f2 ! The squared Coriolis parameter of each column [s-2]. real :: surface_pres ! The top surface pressure [Pa]. @@ -466,34 +448,18 @@ subroutine Calc_kappa_shear_vertex(u_in, v_in, h, T_in, S_in, tv, p_surf, kappa_ ! Diagnostics that should be deleted? #ifdef ADD_DIAGNOSTICS real, dimension(SZK_(GV)+1) :: & ! Additional diagnostics. - I_Ld2_1d + I_Ld2_1d, dz_Int_1d real, dimension(SZI_(G),SZK_(GV)+1) :: & ! 2-D versions of diagnostics. I_Ld2_2d, dz_Int_2d real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1) :: & ! 3-D versions of diagnostics. I_Ld2_3d, dz_Int_3d -#endif -#ifdef DEBUG - integer :: max_debug_itt ; parameter(max_debug_itt=20) - real :: wt(SZK_(GV)+1), wt_tot, I_wt_tot, wt_itt - real, dimension(SZK_(GV)+1) :: & - Ri_k, tke_prev, dtke, dkappa, dtke_norm, & - ksrc_av ! The average through the iterations of k_src [s-1]. - real, dimension(SZK_(GV)+1,0:max_debug_itt) :: & - tke_it1, N2_it1, Sh2_it1, ksrc_it1, kappa_it1, kprev_it1 - real, dimension(SZK_(GV)+1,1:max_debug_itt) :: & - dkappa_it1, wt_it1, K_Q_it1, d_dkappa_it1, dkappa_norm - real, dimension(SZK_(GV),0:max_debug_itt) :: & - u_it1, v_it1, rho_it1, T_it1, S_it1 - real, dimension(0:max_debug_itt) :: & - dk_wt_it1, dkpos_wt_it1, dkneg_wt_it1, k_mag - real, dimension(max_debug_itt) :: dt_it1 #endif isB = G%isc-1 ; ieB = G%iecB ; jsB = G%jsc-1 ; jeB = G%jecB ; nz = GV%ke use_temperature = .false. ; if (associated(tv%T)) use_temperature = .true. new_kappa = .true. ; if (present(initialize_all)) new_kappa = initialize_all - k0dt = dt*CS%kappa_0 + k0dt = dt*US%s_to_T*CS%kappa_0 dz_massless = 0.1*sqrt(k0dt) I_Prandtl = 0.0 ; if (CS%Prandtl_turb > 0.0) I_Prandtl = 1.0 / CS%Prandtl_turb @@ -622,46 +588,44 @@ subroutine Calc_kappa_shear_vertex(u_in, v_in, h, T_in, S_in, tv, p_surf, kappa_ ! Set the initial guess for kappa, here defined at interfaces. ! ---------------------------------------------------- if (new_kappa) then - do K=1,nzc+1 ; kappa(K) = US%m_to_Z**2*1.0 ; enddo + do K=1,nzc+1 ; kappa(K) = US%m2_s_to_Z2_T*1.0 ; enddo else - do K=1,nzc+1 ; kappa(K) = US%s_to_T*kappa_2d(I,K,J2) ; enddo + do K=1,nzc+1 ; kappa(K) = kappa_2d(I,K,J2) ; enddo endif +#ifdef ADD_DIAGNOSTICS + call kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & + dz, u0xdz, v0xdz, T0xdz, S0xdz, kappa_avg, & + tke_avg, tv, CS, GV, US, I_Ld2_1d, dz_Int_1d) +#else call kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & dz, u0xdz, v0xdz, T0xdz, S0xdz, kappa_avg, & tke_avg, tv, CS, GV, US) - +#endif ! call cpu_clock_begin(Id_clock_setup) ! Extrapolate from the vertically reduced grid back to the original layers. if (nz == nzc) then do K=1,nz+1 - kappa_2d(I,K,J2) = US%T_to_s*kappa_avg(K) + kappa_2d(I,K,J2) = kappa_avg(K) !### Should this be tke_avg? tke_2d(I,K) = tke(K) enddo else do K=1,nz+1 if (kf(K) == 0.0) then - kappa_2d(I,K,J2) = US%T_to_s*kappa_avg(kc(K)) + kappa_2d(I,K,J2) = kappa_avg(kc(K)) tke_2d(I,K) = tke_avg(kc(K)) else - kappa_2d(I,K,J2) = (1.0-kf(K)) * US%T_to_s*kappa_avg(kc(K)) + & - kf(K) * US%T_to_s*kappa_avg(kc(K)+1) + kappa_2d(I,K,J2) = (1.0-kf(K)) * kappa_avg(kc(K)) + & + kf(K) * kappa_avg(kc(K)+1) tke_2d(I,K) = (1.0-kf(K)) * tke_avg(kc(K)) + & kf(K) * tke_avg(kc(K)+1) endif enddo endif #ifdef ADD_DIAGNOSTICS - I_Ld2_2d(I,1) = 0.0 ; dz_Int_2d(I,1) = dz_Int(1) - do K=2,nzc - I_Ld2_2d(I,K) = I_L2_bdry(K) + & - (N2(K) / CS%lambda**2 + f2) * Z2_to_L2 / (max(TKE(K),1e-30)) - dz_Int_2d(I,K) = dz_Int(K) - enddo - I_Ld2_2d(I,nzc+1) = 0.0 ; dz_Int_2d(I,nzc+1) = dz_Int(nzc+1) - do K=nzc+2,nz+1 - I_Ld2_2d(I,K) = 0.0 ; dz_Int_2d(I,K) = 0.0 + do K=1,nz+1 + I_Ld2_2d(i,K) = I_Ld2_1d(K) ; dz_Int_2d(i,K) = dz_Int_1d(K) enddo #endif ! call cpu_clock_end(Id_clock_setup) @@ -669,8 +633,7 @@ subroutine Calc_kappa_shear_vertex(u_in, v_in, h, T_in, S_in, tv, p_surf, kappa_ do K=1,nz+1 kappa_2d(I,K,J2) = 0.0 ; tke_2d(I,K) = 0.0 #ifdef ADD_DIAGNOSTICS - I_Ld2_2d(I,K) = 0.0 - dz_Int_2d(I,K) = dz_Int(K) + I_Ld2_2d(I,K) = 0.0 ; dz_Int_2d(I,K) = 0.0 #endif enddo endif ; enddo ! i-loop @@ -679,8 +642,7 @@ subroutine Calc_kappa_shear_vertex(u_in, v_in, h, T_in, S_in, tv, p_surf, kappa_ tke_io(I,J,K) = G%mask2dBu(I,J) * tke_2d(I,K) kv_io(I,J,K) = ( G%mask2dBu(I,J) * kappa_2d(I,K,J2) ) * CS%Prandtl_turb #ifdef ADD_DIAGNOSTICS - I_Ld2_3d(I,J,K) = I_Ld2_2d(I,K) - dz_Int_3d(I,J,K) = dz_Int_2d(I,K) + I_Ld2_3d(I,J,K) = I_Ld2_2d(I,K) ; dz_Int_3d(I,J,K) = dz_Int_2d(I,K) #endif enddo ; enddo if (J>=G%jsc) then ; do K=1,nz+1 ; do i=G%isc,G%iec @@ -710,11 +672,11 @@ end subroutine Calc_kappa_shear_vertex !> This subroutine calculates shear-driven diffusivity and TKE in a single column subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & dz, u0xdz, v0xdz, T0xdz, S0xdz, kappa_avg, & - tke_avg, tv, CS, GV, US) + tke_avg, tv, CS, GV, US, I_Ld2_1d, dz_Int_1d) type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZK_(GV)+1), & - intent(inout) :: kappa !< The time-weighted average of kappa [Z2 s-1 ~> m2 s-1]. + intent(inout) :: kappa !< The time-weighted average of kappa [Z2 T-1 ~> m2 s-1]. real, dimension(SZK_(GV)+1), & intent(inout) :: tke !< The Turbulent Kinetic Energy per unit mass at !! an interface [m2 s-2]. @@ -732,7 +694,7 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & real, dimension(SZK_(GV)), & intent(in) :: S0xdz !< The initial salinity times dz [ppt Z ~> ppt m]. real, dimension(SZK_(GV)+1), & - intent(out) :: kappa_avg !< The time-weighted average of kappa [Z2 s-1 ~> m2 s-1]. + intent(out) :: kappa_avg !< The time-weighted average of kappa [Z2 T-1 ~> m2 s-1]. real, dimension(SZK_(GV)+1), & intent(out) :: tke_avg !< The time-weighted average of TKE [m2 s-2]. real, intent(in) :: dt !< Time increment [s]. @@ -741,6 +703,11 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & !! have NULL ptrs. type(Kappa_shear_CS), pointer :: CS !< The control structure returned by a previous !! call to kappa_shear_init. + real, dimension(SZK_(GV)+1), & + optional, intent(out) :: I_Ld2_1d !< The inverse of the squared mixing length [Z-2 ~> m-2]. + real, dimension(SZK_(GV)+1), & + optional, intent(out) :: dz_Int_1d !< The extent of a finite-volume space surrounding an interface, + !! as used in calculating kappa and TKE [Z ~> m]. real, dimension(nzc) :: & u, & ! The zonal velocity after a timestep of mixing [m s-1]. @@ -762,12 +729,12 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & a1, & ! a1 is the coupling between adjacent interfaces in the TKE, ! velocity, and density equations [Z s-1 ~> m s-1] or [Z ~> m] c1, & ! c1 is used in the tridiagonal (and similar) solvers. - k_src, & ! The shear-dependent source term in the kappa equation [s-1]. - kappa_src, & ! The shear-dependent source term in the kappa equation [s-1]. - kappa_out, & ! The kappa that results from the kappa equation [Z2 s-1 ~> m2 s-1]. - kappa_mid, & ! The average of the initial and predictor estimates of kappa [Z2 s-1 ~> m2 s-1]. + k_src, & ! The shear-dependent source term in the kappa equation [T-1 ~> s-1]. + kappa_src, & ! The shear-dependent source term in the kappa equation [T-1 ~> s-1]. + kappa_out, & ! The kappa that results from the kappa equation [Z2 T-1 ~> m2 s-1]. + kappa_mid, & ! The average of the initial and predictor estimates of kappa [Z2 T-1 ~> m2 s-1]. tke_pred, & ! The value of TKE from a predictor step [m2 s-2]. - kappa_pred, & ! The value of kappa from a predictor step [Z2 s-1 ~> m2 s-1]. + kappa_pred, & ! The value of kappa from a predictor step [Z2 T-1 ~> m2 s-1]. pressure, & ! The pressure at an interface [Pa]. T_int, & ! The temperature interpolated to an interface [degC]. Sal_int, & ! The salinity interpolated to an interface [ppt]. @@ -775,15 +742,15 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & dbuoy_dS, & ! and salinity, [Z s-2 degC-1 ~> m s-2 degC-1] and [Z s-2 ppt-1 ~> m s-2 ppt-1]. I_L2_bdry, & ! The inverse of the square of twice the harmonic mean ! distance to the top and bottom boundaries [Z-2 ~> m-2]. - K_Q, & ! Diffusivity divided by TKE [Z2 m-2 s ~> s]. - K_Q_tmp, & ! A temporary copy of diffusivity divided by TKE [Z2 m-2 s ~> s]. + K_Q, & ! Diffusivity divided by TKE [Z2 m-2 s2 T-1 ~> s]. + K_Q_tmp, & ! A temporary copy of diffusivity divided by TKE [Z2 m-2 s2 T-1 ~> s]. local_src_avg, & ! The time-integral of the local source [nondim]. - tol_min, & ! Minimum tolerated ksrc for the corrector step [s-1]. - tol_max, & ! Maximum tolerated ksrc for the corrector step [s-1]. - tol_chg, & ! The tolerated change integrated in time [nondim]. + tol_min, & ! Minimum tolerated ksrc for the corrector step [T-1 ~> s-1]. + tol_max, & ! Maximum tolerated ksrc for the corrector step [T-1 ~> s-1]. + tol_chg, & ! The tolerated change integrated in time [s T-nondim]. dist_from_top, & ! The distance from the top surface [Z ~> m]. local_src ! The sum of all sources of kappa, including kappa_src and - ! sources from the elliptic term [s-1]. + ! sources from the elliptic term [T-1 ~> s-1]. real :: dist_from_bot ! The distance from the bottom surface [Z ~> m]. real :: b1 ! The inverse of the pivot in the tridiagonal equations. @@ -802,7 +769,7 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & real :: dt_wt ! The fractional weight of the current iteration [nondim]. real :: dt_test ! A time-step that is being tested for whether it ! gives acceptably small changes in k_src [s]. - real :: Idtt ! Idtt = 1 / dt_test [s-1]. + real :: Idtt ! Idtt = 1 / dt_test [T-1 ~> s-1]. real :: dt_inc ! An increment to dt_test that is being tested [s]. real :: k0dt ! The background diffusivity times the timestep [Z2 ~> m2]. @@ -818,10 +785,27 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & ! to estimate the maximum permitted time step. I.e., ! the resolution is 1/2^dt_refinements. integer :: k, itt, itt_dt +#ifdef DEBUG + integer :: max_debug_itt ; parameter(max_debug_itt=20) + real :: wt(SZK_(GV)+1), wt_tot, I_wt_tot, wt_itt + real, dimension(SZK_(GV)+1) :: & + Ri_k, tke_prev, dtke, dkappa, dtke_norm, & + N2_debug, & ! A version of N2 for debugging [s-2] + ksrc_av ! The average through the iterations of k_src [T-1 ~> s-1]. + real, dimension(SZK_(GV)+1,0:max_debug_itt) :: & + tke_it1, N2_it1, Sh2_it1, ksrc_it1, kappa_it1, kprev_it1 + real, dimension(SZK_(GV)+1,1:max_debug_itt) :: & + dkappa_it1, wt_it1, K_Q_it1, d_dkappa_it1, dkappa_norm + real, dimension(SZK_(GV),0:max_debug_itt) :: & + u_it1, v_it1, rho_it1, T_it1, S_it1 + real, dimension(0:max_debug_itt) :: & + dk_wt_it1, dkpos_wt_it1, dkneg_wt_it1, k_mag + real, dimension(max_debug_itt) :: dt_it1 +#endif Ri_crit = CS%Rino_crit gR0 = GV%Rho0*(GV%g_Earth*US%m_to_Z) ; g_R0 = (GV%g_Earth*US%m_to_Z**2)/GV%Rho0 - k0dt = dt*CS%kappa_0 + k0dt = dt*US%s_to_T*CS%kappa_0 ! These are hard-coded for now. Perhaps these could be made dynamic later? ! tol_dksrc = 0.5*tol_ksrc_chg ; tol_dksrc_low = 1.0 - 1.0/tol_ksrc_chg ? tol_dksrc = 10.0 ; tol_dksrc_low = 0.95 ; tol2 = 2.0*CS%kappa_tol_err @@ -895,10 +879,6 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & enddo dz_Int(nzc) = dz_Int(nzc) + dz(nzc) ; dz_Int(nzc+1) = 0.0 -#ifdef ADD_DIAGNOSTICS - do K=1,nzc+1 ; I_Ld2_1d(K) = 0.0 ; enddo -#endif - dist_from_bot = 0.0 do K=nzc,2,-1 dist_from_bot = dist_from_bot + dz(k) @@ -925,11 +905,11 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & endif #ifdef DEBUG - N2(1) = 0.0 ; N2(nzc+1) = 0.0 + N2_debug(1) = 0.0 ; N2_debug(nzc+1) = 0.0 do K=2,nzc - N2(K) = max((dbuoy_dT(K) * (T0xdz(k-1)*Idz(k-1) - T0xdz(k)*Idz(k)) + & - dbuoy_dS(K) * (S0xdz(k-1)*Idz(k-1) - S0xdz(k)*Idz(k))) * & - I_dz_int(K), 0.0) + N2_debug(K) = max((dbuoy_dT(K) * (T0xdz(k-1)*Idz(k-1) - T0xdz(k)*Idz(k)) + & + dbuoy_dS(K) * (S0xdz(k-1)*Idz(k-1) - S0xdz(k)*Idz(k))) * & + I_dz_int(K), 0.0) enddo do k=1,nzc u_it1(k,0) = u0xdz(k)*Idz(k) ; v_it1(k,0) = v0xdz(k)*Idz(k) @@ -938,9 +918,9 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & do K=1,nzc+1 kprev_it1(K,0) = kappa(K) ; kappa_it1(K,0) = kappa(K) tke_it1(K,0) = tke(K) - N2_it1(K,0) = N2(K) ; Sh2_it1(K,0) = S2(K) ; ksrc_it1(K,0) = k_src(K) + N2_it1(K,0) = N2_debug(K) ; Sh2_it1(K,0) = S2(K) ; ksrc_it1(K,0) = K_src(K) enddo - do k=nzc+1,nz + do k=nzc+1,GV%ke u_it1(k,0) = 0.0 ; v_it1(k,0) = 0.0 T_it1(k,0) = 0.0 ; S_it1(k,0) = 0.0 kprev_it1(K+1,0) = 0.0 ; kappa_it1(K+1,0) = 0.0 ; tke_it1(K+1,0) = 0.0 @@ -948,12 +928,12 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & enddo do itt=1,max_debug_itt dt_it1(itt) = 0.0 - do k=1,nz + do k=1,GV%ke u_it1(k,itt) = 0.0 ; v_it1(k,itt) = 0.0 T_it1(k,itt) = 0.0 ; S_it1(k,itt) = 0.0 rho_it1(k,itt) = 0.0 enddo - do K=1,nz+1 + do K=1,GV%ke+1 kprev_it1(K,itt) = 0.0 ; kappa_it1(K,itt) = 0.0 ; tke_it1(K,itt) = 0.0 N2_it1(K,itt) = 0.0 ; Sh2_it1(K,itt) = 0.0 ksrc_it1(K,itt) = 0.0 @@ -961,7 +941,7 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & K_Q_it1(K,itt) = 0.0 ; d_dkappa_it1(K,itt) = 0.0 enddo enddo - do K=1,nz+1 ; ksrc_av(K) = 0.0 ; enddo + do K=1,GV%ke+1 ; ksrc_av(K) = 0.0 ; enddo #endif ! This call just calculates N2 and S2. @@ -1040,13 +1020,13 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & GV, US, N2, S2, ks_int=ks_kappa, ke_int=ke_kappa, & vel_underflow=CS%vel_underflow) valid_dt = .true. - Idtt = 1.0 / dt_test + Idtt = 1.0 / (US%s_to_T*dt_test) do K=max(ks_kappa-1,2),min(ke_kappa+1,nzc) if (N2(K) < Ri_crit * S2(K)) then ! Equivalent to Ri < Ri_crit. - k_src(K) = (2.0 * CS%Shearmix_rate * sqrt(S2(K))) * & + K_src(K) = US%T_to_s*(2.0 * CS%Shearmix_rate * sqrt(S2(K))) * & ((Ri_crit*S2(K) - N2(K)) / (Ri_crit*S2(K) + CS%FRi_curvature*N2(K))) - if ((k_src(K) > max(tol_max(K), kappa_src(K) + Idtt*tol_chg(K))) .or. & - (k_src(K) < min(tol_min(K), kappa_src(K) - Idtt*tol_chg(K)))) then + if ((K_src(K) > max(tol_max(K), kappa_src(K) + Idtt*tol_chg(K))) .or. & + (K_src(K) < min(tol_min(K), kappa_src(K) - Idtt*tol_chg(K)))) then valid_dt = .false. ; exit endif else @@ -1066,14 +1046,14 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & nzc, dz, I_dz_int, dbuoy_dT, dbuoy_dS, u_test, v_test, T_test, S_test, & GV, US, N2, S2, ks_int=ks_kappa, ke_int=ke_kappa, vel_underflow=CS%vel_underflow) valid_dt = .true. - Idtt = 1.0 / (dt_test+dt_inc) + Idtt = 1.0 / (US%s_to_T*(dt_test+dt_inc)) do K=max(ks_kappa-1,2),min(ke_kappa+1,nzc) if (N2(K) < Ri_crit * S2(K)) then ! Equivalent to Ri < Ri_crit. - k_src(K) = (2.0 * CS%Shearmix_rate * sqrt(S2(K))) * & + K_src(K) = US%T_to_s*(2.0 * CS%Shearmix_rate * sqrt(S2(K))) * & ((Ri_crit*S2(K) - N2(K)) / & (Ri_crit*S2(K) + CS%FRi_curvature*N2(K))) - if ((k_src(K) > max(tol_max(K), kappa_src(K) + Idtt*tol_chg(K))) .or. & - (k_src(K) < min(tol_min(K), kappa_src(K) - Idtt*tol_chg(K)))) then + if ((K_src(K) > max(tol_max(K), kappa_src(K) + Idtt*tol_chg(K))) .or. & + (K_src(K) < min(tol_min(K), kappa_src(K) - Idtt*tol_chg(K)))) then valid_dt = .false. ; exit endif else @@ -1090,9 +1070,9 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & dt_inc = 0.0 endif - dt_now = min(dt_test*(1.0+CS%kappa_tol_err)+dt_inc,dt_rem) + dt_now = min(dt_test*(1.0+CS%kappa_tol_err)+dt_inc,dt_rem) do K=2,nzc - local_src_avg(K) = local_src_avg(K) + dt_now * local_src(K) + local_src_avg(K) = local_src_avg(K) + dt_now*US%s_to_T * local_src(K) enddo endif ! Are all the values of kappa_out 0? ! call cpu_clock_end(id_clock_project) @@ -1173,7 +1153,7 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & k_mag(itt) = 0.0 wt_itt = 1.0/real(itt) ; wt_tot = 0.0 do K=1,nzc+1 - ksrc_av(K) = (1.0-wt_itt)*ksrc_av(K) + wt_itt*k_src(K) + ksrc_av(K) = (1.0-wt_itt)*ksrc_av(K) + wt_itt*K_src(K) wt_tot = wt_tot + dz_Int(K) * ksrc_av(K) enddo ! Use the 1/0=0 convention. @@ -1184,7 +1164,7 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & k_mag(itt) = k_mag(itt) + wt(K)*kappa_mid(K) dkappa_it1(K,itt) = kappa_pred(K) - kappa_out(K) dk_wt_it1(itt) = dk_wt_it1(itt) + wt(K)*dkappa_it1(K,itt) - if (dk > 0.0) then + if (dkappa_it1(K,itt) > 0.0) then dkpos_wt_it1(itt) = dkpos_wt_it1(itt) + wt(K)*dkappa_it1(K,itt) else dkneg_wt_it1(itt) = dkneg_wt_it1(itt) + wt(K)*dkappa_it1(K,itt) @@ -1196,7 +1176,7 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & Ri_k(K) = 1e3 ; if (N2(K) < 1e3 * S2(K)) Ri_k(K) = N2(K) / S2(K) dtke(K) = tke_pred(K) - tke(K) dtke_norm(K) = dtke(K) / (0.5*(tke(K) + tke_pred(K))) - dkap(K) = kappa_pred(K) - kappa_out(K) + dkappa(K) = kappa_pred(K) - kappa_out(K) enddo if (itt <= max_debug_itt) then do k=1,nzc @@ -1204,8 +1184,8 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & T_it1(k,itt) = T(k) ; S_it1(k,itt) = Sal(k) enddo do K=1,nzc+1 - kprev_it1(K,itt)=kappa_out(K) - kappa_it1(K,itt)=kappa_mid(K) ; tke_it1(K,itt) = 0.5*(tke(K)+tke_pred(K)) + kprev_it1(K,itt) = kappa_out(K) + kappa_it1(K,itt) = kappa_mid(K) ; tke_it1(K,itt) = 0.5*(tke(K)+tke_pred(K)) N2_it1(K,itt)=N2(K) ; Sh2_it1(K,itt)=S2(K) ksrc_it1(K,itt) = kappa_src(K) K_Q_it1(K,itt) = kappa_out(K) / (TKE(K)) @@ -1213,7 +1193,7 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & if (abs(dkappa_it1(K,itt-1)) > 1e-20) & d_dkappa_it1(K,itt) = dkappa_it1(K,itt) / dkappa_it1(K,itt-1) endif - dkappa_norm(K,itt) = dkap(K) / max(0.5*(kappa_pred(K) + kappa_out(K)), US%m_to_Z**2*1e-100) + dkappa_norm(K,itt) = dkappa(K) / max(0.5*(kappa_pred(K) + kappa_out(K)), US%m2_s_to_Z2_T*1e-100) enddo endif #endif @@ -1222,6 +1202,19 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & enddo ! end itt loop +#ifdef ADD_DIAGNOSTICS + if (present(I_Ld2_1d)) then + do K=1,GV%ke+1 ; I_Ld2_1d(K) = 0.0 ; enddo + do K=2,nzc ; if (TKE(K) > 0.0) & + I_Ld2_1d(K) = I_L2_bdry(K) + (N2(K) / CS%lambda**2 + f2) * US%Z_to_m**2 / TKE(K) + enddo + endif + if (present(dz_Int_1d)) then + do K=1,nzc+1 ; dz_Int_1d(K) = dz_Int(K) ; enddo + do K=nzc+2,GV%ke ; dz_Int_1d(K) = 0.0 ; enddo + endif +#endif + end subroutine kappa_shear_column !> This subroutine calculates the velocities, temperature and salinity that @@ -1233,7 +1226,7 @@ subroutine calculate_projected_state(kappa, u0, v0, T0, S0, dt, nz, & integer, intent(in) :: nz !< The number of layers (after eliminating massless !! layers?). real, dimension(nz+1), intent(in) :: kappa !< The diapycnal diffusivity at interfaces, - !! [Z2 s-1 ~> m2 s-1]. + !! [Z2 T-1 ~> m2 s-1]. real, dimension(nz), intent(in) :: u0 !< The initial zonal velocity [m s-1]. real, dimension(nz), intent(in) :: v0 !< The initial meridional velocity [m s-1]. real, dimension(nz), intent(in) :: T0 !< The initial temperature [degC]. @@ -1279,7 +1272,7 @@ subroutine calculate_projected_state(kappa, u0, v0, T0, S0, dt, nz, & if (ks > ke) return if (dt > 0.0) then - a_b = dt*(kappa(ks+1)*I_dz_int(ks+1)) + a_b = dt*US%s_to_T*(kappa(ks+1)*I_dz_int(ks+1)) b1 = 1.0 / (dz(ks) + a_b) c1(ks+1) = a_b * b1 ; d1 = dz(ks) * b1 ! = 1 - c1 @@ -1287,7 +1280,7 @@ subroutine calculate_projected_state(kappa, u0, v0, T0, S0, dt, nz, & T(ks) = (b1 * dz(ks))*T0(ks) ; Sal(ks) = (b1 * dz(ks))*S0(ks) do K=ks+1,ke-1 a_a = a_b - a_b = dt*(kappa(K+1)*I_dz_int(K+1)) + a_b = dt*US%s_to_T*(kappa(K+1)*I_dz_int(K+1)) bd1 = dz(k) + d1*a_a b1 = 1.0 / (bd1 + a_b) c1(K+1) = a_b * b1 ; d1 = bd1 * b1 ! d1 = 1 - c1 @@ -1310,7 +1303,7 @@ subroutine calculate_projected_state(kappa, u0, v0, T0, S0, dt, nz, & ! tracers and velocities if the mixing is separated from the bottom, but if ! the mixing goes all the way to the bottom, use no-slip BCs for velocities. if (ke == nz) then - a_b = dt*(kappa(nz+1)*I_dz_int(nz+1)) + a_b = dt*US%s_to_T*(kappa(nz+1)*I_dz_int(nz+1)) b1nz_0 = 1.0 / ((dz(nz) + d1*a_a) + a_b) else b1nz_0 = b1 @@ -1371,7 +1364,7 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, & real, dimension(nz+1), intent(in) :: N2 !< The buoyancy frequency squared at interfaces [s-2]. real, dimension(nz+1), intent(in) :: S2 !< The squared shear at interfaces [s-2]. real, dimension(nz+1), intent(in) :: kappa_in !< The initial guess at the diffusivity - !! [Z2 s-1 ~> m2 s-1]. + !! [Z2 T-1 ~> m2 s-1]. real, dimension(nz+1), intent(in) :: dz_Int !< The thicknesses associated with interfaces !! [Z-1 ~> m-1]. real, dimension(nz+1), intent(in) :: I_L2_bdry !< The inverse of the squared distance to @@ -1383,16 +1376,16 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, & type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(nz+1), intent(inout) :: K_Q !< The shear-driven diapycnal diffusivity divided by !! the turbulent kinetic energy per unit mass at - !! interfaces [s]. + !! interfaces [Z2 m-2 s2 T-1 ~> s]. real, dimension(nz+1), intent(out) :: tke !< The turbulent kinetic energy per unit mass at !! interfaces [m2 s-2]. real, dimension(nz+1), intent(out) :: kappa !< The diapycnal diffusivity at interfaces - !! [Z2 s-1 ~> m2 s-1]. + !! [Z2 T-1 ~> m2 s-1]. real, dimension(nz+1), optional, & - intent(out) :: kappa_src !< The source term for kappa [s-1]. + intent(out) :: kappa_src !< The source term for kappa [T-1]. real, dimension(nz+1), optional, & intent(out) :: local_src !< The sum of all local sources for kappa, - !! [s-1]. + !! [T-1 ~> s-1]. ! This subroutine calculates new, consistent estimates of TKE and kappa. ! Local variables @@ -1400,14 +1393,13 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, & aQ, & ! aQ is the coupling between adjacent interfaces in the TKE equations [m s-1]. dQdz ! Half the partial derivative of TKE with depth [m s-2]. real, dimension(nz+1) :: & - dK, & ! The change in kappa [Z2 s-1 ~> m2 s-1]. + dK, & ! The change in kappa [Z2 T-1 ~> m2 s-1]. dQ, & ! The change in TKE [m2 s-2]. cQ, cK, & ! cQ and cK are the upward influences in the tridiagonal and ! hexadiagonal solvers for the TKE and kappa equations [nondim]. - I_Ld2, & ! 1/Ld^2, where Ld is the effective decay length scale - ! for kappa [Z-2 ~> m-2]. + I_Ld2, & ! 1/Ld^2, where Ld is the effective decay length scale for kappa [Z-2 ~> m-2]. TKE_decay, & ! The local TKE decay rate [s-1]. - k_src, & ! The source term in the kappa equation [s-1]. + k_src, & ! The source term in the kappa equation [T-1 ~> s-1]. dQmdK, & ! With Newton's method the change in dQ(k-1) due to dK(k) [m2 s Z-2 ~> s]. dKdQ, & ! With Newton's method the change in dK(k) due to dQ(k) [Z2 m-2 s-1 ~> s-1]. e1 ! The fractional change in a layer TKE due to a change in the @@ -1430,16 +1422,15 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, & real :: Ilambda2 ! 1.0 / CS%lambda**2 [nondim] real :: TKE_min ! The minimum value of shear-driven TKE that can be ! solved for [m2 s-2]. - real :: kappa0 ! The background diapycnal diffusivity [Z2 s-1 ~> m2 s-1]. - real :: max_err ! The maximum value of norm_err in a column [nondim]. - real :: kappa_trunc ! Diffusivities smaller than this are rounded to 0 [Z2 s-1 ~> m2 s-1]. + real :: kappa0 ! The background diapycnal diffusivity [Z2 T-1 ~> m2 s-1]. + real :: kappa_trunc ! Diffusivities smaller than this are rounded to 0 [Z2 T-1 ~> m2 s-1]. real :: eden1, eden2, I_eden, ome ! Variables used in calculating e1. - real :: diffusive_src ! The diffusive source in the kappa equation [m s-1]. + real :: diffusive_src ! The diffusive source in the kappa equation [m T-1 ~> m s-1]. real :: chg_by_k0 ! The value of k_src that leads to an increase of - ! kappa_0 if only the diffusive term is a sink [s-1]. + ! kappa_0 if only the diffusive term is a sink [T-1 ~> s-1]. - real :: kappa_mean ! A mean value of kappa [Z2 s-1 ~> m2 s-1]. + real :: kappa_mean ! A mean value of kappa [Z2 T-1 ~> m2 s-1]. real :: Newton_test ! The value of relative error that will cause the next ! iteration to use Newton's method. ! Temporary variables used in the Newton's method iterations. @@ -1474,14 +1465,12 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, & integer :: max_debug_itt ; parameter(max_debug_itt=20) real :: K_err_lin, Q_err_lin real, dimension(nz+1) :: & - kappa_prev, & ! The value of kappa at the start of the current iteration [Z2 s-1 ~> m2 s-1]. + I_Ld2_debug, & ! A separate version of I_Ld2 for debugging [Z-2 ~> m-2]. + kappa_prev, & ! The value of kappa at the start of the current iteration [Z2 T-1 ~> m2 s-1]. TKE_prev ! The value of TKE at the start of the current iteration [m2 s-2]. real, dimension(nz+1,1:max_debug_itt) :: & tke_it1, kappa_it1, kprev_it1, & ! Various values from each iteration. dkappa_it1, K_Q_it1, d_dkappa_it1, dkappa_norm_it1 - real :: norm_err ! The absolute change in kappa between iterations, - ! normalized by the value of kappa [nondim]. - real :: max_TKE_err, min_TKE_err, TKE_err(nz) ! Various normalized TKE changes. integer :: it2 #endif @@ -1503,7 +1492,7 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, & ! Ri = N2(K) / S2(K) ! k_src(K) = (2.0 * CS%Shearmix_rate * sqrt(S2(K))) * & ! ((Ri_crit - Ri) / (Ri_crit + CS%FRi_curvature*Ri)) - k_src(K) = (2.0 * CS%Shearmix_rate * sqrt(S2(K))) * & + K_src(K) = US%T_to_s*(2.0 * CS%Shearmix_rate * sqrt(S2(K))) * & ((Ri_crit*S2(K) - N2(K)) / (Ri_crit*S2(K) + CS%FRi_curvature*N2(K))) ke_src = K if (ks_src > k) ks_src = K @@ -1538,7 +1527,7 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, & ! Calculate the term (e1) that allows changes in TKE to be calculated quickly ! below the deepest nonzero value of kappa. If kappa = 0, below interface ! k-1, the final changes in TKE are related by dQ(K+1) = e1(K+1)*dQ(K). - eden2 = kappa0 * Idz(nz) + eden2 = US%s_to_T*kappa0 * Idz(nz) if (tke_noflux_bottom_BC) then eden1 = dz_Int(nz+1)*TKE_decay(nz+1) I_eden = 1.0 / (eden2 + eden1) @@ -1548,7 +1537,7 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, & endif do k=nz,2,-1 eden1 = dz_Int(K)*TKE_decay(K) + ome * eden2 - eden2 = kappa0 * Idz(k-1) + eden2 = US%s_to_T*kappa0 * Idz(k-1) I_eden = 1.0 / (eden2 + eden1) e1(K) = eden2 * I_eden ; ome = eden1 * I_eden ! = 1-e1 enddo @@ -1575,11 +1564,11 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, & ke_tke = max(ke_kappa,ke_kappa_prev)+1 ! aQ is the coupling between adjacent interfaces [Z s-1 ~> m s-1]. do k=1,min(ke_tke,nz) - aQ(k) = (0.5*(kappa(K)+kappa(K+1)) + kappa0) * Idz(k) + aQ(k) = US%s_to_T*(0.5*(kappa(K)+kappa(K+1)) + kappa0) * Idz(k) enddo dQ(1) = -TKE(1) if (tke_noflux_top_BC) then - tke_src = Z2_to_L2*kappa0*S2(1) + q0 * TKE_decay(1) ! Uses that kappa(1) = 0 + tke_src = Z2_to_L2*US%s_to_T*kappa0*S2(1) + q0 * TKE_decay(1) ! Uses that kappa(1) = 0 bd1 = dz_Int(1) * TKE_decay(1) bQ = 1.0 / (bd1 + aQ(1)) tke(1) = bQ * (dz_Int(1)*tke_src) @@ -1589,8 +1578,8 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, & endif do K=2,ke_tke-1 dQ(K) = -TKE(K) - tke_src = Z2_to_L2*(kappa(K) + kappa0)*S2(K) + q0*TKE_decay(K) - bd1 = dz_Int(K)*(TKE_decay(K) + N2(K)*Z2_to_L2*K_Q(K)) + cQcomp*aQ(k-1) + tke_src = Z2_to_L2*US%s_to_T*(kappa(K) + kappa0)*S2(K) + q0*TKE_decay(K) + bd1 = dz_Int(K)*(TKE_decay(K) + N2(K)*Z2_to_L2*US%s_to_T*K_Q(K)) + cQcomp*aQ(k-1) bQ = 1.0 / (bd1 + aQ(k)) tke(K) = bQ * (dz_Int(K)*tke_src + aQ(k-1)*tke(K-1)) cQ(K+1) = aQ(k) * bQ ; cQcomp = bd1 * bQ ! = 1 - cQ @@ -1600,7 +1589,7 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, & dQ(nz+1) = 0.0 else k = ke_tke - tke_src = Z2_to_L2*kappa0*S2(K) + q0*TKE_decay(K) ! Uses that kappa(ke_tke) = 0 + tke_src = Z2_to_L2*US%s_to_T*kappa0*S2(K) + q0*TKE_decay(K) ! Uses that kappa(ke_tke) = 0 if (K == nz+1) then dQ(K) = -TKE(K) bQ = 1.0 / (dz_Int(K)*TKE_decay(K) + cQcomp*aQ(k-1)) @@ -1652,7 +1641,7 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, & bd1 = dz_Int(K)*I_Ld2(K) + cKcomp*Idz(k-1) bK = 1.0 / (bd1 + Idz(k)) - kappa(K) = bK * (Idz(k-1)*kappa(K-1) + dz_Int(K) * k_src(K)) + kappa(K) = bK * (Idz(k-1)*kappa(K-1) + dz_Int(K) * K_src(K)) cK(K+1) = Idz(k) * bK ; cKcomp = bd1 * bK ! = 1 - cK(K+1) ! Neglect values that are smaller than kappa_trunc. @@ -1689,10 +1678,10 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, & ks_kappa_prev = ks_kappa ; ke_kappa_prev = ke_kappa ; ke_kappa = nz ks_kappa = 2 dK(1) = 0.0 ; cK(2) = 0.0 ; cKcomp = 1.0 ; dKdQ(1) = 0.0 - aQ(1) = (0.5*(kappa(1)+kappa(2))+kappa0) * Idz(1) + aQ(1) = US%s_to_T*(0.5*(kappa(1)+kappa(2))+kappa0) * Idz(1) dQdz(1) = 0.5*(TKE(1) - TKE(2))*Idz(1) if (tke_noflux_top_BC) then - tke_src = dz_Int(1) * (Z2_to_L2*kappa0*S2(1) - (TKE(1) - q0)*TKE_decay(1)) - & + tke_src = dz_Int(1) * (Z2_to_L2*US%s_to_T*kappa0*S2(1) - (TKE(1) - q0)*TKE_decay(1)) - & aQ(1) * (TKE(1) - TKE(2)) bQ = 1.0 / (aQ(1) + dz_Int(1)*TKE_decay(1)) @@ -1707,7 +1696,7 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, & I_Q = 1.0 / TKE(K) I_Ld2(K) = (N2(K)*Ilambda2 + f2) * (Z2_to_L2*I_Q) + I_L2_bdry(K) - kap_src = dz_Int(K) * (k_src(K) - I_Ld2(K)*kappa(K)) + & + kap_src = dz_Int(K) * (K_src(K) - I_Ld2(K)*kappa(K)) + & Idz(k-1)*(kappa(K-1)-kappa(K)) - Idz(k)*(kappa(K)-kappa(K+1)) ! Ensure that the pivot is always positive, and that 0 <= cK <= 1. @@ -1719,8 +1708,8 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, & cK(K+1) = bK * Idz(k) cKcomp = bK * (Idz(k-1)*cKcomp + decay_term_k) ! = 1-cK(K+1) dKdQ(K) = bK * (Idz(k-1)*dKdQ(K-1)*cQ(K) + & - US%Z_to_m*(N2(K)*Ilambda2 + f2) * I_Q**2 * kappa(K) ) - dK(K) = bK * (kap_src + Idz(k-1)*dK(K-1) + Idz(k-1)*dKdQ(K-1)*dQ(K-1)) + US%Z_to_m*(N2(K)*Ilambda2 + f2) * I_Q**2 * US%s_to_T*kappa(K) ) + dK(K) = bK * (kap_src + Idz(k-1)*dK(K-1) + Idz(k-1)*US%T_to_s*dKdQ(K-1)*dQ(K-1)) ! Truncate away negligibly small values of kappa. if (dK(K) <= cKcomp*(kappa_trunc - kappa(K))) then @@ -1731,9 +1720,9 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, & endif ! Solve for dQ(K)... - aQ(k) = (0.5*(kappa(K)+kappa(K+1))+kappa0) * Idz(k) + aQ(k) = US%s_to_T*(0.5*(kappa(K)+kappa(K+1))+kappa0) * Idz(k) dQdz(k) = 0.5*(TKE(K) - TKE(K+1))*Idz(k) - tke_src = dz_Int(K) * (Z2_to_L2*((kappa(k) + kappa0)*S2(k) - kappa(k)*N2(k)) - & + tke_src = dz_Int(K) * (Z2_to_L2*US%s_to_T*((kappa(K) + kappa0)*S2(K) - kappa(k)*N2(K)) - & (TKE(k) - q0)*TKE_decay(k)) - & (aQ(k) * (TKE(K) - TKE(K+1)) - aQ(k-1) * (TKE(K-1) - TKE(K))) v1 = aQ(k-1) + dQdz(k-1)*dKdQ(K-1) @@ -1751,8 +1740,8 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, & dQmdK(K+1) = (v2 * cK(K+1) - dQdz(k)) * bQ ! Ensure that TKE+dQ will not drop below 0.5*TKE. - dQ(K) = max(bQ * ((v1 * dQ(K-1) + dQdz(k-1)*dK(k-1)) + & - (v2 * dK(K) + tke_src)), cQcomp*(-0.5*TKE(K))) + dQ(K) = max(bQ * ((v1 * dQ(K-1) + dQdz(k-1)*US%s_to_T*dK(k-1)) + & + (v2 * US%s_to_T*dK(K) + tke_src)), cQcomp*(-0.5*TKE(K))) ! Check whether the next layer will be affected by any nonzero kappas. if ((itt > 1) .and. (K > ke_src) .and. (dK(K) == 0.0) .and. & @@ -1765,7 +1754,7 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, & dK(nz+1) = 0.0 ; dKdQ(nz+1) = 0.0 if (tke_noflux_bottom_BC) then K = nz+1 - tke_src = dz_Int(K) * (Z2_to_L2*kappa0*S2(K) - (TKE(K) - q0)*TKE_decay(K)) + & + tke_src = dz_Int(K) * (Z2_to_L2*US%s_to_T*kappa0*S2(K) - (TKE(K) - q0)*TKE_decay(K)) + & aQ(k-1) * (TKE(K-1) - TKE(K)) v1 = aQ(k-1) + dQdz(k-1)*dKdQ(K-1) @@ -1775,7 +1764,7 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, & else bQ = 1.0 / (aQ(k) + (cQcomp*aQ(k-1) + decay_term_Q)) ! Ensure that TKE+dQ will not drop below 0.5*TKE. - dQ(K) = max(bQ * ((v1 * dQ(K-1) + dQdz(k-1)*dK(K-1)) + tke_src), & + dQ(K) = max(bQ * ((v1 * dQ(K-1) + dQdz(k-1)*US%s_to_T*dK(K-1)) + tke_src), & -0.5*TKE(K)) TKE(K) = max(TKE(K) + dQ(K), TKE_min) endif @@ -1790,8 +1779,8 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, & #ifdef DEBUG if (K < nz+1) then ! Ignore this source? - aQ(k) = (0.5*(kappa(K)+kappa(K+1))+kappa0) * Idz(k) - tke_src = (dz_Int(K) * (Z2_to_L2*kappa0*S2(K) - (TKE(K)-q0)*TKE_decay(K)) - & + aQ(k) = US%s_to_T*(0.5*(kappa(K)+kappa(K+1))+kappa0) * Idz(k) + tke_src = (dz_Int(K) * (Z2_to_L2*US%s_to_T*kappa0*S2(K) - (TKE(K)-q0)*TKE_decay(K)) - & (aQ(k) * (TKE(K) - TKE(K+1)) - aQ(k-1) * (TKE(K-1) - TKE(K))) ) / & (aQ(k) + (aQ(k-1) + dz_Int(K)*TKE_decay(K))) endif @@ -1810,10 +1799,10 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, & if (.not. abort_Newton) then do K=ke_kappa,2,-1 ! Ensure that TKE+dQ will not drop below 0.5*TKE. - dQ(K) = max(dQ(K) + (cQ(K+1)*dQ(K+1) + dQmdK(K+1) * dK(K+1)), & + dQ(K) = max(dQ(K) + (cQ(K+1)*dQ(K+1) + dQmdK(K+1) * US%s_to_T*dK(K+1)), & -0.5*TKE(K)) TKE(K) = max(TKE(K) + dQ(K), TKE_min) - dK(K) = dK(K) + (cK(K+1)*dK(K+1) + dKdQ(K) * dQ(K)) + dK(K) = dK(K) + (cK(K+1)*dK(K+1) + US%T_to_s*dKdQ(K) * dQ(K)) ! Truncate away negligibly small values of kappa. if (dK(K) <= kappa_trunc - kappa(K)) then dK(K) = -kappa(K) @@ -1828,7 +1817,7 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, & if (K<=ks_kappa) ks_kappa = 2 endif enddo - dQ(1) = max(dQ(1) + cQ(2)*dQ(2) + dQmdK(2) * dK(2), TKE_min - TKE(1)) + dQ(1) = max(dQ(1) + cQ(2)*dQ(2) + dQmdK(2) * US%s_to_T*dK(2), TKE_min - TKE(1)) TKE(1) = max(TKE(1) + dQ(1), TKE_min) dK(1) = 0.0 endif @@ -1843,52 +1832,29 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, & ! been increased to ensure a positive pivot, or 2) negative TKEs have been ! truncated, or 3) small or negative kappas have been rounded toward 0. I_Q = 1.0 / TKE(K) - I_Ld2(K) = (N2(K)*Ilambda2 + f2) * (Z2_to_L2*I_Q) + I_L2_bdry(K) + I_Ld2_debug(K) = (N2(K)*Ilambda2 + f2) * (Z2_to_L2*I_Q) + I_L2_bdry(K) - kap_src = dz_Int(K) * (k_src(K) - I_Ld2(K)*kappa_prev(K)) + & + kap_src = dz_Int(K) * (K_src(K) - I_Ld2(K)*kappa_prev(K)) + & (Idz(k-1)*(kappa_prev(k-1)-kappa_prev(k)) - & Idz(k)*(kappa_prev(k)-kappa_prev(k+1))) K_err_lin = -Idz(k-1)*(dK(K-1)-dK(K)) + Idz(k)*(dK(K)-dK(K+1)) + & - dz_Int(K)*I_Ld2(K)*dK(K) - kap_src - & + dz_Int(K)*I_Ld2_debug(K)*dK(K) - kap_src - & US%Z_to_m*(N2(K)*Ilambda2 + f2)*I_Q**2*kappa_prev(K) * dQ(K) - tke_src = dz_Int(K) * (Z2_to_L2*(kappa_prev(K) + kappa0)*S2(K) - & - Z2_to_L2*kappa_prev(K)*N2(K) - (TKE_prev(K) - q0)*TKE_decay(K)) - & - (aQ(k) * (TKE_prev(K) - TKE_prev(K+1)) - & - aQ(k-1) * (TKE_prev(K-1) - TKE_prev(K))) - Q_err_lin = (aQ(k-1) * (dQ(K-1)-dQ(K)) - aQ(k) * (dQ(k)-dQ(k+1))) - & - 0.5*(TKE_prev(K)-TKE_prev(K+1))*Idz(k) * (dK(K) + dK(K+1)) - & - 0.5*(TKE_prev(K)-TKE_prev(K-1))*Idz(k-1)* (dK(K-1) + dK(K)) + & - dz_Int(K) * (Z2_to_L2*dK(K) * (S2(K) - N2(K)) - dQ(K)*TKE_decay(K)) + tke_src + tke_src = dz_Int(K) * (Z2_to_L2*US%s_to_T*(kappa_prev(K) + kappa0)*S2(K) - & + Z2_to_L2*US%s_to_T*kappa_prev(K)*N2(K) - (TKE_prev(K) - q0)*TKE_decay(K)) - & + (aQ(k) * (TKE_prev(K) - TKE_prev(K+1)) - aQ(k-1) * (TKE_prev(K-1) - TKE_prev(K))) + Q_err_lin = tke_src + (aQ(k-1) * (dQ(K-1)-dQ(K)) - aQ(k) * (dQ(k)-dQ(k+1))) - & + US%s_to_T*0.5*(TKE_prev(K)-TKE_prev(K+1))*Idz(k) * (dK(K) + dK(K+1)) - & + US%s_to_T*0.5*(TKE_prev(K)-TKE_prev(K-1))*Idz(k-1)* (dK(K-1) + dK(K)) + & + dz_Int(K) * (Z2_to_L2*US%s_to_T*dK(K) * (S2(K) - N2(K)) - dQ(K)*TKE_decay(K)) enddo #endif endif ! End of the Newton's method solver. ! Test kappa for convergence... -#ifdef DEBUG - max_err = 0.0 ; max_TKE_err = 0.0 ; min_TKE_err = 0.0 - do K=min(ks_kappa,ks_kappa_prev),max(ke_kappa,ke_kappa_prev) - norm_err = abs(kappa(K) - kappa_prev(K)) / & - (kappa0 + 0.5*(kappa(K) + kappa_prev(K))) - if (max_err < norm_err) max_err = norm_err - - TKE_err(K) = dQ(K) / (tke(K) - 0.5*dQ(K)) - if (TKE_err(K) > max_TKE_err) max_TKE_err = TKE_err(K) - if (TKE_err(K) < min_TKE_err) min_TKE_err = TKE_err(K) - enddo - if (do_Newton) then - if (max(max_err,max_TKE_err,-min_TKE_err) >= 2.0*Newton_err) then - do_Newton = .false. ; abort_Newton = .true. - endif - else - if (max(max_err,max_TKE_err,-min_TKE_err) < Newton_err) do_Newton = .true. - endif - within_tolerance = (max_err < tol_err) -#else - ! max_err = 0.0 if ((tol_err < Newton_err) .and. (.not.abort_Newton)) then - ! A lower tolerance is used to switch to Newton's method than to - ! switch back. + ! A lower tolerance is used to switch to Newton's method than to switch back. Newton_test = Newton_err ; if (do_Newton) Newton_test = 2.0*Newton_err was_Newton = do_Newton within_tolerance = .true. ; do_Newton = .true. @@ -1914,7 +1880,6 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, & endif enddo endif -#endif if (abort_Newton) then do_Newton = .false. ; abort_Newton = .false. @@ -1927,14 +1892,14 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, & #ifdef DEBUG if (itt <= max_debug_itt) then do K=1,nz+1 - kprev_it1(K,itt)=kappa_prev(K) - kappa_it1(K,itt)=kappa(K) ; tke_it1(K,itt) = tke(K) + kprev_it1(K,itt) = kappa_prev(K) + kappa_it1(K,itt) = kappa(K) ; tke_it1(K,itt) = tke(K) dkappa_it1(K,itt) = kappa(K) - kappa_prev(K) dkappa_norm_it1(K,itt) = (kappa(K) - kappa_prev(K)) / & (kappa0 + 0.5*(kappa(K) + kappa_prev(K))) K_Q_it1(K,itt) = kappa(K) / max(TKE(K),TKE_min) d_dkappa_it1(K,itt) = 0.0 - if (itt > 1) then ; if (abs(dkappa_it1(K,itt-1)) > 1e-20) & + if (itt > 1) then ; if (abs(kappa_it1(K,itt-1)) > 1e-20*US%T_to_s) & d_dkappa_it1(K,itt) = dkappa_it1(K,itt) / dkappa_it1(K,itt-1) endif enddo @@ -1964,16 +1929,16 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, & diffusive_src = Idz(k-1)*(kappa(K-1)-kappa(K)) + Idz(k)*(kappa(K+1)-kappa(K)) chg_by_k0 = kappa0 * ((Idz(k-1)+Idz(k)) / dz_Int(K) + I_Ld2(K)) if (diffusive_src <= 0.0) then - local_src(K) = k_src(K) + chg_by_k0 + local_src(K) = K_src(K) + chg_by_k0 else - local_src(K) = (k_src(K) + chg_by_k0) + diffusive_src / dz_Int(K) + local_src(K) = (K_src(K) + chg_by_k0) + diffusive_src / dz_Int(K) endif enddo endif if (present(kappa_src)) then kappa_src(1) = 0.0 ; kappa_src(nz+1) = 0.0 do K=2,nz - kappa_src(K) = k_src(K) + kappa_src(K) = K_src(K) enddo endif @@ -2043,7 +2008,7 @@ function kappa_shear_init(Time, G, GV, US, param_file, diag, CS) "The background diffusivity that is used to smooth the "//& "density and shear profiles before solving for the "//& "diffusivities. Defaults to value of KD.", & - units="m2 s-1", default=KD_normal, scale=US%m_to_Z**2) + units="m2 s-1", default=KD_normal, scale=US%m2_s_to_Z2_T) call get_param(param_file, mdl, "FRI_CURVATURE", CS%FRi_curvature, & "The nondimensional curvature of the function of the "//& "Richardson number in the kappa source term in the "//& From 61f04d51cff3af2d2f8008ed70bfb375d514e6e9 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Wed, 26 Jun 2019 06:22:57 -0400 Subject: [PATCH 39/82] Pass time step to kappa_shear_column in units of T Changed the units of the time step passed to kappa_shear_column from s to T. All answers are bitwise identical. --- .../vertical/MOM_kappa_shear.F90 | 36 +++++++++---------- 1 file changed, 18 insertions(+), 18 deletions(-) diff --git a/src/parameterizations/vertical/MOM_kappa_shear.F90 b/src/parameterizations/vertical/MOM_kappa_shear.F90 index 8612c19e8b..6a67b3e296 100644 --- a/src/parameterizations/vertical/MOM_kappa_shear.F90 +++ b/src/parameterizations/vertical/MOM_kappa_shear.F90 @@ -288,11 +288,11 @@ subroutine Calculate_kappa_shear(u_in, v_in, h, tv, p_surf, kappa_io, tke_io, & endif #ifdef ADD_DIAGNOSTICS - call kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & + call kappa_shear_column(kappa, tke, US%s_to_T*dt, nzc, f2, surface_pres, & dz, u0xdz, v0xdz, T0xdz, S0xdz, kappa_avg, & tke_avg, tv, CS, GV, US, I_Ld2_1d, dz_Int_1d) #else - call kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & + call kappa_shear_column(kappa, tke, US%s_to_T*dt, nzc, f2, surface_pres, & dz, u0xdz, v0xdz, T0xdz, S0xdz, kappa_avg, & tke_avg, tv, CS, GV, US) #endif @@ -594,11 +594,11 @@ subroutine Calc_kappa_shear_vertex(u_in, v_in, h, T_in, S_in, tv, p_surf, kappa_ endif #ifdef ADD_DIAGNOSTICS - call kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & + call kappa_shear_column(kappa, tke, US%s_to_T*dt, nzc, f2, surface_pres, & dz, u0xdz, v0xdz, T0xdz, S0xdz, kappa_avg, & tke_avg, tv, CS, GV, US, I_Ld2_1d, dz_Int_1d) #else - call kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & + call kappa_shear_column(kappa, tke, US%s_to_T*dt, nzc, f2, surface_pres, & dz, u0xdz, v0xdz, T0xdz, S0xdz, kappa_avg, & tke_avg, tv, CS, GV, US) #endif @@ -697,7 +697,7 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & intent(out) :: kappa_avg !< The time-weighted average of kappa [Z2 T-1 ~> m2 s-1]. real, dimension(SZK_(GV)+1), & intent(out) :: tke_avg !< The time-weighted average of TKE [m2 s-2]. - real, intent(in) :: dt !< Time increment [s]. + real, intent(in) :: dt !< Time increment [T ~> s]. type(thermo_var_ptrs), intent(in) :: tv !< A structure containing pointers to any !! available thermodynamic fields. Absent fields !! have NULL ptrs. @@ -764,13 +764,13 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & ! within an iteration. 0 < tol_dksrc_low < 1. real :: Ri_crit ! The critical shear Richardson number for shear- ! driven mixing. The theoretical value is 0.25. - real :: dt_rem ! The remaining time to advance the solution [s]. - real :: dt_now ! The time step used in the current iteration [s]. + real :: dt_rem ! The remaining time to advance the solution [T ~> s]. + real :: dt_now ! The time step used in the current iteration [T ~> s]. real :: dt_wt ! The fractional weight of the current iteration [nondim]. real :: dt_test ! A time-step that is being tested for whether it - ! gives acceptably small changes in k_src [s]. + ! gives acceptably small changes in k_src [T ~> s]. real :: Idtt ! Idtt = 1 / dt_test [T-1 ~> s-1]. - real :: dt_inc ! An increment to dt_test that is being tested [s]. + real :: dt_inc ! An increment to dt_test that is being tested [T ~> s]. real :: k0dt ! The background diffusivity times the timestep [Z2 ~> m2]. logical :: valid_dt ! If true, all levels so far exhibit acceptably small @@ -805,7 +805,7 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & Ri_crit = CS%Rino_crit gR0 = GV%Rho0*(GV%g_Earth*US%m_to_Z) ; g_R0 = (GV%g_Earth*US%m_to_Z**2)/GV%Rho0 - k0dt = dt*US%s_to_T*CS%kappa_0 + k0dt = dt*CS%kappa_0 ! These are hard-coded for now. Perhaps these could be made dynamic later? ! tol_dksrc = 0.5*tol_ksrc_chg ; tol_dksrc_low = 1.0 - 1.0/tol_ksrc_chg ? tol_dksrc = 10.0 ; tol_dksrc_low = 0.95 ; tol2 = 2.0*CS%kappa_tol_err @@ -1020,7 +1020,7 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & GV, US, N2, S2, ks_int=ks_kappa, ke_int=ke_kappa, & vel_underflow=CS%vel_underflow) valid_dt = .true. - Idtt = 1.0 / (US%s_to_T*dt_test) + Idtt = 1.0 / dt_test do K=max(ks_kappa-1,2),min(ke_kappa+1,nzc) if (N2(K) < Ri_crit * S2(K)) then ! Equivalent to Ri < Ri_crit. K_src(K) = US%T_to_s*(2.0 * CS%Shearmix_rate * sqrt(S2(K))) * & @@ -1046,7 +1046,7 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & nzc, dz, I_dz_int, dbuoy_dT, dbuoy_dS, u_test, v_test, T_test, S_test, & GV, US, N2, S2, ks_int=ks_kappa, ke_int=ke_kappa, vel_underflow=CS%vel_underflow) valid_dt = .true. - Idtt = 1.0 / (US%s_to_T*(dt_test+dt_inc)) + Idtt = 1.0 / (dt_test+dt_inc) do K=max(ks_kappa-1,2),min(ke_kappa+1,nzc) if (N2(K) < Ri_crit * S2(K)) then ! Equivalent to Ri < Ri_crit. K_src(K) = US%T_to_s*(2.0 * CS%Shearmix_rate * sqrt(S2(K))) * & @@ -1070,9 +1070,9 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & dt_inc = 0.0 endif - dt_now = min(dt_test*(1.0+CS%kappa_tol_err)+dt_inc,dt_rem) + dt_now = min(dt_test*(1.0+CS%kappa_tol_err)+dt_inc, dt_rem) do K=2,nzc - local_src_avg(K) = local_src_avg(K) + dt_now*US%s_to_T * local_src(K) + local_src_avg(K) = local_src_avg(K) + dt_now * local_src(K) enddo endif ! Are all the values of kappa_out 0? ! call cpu_clock_end(id_clock_project) @@ -1238,7 +1238,7 @@ subroutine calculate_projected_state(kappa, u0, v0, T0, S0, dt, nz, & !! temperature [Z s-2 degC-1 ~> m s-2 degC-1]. real, dimension(nz+1), intent(in) :: dbuoy_dS !< The partial derivative of buoyancy with !! salinity [Z s-2 ppt-1 ~> m s-2 ppt-1]. - real, intent(in) :: dt !< The time step [s]. + real, intent(in) :: dt !< The time step [T ~> s]. real, dimension(nz), intent(inout) :: u !< The zonal velocity after dt [m s-1]. real, dimension(nz), intent(inout) :: v !< The meridional velocity after dt [m s-1]. real, dimension(nz), intent(inout) :: T !< The temperature after dt [degC]. @@ -1272,7 +1272,7 @@ subroutine calculate_projected_state(kappa, u0, v0, T0, S0, dt, nz, & if (ks > ke) return if (dt > 0.0) then - a_b = dt*US%s_to_T*(kappa(ks+1)*I_dz_int(ks+1)) + a_b = dt*(kappa(ks+1)*I_dz_int(ks+1)) b1 = 1.0 / (dz(ks) + a_b) c1(ks+1) = a_b * b1 ; d1 = dz(ks) * b1 ! = 1 - c1 @@ -1280,7 +1280,7 @@ subroutine calculate_projected_state(kappa, u0, v0, T0, S0, dt, nz, & T(ks) = (b1 * dz(ks))*T0(ks) ; Sal(ks) = (b1 * dz(ks))*S0(ks) do K=ks+1,ke-1 a_a = a_b - a_b = dt*US%s_to_T*(kappa(K+1)*I_dz_int(K+1)) + a_b = dt*(kappa(K+1)*I_dz_int(K+1)) bd1 = dz(k) + d1*a_a b1 = 1.0 / (bd1 + a_b) c1(K+1) = a_b * b1 ; d1 = bd1 * b1 ! d1 = 1 - c1 @@ -1303,7 +1303,7 @@ subroutine calculate_projected_state(kappa, u0, v0, T0, S0, dt, nz, & ! tracers and velocities if the mixing is separated from the bottom, but if ! the mixing goes all the way to the bottom, use no-slip BCs for velocities. if (ke == nz) then - a_b = dt*US%s_to_T*(kappa(nz+1)*I_dz_int(nz+1)) + a_b = dt*(kappa(nz+1)*I_dz_int(nz+1)) b1nz_0 = 1.0 / ((dz(nz) + d1*a_a) + a_b) else b1nz_0 = b1 From fd4fb8b1aa75f4f0b6b2681aad6c2427240b8917 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Wed, 26 Jun 2019 06:51:32 -0400 Subject: [PATCH 40/82] Rescaled internal variables in find_kappa_tke Rescaled internal variables in find_kappa_tke to eliminate rescaling factors and demonstrate dimensional consistency. All answers are bitwise identical. --- .../vertical/MOM_kappa_shear.F90 | 108 +++++++++--------- 1 file changed, 55 insertions(+), 53 deletions(-) diff --git a/src/parameterizations/vertical/MOM_kappa_shear.F90 b/src/parameterizations/vertical/MOM_kappa_shear.F90 index 6a67b3e296..92b585d629 100644 --- a/src/parameterizations/vertical/MOM_kappa_shear.F90 +++ b/src/parameterizations/vertical/MOM_kappa_shear.F90 @@ -1390,7 +1390,7 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, & ! Local variables real, dimension(nz) :: & - aQ, & ! aQ is the coupling between adjacent interfaces in the TKE equations [m s-1]. + aQ, & ! aQ is the coupling between adjacent interfaces in the TKE equations [Z T-1 ~> m s-1]. dQdz ! Half the partial derivative of TKE with depth [m s-2]. real, dimension(nz+1) :: & dK, & ! The change in kappa [Z2 T-1 ~> m2 s-1]. @@ -1398,19 +1398,21 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, & cQ, cK, & ! cQ and cK are the upward influences in the tridiagonal and ! hexadiagonal solvers for the TKE and kappa equations [nondim]. I_Ld2, & ! 1/Ld^2, where Ld is the effective decay length scale for kappa [Z-2 ~> m-2]. - TKE_decay, & ! The local TKE decay rate [s-1]. + TKE_decay, & ! The local TKE decay rate [T-1 ~> s-1]. k_src, & ! The source term in the kappa equation [T-1 ~> s-1]. - dQmdK, & ! With Newton's method the change in dQ(k-1) due to dK(k) [m2 s Z-2 ~> s]. - dKdQ, & ! With Newton's method the change in dK(k) due to dQ(k) [Z2 m-2 s-1 ~> s-1]. + dQmdK, & ! With Newton's method the change in dQ(k-1) due to dK(k) [m2 T Z-2 ~> s]. + dKdQ, & ! With Newton's method the change in dK(k) due to dQ(k) [Z2 m-2 T-1 ~> s-1]. e1 ! The fractional change in a layer TKE due to a change in the ! TKE of the layer above when all the kappas below are 0. ! e1 is nondimensional, and 0 < e1 < 1. real :: tke_src ! The net source of TKE due to mixing against the shear - ! and stratification [m2 s-3]. (For convenience, + ! and stratification [m2 s-2 T-1 ~> m2 s-3]. (For convenience, ! a term involving the non-dissipation of q0 is also ! included here.) - real :: bQ, bK ! The inverse of the pivot in the tridiagonal equations [Z-1 ~> m-1]. - real :: bd1 ! A term in the denominator of bQ or bK. + real :: bQ ! The inverse of the pivot in the tridiagonal equations [T Z-1 ~> s m-1]. + real :: bK ! The inverse of the pivot in the tridiagonal equations [Z-1 ~> m-1]. + real :: bQd1 ! A term in the denominator of bQ [Z T-1 ~> m s-1]. + real :: bKd1 ! A term in the denominator of bK [Z ~> m]. real :: cQcomp, cKcomp ! 1 - cQ or 1 - cK in the tridiagonal equations. real :: c_s2 ! The coefficient for the decay of TKE due to ! shear (i.e. proportional to |S|*tke), nondimensional. @@ -1435,10 +1437,11 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, & ! iteration to use Newton's method. ! Temporary variables used in the Newton's method iterations. real :: decay_term_k ! The decay term in the diffusivity equation - real :: decay_term_Q ! The decay term in the TKE equation + real :: decay_term_Q ! The decay term in the TKE equation - proportional to [T-1 ~> s-1] real :: I_Q ! The inverse of TKE [s2 m-2] real :: kap_src - real :: v1, v2 + real :: v1 ! A temporary variable proportional to [T-1 ~> s-1] + real :: v2 real :: Z2_to_L2 ! A conversion factor from vertical depth units to horizontal length ! units squared [m2 Z-2]. real :: tol_err ! The tolerance for max_err that determines when to @@ -1463,7 +1466,7 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, & integer :: itt, k, k2 #ifdef DEBUG integer :: max_debug_itt ; parameter(max_debug_itt=20) - real :: K_err_lin, Q_err_lin + real :: K_err_lin, Q_err_lin, TKE_src_norm real, dimension(nz+1) :: & I_Ld2_debug, & ! A separate version of I_Ld2 for debugging [Z-2 ~> m-2]. kappa_prev, & ! The value of kappa at the start of the current iteration [Z2 T-1 ~> m2 s-1]. @@ -1514,7 +1517,7 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, & do K=1,nz+1 kappa(K) = kappa_in(K) ! TKE_decay(K) = c_n*sqrt(N2(K)) + c_s*sqrt(S2(K)) ! The expression in JHL. - TKE_decay(K) = sqrt(c_n2*N2(K) + c_s2*S2(K)) + TKE_decay(K) = US%T_to_s*sqrt(c_n2*N2(K) + c_s2*S2(K)) if ((kappa(K) > 0.0) .and. (K_Q(K) > 0.0)) then TKE(K) = kappa(K) / K_Q(K) else @@ -1527,7 +1530,7 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, & ! Calculate the term (e1) that allows changes in TKE to be calculated quickly ! below the deepest nonzero value of kappa. If kappa = 0, below interface ! k-1, the final changes in TKE are related by dQ(K+1) = e1(K+1)*dQ(K). - eden2 = US%s_to_T*kappa0 * Idz(nz) + eden2 = kappa0 * Idz(nz) if (tke_noflux_bottom_BC) then eden1 = dz_Int(nz+1)*TKE_decay(nz+1) I_eden = 1.0 / (eden2 + eden1) @@ -1537,7 +1540,7 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, & endif do k=nz,2,-1 eden1 = dz_Int(K)*TKE_decay(K) + ome * eden2 - eden2 = US%s_to_T*kappa0 * Idz(k-1) + eden2 = kappa0 * Idz(k-1) I_eden = 1.0 / (eden2 + eden1) e1(K) = eden2 * I_eden ; ome = eden1 * I_eden ! = 1-e1 enddo @@ -1562,34 +1565,34 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, & ! terms. ke_tke = max(ke_kappa,ke_kappa_prev)+1 - ! aQ is the coupling between adjacent interfaces [Z s-1 ~> m s-1]. + ! aQ is the coupling between adjacent interfaces [Z T-1 ~> m s-1]. do k=1,min(ke_tke,nz) - aQ(k) = US%s_to_T*(0.5*(kappa(K)+kappa(K+1)) + kappa0) * Idz(k) + aQ(k) = (0.5*(kappa(K)+kappa(K+1)) + kappa0) * Idz(k) enddo dQ(1) = -TKE(1) if (tke_noflux_top_BC) then - tke_src = Z2_to_L2*US%s_to_T*kappa0*S2(1) + q0 * TKE_decay(1) ! Uses that kappa(1) = 0 - bd1 = dz_Int(1) * TKE_decay(1) - bQ = 1.0 / (bd1 + aQ(1)) + tke_src = Z2_to_L2*kappa0*S2(1) + q0 * TKE_decay(1) ! Uses that kappa(1) = 0 + bQd1 = dz_Int(1) * TKE_decay(1) + bQ = 1.0 / (bQd1 + aQ(1)) tke(1) = bQ * (dz_Int(1)*tke_src) - cQ(2) = aQ(1) * bQ ; cQcomp = bd1 * bQ ! = 1 - cQ + cQ(2) = aQ(1) * bQ ; cQcomp = bQd1 * bQ ! = 1 - cQ else tke(1) = q0 ; cQ(2) = 0.0 ; cQcomp = 1.0 endif do K=2,ke_tke-1 dQ(K) = -TKE(K) - tke_src = Z2_to_L2*US%s_to_T*(kappa(K) + kappa0)*S2(K) + q0*TKE_decay(K) - bd1 = dz_Int(K)*(TKE_decay(K) + N2(K)*Z2_to_L2*US%s_to_T*K_Q(K)) + cQcomp*aQ(k-1) - bQ = 1.0 / (bd1 + aQ(k)) + tke_src = Z2_to_L2*(kappa(K) + kappa0)*S2(K) + q0*TKE_decay(K) + bQd1 = dz_Int(K)*(TKE_decay(K) + N2(K)*Z2_to_L2*K_Q(K)) + cQcomp*aQ(k-1) + bQ = 1.0 / (bQd1 + aQ(k)) tke(K) = bQ * (dz_Int(K)*tke_src + aQ(k-1)*tke(K-1)) - cQ(K+1) = aQ(k) * bQ ; cQcomp = bd1 * bQ ! = 1 - cQ + cQ(K+1) = aQ(k) * bQ ; cQcomp = bQd1 * bQ ! = 1 - cQ enddo if ((ke_tke == nz+1) .and. .not.(tke_noflux_bottom_BC)) then tke(nz+1) = TKE_min dQ(nz+1) = 0.0 else k = ke_tke - tke_src = Z2_to_L2*US%s_to_T*kappa0*S2(K) + q0*TKE_decay(K) ! Uses that kappa(ke_tke) = 0 + tke_src = Z2_to_L2*kappa0*S2(K) + q0*TKE_decay(K) ! Uses that kappa(ke_tke) = 0 if (K == nz+1) then dQ(K) = -TKE(K) bQ = 1.0 / (dz_Int(K)*TKE_decay(K) + cQcomp*aQ(k-1)) @@ -1601,8 +1604,7 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, & ! Account for all changes deeper in the water column. dQ(K) = -TKE(K) tke(K) = max((bQ * (dz_Int(K)*tke_src + aQ(k-1)*tke(K-1)) + & - cQ(K+1)*(tke(K+1) - e1(K+1)*tke(K))) / & - (1.0 - cQ(K+1)*e1(K+1)), TKE_min) + cQ(K+1)*(tke(K+1) - e1(K+1)*tke(K))) / (1.0 - cQ(K+1)*e1(K+1)), TKE_min) dQ(K) = tke(K) + dQ(K) ! Adjust TKE deeper in the water column in case ke_tke increases. @@ -1638,11 +1640,11 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, & dK(K) = -kappa(K) if (itt>1) & I_Ld2(K) = (N2(K)*Ilambda2 + f2) * Z2_to_L2 / tke(K) + I_L2_bdry(K) - bd1 = dz_Int(K)*I_Ld2(K) + cKcomp*Idz(k-1) - bK = 1.0 / (bd1 + Idz(k)) + bKd1 = dz_Int(K)*I_Ld2(K) + cKcomp*Idz(k-1) + bK = 1.0 / (bKd1 + Idz(k)) kappa(K) = bK * (Idz(k-1)*kappa(K-1) + dz_Int(K) * K_src(K)) - cK(K+1) = Idz(k) * bK ; cKcomp = bd1 * bK ! = 1 - cK(K+1) + cK(K+1) = Idz(k) * bK ; cKcomp = bKd1 * bK ! = 1 - cK(K+1) ! Neglect values that are smaller than kappa_trunc. if (kappa(K) < cKcomp*kappa_trunc) then @@ -1678,10 +1680,10 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, & ks_kappa_prev = ks_kappa ; ke_kappa_prev = ke_kappa ; ke_kappa = nz ks_kappa = 2 dK(1) = 0.0 ; cK(2) = 0.0 ; cKcomp = 1.0 ; dKdQ(1) = 0.0 - aQ(1) = US%s_to_T*(0.5*(kappa(1)+kappa(2))+kappa0) * Idz(1) + aQ(1) = (0.5*(kappa(1)+kappa(2))+kappa0) * Idz(1) dQdz(1) = 0.5*(TKE(1) - TKE(2))*Idz(1) if (tke_noflux_top_BC) then - tke_src = dz_Int(1) * (Z2_to_L2*US%s_to_T*kappa0*S2(1) - (TKE(1) - q0)*TKE_decay(1)) - & + tke_src = dz_Int(1) * (Z2_to_L2*kappa0*S2(1) - (TKE(1) - q0)*TKE_decay(1)) - & aQ(1) * (TKE(1) - TKE(2)) bQ = 1.0 / (aQ(1) + dz_Int(1)*TKE_decay(1)) @@ -1707,9 +1709,10 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, & cK(K+1) = bK * Idz(k) cKcomp = bK * (Idz(k-1)*cKcomp + decay_term_k) ! = 1-cK(K+1) + !### The following expression appears to be dimensionally inconsistent in length. -RWH dKdQ(K) = bK * (Idz(k-1)*dKdQ(K-1)*cQ(K) + & - US%Z_to_m*(N2(K)*Ilambda2 + f2) * I_Q**2 * US%s_to_T*kappa(K) ) - dK(K) = bK * (kap_src + Idz(k-1)*dK(K-1) + Idz(k-1)*US%T_to_s*dKdQ(K-1)*dQ(K-1)) + US%Z_to_m*(N2(K)*Ilambda2 + f2) * I_Q**2 * kappa(K) ) + dK(K) = bK * (kap_src + Idz(k-1)*dK(K-1) + Idz(k-1)*dKdQ(K-1)*dQ(K-1)) ! Truncate away negligibly small values of kappa. if (dK(K) <= cKcomp*(kappa_trunc - kappa(K))) then @@ -1720,9 +1723,9 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, & endif ! Solve for dQ(K)... - aQ(k) = US%s_to_T*(0.5*(kappa(K)+kappa(K+1))+kappa0) * Idz(k) + aQ(k) = (0.5*(kappa(K)+kappa(K+1))+kappa0) * Idz(k) dQdz(k) = 0.5*(TKE(K) - TKE(K+1))*Idz(k) - tke_src = dz_Int(K) * (Z2_to_L2*US%s_to_T*((kappa(K) + kappa0)*S2(K) - kappa(k)*N2(K)) - & + tke_src = dz_Int(K) * (Z2_to_L2*((kappa(K) + kappa0)*S2(K) - kappa(k)*N2(K)) - & (TKE(k) - q0)*TKE_decay(k)) - & (aQ(k) * (TKE(K) - TKE(K+1)) - aQ(k-1) * (TKE(K-1) - TKE(K))) v1 = aQ(k-1) + dQdz(k-1)*dKdQ(K-1) @@ -1740,8 +1743,8 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, & dQmdK(K+1) = (v2 * cK(K+1) - dQdz(k)) * bQ ! Ensure that TKE+dQ will not drop below 0.5*TKE. - dQ(K) = max(bQ * ((v1 * dQ(K-1) + dQdz(k-1)*US%s_to_T*dK(k-1)) + & - (v2 * US%s_to_T*dK(K) + tke_src)), cQcomp*(-0.5*TKE(K))) + dQ(K) = max(bQ * ((v1 * dQ(K-1) + dQdz(k-1)*dK(k-1)) + & + (v2 * dK(K) + tke_src)), cQcomp*(-0.5*TKE(K))) ! Check whether the next layer will be affected by any nonzero kappas. if ((itt > 1) .and. (K > ke_src) .and. (dK(K) == 0.0) .and. & @@ -1754,7 +1757,7 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, & dK(nz+1) = 0.0 ; dKdQ(nz+1) = 0.0 if (tke_noflux_bottom_BC) then K = nz+1 - tke_src = dz_Int(K) * (Z2_to_L2*US%s_to_T*kappa0*S2(K) - (TKE(K) - q0)*TKE_decay(K)) + & + tke_src = dz_Int(K) * (Z2_to_L2*kappa0*S2(K) - (TKE(K) - q0)*TKE_decay(K)) + & aQ(k-1) * (TKE(K-1) - TKE(K)) v1 = aQ(k-1) + dQdz(k-1)*dKdQ(K-1) @@ -1764,8 +1767,7 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, & else bQ = 1.0 / (aQ(k) + (cQcomp*aQ(k-1) + decay_term_Q)) ! Ensure that TKE+dQ will not drop below 0.5*TKE. - dQ(K) = max(bQ * ((v1 * dQ(K-1) + dQdz(k-1)*US%s_to_T*dK(K-1)) + tke_src), & - -0.5*TKE(K)) + dQ(K) = max(bQ * ((v1 * dQ(K-1) + dQdz(k-1)*dK(K-1)) + tke_src), -0.5*TKE(K)) TKE(K) = max(TKE(K) + dQ(K), TKE_min) endif else @@ -1779,10 +1781,10 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, & #ifdef DEBUG if (K < nz+1) then ! Ignore this source? - aQ(k) = US%s_to_T*(0.5*(kappa(K)+kappa(K+1))+kappa0) * Idz(k) - tke_src = (dz_Int(K) * (Z2_to_L2*US%s_to_T*kappa0*S2(K) - (TKE(K)-q0)*TKE_decay(K)) - & - (aQ(k) * (TKE(K) - TKE(K+1)) - aQ(k-1) * (TKE(K-1) - TKE(K))) ) / & - (aQ(k) + (aQ(k-1) + dz_Int(K)*TKE_decay(K))) + aQ(k) = (0.5*(kappa(K)+kappa(K+1))+kappa0) * Idz(k) + tke_src_norm = (dz_Int(K) * (Z2_to_L2*kappa0*S2(K) - (TKE(K)-q0)*TKE_decay(K)) - & + (aQ(k) * (TKE(K) - TKE(K+1)) - aQ(k-1) * (TKE(K-1) - TKE(K))) ) / & + (aQ(k) + (aQ(k-1) + dz_Int(K)*TKE_decay(K))) endif #endif dK(K) = 0.0 @@ -1799,10 +1801,9 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, & if (.not. abort_Newton) then do K=ke_kappa,2,-1 ! Ensure that TKE+dQ will not drop below 0.5*TKE. - dQ(K) = max(dQ(K) + (cQ(K+1)*dQ(K+1) + dQmdK(K+1) * US%s_to_T*dK(K+1)), & - -0.5*TKE(K)) + dQ(K) = max(dQ(K) + (cQ(K+1)*dQ(K+1) + dQmdK(K+1) * dK(K+1)), -0.5*TKE(K)) TKE(K) = max(TKE(K) + dQ(K), TKE_min) - dK(K) = dK(K) + (cK(K+1)*dK(K+1) + US%T_to_s*dKdQ(K) * dQ(K)) + dK(K) = dK(K) + (cK(K+1)*dK(K+1) + dKdQ(K) * dQ(K)) ! Truncate away negligibly small values of kappa. if (dK(K) <= kappa_trunc - kappa(K)) then dK(K) = -kappa(K) @@ -1817,7 +1818,7 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, & if (K<=ks_kappa) ks_kappa = 2 endif enddo - dQ(1) = max(dQ(1) + cQ(2)*dQ(2) + dQmdK(2) * US%s_to_T*dK(2), TKE_min - TKE(1)) + dQ(1) = max(dQ(1) + cQ(2)*dQ(2) + dQmdK(2) * dK(2), TKE_min - TKE(1)) TKE(1) = max(TKE(1) + dQ(1), TKE_min) dK(1) = 0.0 endif @@ -1837,17 +1838,18 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, & kap_src = dz_Int(K) * (K_src(K) - I_Ld2(K)*kappa_prev(K)) + & (Idz(k-1)*(kappa_prev(k-1)-kappa_prev(k)) - & Idz(k)*(kappa_prev(k)-kappa_prev(k+1))) + !### The last line of the following appears to be dimensionally inconsistent with the first two. K_err_lin = -Idz(k-1)*(dK(K-1)-dK(K)) + Idz(k)*(dK(K)-dK(K+1)) + & dz_Int(K)*I_Ld2_debug(K)*dK(K) - kap_src - & US%Z_to_m*(N2(K)*Ilambda2 + f2)*I_Q**2*kappa_prev(K) * dQ(K) - tke_src = dz_Int(K) * (Z2_to_L2*US%s_to_T*(kappa_prev(K) + kappa0)*S2(K) - & - Z2_to_L2*US%s_to_T*kappa_prev(K)*N2(K) - (TKE_prev(K) - q0)*TKE_decay(K)) - & + tke_src = dz_Int(K) * (Z2_to_L2*(kappa_prev(K) + kappa0)*S2(K) - & + Z2_to_L2*kappa_prev(K)*N2(K) - (TKE_prev(K) - q0)*TKE_decay(K)) - & (aQ(k) * (TKE_prev(K) - TKE_prev(K+1)) - aQ(k-1) * (TKE_prev(K-1) - TKE_prev(K))) Q_err_lin = tke_src + (aQ(k-1) * (dQ(K-1)-dQ(K)) - aQ(k) * (dQ(k)-dQ(k+1))) - & - US%s_to_T*0.5*(TKE_prev(K)-TKE_prev(K+1))*Idz(k) * (dK(K) + dK(K+1)) - & - US%s_to_T*0.5*(TKE_prev(K)-TKE_prev(K-1))*Idz(k-1)* (dK(K-1) + dK(K)) + & - dz_Int(K) * (Z2_to_L2*US%s_to_T*dK(K) * (S2(K) - N2(K)) - dQ(K)*TKE_decay(K)) + 0.5*(TKE_prev(K)-TKE_prev(K+1))*Idz(k) * (dK(K) + dK(K+1)) - & + 0.5*(TKE_prev(K)-TKE_prev(K-1))*Idz(k-1)* (dK(K-1) + dK(K)) + & + dz_Int(K) * (Z2_to_L2*dK(K) * (S2(K) - N2(K)) - dQ(K)*TKE_decay(K)) enddo #endif endif ! End of the Newton's method solver. From be7a61fe7f5a5e087c93e4cc66a0af76ebe45447 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Wed, 26 Jun 2019 09:17:27 -0400 Subject: [PATCH 41/82] Rescaled frequencies in MOM_kappa_shear Rescaled the units of frequences from s-1 to T-1 throughout MOM_kappa_shear, including N2, S2 and f2, for better dimensional consistency testing. Also rescaled the internal units of buoyancy similarly. All answers are bitwise identical. --- .../vertical/MOM_kappa_shear.F90 | 78 ++++++++++--------- 1 file changed, 40 insertions(+), 38 deletions(-) diff --git a/src/parameterizations/vertical/MOM_kappa_shear.F90 b/src/parameterizations/vertical/MOM_kappa_shear.F90 index 92b585d629..2bf2b8d0c8 100644 --- a/src/parameterizations/vertical/MOM_kappa_shear.F90 +++ b/src/parameterizations/vertical/MOM_kappa_shear.F90 @@ -151,7 +151,7 @@ subroutine Calculate_kappa_shear(u_in, v_in, h, tv, p_surf, kappa_io, tke_io, & tke, & ! The Turbulent Kinetic Energy per unit mass at an interface [m2 s-2]. kappa_avg, & ! The time-weighted average of kappa [Z2 T-1 ~> m2 s-1]. tke_avg ! The time-weighted average of TKE [m2 s-2]. - real :: f2 ! The squared Coriolis parameter of each column [s-2]. + real :: f2 ! The squared Coriolis parameter of each column [T-2 ~> s-2]. real :: surface_pres ! The top surface pressure [Pa]. real :: dz_in_lay ! The running sum of the thickness in a layer [Z ~> m]. @@ -273,8 +273,8 @@ subroutine Calculate_kappa_shear(u_in, v_in, h, tv, p_surf, kappa_io, tke_io, & nzc = nz do k=1,nzc+1 ; kc(k) = k ; kf(k) = 0.0 ; enddo endif - f2 = 0.25 * US%s_to_T**2 * ((G%CoriolisBu(I,j)**2 + G%CoriolisBu(I-1,J-1)**2) + & - (G%CoriolisBu(I,J-1)**2 + G%CoriolisBu(I-1,J)**2)) + f2 = 0.25 * ((G%CoriolisBu(I,j)**2 + G%CoriolisBu(I-1,J-1)**2) + & + (G%CoriolisBu(I,J-1)**2 + G%CoriolisBu(I-1,J)**2)) surface_pres = 0.0 ; if (associated(p_surf)) surface_pres = p_surf(i,j) ! ---------------------------------------------------- I_Ld2_1d, dz_Int_1d @@ -424,7 +424,7 @@ subroutine Calc_kappa_shear_vertex(u_in, v_in, h, T_in, S_in, tv, p_surf, kappa_ tke, & ! The Turbulent Kinetic Energy per unit mass at an interface [m2 s-2]. kappa_avg, & ! The time-weighted average of kappa [Z2 T-1 ~> m2 s-1]. tke_avg ! The time-weighted average of TKE [m2 s-2]. - real :: f2 ! The squared Coriolis parameter of each column [s-2]. + real :: f2 ! The squared Coriolis parameter of each column [T-2 ~> s-2]. real :: surface_pres ! The top surface pressure [Pa]. real :: dz_in_lay ! The running sum of the thickness in a layer [Z ~> m]. @@ -578,7 +578,7 @@ subroutine Calc_kappa_shear_vertex(u_in, v_in, h, T_in, S_in, tv, p_surf, kappa_ nzc = nz do k=1,nzc+1 ; kc(k) = k ; kf(k) = 0.0 ; enddo endif - f2 = US%s_to_T**2 * G%CoriolisBu(I,J)**2 + f2 = G%CoriolisBu(I,J)**2 surface_pres = 0.0 ; if (associated(p_surf)) then surface_pres = 0.25 * ((p_surf(i,j) + p_surf(i+1,j+1)) + & (p_surf(i+1,j) + p_surf(i,j+1))) @@ -681,7 +681,7 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & intent(inout) :: tke !< The Turbulent Kinetic Energy per unit mass at !! an interface [m2 s-2]. integer, intent(in) :: nzc !< The number of active layers in the column. - real, intent(in) :: f2 !< The square of the Coriolis parameter [s-2]. + real, intent(in) :: f2 !< The square of the Coriolis parameter [T-2 ~> s-2]. real, intent(in) :: surface_pres !< The surface pressure [Pa]. real, dimension(SZK_(GV)), & intent(in) :: dz !< The layer thickness [Z ~> m]. @@ -718,14 +718,14 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & u_test, v_test, T_test, S_test real, dimension(nzc+1) :: & - N2, & ! The squared buoyancy frequency at an interface [s-2]. + N2, & ! The squared buoyancy frequency at an interface [T-2 ~> s-2]. dz_Int, & ! The extent of a finite-volume space surrounding an interface, ! as used in calculating kappa and TKE [Z ~> m]. I_dz_int, & ! The inverse of the distance between velocity & density points ! above and below an interface [Z-1 ~> m-1]. This is used to ! calculate N2, shear, and fluxes, and it might differ from ! 1/dz_Int, as they have different uses. - S2, & ! The squared shear at an interface [s-2]. + S2, & ! The squared shear at an interface [T-2 ~> s-2]. a1, & ! a1 is the coupling between adjacent interfaces in the TKE, ! velocity, and density equations [Z s-1 ~> m s-1] or [Z ~> m] c1, & ! c1 is used in the tridiagonal (and similar) solvers. @@ -739,7 +739,7 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & T_int, & ! The temperature interpolated to an interface [degC]. Sal_int, & ! The salinity interpolated to an interface [ppt]. dbuoy_dT, & ! The partial derivatives of buoyancy with changes in temperature - dbuoy_dS, & ! and salinity, [Z s-2 degC-1 ~> m s-2 degC-1] and [Z s-2 ppt-1 ~> m s-2 ppt-1]. + dbuoy_dS, & ! and salinity, [Z T-2 degC-1 ~> m s-2 degC-1] and [Z T-2 ppt-1 ~> m s-2 ppt-1]. I_L2_bdry, & ! The inverse of the square of twice the harmonic mean ! distance to the top and bottom boundaries [Z-2 ~> m-2]. K_Q, & ! Diffusivity divided by TKE [Z2 m-2 s2 T-1 ~> s]. @@ -756,8 +756,8 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & real :: b1 ! The inverse of the pivot in the tridiagonal equations. real :: bd1 ! A term in the denominator of b1. real :: d1 ! 1 - c1 in the tridiagonal equations. - real :: gR0 ! Rho_0 times g [kg m-2 s-2]. - real :: g_R0 ! g_R0 is g/Rho [Z m3 kg-1 s-2 ~> m4 kg-1 s-2]. + real :: gR0 ! Rho_0 times g [kg m-1 Z-1 s-2 ~> kg m-2 s-2]. + real :: g_R0 ! g_R0 is a rescaled version of g/Rho [Z m3 kg-1 T-2 ~> m4 kg-1 s-2]. real :: Norm ! A factor that normalizes two weights to 1 [Z-2 ~> m-2]. real :: tol_dksrc, tol2 ! ### Tolerances that need to be set better later. real :: tol_dksrc_low ! The tolerance for the fractional decrease in ksrc @@ -790,7 +790,7 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & real :: wt(SZK_(GV)+1), wt_tot, I_wt_tot, wt_itt real, dimension(SZK_(GV)+1) :: & Ri_k, tke_prev, dtke, dkappa, dtke_norm, & - N2_debug, & ! A version of N2 for debugging [s-2] + N2_debug, & ! A version of N2 for debugging [T-2 ~> s-2] ksrc_av ! The average through the iterations of k_src [T-1 ~> s-1]. real, dimension(SZK_(GV)+1,0:max_debug_itt) :: & tke_it1, N2_it1, Sh2_it1, ksrc_it1, kappa_it1, kprev_it1 @@ -804,7 +804,7 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & #endif Ri_crit = CS%Rino_crit - gR0 = GV%Rho0*(GV%g_Earth*US%m_to_Z) ; g_R0 = (GV%g_Earth*US%m_to_Z**2)/GV%Rho0 + gR0 = GV%Rho0*GV%g_Earth ; g_R0 = (GV%g_Earth*US%m_to_Z**2*US%T_to_s**2)/GV%Rho0 k0dt = dt*CS%kappa_0 ! These are hard-coded for now. Perhaps these could be made dynamic later? ! tol_dksrc = 0.5*tol_ksrc_chg ; tol_dksrc_low = 1.0 - 1.0/tol_ksrc_chg ? @@ -890,18 +890,18 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & if (use_temperature) then pressure(1) = surface_pres do K=2,nzc - pressure(K) = pressure(K-1) + gR0*US%Z_to_m*dz(k-1) + pressure(K) = pressure(K-1) + gR0*dz(k-1) T_int(K) = 0.5*(T(k-1) + T(k)) Sal_int(K) = 0.5*(Sal(k-1) + Sal(k)) enddo call calculate_density_derivs(T_int, Sal_int, pressure, dbuoy_dT, & dbuoy_dS, 2, nzc-1, tv%eqn_of_state) do K=2,nzc - dbuoy_dT(K) = -G_R0*dbuoy_dT(K) - dbuoy_dS(K) = -G_R0*dbuoy_dS(K) + dbuoy_dT(K) = -g_R0*dbuoy_dT(K) + dbuoy_dS(K) = -g_R0*dbuoy_dS(K) enddo else - do K=1,nzc+1 ; dbuoy_dT(K) = -G_R0 ; dbuoy_dS(K) = 0.0 ; enddo + do K=1,nzc+1 ; dbuoy_dT(K) = -g_R0 ; dbuoy_dS(K) = 0.0 ; enddo endif #ifdef DEBUG @@ -1023,7 +1023,7 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & Idtt = 1.0 / dt_test do K=max(ks_kappa-1,2),min(ke_kappa+1,nzc) if (N2(K) < Ri_crit * S2(K)) then ! Equivalent to Ri < Ri_crit. - K_src(K) = US%T_to_s*(2.0 * CS%Shearmix_rate * sqrt(S2(K))) * & + K_src(K) = (2.0 * CS%Shearmix_rate * sqrt(S2(K))) * & ((Ri_crit*S2(K) - N2(K)) / (Ri_crit*S2(K) + CS%FRi_curvature*N2(K))) if ((K_src(K) > max(tol_max(K), kappa_src(K) + Idtt*tol_chg(K))) .or. & (K_src(K) < min(tol_min(K), kappa_src(K) - Idtt*tol_chg(K)))) then @@ -1049,9 +1049,8 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & Idtt = 1.0 / (dt_test+dt_inc) do K=max(ks_kappa-1,2),min(ke_kappa+1,nzc) if (N2(K) < Ri_crit * S2(K)) then ! Equivalent to Ri < Ri_crit. - K_src(K) = US%T_to_s*(2.0 * CS%Shearmix_rate * sqrt(S2(K))) * & - ((Ri_crit*S2(K) - N2(K)) / & - (Ri_crit*S2(K) + CS%FRi_curvature*N2(K))) + K_src(K) = (2.0 * CS%Shearmix_rate * sqrt(S2(K))) * & + ((Ri_crit*S2(K) - N2(K)) / (Ri_crit*S2(K) + CS%FRi_curvature*N2(K))) if ((K_src(K) > max(tol_max(K), kappa_src(K) + Idtt*tol_chg(K))) .or. & (K_src(K) < min(tol_min(K), kappa_src(K) - Idtt*tol_chg(K)))) then valid_dt = .false. ; exit @@ -1206,7 +1205,7 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & if (present(I_Ld2_1d)) then do K=1,GV%ke+1 ; I_Ld2_1d(K) = 0.0 ; enddo do K=2,nzc ; if (TKE(K) > 0.0) & - I_Ld2_1d(K) = I_L2_bdry(K) + (N2(K) / CS%lambda**2 + f2) * US%Z_to_m**2 / TKE(K) + I_Ld2_1d(K) = I_L2_bdry(K) + (N2(K) / CS%lambda**2 + f2) * (US%s_to_T**2*US%Z_to_m**2) / TKE(K) enddo endif if (present(dz_Int_1d)) then @@ -1235,9 +1234,9 @@ subroutine calculate_projected_state(kappa, u0, v0, T0, S0, dt, nz, & real, dimension(nz+1), intent(in) :: I_dz_int !< The inverse of the layer's thicknesses !! [Z-1 ~> m-1]. real, dimension(nz+1), intent(in) :: dbuoy_dT !< The partial derivative of buoyancy with - !! temperature [Z s-2 degC-1 ~> m s-2 degC-1]. + !! temperature [Z T-2 degC-1 ~> m s-2 degC-1]. real, dimension(nz+1), intent(in) :: dbuoy_dS !< The partial derivative of buoyancy with - !! salinity [Z s-2 ppt-1 ~> m s-2 ppt-1]. + !! salinity [Z T-2 ppt-1 ~> m s-2 ppt-1]. real, intent(in) :: dt !< The time step [T ~> s]. real, dimension(nz), intent(inout) :: u !< The zonal velocity after dt [m s-1]. real, dimension(nz), intent(inout) :: v !< The meridional velocity after dt [m s-1]. @@ -1246,9 +1245,9 @@ subroutine calculate_projected_state(kappa, u0, v0, T0, S0, dt, nz, & type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(nz+1), optional, & - intent(inout) :: N2 !< The buoyancy frequency squared at interfaces [s-2]. + intent(inout) :: N2 !< The buoyancy frequency squared at interfaces [T-2 ~> s-2]. real, dimension(nz+1), optional, & - intent(inout) :: S2 !< The squared shear at interfaces [s-2]. + intent(inout) :: S2 !< The squared shear at interfaces [T-2 ~> s-2]. integer, optional, intent(in) :: ks_int !< The topmost k-index with a non-zero diffusivity. integer, optional, intent(in) :: ke_int !< The bottommost k-index with a non-zero !! diffusivity. @@ -1259,7 +1258,7 @@ subroutine calculate_projected_state(kappa, u0, v0, T0, S0, dt, nz, & ! Local variables real, dimension(nz+1) :: c1 real :: L2_to_Z2 ! A conversion factor from horizontal length units to vertical depth - ! units squared [Z2 m-2 ~> 1]. + ! units squared [Z2 s2 T-2 m-2 ~> 1]. real :: underflow_vel ! Velocities smaller in magnitude than underflow_vel are set to 0 [m s-1]. real :: a_a, a_b, b1, d1, bd1, b1nz_0 integer :: k, ks, ke @@ -1330,7 +1329,7 @@ subroutine calculate_projected_state(kappa, u0, v0, T0, S0, dt, nz, & endif if (present(S2)) then - L2_to_Z2 = US%m_to_Z**2 + L2_to_Z2 = US%m_to_Z**2 * US%T_to_s**2 S2(1) = 0.0 ; S2(nz+1) = 0.0 if (ks > 1) & S2(ks) = ((u(ks)-u0(ks-1))**2 + (v(ks)-v0(ks-1))**2) * (L2_to_Z2*I_dz_int(ks)**2) @@ -1361,8 +1360,8 @@ end subroutine calculate_projected_state subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, & nz, CS, GV, US, K_Q, tke, kappa, kappa_src, local_src) integer, intent(in) :: nz !< The number of layers to work on. - real, dimension(nz+1), intent(in) :: N2 !< The buoyancy frequency squared at interfaces [s-2]. - real, dimension(nz+1), intent(in) :: S2 !< The squared shear at interfaces [s-2]. + real, dimension(nz+1), intent(in) :: N2 !< The buoyancy frequency squared at interfaces [T-2 ~> s-2]. + real, dimension(nz+1), intent(in) :: S2 !< The squared shear at interfaces [T-2 ~> s-2]. real, dimension(nz+1), intent(in) :: kappa_in !< The initial guess at the diffusivity !! [Z2 T-1 ~> m2 s-1]. real, dimension(nz+1), intent(in) :: dz_Int !< The thicknesses associated with interfaces @@ -1370,7 +1369,7 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, & real, dimension(nz+1), intent(in) :: I_L2_bdry !< The inverse of the squared distance to !! boundaries [m-2]. real, dimension(nz), intent(in) :: Idz !< The inverse grid spacing of layers [Z-1 ~> m-1]. - real, intent(in) :: f2 !< The squared Coriolis parameter [s-2]. + real, intent(in) :: f2 !< The squared Coriolis parameter [T-2 ~> s-2]. type(Kappa_shear_CS), pointer :: CS !< A pointer to this module's control structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type @@ -1443,7 +1442,7 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, & real :: v1 ! A temporary variable proportional to [T-1 ~> s-1] real :: v2 real :: Z2_to_L2 ! A conversion factor from vertical depth units to horizontal length - ! units squared [m2 Z-2]. + ! units squared [m2 s-2 T2 Z-2]. real :: tol_err ! The tolerance for max_err that determines when to ! stop iterating. real :: Newton_err ! The tolerance for max_err that determines when to @@ -1481,7 +1480,7 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, & q0 = CS%TKE_bg ; kappa0 = CS%kappa_0 ; TKE_min = max(CS%TKE_bg,1.0E-20) Ri_crit = CS%Rino_crit Ilambda2 = 1.0 / CS%lambda**2 - Z2_to_L2 = US%Z_to_m**2 + Z2_to_L2 = US%s_to_T**2 * US%Z_to_m**2 kappa_trunc = 0.01*kappa0 ! ### CHANGE THIS HARD-WIRING LATER? do_Newton = .false. ; abort_Newton = .false. tol_err = CS%kappa_tol_err @@ -1495,7 +1494,7 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, & ! Ri = N2(K) / S2(K) ! k_src(K) = (2.0 * CS%Shearmix_rate * sqrt(S2(K))) * & ! ((Ri_crit - Ri) / (Ri_crit + CS%FRi_curvature*Ri)) - K_src(K) = US%T_to_s*(2.0 * CS%Shearmix_rate * sqrt(S2(K))) * & + K_src(K) = (2.0 * CS%Shearmix_rate * sqrt(S2(K))) * & ((Ri_crit*S2(K) - N2(K)) / (Ri_crit*S2(K) + CS%FRi_curvature*N2(K))) ke_src = K if (ks_src > k) ks_src = K @@ -1517,7 +1516,7 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, & do K=1,nz+1 kappa(K) = kappa_in(K) ! TKE_decay(K) = c_n*sqrt(N2(K)) + c_s*sqrt(S2(K)) ! The expression in JHL. - TKE_decay(K) = US%T_to_s*sqrt(c_n2*N2(K) + c_s2*S2(K)) + TKE_decay(K) = sqrt(c_n2*N2(K) + c_s2*S2(K)) if ((kappa(K) > 0.0) .and. (K_Q(K) > 0.0)) then TKE(K) = kappa(K) / K_Q(K) else @@ -1711,7 +1710,9 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, & cKcomp = bK * (Idz(k-1)*cKcomp + decay_term_k) ! = 1-cK(K+1) !### The following expression appears to be dimensionally inconsistent in length. -RWH dKdQ(K) = bK * (Idz(k-1)*dKdQ(K-1)*cQ(K) + & - US%Z_to_m*(N2(K)*Ilambda2 + f2) * I_Q**2 * kappa(K) ) + US%m_to_Z*Z2_to_L2*(N2(K)*Ilambda2 + f2) * I_Q**2 * kappa(K) ) + ! I think that the second term needs to be multiplied by dz_Int(K): + ! Z2_to_L2*dz_Int(K)*(N2(K)*Ilambda2 + f2) * I_Q**2 * kappa(K) ) dK(K) = bK * (kap_src + Idz(k-1)*dK(K-1) + Idz(k-1)*dKdQ(K-1)*dQ(K-1)) ! Truncate away negligibly small values of kappa. @@ -1839,9 +1840,10 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, & (Idz(k-1)*(kappa_prev(k-1)-kappa_prev(k)) - & Idz(k)*(kappa_prev(k)-kappa_prev(k+1))) !### The last line of the following appears to be dimensionally inconsistent with the first two. + ! I think that the term on the last line needs to be multiplied by dz_Int(K). K_err_lin = -Idz(k-1)*(dK(K-1)-dK(K)) + Idz(k)*(dK(K)-dK(K+1)) + & dz_Int(K)*I_Ld2_debug(K)*dK(K) - kap_src - & - US%Z_to_m*(N2(K)*Ilambda2 + f2)*I_Q**2*kappa_prev(K) * dQ(K) + US%m_to_Z*Z2_to_L2*(N2(K)*Ilambda2 + f2)*I_Q**2*kappa_prev(K) * dQ(K) tke_src = dz_Int(K) * (Z2_to_L2*(kappa_prev(K) + kappa0)*S2(K) - & Z2_to_L2*kappa_prev(K)*N2(K) - (TKE_prev(K) - q0)*TKE_decay(K)) - & @@ -1901,7 +1903,7 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, & (kappa0 + 0.5*(kappa(K) + kappa_prev(K))) K_Q_it1(K,itt) = kappa(K) / max(TKE(K),TKE_min) d_dkappa_it1(K,itt) = 0.0 - if (itt > 1) then ; if (abs(kappa_it1(K,itt-1)) > 1e-20*US%T_to_s) & + if (itt > 1) then ; if (abs(dkappa_it1(K,itt-1)) > 1e-20*US%m2_s_to_Z2_T) & d_dkappa_it1(K,itt) = dkappa_it1(K,itt) / dkappa_it1(K,itt-1) endif enddo From 4f224af0b97ce2b888dc7db4ea4df9a1999c60b0 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Wed, 26 Jun 2019 14:55:44 -0400 Subject: [PATCH 42/82] Rescaled TKE in MOM_kappa_shear Rescaled the units of TKE-related variables from m2 s-2 to Z2 T-2 throughout MOM_kappa_shear, including some rates of TKE change, for better dimensional consistency testing. All answers are bitwise identical. --- .../vertical/MOM_kappa_shear.F90 | 93 +++++++++---------- 1 file changed, 46 insertions(+), 47 deletions(-) diff --git a/src/parameterizations/vertical/MOM_kappa_shear.F90 b/src/parameterizations/vertical/MOM_kappa_shear.F90 index 2bf2b8d0c8..2d0cbc2785 100644 --- a/src/parameterizations/vertical/MOM_kappa_shear.F90 +++ b/src/parameterizations/vertical/MOM_kappa_shear.F90 @@ -55,7 +55,7 @@ module MOM_kappa_shear real :: lambda2_N_S !< The square of the ratio of the coefficients of !! the buoyancy and shear scales in the diffusivity !! equation, 0 to eliminate the shear scale. Nondim. - real :: TKE_bg !< The background level of TKE [m2 s-2]. + real :: TKE_bg !< The background level of TKE [Z2 T-2 ~> m2 s-2]. real :: kappa_0 !< The background diapycnal diffusivity [Z2 s-1 ~> m2 s-1]. real :: kappa_tol_err !< The fractional error in kappa that is tolerated. real :: Prandtl_turb !< Prandtl number used to convert Kd_shear into viscosity. @@ -134,7 +134,8 @@ subroutine Calculate_kappa_shear(u_in, v_in, h, tv, p_surf, kappa_io, tke_io, & h_2d, & ! A 2-D version of h, but converted to m. u_2d, v_2d, T_2d, S_2d, rho_2d ! 2-D versions of u_in, v_in, T, S, and rho. real, dimension(SZI_(G),SZK_(GV)+1) :: & - kappa_2d, tke_2d ! 2-D versions of various kappa_io and tke_io. + kappa_2d, & ! 2-D version of kappa_io [Z2 T-1 ~> m2 s-1]. + tke_2d ! 2-D version tke_io [Z2 T-2 ~> m2 s-2]. real, dimension(SZK_(GV)) :: & u, & ! The zonal velocity after a timestep of mixing [m s-1]. v, & ! The meridional velocity after a timestep of mixing [m s-1]. @@ -148,9 +149,9 @@ subroutine Calculate_kappa_shear(u_in, v_in, h, tv, p_surf, kappa_io, tke_io, & S0xdz ! The initial salinity times dz [ppt Z ~> ppt m]. real, dimension(SZK_(GV)+1) :: & kappa, & ! The shear-driven diapycnal diffusivity at an interface [Z2 T-1 ~> m2 s-1]. - tke, & ! The Turbulent Kinetic Energy per unit mass at an interface [m2 s-2]. + tke, & ! The Turbulent Kinetic Energy per unit mass at an interface [Z2 T-2 ~> m2 s-2]. kappa_avg, & ! The time-weighted average of kappa [Z2 T-1 ~> m2 s-1]. - tke_avg ! The time-weighted average of TKE [m2 s-2]. + tke_avg ! The time-weighted average of TKE [Z2 T-2 ~> m2 s-2]. real :: f2 ! The squared Coriolis parameter of each column [T-2 ~> s-2]. real :: surface_pres ! The top surface pressure [Pa]. @@ -335,7 +336,7 @@ subroutine Calculate_kappa_shear(u_in, v_in, h, tv, p_surf, kappa_io, tke_io, & do K=1,nz+1 ; do i=is,ie kappa_io(i,j,K) = G%mask2dT(i,j) * kappa_2d(i,K) - tke_io(i,j,K) = G%mask2dT(i,j) * tke_2d(i,K) + tke_io(i,j,K) = G%mask2dT(i,j) * (US%Z_to_m**2*US%s_to_T**2)*tke_2d(i,K) kv_io(i,j,K) = ( G%mask2dT(i,j) * kappa_2d(i,K) ) * CS%Prandtl_turb #ifdef ADD_DIAGNOSTICS I_Ld2_3d(i,j,K) = I_Ld2_2d(i,K) ; dz_Int_3d(i,j,K) = dz_Int_2d(i,K) @@ -407,7 +408,7 @@ subroutine Calc_kappa_shear_vertex(u_in, v_in, h, T_in, S_in, tv, p_surf, kappa_ real, dimension(SZIB_(G),SZK_(GV)+1,2) :: & kappa_2d ! Quasi 2-D versions of kappa_io [Z2 T-1 ~> m2 s-1]. real, dimension(SZIB_(G),SZK_(GV)+1) :: & - tke_2d ! 2-D version tke_io [m2 s-2]. + tke_2d ! 2-D version tke_io [Z2 T-2 ~> m2 s-2]. real, dimension(SZK_(GV)) :: & u, & ! The zonal velocity after a timestep of mixing [m s-1]. v, & ! The meridional velocity after a timestep of mixing [m s-1]. @@ -421,9 +422,9 @@ subroutine Calc_kappa_shear_vertex(u_in, v_in, h, T_in, S_in, tv, p_surf, kappa_ S0xdz ! The initial salinity times dz [ppt Z ~> ppt m]. real, dimension(SZK_(GV)+1) :: & kappa, & ! The shear-driven diapycnal diffusivity at an interface [Z2 T-1 ~> m2 s-1]. - tke, & ! The Turbulent Kinetic Energy per unit mass at an interface [m2 s-2]. + tke, & ! The Turbulent Kinetic Energy per unit mass at an interface [Z2 T-2 ~> m2 s-2]. kappa_avg, & ! The time-weighted average of kappa [Z2 T-1 ~> m2 s-1]. - tke_avg ! The time-weighted average of TKE [m2 s-2]. + tke_avg ! The time-weighted average of TKE [Z2 T-2 ~> m2 s-2]. real :: f2 ! The squared Coriolis parameter of each column [T-2 ~> s-2]. real :: surface_pres ! The top surface pressure [Pa]. @@ -679,7 +680,7 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & intent(inout) :: kappa !< The time-weighted average of kappa [Z2 T-1 ~> m2 s-1]. real, dimension(SZK_(GV)+1), & intent(inout) :: tke !< The Turbulent Kinetic Energy per unit mass at - !! an interface [m2 s-2]. + !! an interface [Z2 T-2 ~> m2 s-2]. integer, intent(in) :: nzc !< The number of active layers in the column. real, intent(in) :: f2 !< The square of the Coriolis parameter [T-2 ~> s-2]. real, intent(in) :: surface_pres !< The surface pressure [Pa]. @@ -696,7 +697,7 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & real, dimension(SZK_(GV)+1), & intent(out) :: kappa_avg !< The time-weighted average of kappa [Z2 T-1 ~> m2 s-1]. real, dimension(SZK_(GV)+1), & - intent(out) :: tke_avg !< The time-weighted average of TKE [m2 s-2]. + intent(out) :: tke_avg !< The time-weighted average of TKE [Z2 T-2 ~> m2 s-2]. real, intent(in) :: dt !< Time increment [T ~> s]. type(thermo_var_ptrs), intent(in) :: tv !< A structure containing pointers to any !! available thermodynamic fields. Absent fields @@ -733,7 +734,7 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & kappa_src, & ! The shear-dependent source term in the kappa equation [T-1 ~> s-1]. kappa_out, & ! The kappa that results from the kappa equation [Z2 T-1 ~> m2 s-1]. kappa_mid, & ! The average of the initial and predictor estimates of kappa [Z2 T-1 ~> m2 s-1]. - tke_pred, & ! The value of TKE from a predictor step [m2 s-2]. + tke_pred, & ! The value of TKE from a predictor step [Z2 T-2 ~> m2 s-2]. kappa_pred, & ! The value of kappa from a predictor step [Z2 T-1 ~> m2 s-1]. pressure, & ! The pressure at an interface [Pa]. T_int, & ! The temperature interpolated to an interface [degC]. @@ -1205,7 +1206,7 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & if (present(I_Ld2_1d)) then do K=1,GV%ke+1 ; I_Ld2_1d(K) = 0.0 ; enddo do K=2,nzc ; if (TKE(K) > 0.0) & - I_Ld2_1d(K) = I_L2_bdry(K) + (N2(K) / CS%lambda**2 + f2) * (US%s_to_T**2*US%Z_to_m**2) / TKE(K) + I_Ld2_1d(K) = I_L2_bdry(K) + (N2(K) / CS%lambda**2 + f2) / TKE(K) enddo endif if (present(dz_Int_1d)) then @@ -1367,7 +1368,7 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, & real, dimension(nz+1), intent(in) :: dz_Int !< The thicknesses associated with interfaces !! [Z-1 ~> m-1]. real, dimension(nz+1), intent(in) :: I_L2_bdry !< The inverse of the squared distance to - !! boundaries [m-2]. + !! boundaries [Z-2 !> m-2]. real, dimension(nz), intent(in) :: Idz !< The inverse grid spacing of layers [Z-1 ~> m-1]. real, intent(in) :: f2 !< The squared Coriolis parameter [T-2 ~> s-2]. type(Kappa_shear_CS), pointer :: CS !< A pointer to this module's control structure. @@ -1377,7 +1378,7 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, & !! the turbulent kinetic energy per unit mass at !! interfaces [Z2 m-2 s2 T-1 ~> s]. real, dimension(nz+1), intent(out) :: tke !< The turbulent kinetic energy per unit mass at - !! interfaces [m2 s-2]. + !! interfaces [Z2 T-2 ~> m2 s-2]. real, dimension(nz+1), intent(out) :: kappa !< The diapycnal diffusivity at interfaces !! [Z2 T-1 ~> m2 s-1]. real, dimension(nz+1), optional, & @@ -1390,22 +1391,22 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, & ! Local variables real, dimension(nz) :: & aQ, & ! aQ is the coupling between adjacent interfaces in the TKE equations [Z T-1 ~> m s-1]. - dQdz ! Half the partial derivative of TKE with depth [m s-2]. + dQdz ! Half the partial derivative of TKE with depth [Z T-2 ~> m s-2]. real, dimension(nz+1) :: & dK, & ! The change in kappa [Z2 T-1 ~> m2 s-1]. - dQ, & ! The change in TKE [m2 s-2]. + dQ, & ! The change in TKE [Z2 T-2 ~> m2 s-2]. cQ, cK, & ! cQ and cK are the upward influences in the tridiagonal and ! hexadiagonal solvers for the TKE and kappa equations [nondim]. I_Ld2, & ! 1/Ld^2, where Ld is the effective decay length scale for kappa [Z-2 ~> m-2]. TKE_decay, & ! The local TKE decay rate [T-1 ~> s-1]. k_src, & ! The source term in the kappa equation [T-1 ~> s-1]. - dQmdK, & ! With Newton's method the change in dQ(k-1) due to dK(k) [m2 T Z-2 ~> s]. - dKdQ, & ! With Newton's method the change in dK(k) due to dQ(k) [Z2 m-2 T-1 ~> s-1]. + dQmdK, & ! With Newton's method the change in dQ(k-1) due to dK(k) [T ~> s]. + dKdQ, & ! With Newton's method the change in dK(k) due to dQ(k) [T-1 ~> s-1]. e1 ! The fractional change in a layer TKE due to a change in the ! TKE of the layer above when all the kappas below are 0. ! e1 is nondimensional, and 0 < e1 < 1. real :: tke_src ! The net source of TKE due to mixing against the shear - ! and stratification [m2 s-2 T-1 ~> m2 s-3]. (For convenience, + ! and stratification [Z2 T-3 ~> m2 s-3]. (For convenience, ! a term involving the non-dissipation of q0 is also ! included here.) real :: bQ ! The inverse of the pivot in the tridiagonal equations [T Z-1 ~> s m-1]. @@ -1419,15 +1420,15 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, & ! stratification (i.e. proportional to N*tke) [nondim]. real :: Ri_crit ! The critical shear Richardson number for shear- ! driven mixing. The theoretical value is 0.25. - real :: q0 ! The background level of TKE [m2 s-2]. + real :: q0 ! The background level of TKE [Z2 T-2 ~> m2 s-2]. real :: Ilambda2 ! 1.0 / CS%lambda**2 [nondim] real :: TKE_min ! The minimum value of shear-driven TKE that can be - ! solved for [m2 s-2]. + ! solved for [Z2 T-2 ~> m2 s-2]. real :: kappa0 ! The background diapycnal diffusivity [Z2 T-1 ~> m2 s-1]. real :: kappa_trunc ! Diffusivities smaller than this are rounded to 0 [Z2 T-1 ~> m2 s-1]. real :: eden1, eden2, I_eden, ome ! Variables used in calculating e1. - real :: diffusive_src ! The diffusive source in the kappa equation [m T-1 ~> m s-1]. + real :: diffusive_src ! The diffusive source in the kappa equation [Z T-1 ~> m s-1]. real :: chg_by_k0 ! The value of k_src that leads to an increase of ! kappa_0 if only the diffusive term is a sink [T-1 ~> s-1]. @@ -1441,8 +1442,6 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, & real :: kap_src real :: v1 ! A temporary variable proportional to [T-1 ~> s-1] real :: v2 - real :: Z2_to_L2 ! A conversion factor from vertical depth units to horizontal length - ! units squared [m2 s-2 T2 Z-2]. real :: tol_err ! The tolerance for max_err that determines when to ! stop iterating. real :: Newton_err ! The tolerance for max_err that determines when to @@ -1469,7 +1468,7 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, & real, dimension(nz+1) :: & I_Ld2_debug, & ! A separate version of I_Ld2 for debugging [Z-2 ~> m-2]. kappa_prev, & ! The value of kappa at the start of the current iteration [Z2 T-1 ~> m2 s-1]. - TKE_prev ! The value of TKE at the start of the current iteration [m2 s-2]. + TKE_prev ! The value of TKE at the start of the current iteration [Z2 T-2 ~> m2 s-2]. real, dimension(nz+1,1:max_debug_itt) :: & tke_it1, kappa_it1, kprev_it1, & ! Various values from each iteration. dkappa_it1, K_Q_it1, d_dkappa_it1, dkappa_norm_it1 @@ -1477,10 +1476,10 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, & #endif c_N2 = CS%C_N**2 ; c_S2 = CS%C_S**2 - q0 = CS%TKE_bg ; kappa0 = CS%kappa_0 ; TKE_min = max(CS%TKE_bg,1.0E-20) + q0 = CS%TKE_bg ; kappa0 = CS%kappa_0 + TKE_min = max(CS%TKE_bg, 1.0E-20*US%m_to_Z**2*US%T_to_s**2) Ri_crit = CS%Rino_crit Ilambda2 = 1.0 / CS%lambda**2 - Z2_to_L2 = US%s_to_T**2 * US%Z_to_m**2 kappa_trunc = 0.01*kappa0 ! ### CHANGE THIS HARD-WIRING LATER? do_Newton = .false. ; abort_Newton = .false. tol_err = CS%kappa_tol_err @@ -1570,7 +1569,7 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, & enddo dQ(1) = -TKE(1) if (tke_noflux_top_BC) then - tke_src = Z2_to_L2*kappa0*S2(1) + q0 * TKE_decay(1) ! Uses that kappa(1) = 0 + tke_src = kappa0*S2(1) + q0 * TKE_decay(1) ! Uses that kappa(1) = 0 bQd1 = dz_Int(1) * TKE_decay(1) bQ = 1.0 / (bQd1 + aQ(1)) tke(1) = bQ * (dz_Int(1)*tke_src) @@ -1580,8 +1579,8 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, & endif do K=2,ke_tke-1 dQ(K) = -TKE(K) - tke_src = Z2_to_L2*(kappa(K) + kappa0)*S2(K) + q0*TKE_decay(K) - bQd1 = dz_Int(K)*(TKE_decay(K) + N2(K)*Z2_to_L2*K_Q(K)) + cQcomp*aQ(k-1) + tke_src = (kappa(K) + kappa0)*S2(K) + q0*TKE_decay(K) + bQd1 = dz_Int(K)*(TKE_decay(K) + N2(K)*K_Q(K)) + cQcomp*aQ(k-1) bQ = 1.0 / (bQd1 + aQ(k)) tke(K) = bQ * (dz_Int(K)*tke_src + aQ(k-1)*tke(K-1)) cQ(K+1) = aQ(k) * bQ ; cQcomp = bQd1 * bQ ! = 1 - cQ @@ -1591,7 +1590,7 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, & dQ(nz+1) = 0.0 else k = ke_tke - tke_src = Z2_to_L2*kappa0*S2(K) + q0*TKE_decay(K) ! Uses that kappa(ke_tke) = 0 + tke_src = kappa0*S2(K) + q0*TKE_decay(K) ! Uses that kappa(ke_tke) = 0 if (K == nz+1) then dQ(K) = -TKE(K) bQ = 1.0 / (dz_Int(K)*TKE_decay(K) + cQcomp*aQ(k-1)) @@ -1633,12 +1632,12 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, & dK(1) = 0.0 ! kappa takes boundary values of 0. cK(2) = 0.0 ; cKcomp = 1.0 if (itt == 1) then ; dO K=2,nz - I_Ld2(K) = (N2(K)*Ilambda2 + f2) * Z2_to_L2 / tke(K) + I_L2_bdry(K) + I_Ld2(K) = (N2(K)*Ilambda2 + f2) / tke(K) + I_L2_bdry(K) enddo ; endif do K=2,nz dK(K) = -kappa(K) if (itt>1) & - I_Ld2(K) = (N2(K)*Ilambda2 + f2) * Z2_to_L2 / tke(K) + I_L2_bdry(K) + I_Ld2(K) = (N2(K)*Ilambda2 + f2) / tke(K) + I_L2_bdry(K) bKd1 = dz_Int(K)*I_Ld2(K) + cKcomp*Idz(k-1) bK = 1.0 / (bKd1 + Idz(k)) @@ -1682,7 +1681,7 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, & aQ(1) = (0.5*(kappa(1)+kappa(2))+kappa0) * Idz(1) dQdz(1) = 0.5*(TKE(1) - TKE(2))*Idz(1) if (tke_noflux_top_BC) then - tke_src = dz_Int(1) * (Z2_to_L2*kappa0*S2(1) - (TKE(1) - q0)*TKE_decay(1)) - & + tke_src = dz_Int(1) * (kappa0*S2(1) - (TKE(1) - q0)*TKE_decay(1)) - & aQ(1) * (TKE(1) - TKE(2)) bQ = 1.0 / (aQ(1) + dz_Int(1)*TKE_decay(1)) @@ -1695,7 +1694,7 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, & endif do K=2,nz I_Q = 1.0 / TKE(K) - I_Ld2(K) = (N2(K)*Ilambda2 + f2) * (Z2_to_L2*I_Q) + I_L2_bdry(K) + I_Ld2(K) = (N2(K)*Ilambda2 + f2) * I_Q + I_L2_bdry(K) kap_src = dz_Int(K) * (K_src(K) - I_Ld2(K)*kappa(K)) + & Idz(k-1)*(kappa(K-1)-kappa(K)) - Idz(k)*(kappa(K)-kappa(K+1)) @@ -1710,9 +1709,9 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, & cKcomp = bK * (Idz(k-1)*cKcomp + decay_term_k) ! = 1-cK(K+1) !### The following expression appears to be dimensionally inconsistent in length. -RWH dKdQ(K) = bK * (Idz(k-1)*dKdQ(K-1)*cQ(K) + & - US%m_to_Z*Z2_to_L2*(N2(K)*Ilambda2 + f2) * I_Q**2 * kappa(K) ) + US%m_to_Z*(N2(K)*Ilambda2 + f2) * I_Q**2 * kappa(K) ) ! I think that the second term needs to be multiplied by dz_Int(K): - ! Z2_to_L2*dz_Int(K)*(N2(K)*Ilambda2 + f2) * I_Q**2 * kappa(K) ) + ! dz_Int(K)*(N2(K)*Ilambda2 + f2) * I_Q**2 * kappa(K) ) dK(K) = bK * (kap_src + Idz(k-1)*dK(K-1) + Idz(k-1)*dKdQ(K-1)*dQ(K-1)) ! Truncate away negligibly small values of kappa. @@ -1726,12 +1725,12 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, & ! Solve for dQ(K)... aQ(k) = (0.5*(kappa(K)+kappa(K+1))+kappa0) * Idz(k) dQdz(k) = 0.5*(TKE(K) - TKE(K+1))*Idz(k) - tke_src = dz_Int(K) * (Z2_to_L2*((kappa(K) + kappa0)*S2(K) - kappa(k)*N2(K)) - & + tke_src = dz_Int(K) * (((kappa(K) + kappa0)*S2(K) - kappa(k)*N2(K)) - & (TKE(k) - q0)*TKE_decay(k)) - & (aQ(k) * (TKE(K) - TKE(K+1)) - aQ(k-1) * (TKE(K-1) - TKE(K))) v1 = aQ(k-1) + dQdz(k-1)*dKdQ(K-1) v2 = (v1*dQmdK(K) + dQdz(k-1)*cK(K)) + & - ((dQdz(k-1) - dQdz(k)) + Z2_to_L2*dz_Int(K)*(S2(K) - N2(K))) + ((dQdz(k-1) - dQdz(k)) + dz_Int(K)*(S2(K) - N2(K))) ! Ensure that the pivot is always positive, and that 0 <= cQ <= 1. ! Otherwise do not use Newton's method. @@ -1758,7 +1757,7 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, & dK(nz+1) = 0.0 ; dKdQ(nz+1) = 0.0 if (tke_noflux_bottom_BC) then K = nz+1 - tke_src = dz_Int(K) * (Z2_to_L2*kappa0*S2(K) - (TKE(K) - q0)*TKE_decay(K)) + & + tke_src = dz_Int(K) * (kappa0*S2(K) - (TKE(K) - q0)*TKE_decay(K)) + & aQ(k-1) * (TKE(K-1) - TKE(K)) v1 = aQ(k-1) + dQdz(k-1)*dKdQ(K-1) @@ -1783,7 +1782,7 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, & if (K < nz+1) then ! Ignore this source? aQ(k) = (0.5*(kappa(K)+kappa(K+1))+kappa0) * Idz(k) - tke_src_norm = (dz_Int(K) * (Z2_to_L2*kappa0*S2(K) - (TKE(K)-q0)*TKE_decay(K)) - & + tke_src_norm = (dz_Int(K) * (kappa0*S2(K) - (TKE(K)-q0)*TKE_decay(K)) - & (aQ(k) * (TKE(K) - TKE(K+1)) - aQ(k-1) * (TKE(K-1) - TKE(K))) ) / & (aQ(k) + (aQ(k-1) + dz_Int(K)*TKE_decay(K))) endif @@ -1834,7 +1833,7 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, & ! been increased to ensure a positive pivot, or 2) negative TKEs have been ! truncated, or 3) small or negative kappas have been rounded toward 0. I_Q = 1.0 / TKE(K) - I_Ld2_debug(K) = (N2(K)*Ilambda2 + f2) * (Z2_to_L2*I_Q) + I_L2_bdry(K) + I_Ld2_debug(K) = (N2(K)*Ilambda2 + f2) * I_Q + I_L2_bdry(K) kap_src = dz_Int(K) * (K_src(K) - I_Ld2(K)*kappa_prev(K)) + & (Idz(k-1)*(kappa_prev(k-1)-kappa_prev(k)) - & @@ -1843,15 +1842,15 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, & ! I think that the term on the last line needs to be multiplied by dz_Int(K). K_err_lin = -Idz(k-1)*(dK(K-1)-dK(K)) + Idz(k)*(dK(K)-dK(K+1)) + & dz_Int(K)*I_Ld2_debug(K)*dK(K) - kap_src - & - US%m_to_Z*Z2_to_L2*(N2(K)*Ilambda2 + f2)*I_Q**2*kappa_prev(K) * dQ(K) + US%m_to_Z*(N2(K)*Ilambda2 + f2)*I_Q**2*kappa_prev(K) * dQ(K) - tke_src = dz_Int(K) * (Z2_to_L2*(kappa_prev(K) + kappa0)*S2(K) - & - Z2_to_L2*kappa_prev(K)*N2(K) - (TKE_prev(K) - q0)*TKE_decay(K)) - & + tke_src = dz_Int(K) * ((kappa_prev(K) + kappa0)*S2(K) - & + kappa_prev(K)*N2(K) - (TKE_prev(K) - q0)*TKE_decay(K)) - & (aQ(k) * (TKE_prev(K) - TKE_prev(K+1)) - aQ(k-1) * (TKE_prev(K-1) - TKE_prev(K))) Q_err_lin = tke_src + (aQ(k-1) * (dQ(K-1)-dQ(K)) - aQ(k) * (dQ(k)-dQ(k+1))) - & 0.5*(TKE_prev(K)-TKE_prev(K+1))*Idz(k) * (dK(K) + dK(K+1)) - & 0.5*(TKE_prev(K)-TKE_prev(K-1))*Idz(k-1)* (dK(K-1) + dK(K)) + & - dz_Int(K) * (Z2_to_L2*dK(K) * (S2(K) - N2(K)) - dQ(K)*TKE_decay(K)) + dz_Int(K) * (dK(K) * (S2(K) - N2(K)) - dQ(K)*TKE_decay(K)) enddo #endif endif ! End of the Newton's method solver. @@ -2048,7 +2047,7 @@ function kappa_shear_init(Time, G, GV, US, param_file, diag, CS) call get_param(param_file, mdl, "TKE_BACKGROUND", CS%TKE_bg, & "A background level of TKE used in the first iteration "//& "of the kappa equation. TKE_BACKGROUND could be 0.", & - units="m2 s-2", default=0.0) + units="m2 s-2", default=0.0, scale=US%m_to_Z**2*US%T_to_s**2) call get_param(param_file, mdl, "KAPPA_SHEAR_ELIM_MASSLESS", CS%eliminate_massless, & "If true, massless layers are merged with neighboring "//& "massive layers in this calculation. The default is "//& From ea25c1b7258489909e4f0f5ae64895122f65f2b2 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Wed, 26 Jun 2019 17:20:58 -0400 Subject: [PATCH 43/82] +Altered arguments to Calculate_kappa_shear Altered arguments to Calculate_kappa_shear and Calc_kappa_shear_vertex, changing the units of dt from [s] to {T}, and making tke_io intent out and changing its units from [m2 s-2] to [Z2 T-2] and altering chksum calls on TKE_turb accordingly. Also eliminated TKE_turb from the MOM_restart files, as this serves no purpose. All answers are bitwise identical. --- src/core/MOM_variables.F90 | 2 +- .../vertical/MOM_diabatic_driver.F90 | 11 ++-- .../vertical/MOM_kappa_shear.F90 | 59 +++++++------------ .../vertical/MOM_set_diffusivity.F90 | 11 ++-- .../vertical/MOM_set_viscosity.F90 | 14 ++--- 5 files changed, 37 insertions(+), 60 deletions(-) diff --git a/src/core/MOM_variables.F90 b/src/core/MOM_variables.F90 index 2202e53f32..8df0b31406 100644 --- a/src/core/MOM_variables.F90 +++ b/src/core/MOM_variables.F90 @@ -255,7 +255,7 @@ module MOM_variables !< The turbulent vertical viscosity component due to "slow" processes (e.g., tidal, !! background, convection etc) [Z2 T-1 ~> m2 s-1]. real, pointer, dimension(:,:,:) :: TKE_turb => NULL() - !< The turbulent kinetic energy per unit mass at the interfaces [m2 s-2]. + !< The turbulent kinetic energy per unit mass at the interfaces [Z2 T-2 ~> m2 s-2]. !! This may be at the tracer or corner points logical :: add_Kv_slow !< If True, add Kv_slow when calculating the 'coupling coefficient' (a_cpl) !! at the interfaces in find_coupling_coef. diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index b1d8bf0974..6e08135919 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -562,8 +562,8 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & endif ! end CS%use_int_tides call cpu_clock_begin(id_clock_set_diffusivity) - ! Sets: Kd_lay, Kd_int, visc%Kd_extra_T, visc%Kd_extra_S - ! Also changes: visc%Kd_shear, visc%Kv_slow and visc%TKE_turb (not clear that TKE_turb is used as input ???? + ! Sets: Kd_lay, Kd_int, visc%Kd_extra_T, visc%Kd_extra_S and visc%TKE_turb + ! Also changes: visc%Kd_shear, visc%Kv_shear and visc%Kv_slow call set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, CS%optics, visc, dt, G, GV, US, & CS%set_diff_CSp, Kd_lay, Kd_int) call cpu_clock_end(id_clock_set_diffusivity) @@ -754,7 +754,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & ! Augment the diffusivities and viscosity due to those diagnosed in energetic_PBL. do K=2,nz ; do j=js,je ; do i=is,ie - !### These expressesions assume a Prandtl number of 1. + !### These expressions assume a Prandtl number of 1. if (CS%ePBL_is_additive) then Kd_add_here = Kd_ePBL(i,j,K) visc%Kv_shear(i,j,K) = visc%Kv_shear(i,j,K) + Kd_ePBL(i,j,K) @@ -1462,9 +1462,8 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en endif call cpu_clock_begin(id_clock_set_diffusivity) - ! Sets: Kd_lay, Kd_int, visc%Kd_extra_T, visc%Kd_extra_S - ! Also changes: visc%Kd_shear, visc%TKE_turb (not clear that TKE_turb is used as input ???? - ! And sets visc%Kv_shear + ! Sets: Kd_lay, Kd_int, visc%Kd_extra_T, visc%Kd_extra_S and visc%TKE_turb + ! Also changes: visc%Kd_shear and visc%Kv_shear if ((CS%halo_TS_diff > 0) .and. (CS%ML_mix_first > 0.0)) then if (associated(tv%T)) call pass_var(tv%T, G%Domain, halo=CS%halo_TS_diff, complete=.false.) if (associated(tv%T)) call pass_var(tv%S, G%Domain, halo=CS%halo_TS_diff, complete=.false.) diff --git a/src/parameterizations/vertical/MOM_kappa_shear.F90 b/src/parameterizations/vertical/MOM_kappa_shear.F90 index 2d0cbc2785..145174d568 100644 --- a/src/parameterizations/vertical/MOM_kappa_shear.F90 +++ b/src/parameterizations/vertical/MOM_kappa_shear.F90 @@ -113,17 +113,14 @@ subroutine Calculate_kappa_shear(u_in, v_in, h, tv, p_surf, kappa_io, tke_io, & !! value from the previous timestep, which may !! accelerate the iteration toward convergence. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), & - intent(inout) :: tke_io !< The turbulent kinetic energy per unit mass at - !! each interface (not layer!) [m2 s-2]. - !! Initially this is the value from the previous - !! timestep, which may accelerate the iteration - !! toward convergence. + intent(out) :: tke_io !< The turbulent kinetic energy per unit mass at + !! each interface (not layer!) [Z2 T-2 ~> m2 s-2]. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), & intent(inout) :: kv_io !< The vertical viscosity at each interface !! (not layer!) [Z2 T-1 ~> m2 s-1]. This discards any !! previous value (i.e. it is intent out) and !! simply sets Kv = Prandtl * Kd_shear - real, intent(in) :: dt !< Time increment [s]. + real, intent(in) :: dt !< Time increment [T ~> s]. type(Kappa_shear_CS), pointer :: CS !< The control structure returned by a previous !! call to kappa_shear_init. logical, optional, intent(in) :: initialize_all !< If present and false, the previous @@ -137,11 +134,7 @@ subroutine Calculate_kappa_shear(u_in, v_in, h, tv, p_surf, kappa_io, tke_io, & kappa_2d, & ! 2-D version of kappa_io [Z2 T-1 ~> m2 s-1]. tke_2d ! 2-D version tke_io [Z2 T-2 ~> m2 s-2]. real, dimension(SZK_(GV)) :: & - u, & ! The zonal velocity after a timestep of mixing [m s-1]. - v, & ! The meridional velocity after a timestep of mixing [m s-1]. Idz, & ! The inverse of the distance between TKE points [Z-1 ~> m-1]. - T, & ! The potential temperature after a timestep of mixing [degC]. - Sal, & ! The salinity after a timestep of mixing [ppt]. dz, & ! The layer thickness [Z ~> m]. u0xdz, & ! The initial zonal velocity times dz [Z m s-1 ~> m2 s-1]. v0xdz, & ! The initial meridional velocity times dz [Z m s-1 ~> m2 s-1]. @@ -184,7 +177,7 @@ subroutine Calculate_kappa_shear(u_in, v_in, h, tv, p_surf, kappa_io, tke_io, & use_temperature = .false. ; if (associated(tv%T)) use_temperature = .true. new_kappa = .true. ; if (present(initialize_all)) new_kappa = initialize_all - k0dt = dt*US%s_to_T*CS%kappa_0 + k0dt = dt*CS%kappa_0 dz_massless = 0.1*sqrt(k0dt) !$OMP parallel do default(private) shared(js,je,is,ie,nz,h,u_in,v_in,use_temperature,new_kappa, & @@ -289,11 +282,11 @@ subroutine Calculate_kappa_shear(u_in, v_in, h, tv, p_surf, kappa_io, tke_io, & endif #ifdef ADD_DIAGNOSTICS - call kappa_shear_column(kappa, tke, US%s_to_T*dt, nzc, f2, surface_pres, & + call kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & dz, u0xdz, v0xdz, T0xdz, S0xdz, kappa_avg, & tke_avg, tv, CS, GV, US, I_Ld2_1d, dz_Int_1d) #else - call kappa_shear_column(kappa, tke, US%s_to_T*dt, nzc, f2, surface_pres, & + call kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & dz, u0xdz, v0xdz, T0xdz, S0xdz, kappa_avg, & tke_avg, tv, CS, GV, US) #endif @@ -336,7 +329,7 @@ subroutine Calculate_kappa_shear(u_in, v_in, h, tv, p_surf, kappa_io, tke_io, & do K=1,nz+1 ; do i=is,ie kappa_io(i,j,K) = G%mask2dT(i,j) * kappa_2d(i,K) - tke_io(i,j,K) = G%mask2dT(i,j) * (US%Z_to_m**2*US%s_to_T**2)*tke_2d(i,K) + tke_io(i,j,K) = G%mask2dT(i,j) * tke_2d(i,K) kv_io(i,j,K) = ( G%mask2dT(i,j) * kappa_2d(i,K) ) * CS%Prandtl_turb #ifdef ADD_DIAGNOSTICS I_Ld2_3d(i,j,K) = I_Ld2_2d(i,K) ; dz_Int_3d(i,j,K) = dz_Int_2d(i,K) @@ -347,7 +340,7 @@ subroutine Calculate_kappa_shear(u_in, v_in, h, tv, p_surf, kappa_io, tke_io, & if (CS%debug) then call hchksum(kappa_io, "kappa", G%HI, scale=US%Z2_T_to_m2_s) - call hchksum(tke_io, "tke", G%HI) + call hchksum(tke_io, "tke", G%HI, scale=US%Z_to_m**2*US%s_to_T**2) endif if (CS%id_Kd_shear > 0) call post_data(CS%id_Kd_shear, kappa_io, CS%diag) @@ -385,17 +378,14 @@ subroutine Calc_kappa_shear_vertex(u_in, v_in, h, T_in, S_in, tv, p_surf, kappa_ intent(out) :: kappa_io !< The diapycnal diffusivity at each interface !! (not layer!) [Z2 T-1 ~> m2 s-1]. real, dimension(SZIB_(G),SZJB_(G),SZK_(GV)+1), & - intent(inout) :: tke_io !< The turbulent kinetic energy per unit mass at - !! each interface (not layer!) [m2 s-2]. - !! Initially this is the value from the previous - !! timestep, which may accelerate the iteration - !! toward convergence. + intent(out) :: tke_io !< The turbulent kinetic energy per unit mass at + !! each interface (not layer!) [Z2 T-2 ~> m2 s-2]. real, dimension(SZIB_(G),SZJB_(G),SZK_(GV)+1), & intent(inout) :: kv_io !< The vertical viscosity at each interface [Z2 T-1 ~> m2 s-1]. !! The previous value is used to initialize kappa !! in the vertex columes as Kappa = Kv/Prandtl !! to accelerate the iteration toward covergence. - real, intent(in) :: dt !< Time increment [s]. + real, intent(in) :: dt !< Time increment [T ~> s]. type(Kappa_shear_CS), pointer :: CS !< The control structure returned by a previous !! call to kappa_shear_init. logical, optional, intent(in) :: initialize_all !< If present and false, the previous @@ -410,11 +400,7 @@ subroutine Calc_kappa_shear_vertex(u_in, v_in, h, T_in, S_in, tv, p_surf, kappa_ real, dimension(SZIB_(G),SZK_(GV)+1) :: & tke_2d ! 2-D version tke_io [Z2 T-2 ~> m2 s-2]. real, dimension(SZK_(GV)) :: & - u, & ! The zonal velocity after a timestep of mixing [m s-1]. - v, & ! The meridional velocity after a timestep of mixing [m s-1]. Idz, & ! The inverse of the distance between TKE points [Z-1 ~> m-1]. - T, & ! The potential temperature after a timestep of mixing [degC]. - Sal, & ! The salinity after a timestep of mixing [ppt]. dz, & ! The layer thickness [Z ~> m]. u0xdz, & ! The initial zonal velocity times dz [m Z s-1 ~> m2 s-1]. v0xdz, & ! The initial meridional velocity times dz [m Z s-1 ~> m2 s-1]. @@ -460,7 +446,7 @@ subroutine Calc_kappa_shear_vertex(u_in, v_in, h, T_in, S_in, tv, p_surf, kappa_ use_temperature = .false. ; if (associated(tv%T)) use_temperature = .true. new_kappa = .true. ; if (present(initialize_all)) new_kappa = initialize_all - k0dt = dt*US%s_to_T*CS%kappa_0 + k0dt = dt*CS%kappa_0 dz_massless = 0.1*sqrt(k0dt) I_Prandtl = 0.0 ; if (CS%Prandtl_turb > 0.0) I_Prandtl = 1.0 / CS%Prandtl_turb @@ -580,10 +566,9 @@ subroutine Calc_kappa_shear_vertex(u_in, v_in, h, T_in, S_in, tv, p_surf, kappa_ do k=1,nzc+1 ; kc(k) = k ; kf(k) = 0.0 ; enddo endif f2 = G%CoriolisBu(I,J)**2 - surface_pres = 0.0 ; if (associated(p_surf)) then + surface_pres = 0.0 ; if (associated(p_surf)) & surface_pres = 0.25 * ((p_surf(i,j) + p_surf(i+1,j+1)) + & (p_surf(i+1,j) + p_surf(i,j+1))) - endif ! ---------------------------------------------------- ! Set the initial guess for kappa, here defined at interfaces. @@ -595,11 +580,11 @@ subroutine Calc_kappa_shear_vertex(u_in, v_in, h, T_in, S_in, tv, p_surf, kappa_ endif #ifdef ADD_DIAGNOSTICS - call kappa_shear_column(kappa, tke, US%s_to_T*dt, nzc, f2, surface_pres, & + call kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & dz, u0xdz, v0xdz, T0xdz, S0xdz, kappa_avg, & tke_avg, tv, CS, GV, US, I_Ld2_1d, dz_Int_1d) #else - call kappa_shear_column(kappa, tke, US%s_to_T*dt, nzc, f2, surface_pres, & + call kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & dz, u0xdz, v0xdz, T0xdz, S0xdz, kappa_avg, & tke_avg, tv, CS, GV, US) #endif @@ -617,10 +602,8 @@ subroutine Calc_kappa_shear_vertex(u_in, v_in, h, T_in, S_in, tv, p_surf, kappa_ kappa_2d(I,K,J2) = kappa_avg(kc(K)) tke_2d(I,K) = tke_avg(kc(K)) else - kappa_2d(I,K,J2) = (1.0-kf(K)) * kappa_avg(kc(K)) + & - kf(K) * kappa_avg(kc(K)+1) - tke_2d(I,K) = (1.0-kf(K)) * tke_avg(kc(K)) + & - kf(K) * tke_avg(kc(K)+1) + kappa_2d(I,K,J2) = (1.0-kf(K)) * kappa_avg(kc(K)) + kf(K) * kappa_avg(kc(K)+1) + tke_2d(I,K) = (1.0-kf(K)) * tke_avg(kc(K)) + kf(K) * tke_avg(kc(K)+1) endif enddo endif @@ -679,7 +662,7 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & real, dimension(SZK_(GV)+1), & intent(inout) :: kappa !< The time-weighted average of kappa [Z2 T-1 ~> m2 s-1]. real, dimension(SZK_(GV)+1), & - intent(inout) :: tke !< The Turbulent Kinetic Energy per unit mass at + intent(out) :: tke !< The Turbulent Kinetic Energy per unit mass at !! an interface [Z2 T-2 ~> m2 s-2]. integer, intent(in) :: nzc !< The number of active layers in the column. real, intent(in) :: f2 !< The square of the Coriolis parameter [T-2 ~> s-2]. @@ -918,7 +901,7 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & enddo do K=1,nzc+1 kprev_it1(K,0) = kappa(K) ; kappa_it1(K,0) = kappa(K) - tke_it1(K,0) = tke(K) + tke_it1(K,0) = 0.0 N2_it1(K,0) = N2_debug(K) ; Sh2_it1(K,0) = S2(K) ; ksrc_it1(K,0) = K_src(K) enddo do k=nzc+1,GV%ke @@ -973,7 +956,7 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & #ifdef DEBUG do K=1,nzc+1 Ri_k(K) = 1e3 ; if (S2(K) > 1e-3*N2(K)) Ri_k(K) = N2(K) / S2(K) - tke_prev(K) = tke(K) + if (itt > 1) then ; tke_prev(K) = tke(K) ; else ; tke_prev(K) = 0.0 ; endif enddo #endif @@ -2093,7 +2076,7 @@ function kappa_shear_init(Time, G, GV, US, param_file, diag, CS) CS%id_Kd_shear = register_diag_field('ocean_model','Kd_shear',diag%axesTi,Time, & 'Shear-driven Diapycnal Diffusivity', 'm2 s-1', conversion=US%Z2_T_to_m2_s) CS%id_TKE = register_diag_field('ocean_model','TKE_shear',diag%axesTi,Time, & - 'Shear-driven Turbulent Kinetic Energy', 'm2 s-2') + 'Shear-driven Turbulent Kinetic Energy', 'm2 s-2', conversion=US%Z_to_m**2*US%s_to_T**2) #ifdef ADD_DIAGNOSTICS CS%id_ILd2 = register_diag_field('ocean_model','ILd2_shear',diag%axesTi,Time, & 'Inverse kappa decay scale at interfaces', 'm-2', conversion=US%m_to_Z**2) diff --git a/src/parameterizations/vertical/MOM_set_diffusivity.F90 b/src/parameterizations/vertical/MOM_set_diffusivity.F90 index a5012cd3e2..3baf6a35f7 100644 --- a/src/parameterizations/vertical/MOM_set_diffusivity.F90 +++ b/src/parameterizations/vertical/MOM_set_diffusivity.F90 @@ -353,22 +353,21 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & (GV%Z_to_H**2)*kappa_fill*dt_fill, halo=1) call calc_kappa_shear_vertex(u, v, h, T_adj, S_adj, tv, fluxes%p_surf, visc%Kd_shear, & - visc%TKE_turb, visc%Kv_shear_Bu, dt, G, GV, US, CS%kappaShear_CSp) + visc%TKE_turb, visc%Kv_shear_Bu, US%s_to_T*dt, G, GV, US, CS%kappaShear_CSp) if (associated(visc%Kv_shear)) visc%Kv_shear(:,:,:) = 0.0 ! needed for other parameterizations if (CS%debug) then call hchksum(visc%Kd_shear, "after calc_KS_vert visc%Kd_shear", G%HI, scale=US%Z2_T_to_m2_s) call Bchksum(visc%Kv_shear_Bu, "after calc_KS_vert visc%Kv_shear_Bu", G%HI, scale=US%Z2_T_to_m2_s) - call Bchksum(visc%TKE_turb, "after calc_KS_vert visc%TKE_turb", G%HI) + call Bchksum(visc%TKE_turb, "after calc_KS_vert visc%TKE_turb", G%HI, scale=US%Z_to_m**2*US%s_to_T**2) endif else - ! Changes: visc%Kd_shear, visc%TKE_turb (not clear that TKE_turb is used as input ????) - ! Sets visc%Kv_shear + ! Changes: visc%Kd_shear ; Sets: visc%Kv_shear and visc%TKE_turb call calculate_kappa_shear(u_h, v_h, h, tv, fluxes%p_surf, visc%Kd_shear, visc%TKE_turb, & - visc%Kv_shear, dt, G, GV, US, CS%kappaShear_CSp) + visc%Kv_shear, US%s_to_T*dt, G, GV, US, CS%kappaShear_CSp) if (CS%debug) then call hchksum(visc%Kd_shear, "after calc_KS visc%Kd_shear", G%HI, scale=US%Z2_T_to_m2_s) call hchksum(visc%Kv_shear, "after calc_KS visc%Kv_shear", G%HI, scale=US%Z2_T_to_m2_s) - call hchksum(visc%TKE_turb, "after calc_KS visc%TKE_turb", G%HI) + call hchksum(visc%TKE_turb, "after calc_KS visc%TKE_turb", G%HI, scale=US%Z_to_m**2*US%s_to_T**2) endif endif call cpu_clock_end(id_clock_kappaShear) diff --git a/src/parameterizations/vertical/MOM_set_viscosity.F90 b/src/parameterizations/vertical/MOM_set_viscosity.F90 index d55c7e33cf..6c04f05926 100644 --- a/src/parameterizations/vertical/MOM_set_viscosity.F90 +++ b/src/parameterizations/vertical/MOM_set_viscosity.F90 @@ -1726,17 +1726,12 @@ subroutine set_visc_register_restarts(HI, GV, param_file, visc, restart_CS) endif if (use_kappa_shear .and. KS_at_vertex) then call safe_alloc_ptr(visc%TKE_turb, HI%IsdB, HI%IedB, HI%JsdB, HI%JedB, nz+1) - call register_restart_field(visc%TKE_turb, "TKE_turb", .false., restart_CS, & - "Turbulent kinetic energy per unit mass at interfaces", "m2 s-2", & - hor_grid="Bu", z_grid='i') call safe_alloc_ptr(visc%Kv_shear_Bu, HI%IsdB, HI%IedB, HI%JsdB, HI%JedB, nz+1) call register_restart_field(visc%Kv_shear_Bu, "Kv_shear_Bu", .false., restart_CS, & "Shear-driven turbulent viscosity at vertex interfaces", "m2 s-1", & hor_grid="Bu", z_grid='i') elseif (use_kappa_shear) then call safe_alloc_ptr(visc%TKE_turb, isd, ied, jsd, jed, nz+1) - call register_restart_field(visc%TKE_turb, "TKE_turb", .false., restart_CS, & - "Turbulent kinetic energy per unit mass at interfaces", "m2 s-2", z_grid='i') endif ! MOM_bkgnd_mixing is always used, so always allocate visc%Kv_slow. GMM @@ -1993,8 +1988,7 @@ subroutine set_visc_init(Time, G, GV, US, param_file, diag, visc, CS, restart_CS endif if (CS%RiNo_mix .and. kappa_shear_at_vertex(param_file)) then - ! These are necessary for reproduciblity across restarts in non-symmetric mode. - call pass_var(visc%TKE_turb, G%Domain, position=CORNER, complete=.false.) + ! This is necessary for reproduciblity across restarts in non-symmetric mode. call pass_var(visc%Kv_shear_Bu, G%Domain, position=CORNER, complete=.true.) endif @@ -2041,6 +2035,8 @@ subroutine set_visc_init(Time, G, GV, US, param_file, diag, visc, CS, restart_CS call register_restart_field_as_obsolete('Kd_turb','Kd_shear', restart_CS) call register_restart_field_as_obsolete('Kv_turb','Kv_shear', restart_CS) + ! Account for possible changes in dimensional scaling for variables that have been + ! read from a restart file. Z_rescale = 1.0 if ((US%m_to_Z_restart /= 0.0) .and. (US%m_to_Z_restart /= US%m_to_Z)) & Z_rescale = US%m_to_Z / US%m_to_Z_restart @@ -2063,8 +2059,8 @@ subroutine set_visc_init(Time, G, GV, US, param_file, diag, visc, CS, restart_CS endif ; endif if (associated(visc%Kv_shear_Bu)) then ; if (query_initialized(visc%Kv_shear_Bu, "Kv_shear_Bu", restart_CS)) then - do k=1,nz+1 ; do j=js,je ; do i=is,ie - visc%Kv_shear_Bu(i,j,k) = Z2_T_rescale * visc%Kv_shear_Bu(i,j,k) + do k=1,nz+1 ; do J=js-1,je ; do I=is-1,ie + visc%Kv_shear_Bu(I,J,k) = Z2_T_rescale * visc%Kv_shear_Bu(I,J,k) enddo ; enddo ; enddo endif ; endif From 707442f72e6b1d456c9dfebd1c1cd48c66a6b4d1 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Wed, 26 Jun 2019 17:57:17 -0400 Subject: [PATCH 44/82] (*)Removed hard-coded values in set_int_tide_input Changed the hard-coded fill-length parameters in set_int_tide_input into a run-time parameter (with the same name as in other modules) and the time step. This code is not yet in use in any MOM6-examples test cases, so these answers are bitwise identical, but it could change answers if INTERNAL_TIDES = True. --- .../vertical/MOM_internal_tide_input.F90 | 17 +++++++++-------- 1 file changed, 9 insertions(+), 8 deletions(-) diff --git a/src/parameterizations/vertical/MOM_internal_tide_input.F90 b/src/parameterizations/vertical/MOM_internal_tide_input.F90 index 2ffdbcb775..6cc47ed5e2 100644 --- a/src/parameterizations/vertical/MOM_internal_tide_input.F90 +++ b/src/parameterizations/vertical/MOM_internal_tide_input.F90 @@ -37,6 +37,8 @@ module MOM_int_tide_input !! regulate the timing of diagnostic output. real :: TKE_itide_max !< Maximum Internal tide conversion !! available to mix above the BBL [W m-2] + real :: kappa_fill !< Vertical diffusivity used to interpolate sensible values + !! of T & S into thin layers [Z2 s-1 ~> m2 s-1]. real, allocatable, dimension(:,:) :: TKE_itidal_coef !< The time-invariant field that enters the TKE_itidal input calculation [J m-2]. @@ -85,8 +87,6 @@ subroutine set_int_tide_input(u, v, h, tv, fluxes, itide, dt, G, GV, US, CS) integer :: i, j, k, is, ie, js, je, nz integer :: isd, ied, jsd, jed - real :: kappa_fill ! diffusivity used to fill massless layers - real :: dt_fill ! timestep used to fill massless layers is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed @@ -94,22 +94,19 @@ subroutine set_int_tide_input(u, v, h, tv, fluxes, itide, dt, G, GV, US, CS) if (.not.associated(CS)) call MOM_error(FATAL,"set_diffusivity: "//& "Module must be initialized before it is used.") - kappa_fill = 1.e-3*US%m_to_Z**2 !### Dimensional constant [m2 s-1]. - dt_fill = 7200. !### Dimensionalconstant [s]. - use_EOS = associated(tv%eqn_of_state) ! Smooth the properties through massless layers. if (use_EOS) then - call vert_fill_TS(h, tv%T, tv%S, kappa_fill, dt_fill, T_f, S_f, G, GV) + call vert_fill_TS(h, tv%T, tv%S, CS%kappa_fill, dt*US%s_to_T, T_f, S_f, G, GV) endif call find_N2_bottom(h, tv, T_f, S_f, itide%h2, fluxes, G, GV, US, N2_bot) -!$OMP parallel do default(none) shared(is,ie,js,je,G,itide,N2_bot,CS) + !$OMP parallel do default(shared) do j=js,je ; do i=is,ie itide%Nb(i,j) = G%mask2dT(i,j) * sqrt(N2_bot(i,j)) - itide%TKE_itidal_input(i,j) = min(CS%TKE_itidal_coef(i,j)*itide%Nb(i,j),CS%TKE_itide_max) + itide%TKE_itidal_input(i,j) = min(CS%TKE_itidal_coef(i,j)*itide%Nb(i,j), CS%TKE_itide_max) enddo ; enddo if (CS%debug) then @@ -295,6 +292,10 @@ subroutine int_tide_input_init(Time, G, GV, US, param_file, diag, CS, itide) call get_param(param_file, mdl, "MIN_ZBOT_ITIDES", min_zbot_itides, & "Turn off internal tidal dissipation when the total "//& "ocean depth is less than this value.", units="m", default=0.0, scale=US%m_to_Z) + call get_param(param_file, mdl, "KD_SMOOTH", CS%kappa_fill, & + "A diapycnal diffusivity that is used to interpolate "//& + "more sensible values of T & S into thin layers.", & + default=1.0e-6, scale=US%m2_s_to_Z2_T) call get_param(param_file, mdl, "UTIDE", utide, & "The constant tidal amplitude used with INT_TIDE_DISSIPATION.", & From 1ca9998fd260df465fc38d1e5e8ea6bc2f8149eb Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Wed, 26 Jun 2019 18:10:07 -0400 Subject: [PATCH 45/82] (*)Properly rescale Tr_ea_BBL in legacy_diabatic Properly rescale Tr_ea_BBL in non-Boussinesq cases in legacy_diabatic. This will not change physical solutions, but it will change tracer mixing in non-Boussinesq cases with USE_LEGACY_DIABATIC_DRIVER = True, but will also now pass dimensional consistency testing for these cases. There are no existing MOM6-examples test cases that this changes. --- src/parameterizations/vertical/MOM_diabatic_driver.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index 6e08135919..6907fe2caa 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -2050,7 +2050,7 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en ! mixing of passive tracers from massless boundary layers to interior call cpu_clock_begin(id_clock_tracers) if (CS%mix_boundary_tracers) then - Tr_ea_BBL = sqrt(dt_in_T*CS%Kd_BBL_tr) !### I think this needs GV%Z_to_H + Tr_ea_BBL = GV%Z_to_H * sqrt(dt_in_T*CS%Kd_BBL_tr) !$OMP parallel do default(shared) private(htot,in_boundary,add_ent) do j=js,je do i=is,ie From bc80b12b209803b8eca7aff88731bfa622ad4482 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Wed, 26 Jun 2019 18:17:50 -0400 Subject: [PATCH 46/82] (*)Correct dimensional scaling with RESOLVE_EKMAN Correct dimensional scaling in non-Boussinesq cases with BULKMIXEDLAYER = True and RESOLVE_EKMAN = True. This could change answers, but there are no existing MOM6-examples test cases with this particular combination of parameter settings. --- src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 b/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 index 17b7bb5c15..5e39ea8564 100644 --- a/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 +++ b/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 @@ -670,7 +670,7 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, US, C kU_Star = (1.0 - fluxes%frac_shelf_h(i,j)) * kU_star + & fluxes%frac_shelf_h(i,j) * (0.41*fluxes%ustar_shelf(i,j)) endif - absf_x_H = 0.25 * US%m_to_Z * US%s_to_T * h(i,0) * & !### I think this should be H_to_Z -RWH + absf_x_H = 0.25 * GV%H_to_Z * US%s_to_T * h(i,0) * & ((abs(G%CoriolisBu(I,J)) + abs(G%CoriolisBu(I-1,J-1))) + & (abs(G%CoriolisBu(I,J-1)) + abs(G%CoriolisBu(I-1,J)))) ! If the mixed layer vertical viscosity specification is changed in From 7931e984b6d86b7a3e0c4d6ff43c3e93ed151687 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Thu, 27 Jun 2019 17:56:57 -0400 Subject: [PATCH 47/82] +Eliminated the legacy_diabatic public interface Moved the LEGACY_DIABATIC_DRIVER option into MOM_diabatic_driver, and turned diabatic into a small header routine that selects between diabatic_ALE and legacy_diabatic. Also made some minor changes to comments in MOM_diabatic_driver.F90. All answers are bitwise identical, but a public interface has been eliminated and the location of USE_LEGACY_DIABATIC_DRIVER in the MOM_parameter_doc files has changed. --- src/core/MOM.F90 | 17 +- .../vertical/MOM_diabatic_driver.F90 | 161 +++++++++++------- 2 files changed, 97 insertions(+), 81 deletions(-) diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index 6e313f0967..d849211afb 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -54,7 +54,6 @@ module MOM use MOM_coord_initialization, only : MOM_initialize_coord use MOM_diabatic_driver, only : diabatic, diabatic_driver_init, diabatic_CS use MOM_diabatic_driver, only : adiabatic, adiabatic_driver_init, diabatic_driver_end -use MOM_diabatic_driver, only : legacy_diabatic use MOM_diagnostics, only : calculate_diagnostic_fields, MOM_diagnostics_init use MOM_diagnostics, only : register_transport_diags, post_transport_diagnostics use MOM_diagnostics, only : register_surface_diags, write_static_fields @@ -203,8 +202,6 @@ module MOM !! related to the Mesoscale Eddy Kinetic Energy logical :: adiabatic !< If true, there are no diapycnal mass fluxes, and no calls !! to routines to calculate or apply diapycnal fluxes. - logical :: use_legacy_diabatic_driver!< If true (default), use the a legacy version of the diabatic - !! subroutine. This is temporary and is needed to avoid change in answers. logical :: diabatic_first !< If true, apply diabatic and thermodynamic processes before time !! stepping the dynamics. logical :: use_ALE_algorithm !< If true, use the ALE algorithm rather than layered @@ -1184,14 +1181,8 @@ subroutine step_MOM_thermo(CS, G, GV, US, u, v, h, tv, fluxes, dtdia, & endif call cpu_clock_begin(id_clock_diabatic) - if (CS%use_legacy_diabatic_driver) then - ! the following subroutine is legacy and will be deleted in the near future. - call legacy_diabatic(u, v, h, tv, CS%Hml, fluxes, CS%visc, CS%ADp, CS%CDp, & - dtdia, Time_end_thermo, G, GV, US, CS%diabatic_CSp, Waves=Waves) - else - call diabatic(u, v, h, tv, CS%Hml, fluxes, CS%visc, CS%ADp, CS%CDp, & - dtdia, Time_end_thermo, G, GV, US, CS%diabatic_CSp, Waves=Waves) - endif + call diabatic(u, v, h, tv, CS%Hml, fluxes, CS%visc, CS%ADp, CS%CDp, & + dtdia, Time_end_thermo, G, GV, US, CS%diabatic_CSp, Waves=Waves) fluxes%fluxes_used = .true. call cpu_clock_end(id_clock_diabatic) @@ -1670,10 +1661,6 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & "true. This assumes that KD = KDML = 0.0 and that "//& "there is no buoyancy forcing, but makes the model "//& "faster by eliminating subroutine calls.", default=.false.) - call get_param(param_file, "MOM", "USE_LEGACY_DIABATIC_DRIVER", CS%use_legacy_diabatic_driver, & - "If true, use a legacy version of the diabatic subroutine. "//& - "This is temporary and is needed to avoid change in answers.", & - default=.true.) call get_param(param_file, "MOM", "DO_DYNAMICS", CS%do_dynamics, & "If False, skips the dynamics calls that update u & v, as well as "//& "the gravity wave adjustment to h. This is a fragile feature and "//& diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index 6907fe2caa..b3700a3d14 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -81,7 +81,7 @@ module MOM_diabatic_driver public extract_diabatic_member public adiabatic public adiabatic_driver_init -public legacy_diabatic +! public legacy_diabatic ! A note on unit descriptions in comments: MOM6 uses units that can be rescaled for dimensional ! consistency testing. These are noted in comments with units like Z, H, L, and T, along with @@ -90,6 +90,10 @@ module MOM_diabatic_driver !> Control structure for this module type, public:: diabatic_CS; private + + logical :: use_legacy_diabatic !< If true (default), use the a legacy version of the diabatic + !! algorithm. This is temporary and is needed to avoid change + !! in answers. logical :: bulkmixedlayer !< If true, a refined bulk mixed layer is used with !! nkml sublayers (and additional buffer layers). logical :: use_energetic_PBL !< If true, use the implicit energetics planetary @@ -273,7 +277,42 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: h !< thickness [H ~> m or kg m-2] type(thermo_var_ptrs), intent(inout) :: tv !< points to thermodynamic fields !! unused have NULL ptrs - real, dimension(:,:), pointer :: Hml !< mixed layer depth [m] + real, dimension(:,:), pointer :: Hml !< Active mixed layer depth [m] + type(forcing), intent(inout) :: fluxes !< points to forcing fields + !! unused fields have NULL ptrs + type(vertvisc_type), intent(inout) :: visc !< vertical viscosities, BBL properies, and + type(accel_diag_ptrs), intent(inout) :: ADp !< related points to accelerations in momentum + !! equations, to enable the later derived + !! diagnostics, like energy budgets + type(cont_diag_ptrs), intent(inout) :: CDp !< points to terms in continuity equations + real, intent(in) :: dt !< time increment [s] + type(time_type), intent(in) :: Time_end !< Time at the end of the interval + type(diabatic_CS), pointer :: CS !< module control structure + type(Wave_parameters_CS), optional, pointer :: Waves !< Surface gravity waves + + if (CS%use_legacy_diabatic) then + call legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & + G, GV, US, CS, Waves) + else + call diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & + G, GV, US, CS, Waves) + endif + +end subroutine diabatic + +!> This subroutine imposes the diapycnal mass fluxes and the +!! accompanying diapycnal advection of momentum and tracers. +subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & + G, GV, US, CS, Waves) + type(ocean_grid_type), intent(inout) :: G !< ocean grid structure + type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: u !< zonal velocity [m s-1] + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: v !< meridional velocity [m s-1] + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: h !< thickness [H ~> m or kg m-2] + type(thermo_var_ptrs), intent(inout) :: tv !< points to thermodynamic fields + !! unused have NULL ptrs + real, dimension(:,:), pointer :: Hml !< Active mixed layer depth [m] type(forcing), intent(inout) :: fluxes !< points to forcing fields !! unused fields have NULL ptrs type(vertvisc_type), intent(inout) :: visc !< vertical viscosities, BBL properies, and @@ -302,8 +341,8 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & ! hold, & ! layer thickness before diapycnal entrainment, and later ! the initial layer thicknesses (if a mixed layer is used), ! [H ~> m or kg m-2] - dSV_dT, & ! The partial derivatives of specific volume with temperature - dSV_dS, & ! and salinity in [m3 kg-1 degC-1] and [m3 kg-1 ppt-1]. + dSV_dT, & ! The partial derivative of specific volume with temperature [m3 kg-1 degC-1] + dSV_dS, & ! The partial derivative of specific volume with salinity [m3 kg-1 ppt-1]. cTKE, & ! convective TKE requirements for each layer [kg m-3 Z3 T-2 ~> J m-2]. u_h, & ! zonal and meridional velocities at thickness points after v_h ! entrainment [m s-1] @@ -339,18 +378,11 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & ! The following 5 variables are only used with a bulk mixed layer. real, pointer, dimension(:,:,:) :: & - eaml, & ! The equivalent of ea and eb due to mixed layer processes [H ~> m or kg m-2] - ebml ! [H ~> m or kg m-2]. These will be - ! pointers to eatr and ebtr so as to reuse the memory as + eaml, & ! The equivalent of ea due to mixed layer processes [H ~> m or kg m-2]. + ebml ! The equivalent of eb due to mixed layer processes [H ~> m or kg m-2]. + ! eaml and ebml are pointers to eatr and ebtr so as to reuse the memory as ! the arrays are not needed at the same time. - integer :: kb(SZI_(G),SZJ_(G)) ! index of the lightest layer denser - ! than the buffer layer [nondim] - - real :: p_ref_cv(SZI_(G)) ! Reference pressure for the potential - ! density which defines the coordinate - ! variable, set to P_Ref [Pa]. - logical :: in_boundary(SZI_(G)) ! True if there are no massive layers below, ! where massive is defined as sufficiently thick that ! the no-flux boundary conditions have not restricted @@ -376,8 +408,8 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & real :: c1(SZIB_(G),SZK_(G)) ! tridiagonal solver. real :: Ent_int ! The diffusive entrainment rate at an interface [H ~> m or kg m-2] - real :: dt_mix ! amount of time over which to apply mixing [s] - real :: Idt ! inverse time step [s-1] + real :: dt_mix ! The amount of time over which to apply mixing [s] + real :: Idt ! The inverse time step [s-1] real :: dt_in_T ! The time step converted to T units [T ~> s] integer :: dir_flag ! An integer encoding the directions in which to do halo updates. @@ -437,7 +469,6 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & if (CS%debug_energy_req) & call diapyc_energy_req_test(h, dt_in_T, tv, G, GV, US, CS%diapyc_en_rec_CSp) - call cpu_clock_begin(id_clock_set_diffusivity) call set_BBL_TKE(u, v, h, fluxes, visc, G, GV, US, CS%set_diff_CSp) call cpu_clock_end(id_clock_set_diffusivity) @@ -466,7 +497,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & if (CS%id_frazil_h > 0) call post_data(CS%id_frazil_h, h, CS%diag) endif call disable_averaging(CS%diag) - endif !associated(tv%T) .AND. associated(tv%frazil) + endif ! associated(tv%T) .AND. associated(tv%frazil) ! For all other diabatic subroutines, the averaging window should be the entire diabatic timestep call enable_averaging(dt, Time_end, CS%diag) @@ -549,14 +580,12 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & enddo ; enddo endif ! CALL ROUTINE USING PRESCRIBED KE FOR TESTING - call propagate_int_tide(h, tv, cn, TKE_itidal_input_test, & - CS%int_tide_input%tideamp, CS%int_tide_input%Nb, dt, G, GV, US, & - CS%int_tide_CSp) + call propagate_int_tide(h, tv, cn, TKE_itidal_input_test, CS%int_tide_input%tideamp, & + CS%int_tide_input%Nb, dt, G, GV, US, CS%int_tide_CSp) else ! CALL ROUTINE USING CALCULATED KE INPUT - call propagate_int_tide(h, tv, cn, CS%int_tide_input%TKE_itidal_input, & - CS%int_tide_input%tideamp, CS%int_tide_input%Nb, dt, G, GV, US, & - CS%int_tide_CSp) + call propagate_int_tide(h, tv, cn, CS%int_tide_input%TKE_itidal_input, CS%int_tide_input%tideamp, & + CS%int_tide_input%Nb, dt, G, GV, US, CS%int_tide_CSp) endif if (showCallTree) call callTree_waypoint("done with propagate_int_tide (diabatic)") endif ! end CS%use_int_tides @@ -645,10 +674,10 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & if (CS%useKPP) then call cpu_clock_begin(id_clock_kpp) if (CS%debug) then - call hchksum(CS%KPP_temp_flux, "before KPP_applyNLT netHeat",G%HI,haloshift=0, scale=GV%H_to_m) - call hchksum(CS%KPP_salt_flux, "before KPP_applyNLT netSalt",G%HI,haloshift=0, scale=GV%H_to_m) - call hchksum(CS%KPP_NLTheat, "before KPP_applyNLT NLTheat",G%HI,haloshift=0) - call hchksum(CS%KPP_NLTscalar, "before KPP_applyNLT NLTscalar",G%HI,haloshift=0) + call hchksum(CS%KPP_temp_flux, "before KPP_applyNLT netHeat", G%HI, haloshift=0, scale=GV%H_to_m) + call hchksum(CS%KPP_salt_flux, "before KPP_applyNLT netSalt", G%HI, haloshift=0, scale=GV%H_to_m) + call hchksum(CS%KPP_NLTheat, "before KPP_applyNLT NLTheat", G%HI, haloshift=0) + call hchksum(CS%KPP_NLTscalar, "before KPP_applyNLT NLTscalar", G%HI, haloshift=0) endif ! Apply non-local transport of heat and salt ! Changes: tv%T, tv%S @@ -667,8 +696,8 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & ! This is the "old" method for applying differential diffusion. ! Changes: tv%T, tv%S - if (associated(visc%Kd_extra_T) .and. associated(visc%Kd_extra_S) .and. associated(tv%T) .and. .not. & - CS%use_CVMix_ddiff) then + if (associated(visc%Kd_extra_T) .and. associated(visc%Kd_extra_S) .and. associated(tv%T) .and. & + (.not.CS%use_CVMix_ddiff)) then call cpu_clock_begin(id_clock_differential_diff) call differential_diffuse_T_S(h, tv, visc, dt_in_T, G, GV) @@ -1120,7 +1149,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & if (CS%debugConservation) call MOM_state_stats('leaving diabatic', u, v, h, tv%T, tv%S, G) if (showCallTree) call callTree_leave("diabatic()") -end subroutine diabatic +end subroutine diabatic_ALE !> Imposes the diapycnal mass fluxes and the accompanying diapycnal advection of momentum and tracers !! using the original MOM6 algorithms. @@ -1134,7 +1163,7 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: h !< thickness [H ~> m or kg m-2] type(thermo_var_ptrs), intent(inout) :: tv !< points to thermodynamic fields !! unused have NULL ptrs - real, dimension(:,:), pointer :: Hml !< active mixed layer depth + real, dimension(:,:), pointer :: Hml !< Active mixed layer depth [m] type(forcing), intent(inout) :: fluxes !< points to forcing fields !! unused fields have NULL ptrs type(vertvisc_type), intent(inout) :: visc !< vertical viscosities, BBL properies, and @@ -1154,7 +1183,7 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en ! one time step [H ~> m or kg m-2] Kd_lay, & ! diapycnal diffusivity of layers [Z2 T-1 ~> m2 s-1] h_orig, & ! initial layer thicknesses [H ~> m or kg m-2] - h_prebound, & ! initial layer thicknesses [H ~> m or kg m-2] + h_prebound, & ! initial layer thicknesses [H ~> m or kg m-2] hold, & ! layer thickness before diapycnal entrainment, and later ! the initial layer thicknesses (if a mixed layer is used), ! [H ~> m or kg m-2] @@ -1163,10 +1192,8 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en cTKE, & ! convective TKE requirements for each layer [kg m-3 Z3 T-2 ~> J m-2]. u_h, & ! zonal and meridional velocities at thickness points after v_h ! entrainment [m s-1] - real, dimension(SZI_(G),SZJ_(G),CS%nMode) :: & - cn ! baroclinic gravity wave speeds (formerly cg1 - BDM) - + cn ! baroclinic gravity wave speeds real, dimension(SZI_(G),SZJ_(G)) :: & Rcv_ml, & ! coordinate density of mixed layer, used for applying sponges SkinBuoyFlux! 2d surface buoyancy flux [Z2 T-3 ~> m2 s-3], used by ePBL @@ -1182,11 +1209,11 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en ! These are targets so that the space can be shared with eaml & ebml. eatr, & ! The equivalent of ea and eb for tracers, which differ from ea and ebtr ! eb in that they tend to homogenize tracers in massless layers - ! near the boundaries [H ~> m or kg m-2] + ! near the boundaries [H ~> m or kg m-2] (for Bous or non-Bouss) real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), target :: & Kd_int, & ! diapycnal diffusivity of interfaces [Z2 T-1 ~> m2 s-1] - Kd_heat, & ! diapycnal diffusivity of heat [Z2 s-T ~> m2 s-1] + Kd_heat, & ! diapycnal diffusivity of heat [Z2 T-1 ~> m2 s-1] Kd_salt, & ! diapycnal diffusivity of salt and passive tracers [Z2 T-1 ~> m2 s-1] Kd_ePBL, & ! test array of diapycnal diffusivities at interfaces [Z2 T-1 ~> m2 s-1] eta, & ! Interface heights before diapycnal mixing [m]. @@ -1197,9 +1224,9 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en ! The following 5 variables are only used with a bulk mixed layer. real, pointer, dimension(:,:,:) :: & - eaml, & ! The equivalent of ea and eb due to mixed layer processes, - ebml ! [H ~> m or kg m-2]. These will be - ! pointers to eatr and ebtr so as to reuse the memory as + eaml, & ! The equivalent of ea due to mixed layer processes [H ~> m or kg m-2]. + ebml ! The equivalent of eb due to mixed layer processes [H ~> m or kg m-2]. + ! eaml and ebml are pointers to eatr and ebtr so as to reuse the memory as ! the arrays are not needed at the same time. integer :: kb(SZI_(G),SZJ_(G)) ! index of the lightest layer denser @@ -1233,9 +1260,9 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en real :: b1(SZIB_(G)), d1(SZIB_(G)) ! b1, c1, and d1 are variables used by the real :: c1(SZIB_(G),SZK_(G)) ! tridiagonal solver. - real :: Ent_int ! The diffusive entrainment rate at an interface [H ~> m or kg m-2]. - real :: dt_mix ! amount of time over which to apply mixing [s] - real :: Idt ! inverse time step [s-1] + real :: Ent_int ! The diffusive entrainment rate at an interface [H ~> m or kg m-2] + real :: dt_mix ! The amount of time over which to apply mixing [s] + real :: Idt ! The inverse time step [s-1] real :: dt_in_T ! The time step converted to T units [T ~> s] integer :: dir_flag ! An integer encoding the directions in which to do halo updates. @@ -1320,7 +1347,8 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en if (CS%id_frazil_h > 0) call post_data(CS%id_frazil_h, h, CS%diag) endif call disable_averaging(CS%diag) - endif + endif ! associated(tv%T) .AND. associated(tv%frazil) + ! For all other diabatic subroutines, the averaging window should be the entire diabatic timestep call enable_averaging(dt, Time_end, CS%diag) if (CS%debugConservation) call MOM_state_stats('1st make_frazil', u, v, h, tv%T, tv%S, G) @@ -1400,9 +1428,8 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en endif endif - if (CS%debug) then + if (CS%debug) & call MOM_state_chksum("before find_uv_at_h", u, v, h, G, GV, haloshift=0) - endif if (CS%use_kappa_shear .or. CS%use_CVMix_shear) then if ((CS%ML_mix_first > 0.0) .or. CS%use_geothermal) then call find_uv_at_h(u, v, h_orig, u_h, v_h, G, GV, eaml, ebml) @@ -1459,7 +1486,7 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en CS%int_tide_input%Nb, dt, G, GV, US, CS%int_tide_CSp) endif if (showCallTree) call callTree_waypoint("done with propagate_int_tide (diabatic)") - endif + endif ! end CS%use_int_tides call cpu_clock_begin(id_clock_set_diffusivity) ! Sets: Kd_lay, Kd_int, visc%Kd_extra_T, visc%Kd_extra_S and visc%TKE_turb @@ -1478,10 +1505,8 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en call MOM_state_chksum("after set_diffusivity ", u, v, h, G, GV, haloshift=0) call MOM_forcing_chksum("after set_diffusivity ", fluxes, G, US, haloshift=0) call MOM_thermovar_chksum("after set_diffusivity ", tv, G) - call hchksum(Kd_lay, "after set_diffusivity Kd_lay", G%HI, haloshift=0, & - scale=US%Z2_T_to_m2_s) - call hchksum(Kd_Int, "after set_diffusivity Kd_Int", G%HI, haloshift=0, & - scale=US%Z2_T_to_m2_s) + call hchksum(Kd_lay, "after set_diffusivity Kd_lay", G%HI, haloshift=0, scale=US%Z2_T_to_m2_s) + call hchksum(Kd_Int, "after set_diffusivity Kd_Int", G%HI, haloshift=0, scale=US%Z2_T_to_m2_s) endif @@ -1496,11 +1521,14 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en CS%KPP_buoy_flux, CS%KPP_temp_flux, CS%KPP_salt_flux) ! The KPP scheme calculates boundary layer diffusivities and non-local transport. - !$OMP parallel do default(shared) - do k=1,nz+1 ; do j=js,je ; do i=is,ie - Kd_salt(i,j,k) = Kd_int(i,j,K) - Kd_heat(i,j,k) = Kd_int(i,j,K) - enddo ; enddo ; enddo + ! Set diffusivities for heat and salt separately + + !$OMP parallel do default(shared) + do k=1,nz+1 ; do j=js,je ; do i=is,ie + Kd_salt(i,j,k) = Kd_int(i,j,K) + Kd_heat(i,j,k) = Kd_int(i,j,K) + enddo ; enddo ; enddo + ! Add contribution from double diffusion if (associated(visc%Kd_extra_S)) then !$OMP parallel do default(shared) do k=1,nz+1 ; do j=js,je ; do i=is,ie @@ -1552,10 +1580,8 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en call MOM_state_chksum("after KPP", u, v, h, G, GV, haloshift=0) call MOM_forcing_chksum("after KPP", fluxes, G, US, haloshift=0) call MOM_thermovar_chksum("after KPP", tv, G) - call hchksum(Kd_lay, "after KPP Kd_lay", G%HI, haloshift=0, & - scale=US%Z2_T_to_m2_s) - call hchksum(Kd_Int, "after KPP Kd_Int", G%HI, haloshift=0, & - scale=US%Z2_T_to_m2_s) + call hchksum(Kd_lay, "after KPP Kd_lay", G%HI, haloshift=0, scale=US%Z2_T_to_m2_s) + call hchksum(Kd_Int, "after KPP Kd_Int", G%HI, haloshift=0, scale=US%Z2_T_to_m2_s) endif endif ! endif for KPP @@ -1571,7 +1597,6 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en endif if (CS%useKPP) then - call cpu_clock_begin(id_clock_kpp) if (CS%debug) then call hchksum(CS%KPP_temp_flux, "before KPP_applyNLT netHeat", G%HI, haloshift=0, scale=GV%H_to_m) @@ -1592,14 +1617,13 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en call MOM_forcing_chksum("after KPP_applyNLT ", fluxes, G, US, haloshift=0) call MOM_thermovar_chksum("after KPP_applyNLT ", tv, G) endif - endif ! endif for KPP ! Differential diffusion done here. ! Changes: tv%T, tv%S if (associated(visc%Kd_extra_T) .and. associated(visc%Kd_extra_S) .and. associated(tv%T)) then - call cpu_clock_begin(id_clock_differential_diff) + call cpu_clock_begin(id_clock_differential_diff) call differential_diffuse_T_S(h, tv, visc, dt_in_T, G, GV) call cpu_clock_end(id_clock_differential_diff) if (showCallTree) call callTree_waypoint("done with differential_diffuse_T_S (diabatic)") @@ -1608,6 +1632,7 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en ! increment heat and salt diffusivity. ! CS%useKPP==.true. already has extra_T and extra_S included if (.not. CS%useKPP) then + !$OMP parallel do default(shared) do K=2,nz ; do j=js,je ; do i=is,ie Kd_heat(i,j,K) = Kd_heat(i,j,K) + visc%Kd_extra_T(i,j,K) Kd_salt(i,j,K) = Kd_salt(i,j,K) + visc%Kd_extra_S(i,j,K) @@ -1974,8 +1999,8 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en ! Changes T and S via the tridiagonal solver; no change to h if (CS%tracer_tridiag) then - call tracer_vertdiff(hold, ea, eb, dt, tv%T, G, GV) - call tracer_vertdiff(hold, ea, eb, dt, tv%S, G, GV) + call tracer_vertdiff(hold, ea, eb, dt, tv%T, G, GV) + call tracer_vertdiff(hold, ea, eb, dt, tv%S, G, GV) else call triDiagTS(G, GV, is, ie, js, je, hold, ea, eb, tv%T, tv%S) endif @@ -2756,6 +2781,10 @@ subroutine diabatic_driver_init(Time, G, GV, US, param_file, useALEalgorithm, di ! Set default, read and log parameters call log_version(param_file, mdl, version, & "The following parameters are used for diabatic processes.") + call get_param(param_file, mdl, "USE_LEGACY_DIABATIC_DRIVER", CS%use_legacy_diabatic, & + "If true, use a legacy version of the diabatic subroutine. "//& + "This is temporary and is needed to avoid change in answers.", & + default=.true.) call get_param(param_file, mdl, "SPONGE", CS%use_sponge, & "If true, sponges may be applied anywhere in the domain. "//& "The exact location and properties of those sponges are "//& From cbe68e9eda2c12f8d7432fb3ab710ec9de7dee6b Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Thu, 27 Jun 2019 19:41:55 -0400 Subject: [PATCH 48/82] +Added the new subroutine diabatic_ALE_legacy Added a new subroutine, diabatic_ALE_legacy, in MOM_diabatic_driver.F90 to do the diabatic ALE updates using the legacy algorithms, and removed the ALE code from legacy_diabatic. All answers are bitwise identical. --- .../vertical/MOM_diabatic_driver.F90 | 1227 +++++++++++++---- 1 file changed, 975 insertions(+), 252 deletions(-) diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index b3700a3d14..acb5cf26af 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -290,15 +290,886 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & type(diabatic_CS), pointer :: CS !< module control structure type(Wave_parameters_CS), optional, pointer :: Waves !< Surface gravity waves - if (CS%use_legacy_diabatic) then + if (CS%useALEalgorithm .and. CS%use_legacy_diabatic) then + call diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & + G, GV, US, CS, Waves) + elseif (CS%useALEalgorithm) then + call diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & + G, GV, US, CS, Waves) + else call legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & G, GV, US, CS, Waves) + endif + +end subroutine diabatic + + + +!> Applies diabatic forcing and diapycnal mixing of temperature, salinity and other tracers for use +!! with an ALE algorithm. This version uses an older set of algorithms compared with diabatic_ALE. +subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & + G, GV, US, CS, WAVES) + type(ocean_grid_type), intent(inout) :: G !< ocean grid structure + type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: u !< zonal velocity [m s-1] + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: v !< meridional velocity [m s-1] + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: h !< thickness [H ~> m or kg m-2] + type(thermo_var_ptrs), intent(inout) :: tv !< points to thermodynamic fields + !! unused have NULL ptrs + real, dimension(:,:), pointer :: Hml !< Active mixed layer depth [m] + type(forcing), intent(inout) :: fluxes !< points to forcing fields + !! unused fields have NULL ptrs + type(vertvisc_type), intent(inout) :: visc !< vertical viscosities, BBL properies, and + type(accel_diag_ptrs), intent(inout) :: ADp !< related points to accelerations in momentum + !! equations, to enable the later derived + !! diagnostics, like energy budgets + type(cont_diag_ptrs), intent(inout) :: CDp !< points to terms in continuity equations + real, intent(in) :: dt !< time increment [s] + type(time_type), intent(in) :: Time_end !< Time at the end of the interval + type(diabatic_CS), pointer :: CS !< module control structure + type(Wave_parameters_CS), optional, pointer :: Waves !< Surface gravity waves + + ! local variables + real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: & + ea, & ! amount of fluid entrained from the layer above within + ! one time step [H ~> m or kg m-2] + eb, & ! amount of fluid entrained from the layer below within + ! one time step [H ~> m or kg m-2] + Kd_lay, & ! diapycnal diffusivity of layers [Z2 T-1 ~> m2 s-1] + h_orig, & ! initial layer thicknesses [H ~> m or kg m-2] + h_prebound, & ! initial layer thicknesses [H ~> m or kg m-2] + hold, & ! layer thickness before diapycnal entrainment, and later + ! the initial layer thicknesses (if a mixed layer is used), + ! [H ~> m or kg m-2] + dSV_dT, & ! The partial derivative of specific volume with temperature [m3 kg-1 degC-1] + dSV_dS, & ! The partial derivative of specific volume with salinity [m3 kg-1 ppt-1]. + cTKE, & ! convective TKE requirements for each layer [kg m-3 Z3 T-2 ~> J m-2]. + u_h, & ! zonal and meridional velocities at thickness points after + v_h ! entrainment [m s-1] + real, dimension(SZI_(G),SZJ_(G),CS%nMode) :: & + cn ! baroclinic gravity wave speeds + real, dimension(SZI_(G),SZJ_(G)) :: & + Rcv_ml, & ! coordinate density of mixed layer, used for applying sponges + SkinBuoyFlux! 2d surface buoyancy flux [Z2 T-3 ~> m2 s-3], used by ePBL + real, dimension(SZI_(G),SZJ_(G),G%ke) :: h_diag ! diagnostic array for thickness + real, dimension(SZI_(G),SZJ_(G),G%ke) :: temp_diag ! diagnostic array for temp + real, dimension(SZI_(G),SZJ_(G),G%ke) :: saln_diag ! diagnostic array for salinity + real, dimension(SZI_(G),SZJ_(G)) :: tendency_2d ! depth integrated content tendency for diagn + real, dimension(SZI_(G),SZJ_(G)) :: TKE_itidal_input_test ! override of energy input for testing (BDM) + + real :: net_ent ! The net of ea-eb at an interface. + + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), target :: & + ! These are targets so that the space can be shared with eaml & ebml. + eatr, & ! The equivalent of ea and eb for tracers, which differ from ea and + ebtr ! eb in that they tend to homogenize tracers in massless layers + ! near the boundaries [H ~> m or kg m-2] (for Bous or non-Bouss) + + real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), target :: & + Kd_int, & ! diapycnal diffusivity of interfaces [Z2 T-1 ~> m2 s-1] + Kd_heat, & ! diapycnal diffusivity of heat [Z2 T-1 ~> m2 s-1] + Kd_salt, & ! diapycnal diffusivity of salt and passive tracers [Z2 T-1 ~> m2 s-1] + Kd_ePBL, & ! test array of diapycnal diffusivities at interfaces [Z2 T-1 ~> m2 s-1] + eta, & ! Interface heights before diapycnal mixing [m]. + Tdif_flx, & ! diffusive diapycnal heat flux across interfaces [degC m s-1] + Tadv_flx, & ! advective diapycnal heat flux across interfaces [degC m s-1] + Sdif_flx, & ! diffusive diapycnal salt flux across interfaces [ppt m s-1] + Sadv_flx ! advective diapycnal salt flux across interfaces [ppt m s-1] + + ! The following 5 variables are only used with a bulk mixed layer. + real, pointer, dimension(:,:,:) :: & + eaml, & ! The equivalent of ea due to mixed layer processes [H ~> m or kg m-2]. + ebml ! The equivalent of eb due to mixed layer processes [H ~> m or kg m-2]. + ! eaml and ebml are pointers to eatr and ebtr so as to reuse the memory as + ! the arrays are not needed at the same time. + + logical :: in_boundary(SZI_(G)) ! True if there are no massive layers below, + ! where massive is defined as sufficiently thick that + ! the no-flux boundary conditions have not restricted + ! the entrainment - usually sqrt(Kd*dt). + + real :: b_denom_1 ! The first term in the denominator of b1 + ! [H ~> m or kg m-2] + real :: h_neglect ! A thickness that is so small it is usually lost + ! in roundoff and can be neglected + ! [H ~> m or kg m-2] + real :: h_neglect2 ! h_neglect^2 [H2 ~> m2 or kg2 m-4] + real :: add_ent ! Entrainment that needs to be added when mixing tracers + ! [H ~> m or kg m-2] + real :: eaval ! eaval is 2*ea at velocity grid points [H ~> m or kg m-2] + real :: hval ! hval is 2*h at velocity grid points [H ~> m or kg m-2] + real :: h_tr ! h_tr is h at tracer points with a tiny thickness + ! added to ensure positive definiteness [H ~> m or kg m-2] + real :: Tr_ea_BBL ! The diffusive tracer thickness in the BBL that is + ! coupled to the bottom within a timestep [H ~> m or kg m-2] + + real :: htot(SZIB_(G)) ! The summed thickness from the bottom [H ~> m or kg m-2]. + real :: b1(SZIB_(G)), d1(SZIB_(G)) ! b1, c1, and d1 are variables used by the + real :: c1(SZIB_(G),SZK_(G)) ! tridiagonal solver. + + real :: Ent_int ! The diffusive entrainment rate at an interface [H ~> m or kg m-2] + real :: dt_mix ! The amount of time over which to apply mixing [s] + real :: Idt ! The inverse time step [s-1] + real :: dt_in_T ! The time step converted to T units [T ~> s] + + integer :: dir_flag ! An integer encoding the directions in which to do halo updates. + logical :: showCallTree ! If true, show the call tree + integer :: i, j, k, is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz, nkmb, m, halo + + integer :: ig, jg ! global indices for testing testing itide point source (BDM) + logical :: avg_enabled ! for testing internal tides (BDM) + real :: Kd_add_here ! An added diffusivity [Z2 T-1 ~> m2 s-1]. + + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke + Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB + nkmb = GV%nk_rho_varies + h_neglect = GV%H_subroundoff ; h_neglect2 = h_neglect*h_neglect + Kd_heat(:,:,:) = 0.0 ; Kd_salt(:,:,:) = 0.0 + + + if (nz == 1) return + showCallTree = callTree_showQuery() + if (showCallTree) call callTree_enter("diabatic(), MOM_diabatic_driver.F90") + + ! Offer diagnostics of various state varables at the start of diabatic + ! these are mostly for debugging purposes. + if (CS%id_u_predia > 0) call post_data(CS%id_u_predia, u, CS%diag) + if (CS%id_v_predia > 0) call post_data(CS%id_v_predia, v, CS%diag) + if (CS%id_h_predia > 0) call post_data(CS%id_h_predia, h, CS%diag) + if (CS%id_T_predia > 0) call post_data(CS%id_T_predia, tv%T, CS%diag) + if (CS%id_S_predia > 0) call post_data(CS%id_S_predia, tv%S, CS%diag) + if (CS%id_e_predia > 0) then + call find_eta(h, tv, G, GV, US, eta, eta_to_m=1.0) + call post_data(CS%id_e_predia, eta, CS%diag) + endif + + ! set equivalence between the same bits of memory for these arrays + eaml => eatr ; ebml => ebtr + + ! inverse time step + if (dt == 0.0) call MOM_error(FATAL, "MOM_diabatic_driver: "// & + "legacy_diabatic was called with a zero length timestep.") + if (dt < 0.0) call MOM_error(FATAL, "MOM_diabatic_driver: "// & + "legacy_diabatic was called with a negative timestep.") + Idt = 1.0 / dt + dt_in_T = dt * US%s_to_T + + if (.not. associated(CS)) call MOM_error(FATAL, "MOM_diabatic_driver: "// & + "Module must be initialized before it is used.") + + if (CS%debug) then + call MOM_state_chksum("Start of diabatic ", u, v, h, G, GV, haloshift=0) + call MOM_forcing_chksum("Start of diabatic", fluxes, G, US, haloshift=0) + endif + if (CS%debugConservation) call MOM_state_stats('Start of diabatic', u, v, h, tv%T, tv%S, G) + + if (CS%debug_energy_req) & + call diapyc_energy_req_test(h, dt_in_T, tv, G, GV, US, CS%diapyc_en_rec_CSp) + + call cpu_clock_begin(id_clock_set_diffusivity) + call set_BBL_TKE(u, v, h, fluxes, visc, G, GV, US, CS%set_diff_CSp) + call cpu_clock_end(id_clock_set_diffusivity) + + ! Frazil formation keeps the temperature above the freezing point. + ! make_frazil is deliberately called at both the beginning and at + ! the end of the diabatic processes. + if (associated(tv%T) .AND. associated(tv%frazil)) then + ! For frazil diagnostic, the first call covers the first half of the time step + call enable_averaging(0.5*dt, Time_end - real_to_time(0.5*dt), CS%diag) + if (CS%frazil_tendency_diag) then + do k=1,nz ; do j=js,je ; do i=is,ie + temp_diag(i,j,k) = tv%T(i,j,k) + enddo ; enddo ; enddo + endif + + if (associated(fluxes%p_surf_full)) then + call make_frazil(h, tv, G, GV, CS%diabatic_aux_CSp, fluxes%p_surf_full, halo=CS%halo_TS_diff) + else + call make_frazil(h, tv, G, GV, CS%diabatic_aux_CSp, halo=CS%halo_TS_diff) + endif + if (showCallTree) call callTree_waypoint("done with 1st make_frazil (diabatic)") + + if (CS%frazil_tendency_diag) then + call diagnose_frazil_tendency(tv, h, temp_diag, 0.5*dt, G, GV, CS) + if (CS%id_frazil_h > 0) call post_data(CS%id_frazil_h, h, CS%diag) + endif + call disable_averaging(CS%diag) + endif ! associated(tv%T) .AND. associated(tv%frazil) + + ! For all other diabatic subroutines, the averaging window should be the entire diabatic timestep + call enable_averaging(dt, Time_end, CS%diag) + if (CS%debugConservation) call MOM_state_stats('1st make_frazil', u, v, h, tv%T, tv%S, G) + + if (CS%use_geothermal) then + halo = CS%halo_TS_diff + !$OMP parallel do default(shared) + do k=1,nz ; do j=js-halo,je+halo ; do i=is-halo,ie+halo + h_orig(i,j,k) = h(i,j,k) ; eaml(i,j,k) = 0.0 ; ebml(i,j,k) = 0.0 + enddo ; enddo ; enddo + endif + + if (CS%use_geothermal) then + call cpu_clock_begin(id_clock_geothermal) + call geothermal(h, tv, dt, eaml, ebml, G, GV, CS%geothermal_CSp, halo=CS%halo_TS_diff) + call cpu_clock_end(id_clock_geothermal) + if (showCallTree) call callTree_waypoint("geothermal (diabatic)") + if (CS%debugConservation) call MOM_state_stats('geothermal', u, v, h, tv%T, tv%S, G) + endif + + ! Whenever thickness changes let the diag manager know, target grids + ! for vertical remapping may need to be regenerated. + call diag_update_remap_grids(CS%diag) + + ! Set_opacity estimates the optical properties of the water column. + ! It will need to be modified later to include information about the + ! biological properties and layer thicknesses. + if (associated(CS%optics)) & + call set_opacity(CS%optics, fluxes, G, GV, CS%opacity_CSp) + + if (CS%debug) & + call MOM_state_chksum("before find_uv_at_h", u, v, h, G, GV, haloshift=0) + if (CS%use_kappa_shear .or. CS%use_CVMix_shear) then + if (CS%use_geothermal) then + call find_uv_at_h(u, v, h_orig, u_h, v_h, G, GV, eaml, ebml) + if (CS%debug) then + call hchksum(eaml, "after find_uv_at_h eaml",G%HI, scale=GV%H_to_m) + call hchksum(ebml, "after find_uv_at_h ebml",G%HI, scale=GV%H_to_m) + endif + else + call find_uv_at_h(u, v, h, u_h, v_h, G, GV) + endif + if (showCallTree) call callTree_waypoint("done with find_uv_at_h (diabatic)") + endif + + if (CS%use_int_tides) then + ! This block provides an interface for the unresolved low-mode internal + ! tide module (BDM). + + ! PROVIDE ENERGY DISTRIBUTION (calculate time-varying energy source) + call set_int_tide_input(u, v, h, tv, fluxes, CS%int_tide_input, dt, G, GV, US, & + CS%int_tide_input_CSp) + ! CALCULATE MODAL VELOCITIES + cn(:,:,:) = 0.0 + if (CS%uniform_cg) then + ! SET TO CONSTANT VALUE TO TEST PROPAGATE CODE + do m=1,CS%nMode ; cn(:,:,m) = CS%cg_test ; enddo + else + call wave_speeds(h, tv, G, GV, US, CS%nMode, cn, full_halos=.true.) + ! uncomment the lines below for a hard-coded cn that changes linearly with latitude + !do j=G%jsd,G%jed ; do i=G%isd,G%ied + ! cn(i,j,:) = ((7.-1.)/14000000.)*G%geoLatBu(i,j) + (1.-((7.-1.)/14000000.)*-7000000.) + !enddo ; enddo + endif + + if (CS%int_tide_source_test) then + ! BUILD 2D ARRAY WITH POINT SOURCE FOR TESTING + ! This block of code should be moved into set_int_tide_input. -RWH + TKE_itidal_input_test(:,:) = 0.0 + avg_enabled = query_averaging_enabled(CS%diag,time_end=CS%time_end) + if (CS%time_end <= CS%time_max_source) then + do j=G%jsc,G%jec ; do i=G%isc,G%iec + !INPUT ARBITRARY ENERGY POINT SOURCE + if ((G%idg_offset + i == CS%int_tide_source_x) .and. & + (G%jdg_offset + j == CS%int_tide_source_y)) then + TKE_itidal_input_test(i,j) = 1.0 + endif + enddo ; enddo + endif + ! CALL ROUTINE USING PRESCRIBED KE FOR TESTING + call propagate_int_tide(h, tv, cn, TKE_itidal_input_test, CS%int_tide_input%tideamp, & + CS%int_tide_input%Nb, dt, G, GV, US, CS%int_tide_CSp) + else + ! CALL ROUTINE USING CALCULATED KE INPUT + call propagate_int_tide(h, tv, cn, CS%int_tide_input%TKE_itidal_input, CS%int_tide_input%tideamp, & + CS%int_tide_input%Nb, dt, G, GV, US, CS%int_tide_CSp) + endif + if (showCallTree) call callTree_waypoint("done with propagate_int_tide (diabatic)") + endif ! end CS%use_int_tides + + call cpu_clock_begin(id_clock_set_diffusivity) + ! Sets: Kd_lay, Kd_int, visc%Kd_extra_T, visc%Kd_extra_S and visc%TKE_turb + ! Also changes: visc%Kd_shear and visc%Kv_shear + call set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, CS%optics, visc, dt, G, GV, US, & + CS%set_diff_CSp, Kd_lay, Kd_int) + call cpu_clock_end(id_clock_set_diffusivity) + if (showCallTree) call callTree_waypoint("done with set_diffusivity (diabatic)") + + if (CS%debug) then + call MOM_state_chksum("after set_diffusivity ", u, v, h, G, GV, haloshift=0) + call MOM_forcing_chksum("after set_diffusivity ", fluxes, G, US, haloshift=0) + call MOM_thermovar_chksum("after set_diffusivity ", tv, G) + call hchksum(Kd_lay, "after set_diffusivity Kd_lay", G%HI, haloshift=0, scale=US%Z2_T_to_m2_s) + call hchksum(Kd_Int, "after set_diffusivity Kd_Int", G%HI, haloshift=0, scale=US%Z2_T_to_m2_s) + endif + + + if (CS%useKPP) then + call cpu_clock_begin(id_clock_kpp) + ! KPP needs the surface buoyancy flux but does not update state variables. + ! We could make this call higher up to avoid a repeat unpacking of the surface fluxes. + ! Sets: CS%KPP_buoy_flux, CS%KPP_temp_flux, CS%KPP_salt_flux + ! NOTE: CS%KPP_buoy_flux, CS%KPP_temp_flux, CS%KPP_salt_flux are returned as rates (i.e. stuff per second) + ! unlike other instances where the fluxes are integrated in time over a time-step. + call calculateBuoyancyFlux2d(G, GV, US, fluxes, CS%optics, h, tv%T, tv%S, tv, & + CS%KPP_buoy_flux, CS%KPP_temp_flux, CS%KPP_salt_flux) + ! The KPP scheme calculates boundary layer diffusivities and non-local transport. + + ! Set diffusivities for heat and salt separately + + !$OMP parallel do default(shared) + do k=1,nz+1 ; do j=js,je ; do i=is,ie + Kd_salt(i,j,k) = Kd_int(i,j,K) + Kd_heat(i,j,k) = Kd_int(i,j,K) + enddo ; enddo ; enddo + ! Add contribution from double diffusion + if (associated(visc%Kd_extra_S)) then + !$OMP parallel do default(shared) + do k=1,nz+1 ; do j=js,je ; do i=is,ie + Kd_salt(i,j,k) = Kd_salt(i,j,k) + visc%Kd_extra_S(i,j,k) + enddo ; enddo ; enddo + endif + if (associated(visc%Kd_extra_T)) then + !$OMP parallel do default(shared) + do k=1,nz+1 ; do j=js,je ; do i=is,ie + Kd_heat(i,j,k) = Kd_heat(i,j,k) + visc%Kd_extra_T(i,j,k) + enddo ; enddo ; enddo + endif + + call KPP_compute_BLD(CS%KPP_CSp, G, GV, US, h, tv%T, tv%S, u, v, tv%eqn_of_state, & + fluxes%ustar, CS%KPP_buoy_flux, Waves=Waves) + + call KPP_calculate(CS%KPP_CSp, G, GV, US, h, fluxes%ustar, CS%KPP_buoy_flux, Kd_heat, & + Kd_salt, visc%Kv_shear, CS%KPP_NLTheat, CS%KPP_NLTscalar, Waves=Waves) + + if (associated(Hml)) then + call KPP_get_BLD(CS%KPP_CSp, Hml(:,:), G) + call pass_var(Hml, G%domain, halo=1) + ! If visc%MLD exists, copy KPP's BLD into it + if (associated(visc%MLD)) visc%MLD(:,:) = Hml(:,:) + endif + + if (.not. CS%KPPisPassive) then + !$OMP parallel do default(shared) + do k=1,nz+1 ; do j=js,je ; do i=is,ie + Kd_int(i,j,K) = min( Kd_salt(i,j,k), Kd_heat(i,j,k) ) + enddo ; enddo ; enddo + if (associated(visc%Kd_extra_S)) then + !$OMP parallel do default(shared) + do k=1,nz+1 ; do j=js,je ; do i=is,ie + visc%Kd_extra_S(i,j,k) = (Kd_salt(i,j,k) - Kd_int(i,j,K)) + enddo ; enddo ; enddo + endif + if (associated(visc%Kd_extra_T)) then + !$OMP parallel do default(shared) + do k=1,nz+1 ; do j=js,je ; do i=is,ie + visc%Kd_extra_T(i,j,k) = (Kd_heat(i,j,k) - Kd_int(i,j,K)) + enddo ; enddo ; enddo + endif + endif ! not passive + + call cpu_clock_end(id_clock_kpp) + if (showCallTree) call callTree_waypoint("done with KPP_calculate (diabatic)") + if (CS%debug) then + call MOM_state_chksum("after KPP", u, v, h, G, GV, haloshift=0) + call MOM_forcing_chksum("after KPP", fluxes, G, US, haloshift=0) + call MOM_thermovar_chksum("after KPP", tv, G) + call hchksum(Kd_lay, "after KPP Kd_lay", G%HI, haloshift=0, scale=US%Z2_T_to_m2_s) + call hchksum(Kd_Int, "after KPP Kd_Int", G%HI, haloshift=0, scale=US%Z2_T_to_m2_s) + endif + + endif ! endif for KPP + + ! Add vertical diff./visc. due to convection (computed via CVMix) + if (CS%use_CVMix_conv) then + call calculate_CVMix_conv(h, tv, G, GV, US, CS%CVMix_conv_csp, Hml) + + do K=1,nz+1 ; do j=js,je ; do i=is,ie + Kd_int(i,j,K) = Kd_int(i,j,K) + CS%CVMix_conv_csp%kd_conv(i,j,K) + visc%Kv_slow(i,j,K) = visc%Kv_slow(i,j,K) + CS%CVMix_conv_csp%kv_conv(i,j,K) + enddo ; enddo ; enddo + endif + + if (CS%useKPP) then + call cpu_clock_begin(id_clock_kpp) + if (CS%debug) then + call hchksum(CS%KPP_temp_flux, "before KPP_applyNLT netHeat", G%HI, haloshift=0, scale=GV%H_to_m) + call hchksum(CS%KPP_salt_flux, "before KPP_applyNLT netSalt", G%HI, haloshift=0, scale=GV%H_to_m) + call hchksum(CS%KPP_NLTheat, "before KPP_applyNLT NLTheat", G%HI, haloshift=0) + call hchksum(CS%KPP_NLTscalar, "before KPP_applyNLT NLTscalar", G%HI, haloshift=0) + endif + ! Apply non-local transport of heat and salt + ! Changes: tv%T, tv%S + call KPP_NonLocalTransport_temp(CS%KPP_CSp, G, GV, h, CS%KPP_NLTheat, CS%KPP_temp_flux, dt, tv%T, tv%C_p) + call KPP_NonLocalTransport_saln(CS%KPP_CSp, G, GV, h, CS%KPP_NLTscalar, CS%KPP_salt_flux, dt, tv%S) + call cpu_clock_end(id_clock_kpp) + if (showCallTree) call callTree_waypoint("done with KPP_applyNonLocalTransport (diabatic)") + if (CS%debugConservation) call MOM_state_stats('KPP_applyNonLocalTransport', u, v, h, tv%T, tv%S, G) + + if (CS%debug) then + call MOM_state_chksum("after KPP_applyNLT ", u, v, h, G, GV, haloshift=0) + call MOM_forcing_chksum("after KPP_applyNLT ", fluxes, G, US, haloshift=0) + call MOM_thermovar_chksum("after KPP_applyNLT ", tv, G) + endif + endif ! endif for KPP + + ! Differential diffusion done here. + ! Changes: tv%T, tv%S + if (associated(visc%Kd_extra_T) .and. associated(visc%Kd_extra_S) .and. associated(tv%T)) then + + call cpu_clock_begin(id_clock_differential_diff) + call differential_diffuse_T_S(h, tv, visc, dt_in_T, G, GV) + call cpu_clock_end(id_clock_differential_diff) + if (showCallTree) call callTree_waypoint("done with differential_diffuse_T_S (diabatic)") + if (CS%debugConservation) call MOM_state_stats('differential_diffuse_T_S', u, v, h, tv%T, tv%S, G) + + ! increment heat and salt diffusivity. + ! CS%useKPP==.true. already has extra_T and extra_S included + if (.not. CS%useKPP) then + !$OMP parallel do default(shared) + do K=2,nz ; do j=js,je ; do i=is,ie + Kd_heat(i,j,K) = Kd_heat(i,j,K) + visc%Kd_extra_T(i,j,K) + Kd_salt(i,j,K) = Kd_salt(i,j,K) + visc%Kd_extra_S(i,j,K) + enddo ; enddo ; enddo + endif + + endif + + ! This block sets ea, eb from Kd or Kd_int. + ! If using ALE algorithm, set ea=eb=Kd_int on interfaces for + ! use in the tri-diagonal solver. + ! Otherwise, call entrainment_diffusive() which sets ea and eb + ! based on KD and target densities (ie. does remapping as well). + do j=js,je ; do i=is,ie + ea(i,j,1) = 0. + enddo ; enddo + !$OMP parallel do default(shared) private(hval) + do k=2,nz ; do j=js,je ; do i=is,ie + hval=1.0/(h_neglect + 0.5*(h(i,j,k-1) + h(i,j,k))) + ea(i,j,k) = (GV%Z_to_H**2) * dt_in_T * hval * Kd_int(i,j,K) + eb(i,j,k-1) = ea(i,j,k) + enddo ; enddo ; enddo + do j=js,je ; do i=is,ie + eb(i,j,nz) = 0. + enddo ; enddo + if (showCallTree) call callTree_waypoint("done setting ea,eb from Kd_int (diabatic)") + + if (CS%debug) then + call MOM_forcing_chksum("after calc_entrain ", fluxes, G, US, haloshift=0) + call MOM_thermovar_chksum("after calc_entrain ", tv, G) + call MOM_state_chksum("after calc_entrain ", u, v, h, G, GV, haloshift=0) + call hchksum(ea, "after calc_entrain ea", G%HI, haloshift=0, scale=GV%H_to_m) + call hchksum(eb, "after calc_entrain eb", G%HI, haloshift=0, scale=GV%H_to_m) + endif + + ! Save fields before boundary forcing is applied for tendency diagnostics + if (CS%boundary_forcing_tendency_diag) then + do k=1,nz ; do j=js,je ; do i=is,ie + h_diag(i,j,k) = h(i,j,k) + temp_diag(i,j,k) = tv%T(i,j,k) + saln_diag(i,j,k) = tv%S(i,j,k) + enddo ; enddo ; enddo + endif + + ! Apply forcing when using the ALE algorithm + call cpu_clock_begin(id_clock_remap) + + ! Changes made to following fields: h, tv%T and tv%S. + + do k=1,nz ; do j=js,je ; do i=is,ie + h_prebound(i,j,k) = h(i,j,k) + enddo ; enddo ; enddo + if (CS%use_energetic_PBL) then + + skinbuoyflux(:,:) = 0.0 + call applyBoundaryFluxesInOut(CS%diabatic_aux_CSp, G, GV, US, dt, fluxes, CS%optics, & + h, tv, CS%aggregate_FW_forcing, CS%evap_CFL_limit, & + CS%minimum_forcing_depth, cTKE, dSV_dT, dSV_dS, SkinBuoyFlux=SkinBuoyFlux) + + if (CS%debug) then + call hchksum(ea, "after applyBoundaryFluxes ea",G%HI,haloshift=0, scale=GV%H_to_m) + call hchksum(eb, "after applyBoundaryFluxes eb",G%HI,haloshift=0, scale=GV%H_to_m) + call hchksum(cTKE, "after applyBoundaryFluxes cTKE",G%HI,haloshift=0) + call hchksum(dSV_dT, "after applyBoundaryFluxes dSV_dT",G%HI,haloshift=0) + call hchksum(dSV_dS, "after applyBoundaryFluxes dSV_dS",G%HI,haloshift=0) + endif + + call find_uv_at_h(u, v, h, u_h, v_h, G, GV) + call energetic_PBL(h, u_h, v_h, tv, fluxes, dt_in_T, Kd_ePBL, G, GV, US, & + CS%energetic_PBL_CSp, dSV_dT, dSV_dS, cTKE, SkinBuoyFlux, waves=waves) + + ! If visc%MLD exists, copy the ePBL's MLD into it + if (associated(visc%MLD)) then + call energetic_PBL_get_MLD(CS%energetic_PBL_CSp, visc%MLD, G, US) + call pass_var(visc%MLD, G%domain, halo=1) + Hml(:,:) = visc%MLD(:,:) + endif + + ! Augment the diffusivities due to those diagnosed in energetic_PBL. + do K=2,nz ; do j=js,je ; do i=is,ie + + if (CS%ePBL_is_additive) then + Kd_add_here = Kd_ePBL(i,j,K) + visc%Kv_shear(i,j,K) = visc%Kv_shear(i,j,K) + Kd_ePBL(i,j,K) + else + Kd_add_here = max(Kd_ePBL(i,j,K) - visc%Kd_shear(i,j,K), 0.0) + visc%Kv_shear(i,j,K) = max(visc%Kv_shear(i,j,K), Kd_ePBL(i,j,K)) + endif + Ent_int = Kd_add_here * (GV%Z_to_H**2 * dt_in_T) / & + (0.5*(h(i,j,k-1) + h(i,j,k)) + h_neglect) + eb(i,j,k-1) = eb(i,j,k-1) + Ent_int + ea(i,j,k) = ea(i,j,k) + Ent_int + Kd_int(i,j,K) = Kd_int(i,j,K) + Kd_add_here + + ! for diagnostics + Kd_heat(i,j,K) = Kd_heat(i,j,K) + Kd_int(i,j,K) + Kd_salt(i,j,K) = Kd_salt(i,j,K) + Kd_int(i,j,K) + + enddo ; enddo ; enddo + + if (CS%debug) then + call hchksum(ea, "after ePBL ea",G%HI,haloshift=0, scale=GV%H_to_m) + call hchksum(eb, "after ePBL eb",G%HI,haloshift=0, scale=GV%H_to_m) + call hchksum(Kd_ePBL, "after ePBL Kd_ePBL", G%HI, haloshift=0, scale=US%Z2_T_to_m2_s) + endif + + else + call applyBoundaryFluxesInOut(CS%diabatic_aux_CSp, G, GV, US, dt, fluxes, CS%optics, & + h, tv, CS%aggregate_FW_forcing, & + CS%evap_CFL_limit, CS%minimum_forcing_depth) + + endif ! endif for CS%use_energetic_PBL + + ! diagnose the tendencies due to boundary forcing + ! At this point, the diagnostic grids have not been updated since the call to the boundary layer scheme + ! so all tendency diagnostics need to be posted on h_diag, and grids rebuilt afterwards + if (CS%boundary_forcing_tendency_diag) then + call diagnose_boundary_forcing_tendency(tv, h, temp_diag, saln_diag, h_diag, dt, G, GV, CS) + if (CS%id_boundary_forcing_h > 0) call post_data(CS%id_boundary_forcing_h, h, CS%diag, alt_h = h_diag) + endif + ! Boundary fluxes may have changed T, S, and h + call diag_update_remap_grids(CS%diag) + + call cpu_clock_end(id_clock_remap) + if (CS%debug) then + call MOM_forcing_chksum("after applyBoundaryFluxes ", fluxes, G, US, haloshift=0) + call MOM_thermovar_chksum("after applyBoundaryFluxes ", tv, G) + call MOM_state_chksum("after applyBoundaryFluxes ", u, v, h, G, GV, haloshift=0) + endif + if (showCallTree) call callTree_waypoint("done with applyBoundaryFluxes (diabatic)") + if (CS%debugConservation) call MOM_state_stats('applyBoundaryFluxes', u, v, h, tv%T, tv%S, G) + + ! Update h according to divergence of the difference between + ! ea and eb. We keep a record of the original h in hold. + ! In the following, the checks for negative values are to guard + ! against instances where entrainment drives a layer to + ! negative thickness. This situation will never happen if + ! enough iterations are permitted in Calculate_Entrainment. + ! Even if too few iterations are allowed, it is still guarded + ! against. In other words the checks are probably unnecessary. + !$OMP parallel do default(shared) + do j=js,je + do i=is,ie + hold(i,j,1) = h(i,j,1) + h(i,j,1) = h(i,j,1) + (eb(i,j,1) - ea(i,j,2)) + hold(i,j,nz) = h(i,j,nz) + h(i,j,nz) = h(i,j,nz) + (ea(i,j,nz) - eb(i,j,nz-1)) + if (h(i,j,1) <= 0.0) h(i,j,1) = GV%Angstrom_H + if (h(i,j,nz) <= 0.0) h(i,j,nz) = GV%Angstrom_H + enddo + do k=2,nz-1 ; do i=is,ie + hold(i,j,k) = h(i,j,k) + h(i,j,k) = h(i,j,k) + ((ea(i,j,k) - eb(i,j,k-1)) + & + (eb(i,j,k) - ea(i,j,k+1))) + if (h(i,j,k) <= 0.0) h(i,j,k) = GV%Angstrom_H + enddo ; enddo + enddo + ! Checks for negative thickness may have changed layer thicknesses + call diag_update_remap_grids(CS%diag) + + if (CS%debug) then + call MOM_state_chksum("after negative check ", u, v, h, G, GV, haloshift=0) + call MOM_forcing_chksum("after negative check ", fluxes, G, US, haloshift=0) + call MOM_thermovar_chksum("after negative check ", tv, G) + endif + if (showCallTree) call callTree_waypoint("done with h=ea-eb (diabatic)") + if (CS%debugConservation) call MOM_state_stats('h=ea-eb', u, v, h, tv%T, tv%S, G) + + ! Here, T and S are updated according to ea and eb. + ! If using the bulk mixed layer, T and S are also updated + ! by surface fluxes (in fluxes%*). + ! This is a very long block. + + ! calculate change in temperature & salinity due to dia-coordinate surface diffusion + if (associated(tv%T)) then + + if (CS%debug) then + call hchksum(ea, "before triDiagTS ea ",G%HI,haloshift=0, scale=GV%H_to_m) + call hchksum(eb, "before triDiagTS eb ",G%HI,haloshift=0, scale=GV%H_to_m) + endif + call cpu_clock_begin(id_clock_tridiag) + + ! Keep salinity from falling below a small but positive threshold. + ! This constraint is needed for SIS1 ice model, which can extract + ! more salt than is present in the ocean. SIS2 does not suffer + ! from this limitation, in which case we can let salinity=0 and still + ! have salt conserved with SIS2 ice. So for SIS2, we can run with + ! BOUND_SALINITY=False in MOM.F90. + if (associated(tv%S) .and. associated(tv%salt_deficit)) & + call adjust_salt(h, tv, G, GV, CS%diabatic_aux_CSp) + + if (CS%diabatic_diff_tendency_diag) then + do k=1,nz ; do j=js,je ; do i=is,ie + temp_diag(i,j,k) = tv%T(i,j,k) + saln_diag(i,j,k) = tv%S(i,j,k) + enddo ; enddo ; enddo + endif + + ! Changes T and S via the tridiagonal solver; no change to h + if (CS%tracer_tridiag) then + call tracer_vertdiff(hold, ea, eb, dt, tv%T, G, GV) + call tracer_vertdiff(hold, ea, eb, dt, tv%S, G, GV) + else + call triDiagTS(G, GV, is, ie, js, je, hold, ea, eb, tv%T, tv%S) + endif + + ! diagnose temperature, salinity, heat, and salt tendencies + ! Note: hold here refers to the thicknesses from before the dual-entraintment when using + ! the bulk mixed layer scheme. Otherwise in ALE-mode, layer thicknesses will have changed + ! In either case, tendencies should be posted on hold + if (CS%diabatic_diff_tendency_diag) then + call diagnose_diabatic_diff_tendency(tv, hold, temp_diag, saln_diag, dt, G, GV, CS) + if (CS%id_diabatic_diff_h > 0) call post_data(CS%id_diabatic_diff_h, hold, CS%diag, alt_h = hold) + endif + + call cpu_clock_end(id_clock_tridiag) + if (showCallTree) call callTree_waypoint("done with triDiagTS (diabatic)") + + endif ! endif corresponding to if (associated(tv%T)) + if (CS%debugConservation) call MOM_state_stats('triDiagTS', u, v, h, tv%T, tv%S, G) + + if (CS%debug) then + call MOM_state_chksum("after mixed layer ", u, v, h, G, GV, haloshift=0) + call MOM_thermovar_chksum("after mixed layer ", tv, G) + call hchksum(ea, "after mixed layer ea", G%HI, scale=GV%H_to_m) + call hchksum(eb, "after mixed layer eb", G%HI, scale=GV%H_to_m) + endif + + ! Whenever thickness changes let the diag manager know, as the + ! target grids for vertical remapping may need to be regenerated. + if (CS%id_dudt_dia > 0 .or. CS%id_dvdt_dia > 0) & + ! Remapped d[uv]dt_dia require east/north halo updates of h + call pass_var(h, G%domain, To_West+To_South+Omit_Corners, halo=1) + call diag_update_remap_grids(CS%diag) + + ! diagnostics + if ((CS%id_Tdif > 0) .or. (CS%id_Tadv > 0)) then + do j=js,je ; do i=is,ie + Tdif_flx(i,j,1) = 0.0 ; Tdif_flx(i,j,nz+1) = 0.0 + Tadv_flx(i,j,1) = 0.0 ; Tadv_flx(i,j,nz+1) = 0.0 + enddo ; enddo + !$OMP parallel do default(shared) + do K=2,nz ; do j=js,je ; do i=is,ie + Tdif_flx(i,j,K) = (Idt * 0.5*(ea(i,j,k) + eb(i,j,k-1))) * & + (tv%T(i,j,k-1) - tv%T(i,j,k)) + Tadv_flx(i,j,K) = (Idt * (ea(i,j,k) - eb(i,j,k-1))) * & + 0.5*(tv%T(i,j,k-1) + tv%T(i,j,k)) + enddo ; enddo ; enddo + endif + if ((CS%id_Sdif > 0) .or. (CS%id_Sadv > 0)) then + do j=js,je ; do i=is,ie + Sdif_flx(i,j,1) = 0.0 ; Sdif_flx(i,j,nz+1) = 0.0 + Sadv_flx(i,j,1) = 0.0 ; Sadv_flx(i,j,nz+1) = 0.0 + enddo ; enddo + !$OMP parallel do default(shared) + do K=2,nz ; do j=js,je ; do i=is,ie + Sdif_flx(i,j,K) = (Idt * 0.5*(ea(i,j,k) + eb(i,j,k-1))) * & + (tv%S(i,j,k-1) - tv%S(i,j,k)) + Sadv_flx(i,j,K) = (Idt * (ea(i,j,k) - eb(i,j,k-1))) * & + 0.5*(tv%S(i,j,k-1) + tv%S(i,j,k)) + enddo ; enddo ; enddo + endif + + ! mixing of passive tracers from massless boundary layers to interior + call cpu_clock_begin(id_clock_tracers) + if (CS%mix_boundary_tracers) then + Tr_ea_BBL = GV%Z_to_H * sqrt(dt_in_T*CS%Kd_BBL_tr) + !$OMP parallel do default(shared) private(htot,in_boundary,add_ent) + do j=js,je + do i=is,ie + ebtr(i,j,nz) = eb(i,j,nz) + htot(i) = 0.0 + in_boundary(i) = (G%mask2dT(i,j) > 0.0) + enddo + do k=nz,2,-1 ; do i=is,ie + if (in_boundary(i)) then + htot(i) = htot(i) + h(i,j,k) + ! If diapycnal mixing has been suppressed because this is a massless + ! layer near the bottom, add some mixing of tracers between these + ! layers. This flux is based on the harmonic mean of the two + ! thicknesses, as this corresponds pretty closely (to within + ! differences in the density jumps between layers) with what is done + ! in the calculation of the fluxes in the first place. Kd_min_tr + ! should be much less than the values that have been set in Kd_lay, + ! perhaps a molecular diffusivity. + add_ent = ((dt_in_T * CS%Kd_min_tr) * GV%Z_to_H**2) * & + ((h(i,j,k-1)+h(i,j,k)+h_neglect) / & + (h(i,j,k-1)*h(i,j,k)+h_neglect2)) - & + 0.5*(ea(i,j,k) + eb(i,j,k-1)) + if (htot(i) < Tr_ea_BBL) then + add_ent = max(0.0, add_ent, & + (Tr_ea_BBL - htot(i)) - min(ea(i,j,k),eb(i,j,k-1))) + elseif (add_ent < 0.0) then + add_ent = 0.0 ; in_boundary(i) = .false. + endif + + ebtr(i,j,k-1) = eb(i,j,k-1) + add_ent + eatr(i,j,k) = ea(i,j,k) + add_ent + else + ebtr(i,j,k-1) = eb(i,j,k-1) ; eatr(i,j,k) = ea(i,j,k) + endif + if (associated(visc%Kd_extra_S)) then ; if (visc%Kd_extra_S(i,j,k) > 0.0) then + add_ent = ((dt_in_T * visc%Kd_extra_S(i,j,k)) * GV%Z_to_H**2) / & + (0.25 * ((h(i,j,k-1) + h(i,j,k)) + (hold(i,j,k-1) + hold(i,j,k))) + & + h_neglect) + ebtr(i,j,k-1) = ebtr(i,j,k-1) + add_ent + eatr(i,j,k) = eatr(i,j,k) + add_ent + endif ; endif + enddo ; enddo + do i=is,ie ; eatr(i,j,1) = ea(i,j,1) ; enddo + + enddo + + ! For passive tracers, the changes in thickness due to boundary fluxes has yet to be applied + ! so hold should be h_orig + call call_tracer_column_fns(h_prebound, h, ea, eb, fluxes, Hml, dt, G, GV, tv, & + CS%optics, CS%tracer_flow_CSp, CS%debug, & + evap_CFL_limit = CS%evap_CFL_limit, & + minimum_forcing_depth = CS%minimum_forcing_depth) + + elseif (associated(visc%Kd_extra_S)) then ! extra diffusivity for passive tracers + + do j=js,je ; do i=is,ie + ebtr(i,j,nz) = eb(i,j,nz) ; eatr(i,j,1) = ea(i,j,1) + enddo ; enddo + !$OMP parallel do default(shared) private(add_ent) + do k=nz,2,-1 ; do j=js,je ; do i=is,ie + if (visc%Kd_extra_S(i,j,k) > 0.0) then + add_ent = ((dt_in_T * visc%Kd_extra_S(i,j,k)) * GV%Z_to_H**2) / & + (0.25 * ((h(i,j,k-1) + h(i,j,k)) + (hold(i,j,k-1) + hold(i,j,k))) + & + h_neglect) + else + add_ent = 0.0 + endif + ebtr(i,j,k-1) = eb(i,j,k-1) + add_ent + eatr(i,j,k) = ea(i,j,k) + add_ent + enddo ; enddo ; enddo + + ! For passive tracers, the changes in thickness due to boundary fluxes has yet to be applied + call call_tracer_column_fns(h_prebound, h, eatr, ebtr, fluxes, Hml, dt, G, GV, tv, & + CS%optics, CS%tracer_flow_CSp, CS%debug,& + evap_CFL_limit = CS%evap_CFL_limit, & + minimum_forcing_depth = CS%minimum_forcing_depth) else - call diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & - G, GV, US, CS, Waves) + ! For passive tracers, the changes in thickness due to boundary fluxes has yet to be applied + call call_tracer_column_fns(h_prebound, h, eatr, ebtr, fluxes, Hml, dt, G, GV, tv, & + CS%optics, CS%tracer_flow_CSp, CS%debug, & + evap_CFL_limit = CS%evap_CFL_limit, & + minimum_forcing_depth = CS%minimum_forcing_depth) + endif ! (CS%mix_boundary_tracers) + + call cpu_clock_end(id_clock_tracers) + + ! sponges + if (CS%use_sponge .and. associated(CS%ALE_sponge_CSp)) then + call cpu_clock_begin(id_clock_sponge) + ! ALE sponge + call apply_ALE_sponge(h, dt, G, GV, US, CS%ALE_sponge_CSp, CS%Time) + call cpu_clock_end(id_clock_sponge) + if (CS%debug) then + call MOM_state_chksum("apply_sponge ", u, v, h, G, GV, haloshift=0) + call MOM_thermovar_chksum("apply_sponge ", tv, G) + endif + endif ! CS%use_sponge + + call cpu_clock_begin(id_clock_pass) + if (associated(visc%Kv_shear)) & + call pass_var(visc%Kv_shear, G%Domain, To_All+Omit_Corners, halo=1) + call cpu_clock_end(id_clock_pass) + + call disable_averaging(CS%diag) + ! Frazil formation keeps temperature above the freezing point. + ! make_frazil is deliberately called at both the beginning and at + ! the end of the diabatic processes. + if (associated(tv%T) .AND. associated(tv%frazil)) then + call enable_averaging(0.5*dt, Time_end, CS%diag) + if (CS%frazil_tendency_diag) then + do k=1,nz ; do j=js,je ; do i=is,ie + temp_diag(i,j,k) = tv%T(i,j,k) + enddo ; enddo ; enddo + endif + + if (associated(fluxes%p_surf_full)) then + call make_frazil(h, tv, G, GV, CS%diabatic_aux_CSp, fluxes%p_surf_full) + else + call make_frazil(h, tv, G, GV, CS%diabatic_aux_CSp) + endif + + if (CS%frazil_tendency_diag) then + call diagnose_frazil_tendency(tv, h, temp_diag, 0.5*dt, G, GV, CS) + if (CS%id_frazil_h > 0 ) call post_data(CS%id_frazil_h, h, CS%diag) + endif + + if (showCallTree) call callTree_waypoint("done with 2nd make_frazil (diabatic)") + if (CS%debugConservation) call MOM_state_stats('2nd make_frazil', u, v, h, tv%T, tv%S, G) + call disable_averaging(CS%diag) + + endif ! endif for frazil + + ! Diagnose the diapycnal diffusivities and other related quantities. + call enable_averaging(dt, Time_end, CS%diag) + + if (CS%id_Kd_interface > 0) call post_data(CS%id_Kd_interface, Kd_int, CS%diag) + if (CS%id_Kd_heat > 0) call post_data(CS%id_Kd_heat, Kd_heat, CS%diag) + if (CS%id_Kd_salt > 0) call post_data(CS%id_Kd_salt, Kd_salt, CS%diag) + if (CS%id_Kd_ePBL > 0) call post_data(CS%id_Kd_ePBL, Kd_ePBL, CS%diag) + + if (CS%id_ea > 0) call post_data(CS%id_ea, ea, CS%diag) + if (CS%id_eb > 0) call post_data(CS%id_eb, eb, CS%diag) + + if (CS%id_dudt_dia > 0) call post_data(CS%id_dudt_dia, ADp%du_dt_dia, CS%diag) + if (CS%id_dvdt_dia > 0) call post_data(CS%id_dvdt_dia, ADp%dv_dt_dia, CS%diag) + if (CS%id_wd > 0) call post_data(CS%id_wd, CDp%diapyc_vel, CS%diag) + + if (CS%id_MLD_003 > 0 .or. CS%id_subMLN2 > 0 .or. CS%id_mlotstsq > 0) then + call diagnoseMLDbyDensityDifference(CS%id_MLD_003, h, tv, 0.03, G, GV, US, CS%diag, & + id_N2subML=CS%id_subMLN2, id_MLDsq=CS%id_mlotstsq, dz_subML=CS%dz_subML_N2) + endif + if (CS%id_MLD_0125 > 0) then + call diagnoseMLDbyDensityDifference(CS%id_MLD_0125, h, tv, 0.125, G, GV, US, CS%diag) + endif + if (CS%id_MLD_user > 0) then + call diagnoseMLDbyDensityDifference(CS%id_MLD_user, h, tv, CS%MLDdensityDifference, G, GV, US, CS%diag) endif -end subroutine diabatic + if (CS%id_Tdif > 0) call post_data(CS%id_Tdif, Tdif_flx, CS%diag) + if (CS%id_Tadv > 0) call post_data(CS%id_Tadv, Tadv_flx, CS%diag) + if (CS%id_Sdif > 0) call post_data(CS%id_Sdif, Sdif_flx, CS%diag) + if (CS%id_Sadv > 0) call post_data(CS%id_Sadv, Sadv_flx, CS%diag) + if (CS%use_int_tides) then + if (CS%id_cg1 > 0) call post_data(CS%id_cg1, cn(:,:,1),CS%diag) + do m=1,CS%nMode + if (CS%id_cn(m) > 0) call post_data(CS%id_cn(m),cn(:,:,m),CS%diag) + enddo + endif + + call disable_averaging(CS%diag) + + if (CS%debugConservation) call MOM_state_stats('leaving diabatic', u, v, h, tv%T, tv%S, G) + if (showCallTree) call callTree_leave("diabatic()") + +end subroutine diabatic_ALE_legacy + !> This subroutine imposes the diapycnal mass fluxes and the !! accompanying diapycnal advection of momentum and tracers. @@ -1642,39 +2513,17 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en endif ! This block sets ea, eb from Kd or Kd_int. - ! If using ALE algorithm, set ea=eb=Kd_int on interfaces for - ! use in the tri-diagonal solver. ! Otherwise, call entrainment_diffusive() which sets ea and eb ! based on KD and target densities (ie. does remapping as well). - if (CS%useALEalgorithm) then - - do j=js,je ; do i=is,ie - ea(i,j,1) = 0. - enddo ; enddo -!$OMP parallel do default(none) shared(is,ie,js,je,nz,h_neglect,h,ea,GV,dt,Kd_int,eb) & -!$OMP private(hval) - do k=2,nz ; do j=js,je ; do i=is,ie - hval=1.0/(h_neglect + 0.5*(h(i,j,k-1) + h(i,j,k))) - ea(i,j,k) = (GV%Z_to_H**2) * dt_in_T * hval * Kd_int(i,j,K) - eb(i,j,k-1) = ea(i,j,k) - enddo ; enddo ; enddo - do j=js,je ; do i=is,ie - eb(i,j,nz) = 0. - enddo ; enddo - if (showCallTree) call callTree_waypoint("done setting ea,eb from Kd_int (diabatic)") - - else ! .not. CS%useALEalgorithm - ! When not using ALE, calculate layer entrainments/detrainments from - ! diffusivities and differences between layer and target densities - call cpu_clock_begin(id_clock_entrain) - ! Calculate appropriately limited diapycnal mass fluxes to account - ! for diapycnal diffusion and advection. Sets: ea, eb. Changes: kb - call Entrainment_diffusive(h, tv, fluxes, dt_in_T, G, GV, US, CS%entrain_diffusive_CSp, & - ea, eb, kb, Kd_lay=Kd_lay, Kd_int=Kd_int) - call cpu_clock_end(id_clock_entrain) - if (showCallTree) call callTree_waypoint("done with Entrainment_diffusive (diabatic)") - - endif ! endif for (CS%useALEalgorithm) + ! When not using ALE, calculate layer entrainments/detrainments from + ! diffusivities and differences between layer and target densities + call cpu_clock_begin(id_clock_entrain) + ! Calculate appropriately limited diapycnal mass fluxes to account + ! for diapycnal diffusion and advection. Sets: ea, eb. Changes: kb + call Entrainment_diffusive(h, tv, fluxes, dt_in_T, G, GV, US, CS%entrain_diffusive_CSp, & + ea, eb, kb, Kd_lay=Kd_lay, Kd_int=Kd_int) + call cpu_clock_end(id_clock_entrain) + if (showCallTree) call callTree_waypoint("done with Entrainment_diffusive (diabatic)") if (CS%debug) then call MOM_forcing_chksum("after calc_entrain ", fluxes, G, US, haloshift=0) @@ -1693,97 +2542,6 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en enddo ; enddo ; enddo endif - ! Apply forcing when using the ALE algorithm - if (CS%useALEalgorithm) then - call cpu_clock_begin(id_clock_remap) - - ! Changes made to following fields: h, tv%T and tv%S. - - do k=1,nz ; do j=js,je ; do i=is,ie - h_prebound(i,j,k) = h(i,j,k) - enddo ; enddo ; enddo - if (CS%use_energetic_PBL) then - - skinbuoyflux(:,:) = 0.0 - call applyBoundaryFluxesInOut(CS%diabatic_aux_CSp, G, GV, US, dt, fluxes, CS%optics, & - h, tv, CS%aggregate_FW_forcing, CS%evap_CFL_limit, & - CS%minimum_forcing_depth, cTKE, dSV_dT, dSV_dS, SkinBuoyFlux=SkinBuoyFlux) - - if (CS%debug) then - call hchksum(ea, "after applyBoundaryFluxes ea",G%HI,haloshift=0, scale=GV%H_to_m) - call hchksum(eb, "after applyBoundaryFluxes eb",G%HI,haloshift=0, scale=GV%H_to_m) - call hchksum(cTKE, "after applyBoundaryFluxes cTKE",G%HI,haloshift=0) - call hchksum(dSV_dT, "after applyBoundaryFluxes dSV_dT",G%HI,haloshift=0) - call hchksum(dSV_dS, "after applyBoundaryFluxes dSV_dS",G%HI,haloshift=0) - endif - - call find_uv_at_h(u, v, h, u_h, v_h, G, GV) - call energetic_PBL(h, u_h, v_h, tv, fluxes, dt_in_T, Kd_ePBL, G, GV, US, & - CS%energetic_PBL_CSp, dSV_dT, dSV_dS, cTKE, SkinBuoyFlux, waves=waves) - - ! If visc%MLD exists, copy the ePBL's MLD into it - if (associated(visc%MLD)) then - call energetic_PBL_get_MLD(CS%energetic_PBL_CSp, visc%MLD, G, US) - call pass_var(visc%MLD, G%domain, halo=1) - Hml(:,:) = visc%MLD(:,:) - endif - - ! Augment the diffusivities due to those diagnosed in energetic_PBL. - do K=2,nz ; do j=js,je ; do i=is,ie - - if (CS%ePBL_is_additive) then - Kd_add_here = Kd_ePBL(i,j,K) - visc%Kv_shear(i,j,K) = visc%Kv_shear(i,j,K) + Kd_ePBL(i,j,K) - else - Kd_add_here = max(Kd_ePBL(i,j,K) - visc%Kd_shear(i,j,K), 0.0) - visc%Kv_shear(i,j,K) = max(visc%Kv_shear(i,j,K), Kd_ePBL(i,j,K)) - endif - Ent_int = Kd_add_here * (GV%Z_to_H**2 * dt_in_T) / & - (0.5*(h(i,j,k-1) + h(i,j,k)) + h_neglect) - eb(i,j,k-1) = eb(i,j,k-1) + Ent_int - ea(i,j,k) = ea(i,j,k) + Ent_int - Kd_int(i,j,K) = Kd_int(i,j,K) + Kd_add_here - - ! for diagnostics - Kd_heat(i,j,K) = Kd_heat(i,j,K) + Kd_int(i,j,K) - Kd_salt(i,j,K) = Kd_salt(i,j,K) + Kd_int(i,j,K) - - enddo ; enddo ; enddo - - if (CS%debug) then - call hchksum(ea, "after ePBL ea",G%HI,haloshift=0, scale=GV%H_to_m) - call hchksum(eb, "after ePBL eb",G%HI,haloshift=0, scale=GV%H_to_m) - call hchksum(Kd_ePBL, "after ePBL Kd_ePBL", G%HI, haloshift=0, scale=US%Z2_T_to_m2_s) - endif - - else - call applyBoundaryFluxesInOut(CS%diabatic_aux_CSp, G, GV, US, dt, fluxes, CS%optics, & - h, tv, CS%aggregate_FW_forcing, & - CS%evap_CFL_limit, CS%minimum_forcing_depth) - - endif ! endif for CS%use_energetic_PBL - - ! diagnose the tendencies due to boundary forcing - ! At this point, the diagnostic grids have not been updated since the call to the boundary layer scheme - ! so all tendency diagnostics need to be posted on h_diag, and grids rebuilt afterwards - if (CS%boundary_forcing_tendency_diag) then - call diagnose_boundary_forcing_tendency(tv, h, temp_diag, saln_diag, h_diag, dt, G, GV, CS) - if (CS%id_boundary_forcing_h > 0) call post_data(CS%id_boundary_forcing_h, h, CS%diag, alt_h = h_diag) - endif - ! Boundary fluxes may have changed T, S, and h - call diag_update_remap_grids(CS%diag) - - call cpu_clock_end(id_clock_remap) - if (CS%debug) then - call MOM_forcing_chksum("after applyBoundaryFluxes ", fluxes, G, US, haloshift=0) - call MOM_thermovar_chksum("after applyBoundaryFluxes ", tv, G) - call MOM_state_chksum("after applyBoundaryFluxes ", u, v, h, G, GV, haloshift=0) - endif - if (showCallTree) call callTree_waypoint("done with applyBoundaryFluxes (diabatic)") - if (CS%debugConservation) call MOM_state_stats('applyBoundaryFluxes', u, v, h, tv%T, tv%S, G) - - endif ! endif for (CS%useALEalgorithm) - ! Update h according to divergence of the difference between ! ea and eb. We keep a record of the original h in hold. ! In the following, the checks for negative values are to guard @@ -2007,8 +2765,7 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en ! diagnose temperature, salinity, heat, and salt tendencies ! Note: hold here refers to the thicknesses from before the dual-entraintment when using - ! the bulk mixed layer scheme. Otherwise in ALE-mode, layer thicknesses will have changed - ! In either case, tendencies should be posted on hold + ! the bulk mixed layer scheme, so tendencies should be posted on hold. if (CS%diabatic_diff_tendency_diag) then call diagnose_diabatic_diff_tendency(tv, hold, temp_diag, saln_diag, dt, G, GV, CS) if (CS%id_diabatic_diff_h > 0) call post_data(CS%id_diabatic_diff_h, hold, CS%diag, alt_h = hold) @@ -2029,13 +2786,11 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en call hchksum(eb, "after mixed layer eb", G%HI, scale=GV%H_to_m) endif - if (.not. CS%useALEalgorithm) then - call cpu_clock_begin(id_clock_remap) - call regularize_layers(h, tv, dt, ea, eb, G, GV, CS%regularize_layers_CSp) - call cpu_clock_end(id_clock_remap) - if (showCallTree) call callTree_waypoint("done with regularize_layers (diabatic)") - if (CS%debugConservation) call MOM_state_stats('regularize_layers', u, v, h, tv%T, tv%S, G) - endif + call cpu_clock_begin(id_clock_remap) + call regularize_layers(h, tv, dt, ea, eb, G, GV, CS%regularize_layers_CSp) + call cpu_clock_end(id_clock_remap) + if (showCallTree) call callTree_waypoint("done with regularize_layers (diabatic)") + if (CS%debugConservation) call MOM_state_stats('regularize_layers', u, v, h, tv%T, tv%S, G) ! Whenever thickness changes let the diag manager know, as the ! target grids for vertical remapping may need to be regenerated. @@ -2122,17 +2877,8 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en enddo - if (CS%useALEalgorithm) then - ! For passive tracers, the changes in thickness due to boundary fluxes has yet to be applied - ! so hold should be h_orig - call call_tracer_column_fns(h_prebound, h, ea, eb, fluxes, Hml, dt, G, GV, tv, & - CS%optics, CS%tracer_flow_CSp, CS%debug, & - evap_CFL_limit = CS%evap_CFL_limit, & - minimum_forcing_depth = CS%minimum_forcing_depth) - else - call call_tracer_column_fns(hold, h, eatr, ebtr, fluxes, Hml, dt, G, GV, tv, & - CS%optics, CS%tracer_flow_CSp, CS%debug) - endif + call call_tracer_column_fns(hold, h, eatr, ebtr, fluxes, Hml, dt, G, GV, tv, & + CS%optics, CS%tracer_flow_CSp, CS%debug) elseif (associated(visc%Kd_extra_S)) then ! extra diffusivity for passive tracers @@ -2152,28 +2898,12 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en eatr(i,j,k) = ea(i,j,k) + add_ent enddo ; enddo ; enddo - if (CS%useALEalgorithm) then - ! For passive tracers, the changes in thickness due to boundary fluxes has yet to be applied - call call_tracer_column_fns(h_prebound, h, eatr, ebtr, fluxes, Hml, dt, G, GV, tv, & - CS%optics, CS%tracer_flow_CSp, CS%debug,& - evap_CFL_limit = CS%evap_CFL_limit, & - minimum_forcing_depth = CS%minimum_forcing_depth) - else - call call_tracer_column_fns(hold, h, eatr, ebtr, fluxes, Hml, dt, G, GV, tv, & - CS%optics, CS%tracer_flow_CSp, CS%debug) - endif + call call_tracer_column_fns(hold, h, eatr, ebtr, fluxes, Hml, dt, G, GV, tv, & + CS%optics, CS%tracer_flow_CSp, CS%debug) else - if (CS%useALEalgorithm) then - ! For passive tracers, the changes in thickness due to boundary fluxes has yet to be applied - call call_tracer_column_fns(h_prebound, h, eatr, ebtr, fluxes, Hml, dt, G, GV, tv, & - CS%optics, CS%tracer_flow_CSp, CS%debug, & - evap_CFL_limit = CS%evap_CFL_limit, & - minimum_forcing_depth = CS%minimum_forcing_depth) - else - call call_tracer_column_fns(hold, h, ea, eb, fluxes, Hml, dt, G, GV, tv, & - CS%optics, CS%tracer_flow_CSp, CS%debug) - endif + call call_tracer_column_fns(hold, h, ea, eb, fluxes, Hml, dt, G, GV, tv, & + CS%optics, CS%tracer_flow_CSp, CS%debug) endif ! (CS%mix_boundary_tracers) @@ -2182,22 +2912,17 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en ! sponges if (CS%use_sponge) then call cpu_clock_begin(id_clock_sponge) - if (associated(CS%ALE_sponge_CSp)) then - ! ALE sponge - call apply_ALE_sponge(h, dt, G, GV, US, CS%ALE_sponge_CSp, CS%Time) + ! Layer mode sponge + if (CS%bulkmixedlayer .and. associated(tv%eqn_of_state)) then + do i=is,ie ; p_ref_cv(i) = tv%P_Ref ; enddo + !$OMP parallel do default(shared) + do j=js,je + call calculate_density(tv%T(:,j,1), tv%S(:,j,1), p_ref_cv, Rcv_ml(:,j), & + is, ie-is+1, tv%eqn_of_state) + enddo + call apply_sponge(h, dt, G, GV, ea, eb, CS%sponge_CSp, Rcv_ml) else - ! Layer mode sponge - if (CS%bulkmixedlayer .and. associated(tv%eqn_of_state)) then - do i=is,ie ; p_ref_cv(i) = tv%P_Ref ; enddo - !$OMP parallel do default(shared) - do j=js,je - call calculate_density(tv%T(:,j,1), tv%S(:,j,1), p_ref_cv, Rcv_ml(:,j), & - is, ie-is+1, tv%eqn_of_state) - enddo - call apply_sponge(h, dt, G, GV, ea, eb, CS%sponge_CSp, Rcv_ml) - else - call apply_sponge(h, dt, G, GV, ea, eb, CS%sponge_CSp) - endif + call apply_sponge(h, dt, G, GV, ea, eb, CS%sponge_CSp) endif call cpu_clock_end(id_clock_sponge) if (CS%debug) then @@ -2267,83 +2992,81 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en call pass_var(visc%Kv_shear, G%Domain, To_All+Omit_Corners, halo=1) call cpu_clock_end(id_clock_pass) - if (.not. CS%useALEalgorithm) then - ! Use a tridiagonal solver to determine effect of the diapycnal - ! advection on velocity field. It is assumed that water leaves - ! or enters the ocean with the surface velocity. - if (CS%debug) then - call MOM_state_chksum("before u/v tridiag ", u, v, h, G, GV, haloshift=0) - call hchksum(ea, "before u/v tridiag ea",G%HI, scale=GV%H_to_m) - call hchksum(eb, "before u/v tridiag eb",G%HI, scale=GV%H_to_m) - call hchksum(hold, "before u/v tridiag hold",G%HI, scale=GV%H_to_m) - endif - call cpu_clock_begin(id_clock_tridiag) - !$OMP parallel do default(shared) private(hval,b1,d1,c1,eaval) - do j=js,je + ! Use a tridiagonal solver to determine effect of the diapycnal + ! advection on velocity field. It is assumed that water leaves + ! or enters the ocean with the surface velocity. + if (CS%debug) then + call MOM_state_chksum("before u/v tridiag ", u, v, h, G, GV, haloshift=0) + call hchksum(ea, "before u/v tridiag ea",G%HI, scale=GV%H_to_m) + call hchksum(eb, "before u/v tridiag eb",G%HI, scale=GV%H_to_m) + call hchksum(hold, "before u/v tridiag hold",G%HI, scale=GV%H_to_m) + endif + call cpu_clock_begin(id_clock_tridiag) + !$OMP parallel do default(shared) private(hval,b1,d1,c1,eaval) + do j=js,je + do I=Isq,Ieq + if (associated(ADp%du_dt_dia)) ADp%du_dt_dia(I,j,1) = u(I,j,1) + hval = (hold(i,j,1) + hold(i+1,j,1)) + (ea(i,j,1) + ea(i+1,j,1)) + h_neglect + b1(I) = 1.0 / (hval + (eb(i,j,1) + eb(i+1,j,1))) + d1(I) = hval * b1(I) + u(I,j,1) = b1(I) * (hval * u(I,j,1)) + enddo + do k=2,nz ; do I=Isq,Ieq + if (associated(ADp%du_dt_dia)) ADp%du_dt_dia(I,j,k) = u(I,j,k) + c1(I,k) = (eb(i,j,k-1)+eb(i+1,j,k-1)) * b1(I) + eaval = ea(i,j,k) + ea(i+1,j,k) + hval = hold(i,j,k) + hold(i+1,j,k) + h_neglect + b1(I) = 1.0 / ((eb(i,j,k) + eb(i+1,j,k)) + (hval + d1(I)*eaval)) + d1(I) = (hval + d1(I)*eaval) * b1(I) + u(I,j,k) = (hval*u(I,j,k) + eaval*u(I,j,k-1))*b1(I) + enddo ; enddo + do k=nz-1,1,-1 ; do I=Isq,Ieq + u(I,j,k) = u(I,j,k) + c1(I,k+1)*u(I,j,k+1) + if (associated(ADp%du_dt_dia)) & + ADp%du_dt_dia(I,j,k) = (u(I,j,k) - ADp%du_dt_dia(I,j,k)) * Idt + enddo ; enddo + if (associated(ADp%du_dt_dia)) then do I=Isq,Ieq - if (associated(ADp%du_dt_dia)) ADp%du_dt_dia(I,j,1) = u(I,j,1) - hval = (hold(i,j,1) + hold(i+1,j,1)) + (ea(i,j,1) + ea(i+1,j,1)) + h_neglect - b1(I) = 1.0 / (hval + (eb(i,j,1) + eb(i+1,j,1))) - d1(I) = hval * b1(I) - u(I,j,1) = b1(I) * (hval * u(I,j,1)) + ADp%du_dt_dia(I,j,nz) = (u(I,j,nz)-ADp%du_dt_dia(I,j,nz)) * Idt enddo - do k=2,nz ; do I=Isq,Ieq - if (associated(ADp%du_dt_dia)) ADp%du_dt_dia(I,j,k) = u(I,j,k) - c1(I,k) = (eb(i,j,k-1)+eb(i+1,j,k-1)) * b1(I) - eaval = ea(i,j,k) + ea(i+1,j,k) - hval = hold(i,j,k) + hold(i+1,j,k) + h_neglect - b1(I) = 1.0 / ((eb(i,j,k) + eb(i+1,j,k)) + (hval + d1(I)*eaval)) - d1(I) = (hval + d1(I)*eaval) * b1(I) - u(I,j,k) = (hval*u(I,j,k) + eaval*u(I,j,k-1))*b1(I) - enddo ; enddo - do k=nz-1,1,-1 ; do I=Isq,Ieq - u(I,j,k) = u(I,j,k) + c1(I,k+1)*u(I,j,k+1) - if (associated(ADp%du_dt_dia)) & - ADp%du_dt_dia(I,j,k) = (u(I,j,k) - ADp%du_dt_dia(I,j,k)) * Idt - enddo ; enddo - if (associated(ADp%du_dt_dia)) then - do I=Isq,Ieq - ADp%du_dt_dia(I,j,nz) = (u(I,j,nz)-ADp%du_dt_dia(I,j,nz)) * Idt - enddo - endif - enddo - if (CS%debug) then - call MOM_state_chksum("aft 1st loop tridiag ", u, v, h, G, GV, haloshift=0) endif - !$OMP parallel do default(shared) private(hval,b1,d1,c1,eaval) - do J=Jsq,Jeq + enddo + if (CS%debug) then + call MOM_state_chksum("aft 1st loop tridiag ", u, v, h, G, GV, haloshift=0) + endif + !$OMP parallel do default(shared) private(hval,b1,d1,c1,eaval) + do J=Jsq,Jeq + do i=is,ie + if (associated(ADp%dv_dt_dia)) ADp%dv_dt_dia(i,J,1) = v(i,J,1) + hval = (hold(i,j,1) + hold(i,j+1,1)) + (ea(i,j,1) + ea(i,j+1,1)) + h_neglect + b1(i) = 1.0 / (hval + (eb(i,j,1) + eb(i,j+1,1))) + d1(I) = hval * b1(I) + v(i,J,1) = b1(i) * (hval * v(i,J,1)) + enddo + do k=2,nz ; do i=is,ie + if (associated(ADp%dv_dt_dia)) ADp%dv_dt_dia(i,J,k) = v(i,J,k) + c1(i,k) = (eb(i,j,k-1)+eb(i,j+1,k-1)) * b1(i) + eaval = ea(i,j,k) + ea(i,j+1,k) + hval = hold(i,j,k) + hold(i,j+1,k) + h_neglect + b1(i) = 1.0 / ((eb(i,j,k) + eb(i,j+1,k)) + (hval + d1(i)*eaval)) + d1(i) = (hval + d1(i)*eaval) * b1(i) + v(i,J,k) = (hval*v(i,J,k) + eaval*v(i,J,k-1))*b1(i) + enddo ; enddo + do k=nz-1,1,-1 ; do i=is,ie + v(i,J,k) = v(i,J,k) + c1(i,k+1)*v(i,J,k+1) + if (associated(ADp%dv_dt_dia)) & + ADp%dv_dt_dia(i,J,k) = (v(i,J,k) - ADp%dv_dt_dia(i,J,k)) * Idt + enddo ; enddo + if (associated(ADp%dv_dt_dia)) then do i=is,ie - if (associated(ADp%dv_dt_dia)) ADp%dv_dt_dia(i,J,1) = v(i,J,1) - hval = (hold(i,j,1) + hold(i,j+1,1)) + (ea(i,j,1) + ea(i,j+1,1)) + h_neglect - b1(i) = 1.0 / (hval + (eb(i,j,1) + eb(i,j+1,1))) - d1(I) = hval * b1(I) - v(i,J,1) = b1(i) * (hval * v(i,J,1)) + ADp%dv_dt_dia(i,J,nz) = (v(i,J,nz)-ADp%dv_dt_dia(i,J,nz)) * Idt enddo - do k=2,nz ; do i=is,ie - if (associated(ADp%dv_dt_dia)) ADp%dv_dt_dia(i,J,k) = v(i,J,k) - c1(i,k) = (eb(i,j,k-1)+eb(i,j+1,k-1)) * b1(i) - eaval = ea(i,j,k) + ea(i,j+1,k) - hval = hold(i,j,k) + hold(i,j+1,k) + h_neglect - b1(i) = 1.0 / ((eb(i,j,k) + eb(i,j+1,k)) + (hval + d1(i)*eaval)) - d1(i) = (hval + d1(i)*eaval) * b1(i) - v(i,J,k) = (hval*v(i,J,k) + eaval*v(i,J,k-1))*b1(i) - enddo ; enddo - do k=nz-1,1,-1 ; do i=is,ie - v(i,J,k) = v(i,J,k) + c1(i,k+1)*v(i,J,k+1) - if (associated(ADp%dv_dt_dia)) & - ADp%dv_dt_dia(i,J,k) = (v(i,J,k) - ADp%dv_dt_dia(i,J,k)) * Idt - enddo ; enddo - if (associated(ADp%dv_dt_dia)) then - do i=is,ie - ADp%dv_dt_dia(i,J,nz) = (v(i,J,nz)-ADp%dv_dt_dia(i,J,nz)) * Idt - enddo - endif - enddo - call cpu_clock_end(id_clock_tridiag) - if (CS%debug) then - call MOM_state_chksum("after u/v tridiag ", u, v, h, G, GV, haloshift=0) endif - endif ! useALEalgorithm + enddo + call cpu_clock_end(id_clock_tridiag) + if (CS%debug) then + call MOM_state_chksum("after u/v tridiag ", u, v, h, G, GV, haloshift=0) + endif call disable_averaging(CS%diag) ! Frazil formation keeps temperature above the freezing point. From 464b667e852171c35f73acf047a9a8e14482a771 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Fri, 28 Jun 2019 11:07:43 -0400 Subject: [PATCH 49/82] Split long comments in RGC_tracer.F90 RGC_tracer.F90 previously had some very long comments at the end of some lines. These have now been split onto multiple lines to respect the MOM6 standards for line-length. All answers are bitwise identical. --- src/tracer/RGC_tracer.F90 | 67 ++++++++++++++++++++------------------- 1 file changed, 35 insertions(+), 32 deletions(-) diff --git a/src/tracer/RGC_tracer.F90 b/src/tracer/RGC_tracer.F90 index b056ae3a76..decb834a6a 100644 --- a/src/tracer/RGC_tracer.F90 +++ b/src/tracer/RGC_tracer.F90 @@ -64,12 +64,14 @@ module RGC_tracer !> This subroutine is used to register tracer fields function register_RGC_tracer(HI, GV, param_file, CS, tr_Reg, restart_CS) - type(hor_index_type), intent(in) :: HI ! Initializes the NTR tracer fields in tr(:,:,:,:) -! and it sets up the tracer output. +!! and it sets up the tracer output. subroutine initialize_RGC_tracer(restart, day, G, GV, h, diag, OBC, CS, & layer_CSp, sponge_CSp) - type(ocean_grid_type), intent(in) :: G !< Grid structure. - type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. - logical, intent(in) :: restart !< .true. if the fields have already been read from a restart file. - type(time_type), target, intent(in) :: day !< Time of the start of the run. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness, in m or kg m-2. - type(diag_ctrl), target, intent(in) :: diag !< Structure used to regulate diagnostic output. - type(ocean_OBC_type), pointer :: OBC !< This open boundary condition type specifies whether, where, and what open boundary conditions are used. This is not being used for now. - type(RGC_tracer_CS), pointer :: CS !< The control structure returned by a previous call to RGC_register_tracer. - type(sponge_CS), pointer :: layer_CSp !< A pointer to the control structure - type(ALE_sponge_CS), pointer :: sponge_CSp !< A pointer to the control structure for the sponges, if they are in use. Otherwise this may be unassociated. + type(ocean_grid_type), intent(in) :: G !< Grid structure. + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. + logical, intent(in) :: restart !< .true. if the fields have already + !! been read from a restart file. + type(time_type), target, intent(in) :: day !< Time of the start of the run. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + intent(in) :: h !< Layer thickness, in m or kg m-2. + type(diag_ctrl), target, intent(in) :: diag !< Structure used to regulate diagnostic output. + type(ocean_OBC_type), pointer :: OBC !< This open boundary condition type specifies + !! whether, where, and what open boundary + !! conditions are used. This is not being used for now. + type(RGC_tracer_CS), pointer :: CS !< The control structure returned by a previous + !! call to RGC_register_tracer. + type(sponge_CS), pointer :: layer_CSp !< A pointer to the control structure + type(ALE_sponge_CS), pointer :: sponge_CSp !< A pointer to the control structure for the + !! sponges, if they are in use. Otherwise this may be unassociated. real, allocatable :: temp(:,:,:) real, pointer, dimension(:,:,:) :: & @@ -265,8 +273,8 @@ subroutine initialize_RGC_tracer(restart, day, G, GV, h, diag, OBC, CS, & end subroutine initialize_RGC_tracer !> This subroutine applies diapycnal diffusion and any other column -! tracer physics or chemistry to the tracers from this file. -! This is a simple example of a set of advected passive tracers. +!! tracer physics or chemistry to the tracers from this file. +!! This is a simple example of a set of advected passive tracers. subroutine RGC_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, CS, & evap_CFL_limit, minimum_forcing_depth) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. @@ -283,20 +291,15 @@ subroutine RGC_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, intent(in) :: eb !< an array to which the amount of fluid entrained !! from the layer below during this call will be !! added [H ~> m or kg m-2]. - type(forcing), intent(in) :: fluxes !< A structure containing pointers to any possible forcing fields. Unused fields have NULL ptrs. - real, intent(in) :: dt !< The amount of time covered by this call [s]. - type(RGC_tracer_CS), pointer :: CS !< The control structure returned by a previous call. - real, optional,intent(in) :: evap_CFL_limit !< Limit on the fraction of the water that can be fluxed out of the top layer in a timestep [nondim]. - real, optional,intent(in) :: minimum_forcing_depth !< The smallest depth over which fluxes can be applied [m]. - -! Arguments: h_old - Layer thickness before entrainment, in m or kg m-2. -! (in) h_new - Layer thickness after entrainment, in m or kg m-2. -! (in) ea - an array to which the amount of fluid entrained -! from the layer above during this call will be -! added, in m or kg m-2. -! (in) eb - an array to which the amount of fluid entrained -! from the layer below during this call will be -! added, in m or kg m-2. + type(forcing), intent(in) :: fluxes !< A structure containing pointers to any possible + !! forcing fields. Unused fields have NULL ptrs. + real, intent(in) :: dt !< The amount of time covered by this call [s]. + type(RGC_tracer_CS), pointer :: CS !< The control structure returned by a previous call. + real, optional, intent(in) :: evap_CFL_limit !< Limit on the fraction of the water that can be + !! fluxed out of the top layer in a timestep [nondim]. + real, optional, intent(in) :: minimum_forcing_depth !< The smallest depth over which fluxes + !! can be applied [m]. + ! The arguments to this subroutine are redundant in that ! h_new[k] = h_old[k] + ea[k] - eb[k-1] + eb[k] - ea[k+1] From 84f02b722527876683dd52cc3e5c12092c45ba4f Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Fri, 28 Jun 2019 15:32:38 -0400 Subject: [PATCH 50/82] Code rearrangement in MOM_diabatic_driver.F90 Moved common preamble and post-mixing code into the top diabatic routine, and renamed variables and modified spaces and comments so that diabatic_ALE_legacy more closely resembles the code in diabatic_ALE, in a prelude to merging these two routines. All answers are bitwise identical. --- .../vertical/MOM_diabatic_driver.F90 | 918 ++++++------------ 1 file changed, 304 insertions(+), 614 deletions(-) diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index acb5cf26af..1daddc32ec 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -290,6 +290,130 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & type(diabatic_CS), pointer :: CS !< module control structure type(Wave_parameters_CS), optional, pointer :: Waves !< Surface gravity waves + ! local variables + real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1) :: & + eta ! Interface heights before diapycnal mixing [m]. + real, dimension(SZI_(G),SZJ_(G),CS%nMode) :: & + cn ! baroclinic gravity wave speeds + real, dimension(SZI_(G),SZJ_(G),G%ke) :: temp_diag ! diagnostic array for temp + real, dimension(SZI_(G),SZJ_(G)) :: TKE_itidal_input_test ! override of energy input for testing (BDM) + real :: dt_in_T ! The time step converted to T units [T ~> s] + integer :: i, j, k, m, is, ie, js, je, nz + logical :: avg_enabled ! for testing internal tides (BDM) + logical :: showCallTree ! If true, show the call tree + + if (G%ke == 1) return + + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke + + if (.not. associated(CS)) call MOM_error(FATAL, "MOM_diabatic_driver: "// & + "Module must be initialized before it is used.") + if (dt == 0.0) call MOM_error(FATAL, "MOM_diabatic_driver: "// & + "diabatic was called with a zero length timestep.") + if (dt < 0.0) call MOM_error(FATAL, "MOM_diabatic_driver: "// & + "diabatic was called with a negative timestep.") + + showCallTree = callTree_showQuery() + + ! Offer diagnostics of various state varables at the start of diabatic + ! these are mostly for debugging purposes. + if (CS%id_u_predia > 0) call post_data(CS%id_u_predia, u, CS%diag) + if (CS%id_v_predia > 0) call post_data(CS%id_v_predia, v, CS%diag) + if (CS%id_h_predia > 0) call post_data(CS%id_h_predia, h, CS%diag) + if (CS%id_T_predia > 0) call post_data(CS%id_T_predia, tv%T, CS%diag) + if (CS%id_S_predia > 0) call post_data(CS%id_S_predia, tv%S, CS%diag) + if (CS%id_e_predia > 0) then + call find_eta(h, tv, G, GV, US, eta, eta_to_m=1.0) + call post_data(CS%id_e_predia, eta, CS%diag) + endif + + dt_in_T = dt * US%s_to_T + if (CS%debug) then + call MOM_state_chksum("Start of diabatic ", u, v, h, G, GV, haloshift=0) + call MOM_forcing_chksum("Start of diabatic", fluxes, G, US, haloshift=0) + endif + if (CS%debugConservation) call MOM_state_stats('Start of diabatic', u, v, h, tv%T, tv%S, G) + + if (CS%debug_energy_req) & + call diapyc_energy_req_test(h, dt_in_T, tv, G, GV, US, CS%diapyc_en_rec_CSp) + + call cpu_clock_begin(id_clock_set_diffusivity) + call set_BBL_TKE(u, v, h, fluxes, visc, G, GV, US, CS%set_diff_CSp) + call cpu_clock_end(id_clock_set_diffusivity) + + ! Frazil formation keeps the temperature above the freezing point. + ! make_frazil is deliberately called at both the beginning and at + ! the end of the diabatic processes. + if (associated(tv%T) .AND. associated(tv%frazil)) then + ! For frazil diagnostic, the first call covers the first half of the time step + call enable_averaging(0.5*dt, Time_end - real_to_time(0.5*dt), CS%diag) + if (CS%frazil_tendency_diag) then + do k=1,nz ; do j=js,je ; do i=is,ie + temp_diag(i,j,k) = tv%T(i,j,k) + enddo ; enddo ; enddo + endif + + if (associated(fluxes%p_surf_full)) then + call make_frazil(h, tv, G, GV, CS%diabatic_aux_CSp, fluxes%p_surf_full, halo=CS%halo_TS_diff) + else + call make_frazil(h, tv, G, GV, CS%diabatic_aux_CSp, halo=CS%halo_TS_diff) + endif + if (showCallTree) call callTree_waypoint("done with 1st make_frazil (diabatic)") + + if (CS%frazil_tendency_diag) then + call diagnose_frazil_tendency(tv, h, temp_diag, 0.5*dt, G, GV, CS) + if (CS%id_frazil_h > 0) call post_data(CS%id_frazil_h, h, CS%diag) + endif + call disable_averaging(CS%diag) + endif ! associated(tv%T) .AND. associated(tv%frazil) + if (CS%debugConservation) call MOM_state_stats('1st make_frazil', u, v, h, tv%T, tv%S, G) + + + if (CS%use_int_tides) then + ! This block provides an interface for the unresolved low-mode internal tide module (BDM). + + ! PROVIDE ENERGY DISTRIBUTION (calculate time-varying energy source) + call set_int_tide_input(u, v, h, tv, fluxes, CS%int_tide_input, dt, G, GV, US, & + CS%int_tide_input_CSp) + ! CALCULATE MODAL VELOCITIES + cn(:,:,:) = 0.0 + if (CS%uniform_cg) then + ! SET TO CONSTANT VALUE TO TEST PROPAGATE CODE + do m=1,CS%nMode ; cn(:,:,m) = CS%cg_test ; enddo + else + call wave_speeds(h, tv, G, GV, US, CS%nMode, cn, full_halos=.true.) + ! uncomment the lines below for a hard-coded cn that changes linearly with latitude + !do j=G%jsd,G%jed ; do i=G%isd,G%ied + ! cn(i,j,:) = ((7.-1.)/14000000.)*G%geoLatBu(i,j) + (1.-((7.-1.)/14000000.)*-7000000.) + !enddo ; enddo + endif + + if (CS%int_tide_source_test) then + ! BUILD 2D ARRAY WITH POINT SOURCE FOR TESTING + ! This block of code should be moved into set_int_tide_input. -RWH + TKE_itidal_input_test(:,:) = 0.0 + avg_enabled = query_averaging_enabled(CS%diag,time_end=CS%time_end) + if (CS%time_end <= CS%time_max_source) then + do j=G%jsc,G%jec ; do i=G%isc,G%iec + !INPUT ARBITRARY ENERGY POINT SOURCE + if ((G%idg_offset + i == CS%int_tide_source_x) .and. & + (G%jdg_offset + j == CS%int_tide_source_y)) then + TKE_itidal_input_test(i,j) = 1.0 + endif + enddo ; enddo + endif + ! CALL ROUTINE USING PRESCRIBED KE FOR TESTING + call propagate_int_tide(h, tv, cn, TKE_itidal_input_test, CS%int_tide_input%tideamp, & + CS%int_tide_input%Nb, dt, G, GV, US, CS%int_tide_CSp) + else + ! CALL ROUTINE USING CALCULATED KE INPUT + call propagate_int_tide(h, tv, cn, CS%int_tide_input%TKE_itidal_input, CS%int_tide_input%tideamp, & + CS%int_tide_input%Nb, dt, G, GV, US, CS%int_tide_CSp) + endif + if (showCallTree) call callTree_waypoint("done with propagate_int_tide (diabatic)") + endif ! end CS%use_int_tides + + if (CS%useALEalgorithm .and. CS%use_legacy_diabatic) then call diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & G, GV, US, CS, Waves) @@ -301,6 +425,63 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & G, GV, US, CS, Waves) endif + + + call cpu_clock_begin(id_clock_pass) + if (associated(visc%Kv_shear)) & + call pass_var(visc%Kv_shear, G%Domain, To_All+Omit_Corners, halo=1) + call cpu_clock_end(id_clock_pass) + + call disable_averaging(CS%diag) + ! Frazil formation keeps temperature above the freezing point. + ! make_frazil is deliberately called at both the beginning and at + ! the end of the diabatic processes. + if (associated(tv%T) .AND. associated(tv%frazil)) then + call enable_averaging(0.5*dt, Time_end, CS%diag) + if (CS%frazil_tendency_diag) then + do k=1,nz ; do j=js,je ; do i=is,ie + temp_diag(i,j,k) = tv%T(i,j,k) + enddo ; enddo ; enddo + endif + + if (associated(fluxes%p_surf_full)) then + call make_frazil(h, tv, G, GV, CS%diabatic_aux_CSp, fluxes%p_surf_full) + else + call make_frazil(h, tv, G, GV, CS%diabatic_aux_CSp) + endif + + if (CS%frazil_tendency_diag) then + call diagnose_frazil_tendency(tv, h, temp_diag, 0.5*dt, G, GV, CS) + if (CS%id_frazil_h > 0 ) call post_data(CS%id_frazil_h, h, CS%diag) + endif + + if (showCallTree) call callTree_waypoint("done with 2nd make_frazil (diabatic)") + if (CS%debugConservation) call MOM_state_stats('2nd make_frazil', u, v, h, tv%T, tv%S, G) + call disable_averaging(CS%diag) + + endif ! endif for frazil + + + ! Diagnose mixed layer depths. + call enable_averaging(dt, Time_end, CS%diag) + if (CS%id_MLD_003 > 0 .or. CS%id_subMLN2 > 0 .or. CS%id_mlotstsq > 0) then + call diagnoseMLDbyDensityDifference(CS%id_MLD_003, h, tv, 0.03, G, GV, US, CS%diag, & + id_N2subML=CS%id_subMLN2, id_MLDsq=CS%id_mlotstsq, dz_subML=CS%dz_subML_N2) + endif + if (CS%id_MLD_0125 > 0) then + call diagnoseMLDbyDensityDifference(CS%id_MLD_0125, h, tv, 0.125, G, GV, US, CS%diag) + endif + if (CS%id_MLD_user > 0) then + call diagnoseMLDbyDensityDifference(CS%id_MLD_user, h, tv, CS%MLDdensityDifference, G, GV, US, CS%diag) + endif + if (CS%use_int_tides) then + if (CS%id_cg1 > 0) call post_data(CS%id_cg1, cn(:,:,1),CS%diag) + do m=1,CS%nMode ; if (CS%id_cn(m) > 0) call post_data(CS%id_cn(m),cn(:,:,m),CS%diag) ; enddo + endif + call disable_averaging(CS%diag) + + if (CS%debugConservation) call MOM_state_stats('leaving diabatic', u, v, h, tv%T, tv%S, G) + end subroutine diabatic @@ -332,9 +513,13 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim ! local variables real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: & - ea, & ! amount of fluid entrained from the layer above within + ea_s, & ! amount of fluid entrained from the layer above within ! one time step [H ~> m or kg m-2] - eb, & ! amount of fluid entrained from the layer below within + eb_s, & ! amount of fluid entrained from the layer below within + ! one time step [H ~> m or kg m-2] + ea_t, & ! amount of fluid entrained from the layer above within + ! one time step [H ~> m or kg m-2] + eb_t, & ! amount of fluid entrained from the layer below within ! one time step [H ~> m or kg m-2] Kd_lay, & ! diapycnal diffusivity of layers [Z2 T-1 ~> m2 s-1] h_orig, & ! initial layer thicknesses [H ~> m or kg m-2] @@ -347,8 +532,6 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim cTKE, & ! convective TKE requirements for each layer [kg m-3 Z3 T-2 ~> J m-2]. u_h, & ! zonal and meridional velocities at thickness points after v_h ! entrainment [m s-1] - real, dimension(SZI_(G),SZJ_(G),CS%nMode) :: & - cn ! baroclinic gravity wave speeds real, dimension(SZI_(G),SZJ_(G)) :: & Rcv_ml, & ! coordinate density of mixed layer, used for applying sponges SkinBuoyFlux! 2d surface buoyancy flux [Z2 T-3 ~> m2 s-3], used by ePBL @@ -356,12 +539,10 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim real, dimension(SZI_(G),SZJ_(G),G%ke) :: temp_diag ! diagnostic array for temp real, dimension(SZI_(G),SZJ_(G),G%ke) :: saln_diag ! diagnostic array for salinity real, dimension(SZI_(G),SZJ_(G)) :: tendency_2d ! depth integrated content tendency for diagn - real, dimension(SZI_(G),SZJ_(G)) :: TKE_itidal_input_test ! override of energy input for testing (BDM) real :: net_ent ! The net of ea-eb at an interface. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), target :: & - ! These are targets so that the space can be shared with eaml & ebml. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: & eatr, & ! The equivalent of ea and eb for tracers, which differ from ea and ebtr ! eb in that they tend to homogenize tracers in massless layers ! near the boundaries [H ~> m or kg m-2] (for Bous or non-Bouss) @@ -371,19 +552,11 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim Kd_heat, & ! diapycnal diffusivity of heat [Z2 T-1 ~> m2 s-1] Kd_salt, & ! diapycnal diffusivity of salt and passive tracers [Z2 T-1 ~> m2 s-1] Kd_ePBL, & ! test array of diapycnal diffusivities at interfaces [Z2 T-1 ~> m2 s-1] - eta, & ! Interface heights before diapycnal mixing [m]. Tdif_flx, & ! diffusive diapycnal heat flux across interfaces [degC m s-1] Tadv_flx, & ! advective diapycnal heat flux across interfaces [degC m s-1] Sdif_flx, & ! diffusive diapycnal salt flux across interfaces [ppt m s-1] Sadv_flx ! advective diapycnal salt flux across interfaces [ppt m s-1] - ! The following 5 variables are only used with a bulk mixed layer. - real, pointer, dimension(:,:,:) :: & - eaml, & ! The equivalent of ea due to mixed layer processes [H ~> m or kg m-2]. - ebml ! The equivalent of eb due to mixed layer processes [H ~> m or kg m-2]. - ! eaml and ebml are pointers to eatr and ebtr so as to reuse the memory as - ! the arrays are not needed at the same time. - logical :: in_boundary(SZI_(G)) ! True if there are no massive layers below, ! where massive is defined as sufficiently thick that ! the no-flux boundary conditions have not restricted @@ -418,7 +591,6 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim integer :: i, j, k, is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz, nkmb, m, halo integer :: ig, jg ! global indices for testing testing itide point source (BDM) - logical :: avg_enabled ! for testing internal tides (BDM) real :: Kd_add_here ! An added diffusivity [Z2 T-1 ~> m2 s-1]. is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke @@ -427,91 +599,26 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim h_neglect = GV%H_subroundoff ; h_neglect2 = h_neglect*h_neglect Kd_heat(:,:,:) = 0.0 ; Kd_salt(:,:,:) = 0.0 - - if (nz == 1) return showCallTree = callTree_showQuery() - if (showCallTree) call callTree_enter("diabatic(), MOM_diabatic_driver.F90") - - ! Offer diagnostics of various state varables at the start of diabatic - ! these are mostly for debugging purposes. - if (CS%id_u_predia > 0) call post_data(CS%id_u_predia, u, CS%diag) - if (CS%id_v_predia > 0) call post_data(CS%id_v_predia, v, CS%diag) - if (CS%id_h_predia > 0) call post_data(CS%id_h_predia, h, CS%diag) - if (CS%id_T_predia > 0) call post_data(CS%id_T_predia, tv%T, CS%diag) - if (CS%id_S_predia > 0) call post_data(CS%id_S_predia, tv%S, CS%diag) - if (CS%id_e_predia > 0) then - call find_eta(h, tv, G, GV, US, eta, eta_to_m=1.0) - call post_data(CS%id_e_predia, eta, CS%diag) - endif + if (showCallTree) call callTree_enter("diabatic_ALE(), MOM_diabatic_driver.F90") + if (showCallTree) call callTree_enter("diabatic_ALE_legacy(), MOM_diabatic_driver.F90") - ! set equivalence between the same bits of memory for these arrays - eaml => eatr ; ebml => ebtr - - ! inverse time step - if (dt == 0.0) call MOM_error(FATAL, "MOM_diabatic_driver: "// & - "legacy_diabatic was called with a zero length timestep.") - if (dt < 0.0) call MOM_error(FATAL, "MOM_diabatic_driver: "// & - "legacy_diabatic was called with a negative timestep.") - Idt = 1.0 / dt dt_in_T = dt * US%s_to_T - if (.not. associated(CS)) call MOM_error(FATAL, "MOM_diabatic_driver: "// & - "Module must be initialized before it is used.") - - if (CS%debug) then - call MOM_state_chksum("Start of diabatic ", u, v, h, G, GV, haloshift=0) - call MOM_forcing_chksum("Start of diabatic", fluxes, G, US, haloshift=0) - endif - if (CS%debugConservation) call MOM_state_stats('Start of diabatic', u, v, h, tv%T, tv%S, G) - - if (CS%debug_energy_req) & - call diapyc_energy_req_test(h, dt_in_T, tv, G, GV, US, CS%diapyc_en_rec_CSp) - - call cpu_clock_begin(id_clock_set_diffusivity) - call set_BBL_TKE(u, v, h, fluxes, visc, G, GV, US, CS%set_diff_CSp) - call cpu_clock_end(id_clock_set_diffusivity) - - ! Frazil formation keeps the temperature above the freezing point. - ! make_frazil is deliberately called at both the beginning and at - ! the end of the diabatic processes. - if (associated(tv%T) .AND. associated(tv%frazil)) then - ! For frazil diagnostic, the first call covers the first half of the time step - call enable_averaging(0.5*dt, Time_end - real_to_time(0.5*dt), CS%diag) - if (CS%frazil_tendency_diag) then - do k=1,nz ; do j=js,je ; do i=is,ie - temp_diag(i,j,k) = tv%T(i,j,k) - enddo ; enddo ; enddo - endif - - if (associated(fluxes%p_surf_full)) then - call make_frazil(h, tv, G, GV, CS%diabatic_aux_CSp, fluxes%p_surf_full, halo=CS%halo_TS_diff) - else - call make_frazil(h, tv, G, GV, CS%diabatic_aux_CSp, halo=CS%halo_TS_diff) - endif - if (showCallTree) call callTree_waypoint("done with 1st make_frazil (diabatic)") - - if (CS%frazil_tendency_diag) then - call diagnose_frazil_tendency(tv, h, temp_diag, 0.5*dt, G, GV, CS) - if (CS%id_frazil_h > 0) call post_data(CS%id_frazil_h, h, CS%diag) - endif - call disable_averaging(CS%diag) - endif ! associated(tv%T) .AND. associated(tv%frazil) - ! For all other diabatic subroutines, the averaging window should be the entire diabatic timestep call enable_averaging(dt, Time_end, CS%diag) - if (CS%debugConservation) call MOM_state_stats('1st make_frazil', u, v, h, tv%T, tv%S, G) if (CS%use_geothermal) then halo = CS%halo_TS_diff !$OMP parallel do default(shared) do k=1,nz ; do j=js-halo,je+halo ; do i=is-halo,ie+halo - h_orig(i,j,k) = h(i,j,k) ; eaml(i,j,k) = 0.0 ; ebml(i,j,k) = 0.0 + h_orig(i,j,k) = h(i,j,k) ; eatr(i,j,k) = 0.0 ; ebtr(i,j,k) = 0.0 enddo ; enddo ; enddo endif if (CS%use_geothermal) then call cpu_clock_begin(id_clock_geothermal) - call geothermal(h, tv, dt, eaml, ebml, G, GV, CS%geothermal_CSp, halo=CS%halo_TS_diff) + call geothermal(h, tv, dt, eatr, ebtr, G, GV, CS%geothermal_CSp, halo=CS%halo_TS_diff) call cpu_clock_end(id_clock_geothermal) if (showCallTree) call callTree_waypoint("geothermal (diabatic)") if (CS%debugConservation) call MOM_state_stats('geothermal', u, v, h, tv%T, tv%S, G) @@ -524,17 +631,16 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim ! Set_opacity estimates the optical properties of the water column. ! It will need to be modified later to include information about the ! biological properties and layer thicknesses. - if (associated(CS%optics)) & - call set_opacity(CS%optics, fluxes, G, GV, CS%opacity_CSp) + if (associated(CS%optics)) call set_opacity(CS%optics, fluxes, G, GV, CS%opacity_CSp) + + if (CS%debug) call MOM_state_chksum("before find_uv_at_h", u, v, h, G, GV, haloshift=0) - if (CS%debug) & - call MOM_state_chksum("before find_uv_at_h", u, v, h, G, GV, haloshift=0) if (CS%use_kappa_shear .or. CS%use_CVMix_shear) then if (CS%use_geothermal) then - call find_uv_at_h(u, v, h_orig, u_h, v_h, G, GV, eaml, ebml) + call find_uv_at_h(u, v, h_orig, u_h, v_h, G, GV, eatr, ebtr) if (CS%debug) then - call hchksum(eaml, "after find_uv_at_h eaml",G%HI, scale=GV%H_to_m) - call hchksum(ebml, "after find_uv_at_h ebml",G%HI, scale=GV%H_to_m) + call hchksum(eatr, "after find_uv_at_h eatr",G%HI, scale=GV%H_to_m) + call hchksum(ebtr, "after find_uv_at_h ebtr",G%HI, scale=GV%H_to_m) endif else call find_uv_at_h(u, v, h, u_h, v_h, G, GV) @@ -542,51 +648,6 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim if (showCallTree) call callTree_waypoint("done with find_uv_at_h (diabatic)") endif - if (CS%use_int_tides) then - ! This block provides an interface for the unresolved low-mode internal - ! tide module (BDM). - - ! PROVIDE ENERGY DISTRIBUTION (calculate time-varying energy source) - call set_int_tide_input(u, v, h, tv, fluxes, CS%int_tide_input, dt, G, GV, US, & - CS%int_tide_input_CSp) - ! CALCULATE MODAL VELOCITIES - cn(:,:,:) = 0.0 - if (CS%uniform_cg) then - ! SET TO CONSTANT VALUE TO TEST PROPAGATE CODE - do m=1,CS%nMode ; cn(:,:,m) = CS%cg_test ; enddo - else - call wave_speeds(h, tv, G, GV, US, CS%nMode, cn, full_halos=.true.) - ! uncomment the lines below for a hard-coded cn that changes linearly with latitude - !do j=G%jsd,G%jed ; do i=G%isd,G%ied - ! cn(i,j,:) = ((7.-1.)/14000000.)*G%geoLatBu(i,j) + (1.-((7.-1.)/14000000.)*-7000000.) - !enddo ; enddo - endif - - if (CS%int_tide_source_test) then - ! BUILD 2D ARRAY WITH POINT SOURCE FOR TESTING - ! This block of code should be moved into set_int_tide_input. -RWH - TKE_itidal_input_test(:,:) = 0.0 - avg_enabled = query_averaging_enabled(CS%diag,time_end=CS%time_end) - if (CS%time_end <= CS%time_max_source) then - do j=G%jsc,G%jec ; do i=G%isc,G%iec - !INPUT ARBITRARY ENERGY POINT SOURCE - if ((G%idg_offset + i == CS%int_tide_source_x) .and. & - (G%jdg_offset + j == CS%int_tide_source_y)) then - TKE_itidal_input_test(i,j) = 1.0 - endif - enddo ; enddo - endif - ! CALL ROUTINE USING PRESCRIBED KE FOR TESTING - call propagate_int_tide(h, tv, cn, TKE_itidal_input_test, CS%int_tide_input%tideamp, & - CS%int_tide_input%Nb, dt, G, GV, US, CS%int_tide_CSp) - else - ! CALL ROUTINE USING CALCULATED KE INPUT - call propagate_int_tide(h, tv, cn, CS%int_tide_input%TKE_itidal_input, CS%int_tide_input%tideamp, & - CS%int_tide_input%Nb, dt, G, GV, US, CS%int_tide_CSp) - endif - if (showCallTree) call callTree_waypoint("done with propagate_int_tide (diabatic)") - endif ! end CS%use_int_tides - call cpu_clock_begin(id_clock_set_diffusivity) ! Sets: Kd_lay, Kd_int, visc%Kd_extra_T, visc%Kd_extra_S and visc%TKE_turb ! Also changes: visc%Kd_shear and visc%Kv_shear @@ -599,7 +660,6 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim call MOM_state_chksum("after set_diffusivity ", u, v, h, G, GV, haloshift=0) call MOM_forcing_chksum("after set_diffusivity ", fluxes, G, US, haloshift=0) call MOM_thermovar_chksum("after set_diffusivity ", tv, G) - call hchksum(Kd_lay, "after set_diffusivity Kd_lay", G%HI, haloshift=0, scale=US%Z2_T_to_m2_s) call hchksum(Kd_Int, "after set_diffusivity Kd_Int", G%HI, haloshift=0, scale=US%Z2_T_to_m2_s) endif @@ -636,6 +696,11 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim enddo ; enddo ; enddo endif + if (CS%debug) then + call hchksum(Kd_heat, "after set_diffusivity Kd_heat", G%HI, haloshift=0, scale=US%Z2_T_to_m2_s) + call hchksum(Kd_salt, "after set_diffusivity Kd_salt", G%HI, haloshift=0, scale=US%Z2_T_to_m2_s) + endif + call KPP_compute_BLD(CS%KPP_CSp, G, GV, US, h, tv%T, tv%S, u, v, tv%eqn_of_state, & fluxes%ustar, CS%KPP_buoy_flux, Waves=Waves) @@ -643,7 +708,9 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim Kd_salt, visc%Kv_shear, CS%KPP_NLTheat, CS%KPP_NLTscalar, Waves=Waves) if (associated(Hml)) then + !$OMP parallel default(shared) call KPP_get_BLD(CS%KPP_CSp, Hml(:,:), G) + !$OMP end parallel call pass_var(Hml, G%domain, halo=1) ! If visc%MLD exists, copy KPP's BLD into it if (associated(visc%MLD)) visc%MLD(:,:) = Hml(:,:) @@ -674,8 +741,8 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim call MOM_state_chksum("after KPP", u, v, h, G, GV, haloshift=0) call MOM_forcing_chksum("after KPP", fluxes, G, US, haloshift=0) call MOM_thermovar_chksum("after KPP", tv, G) - call hchksum(Kd_lay, "after KPP Kd_lay", G%HI, haloshift=0, scale=US%Z2_T_to_m2_s) - call hchksum(Kd_Int, "after KPP Kd_Int", G%HI, haloshift=0, scale=US%Z2_T_to_m2_s) + call hchksum(Kd_heat, "after KPP Kd_heat", G%HI, haloshift=0, scale=US%Z2_T_to_m2_s) + call hchksum(Kd_salt, "after KPP Kd_salt", G%HI, haloshift=0, scale=US%Z2_T_to_m2_s) endif endif ! endif for KPP @@ -713,13 +780,14 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim endif endif ! endif for KPP - ! Differential diffusion done here. + ! This is the "old" method for applying differential diffusion. ! Changes: tv%T, tv%S if (associated(visc%Kd_extra_T) .and. associated(visc%Kd_extra_S) .and. associated(tv%T)) then call cpu_clock_begin(id_clock_differential_diff) call differential_diffuse_T_S(h, tv, visc, dt_in_T, G, GV) call cpu_clock_end(id_clock_differential_diff) + if (showCallTree) call callTree_waypoint("done with differential_diffuse_T_S (diabatic)") if (CS%debugConservation) call MOM_state_stats('differential_diffuse_T_S', u, v, h, tv%T, tv%S, G) @@ -741,16 +809,18 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim ! Otherwise, call entrainment_diffusive() which sets ea and eb ! based on KD and target densities (ie. does remapping as well). do j=js,je ; do i=is,ie - ea(i,j,1) = 0. + ea_s(i,j,1) = 0. enddo ; enddo !$OMP parallel do default(shared) private(hval) do k=2,nz ; do j=js,je ; do i=is,ie hval=1.0/(h_neglect + 0.5*(h(i,j,k-1) + h(i,j,k))) - ea(i,j,k) = (GV%Z_to_H**2) * dt_in_T * hval * Kd_int(i,j,K) - eb(i,j,k-1) = ea(i,j,k) + ea_s(i,j,k) = (GV%Z_to_H**2) * dt_in_T * hval * Kd_int(i,j,K) + eb_s(i,j,k-1) = ea_s(i,j,k) + ea_t(i,j,k-1) = ea_s(i,j,k-1) ; eb_t(i,j,k-1) = eb_s(i,j,k-1) enddo ; enddo ; enddo do j=js,je ; do i=is,ie - eb(i,j,nz) = 0. + eb_s(i,j,nz) = 0. + ea_t(i,j,nz) = ea_s(i,j,nz) ; eb_t(i,j,nz) = eb_s(i,j,nz) enddo ; enddo if (showCallTree) call callTree_waypoint("done setting ea,eb from Kd_int (diabatic)") @@ -758,8 +828,8 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim call MOM_forcing_chksum("after calc_entrain ", fluxes, G, US, haloshift=0) call MOM_thermovar_chksum("after calc_entrain ", tv, G) call MOM_state_chksum("after calc_entrain ", u, v, h, G, GV, haloshift=0) - call hchksum(ea, "after calc_entrain ea", G%HI, haloshift=0, scale=GV%H_to_m) - call hchksum(eb, "after calc_entrain eb", G%HI, haloshift=0, scale=GV%H_to_m) + call hchksum(ea_s, "after calc_entrain ea_s", G%HI, haloshift=0, scale=GV%H_to_m) + call hchksum(eb_s, "after calc_entrain eb_s", G%HI, haloshift=0, scale=GV%H_to_m) endif ! Save fields before boundary forcing is applied for tendency diagnostics @@ -771,11 +841,10 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim enddo ; enddo ; enddo endif - ! Apply forcing when using the ALE algorithm + ! Apply forcing call cpu_clock_begin(id_clock_remap) ! Changes made to following fields: h, tv%T and tv%S. - do k=1,nz ; do j=js,je ; do i=is,ie h_prebound(i,j,k) = h(i,j,k) enddo ; enddo ; enddo @@ -787,8 +856,10 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim CS%minimum_forcing_depth, cTKE, dSV_dT, dSV_dS, SkinBuoyFlux=SkinBuoyFlux) if (CS%debug) then - call hchksum(ea, "after applyBoundaryFluxes ea",G%HI,haloshift=0, scale=GV%H_to_m) - call hchksum(eb, "after applyBoundaryFluxes eb",G%HI,haloshift=0, scale=GV%H_to_m) + call hchksum(ea_t, "after applyBoundaryFluxes ea_t",G%HI,haloshift=0, scale=GV%H_to_m) + call hchksum(eb_t, "after applyBoundaryFluxes eb_t",G%HI,haloshift=0, scale=GV%H_to_m) + call hchksum(ea_s, "after applyBoundaryFluxes ea_s",G%HI,haloshift=0, scale=GV%H_to_m) + call hchksum(eb_s, "after applyBoundaryFluxes eb_s",G%HI,haloshift=0, scale=GV%H_to_m) call hchksum(cTKE, "after applyBoundaryFluxes cTKE",G%HI,haloshift=0) call hchksum(dSV_dT, "after applyBoundaryFluxes dSV_dT",G%HI,haloshift=0) call hchksum(dSV_dS, "after applyBoundaryFluxes dSV_dS",G%HI,haloshift=0) @@ -805,9 +876,9 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim Hml(:,:) = visc%MLD(:,:) endif - ! Augment the diffusivities due to those diagnosed in energetic_PBL. + ! Augment the diffusivities and viscosity due to those diagnosed in energetic_PBL. do K=2,nz ; do j=js,je ; do i=is,ie - + !### These expressions assume a Prandtl number of 1. if (CS%ePBL_is_additive) then Kd_add_here = Kd_ePBL(i,j,K) visc%Kv_shear(i,j,K) = visc%Kv_shear(i,j,K) + Kd_ePBL(i,j,K) @@ -817,8 +888,8 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim endif Ent_int = Kd_add_here * (GV%Z_to_H**2 * dt_in_T) / & (0.5*(h(i,j,k-1) + h(i,j,k)) + h_neglect) - eb(i,j,k-1) = eb(i,j,k-1) + Ent_int - ea(i,j,k) = ea(i,j,k) + Ent_int + eb_s(i,j,k-1) = eb_s(i,j,k-1) + Ent_int + ea_s(i,j,k) = ea_s(i,j,k) + Ent_int Kd_int(i,j,K) = Kd_int(i,j,K) + Kd_add_here ! for diagnostics @@ -828,8 +899,10 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim enddo ; enddo ; enddo if (CS%debug) then - call hchksum(ea, "after ePBL ea",G%HI,haloshift=0, scale=GV%H_to_m) - call hchksum(eb, "after ePBL eb",G%HI,haloshift=0, scale=GV%H_to_m) + call hchksum(ea_t, "after ePBL ea_t",G%HI,haloshift=0, scale=GV%H_to_m) + call hchksum(eb_t, "after ePBL eb_t",G%HI,haloshift=0, scale=GV%H_to_m) + call hchksum(ea_s, "after ePBL ea_s",G%HI,haloshift=0, scale=GV%H_to_m) + call hchksum(eb_s, "after ePBL eb_s",G%HI,haloshift=0, scale=GV%H_to_m) call hchksum(Kd_ePBL, "after ePBL Kd_ePBL", G%HI, haloshift=0, scale=US%Z2_T_to_m2_s) endif @@ -849,7 +922,6 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim endif ! Boundary fluxes may have changed T, S, and h call diag_update_remap_grids(CS%diag) - call cpu_clock_end(id_clock_remap) if (CS%debug) then call MOM_forcing_chksum("after applyBoundaryFluxes ", fluxes, G, US, haloshift=0) @@ -871,16 +943,16 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim do j=js,je do i=is,ie hold(i,j,1) = h(i,j,1) - h(i,j,1) = h(i,j,1) + (eb(i,j,1) - ea(i,j,2)) + h(i,j,1) = h(i,j,1) + (eb_s(i,j,1) - ea_s(i,j,2)) hold(i,j,nz) = h(i,j,nz) - h(i,j,nz) = h(i,j,nz) + (ea(i,j,nz) - eb(i,j,nz-1)) + h(i,j,nz) = h(i,j,nz) + (ea_s(i,j,nz) - eb_s(i,j,nz-1)) if (h(i,j,1) <= 0.0) h(i,j,1) = GV%Angstrom_H if (h(i,j,nz) <= 0.0) h(i,j,nz) = GV%Angstrom_H enddo do k=2,nz-1 ; do i=is,ie hold(i,j,k) = h(i,j,k) - h(i,j,k) = h(i,j,k) + ((ea(i,j,k) - eb(i,j,k-1)) + & - (eb(i,j,k) - ea(i,j,k+1))) + h(i,j,k) = h(i,j,k) + ((ea_s(i,j,k) - eb_s(i,j,k-1)) + & + (eb_s(i,j,k) - ea_s(i,j,k+1))) if (h(i,j,k) <= 0.0) h(i,j,k) = GV%Angstrom_H enddo ; enddo enddo @@ -895,20 +967,17 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim if (showCallTree) call callTree_waypoint("done with h=ea-eb (diabatic)") if (CS%debugConservation) call MOM_state_stats('h=ea-eb', u, v, h, tv%T, tv%S, G) - ! Here, T and S are updated according to ea and eb. - ! If using the bulk mixed layer, T and S are also updated - ! by surface fluxes (in fluxes%*). - ! This is a very long block. - ! calculate change in temperature & salinity due to dia-coordinate surface diffusion if (associated(tv%T)) then if (CS%debug) then - call hchksum(ea, "before triDiagTS ea ",G%HI,haloshift=0, scale=GV%H_to_m) - call hchksum(eb, "before triDiagTS eb ",G%HI,haloshift=0, scale=GV%H_to_m) + call hchksum(ea_t, "before triDiagTS ea_t ",G%HI,haloshift=0, scale=GV%H_to_m) + call hchksum(eb_t, "before triDiagTS eb_t ",G%HI,haloshift=0, scale=GV%H_to_m) + call hchksum(ea_s, "before triDiagTS ea_s ",G%HI,haloshift=0, scale=GV%H_to_m) + call hchksum(eb_s, "before triDiagTS eb_s ",G%HI,haloshift=0, scale=GV%H_to_m) endif - call cpu_clock_begin(id_clock_tridiag) + call cpu_clock_begin(id_clock_tridiag) ! Keep salinity from falling below a small but positive threshold. ! This constraint is needed for SIS1 ice model, which can extract ! more salt than is present in the ocean. SIS2 does not suffer @@ -926,16 +995,19 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim endif ! Changes T and S via the tridiagonal solver; no change to h + do k=1,nz ; do j=js,je ; do i=is,ie + ea_t(i,j,k) = ea_s(i,j,k) ; eb_t(i,j,k) = eb_s(i,j,k) + enddo ; enddo ; enddo if (CS%tracer_tridiag) then - call tracer_vertdiff(hold, ea, eb, dt, tv%T, G, GV) - call tracer_vertdiff(hold, ea, eb, dt, tv%S, G, GV) + call tracer_vertdiff(hold, ea_t, eb_t, dt, tv%T, G, GV) + call tracer_vertdiff(hold, ea_s, eb_s, dt, tv%S, G, GV) else - call triDiagTS(G, GV, is, ie, js, je, hold, ea, eb, tv%T, tv%S) + call triDiagTS(G, GV, is, ie, js, je, hold, ea_s, eb_s, tv%T, tv%S) endif ! diagnose temperature, salinity, heat, and salt tendencies ! Note: hold here refers to the thicknesses from before the dual-entraintment when using - ! the bulk mixed layer scheme. Otherwise in ALE-mode, layer thicknesses will have changed + ! the bulk mixed layer scheme. Otherwise in ALE-mode, layer thicknesses will (not?) have changed ! In either case, tendencies should be posted on hold if (CS%diabatic_diff_tendency_diag) then call diagnose_diabatic_diff_tendency(tv, hold, temp_diag, saln_diag, dt, G, GV, CS) @@ -943,16 +1015,16 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim endif call cpu_clock_end(id_clock_tridiag) + if (showCallTree) call callTree_waypoint("done with triDiagTS (diabatic)") endif ! endif corresponding to if (associated(tv%T)) + if (CS%debugConservation) call MOM_state_stats('triDiagTS', u, v, h, tv%T, tv%S, G) if (CS%debug) then call MOM_state_chksum("after mixed layer ", u, v, h, G, GV, haloshift=0) call MOM_thermovar_chksum("after mixed layer ", tv, G) - call hchksum(ea, "after mixed layer ea", G%HI, scale=GV%H_to_m) - call hchksum(eb, "after mixed layer eb", G%HI, scale=GV%H_to_m) endif ! Whenever thickness changes let the diag manager know, as the @@ -963,6 +1035,7 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim call diag_update_remap_grids(CS%diag) ! diagnostics + Idt = 1.0 / dt if ((CS%id_Tdif > 0) .or. (CS%id_Tadv > 0)) then do j=js,je ; do i=is,ie Tdif_flx(i,j,1) = 0.0 ; Tdif_flx(i,j,nz+1) = 0.0 @@ -970,9 +1043,9 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim enddo ; enddo !$OMP parallel do default(shared) do K=2,nz ; do j=js,je ; do i=is,ie - Tdif_flx(i,j,K) = (Idt * 0.5*(ea(i,j,k) + eb(i,j,k-1))) * & + Tdif_flx(i,j,K) = (Idt * 0.5*(ea_t(i,j,k) + eb_t(i,j,k-1))) * & (tv%T(i,j,k-1) - tv%T(i,j,k)) - Tadv_flx(i,j,K) = (Idt * (ea(i,j,k) - eb(i,j,k-1))) * & + Tadv_flx(i,j,K) = (Idt * (ea_t(i,j,k) - eb_t(i,j,k-1))) * & 0.5*(tv%T(i,j,k-1) + tv%T(i,j,k)) enddo ; enddo ; enddo endif @@ -983,21 +1056,22 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim enddo ; enddo !$OMP parallel do default(shared) do K=2,nz ; do j=js,je ; do i=is,ie - Sdif_flx(i,j,K) = (Idt * 0.5*(ea(i,j,k) + eb(i,j,k-1))) * & + Sdif_flx(i,j,K) = (Idt * 0.5*(ea_s(i,j,k) + eb_s(i,j,k-1))) * & (tv%S(i,j,k-1) - tv%S(i,j,k)) - Sadv_flx(i,j,K) = (Idt * (ea(i,j,k) - eb(i,j,k-1))) * & + Sadv_flx(i,j,K) = (Idt * (ea_s(i,j,k) - eb_s(i,j,k-1))) * & 0.5*(tv%S(i,j,k-1) + tv%S(i,j,k)) enddo ; enddo ; enddo endif ! mixing of passive tracers from massless boundary layers to interior call cpu_clock_begin(id_clock_tracers) + if (CS%mix_boundary_tracers) then Tr_ea_BBL = GV%Z_to_H * sqrt(dt_in_T*CS%Kd_BBL_tr) !$OMP parallel do default(shared) private(htot,in_boundary,add_ent) do j=js,je do i=is,ie - ebtr(i,j,nz) = eb(i,j,nz) + ebtr(i,j,nz) = eb_s(i,j,nz) htot(i) = 0.0 in_boundary(i) = (G%mask2dT(i,j) > 0.0) enddo @@ -1010,24 +1084,25 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim ! thicknesses, as this corresponds pretty closely (to within ! differences in the density jumps between layers) with what is done ! in the calculation of the fluxes in the first place. Kd_min_tr - ! should be much less than the values that have been set in Kd_lay, + ! should be much less than the values that have been set in Kd_int, ! perhaps a molecular diffusivity. add_ent = ((dt_in_T * CS%Kd_min_tr) * GV%Z_to_H**2) * & ((h(i,j,k-1)+h(i,j,k)+h_neglect) / & (h(i,j,k-1)*h(i,j,k)+h_neglect2)) - & - 0.5*(ea(i,j,k) + eb(i,j,k-1)) + 0.5*(ea_s(i,j,k) + eb_s(i,j,k-1)) if (htot(i) < Tr_ea_BBL) then add_ent = max(0.0, add_ent, & - (Tr_ea_BBL - htot(i)) - min(ea(i,j,k),eb(i,j,k-1))) + (Tr_ea_BBL - htot(i)) - min(ea_s(i,j,k),eb_s(i,j,k-1))) elseif (add_ent < 0.0) then add_ent = 0.0 ; in_boundary(i) = .false. endif - ebtr(i,j,k-1) = eb(i,j,k-1) + add_ent - eatr(i,j,k) = ea(i,j,k) + add_ent + ebtr(i,j,k-1) = eb_s(i,j,k-1) + add_ent + eatr(i,j,k) = ea_s(i,j,k) + add_ent else - ebtr(i,j,k-1) = eb(i,j,k-1) ; eatr(i,j,k) = ea(i,j,k) + ebtr(i,j,k-1) = eb_s(i,j,k-1) ; eatr(i,j,k) = ea_s(i,j,k) endif + if (associated(visc%Kd_extra_S)) then ; if (visc%Kd_extra_S(i,j,k) > 0.0) then add_ent = ((dt_in_T * visc%Kd_extra_S(i,j,k)) * GV%Z_to_H**2) / & (0.25 * ((h(i,j,k-1) + h(i,j,k)) + (hold(i,j,k-1) + hold(i,j,k))) + & @@ -1036,13 +1111,13 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim eatr(i,j,k) = eatr(i,j,k) + add_ent endif ; endif enddo ; enddo - do i=is,ie ; eatr(i,j,1) = ea(i,j,1) ; enddo + do i=is,ie ; eatr(i,j,1) = ea_s(i,j,1) ; enddo enddo ! For passive tracers, the changes in thickness due to boundary fluxes has yet to be applied ! so hold should be h_orig - call call_tracer_column_fns(h_prebound, h, ea, eb, fluxes, Hml, dt, G, GV, tv, & + call call_tracer_column_fns(h_prebound, h, ea_s, eb_s, fluxes, Hml, dt, G, GV, tv, & CS%optics, CS%tracer_flow_CSp, CS%debug, & evap_CFL_limit = CS%evap_CFL_limit, & minimum_forcing_depth = CS%minimum_forcing_depth) @@ -1050,7 +1125,7 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim elseif (associated(visc%Kd_extra_S)) then ! extra diffusivity for passive tracers do j=js,je ; do i=is,ie - ebtr(i,j,nz) = eb(i,j,nz) ; eatr(i,j,1) = ea(i,j,1) + ebtr(i,j,nz) = eb_s(i,j,nz) ; eatr(i,j,1) = ea_s(i,j,1) enddo ; enddo !$OMP parallel do default(shared) private(add_ent) do k=nz,2,-1 ; do j=js,je ; do i=is,ie @@ -1061,8 +1136,8 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim else add_ent = 0.0 endif - ebtr(i,j,k-1) = eb(i,j,k-1) + add_ent - eatr(i,j,k) = ea(i,j,k) + add_ent + ebtr(i,j,k-1) = eb_s(i,j,k-1) + add_ent + eatr(i,j,k) = ea_s(i,j,k) + add_ent enddo ; enddo ; enddo ! For passive tracers, the changes in thickness due to boundary fluxes has yet to be applied @@ -1080,11 +1155,13 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim call cpu_clock_end(id_clock_tracers) - ! sponges - if (CS%use_sponge .and. associated(CS%ALE_sponge_CSp)) then + ! Apply ALE sponge + if (CS%use_sponge) then call cpu_clock_begin(id_clock_sponge) - ! ALE sponge - call apply_ALE_sponge(h, dt, G, GV, US, CS%ALE_sponge_CSp, CS%Time) + if (associated(CS%ALE_sponge_CSp)) then + call apply_ALE_sponge(h, dt, G, GV, US, CS%ALE_sponge_CSp, CS%Time) + endif + call cpu_clock_end(id_clock_sponge) if (CS%debug) then call MOM_state_chksum("apply_sponge ", u, v, h, G, GV, haloshift=0) @@ -1092,40 +1169,7 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim endif endif ! CS%use_sponge - call cpu_clock_begin(id_clock_pass) - if (associated(visc%Kv_shear)) & - call pass_var(visc%Kv_shear, G%Domain, To_All+Omit_Corners, halo=1) - call cpu_clock_end(id_clock_pass) - call disable_averaging(CS%diag) - ! Frazil formation keeps temperature above the freezing point. - ! make_frazil is deliberately called at both the beginning and at - ! the end of the diabatic processes. - if (associated(tv%T) .AND. associated(tv%frazil)) then - call enable_averaging(0.5*dt, Time_end, CS%diag) - if (CS%frazil_tendency_diag) then - do k=1,nz ; do j=js,je ; do i=is,ie - temp_diag(i,j,k) = tv%T(i,j,k) - enddo ; enddo ; enddo - endif - - if (associated(fluxes%p_surf_full)) then - call make_frazil(h, tv, G, GV, CS%diabatic_aux_CSp, fluxes%p_surf_full) - else - call make_frazil(h, tv, G, GV, CS%diabatic_aux_CSp) - endif - - if (CS%frazil_tendency_diag) then - call diagnose_frazil_tendency(tv, h, temp_diag, 0.5*dt, G, GV, CS) - if (CS%id_frazil_h > 0 ) call post_data(CS%id_frazil_h, h, CS%diag) - endif - - if (showCallTree) call callTree_waypoint("done with 2nd make_frazil (diabatic)") - if (CS%debugConservation) call MOM_state_stats('2nd make_frazil', u, v, h, tv%T, tv%S, G) - call disable_averaging(CS%diag) - - endif ! endif for frazil - ! Diagnose the diapycnal diffusivities and other related quantities. call enable_averaging(dt, Time_end, CS%diag) @@ -1134,39 +1178,21 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim if (CS%id_Kd_salt > 0) call post_data(CS%id_Kd_salt, Kd_salt, CS%diag) if (CS%id_Kd_ePBL > 0) call post_data(CS%id_Kd_ePBL, Kd_ePBL, CS%diag) - if (CS%id_ea > 0) call post_data(CS%id_ea, ea, CS%diag) - if (CS%id_eb > 0) call post_data(CS%id_eb, eb, CS%diag) + if (CS%id_ea > 0) call post_data(CS%id_ea, ea_s, CS%diag) + if (CS%id_eb > 0) call post_data(CS%id_eb, eb_s, CS%diag) if (CS%id_dudt_dia > 0) call post_data(CS%id_dudt_dia, ADp%du_dt_dia, CS%diag) if (CS%id_dvdt_dia > 0) call post_data(CS%id_dvdt_dia, ADp%dv_dt_dia, CS%diag) if (CS%id_wd > 0) call post_data(CS%id_wd, CDp%diapyc_vel, CS%diag) - if (CS%id_MLD_003 > 0 .or. CS%id_subMLN2 > 0 .or. CS%id_mlotstsq > 0) then - call diagnoseMLDbyDensityDifference(CS%id_MLD_003, h, tv, 0.03, G, GV, US, CS%diag, & - id_N2subML=CS%id_subMLN2, id_MLDsq=CS%id_mlotstsq, dz_subML=CS%dz_subML_N2) - endif - if (CS%id_MLD_0125 > 0) then - call diagnoseMLDbyDensityDifference(CS%id_MLD_0125, h, tv, 0.125, G, GV, US, CS%diag) - endif - if (CS%id_MLD_user > 0) then - call diagnoseMLDbyDensityDifference(CS%id_MLD_user, h, tv, CS%MLDdensityDifference, G, GV, US, CS%diag) - endif - if (CS%id_Tdif > 0) call post_data(CS%id_Tdif, Tdif_flx, CS%diag) if (CS%id_Tadv > 0) call post_data(CS%id_Tadv, Tadv_flx, CS%diag) if (CS%id_Sdif > 0) call post_data(CS%id_Sdif, Sdif_flx, CS%diag) if (CS%id_Sadv > 0) call post_data(CS%id_Sadv, Sadv_flx, CS%diag) - if (CS%use_int_tides) then - if (CS%id_cg1 > 0) call post_data(CS%id_cg1, cn(:,:,1),CS%diag) - do m=1,CS%nMode - if (CS%id_cn(m) > 0) call post_data(CS%id_cn(m),cn(:,:,m),CS%diag) - enddo - endif call disable_averaging(CS%diag) - if (CS%debugConservation) call MOM_state_stats('leaving diabatic', u, v, h, tv%T, tv%S, G) - if (showCallTree) call callTree_leave("diabatic()") + if (showCallTree) call callTree_leave("diabatic_ALE_legacy()") end subroutine diabatic_ALE_legacy @@ -1217,8 +1243,6 @@ subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, cTKE, & ! convective TKE requirements for each layer [kg m-3 Z3 T-2 ~> J m-2]. u_h, & ! zonal and meridional velocities at thickness points after v_h ! entrainment [m s-1] - real, dimension(SZI_(G),SZJ_(G),CS%nMode) :: & - cn ! baroclinic gravity wave speeds real, dimension(SZI_(G),SZJ_(G)) :: & Rcv_ml, & ! coordinate density of mixed layer, used for applying sponges SkinBuoyFlux! 2d surface buoyancy flux [Z2 T-3 ~> m2 s-3], used by ePBL @@ -1226,12 +1250,10 @@ subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, real, dimension(SZI_(G),SZJ_(G),G%ke) :: temp_diag ! diagnostic array for temp real, dimension(SZI_(G),SZJ_(G),G%ke) :: saln_diag ! diagnostic array for salinity real, dimension(SZI_(G),SZJ_(G)) :: tendency_2d ! depth integrated content tendency for diagn - real, dimension(SZI_(G),SZJ_(G)) :: TKE_itidal_input_test ! override of energy input for testing (BDM) real :: net_ent ! The net of ea-eb at an interface. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), target :: & - ! These are targets so that the space can be shared with eaml & ebml. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: & eatr, & ! The equivalent of ea and eb for tracers, which differ from ea and ebtr ! eb in that they tend to homogenize tracers in massless layers ! near the boundaries [H ~> m or kg m-2] (for Bous or non-Bouss) @@ -1241,19 +1263,11 @@ subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, Kd_heat, & ! diapycnal diffusivity of heat [Z2 T-1 ~> m2 s-1] Kd_salt, & ! diapycnal diffusivity of salt and passive tracers [Z2 T-1 ~> m2 s-1] Kd_ePBL, & ! test array of diapycnal diffusivities at interfaces [Z2 T-1 ~> m2 s-1] - eta, & ! Interface heights before diapycnal mixing [m]. Tdif_flx, & ! diffusive diapycnal heat flux across interfaces [degC m s-1] Tadv_flx, & ! advective diapycnal heat flux across interfaces [degC m s-1] Sdif_flx, & ! diffusive diapycnal salt flux across interfaces [ppt m s-1] Sadv_flx ! advective diapycnal salt flux across interfaces [ppt m s-1] - ! The following 5 variables are only used with a bulk mixed layer. - real, pointer, dimension(:,:,:) :: & - eaml, & ! The equivalent of ea due to mixed layer processes [H ~> m or kg m-2]. - ebml ! The equivalent of eb due to mixed layer processes [H ~> m or kg m-2]. - ! eaml and ebml are pointers to eatr and ebtr so as to reuse the memory as - ! the arrays are not needed at the same time. - logical :: in_boundary(SZI_(G)) ! True if there are no massive layers below, ! where massive is defined as sufficiently thick that ! the no-flux boundary conditions have not restricted @@ -1288,7 +1302,6 @@ subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, integer :: i, j, k, is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz, nkmb, m, halo integer :: ig, jg ! global indices for testing testing itide point source (BDM) - logical :: avg_enabled ! for testing internal tides (BDM) real :: Kd_add_here ! An added diffusivity [Z2 T-1 ~> m2 s-1]. is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke @@ -1297,94 +1310,28 @@ subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, h_neglect = GV%H_subroundoff ; h_neglect2 = h_neglect*h_neglect Kd_heat(:,:,:) = 0.0 ; Kd_salt(:,:,:) = 0.0 - if (nz == 1) return showCallTree = callTree_showQuery() - if (showCallTree) call callTree_enter("diabatic(), MOM_diabatic_driver.F90") + if (showCallTree) call callTree_enter("diabatic_ALE(), MOM_diabatic_driver.F90") if (.not. (CS%useALEalgorithm)) call MOM_error(FATAL, "MOM_diabatic_driver: "// & "The ALE algorithm must be enabled when using MOM_diabatic_driver.") - ! Offer diagnostics of various state varables at the start of diabatic - ! these are mostly for debugging purposes. - if (CS%id_u_predia > 0) call post_data(CS%id_u_predia, u, CS%diag) - if (CS%id_v_predia > 0) call post_data(CS%id_v_predia, v, CS%diag) - if (CS%id_h_predia > 0) call post_data(CS%id_h_predia, h, CS%diag) - if (CS%id_T_predia > 0) call post_data(CS%id_T_predia, tv%T, CS%diag) - if (CS%id_S_predia > 0) call post_data(CS%id_S_predia, tv%S, CS%diag) - if (CS%id_e_predia > 0) then - call find_eta(h, tv, G, GV, US, eta, eta_to_m=1.0) - call post_data(CS%id_e_predia, eta, CS%diag) - endif - - - ! set equivalence between the same bits of memory for these arrays - eaml => eatr ; ebml => ebtr - - ! inverse time step - if (dt == 0.0) call MOM_error(FATAL, "MOM_diabatic_driver: "// & - "diabatic was called with a zero length timestep.") - if (dt < 0.0) call MOM_error(FATAL, "MOM_diabatic_driver: "// & - "diabatic was called with a negative timestep.") - Idt = 1.0 / dt dt_in_T = dt * US%s_to_T - if (.not. associated(CS)) call MOM_error(FATAL, "MOM_diabatic_driver: "// & - "Module must be initialized before it is used.") - - if (CS%debug) then - call MOM_state_chksum("Start of diabatic ", u, v, h, G, GV, haloshift=0) - call MOM_forcing_chksum("Start of diabatic", fluxes, G, US, haloshift=0) - endif - if (CS%debugConservation) call MOM_state_stats('Start of diabatic', u, v, h, tv%T, tv%S, G) - - if (CS%debug_energy_req) & - call diapyc_energy_req_test(h, dt_in_T, tv, G, GV, US, CS%diapyc_en_rec_CSp) - - call cpu_clock_begin(id_clock_set_diffusivity) - call set_BBL_TKE(u, v, h, fluxes, visc, G, GV, US, CS%set_diff_CSp) - call cpu_clock_end(id_clock_set_diffusivity) - - ! Frazil formation keeps the temperature above the freezing point. - ! make_frazil is deliberately called at both the beginning and at - ! the end of the diabatic processes. - if (associated(tv%T) .AND. associated(tv%frazil)) then - ! For frazil diagnostic, the first call covers the first half of the time step - call enable_averaging(0.5*dt, Time_end - real_to_time(0.5*dt), CS%diag) - if (CS%frazil_tendency_diag) then - do k=1,nz ; do j=js,je ; do i=is,ie - temp_diag(i,j,k) = tv%T(i,j,k) - enddo ; enddo ; enddo - endif - - if (associated(fluxes%p_surf_full)) then - call make_frazil(h, tv, G, GV, CS%diabatic_aux_CSp, fluxes%p_surf_full, halo=CS%halo_TS_diff) - else - call make_frazil(h, tv, G, GV, CS%diabatic_aux_CSp, halo=CS%halo_TS_diff) - endif - if (showCallTree) call callTree_waypoint("done with 1st make_frazil (diabatic)") - - if (CS%frazil_tendency_diag) then - call diagnose_frazil_tendency(tv, h, temp_diag, 0.5*dt, G, GV, CS) - if (CS%id_frazil_h > 0) call post_data(CS%id_frazil_h, h, CS%diag) - endif - call disable_averaging(CS%diag) - endif ! associated(tv%T) .AND. associated(tv%frazil) - ! For all other diabatic subroutines, the averaging window should be the entire diabatic timestep call enable_averaging(dt, Time_end, CS%diag) - if (CS%debugConservation) call MOM_state_stats('1st make_frazil', u, v, h, tv%T, tv%S, G) - if ((CS%ML_mix_first > 0.0) .or. CS%use_geothermal) then + if (CS%use_geothermal) then halo = CS%halo_TS_diff !$OMP parallel do default(shared) do k=1,nz ; do j=js-halo,je+halo ; do i=is-halo,ie+halo - h_orig(i,j,k) = h(i,j,k) ; eaml(i,j,k) = 0.0 ; ebml(i,j,k) = 0.0 + h_orig(i,j,k) = h(i,j,k) ; eatr(i,j,k) = 0.0 ; ebtr(i,j,k) = 0.0 enddo ; enddo ; enddo endif if (CS%use_geothermal) then call cpu_clock_begin(id_clock_geothermal) - call geothermal(h, tv, dt, eaml, ebml, G, GV, CS%geothermal_CSp, halo=CS%halo_TS_diff) + call geothermal(h, tv, dt, eatr, ebtr, G, GV, CS%geothermal_CSp, halo=CS%halo_TS_diff) call cpu_clock_end(id_clock_geothermal) if (showCallTree) call callTree_waypoint("geothermal (diabatic)") if (CS%debugConservation) call MOM_state_stats('geothermal', u, v, h, tv%T, tv%S, G) @@ -1397,18 +1344,16 @@ subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, ! Set_opacity estimates the optical properties of the water column. ! It will need to be modified later to include information about the ! biological properties and layer thicknesses. - if (associated(CS%optics)) & - call set_opacity(CS%optics, fluxes, G, GV, CS%opacity_CSp) + if (associated(CS%optics)) call set_opacity(CS%optics, fluxes, G, GV, CS%opacity_CSp) - if (CS%debug) & - call MOM_state_chksum("before find_uv_at_h", u, v, h, G, GV, haloshift=0) + if (CS%debug) call MOM_state_chksum("before find_uv_at_h", u, v, h, G, GV, haloshift=0) if (CS%use_kappa_shear .or. CS%use_CVMix_shear) then - if ((CS%ML_mix_first > 0.0) .or. CS%use_geothermal) then - call find_uv_at_h(u, v, h_orig, u_h, v_h, G, GV, eaml, ebml) + if (CS%use_geothermal) then + call find_uv_at_h(u, v, h_orig, u_h, v_h, G, GV, eatr, ebtr) if (CS%debug) then - call hchksum(eaml, "after find_uv_at_h eaml",G%HI, scale=GV%H_to_m) - call hchksum(ebml, "after find_uv_at_h ebml",G%HI, scale=GV%H_to_m) + call hchksum(eatr, "after find_uv_at_h eatr",G%HI, scale=GV%H_to_m) + call hchksum(ebtr, "after find_uv_at_h ebtr",G%HI, scale=GV%H_to_m) endif else call find_uv_at_h(u, v, h, u_h, v_h, G, GV) @@ -1416,51 +1361,6 @@ subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, if (showCallTree) call callTree_waypoint("done with find_uv_at_h (diabatic)") endif - if (CS%use_int_tides) then - ! This block provides an interface for the unresolved low-mode internal - ! tide module (BDM). - - ! PROVIDE ENERGY DISTRIBUTION (calculate time-varying energy source) - call set_int_tide_input(u, v, h, tv, fluxes, CS%int_tide_input, dt, G, GV, US, & - CS%int_tide_input_CSp) - ! CALCULATE MODAL VELOCITIES - cn(:,:,:) = 0.0 - if (CS%uniform_cg) then - ! SET TO CONSTANT VALUE TO TEST PROPAGATE CODE - do m=1,CS%nMode ; cn(:,:,m) = CS%cg_test ; enddo - else - call wave_speeds(h, tv, G, GV, US, CS%nMode, cn, full_halos=.true.) - ! uncomment the lines below for a hard-coded cn that changes linearly with latitude - !do j=G%jsd,G%jed ; do i=G%isd,G%ied - ! cn(i,j,:) = ((7.-1.)/14000000.)*G%geoLatBu(i,j) + (1.-((7.-1.)/14000000.)*-7000000.) - !enddo ; enddo - endif - - if (CS%int_tide_source_test) then - ! BUILD 2D ARRAY WITH POINT SOURCE FOR TESTING - ! This block of code should be moved into set_int_tide_input. -RWH - TKE_itidal_input_test(:,:) = 0.0 - avg_enabled = query_averaging_enabled(CS%diag,time_end=CS%time_end) - if (CS%time_end <= CS%time_max_source) then - do j=G%jsc,G%jec ; do i=G%isc,G%iec - !INPUT ARBITRARY ENERGY POINT SOURCE - if ((G%idg_offset + i == CS%int_tide_source_x) .and. & - (G%jdg_offset + j == CS%int_tide_source_y)) then - TKE_itidal_input_test(i,j) = 1.0 - endif - enddo ; enddo - endif - ! CALL ROUTINE USING PRESCRIBED KE FOR TESTING - call propagate_int_tide(h, tv, cn, TKE_itidal_input_test, CS%int_tide_input%tideamp, & - CS%int_tide_input%Nb, dt, G, GV, US, CS%int_tide_CSp) - else - ! CALL ROUTINE USING CALCULATED KE INPUT - call propagate_int_tide(h, tv, cn, CS%int_tide_input%TKE_itidal_input, CS%int_tide_input%tideamp, & - CS%int_tide_input%Nb, dt, G, GV, US, CS%int_tide_CSp) - endif - if (showCallTree) call callTree_waypoint("done with propagate_int_tide (diabatic)") - endif ! end CS%use_int_tides - call cpu_clock_begin(id_clock_set_diffusivity) ! Sets: Kd_lay, Kd_int, visc%Kd_extra_T, visc%Kd_extra_S and visc%TKE_turb ! Also changes: visc%Kd_shear, visc%Kv_shear and visc%Kv_slow @@ -1469,6 +1369,13 @@ subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, call cpu_clock_end(id_clock_set_diffusivity) if (showCallTree) call callTree_waypoint("done with set_diffusivity (diabatic)") + if (CS%debug) then + call MOM_state_chksum("after set_diffusivity ", u, v, h, G, GV, haloshift=0) + call MOM_forcing_chksum("after set_diffusivity ", fluxes, G, US, haloshift=0) + call MOM_thermovar_chksum("after set_diffusivity ", tv, G) + call hchksum(Kd_Int, "after set_diffusivity Kd_Int", G%HI, haloshift=0, scale=US%Z2_T_to_m2_s) + endif + ! Set diffusivities for heat and salt separately !$OMP parallel do default(shared) @@ -1491,9 +1398,6 @@ subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, endif if (CS%debug) then - call MOM_state_chksum("after set_diffusivity ", u, v, h, G, GV, haloshift=0) - call MOM_forcing_chksum("after set_diffusivity ", fluxes, G, US, haloshift=0) - call MOM_thermovar_chksum("after set_diffusivity ", tv, G) call hchksum(Kd_heat, "after set_diffusivity Kd_heat", G%HI, haloshift=0, scale=US%Z2_T_to_m2_s) call hchksum(Kd_salt, "after set_diffusivity Kd_salt", G%HI, haloshift=0, scale=US%Z2_T_to_m2_s) endif @@ -1619,7 +1523,7 @@ subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, ! Changes made to following fields: h, tv%T and tv%S. do k=1,nz ; do j=js,je ; do i=is,ie - h_prebound(i,j,k) = h(i,j,k) + h_prebound(i,j,k) = h(i,j,k) enddo ; enddo ; enddo if (CS%use_energetic_PBL) then @@ -1796,6 +1700,7 @@ subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, call diag_update_remap_grids(CS%diag) ! diagnostics + Idt = 1.0 / dt if ((CS%id_Tdif > 0) .or. (CS%id_Tadv > 0)) then do j=js,je ; do i=is,ie Tdif_flx(i,j,1) = 0.0 ; Tdif_flx(i,j,nz+1) = 0.0 @@ -1905,23 +1810,20 @@ subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, CS%optics, CS%tracer_flow_CSp, CS%debug,& evap_CFL_limit = CS%evap_CFL_limit, & minimum_forcing_depth = CS%minimum_forcing_depth) - else ! For passive tracers, the changes in thickness due to boundary fluxes has yet to be applied call call_tracer_column_fns(h_prebound, h, eatr, ebtr, fluxes, Hml, dt, G, GV, tv, & CS%optics, CS%tracer_flow_CSp, CS%debug, & evap_CFL_limit = CS%evap_CFL_limit, & minimum_forcing_depth = CS%minimum_forcing_depth) - endif ! (CS%mix_boundary_tracers) call cpu_clock_end(id_clock_tracers) - ! sponges + ! Apply ALE sponge if (CS%use_sponge) then call cpu_clock_begin(id_clock_sponge) if (associated(CS%ALE_sponge_CSp)) then - ! ALE sponge call apply_ALE_sponge(h, dt, G, GV, US, CS%ALE_sponge_CSp, CS%Time) endif @@ -1940,42 +1842,12 @@ subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, call create_group_pass(CS%pass_hold_eb_ea, ea_t, G%Domain, dir_flag, halo=1) call create_group_pass(CS%pass_hold_eb_ea, ea_s, G%Domain, dir_flag, halo=1) call do_group_pass(CS%pass_hold_eb_ea, G%Domain) - ! visc%Kv_shear and visc%Kv_slow are not in the group pass because it has larger vertical extent. - if (associated(visc%Kv_shear)) & - call pass_var(visc%Kv_shear, G%Domain, To_All+Omit_Corners, halo=1) + ! visc%Kv_slow is not in the group pass because it has larger vertical extent. if (associated(visc%Kv_slow)) & call pass_var(visc%Kv_slow, G%Domain, To_All+Omit_Corners, halo=1) - call cpu_clock_end(id_clock_pass) call disable_averaging(CS%diag) - ! Frazil formation keeps temperature above the freezing point. - ! make_frazil is deliberately called at both the beginning and at - ! the end of the diabatic processes. - if (associated(tv%T) .AND. associated(tv%frazil)) then - call enable_averaging(0.5*dt, Time_end, CS%diag) - if (CS%frazil_tendency_diag) then - do k=1,nz ; do j=js,je ; do i=is,ie - temp_diag(i,j,k) = tv%T(i,j,k) - enddo ; enddo ; enddo - endif - - if (associated(fluxes%p_surf_full)) then - call make_frazil(h, tv, G, GV, CS%diabatic_aux_CSp, fluxes%p_surf_full) - else - call make_frazil(h, tv, G, GV, CS%diabatic_aux_CSp) - endif - - if (CS%frazil_tendency_diag) then - call diagnose_frazil_tendency(tv, h, temp_diag, 0.5*dt, G, GV, CS) - if (CS%id_frazil_h > 0 ) call post_data(CS%id_frazil_h, h, CS%diag) - endif - - if (showCallTree) call callTree_waypoint("done with 2nd make_frazil (diabatic)") - if (CS%debugConservation) call MOM_state_stats('2nd make_frazil', u, v, h, tv%T, tv%S, G) - call disable_averaging(CS%diag) - - endif ! endif for frazil ! Diagnose the diapycnal diffusivities and other related quantities. call enable_averaging(dt, Time_end, CS%diag) @@ -1993,32 +1865,14 @@ subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, if (CS%id_dudt_dia > 0) call post_data(CS%id_dudt_dia, ADp%du_dt_dia, CS%diag) if (CS%id_dvdt_dia > 0) call post_data(CS%id_dvdt_dia, ADp%dv_dt_dia, CS%diag) - if (CS%id_MLD_003 > 0 .or. CS%id_subMLN2 > 0 .or. CS%id_mlotstsq > 0) then - call diagnoseMLDbyDensityDifference(CS%id_MLD_003, h, tv, 0.03, G, GV, US, CS%diag, & - id_N2subML=CS%id_subMLN2, id_MLDsq=CS%id_mlotstsq, dz_subML=CS%dz_subML_N2) - endif - if (CS%id_MLD_0125 > 0) then - call diagnoseMLDbyDensityDifference(CS%id_MLD_0125, h, tv, 0.125, G, GV, US, CS%diag) - endif - if (CS%id_MLD_user > 0) then - call diagnoseMLDbyDensityDifference(CS%id_MLD_user, h, tv, CS%MLDdensityDifference, G, GV, US, CS%diag) - endif - if (CS%id_Tdif > 0) call post_data(CS%id_Tdif, Tdif_flx, CS%diag) if (CS%id_Tadv > 0) call post_data(CS%id_Tadv, Tadv_flx, CS%diag) if (CS%id_Sdif > 0) call post_data(CS%id_Sdif, Sdif_flx, CS%diag) if (CS%id_Sadv > 0) call post_data(CS%id_Sadv, Sadv_flx, CS%diag) - if (CS%use_int_tides) then - if (CS%id_cg1 > 0) call post_data(CS%id_cg1, cn(:,:,1),CS%diag) - do m=1,CS%nMode - if (CS%id_cn(m) > 0) call post_data(CS%id_cn(m),cn(:,:,m),CS%diag) - enddo - endif call disable_averaging(CS%diag) - if (CS%debugConservation) call MOM_state_stats('leaving diabatic', u, v, h, tv%T, tv%S, G) - if (showCallTree) call callTree_leave("diabatic()") + if (showCallTree) call callTree_leave("diabatic_ALE()") end subroutine diabatic_ALE @@ -2063,8 +1917,6 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en cTKE, & ! convective TKE requirements for each layer [kg m-3 Z3 T-2 ~> J m-2]. u_h, & ! zonal and meridional velocities at thickness points after v_h ! entrainment [m s-1] - real, dimension(SZI_(G),SZJ_(G),CS%nMode) :: & - cn ! baroclinic gravity wave speeds real, dimension(SZI_(G),SZJ_(G)) :: & Rcv_ml, & ! coordinate density of mixed layer, used for applying sponges SkinBuoyFlux! 2d surface buoyancy flux [Z2 T-3 ~> m2 s-3], used by ePBL @@ -2072,7 +1924,6 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en real, dimension(SZI_(G),SZJ_(G),G%ke) :: temp_diag ! diagnostic array for temp real, dimension(SZI_(G),SZJ_(G),G%ke) :: saln_diag ! diagnostic array for salinity real, dimension(SZI_(G),SZJ_(G)) :: tendency_2d ! depth integrated content tendency for diagn - real, dimension(SZI_(G),SZJ_(G)) :: TKE_itidal_input_test ! override of energy input for testing (BDM) real :: net_ent ! The net of ea-eb at an interface. @@ -2087,7 +1938,6 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en Kd_heat, & ! diapycnal diffusivity of heat [Z2 T-1 ~> m2 s-1] Kd_salt, & ! diapycnal diffusivity of salt and passive tracers [Z2 T-1 ~> m2 s-1] Kd_ePBL, & ! test array of diapycnal diffusivities at interfaces [Z2 T-1 ~> m2 s-1] - eta, & ! Interface heights before diapycnal mixing [m]. Tdif_flx, & ! diffusive diapycnal heat flux across interfaces [degC m s-1] Tadv_flx, & ! advective diapycnal heat flux across interfaces [degC m s-1] Sdif_flx, & ! diffusive diapycnal salt flux across interfaces [ppt m s-1] @@ -2141,7 +1991,6 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en integer :: i, j, k, is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz, nkmb, m, halo integer :: ig, jg ! global indices for testing testing itide point source (BDM) - logical :: avg_enabled ! for testing internal tides (BDM) real :: Kd_add_here ! An added diffusivity [Z2 T-1 ~> m2 s-1]. is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke @@ -2151,78 +2000,15 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en Kd_heat(:,:,:) = 0.0 ; Kd_salt(:,:,:) = 0.0 - if (nz == 1) return showCallTree = callTree_showQuery() - if (showCallTree) call callTree_enter("diabatic(), MOM_diabatic_driver.F90") - - ! Offer diagnostics of various state varables at the start of diabatic - ! these are mostly for debugging purposes. - if (CS%id_u_predia > 0) call post_data(CS%id_u_predia, u, CS%diag) - if (CS%id_v_predia > 0) call post_data(CS%id_v_predia, v, CS%diag) - if (CS%id_h_predia > 0) call post_data(CS%id_h_predia, h, CS%diag) - if (CS%id_T_predia > 0) call post_data(CS%id_T_predia, tv%T, CS%diag) - if (CS%id_S_predia > 0) call post_data(CS%id_S_predia, tv%S, CS%diag) - if (CS%id_e_predia > 0) then - call find_eta(h, tv, G, GV, US, eta, eta_to_m=1.0) - call post_data(CS%id_e_predia, eta, CS%diag) - endif + if (showCallTree) call callTree_enter("legacy_diabatic(), MOM_diabatic_driver.F90") ! set equivalence between the same bits of memory for these arrays eaml => eatr ; ebml => ebtr - - ! inverse time step - if (dt == 0.0) call MOM_error(FATAL, "MOM_diabatic_driver: "// & - "legacy_diabatic was called with a zero length timestep.") - if (dt < 0.0) call MOM_error(FATAL, "MOM_diabatic_driver: "// & - "legacy_diabatic was called with a negative timestep.") - Idt = 1.0 / dt dt_in_T = dt * US%s_to_T - if (.not. associated(CS)) call MOM_error(FATAL, "MOM_diabatic_driver: "// & - "Module must be initialized before it is used.") - - if (CS%debug) then - call MOM_state_chksum("Start of diabatic ", u, v, h, G, GV, haloshift=0) - call MOM_forcing_chksum("Start of diabatic", fluxes, G, US, haloshift=0) - endif - if (CS%debugConservation) call MOM_state_stats('Start of diabatic', u, v, h, tv%T, tv%S, G) - - if (CS%debug_energy_req) & - call diapyc_energy_req_test(h, dt_in_T, tv, G, GV, US, CS%diapyc_en_rec_CSp) - - call cpu_clock_begin(id_clock_set_diffusivity) - call set_BBL_TKE(u, v, h, fluxes, visc, G, GV, US, CS%set_diff_CSp) - call cpu_clock_end(id_clock_set_diffusivity) - - ! Frazil formation keeps the temperature above the freezing point. - ! make_frazil is deliberately called at both the beginning and at - ! the end of the diabatic processes. - if (associated(tv%T) .AND. associated(tv%frazil)) then - ! For frazil diagnostic, the first call covers the first half of the time step - call enable_averaging(0.5*dt, Time_end - real_to_time(0.5*dt), CS%diag) - if (CS%frazil_tendency_diag) then - do k=1,nz ; do j=js,je ; do i=is,ie - temp_diag(i,j,k) = tv%T(i,j,k) - enddo ; enddo ; enddo - endif - - if (associated(fluxes%p_surf_full)) then - call make_frazil(h, tv, G, GV, CS%diabatic_aux_CSp, fluxes%p_surf_full, halo=CS%halo_TS_diff) - else - call make_frazil(h, tv, G, GV, CS%diabatic_aux_CSp, halo=CS%halo_TS_diff) - endif - if (showCallTree) call callTree_waypoint("done with 1st make_frazil (diabatic)") - - if (CS%frazil_tendency_diag) then - call diagnose_frazil_tendency(tv, h, temp_diag, 0.5*dt, G, GV, CS) - if (CS%id_frazil_h > 0) call post_data(CS%id_frazil_h, h, CS%diag) - endif - call disable_averaging(CS%diag) - endif ! associated(tv%T) .AND. associated(tv%frazil) - ! For all other diabatic subroutines, the averaging window should be the entire diabatic timestep call enable_averaging(dt, Time_end, CS%diag) - if (CS%debugConservation) call MOM_state_stats('1st make_frazil', u, v, h, tv%T, tv%S, G) if ((CS%ML_mix_first > 0.0) .or. CS%use_geothermal) then halo = CS%halo_TS_diff @@ -2247,13 +2033,10 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en ! Set_opacity estimates the optical properties of the water column. ! It will need to be modified later to include information about the ! biological properties and layer thicknesses. - if (associated(CS%optics)) & - call set_opacity(CS%optics, fluxes, G, GV, CS%opacity_CSp) + if (associated(CS%optics)) call set_opacity(CS%optics, fluxes, G, GV, CS%opacity_CSp) if (CS%bulkmixedlayer) then - if (CS%debug) then - call MOM_forcing_chksum("Before mixedlayer", fluxes, G, US, haloshift=0) - endif + if (CS%debug) call MOM_forcing_chksum("Before mixedlayer", fluxes, G, US, haloshift=0) if (CS%ML_mix_first > 0.0) then ! This subroutine @@ -2314,51 +2097,6 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en if (showCallTree) call callTree_waypoint("done with find_uv_at_h (diabatic)") endif - if (CS%use_int_tides) then - ! This block provides an interface for the unresolved low-mode internal - ! tide module (BDM). - - ! PROVIDE ENERGY DISTRIBUTION (calculate time-varying energy source) - call set_int_tide_input(u, v, h, tv, fluxes, CS%int_tide_input, dt, G, GV, US, & - CS%int_tide_input_CSp) - ! CALCULATE MODAL VELOCITIES - cn(:,:,:) = 0.0 - if (CS%uniform_cg) then - ! SET TO CONSTANT VALUE TO TEST PROPAGATE CODE - do m=1,CS%nMode ; cn(:,:,m) = CS%cg_test ; enddo - else - call wave_speeds(h, tv, G, GV, US, CS%nMode, cn, full_halos=.true.) - ! uncomment the lines below for a hard-coded cn that changes linearly with latitude - !do j=G%jsd,G%jed ; do i=G%isd,G%ied - ! cn(i,j,:) = ((7.-1.)/14000000.)*G%geoLatBu(i,j) + (1.-((7.-1.)/14000000.)*-7000000.) - !enddo ; enddo - endif - - if (CS%int_tide_source_test) then - ! BUILD 2D ARRAY WITH POINT SOURCE FOR TESTING - ! This block of code should be moved into set_int_tide_input. -RWH - TKE_itidal_input_test(:,:) = 0.0 - avg_enabled = query_averaging_enabled(CS%diag,time_end=CS%time_end) - if (CS%time_end <= CS%time_max_source) then - do j=G%jsc,G%jec ; do i=G%isc,G%iec - !INPUT ARBITRARY ENERGY POINT SOURCE - if ((G%idg_offset + i == CS%int_tide_source_x) .and. & - (G%jdg_offset + j == CS%int_tide_source_y)) then - TKE_itidal_input_test(i,j) = 1.0 - endif - enddo ; enddo - endif - ! CALL ROUTINE USING PRESCRIBED KE FOR TESTING - call propagate_int_tide(h, tv, cn, TKE_itidal_input_test, CS%int_tide_input%tideamp, & - CS%int_tide_input%Nb, dt, G, GV, US, CS%int_tide_CSp) - else - ! CALL ROUTINE USING CALCULATED KE INPUT - call propagate_int_tide(h, tv, cn, CS%int_tide_input%TKE_itidal_input, CS%int_tide_input%tideamp, & - CS%int_tide_input%Nb, dt, G, GV, US, CS%int_tide_CSp) - endif - if (showCallTree) call callTree_waypoint("done with propagate_int_tide (diabatic)") - endif ! end CS%use_int_tides - call cpu_clock_begin(id_clock_set_diffusivity) ! Sets: Kd_lay, Kd_int, visc%Kd_extra_T, visc%Kd_extra_S and visc%TKE_turb ! Also changes: visc%Kd_shear and visc%Kv_shear @@ -2800,6 +2538,7 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en call diag_update_remap_grids(CS%diag) ! diagnostics + Idt = 1.0 / dt if ((CS%id_Tdif > 0) .or. (CS%id_Tadv > 0)) then do j=js,je ; do i=is,ie Tdif_flx(i,j,1) = 0.0 ; Tdif_flx(i,j,nz+1) = 0.0 @@ -2987,9 +2726,6 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en call create_group_pass(CS%pass_hold_eb_ea, eb, G%Domain, dir_flag, halo=1) call create_group_pass(CS%pass_hold_eb_ea, ea, G%Domain, dir_flag, halo=1) call do_group_pass(CS%pass_hold_eb_ea, G%Domain) - ! visc%Kv_shear is not in the group pass because it has larger vertical extent. - if (associated(visc%Kv_shear)) & - call pass_var(visc%Kv_shear, G%Domain, To_All+Omit_Corners, halo=1) call cpu_clock_end(id_clock_pass) ! Use a tridiagonal solver to determine effect of the diapycnal @@ -3069,34 +2805,6 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en endif call disable_averaging(CS%diag) - ! Frazil formation keeps temperature above the freezing point. - ! make_frazil is deliberately called at both the beginning and at - ! the end of the diabatic processes. - if (associated(tv%T) .AND. associated(tv%frazil)) then - call enable_averaging(0.5*dt, Time_end, CS%diag) - if (CS%frazil_tendency_diag) then - do k=1,nz ; do j=js,je ; do i=is,ie - temp_diag(i,j,k) = tv%T(i,j,k) - enddo ; enddo ; enddo - endif - - if (associated(fluxes%p_surf_full)) then - call make_frazil(h, tv, G, GV, CS%diabatic_aux_CSp, fluxes%p_surf_full) - else - call make_frazil(h, tv, G, GV, CS%diabatic_aux_CSp) - endif - - if (CS%frazil_tendency_diag) then - call diagnose_frazil_tendency(tv, h, temp_diag, 0.5*dt, G, GV, CS) - if (CS%id_frazil_h > 0 ) call post_data(CS%id_frazil_h, h, CS%diag) - endif - - if (showCallTree) call callTree_waypoint("done with 2nd make_frazil (diabatic)") - if (CS%debugConservation) call MOM_state_stats('2nd make_frazil', u, v, h, tv%T, tv%S, G) - call disable_averaging(CS%diag) - - endif ! endif for frazil - ! Diagnose the diapycnal diffusivities and other related quantities. call enable_averaging(dt, Time_end, CS%diag) @@ -3112,32 +2820,14 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en if (CS%id_dvdt_dia > 0) call post_data(CS%id_dvdt_dia, ADp%dv_dt_dia, CS%diag) if (CS%id_wd > 0) call post_data(CS%id_wd, CDp%diapyc_vel, CS%diag) - if (CS%id_MLD_003 > 0 .or. CS%id_subMLN2 > 0 .or. CS%id_mlotstsq > 0) then - call diagnoseMLDbyDensityDifference(CS%id_MLD_003, h, tv, 0.03, G, GV, US, CS%diag, & - id_N2subML=CS%id_subMLN2, id_MLDsq=CS%id_mlotstsq, dz_subML=CS%dz_subML_N2) - endif - if (CS%id_MLD_0125 > 0) then - call diagnoseMLDbyDensityDifference(CS%id_MLD_0125, h, tv, 0.125, G, GV, US, CS%diag) - endif - if (CS%id_MLD_user > 0) then - call diagnoseMLDbyDensityDifference(CS%id_MLD_user, h, tv, CS%MLDdensityDifference, G, GV, US, CS%diag) - endif - if (CS%id_Tdif > 0) call post_data(CS%id_Tdif, Tdif_flx, CS%diag) if (CS%id_Tadv > 0) call post_data(CS%id_Tadv, Tadv_flx, CS%diag) if (CS%id_Sdif > 0) call post_data(CS%id_Sdif, Sdif_flx, CS%diag) if (CS%id_Sadv > 0) call post_data(CS%id_Sadv, Sadv_flx, CS%diag) - if (CS%use_int_tides) then - if (CS%id_cg1 > 0) call post_data(CS%id_cg1, cn(:,:,1),CS%diag) - do m=1,CS%nMode - if (CS%id_cn(m) > 0) call post_data(CS%id_cn(m),cn(:,:,m),CS%diag) - enddo - endif call disable_averaging(CS%diag) - if (CS%debugConservation) call MOM_state_stats('leaving diabatic', u, v, h, tv%T, tv%S, G) - if (showCallTree) call callTree_leave("diabatic()") + if (showCallTree) call callTree_leave("legacy_diabatic()") end subroutine legacy_diabatic From 2b36676747dcbd265fe906e7434a87e80b9dacd2 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Fri, 28 Jun 2019 16:44:37 -0400 Subject: [PATCH 51/82] +Offer ePBL LT diagnostics only when EPBL_LT=True Only offer Langmuir turblence diagnostics from the ePBL code only when Langmuir turbulence is being used. Also added code to avoid filling in these diagnostics with uninitialized variables even if they are not being written. All answers are bitwise identical, but this changes the entries in some available_diags files. --- .../vertical/MOM_energetic_PBL.F90 | 23 ++++++++++++------- 1 file changed, 15 insertions(+), 8 deletions(-) diff --git a/src/parameterizations/vertical/MOM_energetic_PBL.F90 b/src/parameterizations/vertical/MOM_energetic_PBL.F90 index 631e9d7144..4104d7d37a 100644 --- a/src/parameterizations/vertical/MOM_energetic_PBL.F90 +++ b/src/parameterizations/vertical/MOM_energetic_PBL.F90 @@ -1446,7 +1446,11 @@ subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, abs MLD_guess = 0.5*(min_MLD + max_MLD) endif enddo ! Iteration loop for converged boundary layer thickness. - eCD%LA = LA ; eCD%LAmod = LAmod ; eCD%mstar = mstar_total ; eCD%mstar_LT = mstar_LT + if (CS%Use_LT) then + eCD%LA = LA ; eCD%LAmod = LAmod ; eCD%mstar = mstar_total ; eCD%mstar_LT = mstar_LT + else + eCD%LA = 0.0 ; eCD%LAmod = 0.0 ; eCD%mstar = mstar_total ; eCD%mstar_LT = 0.0 + endif MLD_io = MLD_output @@ -1479,7 +1483,7 @@ subroutine find_PE_chg(Kddt_h0, dKddt_h, hp_a, hp_b, Th_a, Sh_a, Th_b, Sh_b, & !! above, including implicit mixing effects with other !! yet higher layers [degC H ~> degC m or degC kg m-2]. real, intent(in) :: Th_b !< An effective temperature times a thickness in the layer - !! below, including implicit mixing effects with other + !! below, including implicit mixfing effects with other !! yet lower layers [degC H ~> degC m or degC kg m-2]. real, intent(in) :: Sh_b !< An effective salinity times a thickness in the layer !! below, including implicit mixing effects with other @@ -2351,12 +2355,15 @@ subroutine energetic_PBL_init(Time, G, GV, US, param_file, diag, CS) Time, 'Velocity Scale that is used.', 'm s-1', conversion=US%Z_to_m*US%s_to_T) CS%id_MSTAR_mix = register_diag_field('ocean_model', 'MSTAR', diag%axesT1, & Time, 'Total mstar that is used.', 'nondim') - CS%id_LA = register_diag_field('ocean_model', 'LA', diag%axesT1, & - Time, 'Langmuir number.', 'nondim') - CS%id_LA_mod = register_diag_field('ocean_model', 'LA_MOD', diag%axesT1, & - Time, 'Modified Langmuir number.', 'nondim') - CS%id_MSTAR_LT = register_diag_field('ocean_model', 'MSTAR_LT', diag%axesT1, & - Time, 'Increase in mstar due to Langmuir Turbulence.', 'nondim') + + if (CS%use_LT) then + CS%id_LA = register_diag_field('ocean_model', 'LA', diag%axesT1, & + Time, 'Langmuir number.', 'nondim') + CS%id_LA_mod = register_diag_field('ocean_model', 'LA_MOD', diag%axesT1, & + Time, 'Modified Langmuir number.', 'nondim') + CS%id_MSTAR_LT = register_diag_field('ocean_model', 'MSTAR_LT', diag%axesT1, & + Time, 'Increase in mstar due to Langmuir Turbulence.', 'nondim') + endif call get_param(param_file, mdl, "ENABLE_THERMODYNAMICS", use_temperature, & "If true, temperature and salinity are used as state "//& From 10d9f0889b4557db3348e8ec495eb50e60f8e205 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Fri, 28 Jun 2019 18:44:51 -0400 Subject: [PATCH 52/82] +Merged diabatic_ALE code into diabatic_ALE_legacy Merged all of the substance of diabatic_ALE into diabatic_ALE_legacy, but with an internal switch to differentiate between the two algorithms. Also renamed legacy_diabatic as layered_diabatic. All answers are bitwise identical. --- .../vertical/MOM_diabatic_driver.F90 | 327 +++++++++++------- 1 file changed, 199 insertions(+), 128 deletions(-) diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index 1daddc32ec..277c3b104f 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -421,8 +421,8 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & call diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & G, GV, US, CS, Waves) else - call legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & - G, GV, US, CS, Waves) + call layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & + G, GV, US, CS, Waves) endif @@ -600,8 +600,8 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim Kd_heat(:,:,:) = 0.0 ; Kd_salt(:,:,:) = 0.0 showCallTree = callTree_showQuery() - if (showCallTree) call callTree_enter("diabatic_ALE(), MOM_diabatic_driver.F90") if (showCallTree) call callTree_enter("diabatic_ALE_legacy(), MOM_diabatic_driver.F90") +! if (showCallTree) call callTree_enter("diabatic_ALE(), MOM_diabatic_driver.F90") dt_in_T = dt * US%s_to_T @@ -650,33 +650,15 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim call cpu_clock_begin(id_clock_set_diffusivity) ! Sets: Kd_lay, Kd_int, visc%Kd_extra_T, visc%Kd_extra_S and visc%TKE_turb - ! Also changes: visc%Kd_shear and visc%Kv_shear + ! Also changes: visc%Kd_shear, visc%Kv_shear and visc%Kv_slow call set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, CS%optics, visc, dt, G, GV, US, & CS%set_diff_CSp, Kd_lay, Kd_int) call cpu_clock_end(id_clock_set_diffusivity) if (showCallTree) call callTree_waypoint("done with set_diffusivity (diabatic)") - if (CS%debug) then - call MOM_state_chksum("after set_diffusivity ", u, v, h, G, GV, haloshift=0) - call MOM_forcing_chksum("after set_diffusivity ", fluxes, G, US, haloshift=0) - call MOM_thermovar_chksum("after set_diffusivity ", tv, G) - call hchksum(Kd_Int, "after set_diffusivity Kd_Int", G%HI, haloshift=0, scale=US%Z2_T_to_m2_s) - endif - - - if (CS%useKPP) then - call cpu_clock_begin(id_clock_kpp) - ! KPP needs the surface buoyancy flux but does not update state variables. - ! We could make this call higher up to avoid a repeat unpacking of the surface fluxes. - ! Sets: CS%KPP_buoy_flux, CS%KPP_temp_flux, CS%KPP_salt_flux - ! NOTE: CS%KPP_buoy_flux, CS%KPP_temp_flux, CS%KPP_salt_flux are returned as rates (i.e. stuff per second) - ! unlike other instances where the fluxes are integrated in time over a time-step. - call calculateBuoyancyFlux2d(G, GV, US, fluxes, CS%optics, h, tv%T, tv%S, tv, & - CS%KPP_buoy_flux, CS%KPP_temp_flux, CS%KPP_salt_flux) - ! The KPP scheme calculates boundary layer diffusivities and non-local transport. - - ! Set diffusivities for heat and salt separately + ! Set diffusivities for heat and salt separately + if (.not.CS%use_legacy_diabatic .or. CS%useKPP) then !$OMP parallel do default(shared) do k=1,nz+1 ; do j=js,je ; do i=is,ie Kd_salt(i,j,k) = Kd_int(i,j,K) @@ -695,12 +677,35 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim Kd_heat(i,j,k) = Kd_heat(i,j,k) + visc%Kd_extra_T(i,j,k) enddo ; enddo ; enddo endif + endif - if (CS%debug) then - call hchksum(Kd_heat, "after set_diffusivity Kd_heat", G%HI, haloshift=0, scale=US%Z2_T_to_m2_s) - call hchksum(Kd_salt, "after set_diffusivity Kd_salt", G%HI, haloshift=0, scale=US%Z2_T_to_m2_s) + if (CS%debug) then + call MOM_state_chksum("after set_diffusivity ", u, v, h, G, GV, haloshift=0) + call MOM_forcing_chksum("after set_diffusivity ", fluxes, G, US, haloshift=0) + call MOM_thermovar_chksum("after set_diffusivity ", tv, G) + call hchksum(Kd_Int, "after set_diffusivity Kd_Int", G%HI, haloshift=0, scale=US%Z2_T_to_m2_s) + call hchksum(Kd_heat, "after set_diffusivity Kd_heat", G%HI, haloshift=0, scale=US%Z2_T_to_m2_s) + call hchksum(Kd_salt, "after set_diffusivity Kd_salt", G%HI, haloshift=0, scale=US%Z2_T_to_m2_s) + endif + + if (CS%useKPP) then + call cpu_clock_begin(id_clock_kpp) + ! total vertical viscosity in the interior is represented via visc%Kv_shear + if (.not.CS%use_legacy_diabatic) then + do k=1,nz+1 ; do j=js,je ; do i=is,ie + visc%Kv_shear(i,j,k) = visc%Kv_shear(i,j,k) + visc%Kv_slow(i,j,k) + enddo ; enddo ; enddo endif + ! KPP needs the surface buoyancy flux but does not update state variables. + ! We could make this call higher up to avoid a repeat unpacking of the surface fluxes. + ! Sets: CS%KPP_buoy_flux, CS%KPP_temp_flux, CS%KPP_salt_flux + ! NOTE: CS%KPP_buoy_flux, CS%KPP_temp_flux, CS%KPP_salt_flux are returned as rates (i.e. stuff per second) + ! unlike other instances where the fluxes are integrated in time over a time-step. + call calculateBuoyancyFlux2d(G, GV, US, fluxes, CS%optics, h, tv%T, tv%S, tv, & + CS%KPP_buoy_flux, CS%KPP_temp_flux, CS%KPP_salt_flux) + ! The KPP scheme calculates boundary layer diffusivities and non-local transport. + call KPP_compute_BLD(CS%KPP_CSp, G, GV, US, h, tv%T, tv%S, u, v, tv%eqn_of_state, & fluxes%ustar, CS%KPP_buoy_flux, Waves=Waves) @@ -716,7 +721,7 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim if (associated(visc%MLD)) visc%MLD(:,:) = Hml(:,:) endif - if (.not. CS%KPPisPassive) then + if (CS%use_legacy_diabatic .and. .not.CS%KPPisPassive) then !$OMP parallel do default(shared) do k=1,nz+1 ; do j=js,je ; do i=is,ie Kd_int(i,j,K) = min( Kd_salt(i,j,k), Kd_heat(i,j,k) ) @@ -747,15 +752,6 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim endif ! endif for KPP - ! Add vertical diff./visc. due to convection (computed via CVMix) - if (CS%use_CVMix_conv) then - call calculate_CVMix_conv(h, tv, G, GV, US, CS%CVMix_conv_csp, Hml) - - do K=1,nz+1 ; do j=js,je ; do i=is,ie - Kd_int(i,j,K) = Kd_int(i,j,K) + CS%CVMix_conv_csp%kd_conv(i,j,K) - visc%Kv_slow(i,j,K) = visc%Kv_slow(i,j,K) + CS%CVMix_conv_csp%kv_conv(i,j,K) - enddo ; enddo ; enddo - endif if (CS%useKPP) then call cpu_clock_begin(id_clock_kpp) @@ -782,7 +778,8 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim ! This is the "old" method for applying differential diffusion. ! Changes: tv%T, tv%S - if (associated(visc%Kd_extra_T) .and. associated(visc%Kd_extra_S) .and. associated(tv%T)) then + if (associated(visc%Kd_extra_T) .and. associated(visc%Kd_extra_S) .and. associated(tv%T) .and. & + (CS%use_legacy_diabatic .or. .not.CS%use_CVMix_ddiff)) then call cpu_clock_begin(id_clock_differential_diff) call differential_diffuse_T_S(h, tv, visc, dt_in_T, G, GV) @@ -803,26 +800,48 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim endif - ! This block sets ea, eb from Kd or Kd_int. - ! If using ALE algorithm, set ea=eb=Kd_int on interfaces for - ! use in the tri-diagonal solver. - ! Otherwise, call entrainment_diffusive() which sets ea and eb - ! based on KD and target densities (ie. does remapping as well). - do j=js,je ; do i=is,ie - ea_s(i,j,1) = 0. - enddo ; enddo - !$OMP parallel do default(shared) private(hval) - do k=2,nz ; do j=js,je ; do i=is,ie - hval=1.0/(h_neglect + 0.5*(h(i,j,k-1) + h(i,j,k))) - ea_s(i,j,k) = (GV%Z_to_H**2) * dt_in_T * hval * Kd_int(i,j,K) - eb_s(i,j,k-1) = ea_s(i,j,k) - ea_t(i,j,k-1) = ea_s(i,j,k-1) ; eb_t(i,j,k-1) = eb_s(i,j,k-1) - enddo ; enddo ; enddo - do j=js,je ; do i=is,ie - eb_s(i,j,nz) = 0. - ea_t(i,j,nz) = ea_s(i,j,nz) ; eb_t(i,j,nz) = eb_s(i,j,nz) - enddo ; enddo - if (showCallTree) call callTree_waypoint("done setting ea,eb from Kd_int (diabatic)") + ! Calculate vertical mixing due to convection (computed via CVMix) + if (CS%use_CVMix_conv) then + call calculate_CVMix_conv(h, tv, G, GV, US, CS%CVMix_conv_csp, Hml) + ! Increment vertical diffusion and viscosity due to convection + if (CS%use_legacy_diabatic) then + !$OMP parallel do default(shared) + do K=1,nz+1 ; do j=js,je ; do i=is,ie + Kd_int(i,j,K) = Kd_int(i,j,K) + CS%CVMix_conv_csp%kd_conv(i,j,K) + visc%Kv_slow(i,j,K) = visc%Kv_slow(i,j,K) + CS%CVMix_conv_csp%kv_conv(i,j,K) + enddo ; enddo ; enddo + else + !$OMP parallel do default(shared) + do K=1,nz+1 ; do j=js,je ; do i=is,ie + Kd_heat(i,j,K) = Kd_heat(i,j,K) + CS%CVMix_conv_csp%kd_conv(i,j,K) + Kd_salt(i,j,K) = Kd_salt(i,j,K) + CS%CVMix_conv_csp%kd_conv(i,j,K) + if (CS%useKPP) then + visc%Kv_shear(i,j,K) = visc%Kv_shear(i,j,K) + CS%CVMix_conv_csp%kv_conv(i,j,K) + else + visc%Kv_slow(i,j,K) = visc%Kv_slow(i,j,K) + CS%CVMix_conv_csp%kv_conv(i,j,K) + endif + enddo ; enddo ; enddo + endif + endif + + ! This block sets ea, eb from h and Kd_int. + if (CS%use_legacy_diabatic) then + do j=js,je ; do i=is,ie + ea_s(i,j,1) = 0.0 + enddo ; enddo + !$OMP parallel do default(shared) private(hval) + do k=2,nz ; do j=js,je ; do i=is,ie + hval=1.0/(h_neglect + 0.5*(h(i,j,k-1) + h(i,j,k))) + ea_s(i,j,k) = (GV%Z_to_H**2) * dt_in_T * hval * Kd_int(i,j,K) + eb_s(i,j,k-1) = ea_s(i,j,k) + ea_t(i,j,k-1) = ea_s(i,j,k-1) ; eb_t(i,j,k-1) = eb_s(i,j,k-1) + enddo ; enddo ; enddo + do j=js,je ; do i=is,ie + eb_s(i,j,nz) = 0.0 + ea_t(i,j,nz) = ea_s(i,j,nz) ; eb_t(i,j,nz) = eb_s(i,j,nz) + enddo ; enddo + if (showCallTree) call callTree_waypoint("done setting ea,eb from Kd_int (diabatic)") + endif if (CS%debug) then call MOM_forcing_chksum("after calc_entrain ", fluxes, G, US, haloshift=0) @@ -869,11 +888,14 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim call energetic_PBL(h, u_h, v_h, tv, fluxes, dt_in_T, Kd_ePBL, G, GV, US, & CS%energetic_PBL_CSp, dSV_dT, dSV_dS, cTKE, SkinBuoyFlux, waves=waves) - ! If visc%MLD exists, copy the ePBL's MLD into it - if (associated(visc%MLD)) then + if (associated(Hml)) then + call energetic_PBL_get_MLD(CS%energetic_PBL_CSp, Hml(:,:), G, US) + call pass_var(Hml, G%domain, halo=1) + ! If visc%MLD exists, copy ePBL's MLD into it + if (associated(visc%MLD)) visc%MLD(:,:) = Hml(:,:) + elseif (associated(visc%MLD)) then call energetic_PBL_get_MLD(CS%energetic_PBL_CSp, visc%MLD, G, US) call pass_var(visc%MLD, G%domain, halo=1) - Hml(:,:) = visc%MLD(:,:) endif ! Augment the diffusivities and viscosity due to those diagnosed in energetic_PBL. @@ -886,15 +908,21 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim Kd_add_here = max(Kd_ePBL(i,j,K) - visc%Kd_shear(i,j,K), 0.0) visc%Kv_shear(i,j,K) = max(visc%Kv_shear(i,j,K), Kd_ePBL(i,j,K)) endif - Ent_int = Kd_add_here * (GV%Z_to_H**2 * dt_in_T) / & - (0.5*(h(i,j,k-1) + h(i,j,k)) + h_neglect) - eb_s(i,j,k-1) = eb_s(i,j,k-1) + Ent_int - ea_s(i,j,k) = ea_s(i,j,k) + Ent_int - Kd_int(i,j,K) = Kd_int(i,j,K) + Kd_add_here - ! for diagnostics - Kd_heat(i,j,K) = Kd_heat(i,j,K) + Kd_int(i,j,K) - Kd_salt(i,j,K) = Kd_salt(i,j,K) + Kd_int(i,j,K) + if (CS%use_legacy_diabatic) then + Ent_int = Kd_add_here * (GV%Z_to_H**2 * dt_in_T) / & + (0.5*(h(i,j,k-1) + h(i,j,k)) + h_neglect) + eb_s(i,j,k-1) = eb_s(i,j,k-1) + Ent_int + ea_s(i,j,k) = ea_s(i,j,k) + Ent_int + Kd_int(i,j,K) = Kd_int(i,j,K) + Kd_add_here + + ! for diagnostics + Kd_heat(i,j,K) = Kd_heat(i,j,K) + Kd_int(i,j,K) + Kd_salt(i,j,K) = Kd_salt(i,j,K) + Kd_int(i,j,K) + else + Kd_heat(i,j,K) = Kd_heat(i,j,K) + Kd_add_here + Kd_salt(i,j,K) = Kd_salt(i,j,K) + Kd_add_here + endif enddo ; enddo ; enddo @@ -933,31 +961,30 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim ! Update h according to divergence of the difference between ! ea and eb. We keep a record of the original h in hold. - ! In the following, the checks for negative values are to guard - ! against instances where entrainment drives a layer to - ! negative thickness. This situation will never happen if - ! enough iterations are permitted in Calculate_Entrainment. - ! Even if too few iterations are allowed, it is still guarded - ! against. In other words the checks are probably unnecessary. - !$OMP parallel do default(shared) - do j=js,je - do i=is,ie - hold(i,j,1) = h(i,j,1) - h(i,j,1) = h(i,j,1) + (eb_s(i,j,1) - ea_s(i,j,2)) - hold(i,j,nz) = h(i,j,nz) - h(i,j,nz) = h(i,j,nz) + (ea_s(i,j,nz) - eb_s(i,j,nz-1)) - if (h(i,j,1) <= 0.0) h(i,j,1) = GV%Angstrom_H - if (h(i,j,nz) <= 0.0) h(i,j,nz) = GV%Angstrom_H + ! In the following, the checks for negative values are to guard against + ! instances where entrainment drives a layer to negative thickness. + ! ### THIS CODE IS PROBABLY UNCNECESSARY? + if (CS%use_legacy_diabatic) then + !$OMP parallel do default(shared) + do j=js,je + do i=is,ie + hold(i,j,1) = h(i,j,1) + h(i,j,1) = h(i,j,1) + (eb_s(i,j,1) - ea_s(i,j,2)) + hold(i,j,nz) = h(i,j,nz) + h(i,j,nz) = h(i,j,nz) + (ea_s(i,j,nz) - eb_s(i,j,nz-1)) + if (h(i,j,1) <= 0.0) h(i,j,1) = GV%Angstrom_H + if (h(i,j,nz) <= 0.0) h(i,j,nz) = GV%Angstrom_H + enddo + do k=2,nz-1 ; do i=is,ie + hold(i,j,k) = h(i,j,k) + h(i,j,k) = h(i,j,k) + ((ea_s(i,j,k) - eb_s(i,j,k-1)) + & + (eb_s(i,j,k) - ea_s(i,j,k+1))) + if (h(i,j,k) <= 0.0) h(i,j,k) = GV%Angstrom_H + enddo ; enddo enddo - do k=2,nz-1 ; do i=is,ie - hold(i,j,k) = h(i,j,k) - h(i,j,k) = h(i,j,k) + ((ea_s(i,j,k) - eb_s(i,j,k-1)) + & - (eb_s(i,j,k) - ea_s(i,j,k+1))) - if (h(i,j,k) <= 0.0) h(i,j,k) = GV%Angstrom_H - enddo ; enddo - enddo - ! Checks for negative thickness may have changed layer thicknesses - call diag_update_remap_grids(CS%diag) + ! Checks for negative thickness may have changed layer thicknesses + call diag_update_remap_grids(CS%diag) + endif if (CS%debug) then call MOM_state_chksum("after negative check ", u, v, h, G, GV, haloshift=0) @@ -994,24 +1021,54 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim enddo ; enddo ; enddo endif - ! Changes T and S via the tridiagonal solver; no change to h - do k=1,nz ; do j=js,je ; do i=is,ie - ea_t(i,j,k) = ea_s(i,j,k) ; eb_t(i,j,k) = eb_s(i,j,k) - enddo ; enddo ; enddo - if (CS%tracer_tridiag) then - call tracer_vertdiff(hold, ea_t, eb_t, dt, tv%T, G, GV) - call tracer_vertdiff(hold, ea_s, eb_s, dt, tv%S, G, GV) + if (CS%use_legacy_diabatic) then + ! Changes T and S via the tridiagonal solver; no change to h + do k=1,nz ; do j=js,je ; do i=is,ie + ea_t(i,j,k) = ea_s(i,j,k) ; eb_t(i,j,k) = eb_s(i,j,k) + enddo ; enddo ; enddo + if (CS%tracer_tridiag) then + call tracer_vertdiff(hold, ea_t, eb_t, dt, tv%T, G, GV) + call tracer_vertdiff(hold, ea_s, eb_s, dt, tv%S, G, GV) + else + call triDiagTS(G, GV, is, ie, js, je, hold, ea_s, eb_s, tv%T, tv%S) + endif + + ! diagnose temperature, salinity, heat, and salt tendencies + ! Note: hold here refers to the thicknesses from before the dual-entraintment when using + ! the bulk mixed layer scheme. Otherwise in ALE-mode, layer thicknesses will (not?) have changed + ! In either case, tendencies should be posted on hold + if (CS%diabatic_diff_tendency_diag) then + call diagnose_diabatic_diff_tendency(tv, hold, temp_diag, saln_diag, dt, G, GV, CS) + if (CS%id_diabatic_diff_h > 0) call post_data(CS%id_diabatic_diff_h, hold, CS%diag, alt_h = hold) + endif else - call triDiagTS(G, GV, is, ie, js, je, hold, ea_s, eb_s, tv%T, tv%S) - endif + ! Set ea_t=eb_t based on Kd_heat and ea_s=eb_s based on Kd_salt on interfaces for use in the tri-diagonal solver. - ! diagnose temperature, salinity, heat, and salt tendencies - ! Note: hold here refers to the thicknesses from before the dual-entraintment when using - ! the bulk mixed layer scheme. Otherwise in ALE-mode, layer thicknesses will (not?) have changed - ! In either case, tendencies should be posted on hold - if (CS%diabatic_diff_tendency_diag) then - call diagnose_diabatic_diff_tendency(tv, hold, temp_diag, saln_diag, dt, G, GV, CS) - if (CS%id_diabatic_diff_h > 0) call post_data(CS%id_diabatic_diff_h, hold, CS%diag, alt_h = hold) + do j=js,je ; do i=is,ie + ea_t(i,j,1) = 0.; ea_s(i,j,1) = 0. + enddo ; enddo + + !$OMP parallel do default(shared) private(hval) + do k=2,nz ; do j=js,je ; do i=is,ie + hval = 1.0 / (h_neglect + 0.5*(h(i,j,k-1) + h(i,j,k))) + ea_t(i,j,k) = (GV%Z_to_H**2) * dt_in_T * hval * Kd_heat(i,j,k) + eb_t(i,j,k-1) = ea_t(i,j,k) + ea_s(i,j,k) = (GV%Z_to_H**2) * dt_in_T * hval * Kd_salt(i,j,k) + eb_s(i,j,k-1) = ea_s(i,j,k) + enddo ; enddo ; enddo + do j=js,je ; do i=is,ie + eb_t(i,j,nz) = 0. ; eb_s(i,j,nz) = 0. + enddo ; enddo + if (showCallTree) call callTree_waypoint("done setting ea_t,ea_s,eb_t,eb_s from Kd_heat" //& + "and Kd_salt (diabatic)") + + ! Changes T and S via the tridiagonal solver; no change to h + call tracer_vertdiff(h, ea_t, eb_t, dt, tv%T, G, GV) + call tracer_vertdiff(h, ea_s, eb_s, dt, tv%S, G, GV) + + ! In ALE-mode, layer thicknesses do not change. Therefore, we can use h below + if (CS%diabatic_diff_tendency_diag) & + call diagnose_diabatic_diff_tendency(tv, h, temp_diag, saln_diag, dt, G, GV, CS) endif call cpu_clock_end(id_clock_tridiag) @@ -1104,9 +1161,14 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim endif if (associated(visc%Kd_extra_S)) then ; if (visc%Kd_extra_S(i,j,k) > 0.0) then - add_ent = ((dt_in_T * visc%Kd_extra_S(i,j,k)) * GV%Z_to_H**2) / & - (0.25 * ((h(i,j,k-1) + h(i,j,k)) + (hold(i,j,k-1) + hold(i,j,k))) + & - h_neglect) + if (CS%use_legacy_diabatic) then + add_ent = ((dt_in_T * visc%Kd_extra_S(i,j,k)) * GV%Z_to_H**2) / & + (0.25 * ((h(i,j,k-1) + h(i,j,k)) + (hold(i,j,k-1) + hold(i,j,k))) + h_neglect) + else + add_ent = ((dt_in_T * visc%Kd_extra_S(i,j,k)) * GV%Z_to_H**2) / & + (0.5 * (h(i,j,k-1) + h(i,j,k)) + & + h_neglect) + endif ebtr(i,j,k-1) = ebtr(i,j,k-1) + add_ent eatr(i,j,k) = eatr(i,j,k) + add_ent endif ; endif @@ -1130,9 +1192,14 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim !$OMP parallel do default(shared) private(add_ent) do k=nz,2,-1 ; do j=js,je ; do i=is,ie if (visc%Kd_extra_S(i,j,k) > 0.0) then - add_ent = ((dt_in_T * visc%Kd_extra_S(i,j,k)) * GV%Z_to_H**2) / & - (0.25 * ((h(i,j,k-1) + h(i,j,k)) + (hold(i,j,k-1) + hold(i,j,k))) + & - h_neglect) + if (CS%use_legacy_diabatic) then + add_ent = ((dt_in_T * visc%Kd_extra_S(i,j,k)) * GV%Z_to_H**2) / & + (0.25 * ((h(i,j,k-1) + h(i,j,k)) + (hold(i,j,k-1) + hold(i,j,k))) + h_neglect) + else + add_ent = ((dt_in_T * visc%Kd_extra_S(i,j,k)) * GV%Z_to_H**2) / & + (0.5 * (h(i,j,k-1) + h(i,j,k)) + & + h_neglect) + endif else add_ent = 0.0 endif @@ -1178,8 +1245,12 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim if (CS%id_Kd_salt > 0) call post_data(CS%id_Kd_salt, Kd_salt, CS%diag) if (CS%id_Kd_ePBL > 0) call post_data(CS%id_Kd_ePBL, Kd_ePBL, CS%diag) - if (CS%id_ea > 0) call post_data(CS%id_ea, ea_s, CS%diag) - if (CS%id_eb > 0) call post_data(CS%id_eb, eb_s, CS%diag) + if (CS%id_ea > 0) call post_data(CS%id_ea, ea_s, CS%diag) + if (CS%id_eb > 0) call post_data(CS%id_eb, eb_s, CS%diag) + if (CS%id_ea_t > 0) call post_data(CS%id_ea_t, ea_t, CS%diag) + if (CS%id_eb_t > 0) call post_data(CS%id_eb_t, eb_t, CS%diag) + if (CS%id_ea_s > 0) call post_data(CS%id_ea_s, ea_s, CS%diag) + if (CS%id_eb_s > 0) call post_data(CS%id_eb_s, eb_s, CS%diag) if (CS%id_dudt_dia > 0) call post_data(CS%id_dudt_dia, ADp%du_dt_dia, CS%diag) if (CS%id_dvdt_dia > 0) call post_data(CS%id_dvdt_dia, ADp%dv_dt_dia, CS%diag) @@ -1498,13 +1569,13 @@ subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, call calculate_CVMix_conv(h, tv, G, GV, US, CS%CVMix_conv_csp, Hml) ! Increment vertical diffusion and viscosity due to convection !$OMP parallel do default(shared) - do k=1,nz+1 ; do j=js,je ; do i=is,ie - Kd_heat(i,j,k) = Kd_heat(i,j,k) + CS%CVMix_conv_csp%kd_conv(i,j,k) - Kd_salt(i,j,k) = Kd_salt(i,j,k) + CS%CVMix_conv_csp%kd_conv(i,j,k) + do K=1,nz+1 ; do j=js,je ; do i=is,ie + Kd_heat(i,j,K) = Kd_heat(i,j,K) + CS%CVMix_conv_csp%kd_conv(i,j,K) + Kd_salt(i,j,K) = Kd_salt(i,j,K) + CS%CVMix_conv_csp%kd_conv(i,j,K) if (CS%useKPP) then - visc%Kv_shear(i,j,k) = visc%Kv_shear(i,j,k) + CS%CVMix_conv_csp%kv_conv(i,j,k) + visc%Kv_shear(i,j,K) = visc%Kv_shear(i,j,K) + CS%CVMix_conv_csp%kv_conv(i,j,K) else - visc%Kv_slow(i,j,k) = visc%Kv_slow(i,j,k) + CS%CVMix_conv_csp%kv_conv(i,j,k) + visc%Kv_slow(i,j,K) = visc%Kv_slow(i,j,K) + CS%CVMix_conv_csp%kv_conv(i,j,K) endif enddo ; enddo ; enddo endif @@ -1749,7 +1820,7 @@ subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, ! thicknesses, as this corresponds pretty closely (to within ! differences in the density jumps between layers) with what is done ! in the calculation of the fluxes in the first place. Kd_min_tr - ! should be much less than the values that have been set in Kd_lay, + ! should be much less than the values that have been set in Kd_int, ! perhaps a molecular diffusivity. add_ent = ((dt_in_T * CS%Kd_min_tr) * GV%Z_to_H**2) * & ((h(i,j,k-1)+h(i,j,k)+h_neglect) / & @@ -1878,8 +1949,8 @@ end subroutine diabatic_ALE !> Imposes the diapycnal mass fluxes and the accompanying diapycnal advection of momentum and tracers !! using the original MOM6 algorithms. -subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & - G, GV, US, CS, WAVES) +subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & + G, GV, US, CS, WAVES) type(ocean_grid_type), intent(inout) :: G !< ocean grid structure type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type @@ -2001,7 +2072,7 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en showCallTree = callTree_showQuery() - if (showCallTree) call callTree_enter("legacy_diabatic(), MOM_diabatic_driver.F90") + if (showCallTree) call callTree_enter("layered_diabatic(), MOM_diabatic_driver.F90") ! set equivalence between the same bits of memory for these arrays eaml => eatr ; ebml => ebtr @@ -2827,9 +2898,9 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en call disable_averaging(CS%diag) - if (showCallTree) call callTree_leave("legacy_diabatic()") + if (showCallTree) call callTree_leave("layered_diabatic()") -end subroutine legacy_diabatic +end subroutine layered_diabatic !> Returns pointers or values of members within the diabatic_CS type. For extensibility, !! each returned argument is an optional argument From a1323098ceb8da1c14ad1be78ffe55a68a3871da Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Fri, 28 Jun 2019 19:34:23 -0400 Subject: [PATCH 53/82] +Moved internal tide testing code Moved internal tide testing code into internal_tide_input. MOM_parameter_doc files would be changed in cases with INTERNAL_TIDES=True. All answers are bitwise identical. --- .../vertical/MOM_diabatic_driver.F90 | 93 +++---------------- .../vertical/MOM_internal_tide_input.F90 | 47 +++++++++- 2 files changed, 61 insertions(+), 79 deletions(-) diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index 277c3b104f..11c6810fa9 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -67,7 +67,6 @@ module MOM_diabatic_driver use MOM_variables, only : cont_diag_ptrs, MOM_thermovar_chksum, p3d use MOM_verticalGrid, only : verticalGrid_type use MOM_wave_speed, only : wave_speeds -use time_manager_mod, only : increment_time ! for testing itides (BDM) use MOM_wave_interface, only : wave_parameters_CS @@ -120,20 +119,8 @@ module MOM_diabatic_driver !! other diffusivities. Otherwise, the larger of kappa- !! shear and ePBL diffusivities are used. integer :: nMode = 1 !< Number of baroclinic modes to consider - logical :: int_tide_source_test !< If true, apply an arbitrary generation site - !! for internal tide testing (BDM) - real :: int_tide_source_x !< X Location of generation site - !! for internal tide for testing (BDM) - real :: int_tide_source_y !< Y Location of generation site - !! for internal tide for testing (BDM) - integer :: tlen_days !< Time interval from start for adding wave source - !! for testing internal tides (BDM) - logical :: uniform_cg !< If true, set cg = cg_test everywhere - !! for testing internal tides (BDM) - real :: cg_test !< Uniform group velocity of internal tide - !! for testing internal tides (BDM) - type(time_type) :: time_max_source !< For use in testing internal tides (BDM) - type(time_type) :: time_end !< For use in testing internal tides (BDM) + real :: uniform_test_cg !< Uniform group velocity of internal tide + !! for testing internal tides [m s-1] (BDM) logical :: useALEalgorithm !< If true, use the ALE algorithm rather than layered !! isopycnal/stacked shallow water mode. This logical !! passed by argument to diabatic_driver_init. @@ -294,12 +281,11 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1) :: & eta ! Interface heights before diapycnal mixing [m]. real, dimension(SZI_(G),SZJ_(G),CS%nMode) :: & - cn ! baroclinic gravity wave speeds + cn_IGW ! baroclinic internal gravity wave speeds real, dimension(SZI_(G),SZJ_(G),G%ke) :: temp_diag ! diagnostic array for temp real, dimension(SZI_(G),SZJ_(G)) :: TKE_itidal_input_test ! override of energy input for testing (BDM) real :: dt_in_T ! The time step converted to T units [T ~> s] integer :: i, j, k, m, is, ie, js, je, nz - logical :: avg_enabled ! for testing internal tides (BDM) logical :: showCallTree ! If true, show the call tree if (G%ke == 1) return @@ -371,45 +357,17 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & if (CS%use_int_tides) then ! This block provides an interface for the unresolved low-mode internal tide module (BDM). - - ! PROVIDE ENERGY DISTRIBUTION (calculate time-varying energy source) call set_int_tide_input(u, v, h, tv, fluxes, CS%int_tide_input, dt, G, GV, US, & CS%int_tide_input_CSp) - ! CALCULATE MODAL VELOCITIES - cn(:,:,:) = 0.0 - if (CS%uniform_cg) then - ! SET TO CONSTANT VALUE TO TEST PROPAGATE CODE - do m=1,CS%nMode ; cn(:,:,m) = CS%cg_test ; enddo - else - call wave_speeds(h, tv, G, GV, US, CS%nMode, cn, full_halos=.true.) - ! uncomment the lines below for a hard-coded cn that changes linearly with latitude - !do j=G%jsd,G%jed ; do i=G%isd,G%ied - ! cn(i,j,:) = ((7.-1.)/14000000.)*G%geoLatBu(i,j) + (1.-((7.-1.)/14000000.)*-7000000.) - !enddo ; enddo - endif - - if (CS%int_tide_source_test) then - ! BUILD 2D ARRAY WITH POINT SOURCE FOR TESTING - ! This block of code should be moved into set_int_tide_input. -RWH - TKE_itidal_input_test(:,:) = 0.0 - avg_enabled = query_averaging_enabled(CS%diag,time_end=CS%time_end) - if (CS%time_end <= CS%time_max_source) then - do j=G%jsc,G%jec ; do i=G%isc,G%iec - !INPUT ARBITRARY ENERGY POINT SOURCE - if ((G%idg_offset + i == CS%int_tide_source_x) .and. & - (G%jdg_offset + j == CS%int_tide_source_y)) then - TKE_itidal_input_test(i,j) = 1.0 - endif - enddo ; enddo - endif - ! CALL ROUTINE USING PRESCRIBED KE FOR TESTING - call propagate_int_tide(h, tv, cn, TKE_itidal_input_test, CS%int_tide_input%tideamp, & - CS%int_tide_input%Nb, dt, G, GV, US, CS%int_tide_CSp) + cn_IGW(:,:,:) = 0.0 + if (CS%uniform_test_cg > 0.0) then + do m=1,CS%nMode ; cn_IGW(:,:,m) = CS%uniform_test_cg ; enddo else - ! CALL ROUTINE USING CALCULATED KE INPUT - call propagate_int_tide(h, tv, cn, CS%int_tide_input%TKE_itidal_input, CS%int_tide_input%tideamp, & - CS%int_tide_input%Nb, dt, G, GV, US, CS%int_tide_CSp) + call wave_speeds(h, tv, G, GV, US, CS%nMode, cn_IGW, full_halos=.true.) endif + + call propagate_int_tide(h, tv, cn_IGW, CS%int_tide_input%TKE_itidal_input, CS%int_tide_input%tideamp, & + CS%int_tide_input%Nb, dt, G, GV, US, CS%int_tide_CSp) if (showCallTree) call callTree_waypoint("done with propagate_int_tide (diabatic)") endif ! end CS%use_int_tides @@ -475,8 +433,8 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & call diagnoseMLDbyDensityDifference(CS%id_MLD_user, h, tv, CS%MLDdensityDifference, G, GV, US, CS%diag) endif if (CS%use_int_tides) then - if (CS%id_cg1 > 0) call post_data(CS%id_cg1, cn(:,:,1),CS%diag) - do m=1,CS%nMode ; if (CS%id_cn(m) > 0) call post_data(CS%id_cn(m),cn(:,:,m),CS%diag) ; enddo + if (CS%id_cg1 > 0) call post_data(CS%id_cg1, cn_IGW(:,:,1),CS%diag) + do m=1,CS%nMode ; if (CS%id_cn(m) > 0) call post_data(CS%id_cn(m), cn_IGW(:,:,m), CS%diag) ; enddo endif call disable_averaging(CS%diag) @@ -3323,33 +3281,12 @@ subroutine diabatic_driver_init(Time, G, GV, US, param_file, useALEalgorithm, di "equations for the internal tide energy density.", default=.false.) CS%nMode = 1 if (CS%use_int_tides) then - ! SET NUMBER OF MODES TO CONSIDER call get_param(param_file, mdl, "INTERNAL_TIDE_MODES", CS%nMode, & "The number of distinct internal tide modes "//& "that will be calculated.", default=1, do_not_log=.true.) - - ! The following parameters are used in testing the internal tide code. - ! GET LOCATION AND DURATION OF ENERGY POINT SOURCE FOR TESTING (BDM) - call get_param(param_file, mdl, "INTERNAL_TIDE_SOURCE_TEST", CS%int_tide_source_test, & - "If true, apply an arbitrary generation site for internal tide testing", & - default=.false.) - if (CS%int_tide_source_test)then - call get_param(param_file, mdl, "INTERNAL_TIDE_SOURCE_X", CS%int_tide_source_x, & - "X Location of generation site for internal tide", default=1.) - call get_param(param_file, mdl, "INTERNAL_TIDE_SOURCE_Y", CS%int_tide_source_y, & - "Y Location of generation site for internal tide", default=1.) - call get_param(param_file, mdl, "INTERNAL_TIDE_SOURCE_TLEN_DAYS", CS%tlen_days, & - "Time interval from start of experiment for adding wave source", & - units="days", default=0) - CS%time_max_source = increment_time(Time,0,days=CS%tlen_days) - endif - ! GET UNIFORM MODE VELOCITY FOR TESTING (BDM) - call get_param(param_file, mdl, "UNIFORM_CG", CS%uniform_cg, & - "If true, set cg = cg_test everywhere for test case", default=.false.) - if (CS%uniform_cg)then - call get_param(param_file, mdl, "CG_TEST", CS%cg_test, & - "Uniform group velocity of internal tide for test case", default=1.) - endif + call get_param(param_file, mdl, "UNIFORM_TEST_CG", CS%uniform_test_cg, & + "If positive, a uniform group velocity of internal tide for test case", & + default=-1., units="m s-1") endif call get_param(param_file, mdl, "MASSLESS_MATCH_TARGETS", & diff --git a/src/parameterizations/vertical/MOM_internal_tide_input.F90 b/src/parameterizations/vertical/MOM_internal_tide_input.F90 index 6cc47ed5e2..9b5dea70ed 100644 --- a/src/parameterizations/vertical/MOM_internal_tide_input.F90 +++ b/src/parameterizations/vertical/MOM_internal_tide_input.F90 @@ -5,7 +5,7 @@ module MOM_int_tide_input use MOM_cpu_clock, only : cpu_clock_id, cpu_clock_begin, cpu_clock_end use MOM_cpu_clock, only : CLOCK_MODULE_DRIVER, CLOCK_MODULE, CLOCK_ROUTINE -use MOM_diag_mediator, only : diag_ctrl, time_type +use MOM_diag_mediator, only : diag_ctrl, query_averaging_enabled use MOM_diag_mediator, only : safe_alloc_ptr, post_data, register_diag_field use MOM_debugging, only : hchksum use MOM_error_handler, only : MOM_error, is_root_pe, FATAL, WARNING, NOTE @@ -14,6 +14,7 @@ module MOM_int_tide_input use MOM_grid, only : ocean_grid_type use MOM_io, only : slasher, vardesc, MOM_read_data use MOM_thickness_diffuse, only : vert_fill_TS +use MOM_time_manager, only : time_type, set_time, operator(+), operator(<=) use MOM_unit_scaling, only : unit_scale_type use MOM_variables, only : thermo_var_ptrs, vertvisc_type, p3d use MOM_verticalGrid, only : verticalGrid_type @@ -44,6 +45,15 @@ module MOM_int_tide_input !< The time-invariant field that enters the TKE_itidal input calculation [J m-2]. character(len=200) :: inputdir !< The directory for input files. + logical :: int_tide_source_test !< If true, apply an arbitrary generation site + !! for internal tide testing (BDM) + type(time_type) :: time_max_source !< A time for use in testing internal tides + real :: int_tide_source_x !< X Location of generation site + !! for internal tide for testing (BDM) + real :: int_tide_source_y !< Y Location of generation site + !! for internal tide for testing (BDM) + + !>@{ Diagnostic IDs integer :: id_TKE_itidal = -1, id_Nb = -1, id_N2_bot = -1 !!@} @@ -84,6 +94,10 @@ subroutine set_int_tide_input(u, v, h, tv, fluxes, itide, dt, G, GV, US, CS) ! the massless layers filled vertically by diffusion. logical :: use_EOS ! If true, density is calculated from T & S using an ! equation of state. + logical :: avg_enabled ! for testing internal tides (BDM) + type(time_type) :: time_end !< For use in testing internal tides (BDM) + + integer :: i, j, k, is, ie, js, je, nz integer :: isd, ied, jsd, jed @@ -109,6 +123,20 @@ subroutine set_int_tide_input(u, v, h, tv, fluxes, itide, dt, G, GV, US, CS) itide%TKE_itidal_input(i,j) = min(CS%TKE_itidal_coef(i,j)*itide%Nb(i,j), CS%TKE_itide_max) enddo ; enddo + if (CS%int_tide_source_test) then + itide%TKE_itidal_input(:,:) = 0.0 + avg_enabled = query_averaging_enabled(CS%diag, time_end=time_end) + if (time_end <= CS%time_max_source) then + do j=js,je ; do i=is,ie + ! Input an arbitrary energy point source. + if (((G%geoLonCu(I-1,j)-CS%int_tide_source_x) * (G%geoLonBu(I,j)-CS%int_tide_source_x) <= 0.0) .and. & + ((G%geoLatCv(i,J-1)-CS%int_tide_source_y) * (G%geoLatCv(i,j)-CS%int_tide_source_y) <= 0.0)) then + itide%TKE_itidal_input(i,j) = 1.0 + endif + enddo ; enddo + endif + endif + if (CS%debug) then call hchksum(N2_bot,"N2_bot",G%HI,haloshift=0) call hchksum(itide%TKE_itidal_input,"TKE_itidal_input",G%HI,haloshift=0) @@ -261,6 +289,8 @@ subroutine int_tide_input_init(Time, G, GV, US, param_file, diag, CS, itide) real :: kappa_h2_factor ! factor for the product of wavenumber * rms sgs height. real :: kappa_itides ! topographic wavenumber and non-dimensional scaling real :: min_zbot_itides ! Minimum ocean depth for internal tide conversion [Z ~> m]. + integer :: tlen_days !< Time interval from start for adding wave source + !! for testing internal tides (BDM) integer :: i, j, is, ie, js, je, isd, ied, jsd, jed if (associated(CS)) then @@ -340,6 +370,21 @@ subroutine int_tide_input_init(Time, G, GV, US, param_file, diag, CS, itide) call log_param(param_file, mdl, "INPUTDIR/H2_FILE", filename) call MOM_read_data(filename, 'h2', itide%h2, G%domain, timelevel=1, scale=US%m_to_Z**2) + ! The following parameters are used in testing the internal tide code. + call get_param(param_file, mdl, "INTERNAL_TIDE_SOURCE_TEST", CS%int_tide_source_test, & + "If true, apply an arbitrary generation site for internal tide testing", & + default=.false.) + if (CS%int_tide_source_test)then + call get_param(param_file, mdl, "INTERNAL_TIDE_SOURCE_X", CS%int_tide_source_x, & + "X Location of generation site for internal tide", default=1.) + call get_param(param_file, mdl, "INTERNAL_TIDE_SOURCE_Y", CS%int_tide_source_y, & + "Y Location of generation site for internal tide", default=1.) + call get_param(param_file, mdl, "INTERNAL_TIDE_SOURCE_TLEN_DAYS", tlen_days, & + "Time interval from start of experiment for adding wave source", & + units="days", default=0) + CS%time_max_source = Time + set_time(0, days=tlen_days) + endif + do j=js,je ; do i=is,ie mask_itidal = 1.0 if (G%bathyT(i,j) < min_zbot_itides) mask_itidal = 0.0 From 79e6902c639d6797cbd0e0dd65fb3793d21242bd Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sat, 29 Jun 2019 07:50:39 -0400 Subject: [PATCH 54/82] +Added new runtime option TIDAL_MIXING_2018_ANSWERS Added a new runtime parameter to enable the use of a more robust algorithm for the internal tide mixing lengths when the mean or bottom stratification are exceptionally small. Answers change very slightly in some test cases when TIDAL_MIXING_2018_ANSWERS is set to false. By default all answers are bitwise identical, but the MOM_parameter_doc.all files have a new entry. --- .../vertical/MOM_tidal_mixing.F90 | 117 ++++++++++++------ 1 file changed, 81 insertions(+), 36 deletions(-) diff --git a/src/parameterizations/vertical/MOM_tidal_mixing.F90 b/src/parameterizations/vertical/MOM_tidal_mixing.F90 index 1d07e0095d..45c2594078 100644 --- a/src/parameterizations/vertical/MOM_tidal_mixing.F90 +++ b/src/parameterizations/vertical/MOM_tidal_mixing.F90 @@ -159,6 +159,10 @@ module MOM_tidal_mixing !! TODO: make this E(x,y) only real, allocatable, dimension(:,:,:) :: tidal_qe_3d_in !< q*E(x,y,z) with the Schmittner parameterization [W m-3?] + logical :: answers_2018 !< If true, use the order of arithmetic and expressions that recover the + !! answers from the end of 2018. Otherwise, use updated and more robust + !! forms of the same expressions. + ! Diagnostics type(diag_ctrl), pointer :: diag => NULL() !< structure to regulate diagnostic output timing type(tidal_mixing_diags), pointer :: dd => NULL() !< A pointer to a structure of diagnostic arrays @@ -259,6 +263,11 @@ logical function tidal_mixing_init(Time, G, GV, US, param_file, diag, CS) tidal_mixing_init = CS%int_tide_dissipation if (.not. tidal_mixing_init) return + call get_param(param_file, mdl, "TIDAL_MIXING_2018_ANSWERS", CS%answers_2018, & + "If true, use the order of arithmetic and expressions that recover the "//& + "answers from the end of 2018. Otherwise, use updated and more robust "//& + "forms of the same expressions.", default=.true.) + if (CS%int_tide_dissipation) then ! Read in CVMix tidal scheme if CVMix tidal mixing is on @@ -453,11 +462,12 @@ logical function tidal_mixing_init(Time, G, GV, US, param_file, diag, CS) ! Restrict rms topo to 10 percent of column depth. !### Note the hard-coded nondimensional constant, and that this could be simplified. - hamp = min(0.1*G%bathyT(i,j),sqrt(CS%h2(i,j))) + hamp = min(0.1*G%bathyT(i,j), sqrt(CS%h2(i,j))) CS%h2(i,j) = hamp*hamp utide = CS%tideamp(i,j) - ! Compute the fixed part of internal tidal forcing; units are [kg Z3 m-3 T-2 ~> J m-2 = kg s-2] here. + ! Compute the fixed part of internal tidal forcing. + ! The units here are [kg Z3 m-3 T-2 ~> J m-2 = kg s-2] here. CS%TKE_itidal(i,j) = 0.5 * CS%kappa_h2_factor * GV%Rho0 * & CS%kappa_itides * CS%h2(i,j) * utide*utide enddo ; enddo @@ -978,6 +988,8 @@ subroutine add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, US, real :: frac_used ! fraction of TKE that can be used in a layer [nondim] real :: Izeta ! inverse of TKE decay scale [Z-1 ~> m-1]. real :: Izeta_lee ! inverse of TKE decay scale for lee waves [Z-1 ~> m-1]. + real :: z0Ps_num ! The numerator of the unlimited z0_Polzin_scaled [Z T-3 ~> m s-3]. + real :: z0Ps_denom ! The denominator of the unlimited z0_Polzin_scaled [T-3 ~> s-3]. real :: z0_psl ! temporary variable [Z ~> m]. real :: TKE_lowmode_tot ! TKE from all low modes [kg Z3 m-3 T-3 ~> W m-2] (BDM) @@ -1056,24 +1068,42 @@ subroutine add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, US, do i=is,ie CS%Nb(i,j) = sqrt(N2_bot(i)) - !### In the code below 1.0e-14 is a dimensional constant in [s-3] - if ((CS%tideamp(i,j) > 0.0) .and. & - (CS%kappa_itides**2 * CS%h2(i,j) * CS%Nb(i,j)**3 > 1.0e-14*US%T_to_s**3) ) then - z0_polzin(i) = CS%Polzin_decay_scale_factor * CS%Nu_Polzin * & - CS%Nbotref_Polzin**2 * CS%tideamp(i,j) / & - ( CS%kappa_itides**2 * CS%h2(i,j) * CS%Nb(i,j)**3 ) - if (z0_polzin(i) < CS%Polzin_min_decay_scale) & - z0_polzin(i) = CS%Polzin_min_decay_scale - if (N2_meanz(i) > 1.0e-14*US%T_to_s**2 ) then !### Here 1.0e-14 has dimensions of s-2. - z0_polzin_scaled(i) = z0_polzin(i)*CS%Nb(i,j)**2 / N2_meanz(i) + if (CS%answers_2018) then + if ((CS%tideamp(i,j) > 0.0) .and. & + (CS%kappa_itides**2 * CS%h2(i,j) * CS%Nb(i,j)**3 > 1.0e-14*US%T_to_s**3) ) then + z0_polzin(i) = CS%Polzin_decay_scale_factor * CS%Nu_Polzin * & + CS%Nbotref_Polzin**2 * CS%tideamp(i,j) / & + ( CS%kappa_itides**2 * CS%h2(i,j) * CS%Nb(i,j)**3 ) + if (z0_polzin(i) < CS%Polzin_min_decay_scale) & + z0_polzin(i) = CS%Polzin_min_decay_scale + if (N2_meanz(i) > 1.0e-14*US%T_to_s**2 ) then + z0_polzin_scaled(i) = z0_polzin(i)*CS%Nb(i,j)**2 / N2_meanz(i) + else + z0_polzin_scaled(i) = CS%Polzin_decay_scale_max_factor * htot(i) + endif + if (z0_polzin_scaled(i) > (CS%Polzin_decay_scale_max_factor * htot(i)) ) & + z0_polzin_scaled(i) = CS%Polzin_decay_scale_max_factor * htot(i) else + z0_polzin(i) = CS%Polzin_decay_scale_max_factor * htot(i) z0_polzin_scaled(i) = CS%Polzin_decay_scale_max_factor * htot(i) endif - if (z0_polzin_scaled(i) > (CS%Polzin_decay_scale_max_factor * htot(i)) ) & - z0_polzin_scaled(i) = CS%Polzin_decay_scale_max_factor * htot(i) else - z0_polzin(i) = CS%Polzin_decay_scale_max_factor * htot(i) - z0_polzin_scaled(i) = CS%Polzin_decay_scale_max_factor * htot(i) + z0Ps_num = (CS%Polzin_decay_scale_factor * CS%Nu_Polzin * CS%Nbotref_Polzin**2) * CS%tideamp(i,j) + z0Ps_denom = ( CS%kappa_itides**2 * CS%h2(i,j) * CS%Nb(i,j) * N2_meanz(i) ) + if ((CS%tideamp(i,j) > 0.0) .and. & + (z0Ps_num < z0Ps_denom * CS%Polzin_decay_scale_max_factor * htot(i))) then + z0_polzin_scaled(i) = z0Ps_num / z0Ps_denom + + if (abs(N2_meanz(i) * z0_polzin_scaled(i)) < & + CS%Nb(i,j)**2 * (CS%Polzin_decay_scale_max_factor * htot(i))) then + z0_polzin(i) = z0_polzin_scaled(i) * (N2_meanz(i) / CS%Nb(i,j)**2) + else + z0_polzin(i) = CS%Polzin_decay_scale_max_factor * htot(i) + endif + else + z0_polzin(i) = CS%Polzin_decay_scale_max_factor * htot(i) + z0_polzin_scaled(i) = CS%Polzin_decay_scale_max_factor * htot(i) + endif endif if (associated(dd%Polzin_decay_scale)) & @@ -1082,33 +1112,48 @@ subroutine add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, US, dd%Polzin_decay_scale_scaled(i,j) = z0_polzin_scaled(i) if (associated(dd%N2_bot)) dd%N2_bot(i,j) = CS%Nb(i,j)*CS%Nb(i,j) - if ( CS%Int_tide_dissipation .and. (CS%int_tide_profile == POLZIN_09) ) then - ! For the Polzin formulation, this if loop prevents the vertical - ! flux of energy dissipation from having NaN values - if (htot_WKB(i) > 1.0e-14*US%m_to_Z) then !### Avoid using this dimensional constant. - Inv_int(i) = ( z0_polzin_scaled(i) / htot_WKB(i) ) + 1.0 + if (CS%answers_2018) then + ! These expressions use dimensional constants to avoid NaN values. + if ( CS%Int_tide_dissipation .and. (CS%int_tide_profile == POLZIN_09) ) then + if (htot_WKB(i) > 1.0e-14*US%m_to_Z) & + Inv_int(i) = ( z0_polzin_scaled(i) / htot_WKB(i) ) + 1.0 endif - endif - if ( CS%lee_wave_dissipation .and. (CS%lee_wave_profile == POLZIN_09) ) then - ! For the Polzin formulation, this if loop prevents the vertical - ! flux of energy dissipation from having NaN values - if (htot_WKB(i) > 1.0e-14*US%m_to_Z) then !### Avoid using this dimensional constant. - Inv_int_lee(i) = ( z0_polzin_scaled(i)*CS%Decay_scale_factor_lee / htot_WKB(i) ) + 1.0 + if ( CS%lee_wave_dissipation .and. (CS%lee_wave_profile == POLZIN_09) ) then + if (htot_WKB(i) > 1.0e-14*US%m_to_Z) & + Inv_int_lee(i) = ( z0_polzin_scaled(i)*CS%Decay_scale_factor_lee / htot_WKB(i) ) + 1.0 endif - endif - if ( CS%Lowmode_itidal_dissipation .and. (CS%int_tide_profile == POLZIN_09) ) then - ! For the Polzin formulation, this if loop prevents the vertical - ! flux of energy dissipation from having NaN values - if (htot_WKB(i) > 1.0e-14*US%m_to_Z) then !### Avoid using this dimensional constant. - Inv_int_low(i) = ( z0_polzin_scaled(i) / htot_WKB(i) ) + 1.0 + if ( CS%Lowmode_itidal_dissipation .and. (CS%int_tide_profile == POLZIN_09) ) then + if (htot_WKB(i) > 1.0e-14*US%m_to_Z) & + Inv_int_low(i) = ( z0_polzin_scaled(i) / htot_WKB(i) ) + 1.0 + endif + else + ! These expressions give values of Inv_int < 10^14 using a variant of Adcroft's reciprocal rule. + Inv_int(i) = 0.0 ; Inv_int_lee(i) = 0.0 ; Inv_int_low(i) = 0.0 + if ( CS%Int_tide_dissipation .and. (CS%int_tide_profile == POLZIN_09) ) then + if (z0_polzin_scaled(i) < 1.0e14 * htot_WKB(i)) & + Inv_int(i) = ( z0_polzin_scaled(i) / htot_WKB(i) ) + 1.0 + endif + if ( CS%lee_wave_dissipation .and. (CS%lee_wave_profile == POLZIN_09) ) then + if (z0_polzin_scaled(i) < 1.0e14 * htot_WKB(i)) & + Inv_int_lee(i) = ( z0_polzin_scaled(i)*CS%Decay_scale_factor_lee / htot_WKB(i) ) + 1.0 + endif + if ( CS%Lowmode_itidal_dissipation .and. (CS%int_tide_profile == POLZIN_09) ) then + if (z0_polzin_scaled(i) < 1.0e14 * htot_WKB(i)) & + Inv_int_low(i) = ( z0_polzin_scaled(i) / htot_WKB(i) ) + 1.0 endif endif z_from_bot(i) = GV%H_to_Z*h(i,j,nz) ! Use the new formulation for WKB scaling. N2 is referenced to its vertical mean. - if (N2_meanz(i) > 1.0e-14*US%T_to_s**2 ) then !### Avoid using this dimensional constant. - z_from_bot_WKB(i) = GV%H_to_Z*h(i,j,nz) * N2_lay(i,nz) / N2_meanz(i) - else ; z_from_bot_WKB(i) = 0 ; endif + if (CS%answers_2018) then + if (N2_meanz(i) > 1.0e-14*US%T_to_s**2 ) then + z_from_bot_WKB(i) = GV%H_to_Z*h(i,j,nz) * N2_lay(i,nz) / N2_meanz(i) + else ; z_from_bot_WKB(i) = 0 ; endif + else + if (GV%H_to_Z*h(i,j,nz) * N2_lay(i,nz) < N2_meanz(i) * (1.0e14 * htot_WKB(i))) then + z_from_bot_WKB(i) = GV%H_to_Z*h(i,j,nz) * N2_lay(i,nz) / N2_meanz(i) + else ; z_from_bot_WKB(i) = 0 ; endif + endif enddo endif ! Polzin From f91b39cb5cd23c0d8b844d926d4d839f3a4b1ec5 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Mon, 1 Jul 2019 03:23:34 -0400 Subject: [PATCH 55/82] +Added runtime parameters for the bulk mixed layer Added four new runtime parameters, BUFFER_LAYER_HMIN_THICK, BUFFER_LAYER_HMIN_REL, BUFFER_LAY_DETRAIN_TIME, and BUFFER_SPLIT_RHO_TOL, replacing hard-coded values that control the detrainment from the buffer layer with the MOM_bulk_mixed_layer code. All answers are bitwise identical by default, but some of the MOM_parameter_doc files have some new entries. --- .../vertical/MOM_bulk_mixed_layer.F90 | 72 +++++++++++-------- 1 file changed, 44 insertions(+), 28 deletions(-) diff --git a/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 b/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 index 5e39ea8564..908eaf961d 100644 --- a/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 +++ b/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 @@ -62,12 +62,21 @@ module MOM_bulk_mixed_layer !! density contours. It should be a typical value of !! (dR/dS) / (dR/dT) in oceanic profiles. !! 6 degC ppt-1 might be reasonable. + real :: Hbuffer_min !< The minimum buffer layer thickness when the mixed layer + !! is very large [H ~> m or kg m-2]. + real :: Hbuffer_rel_min !< The minimum buffer layer thickness relative to the combined + !! mixed and buffer layer thicknesses when they are thin [nondim] + real :: BL_detrain_time !< A timescale that characterizes buffer layer detrainment + !! events [T ~> s]. real :: BL_extrap_lim !< A limit on the density range over which !! extrapolation can occur when detraining from the !! buffer layers, relative to the density range !! within the mixed and buffer layers, when the !! detrainment is going into the lightest interior - !! layer, nondimensional. + !! layer [nondim]. + real :: BL_split_rho_tol !< The fractional tolerance for matching layer target densities + !! when splitting layers to deal with massive interior layers + !! that are lighter than one of the mixed or buffer layers [nondim]. logical :: ML_resort !< If true, resort the layers by density, rather than !! doing convective adjustment. integer :: ML_presort_nz_conv_adj !< If ML_resort is true, do convective @@ -632,11 +641,11 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, US, C if (id_clock_detrain>0) call cpu_clock_begin(id_clock_detrain) if (CS%nkbl == 1) then call mixedlayer_detrain_1(h(:,0:), T(:,0:), S(:,0:), R0(:,0:), Rcv(:,0:), & - GV%Rlay, dt, dt__diag, d_ea, d_eb, j, G, GV, CS, & + GV%Rlay, dt, dt__diag, d_ea, d_eb, j, G, GV, US, CS, & dRcv_dT, dRcv_dS, max_BL_det) elseif (CS%nkbl == 2) then call mixedlayer_detrain_2(h(:,0:), T(:,0:), S(:,0:), R0(:,0:), Rcv(:,0:), & - GV%Rlay, dt, dt__diag, d_ea, j, G, GV, CS, & + GV%Rlay, dt, dt__diag, d_ea, j, G, GV, US, CS, & dR0_dT, dR0_dS, dRcv_dT, dRcv_dS, max_BL_det) else ! CS%nkbl not = 1 or 2 ! This code only works with 1 or 2 buffer layers. @@ -851,7 +860,7 @@ subroutine convective_adjustment(h, u, v, R0, Rcv, T, S, eps, d_eb, & real :: Ih ! The inverse of a thickness [H-1 ~> m-1 or m2 kg-1]. real :: g_H2_2Rho0 ! Half the gravitational acceleration times the square of ! the conversion from H to Z divided by the mean density, - ! in m7 s-2 Z-1 H-2 kg-1. !### CHECK UNITS + ! in [m5 Z s-2 H-2 kg-1 ~> m4 s-2 kg-1 or m10 s-2 kg-3]. integer :: is, ie, nz, i, k, k1, nzc, nkmb is = G%isc ; ie = G%iec ; nz = GV%ke @@ -1939,7 +1948,6 @@ subroutine resort_ML(h, T, S, R0, Rcv, RcvTgt, eps, d_ea, d_eb, ksort, G, GV, CS real :: h_move, h_tgt_old, I_hnew real :: dT_dS_wt2, dT_dR, dS_dR, I_denom real :: Rcv_int - real :: target_match_tol real :: T_up, S_up, R0_up, I_hup, h_to_up real :: T_dn, S_dn, R0_dn, I_hdn, h_to_dn real :: wt_dn @@ -1956,7 +1964,6 @@ subroutine resort_ML(h, T, S, R0, Rcv, RcvTgt, eps, d_ea, d_eb, ksort, G, GV, CS is = G%isc ; ie = G%iec ; nz = GV%ke nkmb = CS%nkml+CS%nkbl - target_match_tol = 0.1 ! ### MAKE THIS A PARAMETER. dT_dS_wt2 = CS%dT_dS_wt**2 @@ -2018,10 +2025,10 @@ subroutine resort_ML(h, T, S, R0, Rcv, RcvTgt, eps, d_ea, d_eb, ksort, G, GV, CS k = ks2(ks) leave_in_layer = .false. if ((k > nkmb) .and. (Rcv(i,k) <= RcvTgt(k))) then - if (RcvTgt(k)-Rcv(i,k) < target_match_tol*(RcvTgt(k) - RcvTgt(k-1))) & + if (RcvTgt(k)-Rcv(i,k) < CS%BL_split_rho_tol*(RcvTgt(k) - RcvTgt(k-1))) & leave_in_layer = .true. elseif (k > nkmb) then - if (Rcv(i,k)-RcvTgt(k) < target_match_tol*(RcvTgt(k+1) - RcvTgt(k))) & + if (Rcv(i,k)-RcvTgt(k) < CS%BL_split_rho_tol*(RcvTgt(k+1) - RcvTgt(k))) & leave_in_layer = .true. endif @@ -2199,7 +2206,7 @@ end subroutine resort_ML !> This subroutine moves any water left in the former mixed layers into the !! two buffer layers and may also move buffer layer water into the interior !! isopycnal layers. -subroutine mixedlayer_detrain_2(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, j, G, GV, CS, & +subroutine mixedlayer_detrain_2(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, j, G, GV, US, CS, & dR0_dT, dR0_dS, dRcv_dT, dRcv_dS, max_BL_det) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. @@ -2220,6 +2227,7 @@ subroutine mixedlayer_detrain_2(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, j, !! [H ~> m or kg m-2]. Positive d_ea !! goes with layer thickness increases. integer, intent(in) :: j !< The meridional row to work on. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(bulkmixedlayer_CS), pointer :: CS !< The control structure returned by a !! previous call to mixedlayer_init. real, dimension(SZI_(G)), intent(in) :: dR0_dT !< The partial derivative of @@ -2257,11 +2265,6 @@ subroutine mixedlayer_detrain_2(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, j, real :: S_to_bl ! The depth integrated amount of S that is detrained to the ! buffer layer [ppt H ~> ppt m or ppt kg m-2] real :: h_min_bl ! The minimum buffer layer thickness [H ~> m or kg m-2]. - real :: h_min_bl_thick ! The minimum buffer layer thickness when the - ! mixed layer is very large [H ~> m or kg m-2]. - real :: h_min_bl_frac_ml = 0.05 ! The minimum buffer layer thickness relative - ! to the total mixed layer thickness for thin - ! mixed layers [nondim], maybe 0.1/CS%nkbl. real :: h1, h2 ! Scalar variables holding the values of ! h(i,CS%nkml+1) and h(i,CS%nkml+2) [H ~> m or kg m-2]. @@ -2325,10 +2328,7 @@ subroutine mixedlayer_detrain_2(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, j, ! days? real :: num_events ! The number of detrainment events over which ! to prefer merging the buffer layers. - real :: detrainment_timescale ! The typical timescale for a detrainment - ! event [s]. - real :: dPE_time_ratio ! Larger of 1 and the detrainment_timescale - ! over dt, nondimensional. + real :: dPE_time_ratio ! Larger of 1 and the detrainment timescale over dt [nondim]. real :: dT_dS_gauge, dS_dT_gauge ! The relative scales of temperature and ! salinity changes in defining spiciness, in ! [degC ppt-1] and [ppt degC-1]. @@ -2370,15 +2370,13 @@ subroutine mixedlayer_detrain_2(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, j, Angstrom = GV%Angstrom_H ! This is hard coding of arbitrary and dimensional numbers. - h_min_bl_thick = 5.0 * GV%m_to_H !### DIMENSIONAL CONSTANT - dT_dS_gauge = CS%dT_dS_wt ; dS_dT_gauge = 1.0 /dT_dS_gauge + dT_dS_gauge = CS%dT_dS_wt ; dS_dT_gauge = 1.0 / dT_dS_gauge num_events = 10.0 - detrainment_timescale = 4.0*3600.0 !### DIMENSIONAL CONSTANT if (CS%nkbl /= 2) call MOM_error(FATAL, "MOM_mixed_layer"// & "CS%nkbl must be 2 in mixedlayer_detrain_2.") - if (dt < detrainment_timescale) then ; dPE_time_ratio = detrainment_timescale/dt + if (US%s_to_T*dt < CS%BL_detrain_time) then ; dPE_time_ratio = CS%BL_detrain_time / (US%s_to_T*dt) else ; dPE_time_ratio = 1.0 ; endif do i=is,ie @@ -2425,7 +2423,7 @@ subroutine mixedlayer_detrain_2(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, j, ! Determine whether more must be detrained from the mixed layer to keep a ! minimal amount of mass in the buffer layers. In this case the 5% of the ! mixed layer thickness is hard-coded, but probably shouldn't be! - h_min_bl = MIN(h_min_bl_thick,h_min_bl_frac_ml*h(i,0)) + h_min_bl = MIN(CS%Hbuffer_min, CS%Hbuffer_rel_min*h(i,0)) stable_Rcv = .true. if (((R0(i,kb2)-R0(i,kb1)) * (Rcv(i,kb2)-Rcv(i,kb1)) <= 0.0)) & @@ -3100,7 +3098,7 @@ end subroutine mixedlayer_detrain_2 !! single buffer layers and may also move buffer layer water into the interior !! isopycnal layers. subroutine mixedlayer_detrain_1(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, d_eb, & - j, G, GV, CS, dRcv_dT, dRcv_dS, max_BL_det) + j, G, GV, US, CS, dRcv_dT, dRcv_dS, max_BL_det) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. real, dimension(SZI_(G),SZK0_(GV)), intent(inout) :: h !< Layer thickness [H ~> m or kg m-2]. @@ -3125,6 +3123,7 @@ subroutine mixedlayer_detrain_1(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, d_e !! Positive values go with mass gain by !! a layer. integer, intent(in) :: j !< The meridional row to work on. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(bulkmixedlayer_CS), pointer :: CS !< The control structure returned by a !! previous call to mixedlayer_init. real, dimension(SZI_(G)), intent(in) :: dRcv_dT !< The partial derivative of @@ -3149,7 +3148,7 @@ subroutine mixedlayer_detrain_1(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, d_e real :: dT_dR, dS_dR, dRml, dR0_dRcv, dT_dS_wt2 real :: I_denom ! A work variable [ppt2 m6 kg-2]. real :: Sdown, Tdown - real :: dt_Time, Timescale = 86400.0*30.0! *365.0/12.0 + real :: dt_Time ! The timestep divided by the detrainment timescale [nondim]. real :: g_H2_2Rho0dt ! Half the gravitational acceleration times the square of the ! conversion from H to m divided by the mean density times the time ! step [m7 s-3 Z-1 H-2 kg-1 ~> m4 s-3 kg-1 or m10 s-3 kg-3]. @@ -3166,7 +3165,8 @@ subroutine mixedlayer_detrain_1(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, d_e if (CS%nkbl /= 1) call MOM_error(FATAL,"MOM_mixed_layer: "// & "CS%nkbl must be 1 in mixedlayer_detrain_1.") Idt = 1.0/dt - dt_Time = dt/Timescale + + dt_Time = US%s_to_T*dt / CS%BL_detrain_time g_H2_2Rho0dt = (GV%g_Earth * GV%H_to_Z**2) / (2.0 * GV%Rho0 * dt_diag) g_H2_2dt = (GV%g_Earth * GV%H_to_Z**2) / (2.0 * dt_diag) @@ -3257,7 +3257,6 @@ subroutine mixedlayer_detrain_1(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, d_e dT_dS_wt2 = CS%dT_dS_wt**2 -! dt_Time = dt/Timescale do k=nz-1,nkmb+1,-1 ; do i=is,ie if (splittable_BL(i)) then if (RcvTgt(k)<=Rcv(i,nkmb)) then @@ -3408,6 +3407,7 @@ subroutine bulkmixedlayer_init(Time, G, GV, US, param_file, diag, CS) ! This include declares and sets the variable "version". #include "version_variable.h" character(len=40) :: mdl = "MOM_mixed_layer" ! This module's name. + real :: BL_detrain_time_dflt ! The default value for BUFFER_LAY_DETRAIN_TIME [s] real :: omega_frac_dflt, ustar_min_dflt, Hmix_min_m integer :: isd, ied, jsd, jed logical :: use_temperature, use_omega @@ -3494,11 +3494,27 @@ subroutine bulkmixedlayer_init(Time, G, GV, US, param_file, diag, CS) "buffer layers, when the detrainment is going into the "//& "lightest interior layer, nondimensional, or a negative "//& "value not to apply this limit.", units="nondim", default = -1.0) + call get_param(param_file, mdl, "BUFFER_LAYER_HMIN_THICK", CS%Hbuffer_min, & + "The minimum buffer layer thickness when the mixed layer is very thick.", & + units="m", default=5.0, scale=GV%m_to_H) + call get_param(param_file, mdl, "BUFFER_LAYER_HMIN_REL", CS%Hbuffer_rel_min, & + "The minimum buffer layer thickness relative to the combined mixed "//& + "land buffer ayer thicknesses when they are thin.", & + units="nondim", default=0.1/CS%nkbl) + BL_detrain_time_dflt = 4.0*3600.0 ; if (CS%nkbl==1) BL_detrain_time_dflt = 86400.0*30.0 + call get_param(param_file, mdl, "BUFFER_LAY_DETRAIN_TIME", CS%BL_detrain_time, & + "A timescale that characterizes buffer layer detrainment events.", & + units="s", default=BL_detrain_time_dflt, scale=US%s_to_T) + call get_param(param_file, mdl, "BUFFER_SPLIT_RHO_TOL", CS%BL_split_rho_tol, & + "The fractional tolerance for matching layer target densities when splitting "//& + "layers to deal with massive interior layers that are lighter than one of the "//& + "mixed or buffer layers.", units="nondim", default=0.1) + call get_param(param_file, mdl, "DEPTH_LIMIT_FLUXES", CS%H_limit_fluxes, & "The surface fluxes are scaled away when the total ocean "//& "depth is less than DEPTH_LIMIT_FLUXES.", & units="m", default=0.1*Hmix_min_m, scale=GV%m_to_H) - call get_param(param_file, mdl, "OMEGA",CS%omega, & + call get_param(param_file, mdl, "OMEGA", CS%omega, & "The rotation rate of the earth.", units="s-1", & default=7.2921e-5) call get_param(param_file, mdl, "ML_USE_OMEGA", use_omega, & From 4343b7061ad71c7ce795e5798ccaffd4f49351ef Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 2 Jul 2019 17:39:36 -0400 Subject: [PATCH 56/82] +Rescaled the units of Waves%KvS Added rescaling for dimensional consistency to Waves%KvS and to the documented units for the dt argument to StokesMixing, which is not yet ready to be used or being called by the MOM6 code. All answers in the MOM6-examples test cases are bitwise identical. --- src/parameterizations/vertical/MOM_CVMix_KPP.F90 | 4 ++-- src/user/MOM_wave_interface.F90 | 8 ++++---- 2 files changed, 6 insertions(+), 6 deletions(-) diff --git a/src/parameterizations/vertical/MOM_CVMix_KPP.F90 b/src/parameterizations/vertical/MOM_CVMix_KPP.F90 index 22e69077fb..de37720a6a 100644 --- a/src/parameterizations/vertical/MOM_CVMix_KPP.F90 +++ b/src/parameterizations/vertical/MOM_CVMix_KPP.F90 @@ -831,14 +831,14 @@ subroutine KPP_calculate(CS, G, GV, US, h, uStar, & Kt(i,j,k) = Kt(i,j,k) + US%m2_s_to_Z2_T * Kdiffusivity(k,1) Ks(i,j,k) = Ks(i,j,k) + US%m2_s_to_Z2_T * Kdiffusivity(k,2) Kv(i,j,k) = Kv(i,j,k) + US%m2_s_to_Z2_T * Kviscosity(k) - if (CS%Stokes_Mixing) Waves%KvS(i,j,k) = US%Z_to_m**2*US%s_to_T * Kv(i,j,k) + if (CS%Stokes_Mixing) Waves%KvS(i,j,k) = Kv(i,j,k) enddo else ! KPP replaces prior diffusivity when former is non-zero do k=1, G%ke+1 if (Kdiffusivity(k,1) /= 0.) Kt(i,j,k) = US%m2_s_to_Z2_T * Kdiffusivity(k,1) if (Kdiffusivity(k,2) /= 0.) Ks(i,j,k) = US%m2_s_to_Z2_T * Kdiffusivity(k,2) if (Kviscosity(k) /= 0.) Kv(i,j,k) = US%m2_s_to_Z2_T * Kviscosity(k) - if (CS%Stokes_Mixing) Waves%KvS(i,j,k) = US%Z_to_m**2*US%s_to_T * Kv(i,j,k) + if (CS%Stokes_Mixing) Waves%KvS(i,j,k) = Kv(i,j,k) enddo endif endif diff --git a/src/user/MOM_wave_interface.F90 b/src/user/MOM_wave_interface.F90 index fd75171fb5..781a32f19c 100644 --- a/src/user/MOM_wave_interface.F90 +++ b/src/user/MOM_wave_interface.F90 @@ -104,7 +104,7 @@ module MOM_wave_interface !! Horizontal -> V points !! 3rd dimension -> Freq/Wavenumber real, allocatable, dimension(:,:,:), public :: & - KvS !< Viscosity for Stokes Drift shear [Z2/s ~> m2 s-1] + KvS !< Viscosity for Stokes Drift shear [Z2 T-1 ~> m2 s-1] ! Pointers to auxiliary fields type(time_type), pointer, public :: Time !< A pointer to the ocean model's clock. @@ -1205,12 +1205,12 @@ end subroutine DHH85_mid !> Explicit solver for Stokes mixing. !! Still in development do not use. -subroutine StokesMixing(G, GV, DT, h, u, v, Waves ) +subroutine StokesMixing(G, GV, dt, h, u, v, Waves ) type(ocean_grid_type), & intent(in) :: G !< Ocean grid type(verticalGrid_type), & intent(in) :: GV !< Ocean vertical grid - real, intent(in) :: Dt !< Time step of MOM6 [s] for explicit solver + real, intent(in) :: dt !< Time step of MOM6 [T ~> s] for explicit solver real, dimension(SZI_(G),SZJ_(G),SZK_(G)),& intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & @@ -1220,7 +1220,7 @@ subroutine StokesMixing(G, GV, DT, h, u, v, Waves ) type(Wave_parameters_CS), & pointer :: Waves !< Surface wave related control structure. ! Local variables - real :: dTauUp, dTauDn + real :: dTauUp, dTauDn ! Vertical momentum fluxes [Z T-1 m s-1] real :: h_Lay ! The layer thickness at a velocity point [Z ~> m]. integer :: i,j,k From 2e70663391f278880aa824daee0bc7589cf51726 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 2 Jul 2019 17:40:11 -0400 Subject: [PATCH 57/82] Dimensional consistency in MOM_bulk_mixed_layer Added dimensional rescaling in time in MOM_bulk_mixed_layer for all variables except for the arguments to external interfaces, members of external types or the external routines that are called from MOM_bulk_mixed_layer. All answers are bitwise identical. --- .../vertical/MOM_bulk_mixed_layer.F90 | 298 +++++++++--------- 1 file changed, 149 insertions(+), 149 deletions(-) diff --git a/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 b/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 index 908eaf961d..405e3b4292 100644 --- a/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 +++ b/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 @@ -52,9 +52,9 @@ module MOM_bulk_mixed_layer real :: H_limit_fluxes !< When the total ocean depth is less than this !! value [H ~> m or kg m-2], scale away all surface forcing to !! avoid boiling the ocean. - real :: ustar_min !< A minimum value of ustar to avoid numerical problems [Z s-1 ~> m s-1]. + real :: ustar_min !< A minimum value of ustar to avoid numerical problems [Z T-1 ~> m s-1]. !! If the value is small enough, this should not affect the solution. - real :: omega !< The Earth's rotation rate [s-1]. + real :: omega !< The Earth's rotation rate [T-1 ~> s-1]. real :: dT_dS_wt !< When forced to extrapolate T & S to match the !! layer densities, this factor (in degC / ppt) is !! combined with the derivatives of density with T & S @@ -119,7 +119,7 @@ module MOM_bulk_mixed_layer real :: Allowed_S_chg !< The amount by which salinity is allowed !! to exceed previous values during detrainment, ppt. - ! These are terms in the mixed layer TKE budget, all in [Z m2 s-3 ~> m3 s-3]. + ! These are terms in the mixed layer TKE budget, all in [Z m2 T-3 ~> m3 s-3] except as noted. real, allocatable, dimension(:,:) :: & ML_depth, & !< The mixed layer depth [H ~> m or kg m-2]. diag_TKE_wind, & !< The wind source of TKE. @@ -130,8 +130,10 @@ module MOM_bulk_mixed_layer diag_TKE_conv_decay, & !< The decay of convective TKE. diag_TKE_mixing, & !< The work done by TKE to deepen the mixed layer. diag_TKE_conv_s2, & !< The convective source of TKE due to to mixing in sigma2. - diag_PE_detrain, & !< The spurious source of potential energy due to mixed layer detrainment, W Z m-3. - diag_PE_detrain2 !< The spurious source of potential energy due to mixed layer only detrainment, W Z m-3. + diag_PE_detrain, & !< The spurious source of potential energy due to mixed layer + !! detrainment [kg T-3 Z m-1 ~> W m-2]. + diag_PE_detrain2 !< The spurious source of potential energy due to mixed layer only + !! detrainment [kg T-3 Z m-1 ~> W m-2]. logical :: allow_clocks_in_omp_loops !< If true, clocks can be called from inside loops that can !! be threaded. To run with multiple threads, set to False. type(group_pass_type) :: pass_h_sum_hmbl_prev !< For group halo pass @@ -261,9 +263,9 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, US, C h_miss ! The summed absolute mismatch [Z ~> m]. real, dimension(SZI_(G)) :: & TKE, & ! The turbulent kinetic energy available for mixing over a - ! time step [Z m2 s-2 ~> m3 s-2]. + ! time step [Z m2 T-2 ~> m3 s-2]. Conv_En, & ! The turbulent kinetic energy source due to mixing down to - ! the depth of free convection [Z m2 s-2 ~> m3 s-2]. + ! the depth of free convection [Z m2 T-2 ~> m3 s-2]. htot, & ! The total depth of the layers being considered for ! entrainment [H ~> m or kg m-2]. R0_tot, & ! The integrated potential density referenced to the surface @@ -298,8 +300,8 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, US, C ! salinity [kg m-3 ppt-1]. dRcv_dS, & ! Partial derivative of the coordinate variable potential ! density in the mixed layer with salinity [kg m-3 ppt-1]. - TKE_river ! The turbulent kinetic energy available for mixing at rivermouths over a - ! time step [Z m2 s-2 ~> m3 s-2]. + TKE_river ! The source of turbulent kinetic energy available for mixing + ! at rivermouths [Z m2 T-3 ~> m3 s-3]. real, dimension(max(CS%nsw,1),SZI_(G)) :: & Pen_SW_bnd ! The penetrating fraction of the shortwave heating integrated @@ -313,19 +315,18 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, US, C real :: Irho0 ! 1.0 / rho_0 [m3 kg-1] real :: Inkml, Inkmlm1! 1.0 / REAL(nkml) and 1.0 / REAL(nkml-1) real :: Ih ! The inverse of a thickness [H-1 ~> m-1 or m2 kg-1]. - real :: Idt ! The inverse of the timestep [s-1]. - real :: Idt_diag ! The inverse of the timestep used for diagnostics [s-1]. + real :: Idt_diag ! The inverse of the timestep used for diagnostics [T-1 ~> s-1]. real :: RmixConst real, dimension(SZI_(G)) :: & dKE_FC, & ! The change in mean kinetic energy due to free convection - ! [Z m2 s-2 ~> m3 s-2]. + ! [Z m2 T-2 ~> m3 s-2]. h_CA ! The depth to which convective adjustment has gone [H ~> m or kg m-2]. real, dimension(SZI_(G),SZK_(GV)) :: & dKE_CA, & ! The change in mean kinetic energy due to convective - ! adjustment [Z m2 s-2 ~> m3 s-2]. + ! adjustment [Z m2 T-2 ~> m3 s-2]. cTKE ! The turbulent kinetic energy source due to convective - ! adjustment [Z m2 s-2 ~> m3 s-2]. + ! adjustment [Z m2 T-2 ~> m3 s-2]. real, dimension(SZI_(G),SZJ_(G)) :: & Hsfc_max, & ! The thickness of the surface region (mixed and buffer layers) ! after entrainment but before any buffer layer detrainment [Z ~> m]. @@ -344,9 +345,10 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, US, C real :: dHsfc, dHD ! Local copies of nondimensional parameters. real :: H_nbr ! A minimum thickness based on neighboring thicknesses [H ~> m or kg m-2]. - real :: absf_x_H ! The absolute value of f times the mixed layer thickness [Z s-1 ~> m s-1]. - real :: kU_star ! Ustar times the Von Karmen constant [Z s-1 ~> m s-1]. - real :: dt__diag ! A copy of dt_diag (if present) or dt [s]. + real :: absf_x_H ! The absolute value of f times the mixed layer thickness [Z T-1 ~> m s-1]. + real :: kU_star ! Ustar times the Von Karmen constant [Z T-1 ~> m s-1]. + real :: dt_in_T ! Time increment in time units [T ~> s]. + real :: dt__diag ! A recaled copy of dt_diag (if present) or dt [T ~> s]. logical :: write_diags ! If true, write out diagnostics with this step. logical :: reset_diags ! If true, zero out the accumulated diagnostics. integer :: i, j, k, is, ie, js, je, nz, nkmb, n @@ -368,10 +370,11 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, US, C Inkml = 1.0 / REAL(CS%nkml) if (CS%nkml > 1) Inkmlm1 = 1.0 / REAL(CS%nkml-1) + dt_in_T = dt * US%s_to_T + Irho0 = 1.0 / GV%Rho0 - dt__diag = dt ; if (present(dt_diag)) dt__diag = dt_diag - Idt = 1.0 / dt - Idt_diag = 1.0 / dt__diag + dt__diag = dt_in_T ; if (present(dt_diag)) dt__diag = dt_diag * US%s_to_T + Idt_diag = 1.0 / (dt__diag) write_diags = .true. ; if (present(last_call)) write_diags = last_call p_ref(:) = 0.0 ; p_ref_cv(:) = tv%P_Ref @@ -403,7 +406,7 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, US, C ! Determine whether to zero out diagnostics before accumulation. reset_diags = .true. - if (present(dt_diag) .and. write_diags .and. (dt__diag > dt)) & + if (present(dt_diag) .and. write_diags .and. (dt__diag > dt_in_T)) & reset_diags = .false. ! This is the second call to mixedlayer. if (reset_diags) then @@ -482,7 +485,7 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, US, C if (id_clock_resort>0) call cpu_clock_begin(id_clock_resort) if (CS%ML_presort_nz_conv_adj > 0) & call convective_adjustment(h(:,1:), u, v, R0(:,1:), Rcv(:,1:), T(:,1:), & - S(:,1:), eps, d_eb, dKE_CA, cTKE, j, G, GV, CS, & + S(:,1:), eps, d_eb, dKE_CA, cTKE, j, G, GV, US, CS, & CS%ML_presort_nz_conv_adj) call sort_ML(h(:,1:), R0(:,1:), eps, G, GV, CS, ksort) @@ -495,7 +498,7 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, US, C ! to remove hydrostatic instabilities. Any water that is lighter than ! currently in the mixed or buffer layer is entrained. call convective_adjustment(h(:,1:), u, v, R0(:,1:), Rcv(:,1:), T(:,1:), & - S(:,1:), eps, d_eb, dKE_CA, cTKE, j, G, GV, CS) + S(:,1:), eps, d_eb, dKE_CA, cTKE, j, G, GV, US, CS) do i=is,ie ; h_CA(i) = h(i,1) ; enddo if (id_clock_adjustment>0) call cpu_clock_end(id_clock_adjustment) @@ -513,10 +516,10 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, US, C ! rivermix_depth = The prescribed depth over which to mix river inflow ! drho_ds = The gradient of density wrt salt at the ambient surface salinity. ! Sriver = 0 (i.e. rivers are assumed to be pure freshwater) - RmixConst = 0.5*CS%rivermix_depth * (GV%g_Earth*US%m_to_Z) * Irho0**2 + RmixConst = 0.5*CS%rivermix_depth * (US%T_to_s**2*GV%g_Earth*US%m_to_Z) * Irho0**2 do i=is,ie TKE_river(i) = max(0.0, RmixConst*dR0_dS(i)* & - (fluxes%lrunoff(i,j) + fluxes%frunoff(i,j)) * S(i,1)) + US%T_to_s*(fluxes%lrunoff(i,j) + fluxes%frunoff(i,j)) * S(i,1)) enddo else do i=is,ie ; TKE_river(i) = 0.0 ; enddo @@ -544,21 +547,21 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, US, C dR0_dT, dRcv_dT, dR0_dS, dRcv_dS, & netMassInOut, netMassOut, Net_heat, Net_salt, & nsw, Pen_SW_bnd, opacity_band, Conv_en, & - dKE_FC, j, ksort, G, GV, CS, tv, fluxes, dt, & + dKE_FC, j, ksort, G, GV, US, CS, tv, fluxes, dt_in_T, & aggregate_FW_forcing) if (id_clock_conv>0) call cpu_clock_end(id_clock_conv) ! Now the mixed layer undergoes mechanically forced entrainment. ! The mixed layer may entrain down to the Monin-Obukhov depth if the - ! surface is becoming lighter, and is effectively detraining. + ! surface is becoming lighter, and is effecti1336vely detraining. ! First the TKE at the depth of free convection that is available ! to drive mixing is calculated. if (id_clock_mech>0) call cpu_clock_begin(id_clock_mech) call find_starting_TKE(htot, h_CA, fluxes, Conv_En, cTKE, dKE_FC, dKE_CA, & - TKE, TKE_river, Idecay_len_TKE, cMKE, dt, Idt_diag, & + TKE, TKE_river, Idecay_len_TKE, cMKE, dt_in_T, Idt_diag, & j, ksort, G, GV, US, CS) ! Here the mechanically driven entrainment occurs. @@ -641,11 +644,11 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, US, C if (id_clock_detrain>0) call cpu_clock_begin(id_clock_detrain) if (CS%nkbl == 1) then call mixedlayer_detrain_1(h(:,0:), T(:,0:), S(:,0:), R0(:,0:), Rcv(:,0:), & - GV%Rlay, dt, dt__diag, d_ea, d_eb, j, G, GV, US, CS, & + GV%Rlay, dt_in_T, dt__diag, d_ea, d_eb, j, G, GV, US, CS, & dRcv_dT, dRcv_dS, max_BL_det) elseif (CS%nkbl == 2) then call mixedlayer_detrain_2(h(:,0:), T(:,0:), S(:,0:), R0(:,0:), Rcv(:,0:), & - GV%Rlay, dt, dt__diag, d_ea, j, G, GV, US, CS, & + GV%Rlay, dt_in_T, dt__diag, d_ea, j, G, GV, US, CS, & dR0_dT, dR0_dS, dRcv_dT, dRcv_dS, max_BL_det) else ! CS%nkbl not = 1 or 2 ! This code only works with 1 or 2 buffer layers. @@ -672,20 +675,19 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, US, C ! as the third piece will then optimally describe mixed layer ! restratification. For nkml>=4 the whole strategy should be revisited. do i=is,ie - kU_Star = 0.41*fluxes%ustar(i,j) ! Maybe could be replaced with u*+w*? + kU_star = 0.41*US%T_to_s*fluxes%ustar(i,j) ! Maybe could be replaced with u*+w*? if (associated(fluxes%ustar_shelf) .and. & associated(fluxes%frac_shelf_h)) then if (fluxes%frac_shelf_h(i,j) > 0.0) & - kU_Star = (1.0 - fluxes%frac_shelf_h(i,j)) * kU_star + & - fluxes%frac_shelf_h(i,j) * (0.41*fluxes%ustar_shelf(i,j)) + kU_star = (1.0 - fluxes%frac_shelf_h(i,j)) * kU_star + & + fluxes%frac_shelf_h(i,j) * (0.41*US%T_to_s*fluxes%ustar_shelf(i,j)) endif - absf_x_H = 0.25 * GV%H_to_Z * US%s_to_T * h(i,0) * & + absf_x_H = 0.25 * GV%H_to_Z * h(i,0) * & ((abs(G%CoriolisBu(I,J)) + abs(G%CoriolisBu(I-1,J-1))) + & (abs(G%CoriolisBu(I,J-1)) + abs(G%CoriolisBu(I-1,J)))) ! If the mixed layer vertical viscosity specification is changed in ! MOM_vert_friction.F90, this line will have to be modified accordingly. - h_3d(i,j,1) = h(i,0) / (3.0 + sqrt(absf_x_H*(absf_x_H + 2.0*kU_star) / & - (kU_star**2)) ) + h_3d(i,j,1) = h(i,0) / (3.0 + sqrt(absf_x_H*(absf_x_H + 2.0*kU_star) / kU_star**2)) do k=2,CS%nkml ! The other layers are evenly distributed through the mixed layer. h_3d(i,j,k) = (h(i,0)-h_3d(i,j,1)) * Inkmlm1 @@ -802,7 +804,7 @@ end subroutine bulkmixedlayer !! layers and mixed layers to remove hydrostatic instabilities. Any water that !! is lighter than currently in the mixed- or buffer- layer is entrained. subroutine convective_adjustment(h, u, v, R0, Rcv, T, S, eps, d_eb, & - dKE_CA, cTKE, j, G, GV, CS, nz_conv) + dKE_CA, cTKE, j, G, GV, US, CS, nz_conv) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. real, dimension(SZI_(G),SZK_(GV)), intent(inout) :: h !< Layer thickness [H ~> m or kg m-2]. @@ -825,11 +827,12 @@ subroutine convective_adjustment(h, u, v, R0, Rcv, T, S, eps, d_eb, & !! that will be left in each layer [H ~> m or kg m-2]. real, dimension(SZI_(G),SZK_(GV)), intent(out) :: dKE_CA !< The vertically integrated change in !! kinetic energy due to convective - !! adjustment [Z m2 s-2 ~> m3 s-2]. + !! adjustment [Z m2 T-2 ~> m3 s-2]. real, dimension(SZI_(G),SZK_(GV)), intent(out) :: cTKE !< The buoyant turbulent kinetic energy !! source due to convective adjustment - !! [Z m2 s-2 ~> m3 s-2]. + !! [Z m2 T-2 ~> m3 s-2]. integer, intent(in) :: j !< The j-index to work on. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(bulkmixedlayer_CS), pointer :: CS !< The control structure for this module. integer, optional, intent(in) :: nz_conv !< If present, the number of layers !! over which to do convective adjustment @@ -860,11 +863,11 @@ subroutine convective_adjustment(h, u, v, R0, Rcv, T, S, eps, d_eb, & real :: Ih ! The inverse of a thickness [H-1 ~> m-1 or m2 kg-1]. real :: g_H2_2Rho0 ! Half the gravitational acceleration times the square of ! the conversion from H to Z divided by the mean density, - ! in [m5 Z s-2 H-2 kg-1 ~> m4 s-2 kg-1 or m10 s-2 kg-3]. + ! in [m5 Z T-2 H-2 kg-1 ~> m4 s-2 kg-1 or m10 s-2 kg-3]. integer :: is, ie, nz, i, k, k1, nzc, nkmb is = G%isc ; ie = G%iec ; nz = GV%ke - g_H2_2Rho0 = (GV%g_Earth * GV%H_to_Z**2) / (2.0 * GV%Rho0) + g_H2_2Rho0 = (US%T_to_s**2*GV%g_Earth * GV%H_to_Z**2) / (2.0 * GV%Rho0) nzc = nz ; if (present(nz_conv)) nzc = nz_conv nkmb = CS%nkml+CS%nkbl @@ -914,7 +917,7 @@ subroutine convective_adjustment(h, u, v, R0, Rcv, T, S, eps, d_eb, & Ih = 1.0 / h(i,k1) R0(i,k1) = R0_tot(i) * Ih u(i,k1) = uhtot(i) * Ih ; v(i,k1) = vhtot(i) * Ih - dKE_CA(i,k1) = dKE_CA(i,k1) + GV%H_to_Z * (CS%bulk_Ri_convective * & + dKE_CA(i,k1) = dKE_CA(i,k1) + GV%H_to_Z * US%T_to_s**2*(CS%bulk_Ri_convective * & (KE_orig(i) - 0.5*h(i,k1)*(u(i,k1)**2 + v(i,k1)**2))) Rcv(i,k1) = Rcv_tot(i) * Ih T(i,k1) = Ttot(i) * Ih ; S(i,k1) = Stot(i) * Ih @@ -937,7 +940,7 @@ subroutine mixedlayer_convection(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & dR0_dT, dRcv_dT, dR0_dS, dRcv_dS, & netMassInOut, netMassOut, Net_heat, Net_salt, & nsw, Pen_SW_bnd, opacity_band, Conv_en, & - dKE_FC, j, ksort, G, GV, CS, tv, fluxes, dt, & + dKE_FC, j, ksort, G, GV, US, CS, tv, fluxes, dt_in_T, & aggregate_FW_forcing) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. @@ -1006,21 +1009,21 @@ subroutine mixedlayer_convection(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & !! shortwave radiation [H-1 ~> m-1 or m2 kg-1]. !! The indicies of opacity_band are band, i, k. real, dimension(SZI_(G)), intent(out) :: Conv_en !< The buoyant turbulent kinetic energy source - !! due to free convection [Z m2 s-2 ~> m3 s-2]. + !! due to free convection [Z m2 T-2 ~> m3 s-2]. real, dimension(SZI_(G)), intent(out) :: dKE_FC !< The vertically integrated change in kinetic - !! energy due to free convection [Z m2 s-2 ~> m3 s-2]. + !! energy due to free convection [Z m2 T-2 ~> m3 s-2]. integer, intent(in) :: j !< The j-index to work on. integer, dimension(SZI_(G),SZK_(GV)), & intent(in) :: ksort !< The density-sorted k-indices. - type(bulkmixedlayer_CS), pointer :: CS !< The control structure for this - !! module. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + type(bulkmixedlayer_CS), pointer :: CS !< The control structure for this module. type(thermo_var_ptrs), intent(inout) :: tv !< A structure containing pointers to any !! available thermodynamic fields. Absent !! fields have NULL ptrs. type(forcing), intent(inout) :: fluxes !< A structure containing pointers to any !! possible forcing fields. Unused fields !! have NULL ptrs. - real, intent(in) :: dt !< Time increment [s]. + real, intent(in) :: dt_in_T !< Time increment [T ~> s]. logical, intent(in) :: aggregate_FW_forcing !< If true, the net incoming and !! outgoing surface freshwater fluxes are !! combined before being applied, instead of @@ -1054,13 +1057,13 @@ subroutine mixedlayer_convection(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & ! h_ent between iterations [H ~> m or kg m-2]. real :: g_H2_2Rho0 ! Half the gravitational acceleration times the square of ! the conversion from H to Z divided by the mean density, - ! [m7 s-2 Z-1 H-2 kg-1 ~> m4 s-2 kg-1 or m10 s-2 kg-3]. + ! [m7 T-2 Z-1 H-2 kg-1 ~> m4 s-2 kg-1 or m10 s-2 kg-3]. real :: Angstrom ! The minimum layer thickness [H ~> m or kg m-2]. real :: opacity ! The opacity converted to inverse thickness units [H-1 ~> m-1 or m2 kg-1] real :: sum_Pen_En ! The potential energy change due to penetrating ! shortwave radiation, integrated over a layer ! [H kg m-3 ~> kg m-2 or kg2 m-5]. - real :: Idt ! 1.0/dt [s-1] + real :: Idt ! 1.0/dt [T-1 ~> s-1] real :: netHeatOut ! accumulated heat content of mass leaving ocean integer :: is, ie, nz, i, k, ks, itt, n real, dimension(max(nsw,1)) :: & @@ -1069,8 +1072,8 @@ subroutine mixedlayer_convection(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & Angstrom = GV%Angstrom_H C1_3 = 1.0/3.0 ; C1_6 = 1.0/6.0 - g_H2_2Rho0 = (GV%g_Earth * GV%H_to_Z**2) / (2.0 * GV%Rho0) - Idt = 1.0/dt + g_H2_2Rho0 = (US%T_to_s**2*GV%g_Earth * GV%H_to_Z**2) / (2.0 * GV%Rho0) + Idt = 1.0 / dt_in_T is = G%isc ; ie = G%iec ; nz = GV%ke do i=is,ie ; if (ksort(i,1) > 0) then @@ -1123,8 +1126,8 @@ subroutine mixedlayer_convection(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & dRcv_dS(i) * (netMassIn(i) * S(i,1) - Net_salt(i))) Conv_En(i) = 0.0 ; dKE_FC(i) = 0.0 if (associated(fluxes%heat_content_massin)) & - fluxes%heat_content_massin(i,j) = fluxes%heat_content_massin(i,j) & - + T_precip * netMassIn(i) * GV%H_to_kg_m2 * fluxes%C_p * Idt + fluxes%heat_content_massin(i,j) = fluxes%heat_content_massin(i,j) + US%s_to_T * & + T_precip * netMassIn(i) * GV%H_to_kg_m2 * fluxes%C_p * Idt if (associated(tv%TempxPmE)) tv%TempxPmE(i,j) = tv%TempxPmE(i,j) + & T_precip * netMassIn(i) * GV%H_to_kg_m2 endif ; enddo @@ -1175,9 +1178,9 @@ subroutine mixedlayer_convection(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & ! heat_content_massout = heat_content_massout - T(i,k)*h_evap*GV%H_to_kg_m2*fluxes%C_p*Idt ! by uncommenting the lines here. ! we will also then completely remove TempXpme from the model. - if (associated(fluxes%heat_content_massout)) & - fluxes%heat_content_massout(i,j) = fluxes%heat_content_massout(i,j) & - - T(i,k)*h_evap*GV%H_to_kg_m2 * fluxes%C_p * Idt + if (associated(fluxes%heat_content_massout)) & + fluxes%heat_content_massout(i,j) = fluxes%heat_content_massout(i,j) - US%s_to_T * & + T(i,k)*h_evap*GV%H_to_kg_m2 * fluxes%C_p * Idt if (associated(tv%TempxPmE)) tv%TempxPmE(i,j) = tv%TempxPmE(i,j) - & T(i,k)*h_evap*GV%H_to_kg_m2 @@ -1287,7 +1290,7 @@ subroutine mixedlayer_convection(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & if (htot(i) > 0.0) & dKE_FC(i) = dKE_FC(i) + CS%bulk_Ri_convective * 0.5 * & ((GV%H_to_Z*h_ent) / (htot(i)*(h_ent+htot(i)))) * & - ((uhtot(i)-u(i,k)*htot(i))**2 + (vhtot(i)-v(i,k)*htot(i))**2) + US%T_to_s**2*((uhtot(i)-u(i,k)*htot(i))**2 + (vhtot(i)-v(i,k)*htot(i))**2) htot(i) = htot(i) + h_ent h(i,k) = h(i,k) - h_ent @@ -1305,7 +1308,7 @@ end subroutine mixedlayer_convection !> This subroutine determines the TKE available at the depth of free !! convection to drive mechanical entrainment. subroutine find_starting_TKE(htot, h_CA, fluxes, Conv_En, cTKE, dKE_FC, dKE_CA, & - TKE, TKE_river, Idecay_len_TKE, cMKE, dt, Idt_diag, & + TKE, TKE_river, Idecay_len_TKE, cMKE, dt_in_T, Idt_diag, & j, ksort, G, GV, US, CS) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. @@ -1318,31 +1321,31 @@ subroutine find_starting_TKE(htot, h_CA, fluxes, Conv_En, cTKE, dKE_FC, dKE_CA, !! possible forcing fields. Unused fields !! have NULL ptrs. real, dimension(SZI_(G)), intent(inout) :: Conv_En !< The buoyant turbulent kinetic energy source - !! due to free convection [Z m2 s-2 ~> m3 s-2]. + !! due to free convection [Z m2 T-2 ~> m3 s-2]. real, dimension(SZI_(G)), intent(in) :: dKE_FC !< The vertically integrated change in !! kinetic energy due to free convection - !! [Z m2 s-2 ~> m3 s-2]. + !! [Z m2 T-2 ~> m3 s-2]. real, dimension(SZI_(G),SZK_(GV)), & intent(in) :: cTKE !< The buoyant turbulent kinetic energy !! source due to convective adjustment - !! [Z m2 s-2 ~> m3 s-2]. + !! [Z m2 T-2 ~> m3 s-2]. real, dimension(SZI_(G),SZK_(GV)), & intent(in) :: dKE_CA !< The vertically integrated change in !! kinetic energy due to convective - !! adjustment [Z m2 s-2 ~> m3 s-2]. + !! adjustment [Z m2 T-2 ~> m3 s-2]. real, dimension(SZI_(G)), intent(out) :: TKE !< The turbulent kinetic energy available for - !! mixing over a time step [Z m2 s-2 ~> m3 s-2]. + !! mixing over a time step [Z m2 T-2 ~> m3 s-2]. real, dimension(SZI_(G)), intent(out) :: Idecay_len_TKE !< The inverse of the vertical decay !! scale for TKE [H-1 ~> m-1 or m2 kg-1]. - real, dimension(SZI_(G)), intent(in) :: TKE_river !< The turbulent kinetic energy available - !! for driving mixing at river mouths - !! integrated over a time step [Z m2 s-2 ~> m3 s-2]. + real, dimension(SZI_(G)), intent(in) :: TKE_river !< The source of turbulent kinetic energy + !! available for driving mixing at river mouths + !! [Z m2 T-3 ~> m3 s-3]. real, dimension(2,SZI_(G)), intent(out) :: cMKE !< Coefficients of HpE and HpE^2 in !! calculating the denominator of MKE_rate, !! [H-1 ~> m-1 or m2 kg-1] and [H-2 ~> m-2 or m4 kg-2]. - real, intent(in) :: dt !< The time step [s]. + real, intent(in) :: dt_in_T !< The time step [T ~> s]. real, intent(in) :: Idt_diag !< The inverse of the accumulated diagnostic - !! time interval [s-1]. + !! time interval [T-1 ~> s-1]. integer, intent(in) :: j !< The j-index to work on. integer, dimension(SZI_(G),SZK_(GV)), & intent(in) :: ksort !< The density-sorted k-indicies. @@ -1352,46 +1355,46 @@ subroutine find_starting_TKE(htot, h_CA, fluxes, Conv_En, cTKE, dKE_FC, dKE_CA, ! convection to drive mechanical entrainment. ! Local variables - real :: dKE_conv ! The change in mean kinetic energy due to all convection [Z m2 s-2 ~> m3 s-2]. + real :: dKE_conv ! The change in mean kinetic energy due to all convection [Z m2 T-2 ~> m3 s-2]. real :: nstar_FC ! The effective efficiency with which the energy released by ! free convection is converted to TKE, often ~0.2 [nondim]. real :: nstar_CA ! The effective efficiency with which the energy released by ! convective adjustment is converted to TKE, often ~0.2 [nondim]. real :: TKE_CA ! The potential energy released by convective adjustment if - ! that release is positive [Z m2 s-2 ~> m3 s-2]. + ! that release is positive [Z m2 T-2 ~> m3 s-2]. real :: MKE_rate_CA ! MKE_rate for convective adjustment [nondim], 0 to 1. real :: MKE_rate_FC ! MKE_rate for free convection [nondim], 0 to 1. - real :: totEn_Z ! The total potential energy released by convection, [Z3 s-2 ~> m3 s-2]. + real :: totEn_Z ! The total potential energy released by convection, [Z3 T-2 ~> m3 s-2]. real :: Ih ! The inverse of a thickness [H-1 ~> m-1 or m2 kg-1]. real :: exp_kh ! The nondimensional decay of TKE across a layer [nondim]. - real :: absf ! The absolute value of f averaged to thickness points [s-1]. - real :: U_star ! The friction velocity [Z s-1 ~> m s-1]. + real :: absf ! The absolute value of f averaged to thickness points [T-1 ~> s-1]. + real :: U_star ! The friction velocity [Z T-1 ~> m s-1]. real :: absf_Ustar ! The absolute value of f divided by U_star [Z-1 ~> m-1]. - real :: wind_TKE_src ! The surface wind source of TKE [Z m2 s-3 ~> m3 s-3]. + real :: wind_TKE_src ! The surface wind source of TKE [Z m2 T-3 ~> m3 s-3]. real :: diag_wt ! The ratio of the current timestep to the diagnostic ! timestep (which may include 2 calls) [nondim]. integer :: is, ie, nz, i is = G%isc ; ie = G%iec ; nz = GV%ke - diag_wt = dt * Idt_diag + diag_wt = dt_in_T * Idt_diag if (CS%omega_frac >= 1.0) absf = 2.0*CS%omega do i=is,ie - U_Star = fluxes%ustar(i,j) + U_star = US%T_to_s*fluxes%ustar(i,j) if (associated(fluxes%ustar_shelf) .and. associated(fluxes%frac_shelf_h)) then if (fluxes%frac_shelf_h(i,j) > 0.0) & - U_Star = (1.0 - fluxes%frac_shelf_h(i,j)) * U_star + & - fluxes%frac_shelf_h(i,j) * fluxes%ustar_shelf(i,j) + U_star = (1.0 - fluxes%frac_shelf_h(i,j)) * U_star + & + fluxes%frac_shelf_h(i,j) * US%T_to_s*fluxes%ustar_shelf(i,j) endif - if (U_Star < CS%ustar_min) U_Star = CS%ustar_min + if (U_star < CS%ustar_min) U_star = CS%ustar_min if (CS%omega_frac < 1.0) then - absf = 0.25*US%s_to_T*((abs(G%CoriolisBu(I,J)) + abs(G%CoriolisBu(I-1,J-1))) + & - (abs(G%CoriolisBu(I,J-1)) + abs(G%CoriolisBu(I-1,J)))) + absf = 0.25*((abs(G%CoriolisBu(I,J)) + abs(G%CoriolisBu(I-1,J-1))) + & + (abs(G%CoriolisBu(I,J-1)) + abs(G%CoriolisBu(I-1,J)))) if (CS%omega_frac > 0.0) & absf = sqrt(CS%omega_frac*4.0*CS%omega**2 + (1.0-CS%omega_frac)*absf**2) endif - absf_Ustar = absf / U_Star + absf_Ustar = absf / U_star Idecay_len_TKE(i) = (absf_Ustar * CS%TKE_decay) * GV%H_to_Z ! The first number in the denominator could be anywhere up to 16. The @@ -1404,7 +1407,7 @@ subroutine find_starting_TKE(htot, h_CA, fluxes, Conv_En, cTKE, dKE_FC, dKE_CA, ! scales contribute to mixed layer deepening at similar rates, even though ! small scales are dissipated more rapidly (implying they are less efficient). ! Ih = 1.0/(16.0*0.41*U_star*dt) - Ih = GV%H_to_Z/(3.0*0.41*U_star*dt) + Ih = GV%H_to_Z/(3.0*0.41*U_star*dt_in_T) cMKE(1,i) = 4.0 * Ih ; cMKE(2,i) = (absf_Ustar*GV%H_to_Z) * Ih if (Idecay_len_TKE(i) > 0.0) then @@ -1423,7 +1426,7 @@ subroutine find_starting_TKE(htot, h_CA, fluxes, Conv_En, cTKE, dKE_FC, dKE_CA, if (totEn_Z > 0.0) then nstar_FC = CS%nstar * totEn_Z / (totEn_Z + 0.2 * & - sqrt(0.5 * dt * (absf*(htot(i)*GV%H_to_Z))**3 * totEn_Z)) + sqrt(0.5 * dt_in_T * (absf*(htot(i)*GV%H_to_Z))**3 * totEn_Z)) else nstar_FC = CS%nstar endif @@ -1433,7 +1436,7 @@ subroutine find_starting_TKE(htot, h_CA, fluxes, Conv_En, cTKE, dKE_FC, dKE_CA, if (Conv_En(i) > 0.0) then totEn_Z = US%m_to_Z**2 * (Conv_En(i) + TKE_CA * (htot(i) / h_CA(i)) ) nstar_FC = CS%nstar * totEn_Z / (totEn_Z + 0.2 * & - sqrt(0.5 * dt * (absf*(htot(i)*GV%H_to_Z))**3 * totEn_Z)) + sqrt(0.5 * dt_in_T * (absf*(htot(i)*GV%H_to_Z))**3 * totEn_Z)) else nstar_FC = CS%nstar endif @@ -1441,7 +1444,7 @@ subroutine find_starting_TKE(htot, h_CA, fluxes, Conv_En, cTKE, dKE_FC, dKE_CA, totEn_Z = US%m_to_Z**2 * (Conv_En(i) + TKE_CA) if (TKE_CA > 0.0) then nstar_CA = CS%nstar * totEn_Z / (totEn_Z + 0.2 * & - sqrt(0.5 * dt * (absf*(h_CA(i)*GV%H_to_Z))**3 * totEn_Z)) + sqrt(0.5 * dt_in_T * (absf*(h_CA(i)*GV%H_to_Z))**3 * totEn_Z)) else nstar_CA = CS%nstar endif @@ -1463,15 +1466,15 @@ subroutine find_starting_TKE(htot, h_CA, fluxes, Conv_En, cTKE, dKE_FC, dKE_CA, dKE_conv = dKE_CA(i,1) * MKE_rate_CA + dKE_FC(i) * MKE_rate_FC ! At this point, it is assumed that cTKE is positive and stored in TKE_CA! ! Note: Removed factor of 2 in u*^3 terms. - TKE(i) = (dt*CS%mstar)*((US%Z_to_m**2*(U_Star*U_Star*U_Star))*exp_kh) + & + TKE(i) = (dt_in_T*CS%mstar)*((US%Z_to_m**2*(U_star*U_Star*U_Star))*exp_kh) + & (exp_kh * dKE_conv + nstar_FC*Conv_En(i) + nstar_CA * TKE_CA) if (CS%do_rivermix) then ! Add additional TKE at river mouths - TKE(i) = TKE(i) + TKE_river(i)*dt*exp_kh + TKE(i) = TKE(i) + TKE_river(i)*dt_in_T*exp_kh endif if (CS%TKE_diagnostics) then - wind_TKE_src = CS%mstar*(US%Z_to_m**2*U_Star*U_Star*U_Star) * diag_wt + wind_TKE_src = CS%mstar*(US%Z_to_m**2*U_star*U_Star*U_Star) * diag_wt CS%diag_TKE_wind(i,j) = CS%diag_TKE_wind(i,j) + & ( wind_TKE_src + TKE_river(i) * diag_wt ) CS%diag_TKE_RiBulk(i,j) = CS%diag_TKE_RiBulk(i,j) + dKE_conv*Idt_diag @@ -1541,7 +1544,7 @@ subroutine mechanical_entrainment(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & !! denominator of MKE_rate; the two elements have differing !! units of [H-1 ~> m-1 or m2 kg-1] and [H-2 ~> m-2 or m4 kg-2]. real, intent(in) :: Idt_diag !< The inverse of the accumulated diagnostic - !! time interval [s-1]. + !! time interval [T-1 ~> s-1]. integer, intent(in) :: nsw !< The number of bands of penetrating !! shortwave radiation. real, dimension(:,:), intent(inout) :: Pen_SW_bnd !< The penetrating shortwave heating at the @@ -1553,7 +1556,7 @@ subroutine mechanical_entrainment(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & !! The indicies of opacity_band are (band, i, k). real, dimension(SZI_(G)), intent(inout) :: TKE !< The turbulent kinetic energy !! available for mixing over a time - !! step [Z m2 s-2 ~> m3 s-2]. + !! step [Z m2 T-2 ~> m3 s-2]. real, dimension(SZI_(G)), intent(inout) :: Idecay_len_TKE !< The vertical TKE decay rate [H-1 ~> m-1 or m2 kg-1]. integer, intent(in) :: j !< The j-index to work on. integer, dimension(SZI_(G),SZK_(GV)), & @@ -1578,22 +1581,22 @@ subroutine mechanical_entrainment(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & real :: HpE ! The current thickness plus entrainment [H ~> m or kg m-2]. real :: g_H_2Rho0 ! Half the gravitational acceleration times the ! conversion from H to m divided by the mean density, - ! in m5 s-2 H-1 kg-1. + ! in [m5 T-2 H-1 kg-1 ~> m4 s-2 kg-1 or m7 s-2 kg-2]. real :: TKE_full_ent ! The TKE remaining if a layer is fully entrained - ! [Z m2 s-2 ~> m3 s-2]. + ! [Z m2 T-2 ~> m3 s-2]. real :: dRL ! Work required to mix water from the next layer - ! across the mixed layer [m2 s-2]. + ! across the mixed layer [m2 T-2 ~> m2 s-2]. real :: Pen_En_Contrib ! Penetrating SW contributions to the changes in - ! TKE, divided by layer thickness in m [m2 s-2]. - real :: C1 ! A temporary variable [m2 s-2]. + ! TKE, divided by layer thickness in m [m2 T2 ~> m2 s-2]. + real :: Cpen1 ! A temporary variable [m2 T-2 ~> m2 s-2]. real :: dMKE ! A temporary variable related to the release of mean - ! kinetic energy, with units of H Z m2 s-2. - real :: TKE_ent ! The TKE that remains if h_ent were entrained [Z m2 s-2 ~> m3 s-2]. + ! kinetic energy [H Z m2 T-2 ~> m4 s-2 or kg m s-2] + real :: TKE_ent ! The TKE that remains if h_ent were entrained [Z m2 T-2 ~> m3 s-2]. real :: TKE_ent1 ! The TKE that would remain, without considering the - ! release of mean kinetic energy [Z m2 s-2 ~> m3 s-2]. - real :: dTKE_dh ! The partial derivative of TKE with h_ent [Z m2 s-2 H-1 ~> m2 s-2 or m5 s-2 kg-1]. + ! release of mean kinetic energy [Z m2 T-2 ~> m3 s-2]. + real :: dTKE_dh ! The partial derivative of TKE with h_ent [Z m2 T-2 H-1 ~> m2 s-2 or m5 s-2 kg-1]. real :: Pen_dTKE_dh_Contrib ! The penetrating shortwave contribution to - ! dTKE_dh [m2 s-2]. + ! dTKE_dh [m2 T-2 ~> m2 s-2]. real :: EF4_val ! The result of EF4() (see later) [H-1 ~> m-1 or m2 kg-1]. real :: h_neglect ! A thickness that is so small it is usually lost ! in roundoff and can be neglected [H ~> m or kg m-2]. @@ -1612,7 +1615,7 @@ subroutine mechanical_entrainment(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & integer :: is, ie, nz, i, k, ks, itt, n C1_3 = 1.0/3.0 ; C1_6 = 1.0/6.0 ; C1_24 = 1.0/24.0 - g_H_2Rho0 = (GV%g_Earth * GV%H_to_Z) / (2.0 * GV%Rho0) + g_H_2Rho0 = (US%T_to_s**2*GV%g_Earth * GV%H_to_Z) / (2.0 * GV%Rho0) Hmix_min = CS%Hmix_min h_neglect = GV%H_subroundoff is = G%isc ; ie = G%iec ; nz = GV%ke @@ -1625,7 +1628,7 @@ subroutine mechanical_entrainment(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & h_avail = h(i,k) - eps(i,k) if ((h_avail > 0.) .and. ((TKE(i) > 0.) .or. (htot(i) < Hmix_min))) then dRL = g_H_2Rho0 * (R0(i,k)*htot(i) - R0_tot(i) ) - dMKE = (GV%H_to_Z * CS%bulk_Ri_ML) * 0.5 * & + dMKE = (GV%H_to_Z * CS%bulk_Ri_ML) * 0.5 * US%T_to_s**2 * & ((uhtot(i)-u(i,k)*htot(i))**2 + (vhtot(i)-v(i,k)*htot(i))**2) ! Find the TKE that would remain if the entire layer were entrained. @@ -1680,8 +1683,7 @@ subroutine mechanical_entrainment(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & if (CS%TKE_diagnostics) then E_HxHpE = h_ent / ((htot(i)+h_neglect)*(htot(i)+h_ent+h_neglect)) CS%diag_TKE_mech_decay(i,j) = CS%diag_TKE_mech_decay(i,j) + & - Idt_diag * ((exp_kh-1.0)*TKE(i) + & - (h_ent*GV%H_to_Z)*dRL*(1.0-f1_kh) + & + Idt_diag * ((exp_kh-1.0)*TKE(i) + (h_ent*GV%H_to_Z)*dRL*(1.0-f1_kh) + & MKE_rate*dMKE*(EF4_val-E_HxHpE)) CS%diag_TKE_mixing(i,j) = CS%diag_TKE_mixing(i,j) - & Idt_diag*(GV%H_to_Z*h_ent)*dRL @@ -1692,7 +1694,8 @@ subroutine mechanical_entrainment(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & endif TKE(i) = TKE_full_ent - if (TKE(i) <= 0.0) TKE(i) = 1.0e-150*US%m_to_Z + !### The minimum TKE value in this line may be problematically small. + if (TKE(i) <= 0.0) TKE(i) = 1.0e-150*US%T_to_s**2*US%m_to_Z else ! The layer is only partially entrained. The amount that will be ! entrained is determined iteratively. No further layers will be @@ -1745,10 +1748,10 @@ subroutine mechanical_entrainment(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & Pen_En1 = exp_kh * ((1.0+opacity*htot(i))*f1_x1 + & opacity*h_ent*f2_x1) endif - C1 = g_H_2Rho0*dR0_dT(i)*Pen_SW_bnd(n,i) - Pen_En_Contrib = Pen_En_Contrib + C1*(Pen_En1 - f1_kh) + Cpen1 = g_H_2Rho0*dR0_dT(i)*Pen_SW_bnd(n,i) + Pen_En_Contrib = Pen_En_Contrib + Cpen1*(Pen_En1 - f1_kh) Pen_dTKE_dh_Contrib = Pen_dTKE_dh_Contrib + & - C1*((1.0-SW_trans) - opacity*(htot(i) + h_ent)*SW_trans) + Cpen1*((1.0-SW_trans) - opacity*(htot(i) + h_ent)*SW_trans) endif ; enddo ! (Pen_SW_bnd(n,i) > 0.0) TKE_ent1 = exp_kh*TKE(i) - (h_ent*GV%H_to_Z)*(dRL*f1_kh + Pen_En_Contrib) @@ -1793,8 +1796,7 @@ subroutine mechanical_entrainment(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & E_HxHpE = h_ent / ((htot(i)+h_neglect)*(HpE+h_neglect)) CS%diag_TKE_mech_decay(i,j) = CS%diag_TKE_mech_decay(i,j) + & - Idt_diag * ((exp_kh-1.0)*TKE(i) + & - (h_ent*GV%H_to_Z)*dRL*(1.0-f1_kh) + & + Idt_diag * ((exp_kh-1.0)*TKE(i) + (h_ent*GV%H_to_Z)*dRL*(1.0-f1_kh) + & dMKE*MKE_rate*(EF4_val-E_HxHpE)) CS%diag_TKE_mixing(i,j) = CS%diag_TKE_mixing(i,j) - & Idt_diag*(h_ent*GV%H_to_Z)*dRL @@ -2206,7 +2208,7 @@ end subroutine resort_ML !> This subroutine moves any water left in the former mixed layers into the !! two buffer layers and may also move buffer layer water into the interior !! isopycnal layers. -subroutine mixedlayer_detrain_2(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, j, G, GV, US, CS, & +subroutine mixedlayer_detrain_2(h, T, S, R0, Rcv, RcvTgt, dt_in_T, dt_diag, d_ea, j, G, GV, US, CS, & dR0_dT, dR0_dS, dRcv_dT, dRcv_dS, max_BL_det) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. @@ -2220,8 +2222,8 @@ subroutine mixedlayer_detrain_2(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, j, !! density [kg m-3]. real, dimension(SZK_(GV)), intent(in) :: RcvTgt !< The target value of Rcv for each !! layer [kg m-3]. - real, intent(in) :: dt !< Time increment [s]. - real, intent(in) :: dt_diag !< The diagnostic time step [s]. + real, intent(in) :: dt_in_T !< Time increment [T ~> s]. + real, intent(in) :: dt_diag !< The diagnostic time step [T ~> s]. real, dimension(SZI_(G),SZK_(GV)), intent(inout) :: d_ea !< The upward increase across a layer in !! the entrainment from above !! [H ~> m or kg m-2]. Positive d_ea @@ -2295,7 +2297,7 @@ subroutine mixedlayer_detrain_2(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, j, ! rho_0*g [H2 ~> m2 or kg2 m-4]. real :: dPE_det, dPE_merge ! The energy required to mix the detrained water ! into the buffer layer or the merge the two - ! buffer layers [J H2 Z m-5 ~> J m-2 or J kg2 m-8]. + ! buffer layers [kg H2 Z T-2 m-3 ~> J m-2 or J kg2 m-8]. real :: h_from_ml ! The amount of additional water that must be ! drawn from the mixed layer [H ~> m or kg m-2]. @@ -2334,17 +2336,17 @@ subroutine mixedlayer_detrain_2(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, j, ! [degC ppt-1] and [ppt degC-1]. real :: I_denom ! A work variable with units of [ppt2 m6 kg-2]. - real :: G_2 ! 1/2 G_Earth [m2 Z-1 s-2 ~> m s-2]. - real :: Rho0xG ! Rho0 times G_Earth [kg m-1 Z-1 s-2 ~> kg m-2 s-2]. + real :: g_2 ! 1/2 g_Earth [m2 Z-1 T-2 ~> m s-2]. + real :: Rho0xG ! Rho0 times G_Earth [kg m-1 Z-1 T-2 ~> kg m-2 s-2]. real :: I2Rho0 ! 1 / (2 Rho0) [m3 kg-1]. real :: Idt_H2 ! The square of the conversion from thickness to Z - ! divided by the time step [Z2 H-2 s-1 ~> s-1 or m6 kg-2 s-1]. + ! divided by the time step [Z2 H-2 T-1 ~> s-1 or m6 kg-2 s-1]. logical :: stable_Rcv ! If true, the buffer layers are stable with ! respect to the coordinate potential density. real :: h_neglect ! A thickness that is so small it is usually lost ! in roundoff and can be neglected [H ~> m or kg m-2]. - real :: s1en ! A work variable [H2 kg m s-3 ~> kg m3 s-3 or kg3 m-3 s-3]. + real :: s1en ! A work variable [H2 kg m T-3 ~> kg m3 s-3 or kg3 m-3 s-3]. real :: s1, s2, bh0 ! Work variables [H ~> m or kg m-2]. real :: s3sq ! A work variable [H2 ~> m2 or kg2 m-4]. real :: I_ya, b1 ! Nondimensional work variables. @@ -2363,8 +2365,8 @@ subroutine mixedlayer_detrain_2(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, j, kb1 = CS%nkml+1; kb2 = CS%nkml+2 nkmb = CS%nkml+CS%nkbl h_neglect = GV%H_subroundoff - G_2 = 0.5*GV%g_Earth - Rho0xG = GV%Rho0 * GV%g_Earth + g_2 = 0.5 * US%T_to_s**2*GV%g_Earth + Rho0xG = GV%Rho0 * US%T_to_s**2*GV%g_Earth Idt_H2 = GV%H_to_Z**2 / dt_diag I2Rho0 = 0.5 / GV%Rho0 Angstrom = GV%Angstrom_H @@ -2376,7 +2378,7 @@ subroutine mixedlayer_detrain_2(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, j, if (CS%nkbl /= 2) call MOM_error(FATAL, "MOM_mixed_layer"// & "CS%nkbl must be 2 in mixedlayer_detrain_2.") - if (US%s_to_T*dt < CS%BL_detrain_time) then ; dPE_time_ratio = CS%BL_detrain_time / (US%s_to_T*dt) + if (dt_in_T < CS%BL_detrain_time) then ; dPE_time_ratio = CS%BL_detrain_time / (dt_in_T) else ; dPE_time_ratio = 1.0 ; endif do i=is,ie @@ -2619,7 +2621,7 @@ subroutine mixedlayer_detrain_2(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, j, if ((stays_merge > stays_min_merge) .and. & (stays_merge + h2_to_k1_rem >= h1 + h2)) then mergeable_bl = .true. - dPE_merge = G_2*(R0(i,kb2)-R0(i,kb1))*(h1-stays_merge)*(h2-stays_merge) + dPE_merge = g_2*(R0(i,kb2)-R0(i,kb1))*(h1-stays_merge)*(h2-stays_merge) endif endif @@ -2800,7 +2802,7 @@ subroutine mixedlayer_detrain_2(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, j, if (allocated(CS%diag_PE_detrain) .or. allocated(CS%diag_PE_detrain2)) then R0_det = R0_to_bl*Ihdet - s1en = G_2 * Idt_H2 * ( ((R0(i,kb2)-R0(i,kb1))*h1*h2 + & + s1en = g_2 * Idt_H2 * ( ((R0(i,kb2)-R0(i,kb1))*h1*h2 + & h_det_to_h2*( (R0(i,kb1)-R0_det)*h1 + (R0(i,kb2)-R0_det)*h2 ) + & h_ml_to_h2*( (R0(i,kb2)-R0(i,0))*h2 + (R0(i,kb1)-R0(i,0))*h1 + & (R0_det-R0(i,0))*h_det_to_h2 ) + & @@ -2896,7 +2898,7 @@ subroutine mixedlayer_detrain_2(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, j, endif endif - dPE_det = G_2*((R0(i,kb1)*h_to_bl - R0_to_bl)*stays + & + dPE_det = g_2*((R0(i,kb1)*h_to_bl - R0_to_bl)*stays + & (R0(i,kb2)-R0(i,kb1)) * (h1-stays) * & (h2 - scale_slope*stays*((h1+h2)+h_to_bl)/(h1+h2)) ) - & Rho0xG*dPE_extrap @@ -3097,7 +3099,7 @@ end subroutine mixedlayer_detrain_2 !> This subroutine moves any water left in the former mixed layers into the !! single buffer layers and may also move buffer layer water into the interior !! isopycnal layers. -subroutine mixedlayer_detrain_1(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, d_eb, & +subroutine mixedlayer_detrain_1(h, T, S, R0, Rcv, RcvTgt, dt_in_T, dt_diag, d_ea, d_eb, & j, G, GV, US, CS, dRcv_dT, dRcv_dS, max_BL_det) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. @@ -3111,9 +3113,9 @@ subroutine mixedlayer_detrain_1(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, d_e !! density [kg m-3]. real, dimension(SZK_(GV)), intent(in) :: RcvTgt !< The target value of Rcv for each !! layer [kg m-3]. - real, intent(in) :: dt !< Time increment [s]. + real, intent(in) :: dt_in_T !< Time increment [T ~> s]. real, intent(in) :: dt_diag !< The accumulated time interval for - !! diagnostics [s]. + !! diagnostics [T ~> s]. real, dimension(SZI_(G),SZK_(GV)), intent(inout) :: d_ea !< The upward increase across a layer in !! the entrainment from above !! [H ~> m or kg m-2]. Positive d_ea @@ -3144,17 +3146,16 @@ subroutine mixedlayer_detrain_1(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, d_e real :: max_det_rem(SZI_(G)) ! Remaining permitted detrainment [H ~> m or kg m-2]. real :: detrain(SZI_(G)) ! The thickness of fluid to detrain ! from the mixed layer [H ~> m or kg m-2]. - real :: Idt ! The inverse of the timestep [s-1]. real :: dT_dR, dS_dR, dRml, dR0_dRcv, dT_dS_wt2 real :: I_denom ! A work variable [ppt2 m6 kg-2]. real :: Sdown, Tdown real :: dt_Time ! The timestep divided by the detrainment timescale [nondim]. real :: g_H2_2Rho0dt ! Half the gravitational acceleration times the square of the ! conversion from H to m divided by the mean density times the time - ! step [m7 s-3 Z-1 H-2 kg-1 ~> m4 s-3 kg-1 or m10 s-3 kg-3]. + ! step [m7 T-3 Z-1 H-2 kg-1 ~> m4 s-3 kg-1 or m10 s-3 kg-3]. real :: g_H2_2dt ! Half the gravitational acceleration times the square of the ! conversion from H to m divided by the diagnostic time step - ! [m4 Z-1 H-2 s-3 ~> m s-3 or m7 kg-2 s-3]. + ! [m4 Z-1 H-2 T-3 ~> m s-3 or m7 kg-2 s-3]. logical :: splittable_BL(SZI_(G)), orthogonal_extrap real :: x1 @@ -3164,11 +3165,10 @@ subroutine mixedlayer_detrain_1(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, d_e nkmb = CS%nkml+CS%nkbl if (CS%nkbl /= 1) call MOM_error(FATAL,"MOM_mixed_layer: "// & "CS%nkbl must be 1 in mixedlayer_detrain_1.") - Idt = 1.0/dt - dt_Time = US%s_to_T*dt / CS%BL_detrain_time - g_H2_2Rho0dt = (GV%g_Earth * GV%H_to_Z**2) / (2.0 * GV%Rho0 * dt_diag) - g_H2_2dt = (GV%g_Earth * GV%H_to_Z**2) / (2.0 * dt_diag) + dt_Time = dt_in_T / CS%BL_detrain_time + g_H2_2Rho0dt = (US%T_to_s**2*GV%g_Earth * GV%H_to_Z**2) / (2.0 * GV%Rho0 * dt_diag) + g_H2_2dt = (US%T_to_s**2*GV%g_Earth * GV%H_to_Z**2) / (2.0 * dt_diag) ! Move detrained water into the buffer layer. do k=1,CS%nkml @@ -3515,8 +3515,8 @@ subroutine bulkmixedlayer_init(Time, G, GV, US, param_file, diag, CS) "depth is less than DEPTH_LIMIT_FLUXES.", & units="m", default=0.1*Hmix_min_m, scale=GV%m_to_H) call get_param(param_file, mdl, "OMEGA", CS%omega, & - "The rotation rate of the earth.", units="s-1", & - default=7.2921e-5) + "The rotation rate of the earth.", & + default=7.2921e-5, units="s-1", scale=US%T_to_s) call get_param(param_file, mdl, "ML_USE_OMEGA", use_omega, & "If true, use the absolute rotation rate instead of the "//& "vertical component of rotation when setting the decay "//& @@ -3540,12 +3540,12 @@ subroutine bulkmixedlayer_init(Time, G, GV, US, param_file, diag, CS) "layers before sorting when ML_RESORT is true.", & units="nondim", default=0, fail_if_missing=.true.) ! Fail added by AJA. ! This gives a minimum decay scale that is typically much less than Angstrom. - ustar_min_dflt = 2e-4*CS%omega*(GV%Angstrom_m + GV%H_to_m*GV%H_subroundoff) + ustar_min_dflt = 2e-4*US%s_to_T*CS%omega*(GV%Angstrom_m + GV%H_to_m*GV%H_subroundoff) call get_param(param_file, mdl, "BML_USTAR_MIN", CS%ustar_min, & "The minimum value of ustar that should be used by the "//& "bulk mixed layer model in setting vertical TKE decay "//& "scales. This must be greater than 0.", units="m s-1", & - default=ustar_min_dflt, scale=US%m_to_Z) + default=ustar_min_dflt, scale=US%m_to_Z*US%T_to_s) if (CS%ustar_min<=0.0) call MOM_error(FATAL, "BML_USTAR_MIN must be positive.") call get_param(param_file, mdl, "RESOLVE_EKMAN", CS%Resolve_Ekman, & @@ -3585,28 +3585,28 @@ subroutine bulkmixedlayer_init(Time, G, GV, US, param_file, diag, CS) CS%id_ML_depth = register_diag_field('ocean_model', 'h_ML', diag%axesT1, & Time, 'Surface mixed layer depth', 'm') CS%id_TKE_wind = register_diag_field('ocean_model', 'TKE_wind', diag%axesT1, & - Time, 'Wind-stirring source of mixed layer TKE', 'm3 s-3', conversion=US%Z_to_m) + Time, 'Wind-stirring source of mixed layer TKE', 'm3 s-3', conversion=US%Z_to_m*US%T_to_s**3) CS%id_TKE_RiBulk = register_diag_field('ocean_model', 'TKE_RiBulk', diag%axesT1, & - Time, 'Mean kinetic energy source of mixed layer TKE', 'm3 s-3', conversion=US%Z_to_m) + Time, 'Mean kinetic energy source of mixed layer TKE', 'm3 s-3', conversion=US%Z_to_m*US%T_to_s**3) CS%id_TKE_conv = register_diag_field('ocean_model', 'TKE_conv', diag%axesT1, & - Time, 'Convective source of mixed layer TKE', 'm3 s-3', conversion=US%Z_to_m) + Time, 'Convective source of mixed layer TKE', 'm3 s-3', conversion=US%Z_to_m*US%T_to_s**3) CS%id_TKE_pen_SW = register_diag_field('ocean_model', 'TKE_pen_SW', diag%axesT1, & Time, 'TKE consumed by mixing penetrative shortwave radation through the mixed layer', & 'm3 s-3', conversion=US%Z_to_m) CS%id_TKE_mixing = register_diag_field('ocean_model', 'TKE_mixing', diag%axesT1, & - Time, 'TKE consumed by mixing that deepens the mixed layer', 'm3 s-3', conversion=US%Z_to_m) + Time, 'TKE consumed by mixing that deepens the mixed layer', 'm3 s-3', conversion=US%Z_to_m*US%T_to_s**3) CS%id_TKE_mech_decay = register_diag_field('ocean_model', 'TKE_mech_decay', diag%axesT1, & - Time, 'Mechanical energy decay sink of mixed layer TKE', 'm3 s-3', conversion=US%Z_to_m) + Time, 'Mechanical energy decay sink of mixed layer TKE', 'm3 s-3', conversion=US%Z_to_m*US%T_to_s**3) CS%id_TKE_conv_decay = register_diag_field('ocean_model', 'TKE_conv_decay', diag%axesT1, & - Time, 'Convective energy decay sink of mixed layer TKE', 'm3 s-3', conversion=US%Z_to_m) + Time, 'Convective energy decay sink of mixed layer TKE', 'm3 s-3', conversion=US%Z_to_m*US%T_to_s**3) CS%id_TKE_conv_s2 = register_diag_field('ocean_model', 'TKE_conv_s2', diag%axesT1, & - Time, 'Spurious source of mixed layer TKE from sigma2', 'm3 s-3', conversion=US%Z_to_m) + Time, 'Spurious source of mixed layer TKE from sigma2', 'm3 s-3', conversion=US%Z_to_m*US%T_to_s**3) CS%id_PE_detrain = register_diag_field('ocean_model', 'PE_detrain', diag%axesT1, & Time, 'Spurious source of potential energy from mixed layer detrainment', & - 'W m-2', conversion=US%Z_to_m) + 'W m-2', conversion=US%Z_to_m*US%T_to_s**3) CS%id_PE_detrain2 = register_diag_field('ocean_model', 'PE_detrain2', diag%axesT1, & Time, 'Spurious source of potential energy from mixed layer only detrainment', & - 'W m-2', conversion=US%Z_to_m) + 'W m-2', conversion=US%Z_to_m*US%T_to_s**3) CS%id_h_mismatch = register_diag_field('ocean_model', 'h_miss_ML', diag%axesT1, & Time, 'Summed absolute mismatch in entrainment terms', 'm', conversion=US%Z_to_m) CS%id_Hsfc_used = register_diag_field('ocean_model', 'Hs_used', diag%axesT1, & From 2cedf63f9a407bd6e8ce0069f86ff9575dd30207 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 2 Jul 2019 17:40:32 -0400 Subject: [PATCH 58/82] +Added runtime parameter FRACTIONAL_ROUGHNESS_MAX Added a new runtime parameter, FRACTIONAL_ROUGHNESS_MAX, to specify the maximum roughness used in the tidal mixing parameterization as a fraction of the bottom depth. The default value follows the hard-coded value that was there before. By default, all answers are bitwise identical, but there is a new entry in some MOM_parameter_doc files. --- .../vertical/MOM_tidal_mixing.F90 | 19 ++++++++++++++----- 1 file changed, 14 insertions(+), 5 deletions(-) diff --git a/src/parameterizations/vertical/MOM_tidal_mixing.F90 b/src/parameterizations/vertical/MOM_tidal_mixing.F90 index 45c2594078..5bab658e89 100644 --- a/src/parameterizations/vertical/MOM_tidal_mixing.F90 +++ b/src/parameterizations/vertical/MOM_tidal_mixing.F90 @@ -222,7 +222,7 @@ logical function tidal_mixing_init(Time, G, GV, US, param_file, diag, CS) character(len=20) :: CVMix_tidal_scheme_str, tidal_energy_type character(len=200) :: filename, h2_file, Niku_TKE_input_file character(len=200) :: tidal_energy_file, tideamp_file - real :: utide, hamp, prandtl_tidal + real :: utide, hamp, prandtl_tidal, max_frac_rough real :: Niku_scale ! local variable for scaling the Nikurashin TKE flux data integer :: i, j, is, ie, js, je integer :: isd, ied, jsd, jed @@ -456,14 +456,23 @@ logical function tidal_mixing_init(Time, G, GV, US, param_file, diag, CS) call log_param(param_file, mdl, "INPUTDIR/H2_FILE", filename) call MOM_read_data(filename, 'h2', CS%h2, G%domain, timelevel=1, scale=US%m_to_Z**2) + call get_param(param_file, mdl, "FRACTIONAL_ROUGHNESS_MAX", max_frac_rough, & + "The maximum topographic roughness amplitude as a fraction of the mean depth, "//& + "or a negative value for no limitations on roughness.", & + units="nondim", default=0.1) + do j=js,je ; do i=is,ie if (G%bathyT(i,j) < CS%min_zbot_itides) CS%mask_itidal(i,j) = 0.0 CS%tideamp(i,j) = CS%tideamp(i,j) * CS%mask_itidal(i,j) * G%mask2dT(i,j) - ! Restrict rms topo to 10 percent of column depth. - !### Note the hard-coded nondimensional constant, and that this could be simplified. - hamp = min(0.1*G%bathyT(i,j), sqrt(CS%h2(i,j))) - CS%h2(i,j) = hamp*hamp + ! Restrict rms topo to a fraction (often 10 percent) of the column depth. + if (CS%answers_2018 .and. (max_frac_rough >= 0.0)) then + hamp = min(max_frac_rough*G%bathyT(i,j), sqrt(CS%h2(i,j))) + CS%h2(i,j) = hamp*hamp + else + if (max_frac_rough >= 0.0) & + CS%h2(i,j) = min((max_frac_rough*G%bathyT(i,j))**2, CS%h2(i,j)) + endif utide = CS%tideamp(i,j) ! Compute the fixed part of internal tidal forcing. From be2da7bc4a317c31c44ac7b76a30aa59a6243785 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 2 Jul 2019 18:29:24 -0400 Subject: [PATCH 59/82] Refactored find_coupling_coef Refactored find_coupling_coef to avoid the reuse of a_cpl for both the total viscosity (now Kv_tot) and the coupling coefficient (a_cpl), which have different dimensions, and to avoid the confusing factor of 2 that appeared at various points in this subroutine. All answers are bitwise identical. --- .../vertical/MOM_vert_friction.F90 | 95 ++++++++++--------- 1 file changed, 50 insertions(+), 45 deletions(-) diff --git a/src/parameterizations/vertical/MOM_vert_friction.F90 b/src/parameterizations/vertical/MOM_vert_friction.F90 index 47170fe169..9d74bcdb3d 100644 --- a/src/parameterizations/vertical/MOM_vert_friction.F90 +++ b/src/parameterizations/vertical/MOM_vert_friction.F90 @@ -1074,7 +1074,8 @@ subroutine find_coupling_coef(a_cpl, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, ! by Hmix, [H ~> m or kg m-2] or [nondim]. kv_TBL, & ! The viscosity in a top boundary layer under ice [Z2 T-1 ~> m2 s-1]. tbl_thick - real, dimension(SZIB_(G),SZK_(GV)) :: & + real, dimension(SZIB_(G),SZK_(GV)+1) :: & + Kv_tot, & ! The total viscosity at an interface [Z2 T-1 ~> m2 s-1]. Kv_add ! A viscosity to add [Z2 T-1 ~> m2 s-1]. real :: h_shear ! The distance over which shears occur [H ~> m or kg m-2]. real :: r ! A thickness to compare with Hbbl [H ~> m or kg m-2]. @@ -1088,13 +1089,14 @@ subroutine find_coupling_coef(a_cpl, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, ! in roundoff and can be neglected [H ~> m or kg m-2]. real :: z2 ! A copy of z_i [nondim] real :: topfn ! A function that is 1 at the top and small far from it [nondim] - real :: a_top ! Twice a viscosity associated with the top boundary layer [Z2 T-1 ~> m2 s-1] + real :: a_top ! A viscosity associated with the top boundary layer [Z2 T-1 ~> m2 s-1] logical :: do_shelf, do_OBCs integer :: i, k, is, ie, max_nk integer :: nz real :: botfn a_cpl(:,:) = 0.0 + Kv_tot(:,:) = 0.0 if (work_on_u) then ; is = G%IscB ; ie = G%IecB else ; is = G%isc ; ie = G%iec ; endif @@ -1113,15 +1115,15 @@ subroutine find_coupling_coef(a_cpl, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, ! The following loop calculates the vertical average velocity and ! surface mixed layer contributions to the vertical viscosity. - do i=is,ie ; a_cpl(i,1) = 0.0 ; enddo + do i=is,ie ; Kv_tot(i,1) = 0.0 ; enddo if ((GV%nkml>0) .or. do_shelf) then ; do k=2,nz ; do i=is,ie - if (do_i(i)) a_cpl(i,K) = 2.0*CS%Kv + if (do_i(i)) Kv_tot(i,K) = CS%Kv enddo ; enddo ; else I_Hmix = 1.0 / (CS%Hmix + h_neglect) do i=is,ie ; z_t(i) = h_neglect*I_Hmix ; enddo do K=2,nz ; do i=is,ie ; if (do_i(i)) then z_t(i) = z_t(i) + h_harm(i,k-1)*I_Hmix - a_cpl(i,K) = 2.0*CS%Kv + 2.0*CS%Kvml / ((z_t(i)*z_t(i)) * & + Kv_tot(i,K) = CS%Kv + CS%Kvml / ((z_t(i)*z_t(i)) * & (1.0 + 0.09*z_t(i)*z_t(i)*z_t(i)*z_t(i)*z_t(i)*z_t(i))) endif ; enddo ; enddo endif @@ -1130,51 +1132,48 @@ subroutine find_coupling_coef(a_cpl, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, if (CS%bottomdraglaw) then r = hvel(i,nz)*0.5 if (r < bbl_thick(i)) then - a_cpl(i,nz+1) = 1.0*kv_bbl(i) / (I_amax*kv_bbl(i) + r*GV%H_to_Z) + a_cpl(i,nz+1) = kv_bbl(i) / (I_amax*kv_bbl(i) + r*GV%H_to_Z) else - a_cpl(i,nz+1) = 1.0*kv_bbl(i) / (I_amax*kv_bbl(i) + bbl_thick(i)*GV%H_to_Z) + a_cpl(i,nz+1) = kv_bbl(i) / (I_amax*kv_bbl(i) + bbl_thick(i)*GV%H_to_Z) endif else - a_cpl(i,nz+1) = 2.0*CS%Kvbbl / (hvel(i,nz)*GV%H_to_Z + 2.0*I_amax*CS%Kvbbl) + a_cpl(i,nz+1) = CS%Kvbbl / (0.5*hvel(i,nz)*GV%H_to_Z + I_amax*CS%Kvbbl) endif endif ; enddo if (associated(visc%Kv_shear)) then - ! BGR/ Add factor of 2. * the averaged Kv_shear. - ! this is needed to reproduce the analytical solution to - ! a simple diffusion problem, likely due to h_shear being - ! equal to 2 x \delta z + ! The factor of 2 that used to be required in the viscosities is no longer needed. if (work_on_u) then do K=2,nz ; do i=is,ie ; if (do_i(i)) then - Kv_add(i,K) = (2.*0.5)*(visc%Kv_shear(i,j,k) + visc%Kv_shear(i+1,j,k)) + Kv_add(i,K) = 0.5*(visc%Kv_shear(i,j,k) + visc%Kv_shear(i+1,j,k)) endif ; enddo ; enddo if (do_OBCs) then do I=is,ie ; if (do_i(I) .and. (OBC%segnum_u(I,j) /= OBC_NONE)) then if (OBC%segment(OBC%segnum_u(I,j))%direction == OBC_DIRECTION_E) then - do K=2,nz ; Kv_add(i,K) = 2.*visc%Kv_shear(i,j,k) ; enddo + do K=2,nz ; Kv_add(i,K) = visc%Kv_shear(i,j,k) ; enddo elseif (OBC%segment(OBC%segnum_u(I,j))%direction == OBC_DIRECTION_W) then - do K=2,nz ; Kv_add(i,K) = 2.*visc%Kv_shear(i+1,j,k) ; enddo + do K=2,nz ; Kv_add(i,K) = visc%Kv_shear(i+1,j,k) ; enddo endif endif ; enddo endif do K=2,nz ; do i=is,ie ; if (do_i(i)) then - a_cpl(i,K) = a_cpl(i,K) + Kv_add(i,K) + Kv_tot(i,K) = Kv_tot(i,K) + Kv_add(i,K) endif ; enddo ; enddo else do K=2,nz ; do i=is,ie ; if (do_i(i)) then - Kv_add(i,K) = (2.*0.5)*(visc%Kv_shear(i,j,k) + visc%Kv_shear(i,j+1,k)) + Kv_add(i,K) = 0.5*(visc%Kv_shear(i,j,k) + visc%Kv_shear(i,j+1,k)) endif ; enddo ; enddo if (do_OBCs) then do i=is,ie ; if (do_i(i) .and. (OBC%segnum_v(i,J) /= OBC_NONE)) then if (OBC%segment(OBC%segnum_v(i,J))%direction == OBC_DIRECTION_N) then - do K=2,nz ; Kv_add(i,K) = 2.*visc%Kv_shear(i,j,k) ; enddo + do K=2,nz ; Kv_add(i,K) = visc%Kv_shear(i,j,k) ; enddo elseif (OBC%segment(OBC%segnum_v(i,J))%direction == OBC_DIRECTION_S) then - do K=2,nz ; Kv_add(i,K) = 2.*visc%Kv_shear(i,j+1,k) ; enddo + do K=2,nz ; Kv_add(i,K) = visc%Kv_shear(i,j+1,k) ; enddo endif endif ; enddo endif do K=2,nz ; do i=is,ie ; if (do_i(i)) then - a_cpl(i,K) = a_cpl(i,K) + Kv_add(i,K) + Kv_tot(i,K) = Kv_tot(i,K) + Kv_add(i,K) endif ; enddo ; enddo endif endif @@ -1182,11 +1181,11 @@ subroutine find_coupling_coef(a_cpl, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, if (associated(visc%Kv_shear_Bu)) then if (work_on_u) then do K=2,nz ; do I=Is,Ie ; If (do_i(I)) then - a_cpl(I,K) = a_cpl(I,K) + (2.*0.5)*(visc%Kv_shear_Bu(I,J-1,k) + visc%Kv_shear_Bu(I,J,k)) + Kv_tot(I,K) = Kv_tot(I,K) + (0.5)*(visc%Kv_shear_Bu(I,J-1,k) + visc%Kv_shear_Bu(I,J,k)) endif ; enddo ; enddo else do K=2,nz ; do i=is,ie ; if (do_i(i)) then - a_cpl(i,K) = a_cpl(i,K) + (2.*0.5)*(visc%Kv_shear_Bu(I-1,J,k) + visc%Kv_shear_Bu(I,J,k)) + Kv_tot(i,K) = Kv_tot(i,K) + (0.5)*(visc%Kv_shear_Bu(I-1,J,k) + visc%Kv_shear_Bu(I,J,k)) endif ; enddo ; enddo endif endif @@ -1195,37 +1194,43 @@ subroutine find_coupling_coef(a_cpl, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, if (associated(visc%Kv_slow) .and. (visc%add_Kv_slow)) then ! GMM/ A factor of 2 is also needed here, see comment above from BGR. if (work_on_u) then + !### Incrementing Kv_add here will cause visc%Kv_shear to be double counted. - RWH do K=2,nz ; do i=is,ie ; if (do_i(i)) then - Kv_add(I,K) = Kv_add(I,K) + 1.0 * (visc%Kv_slow(i,j,k) + visc%Kv_slow(i+1,j,k)) + Kv_add(I,K) = Kv_add(I,K) + 0.5 * (visc%Kv_slow(i,j,k) + visc%Kv_slow(i+1,j,k)) + ! Should be : Kv_add(I,K) = 0.5 * (visc%Kv_slow(i,j,k) + visc%Kv_slow(i+1,j,k)) endif ; enddo ; enddo + !### I am pretty sure that this code is double counting viscosity at OBC points! - RWH if (do_OBCs) then do I=is,ie ; if (do_i(I) .and. (OBC%segnum_u(I,j) /= OBC_NONE)) then if (OBC%segment(OBC%segnum_u(I,j))%direction == OBC_DIRECTION_E) then - do K=2,nz ; Kv_add(I,K) = Kv_add(I,K) + 2. * visc%Kv_slow(i,j,k) ; enddo + do K=2,nz ; Kv_add(I,K) = Kv_add(I,K) + visc%Kv_slow(i,j,k) ; enddo + ! Should be : do K=2,nz ; Kv_add(I,K) = visc%Kv_slow(i,j,k) ; enddo elseif (OBC%segment(OBC%segnum_u(I,j))%direction == OBC_DIRECTION_W) then - do K=2,nz ; Kv_add(I,K) = Kv_add(I,K) + 2. * visc%Kv_slow(i+1,j,k) ; enddo + do K=2,nz ; Kv_add(I,K) = Kv_add(I,K) + visc%Kv_slow(i+1,j,k) ; enddo + ! Should be : do K=2,nz ; Kv_add(I,K) = visc%Kv_slow(i+1,j,k) ; enddo endif endif ; enddo endif do K=2,nz ; do i=is,ie ; if (do_i(i)) then - a_cpl(I,K) = a_cpl(I,K) + Kv_add(I,K) + Kv_tot(I,K) = Kv_tot(I,K) + Kv_add(I,K) endif ; enddo ; enddo else + !### Incrementing Kv_add here will cause visc%Kv_shear to be double counted. - RWH do K=2,nz ; do i=is,ie ; if (do_i(i)) then - Kv_add(i,K) = Kv_add(i,K) + 1.0*(visc%Kv_slow(i,j,k) + visc%Kv_slow(i,j+1,k)) + Kv_add(i,K) = Kv_add(i,K) + 0.5*(visc%Kv_slow(i,j,k) + visc%Kv_slow(i,j+1,k)) endif ; enddo ; enddo - !### I am pretty sure that this is double counting here! - RWH + !### I am pretty sure that this code is double counting viscosity at OBC points! - RWH if (do_OBCs) then do i=is,ie ; if (do_i(i) .and. (OBC%segnum_v(i,J) /= OBC_NONE)) then if (OBC%segment(OBC%segnum_v(i,J))%direction == OBC_DIRECTION_N) then - do K=2,nz ; Kv_add(i,K) = Kv_add(i,K) + 2. * visc%Kv_slow(i,j,k) ; enddo + do K=2,nz ; Kv_add(i,K) = Kv_add(i,K) + visc%Kv_slow(i,j,k) ; enddo elseif (OBC%segment(OBC%segnum_v(i,J))%direction == OBC_DIRECTION_S) then - do K=2,nz ; Kv_add(i,K) = Kv_add(i,K) + 2. * visc%Kv_slow(i,j+1,k) ; enddo + do K=2,nz ; Kv_add(i,K) = Kv_add(i,K) + visc%Kv_slow(i,j+1,k) ; enddo endif endif ; enddo endif do K=2,nz ; do i=is,ie ; if (do_i(i)) then - a_cpl(i,K) = a_cpl(i,K) + Kv_add(i,K) + Kv_tot(i,K) = Kv_tot(i,K) + Kv_add(i,K) endif ; enddo ; enddo endif endif @@ -1237,20 +1242,20 @@ subroutine find_coupling_coef(a_cpl, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, botfn = 1.0 / (1.0 + 0.09*z2*z2*z2*z2*z2*z2) if (CS%bottomdraglaw) then - a_cpl(i,K) = a_cpl(i,K) + 2.0*(kv_bbl(i) - CS%Kv)*botfn - r = (hvel(i,k)+hvel(i,k-1)) - if (r > 2.0*bbl_thick(i)) then - h_shear = ((1.0 - botfn) * r + botfn*2.0*bbl_thick(i)) + Kv_tot(i,K) = Kv_tot(i,K) + (kv_bbl(i) - CS%Kv)*botfn + r = 0.5*(hvel(i,k) + hvel(i,k-1)) + if (r > bbl_thick(i)) then + h_shear = ((1.0 - botfn) * r + botfn*bbl_thick(i)) else h_shear = r endif else - a_cpl(i,K) = a_cpl(i,K) + 2.0*(CS%Kvbbl-CS%Kv)*botfn - h_shear = hvel(i,k) + hvel(i,k-1) + h_neglect + Kv_tot(i,K) = Kv_tot(i,K) + (CS%Kvbbl-CS%Kv)*botfn + h_shear = 0.5*(hvel(i,k) + hvel(i,k-1) + h_neglect) endif - ! Up to this point a_cpl has had units of Z2 T-1, but now is converted to Z T-1. - a_cpl(i,K) = a_cpl(i,K) / (h_shear*GV%H_to_Z + I_amax*a_cpl(i,K)) + ! Calculate the coupling coefficients from the viscosities. + a_cpl(i,K) = Kv_tot(i,K) / (h_shear*GV%H_to_Z + I_amax*Kv_tot(i,K)) endif ; enddo ; enddo ! i & k loops if (do_shelf) then @@ -1267,7 +1272,7 @@ subroutine find_coupling_coef(a_cpl, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, ! If a_cpl(i,1) were not already 0, it would be added here. if (0.5*hvel(i,1) > tbl_thick(i)) then - a_cpl(i,1) = kv_TBL(i) / (tbl_thick(i) *GV%H_to_Z + I_amax*kv_TBL(i)) + a_cpl(i,1) = kv_TBL(i) / (tbl_thick(i)*GV%H_to_Z + I_amax*kv_TBL(i)) else a_cpl(i,1) = kv_TBL(i) / (0.5*hvel(i,1)*GV%H_to_Z + I_amax*kv_TBL(i)) endif @@ -1277,14 +1282,14 @@ subroutine find_coupling_coef(a_cpl, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, z_t(i) = z_t(i) + hvel(i,k-1) / tbl_thick(i) topfn = 1.0 / (1.0 + 0.09 * z_t(i)**6) - r = (hvel(i,k)+hvel(i,k-1)) - if (r > 2.0*tbl_thick(i)) then - h_shear = ((1.0 - topfn) * r + topfn*2.0*tbl_thick(i)) + r = 0.5*(hvel(i,k)+hvel(i,k-1)) + if (r > tbl_thick(i)) then + h_shear = ((1.0 - topfn) * r + topfn*tbl_thick(i)) else h_shear = r endif - a_top = 2.0 * topfn * kv_TBL(i) + a_top = topfn * kv_TBL(i) a_cpl(i,K) = a_cpl(i,K) + a_top / (h_shear*GV%H_to_Z + I_amax*a_top) endif ; enddo ; enddo elseif (CS%dynamic_viscous_ML .or. (GV%nkml>0)) then @@ -1335,7 +1340,7 @@ subroutine find_coupling_coef(a_cpl, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, ! This viscosity is set to go to 0 at the mixed layer top and bottom (in a log-layer) ! and be further limited by rotation to give the natural Ekman length. visc_ml = u_star(i) * 0.41 * (temp1*u_star(i)) / (absf(i)*temp1 + h_ml(i)*u_star(i)) - a_ml = 4.0*visc_ml / ((hvel(i,k)+hvel(i,k-1) + h_neglect) * GV%H_to_Z + 2.0*I_amax*visc_ml) + a_ml = visc_ml / (0.25*(hvel(i,k)+hvel(i,k-1) + h_neglect) * GV%H_to_Z + 0.5*I_amax*visc_ml) ! Choose the largest estimate of a. if (a_ml > a_cpl(i,K)) a_cpl(i,K) = a_ml endif ; endif ; enddo ; enddo From 408f9cd5f4e0c92173795202398aa7fd1b0ee1dd Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Wed, 3 Jul 2019 01:14:50 -0400 Subject: [PATCH 60/82] +Changed bulkmixedlayer timestep arg units to T Changed the units of the timestep arguments in calls to bulkmixedlayer and set_diffusivity from s to T. All answers are bitwise identical. --- .../vertical/MOM_bulk_mixed_layer.F90 | 16 ++++++------- .../vertical/MOM_diabatic_driver.F90 | 24 +++++++++---------- .../vertical/MOM_set_diffusivity.F90 | 10 ++++---- 3 files changed, 24 insertions(+), 26 deletions(-) diff --git a/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 b/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 index 405e3b4292..3c2e153e8a 100644 --- a/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 +++ b/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 @@ -184,7 +184,7 @@ module MOM_bulk_mixed_layer !! For a traditional Kraus-Turner mixed layer, the values are: !! pen_SW_frac = 0.0, pen_SW_scale = 0.0 m, mstar = 1.25, !! nstar = 0.4, TKE_decay = 0.0, conv_decay = 0.0 -subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, US, CS, & +subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt_in_T, ea, eb, G, GV, US, CS, & optics, Hml, aggregate_FW_forcing, dt_diag, last_call) type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. @@ -203,7 +203,7 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, US, C type(forcing), intent(inout) :: fluxes !< A structure containing pointers to any !! possible forcing fields. Unused fields !! have NULL ptrs. - real, intent(in) :: dt !< Time increment [s]. + real, intent(in) :: dt_in_T !< Time increment [T ~> s]. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(inout) :: ea !< The amount of fluid moved downward into a !! layer; this should be increased due to @@ -224,7 +224,7 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, US, C !! being applied separately. real, optional, intent(in) :: dt_diag !< The diagnostic time step, !! which may be less than dt if there are - !! two callse to mixedlayer [s]. + !! two callse to mixedlayer [T ~> s]. logical, optional, intent(in) :: last_call !< if true, this is the last call !! to mixedlayer in the current time step, so !! diagnostics will be written. The default is @@ -347,7 +347,7 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, US, C real :: absf_x_H ! The absolute value of f times the mixed layer thickness [Z T-1 ~> m s-1]. real :: kU_star ! Ustar times the Von Karmen constant [Z T-1 ~> m s-1]. - real :: dt_in_T ! Time increment in time units [T ~> s]. +! real :: dt_in_T ! Time increment in time units [T ~> s]. real :: dt__diag ! A recaled copy of dt_diag (if present) or dt [T ~> s]. logical :: write_diags ! If true, write out diagnostics with this step. logical :: reset_diags ! If true, zero out the accumulated diagnostics. @@ -370,10 +370,10 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, US, C Inkml = 1.0 / REAL(CS%nkml) if (CS%nkml > 1) Inkmlm1 = 1.0 / REAL(CS%nkml-1) - dt_in_T = dt * US%s_to_T +! dt_in_T = dt * US%s_to_T Irho0 = 1.0 / GV%Rho0 - dt__diag = dt_in_T ; if (present(dt_diag)) dt__diag = dt_diag * US%s_to_T + dt__diag = dt_in_T ; if (present(dt_diag)) dt__diag = dt_diag Idt_diag = 1.0 / (dt__diag) write_diags = .true. ; if (present(last_call)) write_diags = last_call @@ -535,7 +535,7 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, US, C ! net_heat = heat via surface fluxes [degC H ~> degC m or degC kg m-2] ! net_salt = salt via surface fluxes [ppt H ~> dppt m or gSalt m-2] ! Pen_SW_bnd = components to penetrative shortwave radiation - call extractFluxes1d(G, GV, fluxes, optics, nsw, j, dt, & + call extractFluxes1d(G, GV, fluxes, optics, nsw, j, US%T_to_s*dt_in_T, & CS%H_limit_fluxes, CS%use_river_heat_content, CS%use_calving_heat_content, & h(:,1:), T(:,1:), netMassInOut, netMassOut, Net_heat, Net_salt, Pen_SW_bnd,& tv, aggregate_FW_forcing) @@ -570,7 +570,7 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, US, C cMKE, Idt_diag, nsw, Pen_SW_bnd, opacity_band, TKE, & Idecay_len_TKE, j, ksort, G, GV, US, CS) - call absorbRemainingSW(G, GV, h(:,1:), opacity_band, nsw, j, dt, CS%H_limit_fluxes, & + call absorbRemainingSW(G, GV, h(:,1:), opacity_band, nsw, j, US%T_to_s*dt_in_T, CS%H_limit_fluxes, & CS%correct_absorption, CS%absorb_all_SW, & T(:,1:), Pen_SW_bnd, eps, ksort, htot, Ttot) diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index 11c6810fa9..642450bdac 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -540,7 +540,6 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim real :: c1(SZIB_(G),SZK_(G)) ! tridiagonal solver. real :: Ent_int ! The diffusive entrainment rate at an interface [H ~> m or kg m-2] - real :: dt_mix ! The amount of time over which to apply mixing [s] real :: Idt ! The inverse time step [s-1] real :: dt_in_T ! The time step converted to T units [T ~> s] @@ -609,7 +608,7 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim call cpu_clock_begin(id_clock_set_diffusivity) ! Sets: Kd_lay, Kd_int, visc%Kd_extra_T, visc%Kd_extra_S and visc%TKE_turb ! Also changes: visc%Kd_shear, visc%Kv_shear and visc%Kv_slow - call set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, CS%optics, visc, dt, G, GV, US, & + call set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, CS%optics, visc, dt_in_T, G, GV, US, & CS%set_diff_CSp, Kd_lay, Kd_int) call cpu_clock_end(id_clock_set_diffusivity) if (showCallTree) call callTree_waypoint("done with set_diffusivity (diabatic)") @@ -1322,7 +1321,6 @@ subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, real :: c1(SZIB_(G),SZK_(G)) ! tridiagonal solver. real :: Ent_int ! The diffusive entrainment rate at an interface [H ~> m or kg m-2] - real :: dt_mix ! The amount of time over which to apply mixing [s] real :: Idt ! The inverse time step [s-1] real :: dt_in_T ! The time step converted to T units [T ~> s] @@ -1393,7 +1391,7 @@ subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, call cpu_clock_begin(id_clock_set_diffusivity) ! Sets: Kd_lay, Kd_int, visc%Kd_extra_T, visc%Kd_extra_S and visc%TKE_turb ! Also changes: visc%Kd_shear, visc%Kv_shear and visc%Kv_slow - call set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, CS%optics, visc, dt, G, GV, US, & + call set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, CS%optics, visc, dt_in_T, G, GV, US, & CS%set_diff_CSp, Kd_lay, Kd_int) call cpu_clock_end(id_clock_set_diffusivity) if (showCallTree) call callTree_waypoint("done with set_diffusivity (diabatic)") @@ -2011,7 +2009,7 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e real :: c1(SZIB_(G),SZK_(G)) ! tridiagonal solver. real :: Ent_int ! The diffusive entrainment rate at an interface [H ~> m or kg m-2] - real :: dt_mix ! The amount of time over which to apply mixing [s] + real :: dt_mix ! The amount of time over which to apply mixing [T ~> s] real :: Idt ! The inverse time step [s-1] real :: dt_in_T ! The time step converted to T units [T ~> s] @@ -2080,17 +2078,17 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e call cpu_clock_begin(id_clock_mixedlayer) if (CS%ML_mix_first < 1.0) then ! Changes: h, tv%T, tv%S, eaml and ebml (G is also inout???) - call bulkmixedlayer(h, u_h, v_h, tv, fluxes, dt*CS%ML_mix_first, & + call bulkmixedlayer(h, u_h, v_h, tv, fluxes, dt_in_T*CS%ML_mix_first, & eaml,ebml, G, GV, US, CS%bulkmixedlayer_CSp, CS%optics, & - Hml, CS%aggregate_FW_forcing, dt, last_call=.false.) + Hml, CS%aggregate_FW_forcing, dt_in_T, last_call=.false.) if (CS%salt_reject_below_ML) & call insert_brine(h, tv, G, GV, fluxes, nkmb, CS%diabatic_aux_CSp, & dt*CS%ML_mix_first, CS%id_brine_lay) else ! Changes: h, tv%T, tv%S, eaml and ebml (G is also inout???) - call bulkmixedlayer(h, u_h, v_h, tv, fluxes, dt, eaml, ebml, & + call bulkmixedlayer(h, u_h, v_h, tv, fluxes, dt_in_T, eaml, ebml, & G, GV, US, CS%bulkmixedlayer_CSp, CS%optics, & - Hml, CS%aggregate_FW_forcing, dt, last_call=.true.) + Hml, CS%aggregate_FW_forcing, dt_in_T, last_call=.true.) endif ! Keep salinity from falling below a small but positive threshold. @@ -2134,7 +2132,7 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e if (associated(tv%T)) call pass_var(tv%S, G%Domain, halo=CS%halo_TS_diff, complete=.false.) call pass_var(h, G%domain, halo=CS%halo_TS_diff, complete=.true.) endif - call set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, CS%optics, visc, dt, G, GV, US, & + call set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, CS%optics, visc, dt_in_T, G, GV, US, & CS%set_diff_CSp, Kd_lay, Kd_int) call cpu_clock_end(id_clock_set_diffusivity) if (showCallTree) call callTree_waypoint("done with set_diffusivity (diabatic)") @@ -2470,15 +2468,15 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e call find_uv_at_h(u, v, hold, u_h, v_h, G, GV, ea, eb) if (CS%debug) call MOM_state_chksum("find_uv_at_h1 ", u, v, h, G, GV, haloshift=0) - dt_mix = min(dt,dt*(1.0 - CS%ML_mix_first)) + dt_mix = min(dt_in_T, dt_in_T*(1.0 - CS%ML_mix_first)) call cpu_clock_begin(id_clock_mixedlayer) ! Changes: h, tv%T, tv%S, ea and eb (G is also inout???) call bulkmixedlayer(h, u_h, v_h, tv, fluxes, dt_mix, ea, eb, & G, GV, US, CS%bulkmixedlayer_CSp, CS%optics, & - Hml, CS%aggregate_FW_forcing, dt, last_call=.true.) + Hml, CS%aggregate_FW_forcing, dt_in_T, last_call=.true.) if (CS%salt_reject_below_ML) & - call insert_brine(h, tv, G, GV, fluxes, nkmb, CS%diabatic_aux_CSp, dt_mix, & + call insert_brine(h, tv, G, GV, fluxes, nkmb, CS%diabatic_aux_CSp, US%T_to_s*dt_mix, & CS%id_brine_lay) ! Keep salinity from falling below a small but positive threshold. diff --git a/src/parameterizations/vertical/MOM_set_diffusivity.F90 b/src/parameterizations/vertical/MOM_set_diffusivity.F90 index 3baf6a35f7..1c827ef8f0 100644 --- a/src/parameterizations/vertical/MOM_set_diffusivity.F90 +++ b/src/parameterizations/vertical/MOM_set_diffusivity.F90 @@ -200,7 +200,7 @@ module MOM_set_diffusivity !! viscosity associated with processes 1,2 and 4 listed above, which is stored in !! visc%Kv_slow. Vertical viscosity due to shear-driven mixing is passed via !! visc%Kv_shear -subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & +subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt_in_T, & G, GV, US, CS, Kd_lay, Kd_int) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. @@ -222,7 +222,7 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & !! properties of the ocean. type(vertvisc_type), intent(inout) :: visc !< Structure containing vertical viscosities, bottom !! boundary layer properies, and related fields. - real, intent(in) :: dt !< Time increment [s]. + real, intent(in) :: dt_in_T !< Time increment [s]. type(set_diffusivity_CS), pointer :: CS !< Module control structure. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(out) :: Kd_lay !< Diapycnal diffusivity of each layer [Z2 T-1 ~> m2 s-1]. @@ -353,7 +353,7 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & (GV%Z_to_H**2)*kappa_fill*dt_fill, halo=1) call calc_kappa_shear_vertex(u, v, h, T_adj, S_adj, tv, fluxes%p_surf, visc%Kd_shear, & - visc%TKE_turb, visc%Kv_shear_Bu, US%s_to_T*dt, G, GV, US, CS%kappaShear_CSp) + visc%TKE_turb, visc%Kv_shear_Bu, dt_in_T, G, GV, US, CS%kappaShear_CSp) if (associated(visc%Kv_shear)) visc%Kv_shear(:,:,:) = 0.0 ! needed for other parameterizations if (CS%debug) then call hchksum(visc%Kd_shear, "after calc_KS_vert visc%Kd_shear", G%HI, scale=US%Z2_T_to_m2_s) @@ -363,7 +363,7 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & else ! Changes: visc%Kd_shear ; Sets: visc%Kv_shear and visc%TKE_turb call calculate_kappa_shear(u_h, v_h, h, tv, fluxes%p_surf, visc%Kd_shear, visc%TKE_turb, & - visc%Kv_shear, US%s_to_T*dt, G, GV, US, CS%kappaShear_CSp) + visc%Kv_shear, dt_in_T, G, GV, US, CS%kappaShear_CSp) if (CS%debug) then call hchksum(visc%Kd_shear, "after calc_KS visc%Kd_shear", G%HI, scale=US%Z2_T_to_m2_s) call hchksum(visc%Kv_shear, "after calc_KS visc%Kv_shear", G%HI, scale=US%Z2_T_to_m2_s) @@ -465,7 +465,7 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & endif endif - call find_TKE_to_Kd(h, tv, dRho_int, N2_lay, j, (US%s_to_T)*dt, G, GV, US, CS, TKE_to_Kd, & + call find_TKE_to_Kd(h, tv, dRho_int, N2_lay, j, dt_in_T, G, GV, US, CS, TKE_to_Kd, & maxTKE, kb) if (associated(dd%maxTKE)) then ; do k=1,nz ; do i=is,ie dd%maxTKE(i,j,k) = maxTKE(i,k) From 057dfdeb17d09f29bb6d78ab5b007d10ea50f548 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Wed, 3 Jul 2019 01:16:04 -0400 Subject: [PATCH 61/82] Corrected units in various comments Corrected units and spelling errors in comments. All answers are bitwise identical. --- src/parameterizations/vertical/MOM_diabatic_aux.F90 | 4 ++-- src/parameterizations/vertical/MOM_entrain_diffusive.F90 | 4 ++-- src/parameterizations/vertical/MOM_internal_tide_input.F90 | 2 +- src/parameterizations/vertical/MOM_kappa_shear.F90 | 2 +- src/parameterizations/vertical/MOM_set_viscosity.F90 | 2 +- 5 files changed, 7 insertions(+), 7 deletions(-) diff --git a/src/parameterizations/vertical/MOM_diabatic_aux.F90 b/src/parameterizations/vertical/MOM_diabatic_aux.F90 index 5899e35b76..8bbadd535a 100644 --- a/src/parameterizations/vertical/MOM_diabatic_aux.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_aux.F90 @@ -381,8 +381,8 @@ subroutine insert_brine(h, tv, G, GV, fluxes, nkmb, CS, dt, id_brine_lay) integer, intent(in) :: nkmb !< The number of layers in the mixed and buffer layers type(diabatic_aux_CS), intent(in) :: CS !< The control structure returned by a previous !! call to diabatic_aux_init - real, intent(in) :: dt !< The thermodyanmic time step [s]. - integer, intent(in) :: id_brine_lay !< The handle for a diagnostic + real, intent(in) :: dt !< The thermodynamic time step [s]. + integer, intent(in) :: id_brine_lay !< The handle for a diagnostic of !! which layer receivees the brine. ! local variables diff --git a/src/parameterizations/vertical/MOM_entrain_diffusive.F90 b/src/parameterizations/vertical/MOM_entrain_diffusive.F90 index 17c90dad2f..4ca1dc6d6d 100644 --- a/src/parameterizations/vertical/MOM_entrain_diffusive.F90 +++ b/src/parameterizations/vertical/MOM_entrain_diffusive.F90 @@ -109,7 +109,7 @@ subroutine entrainment_diffusive(h, tv, fluxes, dt, G, GV, US, CS, ea, eb, & real, allocatable, dimension(:,:,:) :: & Kd_eff, & ! The effective diffusivity that actually applies to each ! layer after the effects of boundary conditions are - ! considered [Z2 s-1 ~> m2 s-1]. + ! considered [Z2 T-1 ~> m2 s-1]. diff_work ! The work actually done by diffusion across each ! interface [W m-2]. Sum vertically for the total work. @@ -2126,7 +2126,7 @@ subroutine entrain_diffusive_init(Time, G, GV, US, param_file, diag, CS) units="m", default=MAX(100.0*GV%Angstrom_m,1.0e-4*sqrt(dt*Kd)), scale=GV%m_to_H) CS%id_Kd = register_diag_field('ocean_model', 'Kd_effective', diag%axesTL, Time, & - 'Diapycnal diffusivity as applied', 'm2 s-1', conversion=US%Z_to_m**2*US%s_to_T) + 'Diapycnal diffusivity as applied', 'm2 s-1', conversion=US%Z2_T_to_m2_s) CS%id_diff_work = register_diag_field('ocean_model', 'diff_work', diag%axesTi, Time, & 'Work actually done by diapycnal diffusion across each interface', 'W m-2', conversion=US%Z_to_m*US%s_to_T) diff --git a/src/parameterizations/vertical/MOM_internal_tide_input.F90 b/src/parameterizations/vertical/MOM_internal_tide_input.F90 index 9b5dea70ed..2478a18f6f 100644 --- a/src/parameterizations/vertical/MOM_internal_tide_input.F90 +++ b/src/parameterizations/vertical/MOM_internal_tide_input.F90 @@ -39,7 +39,7 @@ module MOM_int_tide_input real :: TKE_itide_max !< Maximum Internal tide conversion !! available to mix above the BBL [W m-2] real :: kappa_fill !< Vertical diffusivity used to interpolate sensible values - !! of T & S into thin layers [Z2 s-1 ~> m2 s-1]. + !! of T & S into thin layers [Z2 T-1 ~> m2 s-1]. real, allocatable, dimension(:,:) :: TKE_itidal_coef !< The time-invariant field that enters the TKE_itidal input calculation [J m-2]. diff --git a/src/parameterizations/vertical/MOM_kappa_shear.F90 b/src/parameterizations/vertical/MOM_kappa_shear.F90 index 145174d568..14c319398a 100644 --- a/src/parameterizations/vertical/MOM_kappa_shear.F90 +++ b/src/parameterizations/vertical/MOM_kappa_shear.F90 @@ -56,7 +56,7 @@ module MOM_kappa_shear !! the buoyancy and shear scales in the diffusivity !! equation, 0 to eliminate the shear scale. Nondim. real :: TKE_bg !< The background level of TKE [Z2 T-2 ~> m2 s-2]. - real :: kappa_0 !< The background diapycnal diffusivity [Z2 s-1 ~> m2 s-1]. + real :: kappa_0 !< The background diapycnal diffusivity [Z2 T-1 ~> m2 s-1]. real :: kappa_tol_err !< The fractional error in kappa that is tolerated. real :: Prandtl_turb !< Prandtl number used to convert Kd_shear into viscosity. integer :: nkml !< The number of layers in the mixed layer, as diff --git a/src/parameterizations/vertical/MOM_set_viscosity.F90 b/src/parameterizations/vertical/MOM_set_viscosity.F90 index 6c04f05926..d9a5af6137 100644 --- a/src/parameterizations/vertical/MOM_set_viscosity.F90 +++ b/src/parameterizations/vertical/MOM_set_viscosity.F90 @@ -54,7 +54,7 @@ module MOM_set_visc real :: Htbl_shelf !< A nominal thickness of the surface boundary layer for use !! in calculating the near-surface velocity [H ~> m or kg m-2]. real :: Htbl_shelf_min !< The minimum surface boundary layer thickness [H ~> m or kg m-2]. - real :: KV_BBL_min !< The minimum viscosity in the bottom boundary layer [Z2 s-1 ~> m2 s-1]. + real :: KV_BBL_min !< The minimum viscosity in the bottom boundary layer [Z2 T-1 ~> m2 s-1]. real :: KV_TBL_min !< The minimum viscosity in the top boundary layer [Z2 T-1 ~> m2 s-1]. logical :: bottomdraglaw !< If true, the bottom stress is calculated with a !! drag law c_drag*|u|*u. The velocity magnitude From 48adabdd639f3a58c5cfe38a568aa145c051383d Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Wed, 3 Jul 2019 16:21:25 -0400 Subject: [PATCH 62/82] +Rescale timestep in shortwave heating routines Changed the units of the time-step arguments to sumSWoverBands and absorbRemainingSW from s to T. Also rescaled the units of the optional TKE argument returned from absorbRemainingSW. All answers are bitwise identical. --- src/core/MOM_forcing_type.F90 | 2 +- .../vertical/MOM_bulk_mixed_layer.F90 | 2 +- .../vertical/MOM_diabatic_aux.F90 | 22 ++++++++----- .../vertical/MOM_shortwave_abs.F90 | 31 +++++++++++-------- 4 files changed, 34 insertions(+), 23 deletions(-) diff --git a/src/core/MOM_forcing_type.F90 b/src/core/MOM_forcing_type.F90 index 465cdf2c28..57ef79cc24 100644 --- a/src/core/MOM_forcing_type.F90 +++ b/src/core/MOM_forcing_type.F90 @@ -928,7 +928,7 @@ subroutine calculateBuoyancyFlux1d(G, GV, US, fluxes, optics, h, Temp, Salt, tv, ! Sum over bands and attenuate as a function of depth ! netPen is the netSW as a function of depth - call sumSWoverBands(G, GV, h(:,j,:), optics%opacity_band(:,:,j,:), nsw, j, dt, & + call sumSWoverBands(G, GV, US, h(:,j,:), optics%opacity_band(:,:,j,:), nsw, j, dt*US%s_to_T, & H_limit_fluxes, .true., penSWbnd, netPen) ! Density derivatives diff --git a/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 b/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 index 3c2e153e8a..56a9d5b618 100644 --- a/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 +++ b/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 @@ -570,7 +570,7 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt_in_T, ea, eb, G, GV, cMKE, Idt_diag, nsw, Pen_SW_bnd, opacity_band, TKE, & Idecay_len_TKE, j, ksort, G, GV, US, CS) - call absorbRemainingSW(G, GV, h(:,1:), opacity_band, nsw, j, US%T_to_s*dt_in_T, CS%H_limit_fluxes, & + call absorbRemainingSW(G, GV, US, h(:,1:), opacity_band, nsw, j, dt_in_T, CS%H_limit_fluxes, & CS%correct_absorption, CS%absorb_all_SW, & T(:,1:), Pen_SW_bnd, eps, ksort, htot, Ttot) diff --git a/src/parameterizations/vertical/MOM_diabatic_aux.F90 b/src/parameterizations/vertical/MOM_diabatic_aux.F90 index 8bbadd535a..24ef2f2d0f 100644 --- a/src/parameterizations/vertical/MOM_diabatic_aux.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_aux.F90 @@ -828,15 +828,20 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, US, dt, fluxes, optics, h, tv, & netsalt_rate, & ! netsalt but for dt=1 (e.g. returns a rate) ! [ppt H s-1 ~> ppt m s-1 or ppt kg m-2 s-1] netMassInOut_rate! netmassinout but for dt=1 [H s-1 ~> m s-1 or kg m-2 s-1] - real, dimension(SZI_(G), SZK_(G)) :: h2d, T2d - real, dimension(SZI_(G), SZK_(G)) :: pen_TKE_2d, dSV_dT_2d + real, dimension(SZI_(G), SZK_(G)) :: & + h2d, & ! A 2-d copy of the thicknesses [H ~> m or kg m-2] + T2d, & ! A 2-d copy of the layer temperatures [degC] + pen_TKE_2d, & ! The TKE required to homogenize the heating by shortwave radiation within + ! a layer [kg m-3 Z3 T-2 ~> J m-2] + dSV_dT_2d ! The partial derivative of specific volume with temperature [m3 kg-1 degC-1] real, dimension(SZI_(G),SZK_(G)+1) :: netPen real, dimension(max(optics%nbands,1),SZI_(G)) :: Pen_SW_bnd, Pen_SW_bnd_rate !^ _rate is w/ dt=1 real, dimension(max(optics%nbands,1),SZI_(G),SZK_(G)) :: opacityBand - real :: hGrounding(maxGroundings) + real, dimension(maxGroundings) :: hGrounding real :: Temp_in, Salin_in ! real :: I_G_Earth + real :: dt_in_T ! The time step converted to T units [T ~> s] real :: g_Hconv2 real :: GoRho ! g_Earth times a unit conversion factor divided by density ! [Z m3 s-2 kg-1 ~> m4 s-2 kg-1] @@ -852,6 +857,7 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, US, dt, fluxes, optics, h, tv, & if (.not.associated(fluxes%sw)) return #define _OLD_ALG_ + dt_in_T = dt * US%s_to_T nsw = optics%nbands Idt = 1.0/dt @@ -1189,19 +1195,19 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, US, dt, fluxes, optics, h, tv, & CS%penSWflux_diag(i,j,k) = 0.0 enddo ; enddo k=nz+1 ; do i=is,ie - CS%penSWflux_diag(i,j,k) = 0.0 + CS%penSWflux_diag(i,j,k) = 0.0 enddo endif if (calculate_energetics) then - call absorbRemainingSW(G, GV, h2d, opacityBand, nsw, j, dt, H_limit_fluxes, & + call absorbRemainingSW(G, GV, US, h2d, opacityBand, nsw, j, dt_in_T, H_limit_fluxes, & .false., .true., T2d, Pen_SW_bnd, TKE=pen_TKE_2d, dSV_dT=dSV_dT_2d) k = 1 ! For setting break-points. do k=1,nz ; do i=is,ie - cTKE(i,j,k) = cTKE(i,j,k) + (US%m_to_Z**3 * US%T_to_s**2) * pen_TKE_2d(i,k) + cTKE(i,j,k) = cTKE(i,j,k) + pen_TKE_2d(i,k) enddo ; enddo else - call absorbRemainingSW(G, GV, h2d, opacityBand, nsw, j, dt, H_limit_fluxes, & + call absorbRemainingSW(G, GV, US, h2d, opacityBand, nsw, j, dt_in_T, H_limit_fluxes, & .false., .true., T2d, Pen_SW_bnd) endif @@ -1254,7 +1260,7 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, US, dt, fluxes, optics, h, tv, & netPen(:,:) = 0.0 ! Sum over bands and attenuate as a function of depth ! netPen is the netSW as a function of depth - call sumSWoverBands(G, GV, h2d(:,:), optics%opacity_band(:,:,j,:), nsw, j, dt, & + call sumSWoverBands(G, GV, US, h2d(:,:), optics%opacity_band(:,:,j,:), nsw, j, dt_in_T, & H_limit_fluxes, .true., pen_SW_bnd_rate, netPen) ! Density derivatives call calculate_density_derivs(T2d(:,1), tv%S(:,j,1), SurfPressure, & diff --git a/src/parameterizations/vertical/MOM_shortwave_abs.F90 b/src/parameterizations/vertical/MOM_shortwave_abs.F90 index cf0da1c5f3..d24e5ed55e 100644 --- a/src/parameterizations/vertical/MOM_shortwave_abs.F90 +++ b/src/parameterizations/vertical/MOM_shortwave_abs.F90 @@ -6,6 +6,7 @@ module MOM_shortwave_abs use MOM_error_handler, only : MOM_error, FATAL, WARNING use MOM_file_parser, only : get_param, log_param, log_version, param_file_type use MOM_grid, only : ocean_grid_type +use MOM_unit_scaling, only : unit_scale_type use MOM_verticalGrid, only : verticalGrid_type implicit none ; private @@ -42,12 +43,13 @@ module MOM_shortwave_abs !! water column thickness is greater than H_limit_fluxes. !! For thinner water columns, the heating is scaled down proportionately, the assumption being that the !! remaining heating (which is left in Pen_SW) should go into an (absent for now) ocean bottom sediment layer. -subroutine absorbRemainingSW(G, GV, h, opacity_band, nsw, j, dt, H_limit_fluxes, & +subroutine absorbRemainingSW(G, GV, US, h, opacity_band, nsw, j, dt, H_limit_fluxes, & adjustAbsorptionProfile, absorbAllSW, T, Pen_SW_bnd, & eps, ksort, htot, Ttot, TKE, dSV_dT) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]. real, dimension(:,:,:), intent(in) :: opacity_band !< Opacity in each band of penetrating !! shortwave radiation [H-1 ~> m-1 or m2 kg-1]. @@ -55,7 +57,7 @@ subroutine absorbRemainingSW(G, GV, h, opacity_band, nsw, j, dt, H_limit_fluxes, integer, intent(in) :: nsw !< Number of bands of penetrating !! shortwave radiation. integer, intent(in) :: j !< j-index to work on. - real, intent(in) :: dt !< Time step [s]. + real, intent(in) :: dt !< Time step [T ~> s]. real, intent(in) :: H_limit_fluxes !< If the total ocean depth is !! less than this, they are scaled away !! to avoid numerical instabilities @@ -91,7 +93,7 @@ subroutine absorbRemainingSW(G, GV, h, opacity_band, nsw, j, dt, H_limit_fluxes, real, dimension(SZI_(G),SZK_(G)), optional, intent(in) :: dSV_dT !< The partial derivative of specific !! volume with temperature [m3 kg-1 degC-1]. real, dimension(SZI_(G),SZK_(G)), optional, intent(inout) :: TKE !< The TKE sink from mixing the heating - !! throughout a layer [J m-2]. + !! throughout a layer [kg m-3 Z3 T-2 ~> J m-2]. ! Local variables real, dimension(SZI_(G),SZK_(G)) :: & T_chg_above ! A temperature change that will be applied to all the thick @@ -126,12 +128,12 @@ subroutine absorbRemainingSW(G, GV, h, opacity_band, nsw, j, dt, H_limit_fluxes, real :: coSWa_frac ! The fraction of SWa that is actually moved upward. real :: min_SW_heating ! A minimum remaining shortwave heating rate that will be simply ! absorbed in the next layer for computational efficiency, instead of - ! continuing to penetrate [degC H s-1 ~> degC m s-1 or degC kg m-2 s-1]. + ! continuing to penetrate [degC H T-1 ~> degC m s-1 or degC kg m-2 s-1]. ! The default, 2.5e-11, is about 0.08 degC m / century. real :: epsilon ! A small thickness that must remain in each ! layer, and which will not be subject to heating [H ~> m or kg m-2] - real :: I_G_Earth - real :: g_Hconv2 + real :: g_Hconv2 ! A conversion factor for use in the TKE calculation + ! in units of [Z3 kg2 m-6 T-2 H-2 ~> kg2 m-5 s-2 or m s-2]. logical :: SW_Remains ! If true, some column has shortwave radiation that ! was not entirely absorbed. logical :: TKE_calc ! If true, calculate the implications to the @@ -140,14 +142,16 @@ subroutine absorbRemainingSW(G, GV, h, opacity_band, nsw, j, dt, H_limit_fluxes, integer :: is, ie, nz, i, k, ks, n SW_Remains = .false. - min_SW_heating = 2.5e-11 + min_SW_heating = 2.5e-11*US%T_to_s !### This needs *GV%m_to_H for dimensional consistency? h_min_heat = 2.0*GV%Angstrom_H + GV%H_subroundoff is = G%isc ; ie = G%iec ; nz = G%ke C1_6 = 1.0 / 6.0 ; C1_60 = 1.0 / 60.0 TKE_calc = (present(TKE) .and. present(dSV_dT)) - g_Hconv2 = GV%H_to_Pa * GV%H_to_kg_m2 + ! g_Hconv2 = (US%m_to_Z**3 * US%T_to_s**2) * GV%H_to_Pa * GV%H_to_kg_m2 + g_Hconv2 = (US%m_to_Z**4 * US%T_to_s**2 * GV%g_Earth * GV%H_to_kg_m2) * GV%H_to_kg_m2 + ! g_Hconv2 = US%m_to_Z**4 * US%T_to_s**2 * GV%g_Earth * GV%H_to_kg_m2**2 h_heat(:) = 0.0 if (present(htot)) then ; do i=is,ie ; h_heat(i) = htot(i) ; enddo ; endif @@ -176,7 +180,7 @@ subroutine absorbRemainingSW(G, GV, h, opacity_band, nsw, j, dt, H_limit_fluxes, ! absorbed without further penetration. ! ###Make these numbers into parameters! if (nsw*Pen_SW_bnd(n,i)*SW_trans < & - dt*min_SW_heating*min(GV%m_to_H,1e3*h(i,k)) ) SW_trans = 0.0 + dt*min_SW_heating*min(1.0*GV%m_to_H, 1e3*h(i,k)) ) SW_trans = 0.0 Heat_bnd = Pen_SW_bnd(n,i) * (1.0 - SW_trans) if (adjustAbsorptionProfile .and. (h_heat(i) > 0.0)) then @@ -295,13 +299,14 @@ subroutine absorbRemainingSW(G, GV, h, opacity_band, nsw, j, dt, H_limit_fluxes, end subroutine absorbRemainingSW -subroutine sumSWoverBands(G, GV, h, opacity_band, nsw, j, dt, & +subroutine sumSWoverBands(G, GV, US, h, opacity_band, nsw, j, dt, & H_limit_fluxes, absorbAllSW, iPen_SW_bnd, netPen) !< This subroutine calculates the total shortwave heat flux integrated over !! bands as a function of depth. This routine is only called for computing !! buoyancy fluxes for use in KPP. This routine does not updat e the state. type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZK_(G)), & intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]. real, dimension(:,:,:), intent(in) :: opacity_band !< opacity in each band of @@ -310,7 +315,7 @@ subroutine sumSWoverBands(G, GV, h, opacity_band, nsw, j, dt, & integer, intent(in) :: nsw !< number of bands of penetrating !! shortwave radiation. integer, intent(in) :: j !< j-index to work on. - real, intent(in) :: dt !< Time step [s]. + real, intent(in) :: dt !< Time step [T ~> s]. real, intent(in) :: H_limit_fluxes !< the total depth at which the !! surface fluxes start to be limited to avoid !! excessive heating of a thin ocean [H ~> m or kg m-2] @@ -372,8 +377,8 @@ subroutine sumSWoverBands(G, GV, h, opacity_band, nsw, j, dt, & ! Heating at a rate of less than 10-4 W m-2 = 10-3 K m / Century, ! and of the layer in question less than 1 K / Century, can be ! absorbed without further penetration. - if ((nsw*Pen_SW_bnd(n,i)*SW_trans < GV%m_to_H*2.5e-11*dt) .and. & - (nsw*Pen_SW_bnd(n,i)*SW_trans < h(i,k)*dt*2.5e-8)) & + if ((nsw*Pen_SW_bnd(n,i)*SW_trans < GV%m_to_H*2.5e-11*US%T_to_s*dt) .and. & + (nsw*Pen_SW_bnd(n,i)*SW_trans < h(i,k)*dt*US%T_to_s*2.5e-8)) & SW_trans = 0.0 Pen_SW_bnd(n,i) = Pen_SW_bnd(n,i) * SW_trans From bd201fc02032e18c6ee3b2d29cf516bc186f2817 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Wed, 3 Jul 2019 16:58:25 -0400 Subject: [PATCH 63/82] +Separate shortwave forcing to set_opacity Pass seperate shortwave forcing components to set_opacity and opacity_from_chl to break the direct dependence of the MOM_opacity module on the MOM_forcing_type module. All answers are bitwise identical, but public interfaces have changed. --- .../vertical/MOM_diabatic_driver.F90 | 15 ++-- .../vertical/MOM_opacity.F90 | 76 +++++++++---------- src/tracer/MOM_offline_main.F90 | 3 +- 3 files changed, 49 insertions(+), 45 deletions(-) diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index 642450bdac..3396a29102 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -165,7 +165,6 @@ module MOM_diabatic_driver real :: MLDdensityDifference !< Density difference used to determine MLD_user real :: dz_subML_N2 !< The distance over which to calculate a diagnostic of the !! average stratification at the base of the mixed layer [Z ~> m]. - integer :: nsw !< SW_NBANDS !>@{ Diagnostic IDs integer :: id_cg1 = -1 ! diag handle for mode-1 speed (BDM) @@ -588,7 +587,9 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim ! Set_opacity estimates the optical properties of the water column. ! It will need to be modified later to include information about the ! biological properties and layer thicknesses. - if (associated(CS%optics)) call set_opacity(CS%optics, fluxes, G, GV, CS%opacity_CSp) + if (associated(CS%optics)) & + call set_opacity(CS%optics, fluxes%sw, fluxes%sw_vis_dir, fluxes%sw_vis_dif, & + fluxes%sw_nir_dir, fluxes%sw_nir_dif, G, GV, CS%opacity_CSp) if (CS%debug) call MOM_state_chksum("before find_uv_at_h", u, v, h, G, GV, haloshift=0) @@ -1371,7 +1372,9 @@ subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, ! Set_opacity estimates the optical properties of the water column. ! It will need to be modified later to include information about the ! biological properties and layer thicknesses. - if (associated(CS%optics)) call set_opacity(CS%optics, fluxes, G, GV, CS%opacity_CSp) + if (associated(CS%optics)) & + call set_opacity(CS%optics, fluxes%sw, fluxes%sw_vis_dir, fluxes%sw_vis_dif, & + fluxes%sw_nir_dir, fluxes%sw_nir_dif, G, GV, CS%opacity_CSp) if (CS%debug) call MOM_state_chksum("before find_uv_at_h", u, v, h, G, GV, haloshift=0) @@ -2060,7 +2063,9 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e ! Set_opacity estimates the optical properties of the water column. ! It will need to be modified later to include information about the ! biological properties and layer thicknesses. - if (associated(CS%optics)) call set_opacity(CS%optics, fluxes, G, GV, CS%opacity_CSp) + if (associated(CS%optics)) & + call set_opacity(CS%optics, fluxes%sw, fluxes%sw_vis_dir, fluxes%sw_vis_dif, & + fluxes%sw_nir_dir, fluxes%sw_nir_dif, G, GV, CS%opacity_CSp) if (CS%bulkmixedlayer) then if (CS%debug) call MOM_forcing_chksum("Before mixedlayer", fluxes, G, US, haloshift=0) @@ -3720,8 +3725,6 @@ subroutine diabatic_driver_init(Time, G, GV, US, param_file, useALEalgorithm, di call opacity_init(Time, G, param_file, diag, CS%tracer_flow_CSp, CS%opacity_CSp, CS%optics) endif endif - CS%nsw = 0 - if (associated(CS%optics)) CS%nsw = CS%optics%nbands ! Initialize the diagnostic grid storage call diag_grid_storage_init(CS%diag_grids_prev, G, diag) diff --git a/src/parameterizations/vertical/MOM_opacity.F90 b/src/parameterizations/vertical/MOM_opacity.F90 index 75aa447e15..a4d66ec750 100644 --- a/src/parameterizations/vertical/MOM_opacity.F90 +++ b/src/parameterizations/vertical/MOM_opacity.F90 @@ -8,7 +8,7 @@ module MOM_opacity use MOM_error_handler, only : MOM_error, MOM_mesg, FATAL, WARNING use MOM_file_parser, only : get_param, log_param, log_version, param_file_type use MOM_string_functions, only : uppercase -use MOM_forcing_type, only : forcing, optics_type +use MOM_shortwave_abs, only : optics_type use MOM_grid, only : ocean_grid_type use MOM_io, only : slasher use MOM_tracer_flow_control, only : get_chl_from_model, tracer_flow_control_CS @@ -68,12 +68,14 @@ module MOM_opacity contains !> This sets the opacity of sea water based based on one of several different schemes. -subroutine set_opacity(optics, fluxes, G, GV, CS) +subroutine set_opacity(optics, sw_total, sw_vis_dir, sw_vis_dif, sw_nir_dir, sw_nir_dif, G, GV, CS) type(optics_type), intent(inout) :: optics !< An optics structure that has values !! set based on the opacities. - type(forcing), intent(in) :: fluxes !< A structure containing pointers to any - !! possible forcing fields. Unused fields - !! have NULL ptrs. + real, dimension(:,:), pointer :: sw_total !< Total shortwave flux into the ocean [W m-2] + real, dimension(:,:), pointer :: sw_vis_dir !< Visible, direct shortwave into the ocean [W m-2] + real, dimension(:,:), pointer :: sw_vis_dif !< Visible, diffuse shortwave into the ocean [W m-2] + real, dimension(:,:), pointer :: sw_nir_dir !< Near-IR, direct shortwave into the ocean [W m-2] + real, dimension(:,:), pointer :: sw_nir_dif !< Near-IR, diffuse shortwave into the ocean [W m-2] type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(opacity_CS), pointer :: CS !< The control structure earlier set up by @@ -96,10 +98,10 @@ subroutine set_opacity(optics, fluxes, G, GV, CS) if (CS%var_pen_sw) then if (CS%chl_from_file) then - call opacity_from_chl(optics, fluxes, G, CS) + call opacity_from_chl(optics, sw_total, sw_vis_dir, sw_vis_dif, sw_nir_dir, sw_nir_dif, G, CS) else call get_chl_from_model(chl, G, CS%tracer_flow_CSp) - call opacity_from_chl(optics, fluxes, G, CS, chl) + call opacity_from_chl(optics, sw_total, sw_vis_dir, sw_vis_dif, sw_nir_dir, sw_nir_dif, G, CS, chl) endif else ! Use sw e-folding scale set by MOM_input if (optics%nbands <= 1) then ; Inv_nbands = 1.0 @@ -115,7 +117,7 @@ subroutine set_opacity(optics, fluxes, G, GV, CS) optics%opacity_band(2,i,j,k) = 1.0 / max(CS%pen_sw_scale_2nd, & 0.1*GV%Angstrom_m,GV%H_to_m*GV%H_subroundoff) enddo ; enddo ; enddo - if (.not.associated(fluxes%sw) .or. (CS%pen_SW_scale <= 0.0)) then + if (.not.associated(sw_total) .or. (CS%pen_SW_scale <= 0.0)) then !$OMP parallel do default(shared) do j=js,je ; do i=is,ie ; do n=1,optics%nbands optics%sw_pen_band(n,i,j) = 0.0 @@ -123,15 +125,15 @@ subroutine set_opacity(optics, fluxes, G, GV, CS) else !$OMP parallel do default(shared) do j=js,je ; do i=is,ie - optics%sw_pen_band(1,i,j) = (CS%SW_1st_EXP_RATIO) * fluxes%sw(i,j) - optics%sw_pen_band(2,i,j) = (1.-CS%SW_1st_EXP_RATIO) * fluxes%sw(i,j) + optics%sw_pen_band(1,i,j) = (CS%SW_1st_EXP_RATIO) * sw_total(i,j) + optics%sw_pen_band(2,i,j) = (1.-CS%SW_1st_EXP_RATIO) * sw_total(i,j) enddo ; enddo endif else do k=1,nz ; do j=js,je ; do i=is,ie ; do n=1,optics%nbands optics%opacity_band(n,i,j,k) = inv_sw_pen_scale enddo ; enddo ; enddo ; enddo - if (.not.associated(fluxes%sw) .or. (CS%pen_SW_scale <= 0.0)) then + if (.not.associated(sw_total) .or. (CS%pen_SW_scale <= 0.0)) then !$OMP parallel do default(shared) do j=js,je ; do i=is,ie ; do n=1,optics%nbands optics%sw_pen_band(n,i,j) = 0.0 @@ -139,7 +141,7 @@ subroutine set_opacity(optics, fluxes, G, GV, CS) else !$OMP parallel do default(shared) do j=js,je ; do i=is,ie ; do n=1,optics%nbands - optics%sw_pen_band(n,i,j) = CS%pen_SW_frac * Inv_nbands * fluxes%sw(i,j) + optics%sw_pen_band(n,i,j) = CS%pen_SW_frac * Inv_nbands * sw_total(i,j) enddo ; enddo ; enddo endif endif @@ -189,17 +191,19 @@ end subroutine set_opacity !> This sets the "blue" band opacity based on chloophyll A concencentrations !! The red portion is lumped into the net heating at the surface. -subroutine opacity_from_chl(optics, fluxes, G, CS, chl_in) - type(optics_type), intent(inout) :: optics !< An optics structure that has values - !! set based on the opacities. - type(forcing), intent(in) :: fluxes !< A structure containing pointers to any - !! possible forcing fields. Unused fields - !! have NULL ptrs. - type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. - type(opacity_CS), pointer :: CS !< The control structure. +subroutine opacity_from_chl(optics, sw_total, sw_vis_dir, sw_vis_dif, sw_nir_dir, sw_nir_dif, G, CS, chl_in) + type(optics_type), intent(inout) :: optics !< An optics structure that has values + !! set based on the opacities. + real, dimension(:,:), pointer :: sw_total !< Total shortwave flux into the ocean [W m-2] + real, dimension(:,:), pointer :: sw_vis_dir !< Visible, direct shortwave into the ocean [W m-2] + real, dimension(:,:), pointer :: sw_vis_dif !< Visible, diffuse shortwave into the ocean [W m-2] + real, dimension(:,:), pointer :: sw_nir_dir !< Near-IR, direct shortwave into the ocean [W m-2] + real, dimension(:,:), pointer :: sw_nir_dif !< Near-IR, diffuse shortwave into the ocean [W m-2] + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. + type(opacity_CS), pointer :: CS !< The control structure. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - optional, intent(in) :: chl_in !< A 3-d field of chlorophyll A, - !! in mg m-3. + optional, intent(in) :: chl_in !< A 3-d field of chlorophyll A, + !! in mg m-3. real :: chl_data(SZI_(G),SZJ_(G)) ! The chlorophyll A concentrations in a layer [mg m-3]. real :: Inv_nbands ! The inverse of the number of bands of penetrating @@ -240,10 +244,10 @@ subroutine opacity_from_chl(optics, fluxes, G, CS, chl_in) if (nbands <= 2) then ; Inv_nbands_nir = 0.0 else ; Inv_nbands_nir = 1.0 / real(nbands - 2.0) ; endif - multiband_vis_input = (associated(fluxes%sw_vis_dir) .and. & - associated(fluxes%sw_vis_dif)) - multiband_nir_input = (associated(fluxes%sw_nir_dir) .and. & - associated(fluxes%sw_nir_dif)) + multiband_vis_input = (associated(sw_vis_dir) .and. & + associated(sw_vis_dif)) + multiband_nir_input = (associated(sw_nir_dir) .and. & + associated(sw_nir_dif)) chl_data(:,:) = 0.0 if (present(chl_in)) then @@ -280,21 +284,19 @@ subroutine opacity_from_chl(optics, fluxes, G, CS, chl_in) select case (CS%opacity_scheme) case (MANIZZA_05) -!$OMP parallel do default(none) shared(is,ie,js,je,fluxes,optics,CS,G,multiband_nir_input, & -!$OMP nbands,Inv_nbands_nir,multiband_vis_input ) & -!$OMP private(SW_vis_tot,SW_nir_tot) + !$OMP parallel do default(shared) private(SW_vis_tot,SW_nir_tot) do j=js,je ; do i=is,ie SW_vis_tot = 0.0 ; SW_nir_tot = 0.0 if (G%mask2dT(i,j) > 0.5) then if (multiband_vis_input) then - SW_vis_tot = fluxes%sw_vis_dir(i,j) + fluxes%sw_vis_dif(i,j) + SW_vis_tot = sw_vis_dir(i,j) + sw_vis_dif(i,j) else ! Follow Manizza 05 in assuming that 42% of SW is visible. - SW_vis_tot = 0.42 * fluxes%sw(i,j) + SW_vis_tot = 0.42 * sw_total(i,j) endif if (multiband_nir_input) then - SW_nir_tot = fluxes%sw_nir_dir(i,j) + fluxes%sw_nir_dif(i,j) + SW_nir_tot = sw_nir_dir(i,j) + sw_nir_dif(i,j) else - SW_nir_tot = fluxes%sw(i,j) - SW_vis_tot + SW_nir_tot = sw_total(i,j) - SW_vis_tot endif endif @@ -309,17 +311,15 @@ subroutine opacity_from_chl(optics, fluxes, G, CS, chl_in) enddo enddo ; enddo case (MOREL_88) -!$OMP parallel do default(none) shared(is,ie,js,je,G,multiband_vis_input,chl_data, & -!$OMP fluxes,nbands,optics,Inv_nbands) & -!$OMP private(SW_pen_tot) + !$OMP parallel do default(shared) private(SW_pen_tot) do j=js,je ; do i=is,ie SW_pen_tot = 0.0 if (G%mask2dT(i,j) > 0.5) then ; if (multiband_vis_input) then SW_pen_tot = SW_pen_frac_morel(chl_data(i,j)) * & - (fluxes%sw_vis_dir(i,j) + fluxes%sw_vis_dif(i,j)) + (sw_vis_dir(i,j) + sw_vis_dif(i,j)) else SW_pen_tot = SW_pen_frac_morel(chl_data(i,j)) * & - 0.5*fluxes%sw(i,j) + 0.5*sw_total(i,j) endif ; endif do n=1,nbands diff --git a/src/tracer/MOM_offline_main.F90 b/src/tracer/MOM_offline_main.F90 index 00b61210fe..fc9a2c1353 100644 --- a/src/tracer/MOM_offline_main.F90 +++ b/src/tracer/MOM_offline_main.F90 @@ -718,7 +718,8 @@ subroutine offline_diabatic_ale(fluxes, Time_start, Time_end, CS, h_pre, eatr, e endif if (associated(CS%optics)) & - call set_opacity(CS%optics, fluxes, CS%G, CS%GV, CS%opacity_CSp) + call set_opacity(CS%optics, fluxes%sw, fluxes%sw_vis_dir, fluxes%sw_vis_dif, & + fluxes%sw_nir_dir, fluxes%sw_nir_dif, CS%G, CS%GV, CS%opacity_CSp) ! Note that tracerBoundaryFluxesInOut within this subroutine should NOT be called ! as the freshwater fluxes have already been accounted for From 4937fe5e1ec9f46676abcb527bdd5cf320bf4c45 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Wed, 3 Jul 2019 17:25:26 -0400 Subject: [PATCH 64/82] +Added the new subroutine set_pen_shortwave Added the new subroutine set_pen_shortwave to the MOM_diabatic_aux module to initially act as a convenient interface to set_opacity, but ultimately to handle setting up chlorophyll concentrations and allow set_opacity to be merged with MOM_shortwave_abs. All answers are bitwise identical, but there is a new public interface. --- .../vertical/MOM_diabatic_aux.F90 | 22 +++++++++++++++++- .../vertical/MOM_diabatic_driver.F90 | 23 ++++++++++--------- src/tracer/MOM_offline_main.F90 | 12 ++++++---- 3 files changed, 40 insertions(+), 17 deletions(-) diff --git a/src/parameterizations/vertical/MOM_diabatic_aux.F90 b/src/parameterizations/vertical/MOM_diabatic_aux.F90 index 24ef2f2d0f..e1b9ce9ea6 100644 --- a/src/parameterizations/vertical/MOM_diabatic_aux.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_aux.F90 @@ -15,6 +15,7 @@ module MOM_diabatic_aux use MOM_file_parser, only : get_param, log_version, param_file_type use MOM_forcing_type, only : forcing, extractFluxes1d, forcing_SinglePointPrint use MOM_grid, only : ocean_grid_type +use MOM_opacity, only : set_opacity, opacity_CS use MOM_shortwave_abs, only : absorbRemainingSW, optics_type, sumSWoverBands use MOM_unit_scaling, only : unit_scale_type use MOM_variables, only : thermo_var_ptrs, vertvisc_type! , accel_diag_ptrs @@ -26,7 +27,7 @@ module MOM_diabatic_aux public diabatic_aux_init, diabatic_aux_end public make_frazil, adjust_salt, insert_brine, differential_diffuse_T_S, triDiagTS -public find_uv_at_h, diagnoseMLDbyDensityDifference, applyBoundaryFluxesInOut +public find_uv_at_h, diagnoseMLDbyDensityDifference, applyBoundaryFluxesInOut, set_pen_shortwave ! A note on unit descriptions in comments: MOM6 uses units that can be rescaled for dimensional ! consistency testing. These are noted in comments with units like Z, H, L, and T, along with @@ -638,6 +639,25 @@ subroutine find_uv_at_h(u, v, h, u_h, v_h, G, GV, ea, eb) end subroutine find_uv_at_h +subroutine set_pen_shortwave(optics, fluxes, G, GV, CS, opacity_CSp) + type(optics_type), pointer :: optics !< An optics structure that has will contain + !! information about shortwave fluxes and absorption. + type(forcing), intent(inout) :: fluxes !< points to forcing fields + !! unused fields have NULL ptrs + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. + type(diabatic_aux_CS), pointer :: CS !< Control structure for diabatic_aux + type(opacity_CS), pointer :: opacity_CSp !< The control structure for the opacity module. + + + + if (associated(optics)) & + call set_opacity(optics, fluxes%sw, fluxes%sw_vis_dir, fluxes%sw_vis_dif, & + fluxes%sw_nir_dir, fluxes%sw_nir_dif, G, GV, opacity_CSp) + +end subroutine set_pen_shortwave + + !> Diagnose a mixed layer depth (MLD) determined by a given density difference with the surface. !> This routine is appropriate in MOM_diabatic_driver due to its position within the time stepping. subroutine diagnoseMLDbyDensityDifference(id_MLD, h, tv, densityDiff, G, GV, US, diagPtr, & diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index 3396a29102..ab04d7d918 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -14,6 +14,7 @@ module MOM_diabatic_driver use MOM_diabatic_aux, only : diabatic_aux_init, diabatic_aux_end, diabatic_aux_CS use MOM_diabatic_aux, only : make_frazil, adjust_salt, insert_brine, differential_diffuse_T_S, triDiagTS use MOM_diabatic_aux, only : find_uv_at_h, diagnoseMLDbyDensityDifference, applyBoundaryFluxesInOut +use MOM_diabatic_aux, only : set_pen_shortwave use MOM_diag_mediator, only : post_data, register_diag_field, safe_alloc_ptr use MOM_diag_mediator, only : diag_ctrl, time_type, diag_update_remap_grids use MOM_diag_mediator, only : diag_ctrl, query_averaging_enabled, enable_averaging, disable_averaging @@ -51,7 +52,7 @@ module MOM_diabatic_driver use MOM_CVMix_KPP, only : KPP_CS, KPP_init, KPP_compute_BLD, KPP_calculate use MOM_CVMix_KPP, only : KPP_end, KPP_get_BLD use MOM_CVMix_KPP, only : KPP_NonLocalTransport_temp, KPP_NonLocalTransport_saln -use MOM_opacity, only : opacity_init, set_opacity, opacity_end, opacity_CS +use MOM_opacity, only : opacity_init, opacity_end, opacity_CS use MOM_regularize_layers, only : regularize_layers, regularize_layers_init, regularize_layers_CS use MOM_set_diffusivity, only : set_diffusivity, set_BBL_TKE use MOM_set_diffusivity, only : set_diffusivity_init, set_diffusivity_end @@ -584,12 +585,11 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim ! for vertical remapping may need to be regenerated. call diag_update_remap_grids(CS%diag) - ! Set_opacity estimates the optical properties of the water column. + ! Set_pen_shortwave estimates the optical properties of the water column. ! It will need to be modified later to include information about the ! biological properties and layer thicknesses. if (associated(CS%optics)) & - call set_opacity(CS%optics, fluxes%sw, fluxes%sw_vis_dir, fluxes%sw_vis_dif, & - fluxes%sw_nir_dir, fluxes%sw_nir_dif, G, GV, CS%opacity_CSp) + call set_pen_shortwave(CS%optics, fluxes, G, GV, CS%diabatic_aux_CSp, CS%opacity_CSp) if (CS%debug) call MOM_state_chksum("before find_uv_at_h", u, v, h, G, GV, haloshift=0) @@ -1369,12 +1369,11 @@ subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, ! for vertical remapping may need to be regenerated. call diag_update_remap_grids(CS%diag) - ! Set_opacity estimates the optical properties of the water column. + ! Set_pen_shortwave estimates the optical properties of the water column. ! It will need to be modified later to include information about the ! biological properties and layer thicknesses. if (associated(CS%optics)) & - call set_opacity(CS%optics, fluxes%sw, fluxes%sw_vis_dir, fluxes%sw_vis_dif, & - fluxes%sw_nir_dir, fluxes%sw_nir_dif, G, GV, CS%opacity_CSp) + call set_pen_shortwave(CS%optics, fluxes, G, GV, CS%diabatic_aux_CSp, CS%opacity_CSp) if (CS%debug) call MOM_state_chksum("before find_uv_at_h", u, v, h, G, GV, haloshift=0) @@ -2060,12 +2059,11 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e ! for vertical remapping may need to be regenerated. call diag_update_remap_grids(CS%diag) - ! Set_opacity estimates the optical properties of the water column. + ! Set_pen_shortwave estimates the optical properties of the water column. ! It will need to be modified later to include information about the ! biological properties and layer thicknesses. if (associated(CS%optics)) & - call set_opacity(CS%optics, fluxes%sw, fluxes%sw_vis_dir, fluxes%sw_vis_dif, & - fluxes%sw_nir_dir, fluxes%sw_nir_dif, G, GV, CS%opacity_CSp) + call set_pen_shortwave(CS%optics, fluxes, G, GV, CS%diabatic_aux_CSp, CS%opacity_CSp) if (CS%bulkmixedlayer) then if (CS%debug) call MOM_forcing_chksum("Before mixedlayer", fluxes, G, US, haloshift=0) @@ -2866,7 +2864,7 @@ end subroutine layered_diabatic !> Returns pointers or values of members within the diabatic_CS type. For extensibility, !! each returned argument is an optional argument subroutine extract_diabatic_member(CS, opacity_CSp, optics_CSp, & - evap_CFL_limit, minimum_forcing_depth) + evap_CFL_limit, minimum_forcing_depth, diabatic_aux_CSp) type(diabatic_CS), intent(in ) :: CS !< module control structure ! All output arguments are optional type(opacity_CS), optional, pointer :: opacity_CSp !< A pointer to be set to the opacity control structure @@ -2875,10 +2873,13 @@ subroutine extract_diabatic_member(CS, opacity_CSp, optics_CSp, & !! evaporated in one time-step [nondim]. real, optional, intent( out) :: minimum_forcing_depth !< The smallest depth over which heat !! and freshwater fluxes are applied [m]. + type(diabatic_aux_CS), optional, pointer :: diabatic_aux_CSp !< A pointer to be set to the diabatic_aux + !! control structure ! Pointers to control structures if (present(opacity_CSp)) opacity_CSp => CS%opacity_CSp if (present(optics_CSp)) optics_CSp => CS%optics + if (present(diabatic_aux_CSp)) diabatic_aux_CSp => CS%diabatic_aux_CSp ! Constants within diabatic_CS if (present(evap_CFL_limit)) evap_CFL_limit = CS%evap_CFL_limit diff --git a/src/tracer/MOM_offline_main.F90 b/src/tracer/MOM_offline_main.F90 index fc9a2c1353..3241cb0fa4 100644 --- a/src/tracer/MOM_offline_main.F90 +++ b/src/tracer/MOM_offline_main.F90 @@ -10,7 +10,7 @@ module MOM_offline_main use MOM_cpu_clock, only : cpu_clock_id, cpu_clock_begin, cpu_clock_end use MOM_cpu_clock, only : CLOCK_COMPONENT, CLOCK_SUBCOMPONENT use MOM_cpu_clock, only : CLOCK_MODULE_DRIVER, CLOCK_MODULE, CLOCK_ROUTINE -use MOM_diabatic_aux, only : diabatic_aux_CS +use MOM_diabatic_aux, only : diabatic_aux_CS, set_pen_shortwave use MOM_diabatic_driver, only : diabatic_CS, extract_diabatic_member use MOM_diabatic_aux, only : tridiagTS use MOM_diag_mediator, only : diag_ctrl, post_data, register_diag_field @@ -26,7 +26,7 @@ module MOM_offline_main use MOM_offline_aux, only : update_h_horizontal_flux, update_h_vertical_flux, limit_mass_flux_3d use MOM_offline_aux, only : distribute_residual_uh_barotropic, distribute_residual_vh_barotropic use MOM_offline_aux, only : distribute_residual_uh_upwards, distribute_residual_vh_upwards -use MOM_opacity, only : set_opacity, opacity_CS +use MOM_opacity, only : opacity_CS use MOM_open_boundary, only : ocean_OBC_type use MOM_shortwave_abs, only : optics_type use MOM_time_manager, only : time_type @@ -70,6 +70,8 @@ module MOM_offline_main !< Pointer to structure containing information about the vertical grid type(optics_type), pointer :: optics => NULL() !< Pointer to the optical properties type + type(diabatic_aux_CS), pointer :: diabatic_aux_CSp => NULL() + !< Pointer to the diabatic_aux control structure !> Variables related to reading in fields from online run integer :: start_index !< Timelevel to start @@ -718,8 +720,7 @@ subroutine offline_diabatic_ale(fluxes, Time_start, Time_end, CS, h_pre, eatr, e endif if (associated(CS%optics)) & - call set_opacity(CS%optics, fluxes%sw, fluxes%sw_vis_dir, fluxes%sw_vis_dif, & - fluxes%sw_nir_dir, fluxes%sw_nir_dif, CS%G, CS%GV, CS%opacity_CSp) + call set_pen_shortwave(CS%optics, fluxes, CS%G, CS%GV, CS%diabatic_aux_CSp, CS%opacity_CSp) ! Note that tracerBoundaryFluxesInOut within this subroutine should NOT be called ! as the freshwater fluxes have already been accounted for @@ -1401,7 +1402,8 @@ subroutine offline_transport_init(param_file, CS, diabatic_CSp, G, GV) if (.not. CS%fields_are_offset) CS%ridx_snap = CS%start_index ! Copy members from other modules - call extract_diabatic_member(diabatic_CSp, opacity_CSp=CS%opacity_CSp, optics_CSp=CS%optics,& + call extract_diabatic_member(diabatic_CSp, opacity_CSp=CS%opacity_CSp, optics_CSp=CS%optics, & + diabatic_aux_CSp=CS%diabatic_aux_CSp, & evap_CFL_limit=CS%evap_CFL_limit, & minimum_forcing_depth=CS%minimum_forcing_depth) From 2640b93335588db2509bb8107a667b22b296b7e3 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Fri, 5 Jul 2019 14:03:17 -0400 Subject: [PATCH 65/82] +Set chlorophyll for shortwave in set_pen_shortwave Moved code setting chlorophyll into set_pen_shortwave, along with moving the parameters controlling how this is set into the MOM_diabatic_aux module control structure. All answers are bitwise identical, but the order of entries in the MOM_parameter_doc files has changed. --- .../vertical/MOM_diabatic_aux.F90 | 99 +++++++++++- .../vertical/MOM_diabatic_driver.F90 | 8 +- .../vertical/MOM_opacity.F90 | 149 ++++++------------ src/tracer/MOM_offline_main.F90 | 2 +- 4 files changed, 150 insertions(+), 108 deletions(-) diff --git a/src/parameterizations/vertical/MOM_diabatic_aux.F90 b/src/parameterizations/vertical/MOM_diabatic_aux.F90 index e1b9ce9ea6..972e050b82 100644 --- a/src/parameterizations/vertical/MOM_diabatic_aux.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_aux.F90 @@ -12,14 +12,18 @@ module MOM_diabatic_aux use MOM_EOS, only : calculate_specific_vol_derivs, calculate_density_derivs use MOM_error_handler, only : MOM_error, FATAL, WARNING, callTree_showQuery use MOM_error_handler, only : callTree_enter, callTree_leave, callTree_waypoint -use MOM_file_parser, only : get_param, log_version, param_file_type +use MOM_file_parser, only : get_param, log_param, log_version, param_file_type use MOM_forcing_type, only : forcing, extractFluxes1d, forcing_SinglePointPrint use MOM_grid, only : ocean_grid_type +use MOM_io, only : slasher use MOM_opacity, only : set_opacity, opacity_CS use MOM_shortwave_abs, only : absorbRemainingSW, optics_type, sumSWoverBands +use MOM_tracer_flow_control, only : get_chl_from_model, tracer_flow_control_CS use MOM_unit_scaling, only : unit_scale_type use MOM_variables, only : thermo_var_ptrs, vertvisc_type! , accel_diag_ptrs use MOM_verticalGrid, only : verticalGrid_type +use time_interp_external_mod, only : init_external_field, time_interp_external +use time_interp_external_mod, only : time_interp_external_init implicit none ; private @@ -56,7 +60,13 @@ module MOM_diabatic_aux logical :: use_calving_heat_content !< If true, assumes that ice-ocean boundary !! has provided a calving heat content. Otherwise, calving !! is added with a temperature of the local SST. + logical :: var_pen_sw !< If true, use one of the CHL_A schemes to determine the + !! e-folding depth of incoming shortwave radiation. + integer :: sbc_chl !< An integer handle used in time interpolation of + !! chlorophyll read from a file. + logical :: chl_from_file !< If true, chl_a is read from a file. + type(time_type), pointer :: Time => NULL() !< A pointer to the ocean model's clock. type(diag_ctrl), pointer :: diag !< Structure used to regulate timing of diagnostic output ! Diagnostic handles @@ -65,6 +75,7 @@ module MOM_diabatic_aux integer :: id_penSW_diag = -1 !< Diagnostic ID of Penetrative shortwave heating (flux convergence) integer :: id_penSWflux_diag = -1 !< Diagnostic ID of Penetrative shortwave flux integer :: id_nonpenSW_diag = -1 !< Diagnostic ID of Non-penetrative shortwave heating + integer :: id_Chl = -1 !< Diagnostic ID of chlorophyll-A handles for opacity ! Optional diagnostic arrays real, allocatable, dimension(:,:) :: createdH !< The amount of volume added in order to @@ -573,7 +584,7 @@ subroutine find_uv_at_h(u, v, h, u_h, v_h, G, GV, ea, eb) real :: s, Idenom logical :: mix_vertically integer :: i, j, k, is, ie, js, je, nz - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke call cpu_clock_begin(id_clock_uv_at_h) h_neglect = GV%H_subroundoff @@ -639,7 +650,7 @@ subroutine find_uv_at_h(u, v, h, u_h, v_h, G, GV, ea, eb) end subroutine find_uv_at_h -subroutine set_pen_shortwave(optics, fluxes, G, GV, CS, opacity_CSp) +subroutine set_pen_shortwave(optics, fluxes, G, GV, CS, opacity_CSp, tracer_flow_CSp) type(optics_type), pointer :: optics !< An optics structure that has will contain !! information about shortwave fluxes and absorption. type(forcing), intent(inout) :: fluxes !< points to forcing fields @@ -648,12 +659,50 @@ subroutine set_pen_shortwave(optics, fluxes, G, GV, CS, opacity_CSp) type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(diabatic_aux_CS), pointer :: CS !< Control structure for diabatic_aux type(opacity_CS), pointer :: opacity_CSp !< The control structure for the opacity module. + type(tracer_flow_control_CS), pointer :: tracer_flow_CSp !< A pointer to the control structure of the tracer modules. + + ! Local variables + real, dimension(SZI_(G),SZJ_(G)) :: chl_2d !< Vertically uniform chlorophyll-A concentractions [mg m-3] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: chl_3d !< The chlorophyll-A concentractions of each layer [mg m-3] + character(len=128) :: mesg + integer :: i, j, k, is, ie, js, je + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec + + if (.not.associated(optics)) return + + if (CS%var_pen_sw) then + if (CS%chl_from_file) then + ! Only the 2-d surface chlorophyll can be read in from a file. The + ! same value is assumed for all layers. + call time_interp_external(CS%sbc_chl, CS%Time, chl_2d) + do j=js,je ; do i=is,ie + if ((G%mask2dT(i,j) > 0.5) .and. (chl_2d(i,j) < 0.0)) then + write(mesg,'(" Time_interp negative chl of ",(1pe12.4)," at i,j = ",& + & 2(i3), "lon/lat = ",(1pe12.4)," E ", (1pe12.4), " N.")') & + chl_2d(i,j), i, j, G%geoLonT(i,j), G%geoLatT(i,j) + call MOM_error(FATAL, "MOM_diabatic_aux set_pen_shortwave: "//trim(mesg)) + endif + enddo ; enddo + + if (CS%id_chl > 0) call post_data(CS%id_chl, chl_2d, CS%diag) + call set_opacity(optics, fluxes%sw, fluxes%sw_vis_dir, fluxes%sw_vis_dif, & + fluxes%sw_nir_dir, fluxes%sw_nir_dif, G, GV, opacity_CSp, chl_2d=chl_2d) + else + if (.not.associated(tracer_flow_CSp)) call MOM_error(FATAL, & + "The tracer flow control structure must be associated when the model sets "//& + "the chlorophyll internally in set_pen_shortwave.") + call get_chl_from_model(chl_3d, G, tracer_flow_CSp) + if (CS%id_chl > 0) call post_data(CS%id_chl, chl_3d(:,:,1), CS%diag) - if (associated(optics)) & + call set_opacity(optics, fluxes%sw, fluxes%sw_vis_dir, fluxes%sw_vis_dif, & + fluxes%sw_nir_dir, fluxes%sw_nir_dif, G, GV, opacity_CSp, chl_3d=chl_3d) + endif + else call set_opacity(optics, fluxes%sw, fluxes%sw_vis_dir, fluxes%sw_vis_dif, & fluxes%sw_nir_dir, fluxes%sw_nir_dif, G, GV, opacity_CSp) + endif end subroutine set_pen_shortwave @@ -1326,7 +1375,7 @@ end subroutine applyBoundaryFluxesInOut !> This subroutine initializes the parameters and control structure of the diabatic_aux module. subroutine diabatic_aux_init(Time, G, GV, US, param_file, diag, CS, useALEalgorithm, use_ePBL) - type(time_type), intent(in) :: Time !< The current model time + type(time_type), target, intent(in) :: Time !< The current model time. type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type @@ -1344,6 +1393,12 @@ subroutine diabatic_aux_init(Time, G, GV, US, param_file, diag, CS, useALEalgori #include "version_variable.h" character(len=40) :: mdl = "MOM_diabatic_aux" ! This module's name. character(len=48) :: thickness_units + character(len=200) :: inputdir ! The directory where NetCDF input files + character(len=240) :: chl_filename ! A file from which chl_a concentrations are to be read. + character(len=128) :: chl_file ! Data containing chl_a concentrations. Used + ! when var_pen_sw is defined and reading from file. + character(len=32) :: chl_varname ! Name of chl_a variable in chl_file. + logical :: use_temperature ! True if thermodynamics are enabled. integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB, nz, nbands isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed ; nz = G%ke IsdB = G%IsdB ; IedB = G%IedB ; JsdB = G%JsdB ; JedB = G%JedB @@ -1357,11 +1412,16 @@ subroutine diabatic_aux_init(Time, G, GV, US, param_file, diag, CS, useALEalgori endif CS%diag => diag + CS%Time => Time ! Set default, read and log parameters call log_version(param_file, mdl, version, & "The following parameters are used for auxiliary diabatic processes.") + call get_param(param_file, mdl, "ENABLE_THERMODYNAMICS", use_temperature, & + "If true, temperature and salinity are used as state "//& + "variables.", default=.true.) + call get_param(param_file, mdl, "RECLAIM_FRAZIL", CS%reclaim_frazil, & "If true, try to use any frazil heat deficit to cool any "//& "overlying layers down to the freezing point, thereby "//& @@ -1443,6 +1503,35 @@ subroutine diabatic_aux_init(Time, G, GV, US, param_file, diag, CS, useALEalgori endif endif + if (use_temperature) then + call get_param(param_file, mdl, "VAR_PEN_SW", CS%var_pen_sw, & + "If true, use one of the CHL_A schemes specified by "//& + "OPACITY_SCHEME to determine the e-folding depth of "//& + "incoming short wave radiation.", default=.false.) + if (CS%var_pen_sw) then + + call get_param(param_file, mdl, "CHL_FROM_FILE", CS%chl_from_file, & + "If true, chl_a is read from a file.", default=.true.) + if (CS%chl_from_file) then + call time_interp_external_init() + + call get_param(param_file, mdl, "INPUTDIR", inputdir, default=".") + call get_param(param_file, mdl, "CHL_FILE", chl_file, & + "CHL_FILE is the file containing chl_a concentrations in "//& + "the variable CHL_A. It is used when VAR_PEN_SW and "//& + "CHL_FROM_FILE are true.", fail_if_missing=.true.) + chl_filename = trim(slasher(inputdir))//trim(chl_file) + call log_param(param_file, mdl, "INPUTDIR/CHL_FILE", chl_filename) + call get_param(param_file, mdl, "CHL_VARNAME", chl_varname, & + "Name of CHL_A variable in CHL_FILE.", default='CHL_A') + CS%sbc_chl = init_external_field(chl_filename, trim(chl_varname), domain=G%Domain%mpp_domain) + endif + + CS%id_chl = register_diag_field('ocean_model', 'Chl_opac', diag%axesT1, Time, & + 'Surface chlorophyll A concentration used to find opacity', 'mg m-3') + endif + endif + id_clock_uv_at_h = cpu_clock_id('(Ocean find_uv_at_h)', grain=CLOCK_ROUTINE) id_clock_frazil = cpu_clock_id('(Ocean frazil)', grain=CLOCK_ROUTINE) diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index ab04d7d918..714bea2926 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -589,7 +589,7 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim ! It will need to be modified later to include information about the ! biological properties and layer thicknesses. if (associated(CS%optics)) & - call set_pen_shortwave(CS%optics, fluxes, G, GV, CS%diabatic_aux_CSp, CS%opacity_CSp) + call set_pen_shortwave(CS%optics, fluxes, G, GV, CS%diabatic_aux_CSp, CS%opacity_CSp, CS%tracer_flow_CSp) if (CS%debug) call MOM_state_chksum("before find_uv_at_h", u, v, h, G, GV, haloshift=0) @@ -1373,7 +1373,7 @@ subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, ! It will need to be modified later to include information about the ! biological properties and layer thicknesses. if (associated(CS%optics)) & - call set_pen_shortwave(CS%optics, fluxes, G, GV, CS%diabatic_aux_CSp, CS%opacity_CSp) + call set_pen_shortwave(CS%optics, fluxes, G, GV, CS%diabatic_aux_CSp, CS%opacity_CSp, CS%tracer_flow_CSp) if (CS%debug) call MOM_state_chksum("before find_uv_at_h", u, v, h, G, GV, haloshift=0) @@ -2063,7 +2063,7 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e ! It will need to be modified later to include information about the ! biological properties and layer thicknesses. if (associated(CS%optics)) & - call set_pen_shortwave(CS%optics, fluxes, G, GV, CS%diabatic_aux_CSp, CS%opacity_CSp) + call set_pen_shortwave(CS%optics, fluxes, G, GV, CS%diabatic_aux_CSp, CS%opacity_CSp, CS%tracer_flow_CSp) if (CS%bulkmixedlayer) then if (CS%debug) call MOM_forcing_chksum("Before mixedlayer", fluxes, G, US, haloshift=0) @@ -3723,7 +3723,7 @@ subroutine diabatic_driver_init(Time, G, GV, US, param_file, useALEalgorithm, di call get_param(param_file, mdl, "PEN_SW_NBANDS", nbands, default=1) if (nbands > 0) then allocate(CS%optics) - call opacity_init(Time, G, param_file, diag, CS%tracer_flow_CSp, CS%opacity_CSp, CS%optics) + call opacity_init(Time, G, param_file, diag, CS%opacity_CSp, CS%optics) endif endif diff --git a/src/parameterizations/vertical/MOM_opacity.F90 b/src/parameterizations/vertical/MOM_opacity.F90 index a4d66ec750..4b674c988f 100644 --- a/src/parameterizations/vertical/MOM_opacity.F90 +++ b/src/parameterizations/vertical/MOM_opacity.F90 @@ -10,12 +10,9 @@ module MOM_opacity use MOM_string_functions, only : uppercase use MOM_shortwave_abs, only : optics_type use MOM_grid, only : ocean_grid_type -use MOM_io, only : slasher -use MOM_tracer_flow_control, only : get_chl_from_model, tracer_flow_control_CS use MOM_variables, only : thermo_var_ptrs use MOM_verticalGrid, only : verticalGrid_type -use time_interp_external_mod, only : init_external_field, time_interp_external -use time_interp_external_mod, only : time_interp_external_init + implicit none ; private #include @@ -24,9 +21,8 @@ module MOM_opacity !> The control structure with paramters for the MOM_opacity module type, public :: opacity_CS ; private - logical :: var_pen_sw !< If true, use one of the CHL_A schemes (specified below) to - !! determine the e-folding depth of incoming short wave radiation. - !! The default is false. + logical :: var_pen_sw !< If true, use one of the CHL_A schemes (specified by OPACITY_SCHEME) to + !! determine the e-folding depth of incoming shortwave radiation. integer :: opacity_scheme !< An integer indicating which scheme should be used to translate !! water properties into the opacity (i.e., the e-folding depth) and !! (perhaps) the number of bands of penetrating shortwave radiation to use. @@ -41,17 +37,11 @@ module MOM_opacity !! radiation that is in the blue band [nondim]. real :: opacity_land_value !< The value to use for opacity over land [m-1]. !! The default is 10 m-1 - a value for muddy water. - integer :: sbc_chl !< An integer handle used in time interpolation of - !! chlorophyll read from a file. - logical :: chl_from_file !< If true, chl_a is read from a file. - type(time_type), pointer :: Time => NULL() !< A pointer to the ocean model's clock. type(diag_ctrl), pointer :: diag => NULL() !< A structure that is used to !! regulate the timing of diagnostic output. - type(tracer_flow_control_CS), pointer :: tracer_flow_CSp => NULL() - !< A pointer to the control structure of the tracer modules. !>@{ Diagnostic IDs - integer :: id_sw_pen = -1, id_sw_vis_pen = -1, id_chl = -1 + integer :: id_sw_pen = -1, id_sw_vis_pen = -1 integer, pointer :: id_opacity(:) => NULL() !!@} end type opacity_CS @@ -68,7 +58,7 @@ module MOM_opacity contains !> This sets the opacity of sea water based based on one of several different schemes. -subroutine set_opacity(optics, sw_total, sw_vis_dir, sw_vis_dif, sw_nir_dir, sw_nir_dif, G, GV, CS) +subroutine set_opacity(optics, sw_total, sw_vis_dir, sw_vis_dif, sw_nir_dir, sw_nir_dif, G, GV, CS, chl_2d, chl_3d) type(optics_type), intent(inout) :: optics !< An optics structure that has values !! set based on the opacities. real, dimension(:,:), pointer :: sw_total !< Total shortwave flux into the ocean [W m-2] @@ -80,6 +70,10 @@ subroutine set_opacity(optics, sw_total, sw_vis_dir, sw_vis_dif, sw_nir_dir, sw_ type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(opacity_CS), pointer :: CS !< The control structure earlier set up by !! opacity_init. + real, dimension(SZI_(G),SZJ_(G)), & + optional, intent(in) :: chl_2d !< Vertically uniform chlorophyll-A concentractions[mg m-3] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & + optional, intent(in) :: chl_3d !< The chlorophyll-A concentractions of each layer [mg m-3] ! local variables integer :: i, j, k, n, is, ie, js, je, nz @@ -87,22 +81,19 @@ subroutine set_opacity(optics, sw_total, sw_vis_dir, sw_vis_dif, sw_nir_dir, sw_ real :: Inv_nbands ! The inverse of the number of bands of penetrating ! shortwave radiation. logical :: call_for_surface ! if horizontal slice is the surface layer - real :: tmp(SZI_(G),SZJ_(G),SZK_(G)) ! A 3-d temporary array. - real :: chl(SZI_(G),SZJ_(G),SZK_(G)) ! The concentration of chlorophyll-A [mg m-3]. + real :: tmp(SZI_(G),SZJ_(G),SZK_(GV)) ! A 3-d temporary array. + real :: chl(SZI_(G),SZJ_(G),SZK_(GV)) ! The concentration of chlorophyll-A [mg m-3]. real :: Pen_SW_tot(SZI_(G),SZJ_(G)) ! The penetrating shortwave radiation ! summed across all bands [W m-2]. - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke if (.not. associated(CS)) call MOM_error(FATAL, "set_opacity: "// & "Module must be initialized via opacity_init before it is used.") - if (CS%var_pen_sw) then - if (CS%chl_from_file) then - call opacity_from_chl(optics, sw_total, sw_vis_dir, sw_vis_dif, sw_nir_dir, sw_nir_dif, G, CS) - else - call get_chl_from_model(chl, G, CS%tracer_flow_CSp) - call opacity_from_chl(optics, sw_total, sw_vis_dir, sw_vis_dif, sw_nir_dir, sw_nir_dif, G, CS, chl) - endif + if (present(chl_2d) .or. present(chl_3d)) then + ! The optical properties are based on cholophyll concentrations. + call opacity_from_chl(optics, sw_total, sw_vis_dir, sw_vis_dif, sw_nir_dir, sw_nir_dif, & + G, GV, CS, chl_2d, chl_3d) else ! Use sw e-folding scale set by MOM_input if (optics%nbands <= 1) then ; Inv_nbands = 1.0 else ; Inv_nbands = 1.0 / real(optics%nbands) ; endif @@ -191,19 +182,21 @@ end subroutine set_opacity !> This sets the "blue" band opacity based on chloophyll A concencentrations !! The red portion is lumped into the net heating at the surface. -subroutine opacity_from_chl(optics, sw_total, sw_vis_dir, sw_vis_dif, sw_nir_dir, sw_nir_dif, G, CS, chl_in) - type(optics_type), intent(inout) :: optics !< An optics structure that has values +subroutine opacity_from_chl(optics, sw_total, sw_vis_dir, sw_vis_dif, sw_nir_dir, sw_nir_dif, G, GV, CS, chl_2d, chl_3d) + type(optics_type), intent(inout) :: optics !< An optics structure that has values !! set based on the opacities. - real, dimension(:,:), pointer :: sw_total !< Total shortwave flux into the ocean [W m-2] - real, dimension(:,:), pointer :: sw_vis_dir !< Visible, direct shortwave into the ocean [W m-2] - real, dimension(:,:), pointer :: sw_vis_dif !< Visible, diffuse shortwave into the ocean [W m-2] - real, dimension(:,:), pointer :: sw_nir_dir !< Near-IR, direct shortwave into the ocean [W m-2] - real, dimension(:,:), pointer :: sw_nir_dif !< Near-IR, diffuse shortwave into the ocean [W m-2] - type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. - type(opacity_CS), pointer :: CS !< The control structure. + real, dimension(:,:), pointer :: sw_total !< Total shortwave flux into the ocean [W m-2] + real, dimension(:,:), pointer :: sw_vis_dir !< Visible, direct shortwave into the ocean [W m-2] + real, dimension(:,:), pointer :: sw_vis_dif !< Visible, diffuse shortwave into the ocean [W m-2] + real, dimension(:,:), pointer :: sw_nir_dir !< Near-IR, direct shortwave into the ocean [W m-2] + real, dimension(:,:), pointer :: sw_nir_dif !< Near-IR, diffuse shortwave into the ocean [W m-2] + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. + type(opacity_CS), pointer :: CS !< The control structure. + real, dimension(SZI_(G),SZJ_(G)), & + optional, intent(in) :: chl_2d !< Vertically uniform chlorophyll-A concentractions [mg m-3] real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - optional, intent(in) :: chl_in !< A 3-d field of chlorophyll A, - !! in mg m-3. + optional, intent(in) :: chl_3d !< A 3-d field of chlorophyll-A concentractions [mg m-3] real :: chl_data(SZI_(G),SZJ_(G)) ! The chlorophyll A concentrations in a layer [mg m-3]. real :: Inv_nbands ! The inverse of the number of bands of penetrating @@ -221,7 +214,7 @@ subroutine opacity_from_chl(optics, sw_total, sw_vis_dir, sw_vis_dif, sw_nir_dir integer :: i, j, k, n, is, ie, js, je, nz, nbands logical :: multiband_vis_input, multiband_nir_input - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke ! In this model, the Morel (modified) and Manizza (modified) schemes ! use the "blue" band in the parameterizations to determine the e-folding @@ -231,7 +224,6 @@ subroutine opacity_from_chl(optics, sw_total, sw_vis_dir, sw_vis_dif, sw_nir_dir ! Morel, A., Optical modeling of the upper ocean in relation to its biogenous ! matter content (case-i waters).,J. Geo. Res., {93}, 10,749--10,768, 1988. ! - ! Manizza, M., C.~L. Quere, A.~Watson, and E.~T. Buitenhuis, Bio-optical ! feedbacks amoung phytoplankton, upper ocean physics and sea-ice in a ! global model, Geophys. Res. Let., , L05,603, 2005. @@ -250,36 +242,28 @@ subroutine opacity_from_chl(optics, sw_total, sw_vis_dir, sw_vis_dif, sw_nir_dir associated(sw_nir_dif)) chl_data(:,:) = 0.0 - if (present(chl_in)) then - do j=js,je ; do i=is,ie ; chl_data(i,j) = chl_in(i,j,1) ; enddo ; enddo + if (present(chl_3d)) then + do j=js,je ; do i=is,ie ; chl_data(i,j) = chl_3d(i,j,1) ; enddo ; enddo do k=1,nz; do j=js,je ; do i=is,ie - if ((G%mask2dT(i,j) > 0.5) .and. (chl_in(i,j,k) < 0.0)) then - write(mesg,'(" Negative chl_in of ",(1pe12.4)," found at i,j,k = ", & - & 3(1x,i3), " lon/lat = ",(1pe12.4)," E ", (1pe12.4), " N.")') & - chl_in(i,j,k), i, j, k, G%geoLonT(i,j), G%geoLatT(i,j) - call MOM_error(FATAL,"MOM_opacity opacity_from_chl: "//trim(mesg)) + if ((G%mask2dT(i,j) > 0.5) .and. (chl_3d(i,j,k) < 0.0)) then + write(mesg,'(" Negative chl_3d of ",(1pe12.4)," found at i,j,k = ", & + & 3(1x,i3), " lon/lat = ",(1pe12.4)," E ", (1pe12.4), " N.")') & + chl_3d(i,j,k), i, j, k, G%geoLonT(i,j), G%geoLatT(i,j) + call MOM_error(FATAL, "MOM_opacity opacity_from_chl: "//trim(mesg)) endif enddo ; enddo ; enddo - else - ! Only the 2-d surface chlorophyll can be read in from a file. The - ! same value is assumed for all layers. - call time_interp_external(CS%sbc_chl, CS%Time, chl_data) + elseif (present(chl_2d)) then + do j=js,je ; do i=is,ie ; chl_data(i,j) = chl_2d(i,j) ; enddo ; enddo do j=js,je ; do i=is,ie - if ((G%mask2dT(i,j) > 0.5) .and. (chl_data(i,j) < 0.0)) then - write(mesg,'(" Time_interp negative chl of ",(1pe12.4)," at i,j = ",& + if ((G%mask2dT(i,j) > 0.5) .and. (chl_2d(i,j) < 0.0)) then + write(mesg,'(" Negative chl_2d of ",(1pe12.4)," at i,j = ", & & 2(i3), "lon/lat = ",(1pe12.4)," E ", (1pe12.4), " N.")') & chl_data(i,j), i, j, G%geoLonT(i,j), G%geoLatT(i,j) - call MOM_error(FATAL,"MOM_opacity opacity_from_chl: "//trim(mesg)) + call MOM_error(FATAL, "MOM_opacity opacity_from_chl: "//trim(mesg)) endif enddo ; enddo - endif - - if (CS%id_chl > 0) then - if (present(chl_in)) then - call post_data(CS%id_chl, chl_in(:,:,1), CS%diag) - else - call post_data(CS%id_chl, chl_data, CS%diag) - endif + else + call MOM_error(FATAL, "Either chl_2d or chl_3d must be preesnt in a call to opacity_form_chl.") endif select case (CS%opacity_scheme) @@ -328,13 +312,13 @@ subroutine opacity_from_chl(optics, sw_total, sw_vis_dir, sw_vis_dif, sw_nir_dir enddo ; enddo case default call MOM_error(FATAL, "opacity_from_chl: CS%opacity_scheme is not valid.") - end select + end select -!$OMP parallel do default(none) shared(nz,is,ie,js,je,CS,G,chl_in,optics,nbands) & +!$OMP parallel do default(none) shared(nz,is,ie,js,je,CS,G,chl_3d,optics,nbands) & !$OMP firstprivate(chl_data) do k=1,nz - if (present(chl_in)) then - do j=js,je ; do i=is,ie ; chl_data(i,j) = chl_in(i,j,k) ; enddo ; enddo + if (present(chl_3d)) then + do j=js,je ; do i=is,ie ; chl_data(i,j) = chl_3d(i,j,k) ; enddo ; enddo endif select case (CS%opacity_scheme) @@ -424,16 +408,13 @@ function opacity_manizza(chl_data) opacity_manizza = 0.0232 + 0.074*chl_data**0.674 end function -subroutine opacity_init(Time, G, param_file, diag, tracer_flow, CS, optics) +subroutine opacity_init(Time, G, param_file, diag, CS, optics) type(time_type), target, intent(in) :: Time !< The current model time. type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time !! parameters. type(diag_ctrl), target, intent(inout) :: diag !< A structure that is used to regulate diagnostic !! output. - type(tracer_flow_control_CS), & - target, intent(in) :: tracer_flow !< A pointer to the tracer flow control - !! module's control structure type(opacity_CS), pointer :: CS !< A pointer that is set to point to the control !! structure for this module. type(optics_type), pointer :: optics !< An optics structure that has parameters @@ -448,17 +429,12 @@ subroutine opacity_init(Time, G, param_file, diag, tracer_flow, CS, optics) ! for this module ! This include declares and sets the variable "version". #include "version_variable.h" - character(len=200) :: inputdir ! The directory where NetCDF input files - character(len=240) :: filename character(len=200) :: tmpstr character(len=40) :: mdl = "MOM_opacity" character(len=40) :: bandnum, shortname character(len=200) :: longname character(len=40) :: scheme_string logical :: use_scheme - character(len=128) :: chl_file ! Data containing chl_a concentrations. Used - ! when var_pen_sw is defined and reading from file. - character(len=32) :: chl_varname ! Name of chl_a variable in chl_file. integer :: isd, ied, jsd, jed, nz, n isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed ; nz = G%ke @@ -469,8 +445,6 @@ subroutine opacity_init(Time, G, param_file, diag, tracer_flow, CS, optics) else ; allocate(CS) ; endif CS%diag => diag - CS%Time => Time - CS%tracer_flow_CSp => tracer_flow ! Read all relevant parameters and write them to the model log. call log_version(param_file, mdl, version, '') @@ -509,23 +483,6 @@ subroutine opacity_init(Time, G, param_file, diag, tracer_flow, CS, optics) CS%opacity_scheme = MANIZZA_05 ; scheme_string = MANIZZA_05_STRING endif - call get_param(param_file, mdl, "CHL_FROM_FILE", CS%chl_from_file, & - "If true, chl_a is read from a file.", default=.true.) - if (CS%chl_from_file) then - call time_interp_external_init() - - call get_param(param_file, mdl, "INPUTDIR", inputdir, default=".") - call get_param(param_file, mdl, "CHL_FILE", chl_file, & - "CHL_FILE is the file containing chl_a concentrations in "//& - "the variable CHL_A. It is used when VAR_PEN_SW and "//& - "CHL_FROM_FILE are true.", fail_if_missing=.true.) - filename = trim(slasher(inputdir))//trim(chl_file) - call log_param(param_file, mdl, "INPUTDIR/CHL_FILE", filename) - call get_param(param_file, mdl, "CHL_VARNAME", chl_varname, & - "Name of CHL_A variable in CHL_FILE.", default='CHL_A') - CS%sbc_chl = init_external_field(filename,trim(chl_varname),domain=G%Domain%mpp_domain) - endif - call get_param(param_file, mdl, "BLUE_FRAC_SW", CS%blue_frac, & "The fraction of the penetrating shortwave radiation "//& "that is in the blue band.", default=0.5, units="nondim") @@ -626,10 +583,6 @@ subroutine opacity_init(Time, G, param_file, diag, tracer_flow, CS, optics) CS%id_opacity(n) = register_diag_field('ocean_model', shortname, diag%axesTL, Time, & longname, 'm-1') enddo - if (CS%var_pen_sw) & - CS%id_chl = register_diag_field('ocean_model', 'Chl_opac', diag%axesT1, Time, & - 'Surface chlorophyll A concentration used to find opacity', 'mg m-3') - end subroutine opacity_init @@ -650,8 +603,8 @@ end subroutine opacity_end !> \namespace mom_opacity !! -!! CHL_from_file: -!! In this routine, the Morel (modified) and Manizza (modified) +!! opacity_from_chl: +!! In this routine, the Morel (modified) or Manizza (modified) !! schemes use the "blue" band in the paramterizations to determine !! the e-folding depth of the incoming shortwave attenuation. The red !! portion is lumped into the net heating at the surface. diff --git a/src/tracer/MOM_offline_main.F90 b/src/tracer/MOM_offline_main.F90 index 3241cb0fa4..cb14df2c6a 100644 --- a/src/tracer/MOM_offline_main.F90 +++ b/src/tracer/MOM_offline_main.F90 @@ -720,7 +720,7 @@ subroutine offline_diabatic_ale(fluxes, Time_start, Time_end, CS, h_pre, eatr, e endif if (associated(CS%optics)) & - call set_pen_shortwave(CS%optics, fluxes, CS%G, CS%GV, CS%diabatic_aux_CSp, CS%opacity_CSp) + call set_pen_shortwave(CS%optics, fluxes, CS%G, CS%GV, CS%diabatic_aux_CSp, CS%opacity_CSp, CS%tracer_flow_CSp) ! Note that tracerBoundaryFluxesInOut within this subroutine should NOT be called ! as the freshwater fluxes have already been accounted for From 69a0d8a4c61b3fc3dce001c58c87436377c7248d Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Fri, 5 Jul 2019 14:50:52 -0400 Subject: [PATCH 66/82] +Combined MOM_shortwave_abs and MOM_opacity Combined the MOM_shortwave_abs and MOM_opacity modules. All answers are bitwise identical, but one type and two subroutines are now found in a different module. --- src/core/MOM_forcing_type.F90 | 2 +- .../vertical/MOM_bulk_mixed_layer.F90 | 2 +- .../vertical/MOM_diabatic_aux.F90 | 2 +- .../vertical/MOM_diabatic_driver.F90 | 2 +- .../vertical/MOM_opacity.F90 | 419 ++++++++++++++++- .../vertical/MOM_shortwave_abs.F90 | 424 ------------------ src/tracer/MOM_offline_aux.F90 | 2 +- src/tracer/MOM_offline_main.F90 | 3 +- 8 files changed, 420 insertions(+), 436 deletions(-) delete mode 100644 src/parameterizations/vertical/MOM_shortwave_abs.F90 diff --git a/src/core/MOM_forcing_type.F90 b/src/core/MOM_forcing_type.F90 index 57ef79cc24..29140b8b4b 100644 --- a/src/core/MOM_forcing_type.F90 +++ b/src/core/MOM_forcing_type.F90 @@ -11,7 +11,7 @@ module MOM_forcing_type use MOM_EOS, only : calculate_density_derivs use MOM_file_parser, only : get_param, log_param, log_version, param_file_type use MOM_grid, only : ocean_grid_type -use MOM_shortwave_abs, only : sumSWoverBands, optics_type +use MOM_opacity, only : sumSWoverBands, optics_type use MOM_spatial_means, only : global_area_integral, global_area_mean use MOM_unit_scaling, only : unit_scale_type use MOM_variables, only : surface, thermo_var_ptrs diff --git a/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 b/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 index 56a9d5b618..47154717e2 100644 --- a/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 +++ b/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 @@ -11,7 +11,7 @@ module MOM_bulk_mixed_layer use MOM_file_parser, only : get_param, log_param, log_version, param_file_type use MOM_forcing_type, only : extractFluxes1d, forcing use MOM_grid, only : ocean_grid_type -use MOM_shortwave_abs, only : absorbRemainingSW, optics_type +use MOM_opacity, only : absorbRemainingSW, optics_type use MOM_unit_scaling, only : unit_scale_type use MOM_variables, only : thermo_var_ptrs use MOM_verticalGrid, only : verticalGrid_type diff --git a/src/parameterizations/vertical/MOM_diabatic_aux.F90 b/src/parameterizations/vertical/MOM_diabatic_aux.F90 index 972e050b82..0840ab203f 100644 --- a/src/parameterizations/vertical/MOM_diabatic_aux.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_aux.F90 @@ -17,7 +17,7 @@ module MOM_diabatic_aux use MOM_grid, only : ocean_grid_type use MOM_io, only : slasher use MOM_opacity, only : set_opacity, opacity_CS -use MOM_shortwave_abs, only : absorbRemainingSW, optics_type, sumSWoverBands +use MOM_opacity, only : absorbRemainingSW, optics_type, sumSWoverBands use MOM_tracer_flow_control, only : get_chl_from_model, tracer_flow_control_CS use MOM_unit_scaling, only : unit_scale_type use MOM_variables, only : thermo_var_ptrs, vertvisc_type! , accel_diag_ptrs diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index 714bea2926..f5fe2b4f1e 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -53,11 +53,11 @@ module MOM_diabatic_driver use MOM_CVMix_KPP, only : KPP_end, KPP_get_BLD use MOM_CVMix_KPP, only : KPP_NonLocalTransport_temp, KPP_NonLocalTransport_saln use MOM_opacity, only : opacity_init, opacity_end, opacity_CS +use MOM_opacity, only : absorbRemainingSW, optics_type use MOM_regularize_layers, only : regularize_layers, regularize_layers_init, regularize_layers_CS use MOM_set_diffusivity, only : set_diffusivity, set_BBL_TKE use MOM_set_diffusivity, only : set_diffusivity_init, set_diffusivity_end use MOM_set_diffusivity, only : set_diffusivity_CS -use MOM_shortwave_abs, only : absorbRemainingSW, optics_type use MOM_sponge, only : apply_sponge, sponge_CS use MOM_ALE_sponge, only : apply_ALE_sponge, ALE_sponge_CS use MOM_time_manager, only : time_type, real_to_time, operator(-), operator(<=) diff --git a/src/parameterizations/vertical/MOM_opacity.F90 b/src/parameterizations/vertical/MOM_opacity.F90 index 4b674c988f..ad9f8c53bd 100644 --- a/src/parameterizations/vertical/MOM_opacity.F90 +++ b/src/parameterizations/vertical/MOM_opacity.F90 @@ -6,18 +6,38 @@ module MOM_opacity use MOM_diag_mediator, only : time_type, diag_ctrl, safe_alloc_ptr, post_data use MOM_diag_mediator, only : query_averaging_enabled, register_diag_field use MOM_error_handler, only : MOM_error, MOM_mesg, FATAL, WARNING -use MOM_file_parser, only : get_param, log_param, log_version, param_file_type +use MOM_file_parser, only : get_param, log_param, log_version, param_file_type use MOM_string_functions, only : uppercase -use MOM_shortwave_abs, only : optics_type -use MOM_grid, only : ocean_grid_type -use MOM_variables, only : thermo_var_ptrs -use MOM_verticalGrid, only : verticalGrid_type +use MOM_grid, only : ocean_grid_type +use MOM_unit_scaling, only : unit_scale_type +use MOM_variables, only : thermo_var_ptrs +use MOM_verticalGrid, only : verticalGrid_type implicit none ; private #include public set_opacity, opacity_init, opacity_end, opacity_manizza, opacity_morel +public absorbRemainingSW, sumSWoverBands + +!> This type is used to exchange information about ocean optical properties +type, public :: optics_type + ! ocean optical properties + + integer :: nbands !< number of penetrating bands of SW radiation + + real, pointer, dimension(:,:,:,:) :: opacity_band => NULL() !< SW optical depth per unit thickness [m-1] + !! The number of radiation bands is most rapidly varying (first) index. + + real, pointer, dimension(:,:,:) :: SW_pen_band => NULL() !< shortwave radiation [W m-2] at the surface + !! in each of the nbands bands that penetrates beyond the surface. + !! The most rapidly varying dimension is the band. + + real, pointer, dimension(:) :: & + min_wavelength_band => NULL(), & !< The minimum wavelength in each band of penetrating shortwave radiation [nm] + max_wavelength_band => NULL() !< The maximum wavelength in each band of penetrating shortwave radiation [nm] + +end type optics_type !> The control structure with paramters for the MOM_opacity module type, public :: opacity_CS ; private @@ -408,6 +428,395 @@ function opacity_manizza(chl_data) opacity_manizza = 0.0232 + 0.074*chl_data**0.674 end function + +!> Apply shortwave heating below the boundary layer (when running with the bulk mixed layer inhereted +!! from GOLD) or throughout the water column. +!! +!! In addition, it causes all of the remaining SW radiation to be absorbed, provided that the total +!! water column thickness is greater than H_limit_fluxes. +!! For thinner water columns, the heating is scaled down proportionately, the assumption being that the +!! remaining heating (which is left in Pen_SW) should go into an (absent for now) ocean bottom sediment layer. +subroutine absorbRemainingSW(G, GV, US, h, opacity_band, nsw, j, dt, H_limit_fluxes, & + adjustAbsorptionProfile, absorbAllSW, T, Pen_SW_bnd, & + eps, ksort, htot, Ttot, TKE, dSV_dT) + + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + real, dimension(SZI_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]. + real, dimension(:,:,:), intent(in) :: opacity_band !< Opacity in each band of penetrating + !! shortwave radiation [H-1 ~> m-1 or m2 kg-1]. + !! The indicies are band, i, k. + integer, intent(in) :: nsw !< Number of bands of penetrating + !! shortwave radiation. + integer, intent(in) :: j !< j-index to work on. + real, intent(in) :: dt !< Time step [T ~> s]. + real, intent(in) :: H_limit_fluxes !< If the total ocean depth is + !! less than this, they are scaled away + !! to avoid numerical instabilities + !! [H ~> m or kg m-2]. This would + !! not be necessary if a finite heat + !! capacity mud-layer were added. + logical, intent(in) :: adjustAbsorptionProfile !< If true, apply + !! heating above the layers in which it + !! should have occurred to get the + !! correct mean depth (and potential + !! energy change) of the shortwave that + !! should be absorbed by each layer. + logical, intent(in) :: absorbAllSW !< If true, apply heating above the + !! layers in which it should have occurred + !! to get the correct mean depth (and + !! potential energy change) of the + !! shortwave that should be absorbed by + !! each layer. + real, dimension(SZI_(G),SZK_(G)), intent(inout) :: T !< Layer potential/conservative + !! temperatures [degC] + real, dimension(:,:), intent(inout) :: Pen_SW_bnd !< Penetrating shortwave heating in + !! each band that hits the bottom and will + !! will be redistributed through the water + !! column [degC H ~> degC m or degC kg m-2], + !! size nsw x SZI_(G). + real, dimension(SZI_(G),SZK_(G)), optional, intent(in) :: eps !< Small thickness that must remain in + !! each layer, and which will not be + !! subject to heating [H ~> m or kg m-2] + integer, dimension(SZI_(G),SZK_(G)), optional, intent(in) :: ksort !< Density-sorted k-indicies. + real, dimension(SZI_(G)), optional, intent(in) :: htot !< Total mixed layer thickness [H ~> m or kg m-2]. + real, dimension(SZI_(G)), optional, intent(inout) :: Ttot !< Depth integrated mixed layer + !! temperature [degC H ~> degC m or degC kg m-2] + real, dimension(SZI_(G),SZK_(G)), optional, intent(in) :: dSV_dT !< The partial derivative of specific + !! volume with temperature [m3 kg-1 degC-1]. + real, dimension(SZI_(G),SZK_(G)), optional, intent(inout) :: TKE !< The TKE sink from mixing the heating + !! throughout a layer [kg m-3 Z3 T-2 ~> J m-2]. + ! Local variables + real, dimension(SZI_(G),SZK_(G)) :: & + T_chg_above ! A temperature change that will be applied to all the thick + ! layers above a given layer [degC]. This is only nonzero if + ! adjustAbsorptionProfile is true, in which case the net + ! change in the temperature of a layer is the sum of the + ! direct heating of that layer plus T_chg_above from all of + ! the layers below, plus any contribution from absorbing + ! radiation that hits the bottom. + real, dimension(SZI_(G)) :: & + h_heat, & ! The thickness of the water column that will be heated by + ! any remaining shortwave radiation [H ~> m or kg m-2]. + T_chg, & ! The temperature change of thick layers due to the remaining + ! shortwave radiation and contributions from T_chg_above [degC]. + Pen_SW_rem ! The sum across all wavelength bands of the penetrating shortwave + ! heating that hits the bottom and will be redistributed through + ! the water column [degC H ~> degC m or degC kg m-2] + real :: SW_trans ! fraction of shortwave radiation that is not + ! absorbed in a layer [nondim] + real :: unabsorbed ! fraction of the shortwave radiation that + ! is not absorbed because the layers are too thin + real :: Ih_limit ! inverse of the total depth at which the + ! surface fluxes start to be limited [H-1 ~> m-1 or m2 kg-1] + real :: h_min_heat ! minimum thickness layer that should get heated [H ~> m or kg m-2] + real :: opt_depth ! optical depth of a layer [nondim] + real :: exp_OD ! exp(-opt_depth) [nondim] + real :: heat_bnd ! heating due to absorption in the current + ! layer by the current band, including any piece that + ! is moved upward [degC H ~> degC m or degC kg m-2] + real :: SWa ! fraction of the absorbed shortwave that is + ! moved to layers above with adjustAbsorptionProfile [nondim] + real :: coSWa_frac ! The fraction of SWa that is actually moved upward. + real :: min_SW_heating ! A minimum remaining shortwave heating rate that will be simply + ! absorbed in the next layer for computational efficiency, instead of + ! continuing to penetrate [degC H T-1 ~> degC m s-1 or degC kg m-2 s-1]. + ! The default, 2.5e-11, is about 0.08 degC m / century. + real :: epsilon ! A small thickness that must remain in each + ! layer, and which will not be subject to heating [H ~> m or kg m-2] + real :: g_Hconv2 ! A conversion factor for use in the TKE calculation + ! in units of [Z3 kg2 m-6 T-2 H-2 ~> kg2 m-5 s-2 or m s-2]. + logical :: SW_Remains ! If true, some column has shortwave radiation that + ! was not entirely absorbed. + logical :: TKE_calc ! If true, calculate the implications to the + ! TKE budget of the shortwave heating. + real :: C1_6, C1_60 + integer :: is, ie, nz, i, k, ks, n + SW_Remains = .false. + + min_SW_heating = 2.5e-11*US%T_to_s !### This needs *GV%m_to_H for dimensional consistency? + + h_min_heat = 2.0*GV%Angstrom_H + GV%H_subroundoff + is = G%isc ; ie = G%iec ; nz = G%ke + C1_6 = 1.0 / 6.0 ; C1_60 = 1.0 / 60.0 + + TKE_calc = (present(TKE) .and. present(dSV_dT)) + ! g_Hconv2 = (US%m_to_Z**3 * US%T_to_s**2) * GV%H_to_Pa * GV%H_to_kg_m2 + g_Hconv2 = (US%m_to_Z**4 * US%T_to_s**2 * GV%g_Earth * GV%H_to_kg_m2) * GV%H_to_kg_m2 + ! g_Hconv2 = US%m_to_Z**4 * US%T_to_s**2 * GV%g_Earth * GV%H_to_kg_m2**2 + + h_heat(:) = 0.0 + if (present(htot)) then ; do i=is,ie ; h_heat(i) = htot(i) ; enddo ; endif + + ! Apply penetrating SW radiation to remaining parts of layers. + ! Excessively thin layers are not heated to avoid runaway temps. + do ks=1,nz ; do i=is,ie + k = ks + if (present(ksort)) then + if (ksort(i,ks) <= 0) cycle + k = ksort(i,ks) + endif + epsilon = 0.0 ; if (present(eps)) epsilon = eps(i,k) + + T_chg_above(i,k) = 0.0 + + if (h(i,k) > 1.5*epsilon) then + do n=1,nsw ; if (Pen_SW_bnd(n,i) > 0.0) then + ! SW_trans is the SW that is transmitted THROUGH the layer + opt_depth = h(i,k) * opacity_band(n,i,k) + exp_OD = exp(-opt_depth) + SW_trans = exp_OD + + ! Heating at a rate of less than 10-4 W m-2 = 10-3 K m / Century, + ! and of the layer in question less than 1 K / Century, can be + ! absorbed without further penetration. + ! ###Make these numbers into parameters! + if (nsw*Pen_SW_bnd(n,i)*SW_trans < & + dt*min_SW_heating*min(1.0*GV%m_to_H, 1e3*h(i,k)) ) SW_trans = 0.0 + + Heat_bnd = Pen_SW_bnd(n,i) * (1.0 - SW_trans) + if (adjustAbsorptionProfile .and. (h_heat(i) > 0.0)) then + ! In this case, a fraction of the heating is applied to the + ! overlying water so that the mean pressure at which the shortwave + ! heating occurs is exactly what it would have been with a careful + ! pressure-weighted averaging of the exponential heating profile, + ! hence there should be no TKE budget requirements due to this + ! layer. Very clever, but this is also limited so that the + ! water above is not heated at a faster rate than the layer + ! actually being heated, i.e., SWA <= h_heat / (h_heat + h(i,k)) + ! and takes the energetics of the rest of the heating into account. + ! (-RWH, ~7 years later.) + if (opt_depth > 1e-5) then + SWa = ((opt_depth + (opt_depth + 2.0)*exp_OD) - 2.0) / & + ((opt_depth + opacity_band(n,i,k) * h_heat(i)) * & + (1.0 - exp_OD)) + else + ! Use Taylor series expansion of the expression above for a + ! more accurate form with very small layer optical depths. + SWa = h(i,k) * (opt_depth * (1.0 - opt_depth)) / & + ((h_heat(i) + h(i,k)) * (6.0 - 3.0*opt_depth)) + endif + coSWa_frac = 0.0 + if (SWa*(h_heat(i) + h(i,k)) > h_heat(i)) then + coSWa_frac = (SWa*(h_heat(i) + h(i,k)) - h_heat(i) ) / & + (SWa*(h_heat(i) + h(i,k))) + SWa = h_heat(i) / (h_heat(i) + h(i,k)) + endif + + T_chg_above(i,k) = T_chg_above(i,k) + (SWa * Heat_bnd) / h_heat(i) + T(i,k) = T(i,k) + ((1.0 - SWa) * Heat_bnd) / h(i,k) + else + coSWa_frac = 1.0 + T(i,k) = T(i,k) + Pen_SW_bnd(n,i) * (1.0 - SW_trans) / h(i,k) + endif + + if (TKE_calc) then + if (opt_depth > 1e-2) then + TKE(i,k) = TKE(i,k) - coSWa_frac*Heat_bnd*dSV_dT(i,k)* & + (0.5*h(i,k)*g_Hconv2) * & + (opt_depth*(1.0+exp_OD) - 2.0*(1.0-exp_OD)) / (opt_depth*(1.0-exp_OD)) + else + ! Use Taylor series-derived approximation to the above expression + ! that is well behaved and more accurate when opt_depth is small. + TKE(i,k) = TKE(i,k) - coSWa_frac*Heat_bnd*dSV_dT(i,k)* & + (0.5*h(i,k)*g_Hconv2) * & + (C1_6*opt_depth * (1.0 - C1_60*opt_depth**2)) + endif + endif + + Pen_SW_bnd(n,i) = Pen_SW_bnd(n,i) * SW_trans + endif ; enddo + endif + + ! Add to the accumulated thickness above that could be heated. + ! Only layers greater than h_min_heat thick should get heated. + if (h(i,k) >= 2.0*h_min_heat) then + h_heat(i) = h_heat(i) + h(i,k) + elseif (h(i,k) > h_min_heat) then + h_heat(i) = h_heat(i) + (2.0*h(i,k) - 2.0*h_min_heat) + endif + enddo ; enddo ! i & k loops + + +! if (.not.absorbAllSW .and. .not.adjustAbsorptionProfile) return + + ! Unless modified, there is no temperature change due to fluxes from the bottom. + do i=is,ie ; T_chg(i) = 0.0 ; enddo + + if (absorbAllSW) then + ! If there is still shortwave radiation at this point, it could go into + ! the bottom (with a bottom mud model), or it could be redistributed back + ! through the water column. + do i=is,ie + Pen_SW_rem(i) = Pen_SW_bnd(1,i) + do n=2,nsw ; Pen_SW_rem(i) = Pen_SW_rem(i) + Pen_SW_bnd(n,i) ; enddo + enddo + do i=is,ie ; if (Pen_SW_rem(i) > 0.0) SW_Remains = .true. ; enddo + + Ih_limit = 1.0 / H_limit_fluxes + do i=is,ie ; if ((Pen_SW_rem(i) > 0.0) .and. (h_heat(i) > 0.0)) then + if (h_heat(i)*Ih_limit >= 1.0) then + T_chg(i) = Pen_SW_rem(i) / h_heat(i) ; unabsorbed = 0.0 + else + T_chg(i) = Pen_SW_rem(i) * Ih_limit + unabsorbed = 1.0 - h_heat(i)*Ih_limit + endif + do n=1,nsw ; Pen_SW_bnd(n,i) = unabsorbed * Pen_SW_bnd(n,i) ; enddo + endif ; enddo + endif ! absorbAllSW + + if (absorbAllSW .or. adjustAbsorptionProfile) then + do ks=nz,1,-1 ; do i=is,ie + k = ks + if (present(ksort)) then + if (ksort(i,ks) <= 0) cycle + k = ksort(i,ks) + endif + + if (T_chg(i) > 0.0) then + ! Only layers greater than h_min_heat thick should get heated. + if (h(i,k) >= 2.0*h_min_heat) then ; T(i,k) = T(i,k) + T_chg(i) + elseif (h(i,k) > h_min_heat) then + T(i,k) = T(i,k) + T_chg(i) * (2.0 - 2.0*h_min_heat/h(i,k)) + endif + endif + ! Increase the heating for layers above. + T_chg(i) = T_chg(i) + T_chg_above(i,k) + enddo ; enddo + if (present(htot) .and. present(Ttot)) then + do i=is,ie ; Ttot(i) = Ttot(i) + T_chg(i) * htot(i) ; enddo + endif + endif ! absorbAllSW .or. adjustAbsorptionProfile + +end subroutine absorbRemainingSW + + +subroutine sumSWoverBands(G, GV, US, h, opacity_band, nsw, j, dt, & + H_limit_fluxes, absorbAllSW, iPen_SW_bnd, netPen) +!< This subroutine calculates the total shortwave heat flux integrated over +!! bands as a function of depth. This routine is only called for computing +!! buoyancy fluxes for use in KPP. This routine does not updat e the state. + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + real, dimension(SZI_(G),SZK_(G)), & + intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]. + real, dimension(:,:,:), intent(in) :: opacity_band !< opacity in each band of + !! penetrating shortwave radiation [m-1]. + !! The indicies are band, i, k. + integer, intent(in) :: nsw !< number of bands of penetrating + !! shortwave radiation. + integer, intent(in) :: j !< j-index to work on. + real, intent(in) :: dt !< Time step [T ~> s]. + real, intent(in) :: H_limit_fluxes !< the total depth at which the + !! surface fluxes start to be limited to avoid + !! excessive heating of a thin ocean [H ~> m or kg m-2] + logical, intent(in) :: absorbAllSW !< If true, ensure that all shortwave + !! radiation is absorbed in the ocean water column. + real, dimension(:,:), intent(in) :: iPen_SW_bnd !< The incident penetrating shortwave + !! heating in each band that hits the bottom and + !! will be redistributed through the water column + !! [degC H ~> degC m or degC kg m-2]; size nsw x SZI_(G). + real, dimension(SZI_(G),SZK_(G)+1), & + intent(inout) :: netPen !< Net penetrating shortwave heat flux at each + !! interface, summed across all bands + !! [degC H ~> degC m or degC kg m-2]. + ! Local variables + real :: h_heat(SZI_(G)) ! thickness of the water column that receives + ! remaining shortwave radiation [H ~> m or kg m-2]. + real :: Pen_SW_rem(SZI_(G)) ! sum across all wavelength bands of the + ! penetrating shortwave heating that hits the bottom + ! and will be redistributed through the water column + ! [degC H ~> degC m or degC kg m-2] + + real, dimension(size(iPen_SW_bnd,1),size(iPen_SW_bnd,2)) :: Pen_SW_bnd + real :: SW_trans ! fraction of shortwave radiation not + ! absorbed in a layer [nondim] + real :: unabsorbed ! fraction of the shortwave radiation + ! not absorbed because the layers are too thin. + real :: Ih_limit ! inverse of the total depth at which the + ! surface fluxes start to be limited [H-1 ~> m-1 or m2 kg-1] + real :: h_min_heat ! minimum thickness layer that should get heated [H ~> m or kg m-2] + real :: opt_depth ! optical depth of a layer [nondim] + real :: exp_OD ! exp(-opt_depth) [nondim] + logical :: SW_Remains ! If true, some column has shortwave radiation that + ! was not entirely absorbed. + + integer :: is, ie, nz, i, k, ks, n + SW_Remains = .false. + + h_min_heat = 2.0*GV%Angstrom_H + GV%H_subroundoff + is = G%isc ; ie = G%iec ; nz = G%ke + + pen_SW_bnd(:,:) = iPen_SW_bnd(:,:) + do i=is,ie ; h_heat(i) = 0.0 ; enddo + netPen(:,1) = sum( pen_SW_bnd(:,:), dim=1 ) ! Surface interface + + ! Apply penetrating SW radiation to remaining parts of layers. + ! Excessively thin layers are not heated to avoid runaway temps. + do k=1,nz + + do i=is,ie + netPen(i,k+1) = 0. + + if (h(i,k) > 0.0) then + do n=1,nsw ; if (Pen_SW_bnd(n,i) > 0.0) then + ! SW_trans is the SW that is transmitted THROUGH the layer + opt_depth = h(i,k)*GV%H_to_m * opacity_band(n,i,k) + exp_OD = exp(-opt_depth) + SW_trans = exp_OD + + ! Heating at a rate of less than 10-4 W m-2 = 10-3 K m / Century, + ! and of the layer in question less than 1 K / Century, can be + ! absorbed without further penetration. + if ((nsw*Pen_SW_bnd(n,i)*SW_trans < GV%m_to_H*2.5e-11*US%T_to_s*dt) .and. & + (nsw*Pen_SW_bnd(n,i)*SW_trans < h(i,k)*dt*US%T_to_s*2.5e-8)) & + SW_trans = 0.0 + + Pen_SW_bnd(n,i) = Pen_SW_bnd(n,i) * SW_trans + netPen(i,k+1) = netPen(i,k+1) + Pen_SW_bnd(n,i) + endif ; enddo + endif ! h(i,k) > 0.0 + + ! Add to the accumulated thickness above that could be heated. + ! Only layers greater than h_min_heat thick should get heated. + if (h(i,k) >= 2.0*h_min_heat) then + h_heat(i) = h_heat(i) + h(i,k) + elseif (h(i,k) > h_min_heat) then + h_heat(i) = h_heat(i) + (2.0*h(i,k) - 2.0*h_min_heat) + endif + enddo ! i loop + enddo ! k loop + + if (absorbAllSW) then + + ! If there is still shortwave radiation at this point, it could go into + ! the bottom (with a bottom mud model), or it could be redistributed back + ! through the water column. + do i=is,ie + Pen_SW_rem(i) = Pen_SW_bnd(1,i) + do n=2,nsw ; Pen_SW_rem(i) = Pen_SW_rem(i) + Pen_SW_bnd(n,i) ; enddo + enddo + do i=is,ie ; if (Pen_SW_rem(i) > 0.0) SW_Remains = .true. ; enddo + + Ih_limit = 1.0 / H_limit_fluxes + do i=is,ie ; if ((Pen_SW_rem(i) > 0.0) .and. (h_heat(i) > 0.0)) then + if (h_heat(i)*Ih_limit < 1.0) then + unabsorbed = 1.0 - h_heat(i)*Ih_limit + else + unabsorbed = 0.0 + endif + do n=1,nsw ; Pen_SW_bnd(n,i) = unabsorbed * Pen_SW_bnd(n,i) ; enddo + endif ; enddo + + endif ! absorbAllSW + +end subroutine sumSWoverBands + + + + subroutine opacity_init(Time, G, param_file, diag, CS, optics) type(time_type), target, intent(in) :: Time !< The current model time. type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. diff --git a/src/parameterizations/vertical/MOM_shortwave_abs.F90 b/src/parameterizations/vertical/MOM_shortwave_abs.F90 deleted file mode 100644 index d24e5ed55e..0000000000 --- a/src/parameterizations/vertical/MOM_shortwave_abs.F90 +++ /dev/null @@ -1,424 +0,0 @@ -!> Absorption of downwelling shortwave radiation -module MOM_shortwave_abs - -! This file is part of MOM6. See LICENSE.md for the license. - -use MOM_error_handler, only : MOM_error, FATAL, WARNING -use MOM_file_parser, only : get_param, log_param, log_version, param_file_type -use MOM_grid, only : ocean_grid_type -use MOM_unit_scaling, only : unit_scale_type -use MOM_verticalGrid, only : verticalGrid_type - -implicit none ; private - -#include - -public absorbRemainingSW, sumSWoverBands - -!> This type is used to exchange information about ocean optical properties -type, public :: optics_type - ! ocean optical properties - - integer :: nbands !< number of penetrating bands of SW radiation - - real, pointer, dimension(:,:,:,:) :: opacity_band => NULL() !< SW optical depth per unit thickness [m-1] - !! The number of radiation bands is most rapidly varying (first) index. - - real, pointer, dimension(:,:,:) :: SW_pen_band => NULL() !< shortwave radiation [W m-2] at the surface - !! in each of the nbands bands that penetrates beyond the surface. - !! The most rapidly varying dimension is the band. - - real, pointer, dimension(:) :: & - min_wavelength_band => NULL(), & !< The minimum wavelength in each band of penetrating shortwave radiation [nm] - max_wavelength_band => NULL() !< The maximum wavelength in each band of penetrating shortwave radiation [nm] - -end type optics_type - -contains - -!> Apply shortwave heating below the boundary layer (when running with the bulk mixed layer inhereted -!! from GOLD) or throughout the water column. -!! -!! In addition, it causes all of the remaining SW radiation to be absorbed, provided that the total -!! water column thickness is greater than H_limit_fluxes. -!! For thinner water columns, the heating is scaled down proportionately, the assumption being that the -!! remaining heating (which is left in Pen_SW) should go into an (absent for now) ocean bottom sediment layer. -subroutine absorbRemainingSW(G, GV, US, h, opacity_band, nsw, j, dt, H_limit_fluxes, & - adjustAbsorptionProfile, absorbAllSW, T, Pen_SW_bnd, & - eps, ksort, htot, Ttot, TKE, dSV_dT) - - type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. - type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. - type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - real, dimension(SZI_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]. - real, dimension(:,:,:), intent(in) :: opacity_band !< Opacity in each band of penetrating - !! shortwave radiation [H-1 ~> m-1 or m2 kg-1]. - !! The indicies are band, i, k. - integer, intent(in) :: nsw !< Number of bands of penetrating - !! shortwave radiation. - integer, intent(in) :: j !< j-index to work on. - real, intent(in) :: dt !< Time step [T ~> s]. - real, intent(in) :: H_limit_fluxes !< If the total ocean depth is - !! less than this, they are scaled away - !! to avoid numerical instabilities - !! [H ~> m or kg m-2]. This would - !! not be necessary if a finite heat - !! capacity mud-layer were added. - logical, intent(in) :: adjustAbsorptionProfile !< If true, apply - !! heating above the layers in which it - !! should have occurred to get the - !! correct mean depth (and potential - !! energy change) of the shortwave that - !! should be absorbed by each layer. - logical, intent(in) :: absorbAllSW !< If true, apply heating above the - !! layers in which it should have occurred - !! to get the correct mean depth (and - !! potential energy change) of the - !! shortwave that should be absorbed by - !! each layer. - real, dimension(SZI_(G),SZK_(G)), intent(inout) :: T !< Layer potential/conservative - !! temperatures [degC] - real, dimension(:,:), intent(inout) :: Pen_SW_bnd !< Penetrating shortwave heating in - !! each band that hits the bottom and will - !! will be redistributed through the water - !! column [degC H ~> degC m or degC kg m-2], - !! size nsw x SZI_(G). - real, dimension(SZI_(G),SZK_(G)), optional, intent(in) :: eps !< Small thickness that must remain in - !! each layer, and which will not be - !! subject to heating [H ~> m or kg m-2] - integer, dimension(SZI_(G),SZK_(G)), optional, intent(in) :: ksort !< Density-sorted k-indicies. - real, dimension(SZI_(G)), optional, intent(in) :: htot !< Total mixed layer thickness [H ~> m or kg m-2]. - real, dimension(SZI_(G)), optional, intent(inout) :: Ttot !< Depth integrated mixed layer - !! temperature [degC H ~> degC m or degC kg m-2] - real, dimension(SZI_(G),SZK_(G)), optional, intent(in) :: dSV_dT !< The partial derivative of specific - !! volume with temperature [m3 kg-1 degC-1]. - real, dimension(SZI_(G),SZK_(G)), optional, intent(inout) :: TKE !< The TKE sink from mixing the heating - !! throughout a layer [kg m-3 Z3 T-2 ~> J m-2]. - ! Local variables - real, dimension(SZI_(G),SZK_(G)) :: & - T_chg_above ! A temperature change that will be applied to all the thick - ! layers above a given layer [degC]. This is only nonzero if - ! adjustAbsorptionProfile is true, in which case the net - ! change in the temperature of a layer is the sum of the - ! direct heating of that layer plus T_chg_above from all of - ! the layers below, plus any contribution from absorbing - ! radiation that hits the bottom. - real, dimension(SZI_(G)) :: & - h_heat, & ! The thickness of the water column that will be heated by - ! any remaining shortwave radiation [H ~> m or kg m-2]. - T_chg, & ! The temperature change of thick layers due to the remaining - ! shortwave radiation and contributions from T_chg_above [degC]. - Pen_SW_rem ! The sum across all wavelength bands of the penetrating shortwave - ! heating that hits the bottom and will be redistributed through - ! the water column [degC H ~> degC m or degC kg m-2] - real :: SW_trans ! fraction of shortwave radiation that is not - ! absorbed in a layer [nondim] - real :: unabsorbed ! fraction of the shortwave radiation that - ! is not absorbed because the layers are too thin - real :: Ih_limit ! inverse of the total depth at which the - ! surface fluxes start to be limited [H-1 ~> m-1 or m2 kg-1] - real :: h_min_heat ! minimum thickness layer that should get heated [H ~> m or kg m-2] - real :: opt_depth ! optical depth of a layer [nondim] - real :: exp_OD ! exp(-opt_depth) [nondim] - real :: heat_bnd ! heating due to absorption in the current - ! layer by the current band, including any piece that - ! is moved upward [degC H ~> degC m or degC kg m-2] - real :: SWa ! fraction of the absorbed shortwave that is - ! moved to layers above with adjustAbsorptionProfile [nondim] - real :: coSWa_frac ! The fraction of SWa that is actually moved upward. - real :: min_SW_heating ! A minimum remaining shortwave heating rate that will be simply - ! absorbed in the next layer for computational efficiency, instead of - ! continuing to penetrate [degC H T-1 ~> degC m s-1 or degC kg m-2 s-1]. - ! The default, 2.5e-11, is about 0.08 degC m / century. - real :: epsilon ! A small thickness that must remain in each - ! layer, and which will not be subject to heating [H ~> m or kg m-2] - real :: g_Hconv2 ! A conversion factor for use in the TKE calculation - ! in units of [Z3 kg2 m-6 T-2 H-2 ~> kg2 m-5 s-2 or m s-2]. - logical :: SW_Remains ! If true, some column has shortwave radiation that - ! was not entirely absorbed. - logical :: TKE_calc ! If true, calculate the implications to the - ! TKE budget of the shortwave heating. - real :: C1_6, C1_60 - integer :: is, ie, nz, i, k, ks, n - SW_Remains = .false. - - min_SW_heating = 2.5e-11*US%T_to_s !### This needs *GV%m_to_H for dimensional consistency? - - h_min_heat = 2.0*GV%Angstrom_H + GV%H_subroundoff - is = G%isc ; ie = G%iec ; nz = G%ke - C1_6 = 1.0 / 6.0 ; C1_60 = 1.0 / 60.0 - - TKE_calc = (present(TKE) .and. present(dSV_dT)) - ! g_Hconv2 = (US%m_to_Z**3 * US%T_to_s**2) * GV%H_to_Pa * GV%H_to_kg_m2 - g_Hconv2 = (US%m_to_Z**4 * US%T_to_s**2 * GV%g_Earth * GV%H_to_kg_m2) * GV%H_to_kg_m2 - ! g_Hconv2 = US%m_to_Z**4 * US%T_to_s**2 * GV%g_Earth * GV%H_to_kg_m2**2 - - h_heat(:) = 0.0 - if (present(htot)) then ; do i=is,ie ; h_heat(i) = htot(i) ; enddo ; endif - - ! Apply penetrating SW radiation to remaining parts of layers. - ! Excessively thin layers are not heated to avoid runaway temps. - do ks=1,nz ; do i=is,ie - k = ks - if (present(ksort)) then - if (ksort(i,ks) <= 0) cycle - k = ksort(i,ks) - endif - epsilon = 0.0 ; if (present(eps)) epsilon = eps(i,k) - - T_chg_above(i,k) = 0.0 - - if (h(i,k) > 1.5*epsilon) then - do n=1,nsw ; if (Pen_SW_bnd(n,i) > 0.0) then - ! SW_trans is the SW that is transmitted THROUGH the layer - opt_depth = h(i,k) * opacity_band(n,i,k) - exp_OD = exp(-opt_depth) - SW_trans = exp_OD - - ! Heating at a rate of less than 10-4 W m-2 = 10-3 K m / Century, - ! and of the layer in question less than 1 K / Century, can be - ! absorbed without further penetration. - ! ###Make these numbers into parameters! - if (nsw*Pen_SW_bnd(n,i)*SW_trans < & - dt*min_SW_heating*min(1.0*GV%m_to_H, 1e3*h(i,k)) ) SW_trans = 0.0 - - Heat_bnd = Pen_SW_bnd(n,i) * (1.0 - SW_trans) - if (adjustAbsorptionProfile .and. (h_heat(i) > 0.0)) then - ! In this case, a fraction of the heating is applied to the - ! overlying water so that the mean pressure at which the shortwave - ! heating occurs is exactly what it would have been with a careful - ! pressure-weighted averaging of the exponential heating profile, - ! hence there should be no TKE budget requirements due to this - ! layer. Very clever, but this is also limited so that the - ! water above is not heated at a faster rate than the layer - ! actually being heated, i.e., SWA <= h_heat / (h_heat + h(i,k)) - ! and takes the energetics of the rest of the heating into account. - ! (-RWH, ~7 years later.) - if (opt_depth > 1e-5) then - SWa = ((opt_depth + (opt_depth + 2.0)*exp_OD) - 2.0) / & - ((opt_depth + opacity_band(n,i,k) * h_heat(i)) * & - (1.0 - exp_OD)) - else - ! Use Taylor series expansion of the expression above for a - ! more accurate form with very small layer optical depths. - SWa = h(i,k) * (opt_depth * (1.0 - opt_depth)) / & - ((h_heat(i) + h(i,k)) * (6.0 - 3.0*opt_depth)) - endif - coSWa_frac = 0.0 - if (SWa*(h_heat(i) + h(i,k)) > h_heat(i)) then - coSWa_frac = (SWa*(h_heat(i) + h(i,k)) - h_heat(i) ) / & - (SWa*(h_heat(i) + h(i,k))) - SWa = h_heat(i) / (h_heat(i) + h(i,k)) - endif - - T_chg_above(i,k) = T_chg_above(i,k) + (SWa * Heat_bnd) / h_heat(i) - T(i,k) = T(i,k) + ((1.0 - SWa) * Heat_bnd) / h(i,k) - else - coSWa_frac = 1.0 - T(i,k) = T(i,k) + Pen_SW_bnd(n,i) * (1.0 - SW_trans) / h(i,k) - endif - - if (TKE_calc) then - if (opt_depth > 1e-2) then - TKE(i,k) = TKE(i,k) - coSWa_frac*Heat_bnd*dSV_dT(i,k)* & - (0.5*h(i,k)*g_Hconv2) * & - (opt_depth*(1.0+exp_OD) - 2.0*(1.0-exp_OD)) / (opt_depth*(1.0-exp_OD)) - else - ! Use Taylor series-derived approximation to the above expression - ! that is well behaved and more accurate when opt_depth is small. - TKE(i,k) = TKE(i,k) - coSWa_frac*Heat_bnd*dSV_dT(i,k)* & - (0.5*h(i,k)*g_Hconv2) * & - (C1_6*opt_depth * (1.0 - C1_60*opt_depth**2)) - endif - endif - - Pen_SW_bnd(n,i) = Pen_SW_bnd(n,i) * SW_trans - endif ; enddo - endif - - ! Add to the accumulated thickness above that could be heated. - ! Only layers greater than h_min_heat thick should get heated. - if (h(i,k) >= 2.0*h_min_heat) then - h_heat(i) = h_heat(i) + h(i,k) - elseif (h(i,k) > h_min_heat) then - h_heat(i) = h_heat(i) + (2.0*h(i,k) - 2.0*h_min_heat) - endif - enddo ; enddo ! i & k loops - - -! if (.not.absorbAllSW .and. .not.adjustAbsorptionProfile) return - - ! Unless modified, there is no temperature change due to fluxes from the bottom. - do i=is,ie ; T_chg(i) = 0.0 ; enddo - - if (absorbAllSW) then - ! If there is still shortwave radiation at this point, it could go into - ! the bottom (with a bottom mud model), or it could be redistributed back - ! through the water column. - do i=is,ie - Pen_SW_rem(i) = Pen_SW_bnd(1,i) - do n=2,nsw ; Pen_SW_rem(i) = Pen_SW_rem(i) + Pen_SW_bnd(n,i) ; enddo - enddo - do i=is,ie ; if (Pen_SW_rem(i) > 0.0) SW_Remains = .true. ; enddo - - Ih_limit = 1.0 / H_limit_fluxes - do i=is,ie ; if ((Pen_SW_rem(i) > 0.0) .and. (h_heat(i) > 0.0)) then - if (h_heat(i)*Ih_limit >= 1.0) then - T_chg(i) = Pen_SW_rem(i) / h_heat(i) ; unabsorbed = 0.0 - else - T_chg(i) = Pen_SW_rem(i) * Ih_limit - unabsorbed = 1.0 - h_heat(i)*Ih_limit - endif - do n=1,nsw ; Pen_SW_bnd(n,i) = unabsorbed * Pen_SW_bnd(n,i) ; enddo - endif ; enddo - endif ! absorbAllSW - - if (absorbAllSW .or. adjustAbsorptionProfile) then - do ks=nz,1,-1 ; do i=is,ie - k = ks - if (present(ksort)) then - if (ksort(i,ks) <= 0) cycle - k = ksort(i,ks) - endif - - if (T_chg(i) > 0.0) then - ! Only layers greater than h_min_heat thick should get heated. - if (h(i,k) >= 2.0*h_min_heat) then ; T(i,k) = T(i,k) + T_chg(i) - elseif (h(i,k) > h_min_heat) then - T(i,k) = T(i,k) + T_chg(i) * (2.0 - 2.0*h_min_heat/h(i,k)) - endif - endif - ! Increase the heating for layers above. - T_chg(i) = T_chg(i) + T_chg_above(i,k) - enddo ; enddo - if (present(htot) .and. present(Ttot)) then - do i=is,ie ; Ttot(i) = Ttot(i) + T_chg(i) * htot(i) ; enddo - endif - endif ! absorbAllSW .or. adjustAbsorptionProfile - -end subroutine absorbRemainingSW - - -subroutine sumSWoverBands(G, GV, US, h, opacity_band, nsw, j, dt, & - H_limit_fluxes, absorbAllSW, iPen_SW_bnd, netPen) -!< This subroutine calculates the total shortwave heat flux integrated over -!! bands as a function of depth. This routine is only called for computing -!! buoyancy fluxes for use in KPP. This routine does not updat e the state. - type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. - type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. - type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - real, dimension(SZI_(G),SZK_(G)), & - intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]. - real, dimension(:,:,:), intent(in) :: opacity_band !< opacity in each band of - !! penetrating shortwave radiation [m-1]. - !! The indicies are band, i, k. - integer, intent(in) :: nsw !< number of bands of penetrating - !! shortwave radiation. - integer, intent(in) :: j !< j-index to work on. - real, intent(in) :: dt !< Time step [T ~> s]. - real, intent(in) :: H_limit_fluxes !< the total depth at which the - !! surface fluxes start to be limited to avoid - !! excessive heating of a thin ocean [H ~> m or kg m-2] - logical, intent(in) :: absorbAllSW !< If true, ensure that all shortwave - !! radiation is absorbed in the ocean water column. - real, dimension(:,:), intent(in) :: iPen_SW_bnd !< The incident penetrating shortwave - !! heating in each band that hits the bottom and - !! will be redistributed through the water column - !! [degC H ~> degC m or degC kg m-2]; size nsw x SZI_(G). - real, dimension(SZI_(G),SZK_(G)+1), & - intent(inout) :: netPen !< Net penetrating shortwave heat flux at each - !! interface, summed across all bands - !! [degC H ~> degC m or degC kg m-2]. - ! Local variables - real :: h_heat(SZI_(G)) ! thickness of the water column that receives - ! remaining shortwave radiation [H ~> m or kg m-2]. - real :: Pen_SW_rem(SZI_(G)) ! sum across all wavelength bands of the - ! penetrating shortwave heating that hits the bottom - ! and will be redistributed through the water column - ! [degC H ~> degC m or degC kg m-2] - - real, dimension(size(iPen_SW_bnd,1),size(iPen_SW_bnd,2)) :: Pen_SW_bnd - real :: SW_trans ! fraction of shortwave radiation not - ! absorbed in a layer [nondim] - real :: unabsorbed ! fraction of the shortwave radiation - ! not absorbed because the layers are too thin. - real :: Ih_limit ! inverse of the total depth at which the - ! surface fluxes start to be limited [H-1 ~> m-1 or m2 kg-1] - real :: h_min_heat ! minimum thickness layer that should get heated [H ~> m or kg m-2] - real :: opt_depth ! optical depth of a layer [nondim] - real :: exp_OD ! exp(-opt_depth) [nondim] - logical :: SW_Remains ! If true, some column has shortwave radiation that - ! was not entirely absorbed. - - integer :: is, ie, nz, i, k, ks, n - SW_Remains = .false. - - h_min_heat = 2.0*GV%Angstrom_H + GV%H_subroundoff - is = G%isc ; ie = G%iec ; nz = G%ke - - pen_SW_bnd(:,:) = iPen_SW_bnd(:,:) - do i=is,ie ; h_heat(i) = 0.0 ; enddo - netPen(:,1) = sum( pen_SW_bnd(:,:), dim=1 ) ! Surface interface - - ! Apply penetrating SW radiation to remaining parts of layers. - ! Excessively thin layers are not heated to avoid runaway temps. - do k=1,nz - - do i=is,ie - netPen(i,k+1) = 0. - - if (h(i,k) > 0.0) then - do n=1,nsw ; if (Pen_SW_bnd(n,i) > 0.0) then - ! SW_trans is the SW that is transmitted THROUGH the layer - opt_depth = h(i,k)*GV%H_to_m * opacity_band(n,i,k) - exp_OD = exp(-opt_depth) - SW_trans = exp_OD - - ! Heating at a rate of less than 10-4 W m-2 = 10-3 K m / Century, - ! and of the layer in question less than 1 K / Century, can be - ! absorbed without further penetration. - if ((nsw*Pen_SW_bnd(n,i)*SW_trans < GV%m_to_H*2.5e-11*US%T_to_s*dt) .and. & - (nsw*Pen_SW_bnd(n,i)*SW_trans < h(i,k)*dt*US%T_to_s*2.5e-8)) & - SW_trans = 0.0 - - Pen_SW_bnd(n,i) = Pen_SW_bnd(n,i) * SW_trans - netPen(i,k+1) = netPen(i,k+1) + Pen_SW_bnd(n,i) - endif ; enddo - endif ! h(i,k) > 0.0 - - ! Add to the accumulated thickness above that could be heated. - ! Only layers greater than h_min_heat thick should get heated. - if (h(i,k) >= 2.0*h_min_heat) then - h_heat(i) = h_heat(i) + h(i,k) - elseif (h(i,k) > h_min_heat) then - h_heat(i) = h_heat(i) + (2.0*h(i,k) - 2.0*h_min_heat) - endif - enddo ! i loop - enddo ! k loop - - if (absorbAllSW) then - - ! If there is still shortwave radiation at this point, it could go into - ! the bottom (with a bottom mud model), or it could be redistributed back - ! through the water column. - do i=is,ie - Pen_SW_rem(i) = Pen_SW_bnd(1,i) - do n=2,nsw ; Pen_SW_rem(i) = Pen_SW_rem(i) + Pen_SW_bnd(n,i) ; enddo - enddo - do i=is,ie ; if (Pen_SW_rem(i) > 0.0) SW_Remains = .true. ; enddo - - Ih_limit = 1.0 / H_limit_fluxes - do i=is,ie ; if ((Pen_SW_rem(i) > 0.0) .and. (h_heat(i) > 0.0)) then - if (h_heat(i)*Ih_limit < 1.0) then - unabsorbed = 1.0 - h_heat(i)*Ih_limit - else - unabsorbed = 0.0 - endif - do n=1,nsw ; Pen_SW_bnd(n,i) = unabsorbed * Pen_SW_bnd(n,i) ; enddo - endif ; enddo - - endif ! absorbAllSW - -end subroutine sumSWoverBands - -end module MOM_shortwave_abs diff --git a/src/tracer/MOM_offline_aux.F90 b/src/tracer/MOM_offline_aux.F90 index 89f4a6eef4..37f66987c0 100644 --- a/src/tracer/MOM_offline_aux.F90 +++ b/src/tracer/MOM_offline_aux.F90 @@ -18,7 +18,7 @@ module MOM_offline_aux use astronomy_mod, only : orbital_time, diurnal_solar, daily_mean_solar use MOM_variables, only : vertvisc_type use MOM_forcing_type, only : forcing -use MOM_shortwave_abs, only : optics_type +use MOM_opacity, only : optics_type use MOM_diag_mediator, only : post_data use MOM_forcing_type, only : forcing diff --git a/src/tracer/MOM_offline_main.F90 b/src/tracer/MOM_offline_main.F90 index cb14df2c6a..8278e57264 100644 --- a/src/tracer/MOM_offline_main.F90 +++ b/src/tracer/MOM_offline_main.F90 @@ -26,9 +26,8 @@ module MOM_offline_main use MOM_offline_aux, only : update_h_horizontal_flux, update_h_vertical_flux, limit_mass_flux_3d use MOM_offline_aux, only : distribute_residual_uh_barotropic, distribute_residual_vh_barotropic use MOM_offline_aux, only : distribute_residual_uh_upwards, distribute_residual_vh_upwards -use MOM_opacity, only : opacity_CS +use MOM_opacity, only : opacity_CS, optics_type use MOM_open_boundary, only : ocean_OBC_type -use MOM_shortwave_abs, only : optics_type use MOM_time_manager, only : time_type use MOM_tracer_advect, only : tracer_advect_CS, advect_tracer use MOM_tracer_diabatic, only : applyTracerBoundaryFluxesInOut From d4b476e702853d7fd8df7c3fbf60292c865854ed Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Fri, 5 Jul 2019 18:05:16 -0400 Subject: [PATCH 67/82] Explicitly declare the size of the pen_SW_bnd args Explicitly declared the dimensions of the pen_SW_bnd arguments to extractFluxes1d and extractFluxes2d. This would fix a problem if MOM6 were using global indexing. All answers are bitwise identical. --- src/core/MOM_forcing_type.F90 | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/core/MOM_forcing_type.F90 b/src/core/MOM_forcing_type.F90 index 29140b8b4b..61b39bd928 100644 --- a/src/core/MOM_forcing_type.F90 +++ b/src/core/MOM_forcing_type.F90 @@ -375,7 +375,7 @@ subroutine extractFluxes1d(G, GV, fluxes, optics, nsw, j, dt, real, dimension(SZI_(G)), intent(out) :: net_salt !< surface salt flux into the ocean !! accumulated over a time step !! [ppt H ~> ppt m or ppt kg m-2]. - real, dimension(:,:), intent(out) :: pen_SW_bnd !< penetrating SW flux, split into bands. + real, dimension(max(1,nsw),G%isd:G%ied), intent(out) :: pen_SW_bnd !< penetrating SW flux, split into bands. !! [degC H ~> degC m or degC kg m-2] !! and array size nsw x SZI_(G), where !! nsw=number of SW bands in pen_SW_bnd. @@ -398,7 +398,7 @@ subroutine extractFluxes1d(G, GV, fluxes, optics, nsw, j, dt, real, dimension(SZI_(G)), & optional, intent(out) :: netmassInOut_rate !< Rate of net mass flux into the ocean !! [H s-1 ~> m s-1 or kg m-2 s-1]. - real, dimension(:,:), & + real, dimension(max(1,nsw),G%isd:G%ied), & optional, intent(out) :: pen_sw_bnd_rate !< Rate of penetrative shortwave heating !! [degC H s-1 ~> degC m s-1 or degC kg m-2 s-1]. logical, optional, intent(in) :: skip_diags !< If present and true, skip calculating diagnostics @@ -834,7 +834,7 @@ subroutine extractFluxes2d(G, GV, fluxes, optics, nsw, dt, FluxRescaleDepth, & !! [degC H ~> degC m or degC kg m-2] real, dimension(SZI_(G),SZJ_(G)), intent(out) :: net_salt !< surface salt flux into the ocean accumulated !! over a time step [ppt H ~> ppt m or ppt kg m-2] - real, dimension(:,:,:), intent(out) :: pen_SW_bnd !< penetrating shortwave flux, split into bands. + real, dimension(max(1,nsw),G%isd:G%ied,G%jsd:G%jed), intent(out) :: pen_SW_bnd !< penetrating SW flux, split into bands. !! [degC H ~> degC m or degC kg m-2] array size !! nsw x SZI_(G), where nsw=number of SW bands in !! pen_SW_bnd. This heat flux is not in net_heat. From bf4c12c21bcc3fac753dba076847ce7f41a6203d Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sat, 6 Jul 2019 03:33:59 -0400 Subject: [PATCH 68/82] +Added optics extractor routines Added the extractor routines extract_optics_slice, extract_optics_fields and optics_nbands to the MOM_opacity module, in preparation for possibly making the optics type opaque. All answers are bitwise identical, but there are new public subroutines. --- src/core/MOM_forcing_type.F90 | 20 +++-- .../vertical/MOM_bulk_mixed_layer.F90 | 6 +- .../vertical/MOM_diabatic_aux.F90 | 12 ++- .../vertical/MOM_opacity.F90 | 74 ++++++++++++++++--- 4 files changed, 83 insertions(+), 29 deletions(-) diff --git a/src/core/MOM_forcing_type.F90 b/src/core/MOM_forcing_type.F90 index 61b39bd928..7f1314e25d 100644 --- a/src/core/MOM_forcing_type.F90 +++ b/src/core/MOM_forcing_type.F90 @@ -11,7 +11,7 @@ module MOM_forcing_type use MOM_EOS, only : calculate_density_derivs use MOM_file_parser, only : get_param, log_param, log_version, param_file_type use MOM_grid, only : ocean_grid_type -use MOM_opacity, only : sumSWoverBands, optics_type +use MOM_opacity, only : sumSWoverBands, optics_type, extract_optics_slice, optics_nbands use MOM_spatial_means, only : global_area_integral, global_area_mean use MOM_unit_scaling, only : unit_scale_type use MOM_variables, only : surface, thermo_var_ptrs @@ -444,7 +444,7 @@ subroutine extractFluxes1d(G, GV, fluxes, optics, nsw, j, dt, ! error checking - if (nsw > 0) then ; if (nsw /= optics%nbands) call MOM_error(WARNING, & + if (nsw > 0) then ; if (nsw /= optics_nbands(optics)) call MOM_error(WARNING, & "mismatch in the number of bands of shortwave radiation in MOM_forcing_type extract_fluxes.") endif @@ -473,18 +473,22 @@ subroutine extractFluxes1d(G, GV, fluxes, optics, nsw, j, dt, do i=is,ie ; htot(i) = h(i,1) ; enddo do k=2,nz ; do i=is,ie ; htot(i) = htot(i) + h(i,k) ; enddo ; enddo + if (nsw >= 1) then + call extract_optics_slice(optics, j, G, GV, penSW_top=Pen_SW_bnd) !, penSW_scale=J_m2_to_H*dt + if (do_PSWBR) call extract_optics_slice(optics, j, G, GV, penSW_top=Pen_SW_bnd_rate) !, penSW_scale=J_m2_to_H + endif do i=is,ie scale = 1.0 if (htot(i)*Ih_limit < 1.0) scale = htot(i)*Ih_limit - ! Convert the penetrating shortwave forcing to (K * H) + ! Convert the penetrating shortwave forcing to (K * H) and reduce fluxes for shallow depths. ! (H=m for Bouss, H=kg/m2 for non-Bouss) Pen_sw_tot(i) = 0.0 if (nsw >= 1) then - do n=1,nsw - Pen_SW_bnd(n,i) = J_m2_to_H*scale*dt * max(0.0, optics%sw_pen_band(n,i,j)) + do n=1,nsw + Pen_SW_bnd(n,i) = J_m2_to_H*scale*dt * max(0.0, Pen_SW_bnd(n,i)) Pen_sw_tot(i) = Pen_sw_tot(i) + Pen_SW_bnd(n,i) enddo else @@ -495,7 +499,7 @@ subroutine extractFluxes1d(G, GV, fluxes, optics, nsw, j, dt, pen_sw_tot_rate(i) = 0.0 if (nsw >= 1) then do n=1,nsw - Pen_SW_bnd_rate(n,i) = J_m2_to_H*scale * max(0.0, optics%sw_pen_band(n,i,j)) + Pen_SW_bnd_rate(n,i) = J_m2_to_H*scale * max(0.0, Pen_SW_bnd_rate(n,i)) pen_sw_tot_rate(i) = pen_sw_tot_rate(i) + pen_sw_bnd_rate(n,i) enddo else @@ -900,7 +904,7 @@ subroutine calculateBuoyancyFlux1d(G, GV, US, fluxes, optics, h, Temp, Salt, tv, real :: depthBeforeScalingFluxes, GoRho real :: H_limit_fluxes - nsw = optics%nbands + nsw = optics_nbands(optics) ! smg: what do we do when have heat fluxes from calving and river? useRiverHeatContent = .False. @@ -928,7 +932,7 @@ subroutine calculateBuoyancyFlux1d(G, GV, US, fluxes, optics, h, Temp, Salt, tv, ! Sum over bands and attenuate as a function of depth ! netPen is the netSW as a function of depth - call sumSWoverBands(G, GV, US, h(:,j,:), optics%opacity_band(:,:,j,:), nsw, j, dt*US%s_to_T, & + call sumSWoverBands(G, GV, US, h(:,j,:), optics, j, dt*US%s_to_T, & H_limit_fluxes, .true., penSWbnd, netPen) ! Density derivatives diff --git a/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 b/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 index 47154717e2..9da5b5c6c7 100644 --- a/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 +++ b/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 @@ -11,7 +11,7 @@ module MOM_bulk_mixed_layer use MOM_file_parser, only : get_param, log_param, log_version, param_file_type use MOM_forcing_type, only : extractFluxes1d, forcing use MOM_grid, only : ocean_grid_type -use MOM_opacity, only : absorbRemainingSW, optics_type +use MOM_opacity, only : absorbRemainingSW, optics_type, extract_optics_slice use MOM_unit_scaling, only : unit_scale_type use MOM_variables, only : thermo_var_ptrs use MOM_verticalGrid, only : verticalGrid_type @@ -454,10 +454,8 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt_in_T, ea, eb, G, GV, h_orig(i,k) = h_3d(i,j,k) eps(i,k) = 0.0 ; if (k > nkmb) eps(i,k) = GV%Angstrom_H T(i,k) = tv%T(i,j,k) ; S(i,k) = tv%S(i,j,k) - do n=1,nsw - opacity_band(n,i,k) = GV%H_to_m*optics%opacity_band(n,i,j,k) - enddo enddo ; enddo + if (nsw>0) call extract_optics_slice(optics, j, G, GV, opacity=opacity_band, opacity_scale=GV%H_to_m) do k=1,nz ; do i=is,ie d_ea(i,k) = 0.0 ; d_eb(i,k) = 0.0 diff --git a/src/parameterizations/vertical/MOM_diabatic_aux.F90 b/src/parameterizations/vertical/MOM_diabatic_aux.F90 index 0840ab203f..41ed2452e6 100644 --- a/src/parameterizations/vertical/MOM_diabatic_aux.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_aux.F90 @@ -16,7 +16,7 @@ module MOM_diabatic_aux use MOM_forcing_type, only : forcing, extractFluxes1d, forcing_SinglePointPrint use MOM_grid, only : ocean_grid_type use MOM_io, only : slasher -use MOM_opacity, only : set_opacity, opacity_CS +use MOM_opacity, only : set_opacity, opacity_CS, extract_optics_slice, extract_optics_fields use MOM_opacity, only : absorbRemainingSW, optics_type, sumSWoverBands use MOM_tracer_flow_control, only : get_chl_from_model, tracer_flow_control_CS use MOM_unit_scaling, only : unit_scale_type @@ -927,7 +927,7 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, US, dt, fluxes, optics, h, tv, & #define _OLD_ALG_ dt_in_T = dt * US%s_to_T - nsw = optics%nbands + call extract_optics_fields(optics, nbands=nsw) Idt = 1.0/dt calculate_energetics = (present(cTKE) .and. present(dSV_dT) .and. present(dSV_dS)) @@ -977,10 +977,8 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, US, dt, fluxes, optics, h, tv, & do k=1,nz ; do i=is,ie h2d(i,k) = h(i,j,k) T2d(i,k) = tv%T(i,j,k) - do n=1,nsw - opacityBand(n,i,k) = (1.0 / GV%m_to_H)*optics%opacity_band(n,i,j,k) - enddo enddo ; enddo + if (nsw>0) call extract_optics_slice(optics, j, G, GV, opacity=opacityBand, opacity_scale=(1.0/GV%m_to_H)) if (calculate_energetics) then ! The partial derivatives of specific volume with temperature and @@ -1329,8 +1327,8 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, US, dt, fluxes, optics, h, tv, & netPen(:,:) = 0.0 ! Sum over bands and attenuate as a function of depth ! netPen is the netSW as a function of depth - call sumSWoverBands(G, GV, US, h2d(:,:), optics%opacity_band(:,:,j,:), nsw, j, dt_in_T, & - H_limit_fluxes, .true., pen_SW_bnd_rate, netPen) + call sumSWoverBands(G, GV, US, h2d(:,:), optics, j, dt_in_T, & + H_limit_fluxes, .true., pen_SW_bnd_rate, netPen) ! Density derivatives call calculate_density_derivs(T2d(:,1), tv%S(:,j,1), SurfPressure, & dRhodT, dRhodS, start, npts, tv%eqn_of_state) diff --git a/src/parameterizations/vertical/MOM_opacity.F90 b/src/parameterizations/vertical/MOM_opacity.F90 index ad9f8c53bd..c771268d22 100644 --- a/src/parameterizations/vertical/MOM_opacity.F90 +++ b/src/parameterizations/vertical/MOM_opacity.F90 @@ -18,13 +18,14 @@ module MOM_opacity #include public set_opacity, opacity_init, opacity_end, opacity_manizza, opacity_morel +public extract_optics_slice, extract_optics_fields, optics_nbands public absorbRemainingSW, sumSWoverBands !> This type is used to exchange information about ocean optical properties type, public :: optics_type ! ocean optical properties - integer :: nbands !< number of penetrating bands of SW radiation + integer :: nbands !< The number of penetrating bands of SW radiation real, pointer, dimension(:,:,:,:) :: opacity_band => NULL() !< SW optical depth per unit thickness [m-1] !! The number of radiation bands is most rapidly varying (first) index. @@ -428,6 +429,62 @@ function opacity_manizza(chl_data) opacity_manizza = 0.0232 + 0.074*chl_data**0.674 end function +!> This subroutine returns a 2-d slice at constant j of fields from an optics_type, with the potential +!! for rescaling these fields. +subroutine extract_optics_slice(optics, j, G, GV, opacity, opacity_scale, penSW_top, penSW_scale) + type(optics_type), intent(in) :: optics !< An optics structure that has values of opacities + !! and shortwave fluxes. + integer, intent(in) :: j !< j-index to extract + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. + real, dimension(max(optics%nbands,1),SZI_(G),SZK_(G)), & + optional, intent(out) :: opacity !< The opacity in each band, i-point, and layer + real, optional, intent(in) :: opacity_scale !< A factor by which to rescale the opacity. + real, dimension(max(optics%nbands,1),SZI_(G)), & + optional, intent(out) :: penSW_top !< The shortwave radiation [W m-2] at the surface + !! in each of the nbands bands that penetrates beyond the surface. + real, optional, intent(in) :: penSW_scale !< A factor by which to rescale the shortwave flux. + + ! Local variables + real :: scale_opacity, scale_penSW ! Rescaling factors + integer :: i, is, ie, k, nz, n + is = G%isc ; ie = G%iec ; nz = G%ke + + scale_opacity = 1.0 ; if (present(opacity_scale)) scale_opacity = opacity_scale + scale_penSW = 1.0 ; if (present(penSW_scale)) scale_penSW = penSW_scale + + if (present(opacity)) then ; do k=1,nz ; do i=is,ie + do n=1,optics%nbands + opacity(n,i,k) = scale_opacity * optics%opacity_band(n,i,j,k) + enddo + enddo ; enddo ; endif + + if (present(penSW_top)) then ; do k=1,nz ; do i=is,ie + do n=1,optics%nbands + penSW_top(n,i) = scale_penSW * optics%SW_pen_band(n,i,j) + enddo + enddo ; enddo ; endif + +end subroutine extract_optics_slice + +!> Set arguments to fields from the optics type. +subroutine extract_optics_fields(optics, nbands) + type(optics_type), intent(in) :: optics !< An optics structure that has values of opacities + !! and shortwave fluxes. + integer, optional, intent(out) :: nbands !< The number of penetrating bands of SW radiation + + if (present(nbands)) nbands = optics%nbands + +end subroutine extract_optics_fields + +!> Return the number of bands of penetrating shortwave radiation. +function optics_nbands(optics) + type(optics_type), intent(in) :: optics !< An optics structure that has values of opacities + !! and shortwave fluxes. + integer :: optics_nbands !< The number of penetrating bands of SW radiation + + optics_nbands = optics%nbands +end function optics_nbands !> Apply shortwave heating below the boundary layer (when running with the bulk mixed layer inhereted !! from GOLD) or throughout the water column. @@ -692,7 +749,7 @@ subroutine absorbRemainingSW(G, GV, US, h, opacity_band, nsw, j, dt, H_limit_flu end subroutine absorbRemainingSW -subroutine sumSWoverBands(G, GV, US, h, opacity_band, nsw, j, dt, & +subroutine sumSWoverBands(G, GV, US, h, optics, j, dt, & H_limit_fluxes, absorbAllSW, iPen_SW_bnd, netPen) !< This subroutine calculates the total shortwave heat flux integrated over !! bands as a function of depth. This routine is only called for computing @@ -702,11 +759,8 @@ subroutine sumSWoverBands(G, GV, US, h, opacity_band, nsw, j, dt, & type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZK_(G)), & intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]. - real, dimension(:,:,:), intent(in) :: opacity_band !< opacity in each band of - !! penetrating shortwave radiation [m-1]. - !! The indicies are band, i, k. - integer, intent(in) :: nsw !< number of bands of penetrating - !! shortwave radiation. + type(optics_type), intent(in) :: optics !< An optics structure that has values + !! set based on the opacities. integer, intent(in) :: j !< j-index to work on. real, intent(in) :: dt !< Time step [T ~> s]. real, intent(in) :: H_limit_fluxes !< the total depth at which the @@ -743,11 +797,11 @@ subroutine sumSWoverBands(G, GV, US, h, opacity_band, nsw, j, dt, & logical :: SW_Remains ! If true, some column has shortwave radiation that ! was not entirely absorbed. - integer :: is, ie, nz, i, k, ks, n + integer :: is, ie, nz, i, k, ks, n, nsw SW_Remains = .false. h_min_heat = 2.0*GV%Angstrom_H + GV%H_subroundoff - is = G%isc ; ie = G%iec ; nz = G%ke + is = G%isc ; ie = G%iec ; nz = G%ke ; nsw = optics%nbands pen_SW_bnd(:,:) = iPen_SW_bnd(:,:) do i=is,ie ; h_heat(i) = 0.0 ; enddo @@ -763,7 +817,7 @@ subroutine sumSWoverBands(G, GV, US, h, opacity_band, nsw, j, dt, & if (h(i,k) > 0.0) then do n=1,nsw ; if (Pen_SW_bnd(n,i) > 0.0) then ! SW_trans is the SW that is transmitted THROUGH the layer - opt_depth = h(i,k)*GV%H_to_m * opacity_band(n,i,k) + opt_depth = h(i,k)*GV%H_to_m * optics%opacity_band(n,i,j,k) exp_OD = exp(-opt_depth) SW_trans = exp_OD From 562e5675c8945c5660d19dc13b9e21b20ffb6524 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sat, 6 Jul 2019 04:49:21 -0400 Subject: [PATCH 69/82] +Added nsw argument to applyBoundaryFluxesInOut Added nsw arguments to calculateBuoyancyFlux1d and applyBoundaryFluxesInOut to avoid directly using elements of the optics type. All answers are bitwise identical, but two public interfaces have changed. --- src/core/MOM_forcing_type.F90 | 22 ++++++++-------- .../vertical/MOM_diabatic_aux.F90 | 26 ++++++++++++------- .../vertical/MOM_diabatic_driver.F90 | 12 ++++----- 3 files changed, 33 insertions(+), 27 deletions(-) diff --git a/src/core/MOM_forcing_type.F90 b/src/core/MOM_forcing_type.F90 index 7f1314e25d..4e8053916e 100644 --- a/src/core/MOM_forcing_type.F90 +++ b/src/core/MOM_forcing_type.F90 @@ -838,10 +838,10 @@ subroutine extractFluxes2d(G, GV, fluxes, optics, nsw, dt, FluxRescaleDepth, & !! [degC H ~> degC m or degC kg m-2] real, dimension(SZI_(G),SZJ_(G)), intent(out) :: net_salt !< surface salt flux into the ocean accumulated !! over a time step [ppt H ~> ppt m or ppt kg m-2] - real, dimension(max(1,nsw),G%isd:G%ied,G%jsd:G%jed), intent(out) :: pen_SW_bnd !< penetrating SW flux, split into bands. - !! [degC H ~> degC m or degC kg m-2] array size - !! nsw x SZI_(G), where nsw=number of SW bands in - !! pen_SW_bnd. This heat flux is not in net_heat. + real, dimension(max(1,nsw),G%isd:G%ied,G%jsd:G%jed), intent(out) :: pen_SW_bnd !< penetrating SW flux, by frequency + !! band [degC H ~> degC m or degC kg m-2] with array + !! size nsw x SZI_(G), where nsw=number of SW bands + !! in pen_SW_bnd. This heat flux is not in net_heat. type(thermo_var_ptrs), intent(inout) :: tv !< structure containing pointers to available !! thermodynamic fields. Here it is used to keep !! track of the heat flux associated with net @@ -867,13 +867,15 @@ end subroutine extractFluxes2d !! These are actual fluxes, with units of stuff per time. Setting dt=1 in the call to !! extractFluxes routine allows us to get "stuf per time" rather than the time integrated !! fluxes needed in other routines that call extractFluxes. -subroutine calculateBuoyancyFlux1d(G, GV, US, fluxes, optics, h, Temp, Salt, tv, j, & +subroutine calculateBuoyancyFlux1d(G, GV, US, fluxes, optics, nsw, h, Temp, Salt, tv, j, & buoyancyFlux, netHeatMinusSW, netSalt, skip_diags) type(ocean_grid_type), intent(in) :: G !< ocean grid type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(forcing), intent(inout) :: fluxes !< surface fluxes type(optics_type), pointer :: optics !< penetrating SW optics + integer, intent(in) :: nsw !< The number of frequency bands of + !! penetrating shortwave radiation real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< layer thickness [H ~> m or kg m-2] real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: Temp !< prognostic temp [degC] real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: Salt !< salinity [ppt] @@ -887,13 +889,13 @@ subroutine calculateBuoyancyFlux1d(G, GV, US, fluxes, optics, h, Temp, Salt, tv, logical, optional, intent(in) :: skip_diags !< If present and true, skip calculating !! diagnostics inside extractFluxes1d() ! local variables - integer :: nsw, start, npts, k + integer :: start, npts, k real, parameter :: dt = 1. ! to return a rate from extractFluxes1d real, dimension( SZI_(G) ) :: netH ! net FW flux [H s-1 ~> m s-1 or kg m-2 s-1] real, dimension( SZI_(G) ) :: netEvap ! net FW flux leaving ocean via evaporation ! [H s-1 ~> m s-1 or kg m-2 s-1] real, dimension( SZI_(G) ) :: netHeat ! net temp flux [degC H s-1 ~> degC m s-2 or degC kg m-2 s-1] - real, dimension( optics%nbands, SZI_(G) ) :: penSWbnd ! SW penetration bands + real, dimension( max(nsw,1), SZI_(G) ) :: penSWbnd ! penetrating SW radiation by band real, dimension( SZI_(G) ) :: pressure ! pressurea the surface [Pa] real, dimension( SZI_(G) ) :: dRhodT ! density partial derivative wrt temp [kg m-3 degC-1] real, dimension( SZI_(G) ) :: dRhodS ! density partial derivative wrt saln [kg m-3 ppt-1] @@ -904,8 +906,6 @@ subroutine calculateBuoyancyFlux1d(G, GV, US, fluxes, optics, h, Temp, Salt, tv, real :: depthBeforeScalingFluxes, GoRho real :: H_limit_fluxes - nsw = optics_nbands(optics) - ! smg: what do we do when have heat fluxes from calving and river? useRiverHeatContent = .False. useCalvingHeatContent = .False. @@ -987,8 +987,8 @@ subroutine calculateBuoyancyFlux2d(G, GV, US, fluxes, optics, h, Temp, Salt, tv, !$OMP parallel do default(shared) firstprivate(netT,netS) do j=G%jsc,G%jec - call calculateBuoyancyFlux1d(G, GV, US, fluxes, optics, h, Temp, Salt, tv, j, buoyancyFlux(:,j,:), & - netT, netS, skip_diags=skip_diags) + call calculateBuoyancyFlux1d(G, GV, US, fluxes, optics, optics_nbands(optics), h, Temp, Salt, & + tv, j, buoyancyFlux(:,j,:), netT, netS, skip_diags=skip_diags) if (present(netHeatMinusSW)) netHeatMinusSW(G%isc:G%iec,j) = netT(G%isc:G%iec) if (present(netSalt)) netSalt(G%isc:G%iec,j) = netS(G%isc:G%iec) enddo diff --git a/src/parameterizations/vertical/MOM_diabatic_aux.F90 b/src/parameterizations/vertical/MOM_diabatic_aux.F90 index 41ed2452e6..8edfdb3e3f 100644 --- a/src/parameterizations/vertical/MOM_diabatic_aux.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_aux.F90 @@ -17,7 +17,7 @@ module MOM_diabatic_aux use MOM_grid, only : ocean_grid_type use MOM_io, only : slasher use MOM_opacity, only : set_opacity, opacity_CS, extract_optics_slice, extract_optics_fields -use MOM_opacity, only : absorbRemainingSW, optics_type, sumSWoverBands +use MOM_opacity, only : optics_type, optics_nbands, absorbRemainingSW, sumSWoverBands use MOM_tracer_flow_control, only : get_chl_from_model, tracer_flow_control_CS use MOM_unit_scaling, only : unit_scale_type use MOM_variables, only : thermo_var_ptrs, vertvisc_type! , accel_diag_ptrs @@ -838,7 +838,7 @@ end subroutine diagnoseMLDbyDensityDifference !> Update the thickness, temperature, and salinity due to thermodynamic !! boundary forcing (contained in fluxes type) applied to h, tv%T and tv%S, !! and calculate the TKE implications of this heating. -subroutine applyBoundaryFluxesInOut(CS, G, GV, US, dt, fluxes, optics, h, tv, & +subroutine applyBoundaryFluxesInOut(CS, G, GV, US, dt, fluxes, optics, nsw, h, tv, & aggregate_FW_forcing, evap_CFL_limit, & minimum_forcing_depth, cTKE, dSV_dT, dSV_dS, & SkinBuoyFlux ) @@ -849,6 +849,8 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, US, dt, fluxes, optics, h, tv, & real, intent(in) :: dt !< Time-step over which forcing is applied [s] type(forcing), intent(inout) :: fluxes !< Surface fluxes container type(optics_type), pointer :: optics !< Optical properties container + integer, intent(in) :: nsw !< The number of frequency bands of penetrating + !! shortwave radiation real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(inout) :: h !< Layer thickness [H ~> m or kg m-2] type(thermo_var_ptrs), intent(inout) :: tv !< Structure containing pointers to any @@ -903,10 +905,15 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, US, dt, fluxes, optics, h, tv, & pen_TKE_2d, & ! The TKE required to homogenize the heating by shortwave radiation within ! a layer [kg m-3 Z3 T-2 ~> J m-2] dSV_dT_2d ! The partial derivative of specific volume with temperature [m3 kg-1 degC-1] - real, dimension(SZI_(G),SZK_(G)+1) :: netPen - real, dimension(max(optics%nbands,1),SZI_(G)) :: Pen_SW_bnd, Pen_SW_bnd_rate - !^ _rate is w/ dt=1 - real, dimension(max(optics%nbands,1),SZI_(G),SZK_(G)) :: opacityBand + real, dimension(SZI_(G),SZK_(G)+1) :: netPen + real, dimension(max(nsw,1),SZI_(G)) :: & + Pen_SW_bnd, & ! The penetrative shortwave heating integrated over a timestep by band + ! [degC H ~> degC m or degC kg m-2] + Pen_SW_bnd_rate ! The penetrative shortwave heating rate by band + ! [degC H s-1 ~> degC m s-1 or degC kg m-2 s-1] + real, dimension(max(nsw,1),SZI_(G),SZK_(G)) :: & + opacityBand ! The opacity (inverse of the exponential absorption length) of each frequency + ! band of shortwave radation in each layer [H-1 ~> m-1 or m2 kg-1] real, dimension(maxGroundings) :: hGrounding real :: Temp_in, Salin_in ! real :: I_G_Earth @@ -916,7 +923,7 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, US, dt, fluxes, optics, h, tv, & ! [Z m3 s-2 kg-1 ~> m4 s-2 kg-1] logical :: calculate_energetics logical :: calculate_buoyancy - integer :: i, j, is, ie, js, je, k, nz, n, nsw + integer :: i, j, is, ie, js, je, k, nz, n integer :: start, npts character(len=45) :: mesg @@ -927,7 +934,6 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, US, dt, fluxes, optics, h, tv, & #define _OLD_ALG_ dt_in_T = dt * US%s_to_T - call extract_optics_fields(optics, nbands=nsw) Idt = 1.0/dt calculate_energetics = (present(cTKE) .and. present(dSV_dT) .and. present(dSV_dS)) @@ -1050,8 +1056,8 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, US, dt, fluxes, optics, h, tv, & H_limit_fluxes, CS%use_river_heat_content, CS%use_calving_heat_content, & h2d, T2d, netMassInOut, netMassOut, netHeat, netSalt, & Pen_SW_bnd, tv, aggregate_FW_forcing, nonpenSW=nonpenSW, & - net_Heat_rate=netheat_rate,net_salt_rate=netsalt_rate, & - netmassinout_rate=netmassinout_rate,pen_sw_bnd_rate=pen_sw_bnd_rate) + net_Heat_rate=netheat_rate, net_salt_rate=netsalt_rate, & + netmassinout_rate=netmassinout_rate, pen_sw_bnd_rate=pen_sw_bnd_rate) else call extractFluxes1d(G, GV, fluxes, optics, nsw, j, dt, & H_limit_fluxes, CS%use_river_heat_content, CS%use_calving_heat_content, & diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index f5fe2b4f1e..2d2ed63efb 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -53,7 +53,7 @@ module MOM_diabatic_driver use MOM_CVMix_KPP, only : KPP_end, KPP_get_BLD use MOM_CVMix_KPP, only : KPP_NonLocalTransport_temp, KPP_NonLocalTransport_saln use MOM_opacity, only : opacity_init, opacity_end, opacity_CS -use MOM_opacity, only : absorbRemainingSW, optics_type +use MOM_opacity, only : absorbRemainingSW, optics_type, optics_nbands use MOM_regularize_layers, only : regularize_layers, regularize_layers_init, regularize_layers_CS use MOM_set_diffusivity, only : set_diffusivity, set_BBL_TKE use MOM_set_diffusivity, only : set_diffusivity_init, set_diffusivity_end @@ -829,7 +829,7 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim skinbuoyflux(:,:) = 0.0 call applyBoundaryFluxesInOut(CS%diabatic_aux_CSp, G, GV, US, dt, fluxes, CS%optics, & - h, tv, CS%aggregate_FW_forcing, CS%evap_CFL_limit, & + optics_nbands(CS%optics), h, tv, CS%aggregate_FW_forcing, CS%evap_CFL_limit, & CS%minimum_forcing_depth, cTKE, dSV_dT, dSV_dS, SkinBuoyFlux=SkinBuoyFlux) if (CS%debug) then @@ -894,7 +894,7 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim else call applyBoundaryFluxesInOut(CS%diabatic_aux_CSp, G, GV, US, dt, fluxes, CS%optics, & - h, tv, CS%aggregate_FW_forcing, & + optics_nbands(CS%optics), h, tv, CS%aggregate_FW_forcing, & CS%evap_CFL_limit, CS%minimum_forcing_depth) endif ! endif for CS%use_energetic_PBL @@ -921,7 +921,7 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim ! ea and eb. We keep a record of the original h in hold. ! In the following, the checks for negative values are to guard against ! instances where entrainment drives a layer to negative thickness. - ! ### THIS CODE IS PROBABLY UNCNECESSARY? + ! ### This code is probably unnecessary, but will change answers? if (CS%use_legacy_diabatic) then !$OMP parallel do default(shared) do j=js,je @@ -1558,7 +1558,7 @@ subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, skinbuoyflux(:,:) = 0.0 call applyBoundaryFluxesInOut(CS%diabatic_aux_CSp, G, GV, US, dt, fluxes, CS%optics, & - h, tv, CS%aggregate_FW_forcing, CS%evap_CFL_limit, & + optics_nbands(CS%optics), h, tv, CS%aggregate_FW_forcing, CS%evap_CFL_limit, & CS%minimum_forcing_depth, cTKE, dSV_dT, dSV_dS, SkinBuoyFlux=SkinBuoyFlux) if (CS%debug) then @@ -1611,7 +1611,7 @@ subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, else call applyBoundaryFluxesInOut(CS%diabatic_aux_CSp, G, GV, US, dt, fluxes, CS%optics, & - h, tv, CS%aggregate_FW_forcing, & + optics_nbands(CS%optics), h, tv, CS%aggregate_FW_forcing, & CS%evap_CFL_limit, CS%minimum_forcing_depth) endif ! endif for CS%use_energetic_PBL From beaedaa1ffd9fba63f1f2e009d28271b4974cf5d Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sat, 6 Jul 2019 16:05:32 -0400 Subject: [PATCH 70/82] +Added FRACTIONAL_ROUGHNESS_MAX run-time parameter Added a copy of the FRACTIONAL_ROUGHNESS_MAX run-time parameter to the MOM_internal_tide_input module. All answers are bitwise identical in the MOM6-examples test cases. --- .../vertical/MOM_internal_tide_input.F90 | 29 ++++++++++++------- 1 file changed, 18 insertions(+), 11 deletions(-) diff --git a/src/parameterizations/vertical/MOM_internal_tide_input.F90 b/src/parameterizations/vertical/MOM_internal_tide_input.F90 index 2478a18f6f..5bc5a12dff 100644 --- a/src/parameterizations/vertical/MOM_internal_tide_input.F90 +++ b/src/parameterizations/vertical/MOM_internal_tide_input.F90 @@ -284,13 +284,15 @@ subroutine int_tide_input_init(Time, G, GV, US, param_file, diag, CS, itide) character(len=200) :: filename, tideamp_file, h2_file real :: mask_itidal + real :: max_frac_rough ! The fraction relating the maximum topographic roughness + ! to the mean depth [nondim] real :: utide ! constant tidal amplitude [m s-1] to be used if ! tidal amplitude file is not present. real :: kappa_h2_factor ! factor for the product of wavenumber * rms sgs height. real :: kappa_itides ! topographic wavenumber and non-dimensional scaling real :: min_zbot_itides ! Minimum ocean depth for internal tide conversion [Z ~> m]. - integer :: tlen_days !< Time interval from start for adding wave source - !! for testing internal tides (BDM) + integer :: tlen_days !< Time interval from start for adding wave source + !! for testing internal tides (BDM) integer :: i, j, is, ie, js, je, isd, ied, jsd, jed if (associated(CS)) then @@ -370,18 +372,23 @@ subroutine int_tide_input_init(Time, G, GV, US, param_file, diag, CS, itide) call log_param(param_file, mdl, "INPUTDIR/H2_FILE", filename) call MOM_read_data(filename, 'h2', itide%h2, G%domain, timelevel=1, scale=US%m_to_Z**2) + call get_param(param_file, mdl, "FRACTIONAL_ROUGHNESS_MAX", max_frac_rough, & + "The maximum topographic roughness amplitude as a fraction of the mean depth, "//& + "or a negative value for no limitations on roughness.", & + units="nondim", default=0.1) + ! The following parameters are used in testing the internal tide code. call get_param(param_file, mdl, "INTERNAL_TIDE_SOURCE_TEST", CS%int_tide_source_test, & - "If true, apply an arbitrary generation site for internal tide testing", & - default=.false.) + "If true, apply an arbitrary generation site for internal tide testing", & + default=.false.) if (CS%int_tide_source_test)then call get_param(param_file, mdl, "INTERNAL_TIDE_SOURCE_X", CS%int_tide_source_x, & - "X Location of generation site for internal tide", default=1.) + "X Location of generation site for internal tide", default=1.) call get_param(param_file, mdl, "INTERNAL_TIDE_SOURCE_Y", CS%int_tide_source_y, & - "Y Location of generation site for internal tide", default=1.) + "Y Location of generation site for internal tide", default=1.) call get_param(param_file, mdl, "INTERNAL_TIDE_SOURCE_TLEN_DAYS", tlen_days, & - "Time interval from start of experiment for adding wave source", & - units="days", default=0) + "Time interval from start of experiment for adding wave source", & + units="days", default=0) CS%time_max_source = Time + set_time(0, days=tlen_days) endif @@ -391,9 +398,9 @@ subroutine int_tide_input_init(Time, G, GV, US, param_file, diag, CS, itide) itide%tideamp(i,j) = itide%tideamp(i,j) * mask_itidal * G%mask2dT(i,j) - ! Restrict rms topo to 10 percent of column depth. - !### Note the use here of a hard-coded nondimensional constant. - itide%h2(i,j) = min(0.01*G%bathyT(i,j)**2, itide%h2(i,j)) + ! Restrict rms topo to a fraction (often 10 percent) of the column depth. + if (max_frac_rough >= 0.0) & + itide%h2(i,j) = min((max_frac_rough*G%bathyT(i,j))**2, itide%h2(i,j)) ! Compute the fixed part of internal tidal forcing; units are [J m-2] here. CS%TKE_itidal_coef(i,j) = 0.5*kappa_h2_factor*GV%Rho0*& From a42140deb78f172cbe725ea12f7af2c63dc41c42 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sat, 6 Jul 2019 16:15:52 -0400 Subject: [PATCH 71/82] +Added 3 new runtime parameters to MOM_opacity.F90 Added 3 new runtime parameters, OPTICS_2018_ANSWERS, PEN_SW_FLU_ABSORB and PEN_SW_ABSORB_MINTHICK, to the MOM_opacity module. Also added a new optics argument to absorbRemainingSW and added verticalGrid_type and unit_scale_type arguments to opacity_init. By default, all answers are bitwise identical, but there are non-optional changes to public interfaces and new runtime parameters are added to some MOM_parameter_doc files. --- .../vertical/MOM_bulk_mixed_layer.F90 | 4 +- .../vertical/MOM_diabatic_aux.F90 | 18 +- .../vertical/MOM_diabatic_driver.F90 | 13 +- .../vertical/MOM_opacity.F90 | 232 +++++++++++------- 4 files changed, 158 insertions(+), 109 deletions(-) diff --git a/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 b/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 index 9da5b5c6c7..d7102fc472 100644 --- a/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 +++ b/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 @@ -568,8 +568,8 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt_in_T, ea, eb, G, GV, cMKE, Idt_diag, nsw, Pen_SW_bnd, opacity_band, TKE, & Idecay_len_TKE, j, ksort, G, GV, US, CS) - call absorbRemainingSW(G, GV, US, h(:,1:), opacity_band, nsw, j, dt_in_T, CS%H_limit_fluxes, & - CS%correct_absorption, CS%absorb_all_SW, & + call absorbRemainingSW(G, GV, US, h(:,1:), opacity_band, nsw, optics, j, dt_in_T, & + CS%H_limit_fluxes, CS%correct_absorption, CS%absorb_all_SW, & T(:,1:), Pen_SW_bnd, eps, ksort, htot, Ttot) if (CS%TKE_diagnostics) then ; do i=is,ie diff --git a/src/parameterizations/vertical/MOM_diabatic_aux.F90 b/src/parameterizations/vertical/MOM_diabatic_aux.F90 index 8edfdb3e3f..3a41d4736e 100644 --- a/src/parameterizations/vertical/MOM_diabatic_aux.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_aux.F90 @@ -1202,14 +1202,14 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, US, dt, fluxes, optics, nsw, h, t if (h2d(i,k) > 0.) then if (calculate_energetics) then - ! Calculate the energy required to mix the newly added water over - ! the topmost grid cell, assuming that the fluxes of heat and salt - ! and rejected brine are initially applied in vanishingly thin - ! layers at the top of the layer before being mixed throughout - ! the layer. Note that dThickness is always <= 0. ###CHECK THE SIGNS!!! + ! Calculate the energy required to mix the newly added water over the topmost grid + ! cell, assuming that the fluxes of heat and salt and rejected brine are initially + ! applied in vanishingly thin layers at the top of the layer before being mixed + ! throughout the layer. Note that dThickness is always <= 0 here, and that + ! negative cTKE is a deficit that will need to be filled later. cTKE(i,j,k) = cTKE(i,j,k) - (0.5*h2d(i,k)*g_Hconv2) * & - ((dTemp - dthickness*T2d(i,k)) * dSV_dT(i,j,k) + & - (dSalt - dthickness*tv%S(i,j,k)) * dSV_dS(i,j,k)) + ((dTemp - dthickness*T2d(i,k)) * dSV_dT(i,j,k) + & + (dSalt - dthickness*tv%S(i,j,k)) * dSV_dS(i,j,k)) endif Ithickness = 1.0/h2d(i,k) ! Inverse of new thickness T2d(i,k) = (hOld*T2d(i,k) + dTemp)*Ithickness @@ -1273,14 +1273,14 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, US, dt, fluxes, optics, nsw, h, t endif if (calculate_energetics) then - call absorbRemainingSW(G, GV, US, h2d, opacityBand, nsw, j, dt_in_T, H_limit_fluxes, & + call absorbRemainingSW(G, GV, US, h2d, opacityBand, nsw, optics, j, dt_in_T, H_limit_fluxes, & .false., .true., T2d, Pen_SW_bnd, TKE=pen_TKE_2d, dSV_dT=dSV_dT_2d) k = 1 ! For setting break-points. do k=1,nz ; do i=is,ie cTKE(i,j,k) = cTKE(i,j,k) + pen_TKE_2d(i,k) enddo ; enddo else - call absorbRemainingSW(G, GV, US, h2d, opacityBand, nsw, j, dt_in_T, H_limit_fluxes, & + call absorbRemainingSW(G, GV, US, h2d, opacityBand, nsw, optics, j, dt_in_T, H_limit_fluxes, & .false., .true., T2d, Pen_SW_bnd) endif diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index 2d2ed63efb..d7930a040f 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -921,22 +921,23 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim ! ea and eb. We keep a record of the original h in hold. ! In the following, the checks for negative values are to guard against ! instances where entrainment drives a layer to negative thickness. - ! ### This code is probably unnecessary, but will change answers? + !### This code may be unnecessary, but the negative-thickness checks do appear to change + ! answers slightly in some cases. if (CS%use_legacy_diabatic) then !$OMP parallel do default(shared) do j=js,je do i=is,ie hold(i,j,1) = h(i,j,1) - h(i,j,1) = h(i,j,1) + (eb_s(i,j,1) - ea_s(i,j,2)) + ! Does nothing with ALE: h(i,j,1) = h(i,j,1) + (eb_s(i,j,1) - ea_s(i,j,2)) hold(i,j,nz) = h(i,j,nz) - h(i,j,nz) = h(i,j,nz) + (ea_s(i,j,nz) - eb_s(i,j,nz-1)) + ! Does nothing with ALE: h(i,j,nz) = h(i,j,nz) + (ea_s(i,j,nz) - eb_s(i,j,nz-1)) if (h(i,j,1) <= 0.0) h(i,j,1) = GV%Angstrom_H if (h(i,j,nz) <= 0.0) h(i,j,nz) = GV%Angstrom_H enddo do k=2,nz-1 ; do i=is,ie hold(i,j,k) = h(i,j,k) - h(i,j,k) = h(i,j,k) + ((ea_s(i,j,k) - eb_s(i,j,k-1)) + & - (eb_s(i,j,k) - ea_s(i,j,k+1))) + ! Does nothing with ALE: h(i,j,k) = h(i,j,k) + ((ea_s(i,j,k) - eb_s(i,j,k-1)) + & + ! (eb_s(i,j,k) - ea_s(i,j,k+1))) if (h(i,j,k) <= 0.0) h(i,j,k) = GV%Angstrom_H enddo ; enddo enddo @@ -3723,7 +3724,7 @@ subroutine diabatic_driver_init(Time, G, GV, US, param_file, useALEalgorithm, di call get_param(param_file, mdl, "PEN_SW_NBANDS", nbands, default=1) if (nbands > 0) then allocate(CS%optics) - call opacity_init(Time, G, param_file, diag, CS%opacity_CSp, CS%optics) + call opacity_init(Time, G, GV, US, param_file, diag, CS%opacity_CSp, CS%optics) endif endif diff --git a/src/parameterizations/vertical/MOM_opacity.F90 b/src/parameterizations/vertical/MOM_opacity.F90 index c771268d22..914ed0da05 100644 --- a/src/parameterizations/vertical/MOM_opacity.F90 +++ b/src/parameterizations/vertical/MOM_opacity.F90 @@ -21,23 +21,29 @@ module MOM_opacity public extract_optics_slice, extract_optics_fields, optics_nbands public absorbRemainingSW, sumSWoverBands -!> This type is used to exchange information about ocean optical properties +!> This type is used to store information about ocean optical properties type, public :: optics_type - ! ocean optical properties - - integer :: nbands !< The number of penetrating bands of SW radiation + integer :: nbands !< The number of penetrating bands of SW radiation real, pointer, dimension(:,:,:,:) :: opacity_band => NULL() !< SW optical depth per unit thickness [m-1] - !! The number of radiation bands is most rapidly varying (first) index. + !! The number of radiation bands is most rapidly varying (first) index. real, pointer, dimension(:,:,:) :: SW_pen_band => NULL() !< shortwave radiation [W m-2] at the surface - !! in each of the nbands bands that penetrates beyond the surface. - !! The most rapidly varying dimension is the band. + !! in each of the nbands bands that penetrates beyond the surface. + !! The most rapidly varying dimension is the band. real, pointer, dimension(:) :: & min_wavelength_band => NULL(), & !< The minimum wavelength in each band of penetrating shortwave radiation [nm] max_wavelength_band => NULL() !< The maximum wavelength in each band of penetrating shortwave radiation [nm] + real :: PenSW_flux_absorb !< A heat flux that is small enough to be completely absorbed in the next + !! sufficiently thick layer [H degC T-1 ~> degC m s-1 or degC kg m-2 s-1]. + real :: PenSW_absorb_Invlen !< The inverse of the thickness that is used to absorb the remaining + !! shortwave heat flux when it drops below PEN_SW_FLUX_ABSORB [H ~> m or kg m-2]. + logical :: answers_2018 !< If true, use the order of arithmetic and expressions that recover the + !! answers from the end of 2018. Otherwise, use updated and more robust + !! forms of the same expressions. + end type optics_type !> The control structure with paramters for the MOM_opacity module @@ -79,7 +85,8 @@ module MOM_opacity contains !> This sets the opacity of sea water based based on one of several different schemes. -subroutine set_opacity(optics, sw_total, sw_vis_dir, sw_vis_dif, sw_nir_dir, sw_nir_dif, G, GV, CS, chl_2d, chl_3d) +subroutine set_opacity(optics, sw_total, sw_vis_dir, sw_vis_dif, sw_nir_dir, sw_nir_dif, & + G, GV, CS, chl_2d, chl_3d) type(optics_type), intent(inout) :: optics !< An optics structure that has values !! set based on the opacities. real, dimension(:,:), pointer :: sw_total !< Total shortwave flux into the ocean [W m-2] @@ -96,7 +103,7 @@ subroutine set_opacity(optics, sw_total, sw_vis_dir, sw_vis_dif, sw_nir_dir, sw_ real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & optional, intent(in) :: chl_3d !< The chlorophyll-A concentractions of each layer [mg m-3] -! local variables + ! Local variables integer :: i, j, k, n, is, ie, js, je, nz real :: inv_sw_pen_scale ! The inverse of the e-folding scale [m-1]. real :: Inv_nbands ! The inverse of the number of bands of penetrating @@ -203,7 +210,8 @@ end subroutine set_opacity !> This sets the "blue" band opacity based on chloophyll A concencentrations !! The red portion is lumped into the net heating at the surface. -subroutine opacity_from_chl(optics, sw_total, sw_vis_dir, sw_vis_dif, sw_nir_dir, sw_nir_dif, G, GV, CS, chl_2d, chl_3d) +subroutine opacity_from_chl(optics, sw_total, sw_vis_dir, sw_vis_dif, sw_nir_dir, sw_nir_dif, & + G, GV, CS, chl_2d, chl_3d) type(optics_type), intent(inout) :: optics !< An optics structure that has values !! set based on the opacities. real, dimension(:,:), pointer :: sw_total !< Total shortwave flux into the ocean [W m-2] @@ -216,7 +224,7 @@ subroutine opacity_from_chl(optics, sw_total, sw_vis_dir, sw_vis_dif, sw_nir_dir type(opacity_CS), pointer :: CS !< The control structure. real, dimension(SZI_(G),SZJ_(G)), & optional, intent(in) :: chl_2d !< Vertically uniform chlorophyll-A concentractions [mg m-3] - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & optional, intent(in) :: chl_3d !< A 3-d field of chlorophyll-A concentractions [mg m-3] real :: chl_data(SZI_(G),SZJ_(G)) ! The chlorophyll A concentrations in a layer [mg m-3]. @@ -246,7 +254,7 @@ subroutine opacity_from_chl(optics, sw_total, sw_vis_dir, sw_vis_dif, sw_nir_dir ! matter content (case-i waters).,J. Geo. Res., {93}, 10,749--10,768, 1988. ! ! Manizza, M., C.~L. Quere, A.~Watson, and E.~T. Buitenhuis, Bio-optical -! feedbacks amoung phytoplankton, upper ocean physics and sea-ice in a +! feedbacks among phytoplankton, upper ocean physics and sea-ice in a ! global model, Geophys. Res. Let., , L05,603, 2005. nbands = optics%nbands @@ -335,8 +343,7 @@ subroutine opacity_from_chl(optics, sw_total, sw_vis_dir, sw_vis_dif, sw_nir_dir call MOM_error(FATAL, "opacity_from_chl: CS%opacity_scheme is not valid.") end select -!$OMP parallel do default(none) shared(nz,is,ie,js,je,CS,G,chl_3d,optics,nbands) & -!$OMP firstprivate(chl_data) + !$OMP parallel do default(shared) firstprivate(chl_data) do k=1,nz if (present(chl_3d)) then do j=js,je ; do i=is,ie ; chl_data(i,j) = chl_3d(i,j,k) ; enddo ; enddo @@ -381,13 +388,13 @@ end subroutine opacity_from_chl !! Morel and Antoine (1994). function opacity_morel(chl_data) real, intent(in) :: chl_data !< The chlorophyll-A concentration in mg m-3. - real :: opacity_morel -! Argument : chl_data - The chlorophyll-A concentration in mg m-3. -! The following are coefficients for the optical model taken from Morel and -! Antoine (1994). These coeficients represent a non uniform distribution of -! chlorophyll-a through the water column. Other approaches may be more -! appropriate when using an interactive ecosystem model that predicts -! three-dimensional chl-a values. + real :: opacity_morel !< The returned opacity [m-1] + + ! The following are coefficients for the optical model taken from Morel and + ! Antoine (1994). These coeficients represent a non uniform distribution of + ! chlorophyll-a through the water column. Other approaches may be more + ! appropriate when using an interactive ecosystem model that predicts + ! three-dimensional chl-a values. real, dimension(6), parameter :: & Z2_coef=(/7.925, -6.644, 3.662, -1.815, -0.218, 0.502/) real :: Chl, Chl2 ! The log10 of chl_data (in mg m-3), and Chl^2. @@ -401,13 +408,13 @@ function opacity_morel(chl_data) !! Morel and Antoine (1994). function SW_pen_frac_morel(chl_data) real, intent(in) :: chl_data !< The chlorophyll-A concentration in mg m-3. - real :: SW_pen_frac_morel -! Argument : chl_data - The chlorophyll-A concentration in mg m-3. -! The following are coefficients for the optical model taken from Morel and -! Antoine (1994). These coeficients represent a non uniform distribution of -! chlorophyll-a through the water column. Other approaches may be more -! appropriate when using an interactive ecosystem model that predicts -! three-dimensional chl-a values. + real :: SW_pen_frac_morel !< The returned penetrating shortwave fraction [nondim] + + ! The following are coefficients for the optical model taken from Morel and + ! Antoine (1994). These coeficients represent a non uniform distribution of + ! chlorophyll-a through the water column. Other approaches may be more + ! appropriate when using an interactive ecosystem model that predicts + ! three-dimensional chl-a values. real :: Chl, Chl2 ! The log10 of chl_data in mg m-3, and Chl^2. real, dimension(6), parameter :: & V1_coef=(/0.321, 0.008, 0.132, 0.038, -0.017, -0.007/) @@ -421,10 +428,8 @@ end function SW_pen_frac_morel !! Manizza, M. et al, 2005. function opacity_manizza(chl_data) real, intent(in) :: chl_data !< The chlorophyll-A concentration in mg m-3. - real :: opacity_manizza -! Argument : chl_data - The chlorophyll-A concentration in mg m-3. -! This sets the blue-wavelength opacity according to the scheme proposed by -! Manizza, M. et al, 2005. + real :: opacity_manizza !< The returned opacity [m-1] +! This sets the blue-wavelength opacity according to the scheme proposed by Manizza, M. et al, 2005. opacity_manizza = 0.0232 + 0.074*chl_data**0.674 end function @@ -432,17 +437,18 @@ function opacity_manizza(chl_data) !> This subroutine returns a 2-d slice at constant j of fields from an optics_type, with the potential !! for rescaling these fields. subroutine extract_optics_slice(optics, j, G, GV, opacity, opacity_scale, penSW_top, penSW_scale) - type(optics_type), intent(in) :: optics !< An optics structure that has values of opacities - !! and shortwave fluxes. + type(optics_type), intent(in) :: optics !< An optics structure that has values of opacities + !! and shortwave fluxes. integer, intent(in) :: j !< j-index to extract type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. - real, dimension(max(optics%nbands,1),SZI_(G),SZK_(G)), & + real, dimension(max(optics%nbands,1),SZI_(G),SZK_(GV)), & optional, intent(out) :: opacity !< The opacity in each band, i-point, and layer real, optional, intent(in) :: opacity_scale !< A factor by which to rescale the opacity. real, dimension(max(optics%nbands,1),SZI_(G)), & optional, intent(out) :: penSW_top !< The shortwave radiation [W m-2] at the surface - !! in each of the nbands bands that penetrates beyond the surface. + !! in each of the nbands bands that penetrates + !! beyond the surface skin layer. real, optional, intent(in) :: penSW_scale !< A factor by which to rescale the shortwave flux. ! Local variables @@ -493,22 +499,24 @@ end function optics_nbands !! water column thickness is greater than H_limit_fluxes. !! For thinner water columns, the heating is scaled down proportionately, the assumption being that the !! remaining heating (which is left in Pen_SW) should go into an (absent for now) ocean bottom sediment layer. -subroutine absorbRemainingSW(G, GV, US, h, opacity_band, nsw, j, dt, H_limit_fluxes, & +subroutine absorbRemainingSW(G, GV, US, h, opacity_band, nsw, optics, j, dt, H_limit_fluxes, & adjustAbsorptionProfile, absorbAllSW, T, Pen_SW_bnd, & eps, ksort, htot, Ttot, TKE, dSV_dT) - type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. - type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. - type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - real, dimension(SZI_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]. - real, dimension(:,:,:), intent(in) :: opacity_band !< Opacity in each band of penetrating + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + integer, intent(in) :: nsw !< Number of bands of penetrating + !! shortwave radiation. + real, dimension(SZI_(G),SZK_(GV)), intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]. + real, dimension(max(1,nsw),SZI_(G),SZK_(GV)), intent(in) :: opacity_band !< Opacity in each band of penetrating !! shortwave radiation [H-1 ~> m-1 or m2 kg-1]. !! The indicies are band, i, k. - integer, intent(in) :: nsw !< Number of bands of penetrating - !! shortwave radiation. - integer, intent(in) :: j !< j-index to work on. - real, intent(in) :: dt !< Time step [T ~> s]. - real, intent(in) :: H_limit_fluxes !< If the total ocean depth is + type(optics_type), intent(in) :: optics !< An optics structure that has values of + !! opacities and shortwave fluxes. + integer, intent(in) :: j !< j-index to work on. + real, intent(in) :: dt !< Time step [T ~> s]. + real, intent(in) :: H_limit_fluxes !< If the total ocean depth is !! less than this, they are scaled away !! to avoid numerical instabilities !! [H ~> m or kg m-2]. This would @@ -526,26 +534,27 @@ subroutine absorbRemainingSW(G, GV, US, h, opacity_band, nsw, j, dt, H_limit_flu !! potential energy change) of the !! shortwave that should be absorbed by !! each layer. - real, dimension(SZI_(G),SZK_(G)), intent(inout) :: T !< Layer potential/conservative + real, dimension(SZI_(G),SZK_(GV)), intent(inout) :: T !< Layer potential/conservative !! temperatures [degC] - real, dimension(:,:), intent(inout) :: Pen_SW_bnd !< Penetrating shortwave heating in + real, dimension(max(1,nsw),SZI_(G)), intent(inout) :: Pen_SW_bnd !< Penetrating shortwave heating in !! each band that hits the bottom and will !! will be redistributed through the water !! column [degC H ~> degC m or degC kg m-2], !! size nsw x SZI_(G). - real, dimension(SZI_(G),SZK_(G)), optional, intent(in) :: eps !< Small thickness that must remain in + real, dimension(SZI_(G),SZK_(GV)), optional, intent(in) :: eps !< Small thickness that must remain in !! each layer, and which will not be !! subject to heating [H ~> m or kg m-2] - integer, dimension(SZI_(G),SZK_(G)), optional, intent(in) :: ksort !< Density-sorted k-indicies. + integer, dimension(SZI_(G),SZK_(GV)), optional, intent(in) :: ksort !< Density-sorted k-indicies. real, dimension(SZI_(G)), optional, intent(in) :: htot !< Total mixed layer thickness [H ~> m or kg m-2]. real, dimension(SZI_(G)), optional, intent(inout) :: Ttot !< Depth integrated mixed layer !! temperature [degC H ~> degC m or degC kg m-2] - real, dimension(SZI_(G),SZK_(G)), optional, intent(in) :: dSV_dT !< The partial derivative of specific + real, dimension(SZI_(G),SZK_(GV)), optional, intent(in) :: dSV_dT !< The partial derivative of specific !! volume with temperature [m3 kg-1 degC-1]. - real, dimension(SZI_(G),SZK_(G)), optional, intent(inout) :: TKE !< The TKE sink from mixing the heating + real, dimension(SZI_(G),SZK_(GV)), optional, intent(inout) :: TKE !< The TKE sink from mixing the heating !! throughout a layer [kg m-3 Z3 T-2 ~> J m-2]. + ! Local variables - real, dimension(SZI_(G),SZK_(G)) :: & + real, dimension(SZI_(G),SZK_(GV)) :: & T_chg_above ! A temperature change that will be applied to all the thick ! layers above a given layer [degC]. This is only nonzero if ! adjustAbsorptionProfile is true, in which case the net @@ -576,10 +585,10 @@ subroutine absorbRemainingSW(G, GV, US, h, opacity_band, nsw, j, dt, H_limit_flu real :: SWa ! fraction of the absorbed shortwave that is ! moved to layers above with adjustAbsorptionProfile [nondim] real :: coSWa_frac ! The fraction of SWa that is actually moved upward. - real :: min_SW_heating ! A minimum remaining shortwave heating rate that will be simply + real :: min_SW_heat ! A minimum remaining shortwave heating within a timestep that will be simply ! absorbed in the next layer for computational efficiency, instead of - ! continuing to penetrate [degC H T-1 ~> degC m s-1 or degC kg m-2 s-1]. - ! The default, 2.5e-11, is about 0.08 degC m / century. + ! continuing to penetrate [degC H ~> degC m or degC kg m-2]. + real :: I_Habs ! The inverse of the absorption length for a minimal flux [H-1 ~> m-1 or m2 kg-1] real :: epsilon ! A small thickness that must remain in each ! layer, and which will not be subject to heating [H ~> m or kg m-2] real :: g_Hconv2 ! A conversion factor for use in the TKE calculation @@ -592,16 +601,20 @@ subroutine absorbRemainingSW(G, GV, US, h, opacity_band, nsw, j, dt, H_limit_flu integer :: is, ie, nz, i, k, ks, n SW_Remains = .false. - min_SW_heating = 2.5e-11*US%T_to_s !### This needs *GV%m_to_H for dimensional consistency? + min_SW_heat = optics%PenSW_flux_absorb * dt + I_Habs = optics%PenSW_absorb_Invlen h_min_heat = 2.0*GV%Angstrom_H + GV%H_subroundoff is = G%isc ; ie = G%iec ; nz = G%ke C1_6 = 1.0 / 6.0 ; C1_60 = 1.0 / 60.0 TKE_calc = (present(TKE) .and. present(dSV_dT)) - ! g_Hconv2 = (US%m_to_Z**3 * US%T_to_s**2) * GV%H_to_Pa * GV%H_to_kg_m2 - g_Hconv2 = (US%m_to_Z**4 * US%T_to_s**2 * GV%g_Earth * GV%H_to_kg_m2) * GV%H_to_kg_m2 - ! g_Hconv2 = US%m_to_Z**4 * US%T_to_s**2 * GV%g_Earth * GV%H_to_kg_m2**2 + + if (optics%answers_2018) then + g_Hconv2 = (US%m_to_Z**4 * US%T_to_s**2 * GV%g_Earth * GV%H_to_kg_m2) * GV%H_to_kg_m2 + else + g_Hconv2 = US%m_to_Z**4 * US%T_to_s**2 * GV%g_Earth * GV%H_to_kg_m2**2 + endif h_heat(:) = 0.0 if (present(htot)) then ; do i=is,ie ; h_heat(i) = htot(i) ; enddo ; endif @@ -625,12 +638,17 @@ subroutine absorbRemainingSW(G, GV, US, h, opacity_band, nsw, j, dt, H_limit_flu exp_OD = exp(-opt_depth) SW_trans = exp_OD - ! Heating at a rate of less than 10-4 W m-2 = 10-3 K m / Century, - ! and of the layer in question less than 1 K / Century, can be - ! absorbed without further penetration. - ! ###Make these numbers into parameters! - if (nsw*Pen_SW_bnd(n,i)*SW_trans < & - dt*min_SW_heating*min(1.0*GV%m_to_H, 1e3*h(i,k)) ) SW_trans = 0.0 + ! Heating at a very small rate can be absorbed by a sufficiently thick layer or several + ! thin layers without further penetration. + if (optics%answers_2018) then + if (nsw*Pen_SW_bnd(n,i)*SW_trans < min_SW_heat*min(1.0, I_Habs*h(i,k)) ) SW_trans = 0.0 + elseif ((nsw*Pen_SW_bnd(n,i)*SW_trans < min_SW_heat) .and. (h(i,k) > h_min_heat)) then + if (nsw*Pen_SW_bnd(n,i) <= min_SW_heat * (I_Habs*(h(i,k) - h_min_heat))) then + SW_trans = 0.0 + else + SW_trans = 1.0 - (min_SW_heat*(I_Habs*(h(i,k) - h_min_heat))) / (nsw*Pen_SW_bnd(n,i)) + endif + endif Heat_bnd = Pen_SW_bnd(n,i) * (1.0 - SW_trans) if (adjustAbsorptionProfile .and. (h_heat(i) > 0.0)) then @@ -749,15 +767,15 @@ subroutine absorbRemainingSW(G, GV, US, h, opacity_band, nsw, j, dt, H_limit_flu end subroutine absorbRemainingSW -subroutine sumSWoverBands(G, GV, US, h, optics, j, dt, & - H_limit_fluxes, absorbAllSW, iPen_SW_bnd, netPen) -!< This subroutine calculates the total shortwave heat flux integrated over +!> This subroutine calculates the total shortwave heat flux integrated over !! bands as a function of depth. This routine is only called for computing !! buoyancy fluxes for use in KPP. This routine does not updat e the state. +subroutine sumSWoverBands(G, GV, US, h, optics, j, dt, & + H_limit_fluxes, absorbAllSW, iPen_SW_bnd, netPen) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - real, dimension(SZI_(G),SZK_(G)), & + real, dimension(SZI_(G),SZK_(GV)), & intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]. type(optics_type), intent(in) :: optics !< An optics structure that has values !! set based on the opacities. @@ -772,7 +790,7 @@ subroutine sumSWoverBands(G, GV, US, h, optics, j, dt, & !! heating in each band that hits the bottom and !! will be redistributed through the water column !! [degC H ~> degC m or degC kg m-2]; size nsw x SZI_(G). - real, dimension(SZI_(G),SZK_(G)+1), & + real, dimension(SZI_(G),SZK_(GV)+1), & intent(inout) :: netPen !< Net penetrating shortwave heat flux at each !! interface, summed across all bands !! [degC H ~> degC m or degC kg m-2]. @@ -791,6 +809,10 @@ subroutine sumSWoverBands(G, GV, US, h, optics, j, dt, & ! not absorbed because the layers are too thin. real :: Ih_limit ! inverse of the total depth at which the ! surface fluxes start to be limited [H-1 ~> m-1 or m2 kg-1] + real :: min_SW_heat ! A minimum remaining shortwave heating within a timestep that will be simply + ! absorbed in the next layer for computational efficiency, instead of + ! continuing to penetrate [degC H ~> degC m or degC kg m-2]. + real :: I_Habs ! The inverse of the absorption length for a minimal flux [H-1 ~> m-1 or m2 kg-1] real :: h_min_heat ! minimum thickness layer that should get heated [H ~> m or kg m-2] real :: opt_depth ! optical depth of a layer [nondim] real :: exp_OD ! exp(-opt_depth) [nondim] @@ -800,6 +822,9 @@ subroutine sumSWoverBands(G, GV, US, h, optics, j, dt, & integer :: is, ie, nz, i, k, ks, n, nsw SW_Remains = .false. + min_SW_heat = optics%PenSW_flux_absorb*dt ! Default of 2.5e-11*US%T_to_s*GV%m_to_H + I_Habs = 1e3*GV%H_to_m ! optics%PenSW_absorb_Invlen + h_min_heat = 2.0*GV%Angstrom_H + GV%H_subroundoff is = G%isc ; ie = G%iec ; nz = G%ke ; nsw = optics%nbands @@ -821,12 +846,17 @@ subroutine sumSWoverBands(G, GV, US, h, optics, j, dt, & exp_OD = exp(-opt_depth) SW_trans = exp_OD - ! Heating at a rate of less than 10-4 W m-2 = 10-3 K m / Century, - ! and of the layer in question less than 1 K / Century, can be - ! absorbed without further penetration. - if ((nsw*Pen_SW_bnd(n,i)*SW_trans < GV%m_to_H*2.5e-11*US%T_to_s*dt) .and. & - (nsw*Pen_SW_bnd(n,i)*SW_trans < h(i,k)*dt*US%T_to_s*2.5e-8)) & - SW_trans = 0.0 + ! Heating at a very small rate can be absorbed by a sufficiently thick layer or several + ! thin layers without further penetration. + if (optics%answers_2018) then + if (nsw*Pen_SW_bnd(n,i)*SW_trans < min_SW_heat*min(1.0, I_Habs*h(i,k)) ) SW_trans = 0.0 + elseif ((nsw*Pen_SW_bnd(n,i)*SW_trans < min_SW_heat) .and. (h(i,k) > h_min_heat)) then + if (nsw*Pen_SW_bnd(n,i) <= min_SW_heat * (I_Habs*(h(i,k) - h_min_heat))) then + SW_trans = 0.0 + else + SW_trans = 1.0 - (min_SW_heat*(I_Habs*(h(i,k) - h_min_heat))) / (nsw*Pen_SW_bnd(n,i)) + endif + endif Pen_SW_bnd(n,i) = Pen_SW_bnd(n,i) * SW_trans netPen(i,k+1) = netPen(i,k+1) + Pen_SW_bnd(n,i) @@ -870,10 +900,12 @@ end subroutine sumSWoverBands - -subroutine opacity_init(Time, G, param_file, diag, CS, optics) +!> This routine initalizes the opacity module, including an optics_type. +subroutine opacity_init(Time, G, GV, US, param_file, diag, CS, optics) type(time_type), target, intent(in) :: Time !< The current model time. type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. + type(verticalGrid_type), intent(in) :: GV !< model vertical grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time !! parameters. type(diag_ctrl), target, intent(inout) :: diag !< A structure that is used to regulate diagnostic @@ -882,21 +914,17 @@ subroutine opacity_init(Time, G, param_file, diag, CS, optics) !! structure for this module. type(optics_type), pointer :: optics !< An optics structure that has parameters !! set and arrays allocated here. -! Arguments: Time - The current model time. -! (in) G - The ocean's grid structure. -! (in) param_file - A structure indicating the open file to parse for -! model parameter values. -! (in) diag - A structure that is used to regulate diagnostic output. -! -! (in/out) CS - A pointer that is set to point to the control structure -! for this module -! This include declares and sets the variable "version". -#include "version_variable.h" + ! Local variables character(len=200) :: tmpstr character(len=40) :: mdl = "MOM_opacity" character(len=40) :: bandnum, shortname character(len=200) :: longname character(len=40) :: scheme_string + ! This include declares and sets the variable "version". +# include "version_variable.h" + real :: PenSW_absorb_minthick ! A thickness that is used to absorb the remaining shortwave heat + ! flux when that flux drops below PEN_SW_FLUX_ABSORB [m]. + real :: PenSW_minthick_dflt ! The default for PenSW_absorb_minthick [m] logical :: use_scheme integer :: isd, ied, jsd, jed, nz, n isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed ; nz = G%ke @@ -1005,6 +1033,26 @@ subroutine opacity_init(Time, G, param_file, diag, CS, optics) "Cannot use a single_exp opacity scheme with nbands!=1.") endif endif + + call get_param(param_file, mdl, "OPTICS_2018_ANSWERS", optics%answers_2018, & + "If true, use the order of arithmetic and expressions that recover the "//& + "answers from the end of 2018. Otherwise, use updated expressions for "//& + "handling the absorpption of small remaining shortwave fluxes.", default=.true.) + + call get_param(param_file, mdl, "PEN_SW_FLUX_ABSORB", optics%PenSW_flux_absorb, & + "A minimum remaining shortwave heating rate that will be simply absorbed in "//& + "the next sufficiently thick layers for computational efficiency, instead of "//& + "continuing to penetrate. The default, 2.5e-11 degC m s-1, is about 1e-4 W m-2 "//& + "or 0.08 degC m century-1, but 0 is also a valid value.", & + default=2.5e-11, units="degC m s-1", scale=GV%m_to_H*US%T_to_s) + + if (optics%answers_2018) then ; PenSW_minthick_dflt = 0.001 ; else ; PenSW_minthick_dflt = 1.0 ; endif + call get_param(param_file, mdl, "PEN_SW_ABSORB_MINTHICK", PenSW_absorb_minthick, & + "A thickness that is used to absorb the remaining penetrating shortwave heat "//& + "flux when it drops below PEN_SW_FLUX_ABSORB.", & + default=PenSW_minthick_dflt, units="m", scale=GV%m_to_H) + optics%PenSW_absorb_Invlen = 1.0 / (PenSW_absorb_minthick + GV%H_subroundoff) + if (.not.associated(optics%min_wavelength_band)) & allocate(optics%min_wavelength_band(optics%nbands)) if (.not.associated(optics%max_wavelength_band)) & @@ -1073,11 +1121,11 @@ end subroutine opacity_end !! portion is lumped into the net heating at the surface. !! !! Morel, A., 1988: Optical modeling of the upper ocean in relation -!! to itsbiogenous matter content (case-i waters)., J. Geo. Res., +!! to its biogenous matter content (case-i waters)., J. Geo. Res., !! 93, 10,749-10,768. !! !! Manizza, M., C. LeQuere, A. J. Watson, and E. T. Buitenhuis, 2005: -!! Bio-optical feedbacks amoung phytoplankton, upper ocean physics +!! Bio-optical feedbacks among phytoplankton, upper ocean physics !! and sea-ice in a global model, Geophys. Res. Let., 32, L05603, !! doi:10.1029/2004GL020778. From 908cff636a26a7f99ecfce928c6ce9e8baf77381 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sat, 6 Jul 2019 17:57:53 -0400 Subject: [PATCH 72/82] +(*)Corrected documentation of BBL_MIXING_MAX_DECAY Revised the get_param message for BBL_MIXING_MAX_DECAY to be consistent with how the code actually works, and changed the code to handle 0 values as documented. Also altered the default value to 200 m so that the answers will reproduce the previous solutions, unless BBL_MIXING_MAX_DECAY was explicitly being set to 0 or a negative value, in which case the revised code will match the intended behavior as documented. All answers are bitwise identical in the existing MOM6-examples, but some MOM_parameter_doc files change and some solutions could change, in which case setting BBL_MIXING_MAX_DECAY=200 will reproduce the previous solutions. --- .../vertical/MOM_set_diffusivity.F90 | 11 +++++------ 1 file changed, 5 insertions(+), 6 deletions(-) diff --git a/src/parameterizations/vertical/MOM_set_diffusivity.F90 b/src/parameterizations/vertical/MOM_set_diffusivity.F90 index 1c827ef8f0..66f4f75ff0 100644 --- a/src/parameterizations/vertical/MOM_set_diffusivity.F90 +++ b/src/parameterizations/vertical/MOM_set_diffusivity.F90 @@ -2010,13 +2010,12 @@ subroutine set_diffusivity_init(Time, G, GV, US, param_file, diag, CS, int_tide_ "bottom drag drives BBL diffusion. This is only "//& "used if BOTTOMDRAGLAW is true.", units="nondim", default=0.20) call get_param(param_file, mdl, "BBL_MIXING_MAX_DECAY", decay_length, & - "The maximum decay scale for the BBL diffusion, or 0 "//& - "to allow the mixing to penetrate as far as "//& - "stratification and rotation permit. The default is 0. "//& - "This is only used if BOTTOMDRAGLAW is true.", & - units="m", default=0.0, scale=US%m_to_Z) + "The maximum decay scale for the BBL diffusion, or 0 to allow the mixing "//& + "to penetrate as far as stratification and rotation permit. The default "//& + "for now is 200 m. This is only used if BOTTOMDRAGLAW is true.", & + units="m", default=200.0, scale=US%m_to_Z) - CS%IMax_decay = 1.0 / (200.0*US%m_to_Z) !### This is inconsistent with the description above. + CS%IMax_decay = 0.0 if (decay_length > 0.0) CS%IMax_decay = 1.0/decay_length call get_param(param_file, mdl, "BBL_MIXING_AS_MAX", CS%BBL_mixing_as_max, & "If true, take the maximum of the diffusivity from the "//& From a0d669dd309b138033f2ea62cd12e039790f744a Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sat, 6 Jul 2019 22:12:26 -0400 Subject: [PATCH 73/82] (*)Multiply fmax by US%s_to_T in MOM_hor_visc.F90 Added a dimensional scaling factor that was dropped when changes from dev/gfdl were automatically merged into the new branch. All answers are bitwise identical and now pass the dimensional scaling test. --- src/parameterizations/lateral/MOM_hor_visc.F90 | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/src/parameterizations/lateral/MOM_hor_visc.F90 b/src/parameterizations/lateral/MOM_hor_visc.F90 index 919ad02820..efba8e8e8d 100644 --- a/src/parameterizations/lateral/MOM_hor_visc.F90 +++ b/src/parameterizations/lateral/MOM_hor_visc.F90 @@ -270,7 +270,8 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, grad_vort_mag_q_2d, & ! Magnitude of 2d vorticity gradient at q-points [m-1 s-1] grad_div_mag_q, & ! Magnitude of divergence gradient at q-points [m-1 s-1] grad_vel_mag_q, & ! Magnitude of the velocity gradient tensor squared at q-points [s-2] - hq, & ! harmonic mean of the harmonic means of the u- & v point thicknesses, in H; This form guarantees that hq/hu < 4. + hq, & ! harmonic mean of the harmonic means of the u- & v point thicknesses [H ~> m or kg m-2] + ! This form guarantees that hq/hu < 4. grad_vel_mag_bt_q ! Magnitude of the barotropic velocity gradient tensor squared at q-points [s-2] real, dimension(SZIB_(G),SZJB_(G),SZK_(G)) :: & @@ -1900,8 +1901,8 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS) if (CS%Smagorinsky_Ah) then CS%Biharm_const_xx(i,j) = Smag_bi_const * (grid_sp_h2 * grid_sp_h2) if (CS%bound_Coriolis) then - fmax = MAX(abs(G%CoriolisBu(I-1,J-1)), abs(G%CoriolisBu(I,J-1)), & - abs(G%CoriolisBu(I-1,J)), abs(G%CoriolisBu(I,J))) + fmax = US%s_to_T*MAX(abs(G%CoriolisBu(I-1,J-1)), abs(G%CoriolisBu(I,J-1)), & + abs(G%CoriolisBu(I-1,J)), abs(G%CoriolisBu(I,J))) CS%Biharm_const2_xx(i,j) = (grid_sp_h2 * grid_sp_h2 * grid_sp_h2) * & (fmax * BoundCorConst) endif From cbd6f9939b298fbc8a91980bfd9639eb4de30cd8 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sat, 6 Jul 2019 22:14:58 -0400 Subject: [PATCH 74/82] Split excessively long lines in 2 files Split excessively long lines and corrected the syntax for unit documentation in MOM_lateral_mixing_coeffs.F90 and MOM_thickness_diffuse.F90. All answers are bitwise identical. --- .../lateral/MOM_lateral_mixing_coeffs.F90 | 71 +++++++++++-------- .../lateral/MOM_thickness_diffuse.F90 | 28 ++++---- 2 files changed, 55 insertions(+), 44 deletions(-) diff --git a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 index a281148b8c..0df5ca75d0 100644 --- a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 +++ b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 @@ -175,7 +175,8 @@ subroutine calc_resoln_function(h, tv, G, GV, US, CS) call wave_speed(h, tv, G, GV, US, CS%cg1, CS%wave_speed_CSp, modal_structure=CS%ebt_struct) else ! Use EBT to get vertical structure first and then re-calculate cg1 using first baroclinic mode - call wave_speed(h, tv, G, GV, US, CS%cg1, CS%wave_speed_CSp, modal_structure=CS%ebt_struct, use_ebt_mode=.true.) + call wave_speed(h, tv, G, GV, US, CS%cg1, CS%wave_speed_CSp, modal_structure=CS%ebt_struct, & + use_ebt_mode=.true.) call wave_speed(h, tv, G, GV, US, CS%cg1, CS%wave_speed_CSp) endif call pass_var(CS%ebt_struct, G%Domain) @@ -704,43 +705,51 @@ end subroutine calc_slope_functions_using_just_e !> Calculates the Leith Laplacian and bi-harmonic viscosity coefficients subroutine calc_QG_Leith_viscosity(CS, G, GV, h, k, div_xx_dx, div_xx_dy, vort_xy_dx, vort_xy_dy) type(VarMix_CS), pointer :: CS !< Variable mixing coefficients - type(ocean_grid_type), intent(in) :: G !< Ocean grid structure + type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. -! real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: u !< Zonal flow (m s-1) -! real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: v !< Meridional flow (m s-1) - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: h !< Layer thickness (m or kg m-2) - integer, intent(in) :: k !< Layer for which to calculate vorticity magnitude - real, dimension(SZIB_(G),SZJ_(G)), intent(in) :: div_xx_dx !< x-derivative of horizontal divergence (d/dx(du/dx + dv/dy)) (m-1 s-1) - real, dimension(SZI_(G),SZJB_(G)), intent(in) :: div_xx_dy !< y-derivative of horizontal divergence (d/dy(du/dx + dv/dy)) (m-1 s-1) - real, dimension(SZI_(G),SZJB_(G)), intent(inout) :: vort_xy_dx !< x-derivative of vertical vorticity (d/dx(dv/dx - du/dy)) (m-1 s-1) - real, dimension(SZIB_(G),SZJ_(G)), intent(inout) :: vort_xy_dy !< y-derivative of vertical vorticity (d/dy(dv/dx - du/dy)) (m-1 s-1) -! real, dimension(SZI_(G),SZJ_(G)), intent(out) :: Leith_Kh_h !< Leith Laplacian viscosity at h-points (m2 s-1) -! real, dimension(SZIB_(G),SZJB_(G)), intent(out) :: Leith_Kh_q !< Leith Laplacian viscosity at q-points (m2 s-1) -! real, dimension(SZI_(G),SZJ_(G)), intent(out) :: Leith_Ah_h !< Leith bi-harmonic viscosity at h-points (m4 s-1) -! real, dimension(SZIB_(G),SZJB_(G)), intent(out) :: Leith_Ah_q !< Leith bi-harmonic viscosity at q-points (m4 s-1) +! real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: u !< Zonal flow [m s-1] +! real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: v !< Meridional flow [m s-1] + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: h !< Layer thickness [H ~> m or kg m-2] + integer, intent(in) :: k !< Layer for which to calculate vorticity magnitude + real, dimension(SZIB_(G),SZJ_(G)), intent(in) :: div_xx_dx !< x-derivative of horizontal divergence + !! (d/dx(du/dx + dv/dy)) [m-1 s-1] + real, dimension(SZI_(G),SZJB_(G)), intent(in) :: div_xx_dy !< y-derivative of horizontal divergence + !! (d/dy(du/dx + dv/dy)) [m-1 s-1] + real, dimension(SZI_(G),SZJB_(G)), intent(inout) :: vort_xy_dx !< x-derivative of vertical vorticity + !! (d/dx(dv/dx - du/dy)) [m-1 s-1] + real, dimension(SZIB_(G),SZJ_(G)), intent(inout) :: vort_xy_dy !< y-derivative of vertical vorticity + !! (d/dy(dv/dx - du/dy)) [m-1 s-1] +! real, dimension(SZI_(G),SZJ_(G)), intent(out) :: Leith_Kh_h !< Leith Laplacian viscosity + !! at h-points [m2 s-1] +! real, dimension(SZIB_(G),SZJB_(G)), intent(out) :: Leith_Kh_q !< Leith Laplacian viscosity + !! at q-points [m2 s-1] +! real, dimension(SZI_(G),SZJ_(G)), intent(out) :: Leith_Ah_h !< Leith bi-harmonic viscosity + !! at h-points [m4 s-1] +! real, dimension(SZIB_(G),SZJB_(G)), intent(out) :: Leith_Ah_q !< Leith bi-harmonic viscosity + !! at q-points [m4 s-1] ! Local variables -! real, dimension(SZIB_(G),SZJB_(G)) :: vort_xy, & ! Vertical vorticity (dv/dx - du/dy) (s-1) -! dudy, & ! Meridional shear of zonal velocity (s-1) -! dvdx ! Zonal shear of meridional velocity (s-1) +! real, dimension(SZIB_(G),SZJB_(G)) :: vort_xy, & ! Vertical vorticity (dv/dx - du/dy) [s-1] +! dudy, & ! Meridional shear of zonal velocity [s-1] +! dvdx ! Zonal shear of meridional velocity [s-1] real, dimension(SZI_(G),SZJB_(G)) :: & -! vort_xy_dx, & ! x-derivative of vertical vorticity (d/dx(dv/dx - du/dy)) (m-1 s-1) -! div_xx_dy, & ! y-derivative of horizontal divergence (d/dy(du/dx + dv/dy)) (m-1 s-1) - dslopey_dz, & ! z-derivative of y-slope at v-points (m-1) - h_at_v, & ! Thickness at v-points (m or kg m-2) - beta_v, & ! Beta at v-points (m-1 s-1) - grad_vort_mag_v, & ! mag. of vort. grad. at v-points (s-1) - grad_div_mag_v ! mag. of div. grad. at v-points (s-1) +! vort_xy_dx, & ! x-derivative of vertical vorticity (d/dx(dv/dx - du/dy)) [m-1 s-1] +! div_xx_dy, & ! y-derivative of horizontal divergence (d/dy(du/dx + dv/dy)) [m-1 s-1] + dslopey_dz, & ! z-derivative of y-slope at v-points [m-1] + h_at_v, & ! Thickness at v-points [H ~> m or kg m-2] + beta_v, & ! Beta at v-points [m-1 s-1] + grad_vort_mag_v, & ! mag. of vort. grad. at v-points [s-1] + grad_div_mag_v ! mag. of div. grad. at v-points [s-1] real, dimension(SZIB_(G),SZJ_(G)) :: & -! vort_xy_dy, & ! y-derivative of vertical vorticity (d/dy(dv/dx - du/dy)) (m-1 s-1) -! div_xx_dx, & ! x-derivative of horizontal divergence (d/dx(du/dx + dv/dy)) (m-1 s-1) +! vort_xy_dy, & ! y-derivative of vertical vorticity (d/dy(dv/dx - du/dy)) [m-1 s-1] +! div_xx_dx, & ! x-derivative of horizontal divergence (d/dx(du/dx + dv/dy)) [m-1 s-1] dslopex_dz, & ! z-derivative of x-slope at u-points (m-1) - h_at_u, & ! Thickness at u-points (m or kg m-2) - beta_u, & ! Beta at u-points (m-1 s-1) - grad_vort_mag_u, & ! mag. of vort. grad. at u-points (s-1) - grad_div_mag_u ! mag. of div. grad. at u-points (s-1) -! real, dimension(SZI_(G),SZJ_(G)) :: div_xx ! Estimate of horizontal divergence at h-points (s-1) + h_at_u, & ! Thickness at u-points [H ~> m or kg m-2] + beta_u, & ! Beta at u-points [m-1 s-1] + grad_vort_mag_u, & ! mag. of vort. grad. at u-points [s-1] + grad_div_mag_u ! mag. of div. grad. at u-points [s-1] +! real, dimension(SZI_(G),SZJ_(G)) :: div_xx ! Estimate of horizontal divergence at h-points [s-1] ! real :: mod_Leith, DY_dxBu, DX_dyBu, vert_vort_mag real :: h_at_slope_above, h_at_slope_below, Ih, f integer :: i, j, is, ie, js, je, Isq, Ieq, Jsq, Jeq,nz diff --git a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 index da18462da6..3ebf159e3d 100644 --- a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 +++ b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 @@ -215,7 +215,8 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp !$OMP do if (CS%MEKE_GEOMETRIC) then do j=js,je ; do I=is-1,ie - Khth_Loc_u(I,j) = Khth_Loc_u(I,j) + G%mask2dCu(I,j) * CS%MEKE_GEOMETRIC_alpha * 0.5*(MEKE%MEKE(i,j)+MEKE%MEKE(i+1,j)) / & + Khth_Loc_u(I,j) = Khth_Loc_u(I,j) + & + G%mask2dCu(I,j) * CS%MEKE_GEOMETRIC_alpha * 0.5*(MEKE%MEKE(i,j)+MEKE%MEKE(i+1,j)) / & (VarMix%SN_u(I,j) + CS%MEKE_GEOMETRIC_epsilon) enddo ; enddo else @@ -293,8 +294,9 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp !$OMP do if (CS%MEKE_GEOMETRIC) then do j=js-1,je ; do I=is,ie - Khth_Loc(I,j) = Khth_Loc(I,j) + G%mask2dCv(i,J) * CS%MEKE_GEOMETRIC_alpha * 0.5*(MEKE%MEKE(i,j)+MEKE%MEKE(i,j+1)) / & - (VarMix%SN_v(i,J) + CS%MEKE_GEOMETRIC_epsilon) + Khth_Loc(I,j) = Khth_Loc(I,j) + & + G%mask2dCv(i,J) * CS%MEKE_GEOMETRIC_alpha * 0.5*(MEKE%MEKE(i,j)+MEKE%MEKE(i,j+1)) / & + (VarMix%SN_v(i,J) + CS%MEKE_GEOMETRIC_epsilon) enddo ; enddo else do J=js-1,je ; do i=is,ie @@ -525,12 +527,12 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV type(MEKE_type), pointer :: MEKE !< MEKE control structure type(thickness_diffuse_CS), pointer :: CS !< Control structure for thickness diffusion real, dimension(SZIB_(G),SZJ_(G),SZK_(G)+1), optional, intent(in) :: int_slope_u !< Ratio that determine how much of - !! the isopycnal slopes are taken directly from the - !! interface slopes without consideration of + !! the isopycnal slopes are taken directly from + !! the interface slopes without consideration of !! density gradients. real, dimension(SZI_(G),SZJB_(G),SZK_(G)+1), optional, intent(in) :: int_slope_v !< Ratio that determine how much of - !! the isopycnal slopes are taken directly from the - !! interface slopes without consideration of + !! the isopycnal slopes are taken directly from + !! the interface slopes without consideration of !! density gradients. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)+1), optional, intent(in) :: slope_x !< Isopycnal slope at u-points real, dimension(SZI_(G),SZJB_(G),SZK_(G)+1), optional, intent(in) :: slope_y !< Isopycnal slope at v-points @@ -1344,13 +1346,13 @@ subroutine add_detangling_Kh(h, e, Kh_u, Kh_v, KH_u_CFL, KH_v_CFL, tv, dt, G, GV real, intent(in) :: dt !< Time increment [s] type(thickness_diffuse_CS), pointer :: CS !< Control structure for thickness diffusion real, dimension(SZIB_(G),SZJ_(G),SZK_(G)+1), intent(inout) :: int_slope_u !< Ratio that determine how much of - !! the isopycnal slopes are taken directly from the - !! interface slopes without consideration of - !! density gradients. + !! the isopycnal slopes are taken directly from + !! the interface slopes without consideration + !! of density gradients. real, dimension(SZI_(G),SZJB_(G),SZK_(G)+1), intent(inout) :: int_slope_v !< Ratio that determine how much of - !! the isopycnal slopes are taken directly from the - !! interface slopes without consideration of - !! density gradients. + !! the isopycnal slopes are taken directly from + !! the interface slopes without consideration + !! of density gradients. ! Local variables real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: & de_top ! The distances between the top of a layer and the top of the From ac8b84a420f4f4e4aded57cd903d17f4d29c08fc Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sun, 7 Jul 2019 21:49:36 -0400 Subject: [PATCH 75/82] (*)Improved SW_trans correction for small fluxes Improved calculation of SW_trans for very small penetrating shortwave fluxes when OPTICS_2018_ANSWERS = False. By default and for the MOM6-examples test cases, all answers are bitwise identical. --- src/parameterizations/vertical/MOM_opacity.F90 | 18 ++++++++---------- 1 file changed, 8 insertions(+), 10 deletions(-) diff --git a/src/parameterizations/vertical/MOM_opacity.F90 b/src/parameterizations/vertical/MOM_opacity.F90 index 914ed0da05..af6715cf16 100644 --- a/src/parameterizations/vertical/MOM_opacity.F90 +++ b/src/parameterizations/vertical/MOM_opacity.F90 @@ -646,7 +646,8 @@ subroutine absorbRemainingSW(G, GV, US, h, opacity_band, nsw, optics, j, dt, H_l if (nsw*Pen_SW_bnd(n,i) <= min_SW_heat * (I_Habs*(h(i,k) - h_min_heat))) then SW_trans = 0.0 else - SW_trans = 1.0 - (min_SW_heat*(I_Habs*(h(i,k) - h_min_heat))) / (nsw*Pen_SW_bnd(n,i)) + SW_trans = min(SW_trans, & + 1.0 - (min_SW_heat*(I_Habs*(h(i,k) - h_min_heat))) / (nsw*Pen_SW_bnd(n,i))) endif endif @@ -854,7 +855,8 @@ subroutine sumSWoverBands(G, GV, US, h, optics, j, dt, & if (nsw*Pen_SW_bnd(n,i) <= min_SW_heat * (I_Habs*(h(i,k) - h_min_heat))) then SW_trans = 0.0 else - SW_trans = 1.0 - (min_SW_heat*(I_Habs*(h(i,k) - h_min_heat))) / (nsw*Pen_SW_bnd(n,i)) + SW_trans = min(SW_trans, & + 1.0 - (min_SW_heat*(I_Habs*(h(i,k) - h_min_heat))) / (nsw*Pen_SW_bnd(n,i))) endif endif @@ -1023,15 +1025,11 @@ subroutine opacity_init(Time, G, GV, US, param_file, diag, CS, optics) "The number of bands of penetrating shortwave radiation.", & default=1) if (CS%Opacity_scheme == DOUBLE_EXP ) then - if (optics%nbands /= 2) then - call MOM_error(FATAL, "set_opacity: "// & - "Cannot use a double_exp opacity scheme with nbands!=2.") - endif + if (optics%nbands /= 2) call MOM_error(FATAL, & + "set_opacity: \Cannot use a double_exp opacity scheme with nbands!=2.") elseif (CS%Opacity_scheme == SINGLE_EXP ) then - if (optics%nbands /= 1) then - call MOM_error(FATAL, "set_opacity: "// & - "Cannot use a single_exp opacity scheme with nbands!=1.") - endif + if (optics%nbands /= 1) call MOM_error(FATAL, & + "set_opacity: \Cannot use a single_exp opacity scheme with nbands!=1.") endif call get_param(param_file, mdl, "OPTICS_2018_ANSWERS", optics%answers_2018, & From 48fc7f279ffd586ee07c7e2fe507334179ea28dc Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Mon, 8 Jul 2019 10:46:26 -0400 Subject: [PATCH 76/82] Rescaled units of fluxes%ustar Added dimensional rescaling for forces%ustar, fluxes%ustar, fluxes%ustar_berg, fluxes%ustar_tidal, and fluxes%ustar_gustless, all of which are now in units of [Z T-1 ~> m s-1]. All answers are bitwise identical and are passing the dimensional consistency tests. --- .../coupled_driver/MOM_surface_forcing.F90 | 34 ++++++++-------- .../ice_solo_driver/MOM_surface_forcing.F90 | 14 +++---- .../ice_solo_driver/user_surface_forcing.F90 | 4 +- config_src/mct_driver/MOM_surface_forcing.F90 | 16 ++++---- .../nuopc_driver/MOM_surface_forcing.F90 | 40 +++++++++---------- .../solo_driver/MOM_surface_forcing.F90 | 24 +++++------ .../solo_driver/Neverland_surface_forcing.F90 | 2 +- .../solo_driver/user_surface_forcing.F90 | 2 +- src/core/MOM_forcing_type.F90 | 26 ++++++------ src/ice_shelf/MOM_ice_shelf.F90 | 14 +++---- .../lateral/MOM_mixed_layer_restrat.F90 | 10 ++--- .../vertical/MOM_CVMix_KPP.F90 | 16 ++++---- .../vertical/MOM_bulk_mixed_layer.F90 | 8 ++-- .../vertical/MOM_energetic_PBL.F90 | 6 +-- .../vertical/MOM_set_diffusivity.F90 | 11 ++--- .../vertical/MOM_set_viscosity.F90 | 4 +- .../vertical/MOM_vert_friction.F90 | 12 +++--- src/user/Idealized_Hurricane.F90 | 4 +- src/user/MOM_wave_interface.F90 | 6 +-- src/user/SCM_CVMix_tests.F90 | 2 +- 20 files changed, 128 insertions(+), 127 deletions(-) diff --git a/config_src/coupled_driver/MOM_surface_forcing.F90 b/config_src/coupled_driver/MOM_surface_forcing.F90 index 5112a0b64b..af7af37985 100644 --- a/config_src/coupled_driver/MOM_surface_forcing.F90 +++ b/config_src/coupled_driver/MOM_surface_forcing.F90 @@ -293,7 +293,7 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, US, CS, sfc do j=js-2,je+2 ; do i=is-2,ie+2 fluxes%TKE_tidal(i,j) = CS%TKE_tidal(i,j) - fluxes%ustar_tidal(i,j) = CS%ustar_tidal(i,j) + fluxes%ustar_tidal(i,j) = US%m_to_Z*US%T_to_s*CS%ustar_tidal(i,j) enddo ; enddo if (CS%restore_temp) call safe_alloc_ptr(fluxes%heat_added,isd,ied,jsd,jed) @@ -418,7 +418,7 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, US, CS, sfc fluxes%frunoff(i,j) = IOB%calving(i-i0,j-j0) * G%mask2dT(i,j) if (associated(IOB%ustar_berg)) & - fluxes%ustar_berg(i,j) = US%m_to_Z * IOB%ustar_berg(i-i0,j-j0) * G%mask2dT(i,j) + fluxes%ustar_berg(i,j) = US%m_to_Z*US%T_to_s * IOB%ustar_berg(i-i0,j-j0) * G%mask2dT(i,j) if (associated(IOB%area_berg)) & fluxes%area_berg(i,j) = IOB%area_berg(i-i0,j-j0) * G%mask2dT(i,j) @@ -586,7 +586,7 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, US, CS, dt_ real, dimension(SZI_(G),SZJ_(G)) :: & rigidity_at_h, & ! Ice rigidity at tracer points [m3 s-1] net_mass_src, & ! A temporary of net mass sources [kg m-2 s-1]. - ustar_tmp ! A temporary array of ustar values [m s-1]. + ustar_tmp ! A temporary array of ustar values [Z T-1 ~> m s-1]. real :: I_GEarth ! 1.0 / G%G_Earth [s2 m-1] real :: Kv_rho_ice ! (CS%kv_sea_ice / CS%density_sea_ice) [m5 s-1 kg-1] @@ -806,10 +806,10 @@ subroutine extract_IOB_stresses(IOB, index_bounds, Time, G, US, CS, taux, tauy, real, dimension(SZI_(G),SZJB_(G)), & optional, intent(inout) :: tauy !< The meridional wind stresses on a C-grid [Pa]. real, dimension(SZI_(G),SZJ_(G)), & - optional, intent(inout) :: ustar !< The surface friction velocity [Z s-1 ~> m s-1]. + optional, intent(inout) :: ustar !< The surface friction velocity [Z T-1 ~> m s-1]. real, dimension(SZI_(G),SZJ_(G)), & optional, intent(out) :: gustless_ustar !< The surface friction velocity without - !! any contributions from gustiness [Z s-1 ~> m s-1]. + !! any contributions from gustiness [Z T-1 ~> m s-1]. integer, optional, intent(in) :: tau_halo !< The halo size of wind stresses to set, 0 by default. ! Local variables @@ -821,7 +821,7 @@ subroutine extract_IOB_stresses(IOB, index_bounds, Time, G, US, CS, taux, tauy, real, dimension(SZIB_(G),SZJB_(G)) :: tauy_in_B ! Meridional wind stresses [Pa] at q points real :: gustiness ! unresolved gustiness that contributes to ustar [Pa] - real :: Irho0 ! Inverse of the mean density rescaled to [Z2 m kg-1 ~> m3 kg-1] + real :: Irho0 ! Inverse of the mean density rescaled to [Z2 s2 m T-2 kg-1 ~> m3 kg-1] real :: taux2, tauy2 ! squared wind stresses [Pa2] real :: tau_mag ! magnitude of the wind stress [Pa] @@ -835,7 +835,7 @@ subroutine extract_IOB_stresses(IOB, index_bounds, Time, G, US, CS, taux, tauy, Isqh = G%IscB-halo ; Ieqh = G%IecB+halo ; Jsqh = G%JscB-halo ; Jeqh = G%JecB+halo i0 = is - index_bounds(1) ; j0 = js - index_bounds(3) - Irho0 = US%m_to_Z**2 / CS%Rho0 + Irho0 = (US%m_to_Z*US%T_to_s)**2 / CS%Rho0 do_ustar = present(ustar) ; do_gustless = present(gustless_ustar) @@ -950,7 +950,7 @@ subroutine extract_IOB_stresses(IOB, index_bounds, Time, G, US, CS, taux, tauy, ustar(i,j) = sqrt(gustiness*Irho0 + Irho0*IOB%stress_mag(i-i0,j-j0)) enddo ; enddo ; endif if (do_gustless) then ; do j=js,je ; do i=is,ie - gustless_ustar(i,j) = US%m_to_Z * sqrt(IOB%stress_mag(i-i0,j-j0) / CS%Rho0) + gustless_ustar(i,j) = US%m_to_Z*US%T_to_s * sqrt(IOB%stress_mag(i-i0,j-j0) / CS%Rho0) !### Change to: ! gustless_ustar(i,j) = sqrt(Irho0 * IOB%stress_mag(i-i0,j-j0)) enddo ; enddo ; endif @@ -967,7 +967,7 @@ subroutine extract_IOB_stresses(IOB, index_bounds, Time, G, US, CS, taux, tauy, if (CS%read_gust_2d) gustiness = CS%gust(i,j) endif if (do_ustar) ustar(i,j) = sqrt(gustiness*Irho0 + Irho0 * tau_mag) - if (do_gustless) gustless_ustar(i,j) = US%m_to_Z * sqrt(tau_mag / CS%Rho0) + if (do_gustless) gustless_ustar(i,j) = US%m_to_Z*US%T_to_s * sqrt(tau_mag / CS%Rho0) !### Change to: ! if (do_gustless) gustless_ustar(i,j) = sqrt(Irho0 * tau_mag) enddo ; enddo @@ -977,7 +977,7 @@ subroutine extract_IOB_stresses(IOB, index_bounds, Time, G, US, CS, taux, tauy, gustiness = CS%gust_const if (CS%read_gust_2d .and. (G%mask2dT(i,j) > 0)) gustiness = CS%gust(i,j) if (do_ustar) ustar(i,j) = sqrt(gustiness*Irho0 + Irho0 * tau_mag) - if (do_gustless) gustless_ustar(i,j) = US%m_to_Z * sqrt(tau_mag / CS%Rho0) + if (do_gustless) gustless_ustar(i,j) = US%m_to_Z*US%T_to_s * sqrt(tau_mag / CS%Rho0) !### Change to: ! if (do_gustless) gustless_ustar(i,j) = sqrt(Irho0 * tau_mag) enddo ; enddo @@ -985,18 +985,18 @@ subroutine extract_IOB_stresses(IOB, index_bounds, Time, G, US, CS, taux, tauy, do j=js,je ; do i=is,ie taux2 = 0.0 ; tauy2 = 0.0 if ((G%mask2dCu(I-1,j) + G%mask2dCu(I,j)) > 0) & - taux2 = (G%mask2dCu(I-1,j)*taux_in_C(I-1,j)**2 + & - G%mask2dCu(I,j)*taux_in_C(I,j)**2) / (G%mask2dCu(I-1,j) + G%mask2dCu(I,j)) + taux2 = (G%mask2dCu(I-1,j)*taux_in_C(I-1,j)**2 + G%mask2dCu(I,j)*taux_in_C(I,j)**2) / & + (G%mask2dCu(I-1,j) + G%mask2dCu(I,j)) if ((G%mask2dCv(i,J-1) + G%mask2dCv(i,J)) > 0) & - tauy2 = (G%mask2dCv(i,J-1)*tauy_in_C(i,J-1)**2 + & - G%mask2dCv(i,J)*tauy_in_C(i,J)**2) / (G%mask2dCv(i,J-1) + G%mask2dCv(i,J)) + tauy2 = (G%mask2dCv(i,J-1)*tauy_in_C(i,J-1)**2 + G%mask2dCv(i,J)*tauy_in_C(i,J)**2) / & + (G%mask2dCv(i,J-1) + G%mask2dCv(i,J)) tau_mag = sqrt(taux2 + tauy2) gustiness = CS%gust_const if (CS%read_gust_2d) gustiness = CS%gust(i,j) if (do_ustar) ustar(i,j) = sqrt(gustiness*Irho0 + Irho0 * tau_mag) - if (do_gustless) gustless_ustar(i,j) = US%m_to_Z * sqrt(tau_mag / CS%Rho0) + if (do_gustless) gustless_ustar(i,j) = US%m_to_Z*US%T_to_s * sqrt(tau_mag / CS%Rho0) !### Change to: ! if (do_gustless) gustless_ustar(i,j) = sqrt(Irho0 * tau_mag) enddo ; enddo @@ -1363,13 +1363,13 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS) do j=jsd, jed; do i=isd, ied utide = CS%TKE_tidal(i,j) CS%TKE_tidal(i,j) = G%mask2dT(i,j)*CS%Rho0*CS%cd_tides*(utide*utide*utide) - CS%ustar_tidal(i,j)=sqrt(CS%cd_tides)*utide + CS%ustar_tidal(i,j) = sqrt(CS%cd_tides)*utide enddo ; enddo else do j=jsd,jed; do i=isd,ied utide=CS%utide CS%TKE_tidal(i,j) = CS%Rho0*CS%cd_tides*(utide*utide*utide) - CS%ustar_tidal(i,j)=sqrt(CS%cd_tides)*utide + CS%ustar_tidal(i,j) = sqrt(CS%cd_tides)*utide enddo ; enddo endif diff --git a/config_src/ice_solo_driver/MOM_surface_forcing.F90 b/config_src/ice_solo_driver/MOM_surface_forcing.F90 index 77099b2595..3509016c1f 100644 --- a/config_src/ice_solo_driver/MOM_surface_forcing.F90 +++ b/config_src/ice_solo_driver/MOM_surface_forcing.F90 @@ -356,11 +356,11 @@ subroutine wind_forcing_zero(sfc_state, forces, day, G, US, CS) if (CS%read_gust_2d) then if (associated(forces%ustar)) then ; do j=js,je ; do i=is,ie - forces%ustar(i,j) = US%m_to_Z * sqrt(CS%gust(i,j)/CS%Rho0) + forces%ustar(i,j) = US%m_to_Z*US%T_to_s * sqrt(CS%gust(i,j)/CS%Rho0) enddo ; enddo ; endif else if (associated(forces%ustar)) then ; do j=js,je ; do i=is,ie - forces%ustar(i,j) = US%m_to_Z * sqrt(CS%gust_const/CS%Rho0) + forces%ustar(i,j) = US%m_to_Z*US%T_to_s * sqrt(CS%gust_const/CS%Rho0) enddo ; enddo ; endif endif @@ -479,7 +479,7 @@ subroutine wind_forcing_gyres(sfc_state, forces, day, G, US, CS) ! set the friction velocity do j=js,je ; do i=is,ie - forces%ustar(i,j) = US%m_to_Z * sqrt(sqrt(0.5*(forces%tauy(i,j-1)*forces%tauy(i,j-1) + & + forces%ustar(i,j) = US%m_to_Z*US%T_to_s * sqrt(sqrt(0.5*(forces%tauy(i,j-1)*forces%tauy(i,j-1) + & forces%tauy(i,j)*forces%tauy(i,j) + forces%taux(i-1,j)*forces%taux(i-1,j) + & forces%taux(i,j)*forces%taux(i,j)))/CS%Rho0 + (CS%gust_const/CS%Rho0)) enddo ; enddo @@ -540,12 +540,12 @@ subroutine wind_forcing_from_file(sfc_state, forces, day, G, US, CS) if (CS%read_gust_2d) then do j=js,je ; do i=is,ie - forces%ustar(i,j) = US%m_to_Z * sqrt((sqrt(temp_x(i,j)*temp_x(i,j) + & + forces%ustar(i,j) = US%m_to_Z*US%T_to_s * sqrt((sqrt(temp_x(i,j)*temp_x(i,j) + & temp_y(i,j)*temp_y(i,j)) + CS%gust(i,j)) / CS%Rho0) enddo ; enddo else do j=js,je ; do i=is,ie - forces%ustar(i,j) = US%m_to_Z * sqrt(sqrt(temp_x(i,j)*temp_x(i,j) + & + forces%ustar(i,j) = US%m_to_Z*US%T_to_s * sqrt(sqrt(temp_x(i,j)*temp_x(i,j) + & temp_y(i,j)*temp_y(i,j))/CS%Rho0 + (CS%gust_const/CS%Rho0)) enddo ; enddo endif @@ -565,13 +565,13 @@ subroutine wind_forcing_from_file(sfc_state, forces, day, G, US, CS) call pass_vector(forces%taux, forces%tauy, G%Domain, To_All) if (CS%read_gust_2d) then do j=js, je ; do i=is, ie - forces%ustar(i,j) = US%m_to_Z * sqrt((sqrt(0.5*((forces%tauy(i,j-1)**2 + & + forces%ustar(i,j) = US%m_to_Z*US%T_to_s * sqrt((sqrt(0.5*((forces%tauy(i,j-1)**2 + & forces%tauy(i,j)**2) + (forces%taux(i-1,j)**2 + & forces%taux(i,j)**2))) + CS%gust(i,j)) / CS%Rho0 ) enddo ; enddo else do j=js, je ; do i=is, ie - forces%ustar(i,j) = US%m_to_Z * sqrt(sqrt(0.5*((forces%tauy(i,j-1)**2 + & + forces%ustar(i,j) = US%m_to_Z*US%T_to_s * sqrt(sqrt(0.5*((forces%tauy(i,j-1)**2 + & forces%tauy(i,j)**2) + (forces%taux(i-1,j)**2 + & forces%taux(i,j)**2)))/CS%Rho0 + (CS%gust_const/CS%Rho0)) enddo ; enddo diff --git a/config_src/ice_solo_driver/user_surface_forcing.F90 b/config_src/ice_solo_driver/user_surface_forcing.F90 index 2d899ce1bb..aa5a302e95 100644 --- a/config_src/ice_solo_driver/user_surface_forcing.F90 +++ b/config_src/ice_solo_driver/user_surface_forcing.F90 @@ -106,7 +106,7 @@ subroutine USER_wind_forcing(sfc_state, forces, day, G, US, CS) ! This subroutine sets the surface wind stresses, forces%taux and forces%tauy [Pa]. ! In addition, this subroutine can be used to set the surface friction velocity, -! forces%ustar [Z s-1 ~> m s-1], which is needed with a bulk mixed layer. +! forces%ustar [Z T-1 ~> m s-1], which is needed with a bulk mixed layer. integer :: i, j, is, ie, js, je, Isq, Ieq, Jsq, Jeq integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB @@ -139,7 +139,7 @@ subroutine USER_wind_forcing(sfc_state, forces, day, G, US, CS) ! Set the surface friction velocity [Z s-1 ~> m s-1]. ustar is always positive. if (associated(forces%ustar)) then ; do j=js,je ; do i=is,ie ! This expression can be changed if desired, but need not be. - forces%ustar(i,j) = US%m_to_Z * G%mask2dT(i,j) * sqrt(CS%gust_const/CS%Rho0 + & + forces%ustar(i,j) = US%m_to_Z*US%T_to_s * G%mask2dT(i,j) * sqrt(CS%gust_const/CS%Rho0 + & sqrt(0.5*(forces%taux(I-1,j)**2 + forces%taux(I,j)**2) + & 0.5*(forces%tauy(i,J-1)**2 + forces%tauy(i,J)**2))/CS%Rho0) enddo ; enddo ; endif diff --git a/config_src/mct_driver/MOM_surface_forcing.F90 b/config_src/mct_driver/MOM_surface_forcing.F90 index 47e676a3d3..6176b83602 100644 --- a/config_src/mct_driver/MOM_surface_forcing.F90 +++ b/config_src/mct_driver/MOM_surface_forcing.F90 @@ -305,7 +305,7 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, Time, G, US, CS, & do j=js-2,je+2 ; do i=is-2,ie+2 fluxes%TKE_tidal(i,j) = CS%TKE_tidal(i,j) - fluxes%ustar_tidal(i,j) = CS%ustar_tidal(i,j) + fluxes%ustar_tidal(i,j) = US%m_to_Z*US%T_to_s*CS%ustar_tidal(i,j) enddo; enddo if (restore_temp) call safe_alloc_ptr(fluxes%heat_added,isd,ied,jsd,jed) @@ -422,7 +422,7 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, Time, G, US, CS, & ! .or. (associated(IOB%mass_berg) .and. (.not. associated(fluxes%mass_berg)))) & ! call allocate_forcing_type(G, fluxes, iceberg=.true.) !if (associated(IOB%ustar_berg)) & - ! fluxes%ustar_berg(i,j) = US%m_to_Z * IOB%ustar_berg(i-i0,j-j0) * G%mask2dT(i,j) + ! fluxes%ustar_berg(i,j) = US%m_to_Z*US%T_to_s * IOB%ustar_berg(i-i0,j-j0) * G%mask2dT(i,j) !if (associated(IOB%area_berg)) & ! fluxes%area_berg(i,j) = IOB%area_berg(i-i0,j-j0) * G%mask2dT(i,j) !if (associated(IOB%mass_berg)) & @@ -705,7 +705,7 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, US, CS) ((G%mask2dBu(I,J) + G%mask2dBu(I-1,J-1)) + (G%mask2dBu(I,J-1) + G%mask2dBu(I-1,J))) ) if (CS%read_gust_2d) gustiness = CS%gust(i,j) endif - forces%ustar(i,j) = US%m_to_Z * sqrt(gustiness*Irho0 + Irho0*tau_mag) + forces%ustar(i,j) = US%m_to_Z*US%T_to_s * sqrt(gustiness*Irho0 + Irho0*tau_mag) enddo; enddo elseif (wind_stagger == AGRID) then @@ -730,7 +730,7 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, US, CS) do j=js,je ; do i=is,ie gustiness = CS%gust_const if (CS%read_gust_2d .and. (G%mask2dT(i,j) > 0)) gustiness = CS%gust(i,j) - forces%ustar(i,j) = US%m_to_Z * sqrt(gustiness*Irho0 + Irho0 * G%mask2dT(i,j) * & + forces%ustar(i,j) = US%m_to_Z*US%T_to_s * sqrt(gustiness*Irho0 + Irho0 * G%mask2dT(i,j) * & sqrt(taux_at_h(i,j)**2 + tauy_at_h(i,j)**2)) enddo; enddo @@ -751,9 +751,9 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, US, CS) G%mask2dCv(i,J)*forces%tauy(i,J)**2) / (G%mask2dCv(i,J-1) + G%mask2dCv(i,J)) if (CS%read_gust_2d) then - forces%ustar(i,j) = US%m_to_Z * sqrt(CS%gust(i,j)*Irho0 + Irho0*sqrt(taux2 + tauy2)) + forces%ustar(i,j) = US%m_to_Z*US%T_to_s * sqrt(CS%gust(i,j)*Irho0 + Irho0*sqrt(taux2 + tauy2)) else - forces%ustar(i,j) = US%m_to_Z * sqrt(CS%gust_const*Irho0 + Irho0*sqrt(taux2 + tauy2)) + forces%ustar(i,j) = US%m_to_Z*US%T_to_s * sqrt(CS%gust_const*Irho0 + Irho0*sqrt(taux2 + tauy2)) endif enddo; enddo @@ -1222,13 +1222,13 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, restore_salt, do j=jsd, jed; do i=isd, ied utide = CS%TKE_tidal(i,j) CS%TKE_tidal(i,j) = G%mask2dT(i,j)*CS%Rho0*CS%cd_tides*(utide*utide*utide) - CS%ustar_tidal(i,j)=sqrt(CS%cd_tides)*utide + CS%ustar_tidal(i,j) = sqrt(CS%cd_tides)*utide enddo ; enddo else do j=jsd,jed; do i=isd,ied utide=CS%utide CS%TKE_tidal(i,j) = CS%Rho0*CS%cd_tides*(utide*utide*utide) - CS%ustar_tidal(i,j)=sqrt(CS%cd_tides)*utide + CS%ustar_tidal(i,j) = sqrt(CS%cd_tides)*utide enddo ; enddo endif diff --git a/config_src/nuopc_driver/MOM_surface_forcing.F90 b/config_src/nuopc_driver/MOM_surface_forcing.F90 index 69dda6b6d3..e96399e2d8 100644 --- a/config_src/nuopc_driver/MOM_surface_forcing.F90 +++ b/config_src/nuopc_driver/MOM_surface_forcing.F90 @@ -92,7 +92,7 @@ module MOM_surface_forcing gust => NULL(), & !< spatially varying unresolved background !! gustiness that contributes to ustar [Pa]. !! gust is used when read_gust_2d is true. - ustar_tidal => NULL() !< tidal contribution to the bottom friction velocity [m/s] + ustar_tidal => NULL() !< tidal contribution to the bottom friction velocity [m s-1] real :: cd_tides !< drag coefficient that applies to the tides (nondimensional) real :: utide !< constant tidal velocity to use if read_tideamp !! is false [m s-1] @@ -309,7 +309,7 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, US, CS, & do j=js-2,je+2 ; do i=is-2,ie+2 fluxes%TKE_tidal(i,j) = CS%TKE_tidal(i,j) - fluxes%ustar_tidal(i,j) = CS%ustar_tidal(i,j) + fluxes%ustar_tidal(i,j) = US%m_to_Z*US%T_to_s*CS%ustar_tidal(i,j) enddo ; enddo if (restore_temp) call safe_alloc_ptr(fluxes%heat_added,isd,ied,jsd,jed) @@ -429,32 +429,32 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, US, CS, & ! liquid runoff flux if (associated(IOB%rofl_flux)) then - fluxes%lrunoff(i,j) = IOB%rofl_flux(i-i0,j-j0) * G%mask2dT(i,j) + fluxes%lrunoff(i,j) = IOB%rofl_flux(i-i0,j-j0) * G%mask2dT(i,j) else if (associated(IOB%runoff)) then - fluxes%lrunoff(i,j) = IOB%runoff(i-i0,j-j0) * G%mask2dT(i,j) - end if + fluxes%lrunoff(i,j) = IOB%runoff(i-i0,j-j0) * G%mask2dT(i,j) + endif ! ice runoff flux if (associated(IOB%rofi_flux)) then - fluxes%frunoff(i,j) = IOB%rofi_flux(i-i0,j-j0) * G%mask2dT(i,j) - else if (associated(IOB%calving)) then - fluxes%frunoff(i,j) = IOB%calving(i-i0,j-j0) * G%mask2dT(i,j) - end if + fluxes%frunoff(i,j) = IOB%rofi_flux(i-i0,j-j0) * G%mask2dT(i,j) + elseif (associated(IOB%calving)) then + fluxes%frunoff(i,j) = IOB%calving(i-i0,j-j0) * G%mask2dT(i,j) + endif if (associated(IOB%ustar_berg)) & - fluxes%ustar_berg(i,j) = US%m_to_Z * IOB%ustar_berg(i-i0,j-j0) * G%mask2dT(i,j) + fluxes%ustar_berg(i,j) = US%m_to_Z*US%T_to_s * IOB%ustar_berg(i-i0,j-j0) * G%mask2dT(i,j) if (associated(IOB%area_berg)) & - fluxes%area_berg(i,j) = IOB%area_berg(i-i0,j-j0) * G%mask2dT(i,j) + fluxes%area_berg(i,j) = IOB%area_berg(i-i0,j-j0) * G%mask2dT(i,j) if (associated(IOB%mass_berg)) & - fluxes%mass_berg(i,j) = IOB%mass_berg(i-i0,j-j0) * G%mask2dT(i,j) + fluxes%mass_berg(i,j) = IOB%mass_berg(i-i0,j-j0) * G%mask2dT(i,j) if (associated(IOB%runoff_hflx)) & - fluxes%heat_content_lrunoff(i,j) = IOB%runoff_hflx(i-i0,j-j0) * G%mask2dT(i,j) + fluxes%heat_content_lrunoff(i,j) = IOB%runoff_hflx(i-i0,j-j0) * G%mask2dT(i,j) if (associated(IOB%calving_hflx)) & - fluxes%heat_content_frunoff(i,j) = IOB%calving_hflx(i-i0,j-j0) * G%mask2dT(i,j) + fluxes%heat_content_frunoff(i,j) = IOB%calving_hflx(i-i0,j-j0) * G%mask2dT(i,j) if (associated(IOB%lw_flux)) & fluxes%LW(i,j) = IOB%lw_flux(i-i0,j-j0) * G%mask2dT(i,j) @@ -770,7 +770,7 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, US, CS) ((G%mask2dBu(I,J) + G%mask2dBu(I-1,J-1)) + (G%mask2dBu(I,J-1) + G%mask2dBu(I-1,J))) ) if (CS%read_gust_2d) gustiness = CS%gust(i,j) endif - forces%ustar(i,j) = US%m_to_Z * sqrt(gustiness*Irho0 + Irho0*tau_mag) + forces%ustar(i,j) = US%m_to_Z*US%T_to_s * sqrt(gustiness*Irho0 + Irho0*tau_mag) enddo ; enddo elseif (wind_stagger == AGRID) then @@ -796,7 +796,7 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, US, CS) do j=js,je ; do i=is,ie gustiness = CS%gust_const if (CS%read_gust_2d .and. (G%mask2dT(i,j) > 0)) gustiness = CS%gust(i,j) - forces%ustar(i,j) = US%m_to_Z * sqrt(gustiness*Irho0 + Irho0 * G%mask2dT(i,j) * & + forces%ustar(i,j) = US%m_to_Z*US%T_to_s * sqrt(gustiness*Irho0 + Irho0 * G%mask2dT(i,j) * & sqrt(taux_at_h(i,j)**2 + tauy_at_h(i,j)**2)) enddo ; enddo @@ -817,9 +817,9 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, US, CS) G%mask2dCv(i,J)*forces%tauy(i,J)**2) / (G%mask2dCv(i,J-1) + G%mask2dCv(i,J)) if (CS%read_gust_2d) then - forces%ustar(i,j) = US%m_to_Z * sqrt(CS%gust(i,j)*Irho0 + Irho0*sqrt(taux2 + tauy2)) + forces%ustar(i,j) = US%m_to_Z*US%T_to_s * sqrt(CS%gust(i,j)*Irho0 + Irho0*sqrt(taux2 + tauy2)) else - forces%ustar(i,j) = US%m_to_Z * sqrt(CS%gust_const*Irho0 + Irho0*sqrt(taux2 + tauy2)) + forces%ustar(i,j) = US%m_to_Z*US%T_to_s * sqrt(CS%gust_const*Irho0 + Irho0*sqrt(taux2 + tauy2)) endif enddo ; enddo @@ -1221,13 +1221,13 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, restore_salt, do j=jsd, jed; do i=isd, ied utide = CS%TKE_tidal(i,j) CS%TKE_tidal(i,j) = G%mask2dT(i,j)*CS%Rho0*CS%cd_tides*(utide*utide*utide) - CS%ustar_tidal(i,j)=sqrt(CS%cd_tides)*utide + CS%ustar_tidal(i,j) = sqrt(CS%cd_tides)*utide enddo ; enddo else do j=jsd,jed; do i=isd,ied utide=CS%utide CS%TKE_tidal(i,j) = CS%Rho0*CS%cd_tides*(utide*utide*utide) - CS%ustar_tidal(i,j)=sqrt(CS%cd_tides)*utide + CS%ustar_tidal(i,j) = sqrt(CS%cd_tides)*utide enddo ; enddo endif diff --git a/config_src/solo_driver/MOM_surface_forcing.F90 b/config_src/solo_driver/MOM_surface_forcing.F90 index 6fe06daea8..9bf44f658a 100644 --- a/config_src/solo_driver/MOM_surface_forcing.F90 +++ b/config_src/solo_driver/MOM_surface_forcing.F90 @@ -388,11 +388,11 @@ subroutine wind_forcing_const(sfc_state, forces, tau_x0, tau_y0, day, G, US, CS) if (CS%read_gust_2d) then if (associated(forces%ustar)) then ; do j=js,je ; do i=is,ie - forces%ustar(i,j) = US%m_to_Z * sqrt( ( mag_tau + CS%gust(i,j) ) / CS%Rho0 ) + forces%ustar(i,j) = US%m_to_Z*US%T_to_s * sqrt( ( mag_tau + CS%gust(i,j) ) / CS%Rho0 ) enddo ; enddo ; endif else if (associated(forces%ustar)) then ; do j=js,je ; do i=is,ie - forces%ustar(i,j) = US%m_to_Z * sqrt( ( mag_tau + CS%gust_const ) / CS%Rho0 ) + forces%ustar(i,j) = US%m_to_Z*US%T_to_s * sqrt( ( mag_tau + CS%gust_const ) / CS%Rho0 ) enddo ; enddo ; endif endif @@ -500,7 +500,7 @@ subroutine wind_forcing_gyres(sfc_state, forces, day, G, US, CS) ! set the friction velocity !### Add parenthesis so that this is rotationally invariant. do j=js,je ; do i=is,ie - forces%ustar(i,j) = US%m_to_Z * sqrt(sqrt(0.5*(forces%tauy(i,j-1)*forces%tauy(i,j-1) + & + forces%ustar(i,j) = US%m_to_Z*US%T_to_s * sqrt(sqrt(0.5*(forces%tauy(i,j-1)*forces%tauy(i,j-1) + & forces%tauy(i,j)*forces%tauy(i,j) + forces%taux(i-1,j)*forces%taux(i-1,j) + & forces%taux(i,j)*forces%taux(i,j)))/CS%Rho0 + (CS%gust_const/CS%Rho0)) enddo ; enddo @@ -584,12 +584,12 @@ subroutine wind_forcing_from_file(sfc_state, forces, day, G, US, CS) if (.not.read_Ustar) then if (CS%read_gust_2d) then do j=js,je ; do i=is,ie - forces%ustar(i,j) = US%m_to_Z * sqrt((sqrt(temp_x(i,j)*temp_x(i,j) + & + forces%ustar(i,j) = US%m_to_Z*US%T_to_s * sqrt((sqrt(temp_x(i,j)*temp_x(i,j) + & temp_y(i,j)*temp_y(i,j)) + CS%gust(i,j)) / CS%Rho0) enddo ; enddo else do j=js,je ; do i=is,ie - forces%ustar(i,j) = US%m_to_Z * sqrt(sqrt(temp_x(i,j)*temp_x(i,j) + & + forces%ustar(i,j) = US%m_to_Z*US%T_to_s * sqrt(sqrt(temp_x(i,j)*temp_x(i,j) + & temp_y(i,j)*temp_y(i,j))/CS%Rho0 + (CS%gust_const/CS%Rho0)) enddo ; enddo endif @@ -629,13 +629,13 @@ subroutine wind_forcing_from_file(sfc_state, forces, day, G, US, CS) if (.not.read_Ustar) then if (CS%read_gust_2d) then do j=js, je ; do i=is, ie - forces%ustar(i,j) = US%m_to_Z * sqrt((sqrt(0.5*((forces%tauy(i,j-1)**2 + & + forces%ustar(i,j) = US%m_to_Z*US%T_to_s * sqrt((sqrt(0.5*((forces%tauy(i,j-1)**2 + & forces%tauy(i,j)**2) + (forces%taux(i-1,j)**2 + & forces%taux(i,j)**2))) + CS%gust(i,j)) / CS%Rho0 ) enddo ; enddo else do j=js, je ; do i=is, ie - forces%ustar(i,j) = US%m_to_Z * sqrt(sqrt(0.5*((forces%tauy(i,j-1)**2 + & + forces%ustar(i,j) = US%m_to_Z*US%T_to_s * sqrt(sqrt(0.5*((forces%tauy(i,j-1)**2 + & forces%tauy(i,j)**2) + (forces%taux(i-1,j)**2 + & forces%taux(i,j)**2)))/CS%Rho0 + (CS%gust_const/CS%Rho0)) enddo ; enddo @@ -648,7 +648,7 @@ subroutine wind_forcing_from_file(sfc_state, forces, day, G, US, CS) if (read_Ustar) then call MOM_read_data(filename, CS%Ustar_var, forces%ustar(:,:), & - G%Domain, timelevel=time_lev, scale=US%Z_to_m) + G%Domain, timelevel=time_lev, scale=US%m_to_Z*US%T_to_s) endif CS%wind_last_lev = time_lev @@ -703,19 +703,19 @@ subroutine wind_forcing_by_data_override(sfc_state, forces, day, G, US, CS) read_Ustar = (len_trim(CS%ustar_var) > 0) ! Need better control higher up ???? if (read_Ustar) then - do j=G%jsc,G%jec ; do i=G%isc,G%iec ; temp_ustar(i,j) = US%Z_to_m*forces%ustar(i,j) ; enddo ; enddo + do j=G%jsc,G%jec ; do i=G%isc,G%iec ; temp_ustar(i,j) = US%Z_to_m*US%s_to_T*forces%ustar(i,j) ; enddo ; enddo call data_override('OCN', 'ustar', temp_ustar, day, is_in=is_in, ie_in=ie_in, js_in=js_in, je_in=je_in) - do j=G%jsc,G%jec ; do i=G%isc,G%iec ; forces%ustar(i,j) = US%m_to_Z*temp_ustar(i,j) ; enddo ; enddo + do j=G%jsc,G%jec ; do i=G%isc,G%iec ; forces%ustar(i,j) = US%m_to_Z*US%T_to_s*temp_ustar(i,j) ; enddo ; enddo else if (CS%read_gust_2d) then call data_override('OCN', 'gust', CS%gust, day, is_in=is_in, ie_in=ie_in, js_in=js_in, je_in=je_in) do j=G%jsc,G%jec ; do i=G%isc,G%iec - forces%ustar(i,j) = US%m_to_Z * sqrt((sqrt(temp_x(i,j)*temp_x(i,j) + & + forces%ustar(i,j) = US%m_to_Z*US%T_to_s * sqrt((sqrt(temp_x(i,j)*temp_x(i,j) + & temp_y(i,j)*temp_y(i,j)) + CS%gust(i,j)) / CS%Rho0) enddo ; enddo else do j=G%jsc,G%jec ; do i=G%isc,G%iec - forces%ustar(i,j) = US%m_to_Z * sqrt(sqrt(temp_x(i,j)*temp_x(i,j) + & + forces%ustar(i,j) = US%m_to_Z*US%T_to_s * sqrt(sqrt(temp_x(i,j)*temp_x(i,j) + & temp_y(i,j)*temp_y(i,j))/CS%Rho0 + (CS%gust_const/CS%Rho0)) enddo ; enddo endif diff --git a/config_src/solo_driver/Neverland_surface_forcing.F90 b/config_src/solo_driver/Neverland_surface_forcing.F90 index 71e91a539c..1fefc005f0 100644 --- a/config_src/solo_driver/Neverland_surface_forcing.F90 +++ b/config_src/solo_driver/Neverland_surface_forcing.F90 @@ -104,7 +104,7 @@ subroutine Neverland_wind_forcing(sfc_state, forces, day, G, US, CS) ! is always positive. ! if (associated(forces%ustar)) then ; do j=js,je ; do i=is,ie ! ! This expression can be changed if desired, but need not be. -! forces%ustar(i,j) = US%m_to_Z * G%mask2dT(i,j) * sqrt(CS%gust_const/CS%Rho0 + & +! forces%ustar(i,j) = US%m_to_Z*US%T_to_s * G%mask2dT(i,j) * sqrt(CS%gust_const/CS%Rho0 + & ! sqrt(0.5*(forces%taux(I-1,j)**2 + forces%taux(I,j)**2) + & ! 0.5*(forces%tauy(i,J-1)**2 + forces%tauy(i,J)**2))/CS%Rho0) ! enddo ; enddo ; endif diff --git a/config_src/solo_driver/user_surface_forcing.F90 b/config_src/solo_driver/user_surface_forcing.F90 index 5ff39ae8c4..0275072599 100644 --- a/config_src/solo_driver/user_surface_forcing.F90 +++ b/config_src/solo_driver/user_surface_forcing.F90 @@ -88,7 +88,7 @@ subroutine USER_wind_forcing(sfc_state, forces, day, G, US, CS) ! is always positive. if (associated(forces%ustar)) then ; do j=js,je ; do i=is,ie ! This expression can be changed if desired, but need not be. - forces%ustar(i,j) = US%m_to_Z * G%mask2dT(i,j) * sqrt(CS%gust_const/CS%Rho0 + & + forces%ustar(i,j) = US%m_to_Z*US%T_to_s * G%mask2dT(i,j) * sqrt(CS%gust_const/CS%Rho0 + & sqrt(0.5*(forces%taux(I-1,j)**2 + forces%taux(I,j)**2) + & 0.5*(forces%tauy(i,J-1)**2 + forces%tauy(i,J)**2))/CS%Rho0) enddo ; enddo ; endif diff --git a/src/core/MOM_forcing_type.F90 b/src/core/MOM_forcing_type.F90 index 4fcbac0dec..79b8c251dd 100644 --- a/src/core/MOM_forcing_type.F90 +++ b/src/core/MOM_forcing_type.F90 @@ -50,9 +50,9 @@ module MOM_forcing_type ! surface stress components and turbulent velocity scale real, pointer, dimension(:,:) :: & - ustar => NULL(), & !< surface friction velocity scale [Z s-1 ~> m s-1]. + ustar => NULL(), & !< surface friction velocity scale [Z T-1 ~> m s-1]. ustar_gustless => NULL() !< surface friction velocity scale without any - !! any augmentation for gustiness [Z s-1 ~> m s-1]. + !! any augmentation for gustiness [Z T-1 ~> m s-1]. ! surface buoyancy force, used when temperature is not a state variable real, pointer, dimension(:,:) :: & @@ -131,16 +131,16 @@ module MOM_forcing_type ! tide related inputs real, pointer, dimension(:,:) :: & TKE_tidal => NULL(), & !< tidal energy source driving mixing in bottom boundary layer [W m-2] - ustar_tidal => NULL() !< tidal contribution to bottom ustar [m s-1] + ustar_tidal => NULL() !< tidal contribution to bottom ustar [Z T-1 ~> m s-1] ! iceberg related inputs real, pointer, dimension(:,:) :: & - ustar_berg => NULL(), & !< iceberg contribution to top ustar [Z s-1 ~> m s-1]. + ustar_berg => NULL(), & !< iceberg contribution to top ustar [Z T-1 ~> m s-1]. area_berg => NULL(), & !< area of ocean surface covered by icebergs [m2 m-2] mass_berg => NULL() !< mass of icebergs [kg m-2] ! land ice-shelf related inputs - real, pointer, dimension(:,:) :: ustar_shelf => NULL() !< Friction velocity under ice-shelves [Z s-1 ~> m s-1]. + real, pointer, dimension(:,:) :: ustar_shelf => NULL() !< Friction velocity under ice-shelves [Z T-1 ~> m s-1]. !! as computed by the ocean at the previous time step. real, pointer, dimension(:,:) :: frac_shelf_h => NULL() !< Fractional ice shelf coverage of !! h-cells, nondimensional from 0 to 1. This is only @@ -187,7 +187,7 @@ module MOM_forcing_type real, pointer, dimension(:,:) :: & taux => NULL(), & !< zonal wind stress [Pa] tauy => NULL(), & !< meridional wind stress [Pa] - ustar => NULL(), & !< surface friction velocity scale [Z s-1 ~> m s-1]. + ustar => NULL(), & !< surface friction velocity scale [Z T-1 ~> m s-1]. net_mass_src => NULL() !< The net mass source to the ocean [kg m-2 s-1]. ! applied surface pressure from other component models (e.g., atmos, sea ice, land ice) @@ -1013,7 +1013,7 @@ subroutine MOM_forcing_chksum(mesg, fluxes, G, US, haloshift) ! counts, there must be no redundant points, so all variables use is..ie ! and js...je as their extent. if (associated(fluxes%ustar)) & - call hchksum(fluxes%ustar, mesg//" fluxes%ustar",G%HI, haloshift=hshift, scale=US%Z_to_m) + call hchksum(fluxes%ustar, mesg//" fluxes%ustar",G%HI, haloshift=hshift, scale=US%Z_to_m*US%s_to_T) if (associated(fluxes%buoy)) & call hchksum(fluxes%buoy, mesg//" fluxes%buoy ",G%HI,haloshift=hshift) if (associated(fluxes%sw)) & @@ -1057,7 +1057,7 @@ subroutine MOM_forcing_chksum(mesg, fluxes, G, US, haloshift) if (associated(fluxes%TKE_tidal)) & call hchksum(fluxes%TKE_tidal, mesg//" fluxes%TKE_tidal",G%HI,haloshift=hshift) if (associated(fluxes%ustar_tidal)) & - call hchksum(fluxes%ustar_tidal, mesg//" fluxes%ustar_tidal",G%HI,haloshift=hshift) + call hchksum(fluxes%ustar_tidal, mesg//" fluxes%ustar_tidal",G%HI,haloshift=hshift, scale=US%Z_to_m*US%s_to_T) if (associated(fluxes%lrunoff)) & call hchksum(fluxes%lrunoff, mesg//" fluxes%lrunoff",G%HI,haloshift=hshift) if (associated(fluxes%frunoff)) & @@ -1100,7 +1100,7 @@ subroutine MOM_mech_forcing_chksum(mesg, forces, G, US, haloshift) if (associated(forces%p_surf)) & call hchksum(forces%p_surf, mesg//" forces%p_surf",G%HI,haloshift=hshift) if (associated(forces%ustar)) & - call hchksum(forces%ustar, mesg//" forces%ustar",G%HI,haloshift=hshift, scale=US%Z_to_m) + call hchksum(forces%ustar, mesg//" forces%ustar",G%HI,haloshift=hshift, scale=US%Z_to_m*US%s_to_T) if (associated(forces%rigidity_ice_u) .and. associated(forces%rigidity_ice_v)) & call uvchksum(mesg//" forces%rigidity_ice_[uv]", forces%rigidity_ice_u, & forces%rigidity_ice_v, G%HI, haloshift=hshift, symmetric=.true.) @@ -1222,12 +1222,12 @@ subroutine register_forcing_type_diags(Time, diag, US, use_temperature, handles, handles%id_ustar = register_diag_field('ocean_model', 'ustar', diag%axesT1, Time, & 'Surface friction velocity = [(gustiness + tau_magnitude)/rho0]^(1/2)', & - 'm s-1', conversion=US%Z_to_m) + 'm s-1', conversion=US%Z_to_m*US%s_to_T) if (present(use_berg_fluxes)) then if (use_berg_fluxes) then handles%id_ustar_berg = register_diag_field('ocean_model', 'ustar_berg', diag%axesT1, Time, & - 'Friction velocity below iceberg ', 'm s-1', conversion=US%Z_to_m) + 'Friction velocity below iceberg ', 'm s-1', conversion=US%Z_to_m*US%s_to_T) handles%id_area_berg = register_diag_field('ocean_model', 'area_berg', diag%axesT1, Time, & 'Area of grid cell covered by iceberg ', 'm2 m-2') @@ -1236,7 +1236,7 @@ subroutine register_forcing_type_diags(Time, diag, US, use_temperature, handles, 'Mass of icebergs ', 'kg m-2') handles%id_ustar_ice_cover = register_diag_field('ocean_model', 'ustar_ice_cover', diag%axesT1, Time, & - 'Friction velocity below iceberg and ice shelf together', 'm s-1', conversion=US%Z_to_m) + 'Friction velocity below iceberg and ice shelf together', 'm s-1', conversion=US%Z_to_m*US%s_to_T) handles%id_frac_ice_cover = register_diag_field('ocean_model', 'frac_ice_cover', diag%axesT1, Time, & 'Area of grid cell below iceberg and ice shelf together ', 'm2 m-2') @@ -2076,7 +2076,7 @@ subroutine set_derived_forcing_fields(forces, fluxes, G, US, Rho0) G%mask2dCv(i,J) * forces%tauy(i,J)**2) / & (G%mask2dCv(i,J-1) + G%mask2dCv(i,J)) - fluxes%ustar_gustless(i,j) = US%m_to_Z * sqrt(sqrt(taux2 + tauy2) / Rho0) + fluxes%ustar_gustless(i,j) = US%m_to_Z*US%T_to_s * sqrt(sqrt(taux2 + tauy2) / Rho0) !### Change to: ! fluxes%ustar_gustless(i,j) = sqrt(sqrt(taux2 + tauy2) * Irho0) enddo ; enddo diff --git a/src/ice_shelf/MOM_ice_shelf.F90 b/src/ice_shelf/MOM_ice_shelf.F90 index 07c03403ab..bc3f8323f0 100644 --- a/src/ice_shelf/MOM_ice_shelf.F90 +++ b/src/ice_shelf/MOM_ice_shelf.F90 @@ -88,7 +88,7 @@ module MOM_ice_shelf real, pointer, dimension(:,:) :: & utide => NULL() !< tidal velocity [m s-1] - real :: ustar_bg !< A minimum value for ustar under ice shelves [Z s-1 ~> m s-1]. + real :: ustar_bg !< A minimum value for ustar under ice shelves [Z T-1 ~> m s-1]. real :: cdrag !< drag coefficient under ice shelves [nondim]. real :: g_Earth !< The gravitational acceleration [m s-2] real :: Cp !< The heat capacity of sea water [J kg-1 degC-1]. @@ -363,10 +363,10 @@ subroutine shelf_calc_flux(state, fluxes, Time, time_step, CS, forces) v_at_h = state%v(i,j) !### I think that CS%utide**1 should be CS%utide**2 - fluxes%ustar_shelf(i,j) = MAX(CS%ustar_bg, US%m_to_Z * & + fluxes%ustar_shelf(i,j) = MAX(CS%ustar_bg, US%m_to_Z*US%T_to_s * & sqrt(CS%cdrag*((u_at_h**2 + v_at_h**2) + CS%utide(i,j)**1))) - ustar_h = US%Z_to_m*fluxes%ustar_shelf(i,j) + ustar_h = US%Z_to_m*US%s_to_T*fluxes%ustar_shelf(i,j) if (associated(state%taux_shelf) .and. associated(state%tauy_shelf)) then state%taux_shelf(i,j) = ustar_h*ustar_h*CS%Rho0*Isqrt2 @@ -936,7 +936,7 @@ subroutine add_shelf_flux(G, CS, state, fluxes) ! tauy2 = (asv1 * state%tauy_shelf(i,J-1)**2 + & ! asv2 * state%tauy_shelf(i,J)**2 ) / (asv1 + asv2) - !fluxes%ustar(i,j) = MAX(CS%ustar_bg, US%m_to_Z*sqrt(Irho0 * sqrt(taux2 + tauy2))) + ! fluxes%ustar(i,j) = MAX(CS%ustar_bg, US%m_to_Z*US%T_to_s*sqrt(Irho0 * sqrt(taux2 + tauy2))) ! endif ; enddo ; enddo if (CS%active_shelf_dynamics .or. CS%override_shelf_movement) then @@ -1351,7 +1351,7 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces, fl call get_param(param_file, mdl, "USTAR_SHELF_BG", CS%ustar_bg, & "The minimum value of ustar under ice sheves.", & - units="m s-1", default=0.0, scale=US%m_to_Z) + units="m s-1", default=0.0, scale=US%m_to_Z*US%T_to_s) call get_param(param_file, mdl, "CDRAG_SHELF", cdrag, & "CDRAG is the drag coefficient relating the magnitude of "//& "the velocity field to the surface stress.", units="nondim", & @@ -1362,7 +1362,7 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces, fl "DRAG_BG_VEL is either the assumed bottom velocity (with "//& "LINEAR_DRAG) or an unresolved velocity that is "//& "combined with the resolved velocity to estimate the "//& - "velocity magnitude.", units="m s-1", default=0.0, scale=US%m_to_Z) + "velocity magnitude.", units="m s-1", default=0.0, scale=US%m_to_Z*US%T_to_s) if (CS%cdrag*drag_bg_vel > 0.0) CS%ustar_bg = sqrt(CS%cdrag)*drag_bg_vel endif @@ -1575,7 +1575,7 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces, fl CS%id_tfl_shelf = register_diag_field('ocean_model', 'tflux_shelf', CS%diag%axesT1, CS%Time, & 'Heat conduction into ice shelf', 'W m-2') CS%id_ustar_shelf = register_diag_field('ocean_model', 'ustar_shelf', CS%diag%axesT1, CS%Time, & - 'Fric vel under shelf', 'm/s', conversion=US%Z_to_m) + 'Fric vel under shelf', 'm/s', conversion=US%Z_to_m*US%s_to_T) if (CS%active_shelf_dynamics) then CS%id_h_mask = register_diag_field('ocean_model', 'h_mask', CS%diag%axesT1, CS%Time, & 'ice shelf thickness mask', 'none') diff --git a/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 b/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 index f9db6eba2b..f763f562b0 100644 --- a/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 +++ b/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 @@ -344,7 +344,7 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var if (CS%debug) then call hchksum(h,'mixed_layer_restrat: h',G%HI,haloshift=1,scale=GV%H_to_m) - call hchksum(forces%ustar,'mixed_layer_restrat: u*',G%HI,haloshift=1,scale=US%Z_to_m) + call hchksum(forces%ustar,'mixed_layer_restrat: u*',G%HI,haloshift=1,scale=US%Z_to_m*US%s_to_T) call hchksum(MLD_fast,'mixed_layer_restrat: MLD',G%HI,haloshift=1,scale=GV%H_to_m) call hchksum(Rml_av_fast,'mixed_layer_restrat: rml',G%HI,haloshift=1, scale=US%m_to_Z) endif @@ -356,7 +356,7 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var ! U - Component !$OMP do do j=js,je ; do I=is-1,ie - u_star = 0.5*(forces%ustar(i,j) + forces%ustar(i+1,j)) + u_star = US%s_to_T*0.5*(forces%ustar(i,j) + forces%ustar(i+1,j)) absf = 0.5*US%s_to_T*(abs(G%CoriolisBu(I,J-1)) + abs(G%CoriolisBu(I,J))) ! If needed, res_scaling_fac = min( ds, L_d ) / l_f if (res_upscale) res_scaling_fac = & @@ -432,7 +432,7 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var ! V- component !$OMP do do J=js-1,je ; do i=is,ie - u_star = 0.5*(forces%ustar(i,j) + forces%ustar(i,j+1)) + u_star = US%s_to_T*0.5*(forces%ustar(i,j) + forces%ustar(i,j+1)) absf = 0.5*US%s_to_T*(abs(G%CoriolisBu(I-1,J)) + abs(G%CoriolisBu(I,J))) ! If needed, res_scaling_fac = min( ds, L_d ) / l_f if (res_upscale) res_scaling_fac = & @@ -653,7 +653,7 @@ subroutine mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, dt, G, GV, US, CS) do j=js,je; do I=is-1,ie h_vel = 0.5*(htot(i,j) + htot(i+1,j)) * GV%H_to_Z - u_star = 0.5*(forces%ustar(i,j) + forces%ustar(i+1,j)) + u_star = US%s_to_T*0.5*(forces%ustar(i,j) + forces%ustar(i+1,j)) absf = 0.5*US%s_to_T*(abs(G%CoriolisBu(I,J-1)) + abs(G%CoriolisBu(I,J))) ! peak ML visc: u_star * 0.41 * (h_ml*u_star)/(absf*h_ml + 4.0*u_star) ! momentum mixing rate: pi^2*visc/h_ml^2 @@ -700,7 +700,7 @@ subroutine mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, dt, G, GV, US, CS) do J=js-1,je ; do i=is,ie h_vel = 0.5*(htot(i,j) + htot(i,j+1)) * GV%H_to_Z - u_star = 0.5*(forces%ustar(i,j) + forces%ustar(i,j+1)) + u_star = US%s_to_T*0.5*(forces%ustar(i,j) + forces%ustar(i,j+1)) absf = 0.5*US%s_to_T*(abs(G%CoriolisBu(I-1,J)) + abs(G%CoriolisBu(I,J))) ! peak ML visc: u_star * 0.41 * (h_ml*u_star)/(absf*h_ml + 4.0*u_star) ! momentum mixing rate: pi^2*visc/h_ml^2 diff --git a/src/parameterizations/vertical/MOM_CVMix_KPP.F90 b/src/parameterizations/vertical/MOM_CVMix_KPP.F90 index de37720a6a..cfb0f37f86 100644 --- a/src/parameterizations/vertical/MOM_CVMix_KPP.F90 +++ b/src/parameterizations/vertical/MOM_CVMix_KPP.F90 @@ -489,7 +489,7 @@ logical function KPP_init(paramFile, G, GV, US, diag, Time, CS, passive, Waves) CS%id_Vt2 = register_diag_field('ocean_model', 'KPP_Vt2', diag%axesTL, Time, & 'Unresolved shear turbulence used by [CVMix] KPP', 'm2/s2') CS%id_uStar = register_diag_field('ocean_model', 'KPP_uStar', diag%axesT1, Time, & - 'Friction velocity, u*, as used by [CVMix] KPP', 'm/s', conversion=US%Z_to_m) + 'Friction velocity, u*, as used by [CVMix] KPP', 'm/s', conversion=US%Z_to_m*US%s_to_T) CS%id_buoyFlux = register_diag_field('ocean_model', 'KPP_buoyFlux', diag%axesTi, Time, & 'Surface (and penetrating) buoyancy flux, as used by [CVMix] KPP', 'm2/s3') CS%id_QminusSW = register_diag_field('ocean_model', 'KPP_QminusSW', diag%axesT1, Time, & @@ -590,7 +590,7 @@ subroutine KPP_calculate(CS, G, GV, US, h, uStar, & type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(wave_parameters_CS), optional, pointer :: Waves !< Wave CS real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer/level thicknesses [H ~> m or kg m-2] - real, dimension(SZI_(G),SZJ_(G)), intent(in) :: uStar !< Surface friction velocity [Z s-1 ~> m s-1] + real, dimension(SZI_(G),SZJ_(G)), intent(in) :: uStar !< Surface friction velocity [Z T-1 ~> m s-1] real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(in) :: buoyFlux !< Surface buoyancy flux [m2 s-3] real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(inout) :: Kt !< (in) Vertical diffusivity of heat w/o KPP !! (out) Vertical diffusivity including KPP @@ -624,7 +624,7 @@ subroutine KPP_calculate(CS, G, GV, US, h, uStar, & #ifdef __DO_SAFETY_CHECKS__ if (CS%debug) then call hchksum(h, "KPP in: h",G%HI,haloshift=0, scale=GV%H_to_m) - call hchksum(uStar, "KPP in: uStar",G%HI,haloshift=0, scale=US%Z_to_m) + call hchksum(uStar, "KPP in: uStar",G%HI,haloshift=0, scale=US%Z_to_m*US%s_to_T) call hchksum(buoyFlux, "KPP in: buoyFlux",G%HI,haloshift=0) call hchksum(Kt, "KPP in: Kt",G%HI,haloshift=0, scale=US%Z2_T_to_m2_s) call hchksum(Ks, "KPP in: Ks",G%HI,haloshift=0, scale=US%Z2_T_to_m2_s) @@ -644,7 +644,7 @@ subroutine KPP_calculate(CS, G, GV, US, h, uStar, & if (G%mask2dT(i,j)==0.) cycle ! things independent of position within the column - surfFricVel = US%Z_to_m * uStar(i,j) + surfFricVel = US%Z_to_m*US%s_to_T * uStar(i,j) iFaceHeight(1) = 0.0 ! BBL is all relative to the surface hcorr = 0. @@ -888,7 +888,7 @@ subroutine KPP_compute_BLD(CS, G, GV, US, h, Temp, Salt, u, v, EOS, uStar, buoyF real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: u !< Velocity i-component [m s-1] real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: v !< Velocity j-component [m s-1] type(EOS_type), pointer :: EOS !< Equation of state - real, dimension(SZI_(G),SZJ_(G)), intent(in) :: uStar !< Surface friction velocity [Z s-1 ~> m s-1] + real, dimension(SZI_(G),SZJ_(G)), intent(in) :: uStar !< Surface friction velocity [Z T-1 ~> m s-1] real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(in) :: buoyFlux !< Surface buoyancy flux [m2 s-3] type(wave_parameters_CS), optional, pointer :: Waves !< Wave CS @@ -964,7 +964,7 @@ subroutine KPP_compute_BLD(CS, G, GV, US, h, Temp, Salt, u, v, EOS, uStar, buoyF ! things independent of position within the column Coriolis = 0.25*US%s_to_T*( (G%CoriolisBu(i,j) + G%CoriolisBu(i-1,j-1)) + & (G%CoriolisBu(i-1,j) + G%CoriolisBu(i,j-1)) ) - surfFricVel = US%Z_to_m * uStar(i,j) + surfFricVel = US%Z_to_m*US%s_to_T * uStar(i,j) ! Bullk Richardson number computed for each cell in a column, ! assuming OBLdepth = grid cell depth. After Rib(k) is @@ -1073,8 +1073,8 @@ subroutine KPP_compute_BLD(CS, G, GV, US, h, Temp, Salt, u, v, EOS, uStar, buoyF if (CS%LT_K_ENHANCEMENT .or. CS%LT_VT2_ENHANCEMENT) then MLD_GUESS = max( 1.*US%m_to_Z, abs(US%m_to_Z*CS%OBLdepthprev(i,j) ) ) - call get_Langmuir_Number( LA, G, GV, US, MLD_guess, US%s_to_T*uStar(i,j), i, j, & - H=H(i,j,:), U_H=U_H, V_H=V_H, WAVES=WAVES) + call get_Langmuir_Number(LA, G, GV, US, MLD_guess, uStar(i,j), i, j, & + H=H(i,j,:), U_H=U_H, V_H=V_H, WAVES=WAVES) CS%La_SL(i,j)=LA endif diff --git a/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 b/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 index d7102fc472..725a6dc7e3 100644 --- a/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 +++ b/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 @@ -673,12 +673,12 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt_in_T, ea, eb, G, GV, ! as the third piece will then optimally describe mixed layer ! restratification. For nkml>=4 the whole strategy should be revisited. do i=is,ie - kU_star = 0.41*US%T_to_s*fluxes%ustar(i,j) ! Maybe could be replaced with u*+w*? + kU_star = 0.41*fluxes%ustar(i,j) ! Maybe could be replaced with u*+w*? if (associated(fluxes%ustar_shelf) .and. & associated(fluxes%frac_shelf_h)) then if (fluxes%frac_shelf_h(i,j) > 0.0) & kU_star = (1.0 - fluxes%frac_shelf_h(i,j)) * kU_star + & - fluxes%frac_shelf_h(i,j) * (0.41*US%T_to_s*fluxes%ustar_shelf(i,j)) + fluxes%frac_shelf_h(i,j) * (0.41*fluxes%ustar_shelf(i,j)) endif absf_x_H = 0.25 * GV%H_to_Z * h(i,0) * & ((abs(G%CoriolisBu(I,J)) + abs(G%CoriolisBu(I-1,J-1))) + & @@ -1378,11 +1378,11 @@ subroutine find_starting_TKE(htot, h_CA, fluxes, Conv_En, cTKE, dKE_FC, dKE_CA, if (CS%omega_frac >= 1.0) absf = 2.0*CS%omega do i=is,ie - U_star = US%T_to_s*fluxes%ustar(i,j) + U_star = fluxes%ustar(i,j) if (associated(fluxes%ustar_shelf) .and. associated(fluxes%frac_shelf_h)) then if (fluxes%frac_shelf_h(i,j) > 0.0) & U_star = (1.0 - fluxes%frac_shelf_h(i,j)) * U_star + & - fluxes%frac_shelf_h(i,j) * US%T_to_s*fluxes%ustar_shelf(i,j) + fluxes%frac_shelf_h(i,j) * fluxes%ustar_shelf(i,j) endif if (U_star < CS%ustar_min) U_star = CS%ustar_min diff --git a/src/parameterizations/vertical/MOM_energetic_PBL.F90 b/src/parameterizations/vertical/MOM_energetic_PBL.F90 index 4104d7d37a..352ac24011 100644 --- a/src/parameterizations/vertical/MOM_energetic_PBL.F90 +++ b/src/parameterizations/vertical/MOM_energetic_PBL.F90 @@ -428,13 +428,13 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS do K=1,nz+1 ; Kd(K) = 0.0 ; enddo ! Make local copies of surface forcing and process them. - u_star = US%T_to_s*fluxes%ustar(i,j) - u_star_Mean = US%T_to_s*fluxes%ustar_gustless(i,j) + u_star = fluxes%ustar(i,j) + u_star_Mean = fluxes%ustar_gustless(i,j) B_flux = buoy_flux(i,j) if (associated(fluxes%ustar_shelf) .and. associated(fluxes%frac_shelf_h)) then if (fluxes%frac_shelf_h(i,j) > 0.0) & u_star = (1.0 - fluxes%frac_shelf_h(i,j)) * u_star + & - fluxes%frac_shelf_h(i,j) * US%T_to_s*fluxes%ustar_shelf(i,j) + fluxes%frac_shelf_h(i,j) * fluxes%ustar_shelf(i,j) endif if (u_star < CS%ustar_min) u_star = CS%ustar_min if (CS%omega_frac >= 1.0) then diff --git a/src/parameterizations/vertical/MOM_set_diffusivity.F90 b/src/parameterizations/vertical/MOM_set_diffusivity.F90 index 66f4f75ff0..13be524570 100644 --- a/src/parameterizations/vertical/MOM_set_diffusivity.F90 +++ b/src/parameterizations/vertical/MOM_set_diffusivity.F90 @@ -1182,7 +1182,7 @@ subroutine add_drag_diffusivity(h, u, v, tv, fluxes, visc, j, TKE_to_Kd, & do i=is,ie ustar_h = visc%ustar_BBL(i,j) if (associated(fluxes%ustar_tidal)) & - ustar_h = ustar_h + (US%m_to_Z * US%T_to_s * fluxes%ustar_tidal(i,j)) + ustar_h = ustar_h + fluxes%ustar_tidal(i,j) absf = 0.25 * ((abs(G%CoriolisBu(I-1,J-1)) + abs(G%CoriolisBu(I,J))) + & (abs(G%CoriolisBu(I-1,J)) + abs(G%CoriolisBu(I,J-1)))) if ((ustar_h > 0.0) .and. (absf > 0.5*CS%IMax_decay*ustar_h)) then @@ -1396,12 +1396,13 @@ subroutine add_LOTW_BBL_diffusivity(h, u, v, tv, fluxes, visc, j, N2_int, & absf = 0.25 * ((abs(G%CoriolisBu(I-1,J-1)) + abs(G%CoriolisBu(I,J))) + & (abs(G%CoriolisBu(I-1,J)) + abs(G%CoriolisBu(I,J-1)))) ! Non-zero on equator! - ! u* at the bottom [m s-1]. + ! u* at the bottom [Z T-1 ~> m s-1]. ustar = visc%ustar_BBL(i,j) ustar2 = ustar**2 ! In add_drag_diffusivity(), fluxes%ustar_tidal is added in. This might be double counting ! since ustar_BBL should already include all contributions to u*? -AJA - if (associated(fluxes%ustar_tidal)) ustar = ustar + (US%m_to_Z * US%T_to_s * fluxes%ustar_tidal(i,j)) + !### Examine this question of whether there is double counting of fluxes%ustar_tidal. + if (associated(fluxes%ustar_tidal)) ustar = ustar + fluxes%ustar_tidal(i,j) ! The maximum decay scale should be something of order 200 m. We use the smaller of u*/f and ! (IMax_decay)^-1 as the decay scale. If ustar = 0, this is land so this value doesn't matter. @@ -1551,9 +1552,9 @@ subroutine add_MLrad_diffusivity(h, fluxes, j, G, GV, US, CS, Kd_lay, TKE_to_Kd, f_sq = CS%ML_omega_frac * 4.0 * Omega2 + (1.0 - CS%ML_omega_frac) * f_sq endif - ustar_sq = max(US%T_to_s * fluxes%ustar(i,j), CS%ustar_min)**2 + ustar_sq = max(fluxes%ustar(i,j), CS%ustar_min)**2 - TKE_ml_flux(i) = (CS%mstar * CS%ML_rad_coeff) * (ustar_sq * (US%T_to_s * fluxes%ustar(i,j))) + TKE_ml_flux(i) = (CS%mstar * CS%ML_rad_coeff) * (ustar_sq * (fluxes%ustar(i,j))) I_decay_len2_TKE = CS%TKE_decay**2 * (f_sq / ustar_sq) if (CS%ML_rad_TKE_decay) & diff --git a/src/parameterizations/vertical/MOM_set_viscosity.F90 b/src/parameterizations/vertical/MOM_set_viscosity.F90 index d9a5af6137..aed9993930 100644 --- a/src/parameterizations/vertical/MOM_set_viscosity.F90 +++ b/src/parameterizations/vertical/MOM_set_viscosity.F90 @@ -1211,7 +1211,7 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS, symmetri if (CS%omega_frac > 0.0) & absf = sqrt(CS%omega_frac*4.0*CS%omega**2 + (1.0-CS%omega_frac)*absf**2) endif - U_star = max(CS%ustar_min, 0.5 * US%T_to_s*(forces%ustar(i,j) + forces%ustar(i+1,j))) + U_star = max(CS%ustar_min, 0.5 * (forces%ustar(i,j) + forces%ustar(i+1,j))) Idecay_len_TKE(I) = ((absf / U_star) * CS%TKE_decay) * GV%H_to_Z endif enddo @@ -1447,7 +1447,7 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS, symmetri absf = sqrt(CS%omega_frac*4.0*CS%omega**2 + (1.0-CS%omega_frac)*absf**2) endif - U_star = max(CS%ustar_min, 0.5 * US%T_to_s*(forces%ustar(i,j) + forces%ustar(i,j+1))) + U_star = max(CS%ustar_min, 0.5 * (forces%ustar(i,j) + forces%ustar(i,j+1))) Idecay_len_TKE(i) = ((absf / U_star) * CS%TKE_decay) * GV%H_to_Z endif diff --git a/src/parameterizations/vertical/MOM_vert_friction.F90 b/src/parameterizations/vertical/MOM_vert_friction.F90 index 9d74bcdb3d..82456b0e58 100644 --- a/src/parameterizations/vertical/MOM_vert_friction.F90 +++ b/src/parameterizations/vertical/MOM_vert_friction.F90 @@ -1297,11 +1297,11 @@ subroutine find_coupling_coef(a_cpl, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, do i=is,ie ; if (do_i(i)) then if (GV%nkml>0) nk_visc(i) = real(GV%nkml+1) if (work_on_u) then - u_star(I) = US%T_to_s*0.5*(forces%ustar(i,j) + forces%ustar(i+1,j)) + u_star(I) = 0.5*(forces%ustar(i,j) + forces%ustar(i+1,j)) absf(I) = 0.5*(abs(G%CoriolisBu(I,J-1)) + abs(G%CoriolisBu(I,J))) if (CS%dynamic_viscous_ML) nk_visc(I) = visc%nkml_visc_u(I,j) + 1 else - u_star(i) = US%T_to_s*0.5*(forces%ustar(i,j) + forces%ustar(i,j+1)) + u_star(i) = 0.5*(forces%ustar(i,j) + forces%ustar(i,j+1)) absf(i) = 0.5*(abs(G%CoriolisBu(I-1,J)) + abs(G%CoriolisBu(I,J))) if (CS%dynamic_viscous_ML) nk_visc(i) = visc%nkml_visc_v(i,J) + 1 endif @@ -1312,16 +1312,16 @@ subroutine find_coupling_coef(a_cpl, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, if (do_OBCS) then ; if (work_on_u) then do I=is,ie ; if (do_i(I) .and. (OBC%segnum_u(I,j) /= OBC_NONE)) then if (OBC%segment(OBC%segnum_u(I,j))%direction == OBC_DIRECTION_E) & - u_star(I) = US%T_to_s*forces%ustar(i,j) + u_star(I) = forces%ustar(i,j) if (OBC%segment(OBC%segnum_u(I,j))%direction == OBC_DIRECTION_W) & - u_star(I) = US%T_to_s*forces%ustar(i+1,j) + u_star(I) = forces%ustar(i+1,j) endif ; enddo else do i=is,ie ; if (do_i(i) .and. (OBC%segnum_v(i,J) /= OBC_NONE)) then if (OBC%segment(OBC%segnum_v(i,J))%direction == OBC_DIRECTION_N) & - u_star(i) = US%T_to_s*forces%ustar(i,j) + u_star(i) = forces%ustar(i,j) if (OBC%segment(OBC%segnum_v(i,J))%direction == OBC_DIRECTION_S) & - u_star(i) = US%T_to_s*forces%ustar(i,j+1) + u_star(i) = forces%ustar(i,j+1) endif ; enddo endif ; endif diff --git a/src/user/Idealized_Hurricane.F90 b/src/user/Idealized_Hurricane.F90 index e76fc1dc5d..730551ccdb 100644 --- a/src/user/Idealized_Hurricane.F90 +++ b/src/user/Idealized_Hurricane.F90 @@ -300,7 +300,7 @@ subroutine idealized_hurricane_wind_forcing(state, forces, day, G, US, CS) do j=js,je do i=is,ie ! This expression can be changed if desired, but need not be. - forces%ustar(i,j) = US%m_to_Z * G%mask2dT(i,j) * sqrt(CS%gustiness/CS%Rho0 + & + forces%ustar(i,j) = US%m_to_Z*US%T_to_s * G%mask2dT(i,j) * sqrt(CS%gustiness/CS%Rho0 + & sqrt(0.5*(forces%taux(I-1,j)**2 + forces%taux(I,j)**2) + & 0.5*(forces%tauy(i,J-1)**2 + forces%tauy(i,J)**2))/CS%Rho0) enddo @@ -602,7 +602,7 @@ subroutine SCM_idealized_hurricane_wind_forcing(state, forces, day, G, US, CS) ! Set the surface friction velocity [m s-1]. ustar is always positive. do j=js,je ; do i=is,ie ! This expression can be changed if desired, but need not be. - forces%ustar(i,j) = US%m_to_Z * G%mask2dT(i,j) * sqrt(CS%gustiness/CS%Rho0 + & + forces%ustar(i,j) = US%m_to_Z*US%T_to_s * G%mask2dT(i,j) * sqrt(CS%gustiness/CS%Rho0 + & sqrt(0.5*(forces%taux(I-1,j)**2 + forces%taux(I,j)**2) + & 0.5*(forces%tauy(i,J-1)**2 + forces%tauy(i,J)**2))/CS%Rho0) enddo ; enddo diff --git a/src/user/MOM_wave_interface.F90 b/src/user/MOM_wave_interface.F90 index 781a32f19c..49db064c40 100644 --- a/src/user/MOM_wave_interface.F90 +++ b/src/user/MOM_wave_interface.F90 @@ -483,7 +483,7 @@ subroutine Update_Stokes_Drift(G, GV, US, CS, h, ustar) real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(in) :: h !< Thickness [H ~> m or kg m-2] real, dimension(SZI_(G),SZJ_(G)), & - intent(in) :: ustar !< Wind friction velocity [Z s-1 ~> m s-1]. + intent(in) :: ustar !< Wind friction velocity [Z T-1 ~> m s-1]. ! Local Variables real :: Top, MidPoint, Bottom, one_cm real :: DecayScale @@ -683,7 +683,7 @@ subroutine Update_Stokes_Drift(G, GV, US, CS, h, ustar) do ii = G%isc,G%iec do jj = G%jsc, G%jec Top = h(ii,jj,1)*GV%H_to_Z - call get_Langmuir_Number( La, G, GV, US, Top, US%T_to_s*ustar(ii,jj), ii, jj, & + call get_Langmuir_Number( La, G, GV, US, Top, ustar(ii,jj), ii, jj, & H(ii,jj,:),Override_MA=.false.,WAVES=CS) CS%La_turb(ii,jj) = La enddo @@ -700,7 +700,7 @@ subroutine Update_Stokes_Drift(G, GV, US, CS, h, ustar) call post_data(CS%id_3dstokes_x, CS%us_x, CS%diag) if (CS%id_La_turb>0) & call post_data(CS%id_La_turb, CS%La_turb, CS%diag) - return + end subroutine Update_Stokes_Drift !> A subroutine to fill the Stokes drift from a NetCDF file diff --git a/src/user/SCM_CVMix_tests.F90 b/src/user/SCM_CVMix_tests.F90 index e24db1bcda..48c4dc229d 100644 --- a/src/user/SCM_CVMix_tests.F90 +++ b/src/user/SCM_CVMix_tests.F90 @@ -218,7 +218,7 @@ subroutine SCM_CVMix_tests_wind_forcing(state, forces, day, G, US, CS) mag_tau = sqrt(CS%tau_x*CS%tau_x + CS%tau_y*CS%tau_y) if (associated(forces%ustar)) then ; do j=js,je ; do i=is,ie - forces%ustar(i,j) = US%m_to_Z * sqrt( mag_tau / CS%Rho0 ) + forces%ustar(i,j) = US%m_to_Z*US%T_to_s * sqrt( mag_tau / CS%Rho0 ) enddo ; enddo ; endif end subroutine SCM_CVMix_tests_wind_forcing From cca8046897a16799c0b96d7118ac418d8de04ea4 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Mon, 8 Jul 2019 17:52:35 -0400 Subject: [PATCH 77/82] Add g_Earth to all versions of surface_forcing_CS Use an unscaled g_Earth from the control structures for the various MOM_surface_forcing modules when USE_RIGID_SEA_ICE is True, rather than assuming that the version of g_Earth in the lateral grid has not been scaled. All answers are bitwise identical, and the MOM_parameter_doc files are unchanged because other modules read G_EARTH before MOM_surface forcing. --- .../coupled_driver/MOM_surface_forcing.F90 | 14 ++++++----- config_src/mct_driver/MOM_surface_forcing.F90 | 24 +++++++++++-------- .../nuopc_driver/MOM_surface_forcing.F90 | 12 ++++++---- 3 files changed, 30 insertions(+), 20 deletions(-) diff --git a/config_src/coupled_driver/MOM_surface_forcing.F90 b/config_src/coupled_driver/MOM_surface_forcing.F90 index af7af37985..f48b755d67 100644 --- a/config_src/coupled_driver/MOM_surface_forcing.F90 +++ b/config_src/coupled_driver/MOM_surface_forcing.F90 @@ -101,8 +101,9 @@ module MOM_surface_forcing logical :: rigid_sea_ice !< If true, sea-ice exerts a rigidity that acts to damp surface !! deflections (especially surface gravity waves). The default is false. + real :: G_Earth !< Gravitational acceleration [m s-2] real :: Kv_sea_ice !< Viscosity in sea-ice that resists sheared vertical motions [m2 s-1] - real :: density_sea_ice !< Typical density of sea-ice (kg/m^3). The value is only used to convert + real :: density_sea_ice !< Typical density of sea-ice [kg m-3]. The value is only used to convert !! the ice pressure into appropriate units for use with Kv_sea_ice. real :: rigid_sea_ice_mass !< A mass per unit area of sea-ice beyond which sea-ice viscosity !! becomes effective [kg m-2], typically of order 1000 kg m-2. @@ -588,7 +589,7 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, US, CS, dt_ net_mass_src, & ! A temporary of net mass sources [kg m-2 s-1]. ustar_tmp ! A temporary array of ustar values [Z T-1 ~> m s-1]. - real :: I_GEarth ! 1.0 / G%G_Earth [s2 m-1] + real :: I_GEarth ! 1.0 / G_Earth [s2 m-1] real :: Kv_rho_ice ! (CS%kv_sea_ice / CS%density_sea_ice) [m5 s-1 kg-1] real :: mass_ice ! mass of sea ice at a face [kg m-2] real :: mass_eff ! effective mass of sea ice for rigidity [kg m-2] @@ -752,7 +753,7 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, US, CS, dt_ if (CS%rigid_sea_ice) then call pass_var(forces%p_surf_full, G%Domain, halo=1) - I_GEarth = 1.0 / G%G_Earth + I_GEarth = 1.0 / CS%G_Earth Kv_rho_ice = (CS%kv_sea_ice / CS%density_sea_ice) do I=is-1,ie ; do j=js,je mass_ice = min(forces%p_surf_full(i,j), forces%p_surf_full(i+1,j)) * I_GEarth @@ -1375,9 +1376,7 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS) call time_interp_external_init -! Optionally read a x-y gustiness field in place of a global -! constant. - + ! Optionally read a x-y gustiness field in place of a global constant. call get_param(param_file, mdl, "READ_GUST_2D", CS%read_gust_2d, & "If true, use a 2-dimensional gustiness supplied from "//& "an input file", default=.false.) @@ -1400,6 +1399,9 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS) "nonhydrostatic pressure that resist vertical motion.", & default=.false.) if (CS%rigid_sea_ice) then + call get_param(param_file, mdl, "G_EARTH", CS%g_Earth, & + "The gravitational acceleration of the Earth.", & + units="m s-2", default = 9.80) call get_param(param_file, mdl, "SEA_ICE_MEAN_DENSITY", CS%density_sea_ice, & "A typical density of sea ice, used with the kinematic "//& "viscosity, when USE_RIGID_SEA_ICE is true.", units="kg m-3", & diff --git a/config_src/mct_driver/MOM_surface_forcing.F90 b/config_src/mct_driver/MOM_surface_forcing.F90 index 6176b83602..252477b2b5 100644 --- a/config_src/mct_driver/MOM_surface_forcing.F90 +++ b/config_src/mct_driver/MOM_surface_forcing.F90 @@ -70,13 +70,13 @@ module MOM_surface_forcing real :: wind_stress_multiplier!< A multiplier applied to incoming wind stress (nondim). ! smg: remove when have A=B code reconciled logical :: bulkmixedlayer !< If true, model based on bulk mixed layer code - real :: Rho0 !< Boussinesq reference density (kg/m^3) - real :: area_surf = -1.0 !< total ocean surface area (m^2) - real :: latent_heat_fusion ! latent heat of fusion (J/kg) - real :: latent_heat_vapor ! latent heat of vaporization (J/kg) + real :: Rho0 !< Boussinesq reference density [kg m-3] + real :: area_surf = -1.0 !< Total ocean surface area [m2] + real :: latent_heat_fusion !< Latent heat of fusion [J kg-1] + real :: latent_heat_vapor !< Latent heat of vaporization [J kg-1] real :: max_p_surf !< maximum surface pressure that can be !! exerted by the atmosphere and floating sea-ice, - !! in Pa. This is needed because the FMS coupling + !! [Pa]. This is needed because the FMS coupling !! structure does not limit the water that can be !! frozen out of the ocean and the ice-ocean heat !! fluxes are treated explicitly. @@ -84,7 +84,7 @@ module MOM_surface_forcing !! the correction for the atmospheric (and sea-ice) !! pressure limited by max_p_surf instead of the !! full atmospheric pressure. The default is true. - real :: gust_const !< constant unresolved background gustiness for ustar (Pa) + real :: gust_const !< constant unresolved background gustiness for ustar [Pa] logical :: read_gust_2d !< If true, use a 2-dimensional gustiness supplied !! from an input file. real, pointer, dimension(:,:) :: & @@ -102,8 +102,9 @@ module MOM_surface_forcing logical :: rigid_sea_ice !< If true, sea-ice exerts a rigidity that acts !! to damp surface deflections (especially surface !! gravity waves). The default is false. - real :: Kv_sea_ice !< viscosity in sea-ice that resists sheared vertical motions (m^2/s) - real :: density_sea_ice !< typical density of sea-ice (kg/m^3). The value is + real :: G_Earth !< Gravitational acceleration [m s-2] + real :: Kv_sea_ice !< viscosity in sea-ice that resists sheared vertical motions [m2 s-1] + real :: density_sea_ice !< typical density of sea-ice [kg m-3]. The value is !! only used to convert the ice pressure into !! appropriate units for use with Kv_sea_ice. real :: rigid_sea_ice_mass !< A mass per unit area of sea-ice beyond which @@ -576,7 +577,7 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, US, CS) real :: Irho0 ! inverse of the mean density in (m^3/kg) real :: taux2, tauy2 ! squared wind stresses (Pa^2) real :: tau_mag ! magnitude of the wind stress (Pa) - real :: I_GEarth ! 1.0 / G%G_Earth (s^2/m) + real :: I_GEarth ! 1.0 / G_Earth [s2 m-1] real :: Kv_rho_ice ! (CS%kv_sea_ice / CS%density_sea_ice) ( m^5/(s*kg) ) real :: mass_ice ! mass of sea ice at a face (kg/m^2) real :: mass_eff ! effective mass of sea ice for rigidity (kg/m^2) @@ -762,7 +763,7 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, US, CS) ! sea ice related dynamic fields if (CS%rigid_sea_ice) then call pass_var(forces%p_surf_full, G%Domain, halo=1) - I_GEarth = 1.0 / G%G_Earth + I_GEarth = 1.0 / CS%G_Earth Kv_rho_ice = (CS%kv_sea_ice / CS%density_sea_ice) do I=is-1,ie ; do j=js,je mass_ice = min(forces%p_surf_full(i,j), forces%p_surf_full(i+1,j)) * I_GEarth @@ -1260,6 +1261,9 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, restore_salt, "nonhydrostatic pressure that resist vertical motion.", & default=.false.) if (CS%rigid_sea_ice) then + call get_param(param_file, mdl, "G_EARTH", CS%g_Earth, & + "The gravitational acceleration of the Earth.", & + units="m s-2", default = 9.80) call get_param(param_file, mdl, "SEA_ICE_MEAN_DENSITY", CS%density_sea_ice, & "A typical density of sea ice, used with the kinematic "//& "viscosity, when USE_RIGID_SEA_ICE is true.", units="kg m-3", & diff --git a/config_src/nuopc_driver/MOM_surface_forcing.F90 b/config_src/nuopc_driver/MOM_surface_forcing.F90 index e96399e2d8..5990aec2e0 100644 --- a/config_src/nuopc_driver/MOM_surface_forcing.F90 +++ b/config_src/nuopc_driver/MOM_surface_forcing.F90 @@ -101,8 +101,9 @@ module MOM_surface_forcing logical :: rigid_sea_ice !< If true, sea-ice exerts a rigidity that acts !! to damp surface deflections (especially surface !! gravity waves). The default is false. - real :: Kv_sea_ice !! viscosity in sea-ice that resists sheared vertical motions [m^2/s] - real :: density_sea_ice !< typical density of sea-ice [kg/m^3]. The value is + real :: G_Earth !< Gravitational acceleration [m s-2] + real :: Kv_sea_ice !! viscosity in sea-ice that resists sheared vertical motions [m2 s-1] + real :: density_sea_ice !< typical density of sea-ice [kg m-3]. The value is !! only used to convert the ice pressure into !! appropriate units for use with Kv_sea_ice. real :: rigid_sea_ice_mass !< A mass per unit area of sea-ice beyond which @@ -618,7 +619,7 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, US, CS) real :: Irho0 !< inverse of the mean density in (m^3/kg) real :: taux2, tauy2 !< squared wind stresses (Pa^2) real :: tau_mag !< magnitude of the wind stress [Pa] - real :: I_GEarth !< 1.0 / G%G_Earth (s^2/m) + real :: I_GEarth !< 1.0 / G_Earth [s2 m-1] real :: Kv_rho_ice !< (CS%kv_sea_ice / CS%density_sea_ice) ( m^5/(s*kg) ) real :: mass_ice !< mass of sea ice at a face (kg/m^2) real :: mass_eff !< effective mass of sea ice for rigidity (kg/m^2) @@ -840,7 +841,7 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, US, CS) if (CS%rigid_sea_ice) then call pass_var(forces%p_surf_full, G%Domain, halo=1) - I_GEarth = 1.0 / G%G_Earth + I_GEarth = 1.0 / CS%g_Earth Kv_rho_ice = (CS%kv_sea_ice / CS%density_sea_ice) do I=is-1,ie ; do j=js,je mass_ice = min(forces%p_surf_full(i,j), forces%p_surf_full(i+1,j)) * I_GEarth @@ -1258,6 +1259,9 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, restore_salt, "nonhydrostatic pressure that resist vertical motion.", & default=.false.) if (CS%rigid_sea_ice) then + call get_param(param_file, mdl, "G_EARTH", CS%g_Earth, & + "The gravitational acceleration of the Earth.", & + units="m s-2", default = 9.80) call get_param(param_file, mdl, "SEA_ICE_MEAN_DENSITY", CS%density_sea_ice, & "A typical density of sea ice, used with the kinematic "//& "viscosity, when USE_RIGID_SEA_ICE is true.", units="kg m-3", & From f258630a549031595e2357e88cde7ae221ce76c2 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 9 Jul 2019 11:48:33 -0400 Subject: [PATCH 78/82] +Rescaled units of g_Earth in vertical params code Rescaled units of g_Earth in the parameterizations/vertical code for improved dimensional consistency testing. Also added an unscaled version of g_Earth and a fully scaled version in the verticalGridtype. All answers are bitwise identical and are passing the dimensional consistency testing for time and length units. --- src/core/MOM.F90 | 8 +++---- src/core/MOM_verticalGrid.F90 | 9 +++++--- src/diagnostics/MOM_diagnostics.F90 | 2 +- .../MOM_coord_initialization.F90 | 16 +++++++------- .../vertical/MOM_CVMix_KPP.F90 | 5 +++-- .../vertical/MOM_CVMix_conv.F90 | 5 +++-- .../vertical/MOM_CVMix_shear.F90 | 6 +++--- .../vertical/MOM_bulk_mixed_layer.F90 | 16 +++++++------- .../vertical/MOM_diabatic_aux.F90 | 20 +++++++++--------- .../vertical/MOM_diabatic_driver.F90 | 2 +- .../vertical/MOM_diapyc_energy_req.F90 | 10 ++++----- .../vertical/MOM_energetic_PBL.F90 | 2 +- .../vertical/MOM_entrain_diffusive.F90 | 3 ++- .../vertical/MOM_internal_tide_input.F90 | 16 +++++++------- .../vertical/MOM_kappa_shear.F90 | 6 ++++-- .../vertical/MOM_opacity.F90 | 4 ++-- .../vertical/MOM_set_diffusivity.F90 | 21 ++++++++++--------- .../vertical/MOM_set_viscosity.F90 | 7 ++++--- src/user/MOM_wave_interface.F90 | 12 +++++------ 19 files changed, 90 insertions(+), 80 deletions(-) diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index de8d79c152..dd521b8eef 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -1949,7 +1949,7 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & call verticalGridInit( param_file, CS%GV, US ) GV => CS%GV -! dG%g_Earth = (GV%g_Earth*US%m_to_Z) +! dG%g_Earth = GV%mks_g_Earth ! Allocate the auxiliary non-symmetric domain for debugging or I/O purposes. if (CS%debug .or. dG%symmetric) & @@ -2145,7 +2145,7 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & else ; G%Domain_aux => G%Domain ; endif ! Copy common variables from the vertical grid to the horizontal grid. ! Consider removing this later? - G%ke = GV%ke ; G%g_Earth = (GV%g_Earth*US%m_to_Z) + G%ke = GV%ke ; G%g_Earth = GV%mks_g_Earth call MOM_initialize_state(CS%u, CS%v, CS%h, CS%tv, Time, G, GV, US, param_file, & dirs, restart_CSp, CS%ALE_CSp, CS%tracer_Reg, & @@ -2174,7 +2174,7 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & if (CS%debug .or. CS%G%symmetric) then call clone_MOM_domain(CS%G%Domain, CS%G%Domain_aux, symmetric=.false.) else ; CS%G%Domain_aux => CS%G%Domain ;endif - G%ke = GV%ke ; G%g_Earth = (GV%g_Earth*US%m_to_Z) + G%ke = GV%ke ; G%g_Earth = GV%mks_g_Earth endif @@ -2665,7 +2665,7 @@ subroutine adjust_ssh_for_p_atm(tv, G, GV, US, ssh, p_atm, use_EOS) else Rho_conv=GV%Rho0 endif - IgR0 = 1.0 / (Rho_conv * (GV%g_Earth*US%m_to_Z)) + IgR0 = 1.0 / (Rho_conv * GV%mks_g_Earth) ssh(i,j) = ssh(i,j) + p_atm(i,j) * IgR0 enddo ; enddo endif ; endif diff --git a/src/core/MOM_verticalGrid.F90 b/src/core/MOM_verticalGrid.F90 index 83fb6d9268..83317192a7 100644 --- a/src/core/MOM_verticalGrid.F90 +++ b/src/core/MOM_verticalGrid.F90 @@ -27,6 +27,8 @@ module MOM_verticalGrid integer :: ke !< The number of layers/levels in the vertical real :: max_depth !< The maximum depth of the ocean [Z ~> m]. real :: g_Earth !< The gravitational acceleration [m2 Z-1 s-2 ~> m s-2]. + real :: mks_g_Earth !< The gravitational acceleration in unscaled MKS units [m s-2]. + real :: LZT_g_Earth !< The gravitational acceleration [L2 Z-1 T-2 ~> m s-2]. real :: Rho0 !< The density used in the Boussinesq approximation or nominal !! density used to convert depths into mass units [kg m-3]. @@ -88,7 +90,7 @@ subroutine verticalGridInit( param_file, GV, US ) ! Read all relevant parameters and write them to the model log. call log_version(param_file, mdl, version, & "Parameters providing information about the vertical grid.") - call get_param(param_file, mdl, "G_EARTH", GV%g_Earth, & + call get_param(param_file, mdl, "G_EARTH", GV%mks_g_Earth, & "The gravitational acceleration of the Earth.", & units="m s-2", default = 9.80) call get_param(param_file, mdl, "RHO_0", GV%Rho0, & @@ -122,7 +124,8 @@ subroutine verticalGridInit( param_file, GV, US ) "units of thickness into m.", units="m H-1", default=1.0) GV%H_to_m = GV%H_to_m * H_rescale_factor endif - GV%g_Earth = GV%g_Earth * US%Z_to_m + GV%g_Earth = GV%mks_g_Earth * US%Z_to_m + GV%LZT_g_Earth = US%m_to_L**2*US%Z_to_m*US%T_to_s**2 * GV%mks_g_Earth #ifdef STATIC_MEMORY_ ! Here NK_ is a macro, while nk is a variable. call get_param(param_file, mdl, "NK", nk, & @@ -149,7 +152,7 @@ subroutine verticalGridInit( param_file, GV, US ) GV%Angstrom_H = GV%Angstrom_m*1000.0*GV%kg_m2_to_H endif GV%H_subroundoff = 1e-20 * max(GV%Angstrom_H,GV%m_to_H*1e-17) - GV%H_to_Pa = (GV%g_Earth*US%m_to_Z) * GV%H_to_kg_m2 + GV%H_to_Pa = GV%mks_g_Earth * GV%H_to_kg_m2 GV%H_to_Z = GV%H_to_m * US%m_to_Z GV%Z_to_H = US%Z_to_m * GV%m_to_H diff --git a/src/diagnostics/MOM_diagnostics.F90 b/src/diagnostics/MOM_diagnostics.F90 index 45cfb0ac68..0f5553721b 100644 --- a/src/diagnostics/MOM_diagnostics.F90 +++ b/src/diagnostics/MOM_diagnostics.F90 @@ -866,7 +866,7 @@ subroutine calculate_vertical_integrals(h, tv, p_surf, G, GV, US, CS) ! pbo = (mass * g) + p_surf ! where p_surf is the sea water pressure at sea water surface. do j=js,je ; do i=is,ie - btm_pres(i,j) = mass(i,j) * (GV%g_Earth*US%m_to_Z) + btm_pres(i,j) = mass(i,j) * GV%mks_g_Earth if (associated(p_surf)) then btm_pres(i,j) = btm_pres(i,j) + p_surf(i,j) endif diff --git a/src/initialization/MOM_coord_initialization.F90 b/src/initialization/MOM_coord_initialization.F90 index d497a7828e..45eb831d6c 100644 --- a/src/initialization/MOM_coord_initialization.F90 +++ b/src/initialization/MOM_coord_initialization.F90 @@ -141,7 +141,7 @@ subroutine set_coord_from_gprime(Rlay, g_prime, GV, US, param_file) call get_param(param_file, mdl, "GFS" , g_fs, & "The reduced gravity at the free surface.", units="m s-2", & - default=(GV%g_Earth*US%m_to_Z), scale=US%Z_to_m) + default=GV%mks_g_Earth, scale=US%Z_to_m) call get_param(param_file, mdl, "GINT", g_int, & "The reduced gravity across internal interfaces.", & units="m s-2", fail_if_missing=.true., scale=US%Z_to_m) @@ -176,7 +176,7 @@ subroutine set_coord_from_layer_density(Rlay, g_prime, GV, US, param_file) call get_param(param_file, mdl, "GFS", g_fs, & "The reduced gravity at the free surface.", units="m s-2", & - default=(GV%g_Earth*US%m_to_Z), scale=US%Z_to_m) + default=GV%mks_g_Earth, scale=US%Z_to_m) call get_param(param_file, mdl, "LIGHTEST_DENSITY", Rlay_Ref, & "The reference potential density used for layer 1.", & units="kg m-3", default=GV%Rho0) @@ -228,7 +228,7 @@ subroutine set_coord_from_TS_ref(Rlay, g_prime, GV, US, param_file, eqn_of_state "The initial salinities.", units="PSU", default=35.0) call get_param(param_file, mdl, "GFS", g_fs, & "The reduced gravity at the free surface.", units="m s-2", & - default=(GV%g_Earth*US%m_to_Z), scale=US%Z_to_m) + default=GV%mks_g_Earth, scale=US%Z_to_m) call get_param(param_file, mdl, "GINT", g_int, & "The reduced gravity across internal interfaces.", & units="m s-2", fail_if_missing=.true., scale=US%Z_to_m) @@ -273,7 +273,7 @@ subroutine set_coord_from_TS_profile(Rlay, g_prime, GV, US, param_file, & call get_param(param_file, mdl, "GFS", g_fs, & "The reduced gravity at the free surface.", units="m s-2", & - default=(GV%g_Earth*US%m_to_Z), scale=US%Z_to_m) + default=GV%mks_g_Earth, scale=US%Z_to_m) call get_param(param_file, mdl, "COORD_FILE", coord_file, & "The file from which the coordinate temperatures and "//& "salinities are read.", fail_if_missing=.true.) @@ -354,7 +354,7 @@ subroutine set_coord_from_TS_range(Rlay, g_prime, GV, US, param_file, & call get_param(param_file, mdl, "GFS", g_fs, & "The reduced gravity at the free surface.", units="m s-2", & - default=(GV%g_Earth*US%m_to_Z), scale=US%Z_to_m) + default=GV%mks_g_Earth, scale=US%Z_to_m) k_light = GV%nk_rho_varies + 1 @@ -401,7 +401,7 @@ subroutine set_coord_from_file(Rlay, g_prime, GV, US, param_file) call get_param(param_file, mdl, "GFS", g_fs, & "The reduced gravity at the free surface.", units="m s-2", & - default=(GV%g_Earth*US%m_to_Z), scale=US%Z_to_m) + default=GV%mks_g_Earth, scale=US%Z_to_m) call get_param(param_file, mdl, "INPUTDIR", inputdir, default=".") inputdir = slasher(inputdir) call get_param(param_file, mdl, "COORD_FILE", coord_file, & @@ -456,7 +456,7 @@ subroutine set_coord_linear(Rlay, g_prime, GV, US, param_file) units="kg m-3", default=2.0) call get_param(param_file, mdl, "GFS", g_fs, & "The reduced gravity at the free surface.", units="m s-2", & - default=(GV%g_Earth*US%m_to_Z), scale=US%Z_to_m) + default=GV%mks_g_Earth, scale=US%Z_to_m) ! This following sets the target layer densities such that a the ! surface interface has density Rlay_ref and the bottom @@ -494,7 +494,7 @@ subroutine set_coord_to_none(Rlay, g_prime, GV, US, param_file) call get_param(param_file, mdl, "GFS" , g_fs, & "The reduced gravity at the free surface.", units="m s-2", & - default=(GV%g_Earth*US%m_to_Z), scale=US%Z_to_m) + default=GV%mks_g_Earth, scale=US%Z_to_m) g_prime(1) = g_fs do k=2,nz ; g_prime(k) = 0. ; enddo diff --git a/src/parameterizations/vertical/MOM_CVMix_KPP.F90 b/src/parameterizations/vertical/MOM_CVMix_KPP.F90 index cfb0f37f86..159a88958b 100644 --- a/src/parameterizations/vertical/MOM_CVMix_KPP.F90 +++ b/src/parameterizations/vertical/MOM_CVMix_KPP.F90 @@ -910,7 +910,8 @@ subroutine KPP_compute_BLD(CS, G, GV, US, h, Temp, Salt, u, v, EOS, uStar, buoyF real, dimension( 3*G%ke ) :: Salt_1D real :: surfFricVel, surfBuoyFlux, Coriolis - real :: GoRho, pRef, rho1, rhoK, Uk, Vk, sigma, sigmaRatio + real :: GoRho ! Gravitational acceleration divided by density in MKS units [m4 s-2] + real :: pRef, rho1, rhoK, Uk, Vk, sigma, sigmaRatio real :: zBottomMinusOffset ! Height of bottom plus a little bit [m] real :: SLdepth_0d ! Surface layer depth = surf_layer_ext*OBLdepth. @@ -946,7 +947,7 @@ subroutine KPP_compute_BLD(CS, G, GV, US, h, Temp, Salt, u, v, EOS, uStar, buoyF #endif ! some constants - GoRho = (GV%g_Earth*US%m_to_Z) / GV%Rho0 + GoRho = GV%mks_g_Earth / GV%Rho0 ! loop over horizontal points on processor !$OMP parallel do default(shared) diff --git a/src/parameterizations/vertical/MOM_CVMix_conv.F90 b/src/parameterizations/vertical/MOM_CVMix_conv.F90 index 026bffe34c..1fbbc15120 100644 --- a/src/parameterizations/vertical/MOM_CVMix_conv.F90 +++ b/src/parameterizations/vertical/MOM_CVMix_conv.F90 @@ -168,10 +168,11 @@ subroutine calculate_CVMix_conv(h, tv, G, GV, US, CS, hbl) real, dimension(SZK_(G)+1) :: iFaceHeight !< Height of interfaces [m] real, dimension(SZK_(G)) :: cellHeight !< Height of cell centers [m] integer :: kOBL !< level of OBL extent - real :: pref, g_o_rho0, rhok, rhokm1, dz, dh, hcorr + real :: g_o_rho0 ! Gravitational acceleration divided by density in MKS units [m4 s-2] + real :: pref, rhok, rhokm1, dz, dh, hcorr integer :: i, j, k - g_o_rho0 = (GV%g_Earth*US%m_to_Z) / GV%Rho0 + g_o_rho0 = GV%mks_g_Earth / GV%Rho0 ! initialize dummy variables rho_lwr(:) = 0.0; rho_1d(:) = 0.0 diff --git a/src/parameterizations/vertical/MOM_CVMix_shear.F90 b/src/parameterizations/vertical/MOM_CVMix_shear.F90 index a93f3a7169..6b6bf32bf7 100644 --- a/src/parameterizations/vertical/MOM_CVMix_shear.F90 +++ b/src/parameterizations/vertical/MOM_CVMix_shear.F90 @@ -72,8 +72,8 @@ subroutine calculate_CVMix_shear(u_H, v_H, h, tv, kd, kv, G, GV, US, CS ) !! CVMix_shear_init. ! Local variables integer :: i, j, k, kk, km1 - real :: GoRho - real :: pref, DU, DV, DRHO, DZ, N2, S2, dummy + real :: GoRho ! Gravitational acceleration divided by density in MKS units [m4 s-2] + real :: pref, DU, DV, dRho, DZ, N2, S2, dummy real, dimension(2*(G%ke)) :: pres_1d, temp_1d, salt_1d, rho_1d real, dimension(G%ke+1) :: Ri_Grad !< Gradient Richardson number real, dimension(G%ke+1) :: Kvisc !< Vertical viscosity at interfaces [m2 s-1] @@ -81,7 +81,7 @@ subroutine calculate_CVMix_shear(u_H, v_H, h, tv, kd, kv, G, GV, US, CS ) real, parameter :: epsln = 1.e-10 !< Threshold to identify vanished layers ! some constants - GoRho = (GV%g_Earth*US%m_to_Z) / GV%Rho0 + GoRho = GV%mks_g_Earth / GV%Rho0 do j = G%jsc, G%jec do i = G%isc, G%iec diff --git a/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 b/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 index 725a6dc7e3..7b355ff960 100644 --- a/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 +++ b/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 @@ -514,7 +514,7 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt_in_T, ea, eb, G, GV, ! rivermix_depth = The prescribed depth over which to mix river inflow ! drho_ds = The gradient of density wrt salt at the ambient surface salinity. ! Sriver = 0 (i.e. rivers are assumed to be pure freshwater) - RmixConst = 0.5*CS%rivermix_depth * (US%T_to_s**2*GV%g_Earth*US%m_to_Z) * Irho0**2 + RmixConst = 0.5*CS%rivermix_depth * (US%L_to_m**2*GV%LZT_g_Earth*US%m_to_Z) * Irho0**2 do i=is,ie TKE_river(i) = max(0.0, RmixConst*dR0_dS(i)* & US%T_to_s*(fluxes%lrunoff(i,j) + fluxes%frunoff(i,j)) * S(i,1)) @@ -865,7 +865,7 @@ subroutine convective_adjustment(h, u, v, R0, Rcv, T, S, eps, d_eb, & integer :: is, ie, nz, i, k, k1, nzc, nkmb is = G%isc ; ie = G%iec ; nz = GV%ke - g_H2_2Rho0 = (US%T_to_s**2*GV%g_Earth * GV%H_to_Z**2) / (2.0 * GV%Rho0) + g_H2_2Rho0 = (US%L_to_m**2*GV%LZT_g_Earth * GV%H_to_Z**2) / (2.0 * GV%Rho0) nzc = nz ; if (present(nz_conv)) nzc = nz_conv nkmb = CS%nkml+CS%nkbl @@ -1070,7 +1070,7 @@ subroutine mixedlayer_convection(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & Angstrom = GV%Angstrom_H C1_3 = 1.0/3.0 ; C1_6 = 1.0/6.0 - g_H2_2Rho0 = (US%T_to_s**2*GV%g_Earth * GV%H_to_Z**2) / (2.0 * GV%Rho0) + g_H2_2Rho0 = (US%L_to_m**2*GV%LZT_g_Earth * GV%H_to_Z**2) / (2.0 * GV%Rho0) Idt = 1.0 / dt_in_T is = G%isc ; ie = G%iec ; nz = GV%ke @@ -1613,7 +1613,7 @@ subroutine mechanical_entrainment(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & integer :: is, ie, nz, i, k, ks, itt, n C1_3 = 1.0/3.0 ; C1_6 = 1.0/6.0 ; C1_24 = 1.0/24.0 - g_H_2Rho0 = (US%T_to_s**2*GV%g_Earth * GV%H_to_Z) / (2.0 * GV%Rho0) + g_H_2Rho0 = (US%L_to_m**2*GV%LZT_g_Earth * GV%H_to_Z) / (2.0 * GV%Rho0) Hmix_min = CS%Hmix_min h_neglect = GV%H_subroundoff is = G%isc ; ie = G%iec ; nz = GV%ke @@ -2363,8 +2363,8 @@ subroutine mixedlayer_detrain_2(h, T, S, R0, Rcv, RcvTgt, dt_in_T, dt_diag, d_ea kb1 = CS%nkml+1; kb2 = CS%nkml+2 nkmb = CS%nkml+CS%nkbl h_neglect = GV%H_subroundoff - g_2 = 0.5 * US%T_to_s**2*GV%g_Earth - Rho0xG = GV%Rho0 * US%T_to_s**2*GV%g_Earth + g_2 = 0.5 * US%L_to_m**2*GV%LZT_g_Earth + Rho0xG = GV%Rho0 * US%L_to_m**2*GV%LZT_g_Earth Idt_H2 = GV%H_to_Z**2 / dt_diag I2Rho0 = 0.5 / GV%Rho0 Angstrom = GV%Angstrom_H @@ -3165,8 +3165,8 @@ subroutine mixedlayer_detrain_1(h, T, S, R0, Rcv, RcvTgt, dt_in_T, dt_diag, d_ea "CS%nkbl must be 1 in mixedlayer_detrain_1.") dt_Time = dt_in_T / CS%BL_detrain_time - g_H2_2Rho0dt = (US%T_to_s**2*GV%g_Earth * GV%H_to_Z**2) / (2.0 * GV%Rho0 * dt_diag) - g_H2_2dt = (US%T_to_s**2*GV%g_Earth * GV%H_to_Z**2) / (2.0 * dt_diag) + g_H2_2Rho0dt = (US%L_to_m**2*GV%LZT_g_Earth * GV%H_to_Z**2) / (2.0 * GV%Rho0 * dt_diag) + g_H2_2dt = (US%L_to_m**2*GV%LZT_g_Earth * GV%H_to_Z**2) / (2.0 * dt_diag) ! Move detrained water into the buffer layer. do k=1,CS%nkml diff --git a/src/parameterizations/vertical/MOM_diabatic_aux.F90 b/src/parameterizations/vertical/MOM_diabatic_aux.F90 index 3a41d4736e..20380f22c5 100644 --- a/src/parameterizations/vertical/MOM_diabatic_aux.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_aux.F90 @@ -736,20 +736,20 @@ subroutine diagnoseMLDbyDensityDifference(id_MLD, h, tv, densityDiff, G, GV, US, real, dimension(SZI_(G)) :: dK, dKm1 ! Depths [Z ~> m]. real, dimension(SZI_(G)) :: rhoSurf ! Density used in finding the mixedlayer depth [kg m-3]. real, dimension(SZI_(G), SZJ_(G)) :: MLD ! Diagnosed mixed layer depth [Z ~> m]. - real, dimension(SZI_(G), SZJ_(G)) :: subMLN2 ! Diagnosed stratification below ML [s-2]. + real, dimension(SZI_(G), SZJ_(G)) :: subMLN2 ! Diagnosed stratification below ML [T-2 ~> s-2]. real, dimension(SZI_(G), SZJ_(G)) :: MLD2 ! Diagnosed MLD^2 [Z2 ~> m2]. logical, dimension(SZI_(G)) :: N2_region_set ! If true, all necessary values for calculating N2 ! have been stored already. - real :: gE_Rho0 ! The gravitational acceleration divided by a mean density [m4 s-2 kg-1]. + real :: gE_Rho0 ! The gravitational acceleration divided by a mean density [Z m3 T-2 kg-1 ~> m4 s-2 kg-1]. real :: dH_subML ! Depth below ML over which to diagnose stratification [H ~> m]. integer :: i, j, is, ie, js, je, k, nz, id_N2, id_SQ real :: aFac, ddRho id_N2 = -1 ; if (PRESENT(id_N2subML)) id_N2 = id_N2subML - id_SQ = -1 ; if (PRESENT(id_N2subML)) id_SQ = id_MLDsq + id_SQ = -1 ; if (PRESENT(id_MLDsq)) id_SQ = id_MLDsq - gE_rho0 = US%m_to_Z**2 * GV%g_Earth / GV%Rho0 + gE_rho0 = US%L_to_Z**2*GV%LZT_g_Earth / GV%Rho0 dH_subML = 50.*GV%m_to_H ; if (present(dz_subML)) dH_subML = GV%Z_to_H*dz_subML is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke @@ -830,7 +830,7 @@ subroutine diagnoseMLDbyDensityDifference(id_MLD, h, tv, densityDiff, G, GV, US, enddo ! j-loop if (id_MLD > 0) call post_data(id_MLD, MLD, diagPtr) - if (id_N2 > 0) call post_data(id_N2, subMLN2 , diagPtr) + if (id_N2 > 0) call post_data(id_N2, subMLN2, diagPtr) if (id_SQ > 0) call post_data(id_SQ, MLD2, diagPtr) end subroutine diagnoseMLDbyDensityDifference @@ -920,7 +920,7 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, US, dt, fluxes, optics, nsw, h, t real :: dt_in_T ! The time step converted to T units [T ~> s] real :: g_Hconv2 real :: GoRho ! g_Earth times a unit conversion factor divided by density - ! [Z m3 s-2 kg-1 ~> m4 s-2 kg-1] + ! [Z3 m T-2 kg-1 ~> m4 s-2 kg-1] logical :: calculate_energetics logical :: calculate_buoyancy integer :: i, j, is, ie, js, je, k, nz, n @@ -945,7 +945,7 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, US, dt, fluxes, optics, nsw, h, t if (present(cTKE)) cTKE(:,:,:) = 0.0 if (calculate_buoyancy) then SurfPressure(:) = 0.0 - GoRho = GV%g_Earth / GV%Rho0 + GoRho = US%L_to_Z**2*GV%LZT_g_Earth / GV%Rho0 start = 1 + G%isc - G%isd npts = 1 + G%iec - G%isc endif @@ -1344,9 +1344,9 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, US, dt, fluxes, optics, nsw, h, t ! 3. Convert to a buoyancy flux, excluding penetrating SW heating ! BGR-Jul 5, 2017: The contribution of SW heating here needs investigated for ePBL. do i=is,ie - SkinBuoyFlux(i,j) = - GoRho * GV%H_to_Z * US%m_to_Z**2 * US%T_to_s**3 * ( & - dRhodS(i) * (netSalt_rate(i) - tv%S(i,j,1)*netMassInOut_rate(i)) + & - dRhodT(i) * ( netHeat_rate(i) + netPen(i,1)) ) ! m^2/s^3 + SkinBuoyFlux(i,j) = - GoRho * GV%H_to_Z * US%T_to_s * & + (dRhodS(i) * (netSalt_rate(i) - tv%S(i,j,1)*netMassInOut_rate(i)) + & + dRhodT(i) * ( netHeat_rate(i) + netPen(i,1)) ) ! m^2/s^3 enddo endif diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index fb0cf09b43..526dc4dfe3 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -3416,7 +3416,7 @@ subroutine diabatic_driver_init(Time, G, GV, US, param_file, useALEalgorithm, di CS%id_MLD_0125 = register_diag_field('ocean_model','MLD_0125',diag%axesT1,Time, & 'Mixed layer depth (delta rho = 0.125)', 'm', conversion=US%Z_to_m) CS%id_subMLN2 = register_diag_field('ocean_model','subML_N2',diag%axesT1,Time, & - 'Squared buoyancy frequency below mixed layer', 's-2') + 'Squared buoyancy frequency below mixed layer', 's-2', conversion=US%s_to_T**2) CS%id_MLD_user = register_diag_field('ocean_model','MLD_user',diag%axesT1,Time, & 'Mixed layer depth (used defined)', 'm', conversion=US%Z_to_m) endif diff --git a/src/parameterizations/vertical/MOM_diapyc_energy_req.F90 b/src/parameterizations/vertical/MOM_diapyc_energy_req.F90 index ff63d86ea9..cd7723f4fa 100644 --- a/src/parameterizations/vertical/MOM_diapyc_energy_req.F90 +++ b/src/parameterizations/vertical/MOM_diapyc_energy_req.F90 @@ -199,7 +199,7 @@ subroutine diapyc_energy_req_calc(h_in, T_in, S_in, Kd, energy_Kd, dt, tv, & pres_Z, & ! Interface pressures with a rescaling factor to convert interface height ! movements into changes in column potential energy [J m-2 Z-1 ~> J m-3]. z_Int, & ! Interface heights relative to the surface [H ~> m or kg m-2]. - N2, & ! An estimate of the buoyancy frequency [s-2]. + N2, & ! An estimate of the buoyancy frequency [T-2 ~> s-2]. Kddt_h, & ! The diapycnal diffusivity times a timestep divided by the ! average thicknesses around a layer [H ~> m or kg m-2]. Kddt_h_a, & ! The value of Kddt_h for layers above the central point in the @@ -941,7 +941,7 @@ subroutine diapyc_energy_req_calc(h_in, T_in, S_in, Kd, energy_Kd, dt, tv, & do K=2,nz call calculate_density(0.5*(T0(k-1) + T0(k)), 0.5*(S0(k-1) + S0(k)), & pres(K), rho_here, tv%eqn_of_state) - N2(K) = ((GV%g_Earth*US%m_to_Z**2) * rho_here / (0.5*GV%H_to_Z*(h_tr(k-1) + h_tr(k)))) * & + N2(K) = ((US%L_to_Z**2*GV%LZT_g_Earth) * rho_here / (0.5*GV%H_to_Z*(h_tr(k-1) + h_tr(k)))) * & ( 0.5*(dSV_dT(k-1) + dSV_dT(k)) * (T0(k-1) - T0(k)) + & 0.5*(dSV_dS(k-1) + dSV_dS(k)) * (S0(k-1) - S0(k)) ) enddo @@ -952,7 +952,7 @@ subroutine diapyc_energy_req_calc(h_in, T_in, S_in, Kd, energy_Kd, dt, tv, & do K=2,nz call calculate_density(0.5*(Tf(k-1) + Tf(k)), 0.5*(Sf(k-1) + Sf(k)), & pres(K), rho_here, tv%eqn_of_state) - N2(K) = ((GV%g_Earth*US%m_to_Z**2) * rho_here / (0.5*GV%H_to_Z*(h_tr(k-1) + h_tr(k)))) * & + N2(K) = ((US%L_to_Z**2*GV%LZT_g_Earth) * rho_here / (0.5*GV%H_to_Z*(h_tr(k-1) + h_tr(k)))) * & ( 0.5*(dSV_dT(k-1) + dSV_dT(k)) * (Tf(k-1) - Tf(k)) + & 0.5*(dSV_dS(k-1) + dSV_dS(k)) * (Sf(k-1) - Sf(k)) ) enddo @@ -1334,9 +1334,9 @@ subroutine diapyc_energy_req_init(Time, G, GV, US, param_file, diag, CS) CS%id_Sf = register_diag_field('ocean_model', 'EnReqTest_Sf', diag%axesZL, Time, & "Salinity after mixing", "g kg-1") CS%id_N2_0 = register_diag_field('ocean_model', 'EnReqTest_N2_0', diag%axesZi, Time, & - "Squared buoyancy frequency before mixing", "second-2") + "Squared buoyancy frequency before mixing", "second-2", conversion=US%s_to_T**2) CS%id_N2_f = register_diag_field('ocean_model', 'EnReqTest_N2_f', diag%axesZi, Time, & - "Squared buoyancy frequency after mixing", "second-2") + "Squared buoyancy frequency after mixing", "second-2", conversion=US%s_to_T**2) end subroutine diapyc_energy_req_init diff --git a/src/parameterizations/vertical/MOM_energetic_PBL.F90 b/src/parameterizations/vertical/MOM_energetic_PBL.F90 index 352ac24011..ecdbebe51e 100644 --- a/src/parameterizations/vertical/MOM_energetic_PBL.F90 +++ b/src/parameterizations/vertical/MOM_energetic_PBL.F90 @@ -807,7 +807,7 @@ subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, abs pres_Z(1) = 0.0 do k=1,nz dMass = US%m_to_Z * GV%H_to_kg_m2 * h(k) - dPres = (US%m_to_Z**2*US%T_to_s**2) * GV%g_Earth * dMass ! Equivalent to GV%H_to_Pa * h(k) with rescaling + dPres = US%L_to_Z**2 * GV%LZT_g_Earth * dMass ! Equivalent to GV%H_to_Pa * h(k) with rescaling dT_to_dPE(k) = (dMass * (pres_Z(K) + 0.5*dPres)) * dSV_dT(k) dS_to_dPE(k) = (dMass * (pres_Z(K) + 0.5*dPres)) * dSV_dS(k) dT_to_dColHt(k) = dMass * dSV_dT(k) diff --git a/src/parameterizations/vertical/MOM_entrain_diffusive.F90 b/src/parameterizations/vertical/MOM_entrain_diffusive.F90 index 4ca1dc6d6d..121191b008 100644 --- a/src/parameterizations/vertical/MOM_entrain_diffusive.F90 +++ b/src/parameterizations/vertical/MOM_entrain_diffusive.F90 @@ -2128,7 +2128,8 @@ subroutine entrain_diffusive_init(Time, G, GV, US, param_file, diag, CS) CS%id_Kd = register_diag_field('ocean_model', 'Kd_effective', diag%axesTL, Time, & 'Diapycnal diffusivity as applied', 'm2 s-1', conversion=US%Z2_T_to_m2_s) CS%id_diff_work = register_diag_field('ocean_model', 'diff_work', diag%axesTi, Time, & - 'Work actually done by diapycnal diffusion across each interface', 'W m-2', conversion=US%Z_to_m*US%s_to_T) + 'Work actually done by diapycnal diffusion across each interface', 'W m-2', & + conversion=US%Z_to_m*US%s_to_T) end subroutine entrain_diffusive_init diff --git a/src/parameterizations/vertical/MOM_internal_tide_input.F90 b/src/parameterizations/vertical/MOM_internal_tide_input.F90 index 5bc5a12dff..52156ac337 100644 --- a/src/parameterizations/vertical/MOM_internal_tide_input.F90 +++ b/src/parameterizations/vertical/MOM_internal_tide_input.F90 @@ -87,7 +87,7 @@ subroutine set_int_tide_input(u, v, h, tv, fluxes, itide, dt, G, GV, US, CS) type(int_tide_input_CS), pointer :: CS !< This module's control structure. ! Local variables real, dimension(SZI_(G),SZJ_(G)) :: & - N2_bot ! The bottom squared buoyancy frequency [s-2]. + N2_bot ! The bottom squared buoyancy frequency [T-2 ~> s-2]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: & T_f, S_f ! The temperature and salinity in [degC] and [ppt] with the values in @@ -119,7 +119,7 @@ subroutine set_int_tide_input(u, v, h, tv, fluxes, itide, dt, G, GV, US, CS) !$OMP parallel do default(shared) do j=js,je ; do i=is,ie - itide%Nb(i,j) = G%mask2dT(i,j) * sqrt(N2_bot(i,j)) + itide%Nb(i,j) = G%mask2dT(i,j) * US%s_to_T*sqrt(N2_bot(i,j)) itide%TKE_itidal_input(i,j) = min(CS%TKE_itidal_coef(i,j)*itide%Nb(i,j), CS%TKE_itide_max) enddo ; enddo @@ -128,7 +128,7 @@ subroutine set_int_tide_input(u, v, h, tv, fluxes, itide, dt, G, GV, US, CS) avg_enabled = query_averaging_enabled(CS%diag, time_end=time_end) if (time_end <= CS%time_max_source) then do j=js,je ; do i=is,ie - ! Input an arbitrary energy point source. + ! Input an arbitrary energy point source.id_ if (((G%geoLonCu(I-1,j)-CS%int_tide_source_x) * (G%geoLonBu(I,j)-CS%int_tide_source_x) <= 0.0) .and. & ((G%geoLatCv(i,J-1)-CS%int_tide_source_y) * (G%geoLatCv(i,j)-CS%int_tide_source_y) <= 0.0)) then itide%TKE_itidal_input(i,j) = 1.0 @@ -138,13 +138,13 @@ subroutine set_int_tide_input(u, v, h, tv, fluxes, itide, dt, G, GV, US, CS) endif if (CS%debug) then - call hchksum(N2_bot,"N2_bot",G%HI,haloshift=0) + call hchksum(N2_bot,"N2_bot",G%HI,haloshift=0, scale=US%s_to_T**2) call hchksum(itide%TKE_itidal_input,"TKE_itidal_input",G%HI,haloshift=0) endif if (CS%id_TKE_itidal > 0) call post_data(CS%id_TKE_itidal, itide%TKE_itidal_input, CS%diag) if (CS%id_Nb > 0) call post_data(CS%id_Nb, itide%Nb, CS%diag) - if (CS%id_N2_bot > 0 ) call post_data(CS%id_N2_bot,N2_bot,CS%diag) + if (CS%id_N2_bot > 0 ) call post_data(CS%id_N2_bot, N2_bot, CS%diag) end subroutine set_int_tide_input @@ -181,11 +181,11 @@ subroutine find_N2_bottom(h, tv, T_f, S_f, h2, fluxes, G, GV, US, N2_bot) real :: dz_int ! The thickness associated with an interface [Z ~> m]. real :: G_Rho0 ! The gravitation acceleration divided by the Boussinesq - ! density [Z m3 s-2 kg-1 ~> m4 s-2 kg-1]. + ! density [Z m3 T-2 kg-1 ~> m4 s-2 kg-1]. logical :: do_i(SZI_(G)), do_any integer :: i, j, k, is, ie, js, je, nz is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke - G_Rho0 = (GV%g_Earth*US%m_to_Z**2) / GV%Rho0 + G_Rho0 = (US%L_to_Z**2*GV%LZT_g_Earth) / GV%Rho0 ! Find the (limited) density jump across each interface. do i=is,ie @@ -415,7 +415,7 @@ subroutine int_tide_input_init(Time, G, GV, US, param_file, diag, CS, itide) 'Bottom Buoyancy Frequency', 's-1') CS%id_N2_bot = register_diag_field('ocean_model','N2_b_itide',diag%axesT1,Time, & - 'Bottom Buoyancy frequency squared', 's-2') + 'Bottom Buoyancy frequency squared', 's-2', conversion=US%s_to_T**2) end subroutine int_tide_input_init diff --git a/src/parameterizations/vertical/MOM_kappa_shear.F90 b/src/parameterizations/vertical/MOM_kappa_shear.F90 index 14c319398a..e80793695f 100644 --- a/src/parameterizations/vertical/MOM_kappa_shear.F90 +++ b/src/parameterizations/vertical/MOM_kappa_shear.F90 @@ -740,7 +740,8 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & real :: b1 ! The inverse of the pivot in the tridiagonal equations. real :: bd1 ! A term in the denominator of b1. real :: d1 ! 1 - c1 in the tridiagonal equations. - real :: gR0 ! Rho_0 times g [kg m-1 Z-1 s-2 ~> kg m-2 s-2]. + real :: gR0 ! A conversion factor from Z to Pa equal to Rho_0 times g + ! [kg m-1 Z-1 s-2 ~> kg m-2 s-2]. real :: g_R0 ! g_R0 is a rescaled version of g/Rho [Z m3 kg-1 T-2 ~> m4 kg-1 s-2]. real :: Norm ! A factor that normalizes two weights to 1 [Z-2 ~> m-2]. real :: tol_dksrc, tol2 ! ### Tolerances that need to be set better later. @@ -788,7 +789,8 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & #endif Ri_crit = CS%Rino_crit - gR0 = GV%Rho0*GV%g_Earth ; g_R0 = (GV%g_Earth*US%m_to_Z**2*US%T_to_s**2)/GV%Rho0 + gR0 = GV%z_to_H*GV%H_to_Pa + g_R0 = (US%L_to_Z**2 * GV%LZT_g_Earth) / GV%Rho0 k0dt = dt*CS%kappa_0 ! These are hard-coded for now. Perhaps these could be made dynamic later? ! tol_dksrc = 0.5*tol_ksrc_chg ; tol_dksrc_low = 1.0 - 1.0/tol_ksrc_chg ? diff --git a/src/parameterizations/vertical/MOM_opacity.F90 b/src/parameterizations/vertical/MOM_opacity.F90 index af6715cf16..6428cfc2dd 100644 --- a/src/parameterizations/vertical/MOM_opacity.F90 +++ b/src/parameterizations/vertical/MOM_opacity.F90 @@ -611,9 +611,9 @@ subroutine absorbRemainingSW(G, GV, US, h, opacity_band, nsw, optics, j, dt, H_l TKE_calc = (present(TKE) .and. present(dSV_dT)) if (optics%answers_2018) then - g_Hconv2 = (US%m_to_Z**4 * US%T_to_s**2 * GV%g_Earth * GV%H_to_kg_m2) * GV%H_to_kg_m2 + g_Hconv2 = (US%m_to_Z**2 * US%L_to_Z**2*GV%LZT_g_Earth * GV%H_to_kg_m2) * GV%H_to_kg_m2 else - g_Hconv2 = US%m_to_Z**4 * US%T_to_s**2 * GV%g_Earth * GV%H_to_kg_m2**2 + g_Hconv2 = US%m_to_Z**2 * US%L_to_Z**2*GV%LZT_g_Earth * GV%H_to_kg_m2**2 endif h_heat(:) = 0.0 diff --git a/src/parameterizations/vertical/MOM_set_diffusivity.F90 b/src/parameterizations/vertical/MOM_set_diffusivity.F90 index 13be524570..3d68918365 100644 --- a/src/parameterizations/vertical/MOM_set_diffusivity.F90 +++ b/src/parameterizations/vertical/MOM_set_diffusivity.F90 @@ -687,10 +687,10 @@ subroutine find_TKE_to_Kd(h, tv, dRho_int, N2_lay, j, dt, G, GV, US, CS, & I_dt = 1.0 / dt Omega2 = CS%omega**2 H_neglect = GV%H_subroundoff - G_Rho0 = (GV%g_Earth * US%m_to_Z**2 * US%T_to_s**2) / GV%Rho0 + G_Rho0 = (US%L_to_Z**2 * GV%LZT_g_Earth) / GV%Rho0 if (CS%answers_2018) then I_Rho0 = 1.0 / GV%Rho0 - G_IRho0 = (GV%g_Earth * US%m_to_Z**2 * US%T_to_s**2) * I_Rho0 + G_IRho0 = (US%L_to_Z**2 * GV%LZT_g_Earth) * I_Rho0 else G_IRho0 = G_Rho0 endif @@ -736,11 +736,11 @@ subroutine find_TKE_to_Kd(h, tv, dRho_int, N2_lay, j, dt, G, GV, US, CS, & enddo enddo - call set_density_ratios(h, tv, kb, G, GV, CS, j, ds_dsp1, rho_0) + call set_density_ratios(h, tv, kb, G, GV, US, CS, j, ds_dsp1, rho_0) else ! not bulkmixedlayer kb_min = 2 ; kmb = 0 do i=is,ie ; kb(i) = 1 ; enddo - call set_density_ratios(h, tv, kb, G, GV, CS, j, ds_dsp1) + call set_density_ratios(h, tv, kb, G, GV, US, CS, j, ds_dsp1) endif ! Determine maxEnt - the maximum permitted entrainment from below by each @@ -882,7 +882,7 @@ subroutine find_N2(h, tv, T_f, S_f, fluxes, j, G, GV, US, CS, dRho_int, & integer :: i, k, is, ie, nz is = G%isc ; ie = G%iec ; nz = G%ke - G_Rho0 = (GV%g_Earth*US%m_to_Z**2 * US%T_to_s**2) / GV%Rho0 + G_Rho0 = (US%L_to_Z**2 * GV%LZT_g_Earth) / GV%Rho0 H_neglect = GV%H_subroundoff ! Find the (limited) density jump across each interface. @@ -1170,7 +1170,7 @@ subroutine add_drag_diffusivity(h, u, v, tv, fluxes, visc, j, TKE_to_Kd, & if (associated(visc%Ray_u) .and. associated(visc%Ray_v)) Rayleigh_drag = .true. I_Rho0 = 1.0/GV%Rho0 - R0_g = GV%Rho0 / (US%m_to_Z**2 * US%T_to_s**2 * GV%g_Earth) + R0_g = GV%Rho0 / (US%L_to_Z**2 * GV%LZT_g_Earth) do K=2,nz ; Rint(K) = 0.5*(GV%Rlay(k-1)+GV%Rlay(k)) ; enddo @@ -1766,7 +1766,7 @@ subroutine set_BBL_TKE(u, v, h, fluxes, visc, G, GV, US, CS) end subroutine set_BBL_TKE -subroutine set_density_ratios(h, tv, kb, G, GV, CS, j, ds_dsp1, rho_0) +subroutine set_density_ratios(h, tv, kb, G, GV, US, CS, j, ds_dsp1, rho_0) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & @@ -1776,6 +1776,7 @@ subroutine set_density_ratios(h, tv, kb, G, GV, CS, j, ds_dsp1, rho_0) !! fields have NULL ptrs. integer, dimension(SZI_(G)), intent(in) :: kb !< Index of lightest layer denser than the buffer !! layer, or -1 without a bulk mixed layer. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(set_diffusivity_CS), pointer :: CS !< Control structure returned by previous !! call to diabatic_entrain_init. integer, intent(in) :: j !< Meridional index upon which to work. @@ -1788,7 +1789,7 @@ subroutine set_density_ratios(h, tv, kb, G, GV, CS, j, ds_dsp1, rho_0) !! surface press [kg m-3]. ! Local variables - real :: g_R0 ! g_R0 is g/Rho [m5 Z-1 kg-1 s-2 ~> m4 kg-1 s-2] + real :: g_R0 ! g_R0 is a rescaled version of g/Rho [m3 L2 Z-1 kg-1 T-2 ~> m4 kg-1 s-2] real :: eps, tmp ! nondimensional temproray variables real :: a(SZK_(G)), a_0(SZK_(G)) ! nondimensional temporary variables real :: p_ref(SZI_(G)) ! an array of tv%P_Ref pressures @@ -1811,7 +1812,7 @@ subroutine set_density_ratios(h, tv, kb, G, GV, CS, j, ds_dsp1, rho_0) enddo if (CS%bulkmixedlayer) then - g_R0 = GV%g_Earth/GV%Rho0 + g_R0 = GV%LZT_g_Earth / GV%Rho0 kmb = GV%nk_rho_varies eps = 0.1 do i=is,ie ; p_ref(i) = tv%P_Ref ; enddo @@ -1825,7 +1826,7 @@ subroutine set_density_ratios(h, tv, kb, G, GV, CS, j, ds_dsp1, rho_0) ! interfaces above and below the buffer layer and the next denser layer. k = kb(i) - I_Drho = g_R0 / GV%g_prime(k+1) + I_Drho = (US%s_to_T**2*US%L_to_m**2*g_R0) / (GV%g_prime(k+1)) ! The indexing convention for a is appropriate for the interfaces. do k3=1,kmb a(k3+1) = (GV%Rlay(k) - Rcv(i,k3)) * I_Drho diff --git a/src/parameterizations/vertical/MOM_set_viscosity.F90 b/src/parameterizations/vertical/MOM_set_viscosity.F90 index aed9993930..370e2f7cfe 100644 --- a/src/parameterizations/vertical/MOM_set_viscosity.F90 +++ b/src/parameterizations/vertical/MOM_set_viscosity.F90 @@ -269,7 +269,7 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, symmetrize) Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB nkmb = GV%nk_rho_varies ; nkml = GV%nkml h_neglect = GV%H_subroundoff - Rho0x400_G = 400.0*(GV%Rho0/GV%g_Earth) * US%s_to_T**2*US%Z_to_m**2 * GV%Z_to_H + Rho0x400_G = 400.0*(GV%Rho0 / (US%L_to_Z**2 * GV%LZT_g_Earth)) * GV%Z_to_H Vol_quit = 0.9*GV%Angstrom_H + h_neglect C2pi_3 = 8.0*atan(1.0)/3.0 @@ -1131,7 +1131,7 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS, symmetri Jsq = js-1 ; Isq = is-1 endif ; endif - Rho0x400_G = 400.0*(GV%Rho0/GV%g_Earth) * US%s_to_T**2*US%Z_to_m**2 * GV%Z_to_H + Rho0x400_G = 400.0*(GV%Rho0/(US%L_to_Z**2 * GV%LZT_g_Earth)) * GV%Z_to_H U_bg_sq = CS%drag_bg_vel * CS%drag_bg_vel cdrag_sqrt = sqrt(CS%cdrag) cdrag_sqrt_Z = US%m_to_Z * sqrt(CS%cdrag) @@ -1141,7 +1141,8 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS, symmetri dt_Rho0 = dt/GV%H_to_kg_m2 h_neglect = GV%H_subroundoff h_tiny = 2.0*GV%Angstrom_H + h_neglect - g_H_Rho0 = (GV%g_Earth*GV%H_to_Z) / GV%Rho0 + ! g_H_Rho0 can be rescaled after all test cases are using non-zero VEL_UNDERFLOW. + g_H_Rho0 = (US%s_to_T**2*US%L_to_m**2*GV%LZT_g_Earth*GV%H_to_Z) / GV%Rho0 if (associated(forces%frac_shelf_u) .neqv. associated(forces%frac_shelf_v)) & call MOM_error(FATAL, "set_viscous_ML: one of forces%frac_shelf_u and "//& diff --git a/src/user/MOM_wave_interface.F90 b/src/user/MOM_wave_interface.F90 index 49db064c40..9e09ea9bba 100644 --- a/src/user/MOM_wave_interface.F90 +++ b/src/user/MOM_wave_interface.F90 @@ -1034,7 +1034,7 @@ subroutine get_StokesSL_LiFoxKemper(ustar, hbl, GV, US, UStokes_SL, LA) ! ! peak frequency (PM, Bouws, 1998) tmp = 2.0 * PI * u19p5_to_u10 * u10 - fp = 0.877 * (GV%g_Earth*US%m_to_Z) / tmp + fp = 0.877 * GV%mks_g_Earth / tmp ! ! mean frequency fm = fm_into_fp * fp @@ -1167,15 +1167,15 @@ subroutine DHH85_mid(GV, US, zpt, UStokes) !/ omega_min = 0.1 ! Hz ! Cut off at 30cm for now... - omega_max = 10. ! ~sqrt(0.2*(GV%g_Earth*US%m_to_Z)*2*pi/0.3) + omega_max = 10. ! ~sqrt(0.2*GV%mks_g_Earth*2*pi/0.3) NOmega = 1000 domega = (omega_max-omega_min)/real(NOmega) ! if (WaveAgePeakFreq) then - omega_peak = (GV%g_Earth*US%m_to_Z) / (WA * u10) + omega_peak = GV%mks_g_Earth / (WA * u10) else - omega_peak = 2. * pi * 0.13 * (GV%g_Earth*US%m_to_Z) / U10 + omega_peak = 2. * pi * 0.13 * GV%mks_g_Earth / U10 endif !/ Ann = 0.006 * WaveAge**(-0.55) @@ -1191,11 +1191,11 @@ subroutine DHH85_mid(GV, US, zpt, UStokes) do oi = 1,nomega-1 Dnn = exp ( -0.5 * (omega-omega_peak)**2 / (Snn**2 * omega_peak**2) ) ! wavespec units = m2s - wavespec = (Ann * (GV%g_Earth*US%m_to_Z)**2 / (omega_peak*omega**4 ) ) * & + wavespec = (Ann * GV%mks_g_Earth**2 / (omega_peak*omega**4 ) ) * & exp(-bnn*(omega_peak/omega)**4)*Cnn**Dnn ! Stokes units m (multiply by frequency range for units of m/s) Stokes = 2.0 * wavespec * omega**3 * & - exp( 2.0 * omega**2 * zpt/(GV%g_Earth*US%m_to_Z)) / (GV%g_Earth*US%m_to_Z) + exp( 2.0 * omega**2 * zpt / GV%mks_g_Earth) / GV%mks_g_Earth UStokes = UStokes + Stokes*domega omega = omega + domega enddo From 5cc85dc68214d47283ca8f8745192c362867a111 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 9 Jul 2019 18:58:33 -0400 Subject: [PATCH 79/82] +Added DEFAULT_2018_ANSWERS Added the new runtime parameter DEFAULT_2018_ANSWERS to set the default for all of the ..._2018_ANSWERS parameters. By default all answers are bitwise identical, but there is a new entry in the MOM_parameter_doc files. --- .../vertical/MOM_energetic_PBL.F90 | 6 +++++- src/parameterizations/vertical/MOM_opacity.F90 | 7 ++++++- .../vertical/MOM_set_diffusivity.F90 | 14 ++++++++------ .../vertical/MOM_set_viscosity.F90 | 11 ++++++++--- .../vertical/MOM_tidal_mixing.F90 | 13 ++++++++----- 5 files changed, 35 insertions(+), 16 deletions(-) diff --git a/src/parameterizations/vertical/MOM_energetic_PBL.F90 b/src/parameterizations/vertical/MOM_energetic_PBL.F90 index ecdbebe51e..1d4a3599f4 100644 --- a/src/parameterizations/vertical/MOM_energetic_PBL.F90 +++ b/src/parameterizations/vertical/MOM_energetic_PBL.F90 @@ -1969,6 +1969,7 @@ subroutine energetic_PBL_init(Time, G, GV, US, param_file, diag, CS) real :: Z3_T3_to_m3_s3 ! A conversion factor for work diagnostics [m3 T3 Z-3 s-3 ~> nondim] integer :: isd, ied, jsd, jed integer :: mstar_mode, LT_enhance, wT_mode + logical :: default_2018_answers logical :: use_temperature, use_omega logical :: use_la_windsea isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed @@ -2008,10 +2009,13 @@ subroutine energetic_PBL_init(Time, G, GV, US, param_file, diag, CS) "A nondimensional scaling factor controlling the inhibition "//& "of the diffusive length scale by rotation. Making this larger "//& "decreases the PBL diffusivity.", units="nondim", default=1.0) + call get_param(param_file, mdl, "DEFAULT_2018_ANSWERS", default_2018_answers, & + "This sets the default value for the various _2018_ANSWERS parameters.", & + default=.true.) call get_param(param_file, mdl, "EPBL_2018_ANSWERS", CS%answers_2018, & "If true, use the order of arithmetic and expressions that recover the "//& "answers from the end of 2018. Otherwise, use updated and more robust "//& - "forms of the same expressions.", default=.true.) + "forms of the same expressions.", default=default_2018_answers) call get_param(param_file, mdl, "EPBL_ORIGINAL_PE_CALC", CS%orig_PE_calc, & diff --git a/src/parameterizations/vertical/MOM_opacity.F90 b/src/parameterizations/vertical/MOM_opacity.F90 index 6428cfc2dd..4fc420f24f 100644 --- a/src/parameterizations/vertical/MOM_opacity.F90 +++ b/src/parameterizations/vertical/MOM_opacity.F90 @@ -927,6 +927,7 @@ subroutine opacity_init(Time, G, GV, US, param_file, diag, CS, optics) real :: PenSW_absorb_minthick ! A thickness that is used to absorb the remaining shortwave heat ! flux when that flux drops below PEN_SW_FLUX_ABSORB [m]. real :: PenSW_minthick_dflt ! The default for PenSW_absorb_minthick [m] + logical :: default_2018_answers logical :: use_scheme integer :: isd, ied, jsd, jed, nz, n isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed ; nz = G%ke @@ -1032,10 +1033,14 @@ subroutine opacity_init(Time, G, GV, US, param_file, diag, CS, optics) "set_opacity: \Cannot use a single_exp opacity scheme with nbands!=1.") endif + call get_param(param_file, mdl, "DEFAULT_2018_ANSWERS", default_2018_answers, & + "This sets the default value for the various _2018_ANSWERS parameters.", & + default=.true.) call get_param(param_file, mdl, "OPTICS_2018_ANSWERS", optics%answers_2018, & "If true, use the order of arithmetic and expressions that recover the "//& "answers from the end of 2018. Otherwise, use updated expressions for "//& - "handling the absorpption of small remaining shortwave fluxes.", default=.true.) + "handling the absorption of small remaining shortwave fluxes.", & + default=default_2018_answers) call get_param(param_file, mdl, "PEN_SW_FLUX_ABSORB", optics%PenSW_flux_absorb, & "A minimum remaining shortwave heating rate that will be simply absorbed in "//& diff --git a/src/parameterizations/vertical/MOM_set_diffusivity.F90 b/src/parameterizations/vertical/MOM_set_diffusivity.F90 index 3d68918365..c47f037789 100644 --- a/src/parameterizations/vertical/MOM_set_diffusivity.F90 +++ b/src/parameterizations/vertical/MOM_set_diffusivity.F90 @@ -1889,13 +1889,12 @@ subroutine set_diffusivity_init(Time, G, GV, US, param_file, diag, CS, int_tide_ integer, optional, intent(out) :: halo_TS !< The halo size of tracer points that must be !! valid for the calculations in set_diffusivity. - ! local variables + ! Local variables real :: decay_length logical :: ML_use_omega - -! This include declares and sets the variable "version". -#include "version_variable.h" - + logical :: default_2018_answers + ! This include declares and sets the variable "version". +# include "version_variable.h" character(len=40) :: mdl = "MOM_set_diffusivity" ! This module's name. real :: omega_frac_dflt integer :: i, j, is, ie, js, je @@ -1934,10 +1933,13 @@ subroutine set_diffusivity_init(Time, G, GV, US, param_file, diag, CS, int_tide_ "The rotation rate of the earth.", units="s-1", & default=7.2921e-5, scale=US%T_to_s) + call get_param(param_file, mdl, "DEFAULT_2018_ANSWERS", default_2018_answers, & + "This sets the default value for the various _2018_ANSWERS parameters.", & + default=.true.) call get_param(param_file, mdl, "SET_DIFF_2018_ANSWERS", CS%answers_2018, & "If true, use the order of arithmetic and expressions that recover the "//& "answers from the end of 2018. Otherwise, use updated and more robust "//& - "forms of the same expressions.", default=.true.) + "forms of the same expressions.", default=default_2018_answers) call get_param(param_file, mdl, "ML_RADIATION", CS%ML_radiation, & "If true, allow a fraction of TKE available from wind "//& diff --git a/src/parameterizations/vertical/MOM_set_viscosity.F90 b/src/parameterizations/vertical/MOM_set_viscosity.F90 index 370e2f7cfe..912ae64d44 100644 --- a/src/parameterizations/vertical/MOM_set_viscosity.F90 +++ b/src/parameterizations/vertical/MOM_set_viscosity.F90 @@ -1777,6 +1777,7 @@ subroutine set_visc_init(Time, G, GV, US, param_file, diag, visc, CS, restart_CS !! structure for this module type(MOM_restart_CS), pointer :: restart_CS !< A pointer to the restart control structure. type(ocean_OBC_type), pointer :: OBC !< A pointer to an open boundary condition structure + ! Local variables real :: Csmag_chan_dflt, smag_const1, TKE_decay_dflt, bulk_Ri_ML_dflt real :: Kv_background @@ -1789,11 +1790,12 @@ subroutine set_visc_init(Time, G, GV, US, param_file, diag, visc, CS, restart_CS ! representation in a restart file to the internal representation in this run. integer :: i, j, k, is, ie, js, je, n integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB, nz + logical :: default_2018_answers logical :: use_kappa_shear, adiabatic, use_omega logical :: use_CVMix_ddiff, differential_diffusion, use_KPP type(OBC_segment_type), pointer :: segment => NULL() ! pointer to OBC segment type -! This include declares and sets the variable "version". -#include "version_variable.h" + ! This include declares and sets the variable "version". +# include "version_variable.h" character(len=40) :: mdl = "MOM_set_visc" ! This module's name. if (associated(CS)) then @@ -1815,10 +1817,13 @@ subroutine set_visc_init(Time, G, GV, US, param_file, diag, visc, CS, restart_CS call log_version(param_file, mdl, version, "") CS%RiNo_mix = .false. ; use_CVMix_ddiff = .false. differential_diffusion = .false. + call get_param(param_file, mdl, "DEFAULT_2018_ANSWERS", default_2018_answers, & + "This sets the default value for the various _2018_ANSWERS parameters.", & + default=.true.) call get_param(param_file, mdl, "SET_VISC_2018_ANSWERS", CS%answers_2018, & "If true, use the order of arithmetic and expressions that recover the "//& "answers from the end of 2018. Otherwise, use updated and more robust "//& - "forms of the same expressions.", default=.true.) + "forms of the same expressions.", default=default_2018_answers) call get_param(param_file, mdl, "BOTTOMDRAGLAW", CS%bottomdraglaw, & "If true, the bottom stress is calculated with a drag "//& "law of the form c_drag*|u|*u. The velocity magnitude "//& diff --git a/src/parameterizations/vertical/MOM_tidal_mixing.F90 b/src/parameterizations/vertical/MOM_tidal_mixing.F90 index 5bab658e89..fd910697af 100644 --- a/src/parameterizations/vertical/MOM_tidal_mixing.F90 +++ b/src/parameterizations/vertical/MOM_tidal_mixing.F90 @@ -193,7 +193,6 @@ module MOM_tidal_mixing end type tidal_mixing_cs !!@{ Coded parmameters for specifying mixing schemes -character(len=40) :: mdl = "MOM_tidal_mixing" !< This module's name. character*(20), parameter :: STLAURENT_PROFILE_STRING = "STLAURENT_02" character*(20), parameter :: POLZIN_PROFILE_STRING = "POLZIN_09" integer, parameter :: STLAURENT_02 = 1 @@ -218,6 +217,7 @@ logical function tidal_mixing_init(Time, G, GV, US, param_file, diag, CS) ! Local variables logical :: read_tideamp + logical :: default_2018_answers character(len=20) :: tmpstr, int_tide_profile_str character(len=20) :: CVMix_tidal_scheme_str, tidal_energy_type character(len=200) :: filename, h2_file, Niku_TKE_input_file @@ -226,9 +226,9 @@ logical function tidal_mixing_init(Time, G, GV, US, param_file, diag, CS) real :: Niku_scale ! local variable for scaling the Nikurashin TKE flux data integer :: i, j, is, ie, js, je integer :: isd, ied, jsd, jed - -! This include declares and sets the variable "version". -#include "version_variable.h" + ! This include declares and sets the variable "version". +# include "version_variable.h" + character(len=40) :: mdl = "MOM_tidal_mixing" !< This module's name. if (associated(CS)) then call MOM_error(WARNING, "tidal_mixing_init called when control structure "// & @@ -263,10 +263,13 @@ logical function tidal_mixing_init(Time, G, GV, US, param_file, diag, CS) tidal_mixing_init = CS%int_tide_dissipation if (.not. tidal_mixing_init) return + call get_param(param_file, mdl, "DEFAULT_2018_ANSWERS", default_2018_answers, & + "This sets the default value for the various _2018_ANSWERS parameters.", & + default=.true.) call get_param(param_file, mdl, "TIDAL_MIXING_2018_ANSWERS", CS%answers_2018, & "If true, use the order of arithmetic and expressions that recover the "//& "answers from the end of 2018. Otherwise, use updated and more robust "//& - "forms of the same expressions.", default=.true.) + "forms of the same expressions.", default=default_2018_answers) if (CS%int_tide_dissipation) then From 25782117d6abca11e0500c4bec28402eb70c5f5b Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 9 Jul 2019 19:00:57 -0400 Subject: [PATCH 80/82] +Added WIND_GYRES_2018_ANSWERS Added the new runtime parameter WIND_GYRES_2018_ANSWERS to enable the transition to newer and simpler expressions for ustar in the gyres option of the solo_driver version of MOM_surface_forcing. Also replaced the markers in the comments around the controlled-forcing code with #CTRL# to distinguish them from other comments. By default all answers are bitwise identical, but there is a new entry in some MOM_parameter_doc files. --- config_src/solo_driver/MOM_driver.F90 | 2 +- .../solo_driver/MOM_surface_forcing.F90 | 96 ++++++++++++------- 2 files changed, 61 insertions(+), 37 deletions(-) diff --git a/config_src/solo_driver/MOM_driver.F90 b/config_src/solo_driver/MOM_driver.F90 index 22a216cb80..6fba8efdee 100644 --- a/config_src/solo_driver/MOM_driver.F90 +++ b/config_src/solo_driver/MOM_driver.F90 @@ -210,7 +210,7 @@ program MOM_main namelist /ocean_solo_nml/ date_init, calendar, months, days, hours, minutes, seconds,& ocean_nthreads, ncores_per_node, use_hyper_thread - !####################################################################### + !===================================================================== call write_cputime_start_clock(write_CPU_CSp) diff --git a/config_src/solo_driver/MOM_surface_forcing.F90 b/config_src/solo_driver/MOM_surface_forcing.F90 index 9bf44f658a..e31e78e7ec 100644 --- a/config_src/solo_driver/MOM_surface_forcing.F90 +++ b/config_src/solo_driver/MOM_surface_forcing.F90 @@ -105,7 +105,10 @@ module MOM_surface_forcing real :: gyres_taux_sin_amp !< The amplitude of cosine wind stress gyres [Pa], if WIND_CONFIG=='gyres'. real :: gyres_taux_cos_amp !< The amplitude of cosine wind stress gyres [Pa], if WIND_CONFIG=='gyres'. real :: gyres_taux_n_pis !< The number of sine lobes in the basin if if WIND_CONFIG=='gyres' - + logical :: answers_2018 !< If true, use the order of arithmetic and expressions that recover + !! the answers from the end of 2018. Otherwise, use a form of the gyre + !! wind stresses that are rotationally invariant and more likely to be + !! the same between compilers. real :: T_north !< target temperatures at north used in buoyancy_forcing_linear real :: T_south !< target temperatures at south used in buoyancy_forcing_linear @@ -124,7 +127,7 @@ module MOM_surface_forcing !! are staggered in WIND_FILE. Valid values are A or C for now. type(tracer_flow_control_CS), pointer :: tracer_flow_CSp => NULL() !< A pointer to the structure !! that is used to orchestrate the calling of tracer packages -!### type(ctrl_forcing_CS), pointer :: ctrl_forcing_CSp => NULL() +!#CTRL# type(ctrl_forcing_CS), pointer :: ctrl_forcing_CSp => NULL() type(MOM_restart_CS), pointer :: restart_CSp => NULL() !< A pointer to the restart control structure type(diag_ctrl), pointer :: diag !< structure used to regulate timing of diagnostic output @@ -477,7 +480,7 @@ subroutine wind_forcing_gyres(sfc_state, forces, day, G, US, CS) type(surface_forcing_CS), pointer :: CS !< pointer to control struct returned by !! a previous surface_forcing_init call ! Local variables - real :: PI, y + real :: PI, y, I_rho integer :: i, j, is, ie, js, je, Isq, Ieq, Jsq, Jeq call callTree_enter("wind_forcing_gyres, MOM_surface_forcing.F90") @@ -488,7 +491,7 @@ subroutine wind_forcing_gyres(sfc_state, forces, day, G, US, CS) PI = 4.0*atan(1.0) do j=js-1,je+1 ; do I=is-1,Ieq - y = (G%geoLatCu(I,j)-CS%South_lat)/CS%len_lat + y = (G%geoLatCu(I,j)-CS%South_lat) / CS%len_lat forces%taux(I,j) = CS%gyres_taux_const + & ( CS%gyres_taux_sin_amp*sin(CS%gyres_taux_n_pis*PI*y) & + CS%gyres_taux_cos_amp*cos(CS%gyres_taux_n_pis*PI*y) ) @@ -498,12 +501,21 @@ subroutine wind_forcing_gyres(sfc_state, forces, day, G, US, CS) forces%tauy(i,J) = 0.0 enddo ; enddo - ! set the friction velocity !### Add parenthesis so that this is rotationally invariant. - do j=js,je ; do i=is,ie - forces%ustar(i,j) = US%m_to_Z*US%T_to_s * sqrt(sqrt(0.5*(forces%tauy(i,j-1)*forces%tauy(i,j-1) + & - forces%tauy(i,j)*forces%tauy(i,j) + forces%taux(i-1,j)*forces%taux(i-1,j) + & - forces%taux(i,j)*forces%taux(i,j)))/CS%Rho0 + (CS%gust_const/CS%Rho0)) - enddo ; enddo + ! set the friction velocity + if (CS%answers_2018) then + do j=js,je ; do i=is,ie + forces%ustar(i,j) = US%m_to_Z*US%T_to_s * sqrt(sqrt(0.5*(forces%tauy(i,j-1)*forces%tauy(i,j-1) + & + forces%tauy(i,j)*forces%tauy(i,j) + forces%taux(i-1,j)*forces%taux(i-1,j) + & + forces%taux(i,j)*forces%taux(i,j)))/CS%Rho0 + (CS%gust_const/CS%Rho0)) + enddo ; enddo + else + I_rho = 1.0 / CS%Rho0 + do j=js,je ; do i=is,ie + forces%ustar(i,j) = US%m_to_Z*US%T_to_s * sqrt( (CS%gust_const + & + sqrt(0.5*((forces%tauy(i,J-1)**2 + forces%tauy(i,J)**2) + & + (forces%taux(I-1,j)**2 + forces%taux(I,j)**2))) ) * I_rho ) + enddo ; enddo + endif call callTree_leave("wind_forcing_gyres") end subroutine wind_forcing_gyres @@ -912,7 +924,7 @@ subroutine buoyancy_forcing_from_files(sfc_state, fluxes, day, dt, G, CS) CS%runoff_last_lev = time_lev ! Read the SST and SSS fields for damping. - if (CS%restorebuoy) then !### .or. associated(CS%ctrl_forcing_CSp)) then + if (CS%restorebuoy) then !#CTRL# .or. associated(CS%ctrl_forcing_CSp)) then select case (CS%SST_nlev) case (12) ; time_lev = time_lev_monthly case (365) ; time_lev = time_lev_daily @@ -993,15 +1005,15 @@ subroutine buoyancy_forcing_from_files(sfc_state, fluxes, day, dt, G, CS) endif ! end RESTOREBUOY -!### if (associated(CS%ctrl_forcing_CSp)) then -!### do j=js,je ; do i=is,ie -!### SST_anom(i,j) = sfc_state%SST(i,j) - CS%T_Restore(i,j) -!### SSS_anom(i,j) = sfc_state%SSS(i,j) - CS%S_Restore(i,j) -!### SSS_mean(i,j) = 0.5*(sfc_state%SSS(i,j) + CS%S_Restore(i,j)) -!### enddo ; enddo -!### call apply_ctrl_forcing(SST_anom, SSS_anom, SSS_mean, fluxes%heat_added, & -!### fluxes%vprec, day, dt, G, CS%ctrl_forcing_CSp) -!### endif +!#CTRL# if (associated(CS%ctrl_forcing_CSp)) then +!#CTRL# do j=js,je ; do i=is,ie +!#CTRL# SST_anom(i,j) = sfc_state%SST(i,j) - CS%T_Restore(i,j) +!#CTRL# SSS_anom(i,j) = sfc_state%SSS(i,j) - CS%S_Restore(i,j) +!#CTRL# SSS_mean(i,j) = 0.5*(sfc_state%SSS(i,j) + CS%S_Restore(i,j)) +!#CTRL# enddo ; enddo +!#CTRL# call apply_ctrl_forcing(SST_anom, SSS_anom, SSS_mean, fluxes%heat_added, & +!#CTRL# fluxes%vprec, day, dt, G, CS%ctrl_forcing_CSp) +!#CTRL# endif call callTree_leave("buoyancy_forcing_from_files") end subroutine buoyancy_forcing_from_files @@ -1094,7 +1106,7 @@ subroutine buoyancy_forcing_from_data_override(sfc_state, fluxes, day, dt, G, CS is_in=is_in, ie_in=ie_in, js_in=js_in, je_in=je_in) ! Read the SST and SSS fields for damping. - if (CS%restorebuoy) then !### .or. associated(CS%ctrl_forcing_CSp)) then + if (CS%restorebuoy) then !#CTRL# .or. associated(CS%ctrl_forcing_CSp)) then call data_override('OCN', 'SST_restore', CS%T_restore(:,:), day, & is_in=is_in, ie_in=ie_in, js_in=js_in, je_in=je_in) @@ -1159,15 +1171,15 @@ subroutine buoyancy_forcing_from_data_override(sfc_state, fluxes, day, dt, G, CS enddo ; enddo -!### if (associated(CS%ctrl_forcing_CSp)) then -!### do j=js,je ; do i=is,ie -!### SST_anom(i,j) = sfc_state%SST(i,j) - CS%T_Restore(i,j) -!### SSS_anom(i,j) = sfc_state%SSS(i,j) - CS%S_Restore(i,j) -!### SSS_mean(i,j) = 0.5*(sfc_state%SSS(i,j) + CS%S_Restore(i,j)) -!### enddo ; enddo -!### call apply_ctrl_forcing(SST_anom, SSS_anom, SSS_mean, fluxes%heat_added, & -!### fluxes%vprec, day, dt, G, CS%ctrl_forcing_CSp) -!### endif +!#CTRL# if (associated(CS%ctrl_forcing_CSp)) then +!#CTRL# do j=js,je ; do i=is,ie +!#CTRL# SST_anom(i,j) = sfc_state%SST(i,j) - CS%T_Restore(i,j) +!#CTRL# SSS_anom(i,j) = sfc_state%SSS(i,j) - CS%S_Restore(i,j) +!#CTRL# SSS_mean(i,j) = 0.5*(sfc_state%SSS(i,j) + CS%S_Restore(i,j)) +!#CTRL# enddo ; enddo +!#CTRL# call apply_ctrl_forcing(SST_anom, SSS_anom, SSS_mean, fluxes%heat_added, & +!#CTRL# fluxes%vprec, day, dt, G, CS%ctrl_forcing_CSp) +!#CTRL# endif call callTree_leave("buoyancy_forcing_from_data_override") end subroutine buoyancy_forcing_from_data_override @@ -1367,12 +1379,14 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, tracer_flow_C type(surface_forcing_CS), pointer :: CS !< pointer to control struct returned by !! a previous surface_forcing_init call type(tracer_flow_control_CS), pointer :: tracer_flow_CSp !< Forcing for tracers? + ! Local variables type(directories) :: dirs logical :: new_sim type(time_type) :: Time_frc -! This include declares and sets the variable "version". -#include "version_variable.h" + ! This include declares and sets the variable "version". +# include "version_variable.h" + logical :: default_2018_answers character(len=40) :: mdl = "MOM_surface_forcing" ! This module's name. character(len=200) :: filename, gust_file ! The name of the gustiness input file. @@ -1601,6 +1615,16 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, tracer_flow_C "the zonal wind stress profile: "//& " n in taux = A + B*sin(n*pi*y/L) + C*cos(n*pi*y/L).", & units="nondim", default=0.0) + call get_param(param_file, mdl, "DEFAULT_2018_ANSWERS", default_2018_answers, & + "This sets the default value for the various _2018_ANSWERS parameters.", & + default=.true.) + call get_param(param_file, mdl, "WIND_GYRES_2018_ANSWERS", CS%answers_2018, & + "If true, use the order of arithmetic and expressions that recover the answers "//& + "from the end of 2018. Otherwise, use expressions for the gyre friction velocities "//& + "that are rotationally invariant and more likely to be the same between compilers.", & + default=default_2018_answers) + else + CS%answers_2018 = .false. endif if ((trim(CS%wind_config) == "2gyre") .or. & (trim(CS%wind_config) == "1gyre") .or. & @@ -1719,8 +1743,8 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, tracer_flow_C ! Set up any restart fields associated with the forcing. call restart_init(param_file, CS%restart_CSp, "MOM_forcing.res") -!### call register_ctrl_forcing_restarts(G, param_file, CS%ctrl_forcing_CSp, & -!### CS%restart_CSp) +!#CTRL# call register_ctrl_forcing_restarts(G, param_file, CS%ctrl_forcing_CSp, & +!#CTRL# CS%restart_CSp) call restart_init_end(CS%restart_CSp) if (associated(CS%restart_CSp)) then @@ -1753,7 +1777,7 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, tracer_flow_C if (trim(CS%wind_config) == "file") & CS%wind_nlev = num_timelevels(CS%wind_file, CS%stress_x_var, min_dims=3) -!### call controlled_forcing_init(Time, G, param_file, diag, CS%ctrl_forcing_CSp) +!#CTRL# call controlled_forcing_init(Time, G, param_file, diag, CS%ctrl_forcing_CSp) call user_revise_forcing_init(param_file, CS%urf_CS) @@ -1773,7 +1797,7 @@ subroutine surface_forcing_end(CS, fluxes) if (present(fluxes)) call deallocate_forcing_type(fluxes) -!### call controlled_forcing_end(CS%ctrl_forcing_CSp) +!#CTRL# call controlled_forcing_end(CS%ctrl_forcing_CSp) if (associated(CS)) deallocate(CS) CS => NULL() From 1b31d9d2feae08e946644b18423d09655a0f071b Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 9 Jul 2019 19:01:20 -0400 Subject: [PATCH 81/82] +Added SURFACE_FORCING_2018_ANSWERS Added the new runtime parameter SURFACE_FORCING_2018_ANSWERS to enable the transition to newer and simpler expressions for gustless_ustar in the coupled_driver version of MOM_surface_forcing. Also replaced the markers in the comments around the controlled-forcing code with #CTRL# to distinguish them from other comments. By default all answers are bitwise identical, but there is a new entry in some MOM_parameter_doc files. --- .../coupled_driver/MOM_surface_forcing.F90 | 88 ++++++++++++------- 1 file changed, 54 insertions(+), 34 deletions(-) diff --git a/config_src/coupled_driver/MOM_surface_forcing.F90 b/config_src/coupled_driver/MOM_surface_forcing.F90 index f48b755d67..bb6270c177 100644 --- a/config_src/coupled_driver/MOM_surface_forcing.F90 +++ b/config_src/coupled_driver/MOM_surface_forcing.F90 @@ -2,9 +2,9 @@ module MOM_surface_forcing ! This file is part of MOM6. See LICENSE.md for the license. -!### use MOM_controlled_forcing, only : apply_ctrl_forcing, register_ctrl_forcing_restarts -!### use MOM_controlled_forcing, only : controlled_forcing_init, controlled_forcing_end -!### use MOM_controlled_forcing, only : ctrl_forcing_CS +!#CTRL# use MOM_controlled_forcing, only : apply_ctrl_forcing, register_ctrl_forcing_restarts +!#CTRL# use MOM_controlled_forcing, only : controlled_forcing_init, controlled_forcing_end +!#CTRL# use MOM_controlled_forcing, only : ctrl_forcing_CS use MOM_coms, only : reproducing_sum use MOM_constants, only : hlv, hlf use MOM_cpu_clock, only : cpu_clock_id, cpu_clock_begin, cpu_clock_end @@ -127,6 +127,9 @@ module MOM_surface_forcing real :: max_delta_srestore !< Maximum delta salinity used for restoring real :: max_delta_trestore !< Maximum delta sst used for restoring real, pointer, dimension(:,:) :: basin_mask => NULL() !< Mask for surface salinity restoring by basin + logical :: answers_2018 !< If true, use the order of arithmetic and expressions that recover + !! the answers from the end of 2018. Otherwise, use a simpler + !! expression to calculate gustiness. type(diag_ctrl), pointer :: diag => NULL() !< Structure to regulate diagnostic output timing character(len=200) :: inputdir !< Directory where NetCDF input files are @@ -149,7 +152,7 @@ module MOM_surface_forcing type(forcing_diags), public :: handles !< Diagnostics handles -!### type(ctrl_forcing_CS), pointer :: ctrl_forcing_CSp => NULL() +!#CTRL# type(ctrl_forcing_CS), pointer :: ctrl_forcing_CSp => NULL() type(MOM_restart_CS), pointer :: restart_CSp => NULL() !< A pointer to the restart control structure type(user_revise_forcing_CS), pointer :: urf_CS => NULL() !< A control structure for user forcing revisions end type surface_forcing_CS @@ -492,15 +495,15 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, US, CS, sfc enddo ; enddo endif -!### if (associated(CS%ctrl_forcing_CSp)) then -!### do j=js,je ; do i=is,ie -!### SST_anom(i,j) = sfc_state%SST(i,j) - CS%T_Restore(i,j) -!### SSS_anom(i,j) = sfc_state%SSS(i,j) - CS%S_Restore(i,j) -!### SSS_mean(i,j) = 0.5*(sfc_state%SSS(i,j) + CS%S_Restore(i,j)) -!### enddo ; enddo -!### call apply_ctrl_forcing(SST_anom, SSS_anom, SSS_mean, fluxes%heat_restore, & -!### fluxes%vprec, day, dt, G, CS%ctrl_forcing_CSp) -!### endif +!#CTRL# if (associated(CS%ctrl_forcing_CSp)) then +!#CTRL# do j=js,je ; do i=is,ie +!#CTRL# SST_anom(i,j) = sfc_state%SST(i,j) - CS%T_Restore(i,j) +!#CTRL# SSS_anom(i,j) = sfc_state%SSS(i,j) - CS%S_Restore(i,j) +!#CTRL# SSS_mean(i,j) = 0.5*(sfc_state%SSS(i,j) + CS%S_Restore(i,j)) +!#CTRL# enddo ; enddo +!#CTRL# call apply_ctrl_forcing(SST_anom, SSS_anom, SSS_mean, fluxes%heat_restore, & +!#CTRL# fluxes%vprec, day, dt, G, CS%ctrl_forcing_CSp) +!#CTRL# endif ! adjust the NET fresh-water flux to zero, if flagged if (CS%adjust_net_fresh_water_to_zero) then @@ -939,7 +942,6 @@ subroutine extract_IOB_stresses(IOB, index_bounds, Time, G, US, CS, taux, tauy, if (associated(IOB%stress_mag)) then if (do_ustar) then ; do j=js,je ; do i=is,ie gustiness = CS%gust_const - !### SIMPLIFY THE TREATMENT OF GUSTINESS! if (CS%read_gust_2d) then if ((wind_stagger == CGRID_NE) .or. & ((wind_stagger == AGRID) .and. (G%mask2dT(i,j) > 0)) .or. & @@ -950,11 +952,15 @@ subroutine extract_IOB_stresses(IOB, index_bounds, Time, G, US, CS, taux, tauy, endif ustar(i,j) = sqrt(gustiness*Irho0 + Irho0*IOB%stress_mag(i-i0,j-j0)) enddo ; enddo ; endif - if (do_gustless) then ; do j=js,je ; do i=is,ie - gustless_ustar(i,j) = US%m_to_Z*US%T_to_s * sqrt(IOB%stress_mag(i-i0,j-j0) / CS%Rho0) -!### Change to: -! gustless_ustar(i,j) = sqrt(Irho0 * IOB%stress_mag(i-i0,j-j0)) - enddo ; enddo ; endif + if (CS%answers_2018) then + if (do_gustless) then ; do j=js,je ; do i=is,ie + gustless_ustar(i,j) = US%m_to_Z*US%T_to_s * sqrt(IOB%stress_mag(i-i0,j-j0) / CS%Rho0) + enddo ; enddo ; endif + else + if (do_gustless) then ; do j=js,je ; do i=is,ie + gustless_ustar(i,j) = sqrt(Irho0 * IOB%stress_mag(i-i0,j-j0)) + enddo ; enddo ; endif + endif elseif (wind_stagger == BGRID_NE) then do j=js,je ; do i=is,ie tau_mag = 0.0 ; gustiness = CS%gust_const @@ -968,9 +974,11 @@ subroutine extract_IOB_stresses(IOB, index_bounds, Time, G, US, CS, taux, tauy, if (CS%read_gust_2d) gustiness = CS%gust(i,j) endif if (do_ustar) ustar(i,j) = sqrt(gustiness*Irho0 + Irho0 * tau_mag) - if (do_gustless) gustless_ustar(i,j) = US%m_to_Z*US%T_to_s * sqrt(tau_mag / CS%Rho0) -!### Change to: -! if (do_gustless) gustless_ustar(i,j) = sqrt(Irho0 * tau_mag) + if (CS%answers_2018) then + if (do_gustless) gustless_ustar(i,j) = US%m_to_Z*US%T_to_s * sqrt(tau_mag / CS%Rho0) + else + if (do_gustless) gustless_ustar(i,j) = sqrt(Irho0 * tau_mag) + endif enddo ; enddo elseif (wind_stagger == AGRID) then do j=js,je ; do i=is,ie @@ -978,9 +986,11 @@ subroutine extract_IOB_stresses(IOB, index_bounds, Time, G, US, CS, taux, tauy, gustiness = CS%gust_const if (CS%read_gust_2d .and. (G%mask2dT(i,j) > 0)) gustiness = CS%gust(i,j) if (do_ustar) ustar(i,j) = sqrt(gustiness*Irho0 + Irho0 * tau_mag) - if (do_gustless) gustless_ustar(i,j) = US%m_to_Z*US%T_to_s * sqrt(tau_mag / CS%Rho0) -!### Change to: -! if (do_gustless) gustless_ustar(i,j) = sqrt(Irho0 * tau_mag) + if (CS%answers_2018) then + if (do_gustless) gustless_ustar(i,j) = US%m_to_Z*US%T_to_s * sqrt(tau_mag / CS%Rho0) + else + if (do_gustless) gustless_ustar(i,j) = sqrt(Irho0 * tau_mag) + endif enddo ; enddo else ! C-grid wind stresses. do j=js,je ; do i=is,ie @@ -997,9 +1007,11 @@ subroutine extract_IOB_stresses(IOB, index_bounds, Time, G, US, CS, taux, tauy, if (CS%read_gust_2d) gustiness = CS%gust(i,j) if (do_ustar) ustar(i,j) = sqrt(gustiness*Irho0 + Irho0 * tau_mag) - if (do_gustless) gustless_ustar(i,j) = US%m_to_Z*US%T_to_s * sqrt(tau_mag / CS%Rho0) -!### Change to: -! if (do_gustless) gustless_ustar(i,j) = sqrt(Irho0 * tau_mag) + if (CS%answers_2018) then + if (do_gustless) gustless_ustar(i,j) = US%m_to_Z*US%T_to_s * sqrt(tau_mag / CS%Rho0) + else + if (do_gustless) gustless_ustar(i,j) = sqrt(Irho0 * tau_mag) + endif enddo ; enddo endif ! endif for wind friction velocity fields endif @@ -1145,10 +1157,11 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS) real :: utide ! The RMS tidal velocity [m s-1]. type(directories) :: dirs logical :: new_sim, iceberg_flux_diags + logical :: default_2018_answers type(time_type) :: Time_frc character(len=200) :: TideAmp_file, gust_file, salt_file, temp_file ! Input file names. -! This include declares and sets the variable "version". -#include "version_variable.h" + ! This include declares and sets the variable "version". +# include "version_variable.h" character(len=40) :: mdl = "MOM_surface_forcing" ! This module's name. character(len=48) :: stagger character(len=48) :: flnam @@ -1392,6 +1405,13 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS) gust_file = trim(CS%inputdir) // trim(gust_file) call MOM_read_data(gust_file,'gustiness',CS%gust,G%domain, timelevel=1) ! units should be Pa endif + call get_param(param_file, mdl, "DEFAULT_2018_ANSWERS", default_2018_answers, & + "This sets the default value for the various _2018_ANSWERS parameters.", & + default=.true.) + call get_param(param_file, mdl, "SURFACE_FORCING_2018_ANSWERS", CS%answers_2018, & + "If true, use the order of arithmetic and expressions that recover the answers "//& + "from the end of 2018. Otherwise, use a simpler expression to calculate gustiness.", & + default=default_2018_answers) ! See whether sufficiently thick sea ice should be treated as rigid. call get_param(param_file, mdl, "USE_RIGID_SEA_ICE", CS%rigid_sea_ice, & @@ -1449,8 +1469,8 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS) ! Set up any restart fields associated with the forcing. call restart_init(param_file, CS%restart_CSp, "MOM_forcing.res") -!### call register_ctrl_forcing_restarts(G, param_file, CS%ctrl_forcing_CSp, & -!### CS%restart_CSp) +!#CTRL# call register_ctrl_forcing_restarts(G, param_file, CS%ctrl_forcing_CSp, & +!#CTRL# CS%restart_CSp) call restart_init_end(CS%restart_CSp) if (associated(CS%restart_CSp)) then @@ -1465,7 +1485,7 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS) endif endif -!### call controlled_forcing_init(Time, G, param_file, diag, CS%ctrl_forcing_CSp) +!#CTRL# call controlled_forcing_init(Time, G, param_file, diag, CS%ctrl_forcing_CSp) call user_revise_forcing_init(param_file, CS%urf_CS) @@ -1483,7 +1503,7 @@ subroutine surface_forcing_end(CS, fluxes) if (present(fluxes)) call deallocate_forcing_type(fluxes) -!### call controlled_forcing_end(CS%ctrl_forcing_CSp) +!#CTRL# call controlled_forcing_end(CS%ctrl_forcing_CSp) if (associated(CS)) deallocate(CS) CS => NULL() From 5645cc0d35ff2de14e15b17989eec5c4a5faf5d5 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Wed, 10 Jul 2019 10:33:01 -0400 Subject: [PATCH 82/82] Fixed the doxyGen comment for Langmuir_number Fixed the doxyGen comment for Langmuir_number in the arguments to Mstar_Langmuir. All answers are bitwise identical --- src/parameterizations/vertical/MOM_energetic_PBL.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/parameterizations/vertical/MOM_energetic_PBL.F90 b/src/parameterizations/vertical/MOM_energetic_PBL.F90 index 1d4a3599f4..64d90e02ff 100644 --- a/src/parameterizations/vertical/MOM_energetic_PBL.F90 +++ b/src/parameterizations/vertical/MOM_energetic_PBL.F90 @@ -1852,7 +1852,7 @@ subroutine Mstar_Langmuir(CS, US, abs_Coriolis, buoyancy_flux, ustar, BLD, Langm real, intent(in) :: UStar !< Surface friction velocity with? gustiness [Z T-1 ~> m s-1] real, intent(in) :: BLD !< boundary layer depth [Z ~> m] real, intent(inout) :: Mstar !< Input/output mstar (Mixing/ustar**3) [nondim] - real, intent(in) :: Langmuir_Number !Langmuir number [nondim] + real, intent(in) :: Langmuir_Number !< Langmuir number [nondim] real, intent(out) :: MStar_LT !< Mstar increase due to Langmuir turbulence [nondim] real, intent(out) :: Convect_Langmuir_number !< Langmuir number including buoyancy flux [nondim]