From ea57802abffc16fb444196d4f6f6c4630a17a590 Mon Sep 17 00:00:00 2001 From: Brandon Reichl Date: Fri, 24 May 2019 10:15:10 -0400 Subject: [PATCH 001/150] 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 002/150] 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 003/150] 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 004/150] +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 005/150] 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 006/150] 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 007/150] 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 008/150] 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 009/150] 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 010/150] 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 011/150] 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 012/150] +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 013/150] +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 014/150] 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 015/150] +(*)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 016/150] +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 017/150] 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 018/150] +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 019/150] 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 020/150] 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 021/150] +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 022/150] +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 023/150] +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 024/150] +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 5ff40fbdbda313873f4363730c748d9ab1bf8657 Mon Sep 17 00:00:00 2001 From: Marshall Ward Date: Wed, 19 Jun 2019 16:43:09 -0400 Subject: [PATCH 025/150] * High precision energy stats output Since we currently rely on ocean.stats and seaice.stats to detect regressions, there are cases (mostly very short runs) which are not detected by the current 12-decimal precision. This patch extends the precision of the *.stats files to 16 decimal places (scaled), which matches machine precision. --- src/diagnostics/MOM_sum_output.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/diagnostics/MOM_sum_output.F90 b/src/diagnostics/MOM_sum_output.F90 index 9399f73a58..842f9ff3c2 100644 --- a/src/diagnostics/MOM_sum_output.F90 +++ b/src/diagnostics/MOM_sum_output.F90 @@ -818,7 +818,7 @@ subroutine write_energy(u, v, h, tv, day, n, G, GV, US, CS, tracer_CSp, OBC, dt_ endif if (CS%use_temperature) then - write(CS%fileenergy_ascii,'(A,",",A,",", I6,", En ",ES18.12, & + write(CS%fileenergy_ascii,'(A,",",A,",", I6,", En ",ES22.16, & &", CFL ", F8.5, ", SL ",& &es11.4,", M ",ES11.5,", S",f8.4,", T",f8.4,& &", Me ",ES9.2,", Se ",ES9.2,", Te ",ES9.2)') & @@ -826,7 +826,7 @@ subroutine write_energy(u, v, h, tv, day, n, G, GV, US, CS, tracer_CSp, OBC, dt_ -H_0APE(1), mass_tot, salin, temp, mass_anom/mass_tot, salin_anom, & temp_anom else - write(CS%fileenergy_ascii,'(A,",",A,",", I6,", En ",ES18.12, & + write(CS%fileenergy_ascii,'(A,",",A,",", I6,", En ",ES22.16, & &", CFL ", F8.5, ", SL ",& &ES11.4,", Mass ",ES11.5,", Me ",ES9.2)') & trim(n_str), trim(day_str), CS%ntrunc, En_mass, max_CFL(1), & From 6c9a442f6d24c6c8f12199e693066f9017e3eee7 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Wed, 19 Jun 2019 18:54:03 -0400 Subject: [PATCH 026/150] +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 9d8468a324520802ecb5f38c3dc759c55637c0da Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Fri, 21 Jun 2019 13:30:02 -0600 Subject: [PATCH 027/150] Commenting salt_flux adjustment in net_FW --- config_src/mct_driver/MOM_surface_forcing.F90 | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/config_src/mct_driver/MOM_surface_forcing.F90 b/config_src/mct_driver/MOM_surface_forcing.F90 index 3a82794723..67bf2f1913 100644 --- a/config_src/mct_driver/MOM_surface_forcing.F90 +++ b/config_src/mct_driver/MOM_surface_forcing.F90 @@ -513,9 +513,9 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, Time, G, US, CS, & ! To do this correctly we will need a sea-ice melt field added to IOB. -AJA ! GMM: as stated above, the following is wrong. CIME deals with volume/mass and ! heat from sea ice/snow via seaice_melt and seaice_melt_heat, respectively. - if (associated(fluxes%salt_flux) .and. (CS%ice_salt_concentration>0.0)) & - net_FW(i,j) = net_FW(i,j) + G%areaT(i,j) * & - (fluxes%salt_flux(i,j) / CS%ice_salt_concentration) + !if (associated(fluxes%salt_flux) .and. (CS%ice_salt_concentration>0.0)) & + ! net_FW(i,j) = net_FW(i,j) + G%areaT(i,j) * & + ! (fluxes%salt_flux(i,j) / CS%ice_salt_concentration) net_FW2(i,j) = net_FW(i,j)/G%areaT(i,j) enddo; enddo From eb5f06c20f7a1d36ab35aa07d733937c8bfe7f09 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Fri, 21 Jun 2019 11:51:34 -0400 Subject: [PATCH 028/150] +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 029/150] +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 97c2395a58af4f5ad716bb52742fa5d64a07c659 Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Sun, 23 Jun 2019 17:42:58 -0600 Subject: [PATCH 030/150] Commenting out salt_flux adjustment in net_FW in NUOPC cap --- config_src/nuopc_driver/MOM_surface_forcing.F90 | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/config_src/nuopc_driver/MOM_surface_forcing.F90 b/config_src/nuopc_driver/MOM_surface_forcing.F90 index aecfd419da..c90526f98a 100644 --- a/config_src/nuopc_driver/MOM_surface_forcing.F90 +++ b/config_src/nuopc_driver/MOM_surface_forcing.F90 @@ -552,9 +552,10 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, US, CS, & ! To do this correctly we will need a sea-ice melt field added to IOB. -AJA ! GMM: as stated above, the following is wrong. CIME deals with volume/mass and ! heat from sea ice/snow via seaice_melt and seaice_melt_heat, respectively. - if (associated(IOB%salt_flux) .and. (CS%ice_salt_concentration>0.0)) & - net_FW(i,j) = net_FW(i,j) + sign_for_net_FW_bug * G%areaT(i,j) * & - (IOB%salt_flux(i-i0,j-j0) / CS%ice_salt_concentration) + !if (associated(IOB%salt_flux) .and. (CS%ice_salt_concentration>0.0)) & + ! net_FW(i,j) = net_FW(i,j) + sign_for_net_FW_bug * G%areaT(i,j) * & + ! (IOB%salt_flux(i-i0,j-j0) / CS%ice_salt_concentration) + net_FW2(i,j) = net_FW(i,j) / G%areaT(i,j) enddo ; enddo From 3f7e9f629eebfce33ca776afbec3bf0a3dedfa96 Mon Sep 17 00:00:00 2001 From: mvertens Date: Mon, 24 Jun 2019 11:26:45 -0600 Subject: [PATCH 031/150] changes needed for mom6 validation --- config_src/nuopc_driver/mom_cap.F90 | 139 +++--- config_src/nuopc_driver/mom_cap_methods.F90 | 460 ++++++++++---------- 2 files changed, 289 insertions(+), 310 deletions(-) diff --git a/config_src/nuopc_driver/mom_cap.F90 b/config_src/nuopc_driver/mom_cap.F90 index 3992aae530..0e46a454f7 100644 --- a/config_src/nuopc_driver/mom_cap.F90 +++ b/config_src/nuopc_driver/mom_cap.F90 @@ -1803,16 +1803,6 @@ subroutine ModelAdvance(gcomp, rc) file=__FILE__)) & return ! bail out - call ESMF_GridCompGetInternalState(gcomp, ocean_internalstate, rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - Ice_ocean_boundary => ocean_internalstate%ptr%ice_ocean_boundary_type_ptr - ocean_public => ocean_internalstate%ptr%ocean_public_type_ptr - ocean_state => ocean_internalstate%ptr%ocean_state_type_ptr - ! HERE THE MODEL ADVANCES: currTime -> currTime + timeStep call ESMF_ClockPrint(clock, options="currTime", & @@ -1835,8 +1825,7 @@ subroutine ModelAdvance(gcomp, rc) return ! bail out call ESMF_TimePrint(currTime + timeStep, & - preString="--------------------------------> to: ", & - unit=msgString, rc=rc) + preString="--------------------------------> to: ", unit=msgString, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & @@ -1869,83 +1858,89 @@ subroutine ModelAdvance(gcomp, rc) do_advance = .true. endif - ! If the second cpl tstep of a startup run, step back a cpl tstep and advance for two cpl tsteps - if (currTime == startTime + timeStep) then - call ESMF_LogWrite("MOM6 - Stepping back one coupling timestep", ESMF_LOGMSG_INFO, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - Time = esmf2fms_time(currTime-timeStep) ! i.e., startTime + if (do_advance) then + ! If the second cpl tstep of a startup run, step back a cpl tstep and advance for two cpl tsteps + if (currTime == startTime + timeStep) then + call ESMF_LogWrite("MOM6 - Stepping back one coupling timestep", ESMF_LOGMSG_INFO, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + Time = esmf2fms_time(currTime-timeStep) ! i.e., startTime + + call ESMF_LogWrite("MOM6 - doubling the coupling timestep", ESMF_LOGMSG_INFO, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + Time_step_coupled = 2 * esmf2fms_time(timeStep) + endif + end if - call ESMF_LogWrite("MOM6 - doubling the coupling timestep", ESMF_LOGMSG_INFO, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - Time_step_coupled = 2 * esmf2fms_time(timeStep) - endif endif endif + if (do_advance) then - !--------------- - ! Write diagnostics for import - !--------------- + call ESMF_GridCompGetInternalState(gcomp, ocean_internalstate, rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out - if(write_diagnostics) then - call NUOPC_Write(importState, fileNamePrefix='field_ocn_import_', & - timeslice=import_slice, relaxedFlag=.true., rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - import_slice = import_slice + 1 - endif + Ice_ocean_boundary => ocean_internalstate%ptr%ice_ocean_boundary_type_ptr + ocean_public => ocean_internalstate%ptr%ocean_public_type_ptr + ocean_state => ocean_internalstate%ptr%ocean_state_type_ptr - !--------------- - ! Get ocean grid - !--------------- + !--------------- + ! Write diagnostics for import + !--------------- - call get_ocean_grid(ocean_state, ocean_grid) + if (write_diagnostics) then + call NUOPC_Write(importState, fileNamePrefix='field_ocn_import_', & + timeslice=import_slice, relaxedFlag=.true., rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + import_slice = import_slice + 1 + endif - !--------------- - ! Import data - !--------------- + !--------------- + ! Get ocean grid + !--------------- - call shr_file_setLogUnit (logunit) + call get_ocean_grid(ocean_state, ocean_grid) + + !--------------- + ! Import data + !--------------- - if (cesm_coupled) then - call mom_import(ocean_public, ocean_grid, importState, ice_ocean_boundary, runtype=runtype, rc=rc) - else call mom_import(ocean_public, ocean_grid, importState, ice_ocean_boundary, rc=rc) - endif - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out - !--------------- - ! Update MOM6 - !--------------- + !--------------- + ! Update MOM6 + !--------------- - if(profile_memory) call ESMF_VMLogMemInfo("Entering MOM update_ocean_model: ") - if (do_advance) then - call update_ocean_model(Ice_ocean_boundary, ocean_state, ocean_public, Time, Time_step_coupled) - endif - if(profile_memory) call ESMF_VMLogMemInfo("Leaving MOM update_ocean_model: ") + if(profile_memory) call ESMF_VMLogMemInfo("Entering MOM update_ocean_model: ") + call update_ocean_model(Ice_ocean_boundary, ocean_state, ocean_public, Time, Time_step_coupled) + if(profile_memory) call ESMF_VMLogMemInfo("Leaving MOM update_ocean_model: ") - !--------------- - ! Export Data - !--------------- + !--------------- + ! Export Data + !--------------- - call mom_export(ocean_public, ocean_grid, ocean_state, exportState, clock, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + call mom_export(ocean_public, ocean_grid, ocean_state, exportState, clock, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out - call shr_file_setLogUnit (logunit) + endif !--------------- ! If restart alarm is ringing - write restart file diff --git a/config_src/nuopc_driver/mom_cap_methods.F90 b/config_src/nuopc_driver/mom_cap_methods.F90 index e6bdbea307..8d9543137a 100644 --- a/config_src/nuopc_driver/mom_cap_methods.F90 +++ b/config_src/nuopc_driver/mom_cap_methods.F90 @@ -57,18 +57,16 @@ end subroutine mom_set_geomtype !> This function has a few purposes: !! (1) it imports surface fluxes using data from the mediator; and !! (2) it can apply restoring in SST and SSS. -subroutine mom_import(ocean_public, ocean_grid, importState, ice_ocean_boundary, runtype, rc) +subroutine mom_import(ocean_public, ocean_grid, importState, ice_ocean_boundary, rc) type(ocean_public_type) , intent(in) :: ocean_public !< Ocean surface state type(ocean_grid_type) , intent(in) :: ocean_grid !< Ocean model grid type(ESMF_State) , intent(inout) :: importState !< incoming data from mediator type(ice_ocean_boundary_type) , intent(inout) :: ice_ocean_boundary !< Ocean boundary forcing - character(len=*), optional , intent(in) :: runtype !< For cesm only, type of run integer , intent(inout) :: rc !< Return code ! Local Variables integer :: i, j, ig, jg, n integer :: isc, iec, jsc, jec - logical :: do_import character(len=128) :: fldname real(ESMF_KIND_R8), allocatable :: taux(:,:) real(ESMF_KIND_R8), allocatable :: tauy(:,:) @@ -80,265 +78,251 @@ subroutine mom_import(ocean_public, ocean_grid, importState, ice_ocean_boundary, ! import_cnt is used to skip using the import state at the first count for cesm ! ------- - if (present(runtype)) then - import_cnt = import_cnt + 1 - if ((trim(runtype) == 'initial' .and. import_cnt <= 2)) then - do_import = .false. ! This will skip the first time import information is given - else - do_import = .true. - endif - else - do_import = .true. - endif + ! The following are global indices without halos + call mpp_get_compute_domain(ocean_public%domain, isc, iec, jsc, jec) - if (do_import) then - ! The following are global indices without halos - call mpp_get_compute_domain(ocean_public%domain, isc, iec, jsc, jec) + !---- + ! surface height pressure + !---- + call state_getimport(importState, 'inst_pres_height_surface', & + isc, iec, jsc, jec, ice_ocean_boundary%p, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out - !---- - ! surface height pressure - !---- - call state_getimport(importState, 'inst_pres_height_surface', & - isc, iec, jsc, jec, ice_ocean_boundary%p, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - !---- - ! near-IR, direct shortwave (W/m2) - !---- - call state_getimport(importState, 'mean_net_sw_ir_dir_flx', & - isc, iec, jsc, jec, ice_ocean_boundary%sw_flux_nir_dir, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - !---- - ! near-IR, diffuse shortwave (W/m2) - !---- - call state_getimport(importState, 'mean_net_sw_ir_dif_flx', & - isc, iec, jsc, jec, ice_ocean_boundary%sw_flux_nir_dif, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - !---- - ! visible, direct shortwave (W/m2) - !---- - call state_getimport(importState, 'mean_net_sw_vis_dir_flx', & - isc, iec, jsc, jec, ice_ocean_boundary%sw_flux_vis_dir, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + !---- + ! near-IR, direct shortwave (W/m2) + !---- + call state_getimport(importState, 'mean_net_sw_ir_dir_flx', & + isc, iec, jsc, jec, ice_ocean_boundary%sw_flux_nir_dir, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out - !---- - ! visible, diffuse shortwave (W/m2) - !---- - call state_getimport(importState, 'mean_net_sw_vis_dif_flx', & - isc, iec, jsc, jec, ice_ocean_boundary%sw_flux_vis_dif, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - ! ------- - ! Net longwave radiation (W/m2) - ! ------- - call state_getimport(importState, 'mean_net_lw_flx', & - isc, iec, jsc, jec, ice_ocean_boundary%lw_flux, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + !---- + ! near-IR, diffuse shortwave (W/m2) + !---- + call state_getimport(importState, 'mean_net_sw_ir_dif_flx', & + isc, iec, jsc, jec, ice_ocean_boundary%sw_flux_nir_dif, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out - !---- - ! zonal and meridional surface stress - !---- - allocate (taux(isc:iec,jsc:jec)) - allocate (tauy(isc:iec,jsc:jec)) + !---- + ! visible, direct shortwave (W/m2) + !---- + call state_getimport(importState, 'mean_net_sw_vis_dir_flx', & + isc, iec, jsc, jec, ice_ocean_boundary%sw_flux_vis_dir, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out - call state_getimport(importState, 'mean_zonal_moment_flx', isc, iec, jsc, jec, taux, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call state_getimport(importState, 'mean_merid_moment_flx', isc, iec, jsc, jec, tauy, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - - ! rotate taux and tauy from true zonal/meridional to local coordinates - do j = jsc, jec - jg = j + ocean_grid%jsc - jsc - do i = isc, iec - ig = i + ocean_grid%isc - isc - ice_ocean_boundary%u_flux(i,j) = ocean_grid%cos_rot(ig,jg)*taux(i,j) & - - ocean_grid%sin_rot(ig,jg)*tauy(i,j) - ice_ocean_boundary%v_flux(i,j) = ocean_grid%cos_rot(ig,jg)*tauy(i,j) & - + ocean_grid%sin_rot(ig,jg)*taux(i,j) - enddo - enddo + !---- + ! visible, diffuse shortwave (W/m2) + !---- + call state_getimport(importState, 'mean_net_sw_vis_dif_flx', & + isc, iec, jsc, jec, ice_ocean_boundary%sw_flux_vis_dif, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out - deallocate(taux, tauy) + ! ------- + ! Net longwave radiation (W/m2) + ! ------- + call state_getimport(importState, 'mean_net_lw_flx', & + isc, iec, jsc, jec, ice_ocean_boundary%lw_flux, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out - !---- - ! sensible heat flux (W/m2) - !---- - call state_getimport(importState, 'mean_sensi_heat_flx', & - isc, iec, jsc, jec, ice_ocean_boundary%t_flux, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + !---- + ! zonal and meridional surface stress + !---- + allocate (taux(isc:iec,jsc:jec)) + allocate (tauy(isc:iec,jsc:jec)) - !---- - ! evaporation flux (W/m2) - !---- - call state_getimport(importState, 'mean_evap_rate', & - isc, iec, jsc, jec, ice_ocean_boundary%q_flux, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + call state_getimport(importState, 'mean_zonal_moment_flx', isc, iec, jsc, jec, taux, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call state_getimport(importState, 'mean_merid_moment_flx', isc, iec, jsc, jec, tauy, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out - !---- - ! liquid precipitation (rain) - !---- - call state_getimport(importState, 'mean_prec_rate', & - isc, iec, jsc, jec, ice_ocean_boundary%lprec, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - !---- - ! frozen precipitation (snow) - !---- - call state_getimport(importState, 'mean_fprec_rate', & - isc, iec, jsc, jec, ice_ocean_boundary%fprec, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + ! rotate taux and tauy from true zonal/meridional to local coordinates + do j = jsc, jec + jg = j + ocean_grid%jsc - jsc + do i = isc, iec + ig = i + ocean_grid%isc - isc + ice_ocean_boundary%u_flux(i,j) = ocean_grid%cos_rot(ig,jg)*taux(i,j) & + - ocean_grid%sin_rot(ig,jg)*tauy(i,j) + ice_ocean_boundary%v_flux(i,j) = ocean_grid%cos_rot(ig,jg)*tauy(i,j) & + + ocean_grid%sin_rot(ig,jg)*taux(i,j) + enddo + enddo - !---- - ! runoff and heat content of runoff - !---- - ! Note - preset values to 0, if field does not exist in importState, then will simply return - ! and preset value will be used + deallocate(taux, tauy) - ! liquid runoff - ice_ocean_boundary%rofl_flux (:,:) = 0._ESMF_KIND_R8 - call state_getimport(importState, 'Foxx_rofl', & - isc, iec, jsc, jec, ice_ocean_boundary%rofl_flux,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + !---- + ! sensible heat flux (W/m2) + !---- + call state_getimport(importState, 'mean_sensi_heat_flx', & + isc, iec, jsc, jec, ice_ocean_boundary%t_flux, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out - ! ice runoff - ice_ocean_boundary%rofi_flux (:,:) = 0._ESMF_KIND_R8 - call state_getimport(importState, 'Foxx_rofi', & - isc, iec, jsc, jec, ice_ocean_boundary%rofi_flux,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + !---- + ! evaporation flux (W/m2) + !---- + call state_getimport(importState, 'mean_evap_rate', & + isc, iec, jsc, jec, ice_ocean_boundary%q_flux, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out - ! total runoff - ice_ocean_boundary%runoff (:,:) = 0._ESMF_KIND_R8 - call state_getimport(importState, 'mean_runoff_rate', & - isc, iec, jsc, jec, ice_ocean_boundary%runoff, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + !---- + ! liquid precipitation (rain) + !---- + call state_getimport(importState, 'mean_prec_rate', & + isc, iec, jsc, jec, ice_ocean_boundary%lprec, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out - ! heat content of runoff - ice_ocean_boundary%runoff_hflx(:,:) = 0._ESMF_KIND_R8 - call state_getimport(importState, 'mean_runoff_heat_flux', & - isc, iec, jsc, jec, ice_ocean_boundary%runoff_hflx, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + !---- + ! frozen precipitation (snow) + !---- + call state_getimport(importState, 'mean_fprec_rate', & + isc, iec, jsc, jec, ice_ocean_boundary%fprec, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out - !---- - ! calving rate and heat flux - !---- - ! Note - preset values to 0, if field does not exist in importState, then will simply return - ! and preset value will be used + !---- + ! runoff and heat content of runoff + !---- + ! Note - preset values to 0, if field does not exist in importState, then will simply return + ! and preset value will be used - ice_ocean_boundary%calving(:,:) = 0._ESMF_KIND_R8 - call state_getimport(importState, 'mean_calving_rate', & - isc, iec, jsc, jec, ice_ocean_boundary%calving, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + ! liquid runoff + ice_ocean_boundary%rofl_flux (:,:) = 0._ESMF_KIND_R8 + call state_getimport(importState, 'Foxx_rofl', & + isc, iec, jsc, jec, ice_ocean_boundary%rofl_flux,rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out - ice_ocean_boundary%calving_hflx(:,:) = 0._ESMF_KIND_R8 - call state_getimport(importState, 'mean_calving_heat_flux', & - isc, iec, jsc, jec, ice_ocean_boundary%calving_hflx, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + ! ice runoff + ice_ocean_boundary%rofi_flux (:,:) = 0._ESMF_KIND_R8 + call state_getimport(importState, 'Foxx_rofi', & + isc, iec, jsc, jec, ice_ocean_boundary%rofi_flux,rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out - !---- - ! salt flux from ice - !---- - ice_ocean_boundary%salt_flux(:,:) = 0._ESMF_KIND_R8 - call state_getimport(importState, 'mean_salt_rate', & - isc, iec, jsc, jec, ice_ocean_boundary%salt_flux,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + ! total runoff + ice_ocean_boundary%runoff (:,:) = 0._ESMF_KIND_R8 + call state_getimport(importState, 'mean_runoff_rate', & + isc, iec, jsc, jec, ice_ocean_boundary%runoff, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out - ! !---- - ! ! snow&ice melt heat flux (W/m^2) - ! !---- - ice_ocean_boundary%seaice_melt_heat(:,:) = 0._ESMF_KIND_R8 - call state_getimport(importState, 'net_heat_flx_to_ocn', & - isc, iec, jsc, jec, ice_ocean_boundary%seaice_melt_heat,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + ! heat content of runoff + ice_ocean_boundary%runoff_hflx(:,:) = 0._ESMF_KIND_R8 + call state_getimport(importState, 'mean_runoff_heat_flux', & + isc, iec, jsc, jec, ice_ocean_boundary%runoff_hflx, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out - ! !---- - ! ! snow&ice melt water flux (W/m^2) - ! !---- - ice_ocean_boundary%seaice_melt(:,:) = 0._ESMF_KIND_R8 - call state_getimport(importState, 'mean_fresh_water_to_ocean_rate', & - isc, iec, jsc, jec, ice_ocean_boundary%seaice_melt,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + !---- + ! calving rate and heat flux + !---- + ! Note - preset values to 0, if field does not exist in importState, then will simply return + ! and preset value will be used - !---- - ! mass of overlying ice - !---- - ! Note - preset values to 0, if field does not exist in importState, then will simply return - ! and preset value will be used + ice_ocean_boundary%calving(:,:) = 0._ESMF_KIND_R8 + call state_getimport(importState, 'mean_calving_rate', & + isc, iec, jsc, jec, ice_ocean_boundary%calving, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out - ice_ocean_boundary%mi(:,:) = 0._ESMF_KIND_R8 - call state_getimport(importState, 'mass_of_overlying_ice', & - isc, iec, jsc, jec, ice_ocean_boundary%mi, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + ice_ocean_boundary%calving_hflx(:,:) = 0._ESMF_KIND_R8 + call state_getimport(importState, 'mean_calving_heat_flux', & + isc, iec, jsc, jec, ice_ocean_boundary%calving_hflx, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out - endif + !---- + ! salt flux from ice + !---- + ice_ocean_boundary%salt_flux(:,:) = 0._ESMF_KIND_R8 + call state_getimport(importState, 'mean_salt_rate', & + isc, iec, jsc, jec, ice_ocean_boundary%salt_flux,rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + ! !---- + ! ! snow&ice melt heat flux (W/m^2) + ! !---- + ice_ocean_boundary%seaice_melt_heat(:,:) = 0._ESMF_KIND_R8 + call state_getimport(importState, 'net_heat_flx_to_ocn', & + isc, iec, jsc, jec, ice_ocean_boundary%seaice_melt_heat,rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + ! !---- + ! ! snow&ice melt water flux (W/m^2) + ! !---- + ice_ocean_boundary%seaice_melt(:,:) = 0._ESMF_KIND_R8 + call state_getimport(importState, 'mean_fresh_water_to_ocean_rate', & + isc, iec, jsc, jec, ice_ocean_boundary%seaice_melt,rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + !---- + ! mass of overlying ice + !---- + ! Note - preset values to 0, if field does not exist in importState, then will simply return + ! and preset value will be used + + ice_ocean_boundary%mi(:,:) = 0._ESMF_KIND_R8 + call state_getimport(importState, 'mass_of_overlying_ice', & + isc, iec, jsc, jec, ice_ocean_boundary%mi, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out end subroutine mom_import From e9cf2cd6288afc8bc97227047f107210fcfc7c7b Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Mon, 24 Jun 2019 13:29:53 -0400 Subject: [PATCH 032/150] +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 033/150] +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 034/150] +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 035/150] +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 036/150] +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 037/150] (*)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 038/150] +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 039/150] +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 040/150] 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 041/150] +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 042/150] 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 043/150] 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 044/150] 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 045/150] 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 046/150] 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 047/150] +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 048/150] (*)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 049/150] (*)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 050/150] (*)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 051/150] +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 052/150] +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 053/150] 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 054/150] 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 055/150] +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 056/150] +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 057/150] +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 058/150] +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 059/150] +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 060/150] +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 061/150] 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 062/150] +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 063/150] 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 064/150] +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 065/150] 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 066/150] +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 067/150] +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 068/150] +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 069/150] +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 070/150] +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 cac0656a9888b13fc475c966e3b89580451f1938 Mon Sep 17 00:00:00 2001 From: mvertens Date: Fri, 5 Jul 2019 14:27:00 -0600 Subject: [PATCH 071/150] fixes to get taux and tauy roundoff between mct and nuopc --- config_src/nuopc_driver/MOM_surface_forcing.F90 | 14 ++++++++++++-- 1 file changed, 12 insertions(+), 2 deletions(-) diff --git a/config_src/nuopc_driver/MOM_surface_forcing.F90 b/config_src/nuopc_driver/MOM_surface_forcing.F90 index aecfd419da..7805674ccf 100644 --- a/config_src/nuopc_driver/MOM_surface_forcing.F90 +++ b/config_src/nuopc_driver/MOM_surface_forcing.F90 @@ -697,7 +697,13 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, US, CS) endif forces%accumulate_p_surf = .true. ! Multiple components may contribute to surface pressure. + ! TODO: this does not seem correct for NEMS +#ifdef CESMCOUPLED + wind_stagger = AGRID +#else wind_stagger = CS%wind_stagger +#endif + if ((IOB%wind_stagger == AGRID) .or. (IOB%wind_stagger == BGRID_NE) .or. & (IOB%wind_stagger == CGRID_NE)) wind_stagger = IOB%wind_stagger if (wind_stagger == BGRID_NE) then @@ -774,8 +780,12 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, US, CS) enddo ; enddo elseif (wind_stagger == AGRID) then - call pass_vector(taux_at_h, tauy_at_h, G%Domain, To_All+Omit_Corners, & - stagger=AGRID, halo=1) + !TODO: which one of these is correct? +#ifdef CESMCOUPLED + call pass_vector(taux_at_h, tauy_at_h, G%Domain,stagger=AGRID) +#else + call pass_vector(taux_at_h, tauy_at_h, G%Domain, To_All+Omit_Corners, stagger=AGRID, halo=1) +#endif do j=js,je ; do I=Isq,Ieq forces%taux(I,j) = 0.0 From d4b476e702853d7fd8df7c3fbf60292c865854ed Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Fri, 5 Jul 2019 18:05:16 -0400 Subject: [PATCH 072/150] 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 073/150] +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 074/150] +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 075/150] +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 076/150] +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 077/150] +(*)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 078/150] (*)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 079/150] 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 080/150] (*)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 081/150] 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 082/150] 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 87e6f1743c642ced93aa6a0c36058344504a82da Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Mon, 8 Jul 2019 21:15:50 -0600 Subject: [PATCH 083/150] removed trailing whitespace --- config_src/nuopc_driver/MOM_surface_forcing.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/config_src/nuopc_driver/MOM_surface_forcing.F90 b/config_src/nuopc_driver/MOM_surface_forcing.F90 index 7805674ccf..78b3da0c1a 100644 --- a/config_src/nuopc_driver/MOM_surface_forcing.F90 +++ b/config_src/nuopc_driver/MOM_surface_forcing.F90 @@ -697,13 +697,13 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, US, CS) endif forces%accumulate_p_surf = .true. ! Multiple components may contribute to surface pressure. - ! TODO: this does not seem correct for NEMS + ! TODO: this does not seem correct for NEMS #ifdef CESMCOUPLED wind_stagger = AGRID #else wind_stagger = CS%wind_stagger #endif - + if ((IOB%wind_stagger == AGRID) .or. (IOB%wind_stagger == BGRID_NE) .or. & (IOB%wind_stagger == CGRID_NE)) wind_stagger = IOB%wind_stagger if (wind_stagger == BGRID_NE) then From f258630a549031595e2357e88cde7ae221ce76c2 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 9 Jul 2019 11:48:33 -0400 Subject: [PATCH 084/150] +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 b6d21b1300af368876263c8882683afc84403f4f Mon Sep 17 00:00:00 2001 From: Marshall Ward Date: Tue, 9 Jul 2019 17:34:28 -0400 Subject: [PATCH 085/150] Conditional registration of FrictWorkMax with MEKE The FrictWorkMax diagnostic requires that MEKE be enabled and that MEKE%MEKE field be allocated and defined. It is currently possible to register this diagnostic, even when MEKE is disabled. This patch prevents the registration of FrictWorkMax when MEKE is turned off. --- src/parameterizations/lateral/MOM_hor_visc.F90 | 10 ++++++++-- 1 file changed, 8 insertions(+), 2 deletions(-) diff --git a/src/parameterizations/lateral/MOM_hor_visc.F90 b/src/parameterizations/lateral/MOM_hor_visc.F90 index 919ad02820..2b18e86ce0 100644 --- a/src/parameterizations/lateral/MOM_hor_visc.F90 +++ b/src/parameterizations/lateral/MOM_hor_visc.F90 @@ -1418,6 +1418,7 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS) ! valid parameters. logical :: split ! If true, use the split time stepping scheme. ! If false and USE_GME = True, issue a FATAL error. + logical :: use_MEKE ! True if MEKE has been enabled character(len=64) :: inputdir, filename real :: deg2rad ! Converts degrees to radians real :: slat_fn ! sin(lat)**Kh_pwr_of_sine @@ -1691,6 +1692,9 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS) return ! We are not using either Laplacian or Bi-harmonic lateral viscosity endif + call get_param(param_file, mdl, "USE_MEKE", use_MEKE, default=.false., & + do_not_log=.true.) + deg2rad = atan(1.0) / 45. ALLOC_(CS%dx2h(isd:ied,jsd:jed)) ; CS%dx2h(:,:) = 0.0 @@ -2081,8 +2085,10 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS) CS%id_FrictWork_diss = register_diag_field('ocean_model','FrictWork_diss',diag%axesTL,Time,& 'Integral work done by lateral friction terms (excluding diffusion of energy)', 'W m-2') - CS%id_FrictWorkMax = register_diag_field('ocean_model','FrictWorkMax',diag%axesTL,Time,& - 'Maximum possible integral work done by lateral friction terms', 'W m-2') + if (use_MEKE) then + CS%id_FrictWorkMax = register_diag_field('ocean_model','FrictWorkMax',diag%axesTL,Time,& + 'Maximum possible integral work done by lateral friction terms', 'W m-2') + endif CS%id_FrictWorkIntz = register_diag_field('ocean_model','FrictWorkIntz',diag%axesT1,Time, & 'Depth integrated work done by lateral friction', 'W m-2', & From 5cc85dc68214d47283ca8f8745192c362867a111 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 9 Jul 2019 18:58:33 -0400 Subject: [PATCH 086/150] +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 087/150] +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 088/150] +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 3fcd94295d438ce8130af32473a9592ca2b5147e Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Tue, 9 Jul 2019 18:41:03 -0600 Subject: [PATCH 089/150] Deletes comments --- config_src/mct_driver/MOM_surface_forcing.F90 | 11 ----------- config_src/nuopc_driver/MOM_surface_forcing.F90 | 12 ------------ 2 files changed, 23 deletions(-) diff --git a/config_src/mct_driver/MOM_surface_forcing.F90 b/config_src/mct_driver/MOM_surface_forcing.F90 index 67bf2f1913..ba0a62677a 100644 --- a/config_src/mct_driver/MOM_surface_forcing.F90 +++ b/config_src/mct_driver/MOM_surface_forcing.F90 @@ -505,17 +505,6 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, Time, G, US, CS, & net_FW(i,j) = (((fluxes%lprec(i,j) + fluxes%fprec(i,j) + fluxes%seaice_melt(i,j)) + & (fluxes%lrunoff(i,j) + fluxes%frunoff(i,j))) + & (fluxes%evap(i,j) + fluxes%vprec(i,j)) ) * G%areaT(i,j) - ! The following contribution appears to be calculating the volume flux of sea-ice - ! melt. This calculation is clearly WRONG if either sea-ice has variable - ! salinity or the sea-ice is completely fresh. - ! Bob thinks this is trying ensure the net fresh-water of the ocean + sea-ice system - ! is constant. - ! To do this correctly we will need a sea-ice melt field added to IOB. -AJA - ! GMM: as stated above, the following is wrong. CIME deals with volume/mass and - ! heat from sea ice/snow via seaice_melt and seaice_melt_heat, respectively. - !if (associated(fluxes%salt_flux) .and. (CS%ice_salt_concentration>0.0)) & - ! net_FW(i,j) = net_FW(i,j) + G%areaT(i,j) * & - ! (fluxes%salt_flux(i,j) / CS%ice_salt_concentration) net_FW2(i,j) = net_FW(i,j)/G%areaT(i,j) enddo; enddo diff --git a/config_src/nuopc_driver/MOM_surface_forcing.F90 b/config_src/nuopc_driver/MOM_surface_forcing.F90 index c90526f98a..0a11d0147d 100644 --- a/config_src/nuopc_driver/MOM_surface_forcing.F90 +++ b/config_src/nuopc_driver/MOM_surface_forcing.F90 @@ -544,18 +544,6 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, US, CS, & (fluxes%lrunoff(i,j) + fluxes%frunoff(i,j))) + & (fluxes%evap(i,j) + fluxes%vprec(i,j)) ) * G%areaT(i,j) - ! The following contribution appears to be calculating the volume flux of sea-ice - ! melt. This calculation is clearly WRONG if either sea-ice has variable - ! salinity or the sea-ice is completely fresh. - ! Bob thinks this is trying ensure the net fresh-water of the ocean + sea-ice system - ! is constant. - ! To do this correctly we will need a sea-ice melt field added to IOB. -AJA - ! GMM: as stated above, the following is wrong. CIME deals with volume/mass and - ! heat from sea ice/snow via seaice_melt and seaice_melt_heat, respectively. - !if (associated(IOB%salt_flux) .and. (CS%ice_salt_concentration>0.0)) & - ! net_FW(i,j) = net_FW(i,j) + sign_for_net_FW_bug * G%areaT(i,j) * & - ! (IOB%salt_flux(i-i0,j-j0) / CS%ice_salt_concentration) - net_FW2(i,j) = net_FW(i,j) / G%areaT(i,j) enddo ; enddo From 5645cc0d35ff2de14e15b17989eec5c4a5faf5d5 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Wed, 10 Jul 2019 10:33:01 -0400 Subject: [PATCH 090/150] 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] From e39675a8d115fb0924e240ba9497673ce8c0a809 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Wed, 10 Jul 2019 18:52:11 -0400 Subject: [PATCH 091/150] (*)Rescaled velocities in MOM_kappa_shear to L T-1 Rescaled the horizontal velocities in MOM_kappa_shear to L T-1 for dimensional consistency testing. This does not change answers after dimensional rescaling provided that VEL_UNDERFLOW is a small positive number (like 1e-30 m s-1), and in some cases even if VEL_UNDERFLOW is 0, and it does not change answers when there is no dimensional rescaling for length or time. All answers are bitwise identical in the MOM6-examples test cases. --- .../vertical/MOM_kappa_shear.F90 | 44 +++++++++++-------- 1 file changed, 25 insertions(+), 19 deletions(-) diff --git a/src/parameterizations/vertical/MOM_kappa_shear.F90 b/src/parameterizations/vertical/MOM_kappa_shear.F90 index e80793695f..2d6f26dd10 100644 --- a/src/parameterizations/vertical/MOM_kappa_shear.F90 +++ b/src/parameterizations/vertical/MOM_kappa_shear.F90 @@ -73,7 +73,7 @@ module MOM_kappa_shear !! massive layers in this calculation. ! I can think of no good reason why this should be false. - RWH real :: vel_underflow !< Velocity components smaller than vel_underflow - !! are set to 0 [m s-1]. + !! are set to 0 [Z T-1 ~> m s-1]. ! logical :: layer_stagger = .false. ! If true, do the calculations centered at ! layers, rather than the interfaces. logical :: debug = .false. !< If true, write verbose debugging messages. @@ -128,16 +128,17 @@ subroutine Calculate_kappa_shear(u_in, v_in, h, tv, p_surf, kappa_io, tke_io, & ! Local variables real, dimension(SZI_(G),SZK_(GV)) :: & - 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. + h_2d, & ! A 2-D version of h, but converted to [Z ~> m]. + u_2d, v_2d, & ! 2-D versions of u_in and v_in, converted to [L T-1 ~> m s-1]. + T_2d, S_2d, rho_2d ! 2-D versions of T, S, and rho. real, dimension(SZI_(G),SZK_(GV)+1) :: & 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)) :: & Idz, & ! The inverse of the distance between TKE points [Z-1 ~> m-1]. 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]. + u0xdz, & ! The initial zonal velocity times dz [Z L T-1 ~> m2 s-1]. + v0xdz, & ! The initial meridional velocity times dz [Z L T-1 ~> m2 s-1]. 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) :: & @@ -188,7 +189,7 @@ subroutine Calculate_kappa_shear(u_in, v_in, h, tv, p_surf, kappa_io, tke_io, & do j=js,je do k=1,nz ; do i=is,ie h_2d(i,k) = h(i,j,k)*GV%H_to_Z - u_2d(i,k) = u_in(i,j,k) ; v_2d(i,k) = v_in(i,j,k) + u_2d(i,k) = u_in(i,j,k)*US%m_s_to_L_T ; v_2d(i,k) = v_in(i,j,k)*US%m_s_to_L_T enddo ; enddo if (use_temperature) then ; do k=1,nz ; do i=is,ie T_2d(i,k) = tv%T(i,j,k) ; S_2d(i,k) = tv%S(i,j,k) @@ -393,8 +394,9 @@ subroutine Calc_kappa_shear_vertex(u_in, v_in, h, T_in, S_in, tv, p_surf, kappa_ ! Local variables real, dimension(SZIB_(G),SZK_(GV)) :: & - 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. + h_2d, & ! A 2-D version of h, but converted to [Z ~> m]. + u_2d, v_2d, & ! 2-D versions of u_in and v_in, converted to [L T-1 ~> m s-1]. + T_2d, S_2d, rho_2d ! 2-D versions of T, S, and rho. 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) :: & @@ -402,8 +404,8 @@ subroutine Calc_kappa_shear_vertex(u_in, v_in, h, T_in, S_in, tv, p_surf, kappa_ real, dimension(SZK_(GV)) :: & Idz, & ! The inverse of the distance between TKE points [Z-1 ~> m-1]. 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]. + u0xdz, & ! The initial zonal velocity times dz [L Z T-1 ~> m2 s-1]. + v0xdz, & ! The initial meridional velocity times dz [L Z T-1 ~> m2 s-1]. 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) :: & @@ -460,11 +462,13 @@ subroutine Calc_kappa_shear_vertex(u_in, v_in, h, T_in, S_in, tv, p_surf, kappa_ ! Interpolate the various quantities to the corners, using masks. do k=1,nz ; do I=IsB,IeB - u_2d(I,k) = (u_in(I,j,k) * (G%mask2dCu(I,j) * (h(i,j,k) + h(i+1,j,k))) + & + u_2d(I,k) = US%m_s_to_L_T * & + (u_in(I,j,k) * (G%mask2dCu(I,j) * (h(i,j,k) + h(i+1,j,k))) + & u_in(I,j+1,k) * (G%mask2dCu(I,j+1) * (h(i,j+1,k) + h(i+1,j+1,k))) ) / & ((G%mask2dCu(I,j) * (h(i,j,k) + h(i+1,j,k)) + & G%mask2dCu(I,j+1) * (h(i,j+1,k) + h(i+1,j+1,k))) + GV%H_subroundoff) - v_2d(I,k) = (v_in(i,J,k) * (G%mask2dCv(i,J) * (h(i,j,k) + h(i,j+1,k))) + & + v_2d(I,k) = US%m_s_to_L_T * & + (v_in(i,J,k) * (G%mask2dCv(i,J) * (h(i,j,k) + h(i,j+1,k))) + & v_in(i+1,J,k) * (G%mask2dCv(i+1,J) * (h(i+1,j,k) + h(i+1,j+1,k))) ) / & ((G%mask2dCv(i,J) * (h(i,j,k) + h(i,j+1,k)) + & G%mask2dCv(i+1,J) * (h(i+1,j,k) + h(i+1,j+1,k))) + GV%H_subroundoff) @@ -670,9 +674,9 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & real, dimension(SZK_(GV)), & intent(in) :: dz !< The layer thickness [Z ~> m]. real, dimension(SZK_(GV)), & - intent(in) :: u0xdz !< The initial zonal velocity times dz [Z m s-1 ~> m2 s-1]. + intent(in) :: u0xdz !< The initial zonal velocity times dz [Z L T-1 ~> m2 s-1]. real, dimension(SZK_(GV)), & - intent(in) :: v0xdz !< The initial meridional velocity times dz [Z m s-1 ~> m2 s-1]. + intent(in) :: v0xdz !< The initial meridional velocity times dz [Z L T-1 ~> m2 s-1]. real, dimension(SZK_(GV)), & intent(in) :: T0xdz !< The initial temperature times dz [degC Z ~> degC m]. real, dimension(SZK_(GV)), & @@ -694,12 +698,13 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & !! as used in calculating kappa and TKE [Z ~> m]. real, dimension(nzc) :: & - u, & ! The zonal velocity after a timestep of mixing [m s-1]. - v, & ! The meridional velocity after a timestep of mixing [m s-1]. + u, & ! The zonal velocity after a timestep of mixing [L T-1 ~> m s-1]. + v, & ! The meridional velocity after a timestep of mixing [L T-1 ~> 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]. - u_test, v_test, T_test, S_test + u_test, v_test, & ! Temporary velocities [L T-1 ~> m s-1]. + T_test, S_test ! Temporary temperatures [degC] and salinities [ppt]. real, dimension(nzc+1) :: & N2, & ! The squared buoyancy frequency at an interface [T-2 ~> s-2]. @@ -1315,7 +1320,8 @@ subroutine calculate_projected_state(kappa, u0, v0, T0, S0, dt, nz, & endif if (present(S2)) then - L2_to_Z2 = US%m_to_Z**2 * US%T_to_s**2 + ! L2_to_Z2 = US%m_to_Z**2 * US%T_to_s**2 + L2_to_Z2 = US%L_to_Z**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) @@ -2050,7 +2056,7 @@ function kappa_shear_init(Time, G, GV, US, param_file, diag, CS) "A negligibly small velocity magnitude below which velocity "//& "components are set to 0. A reasonable value might be "//& "1e-30 m/s, which is less than an Angstrom divided by "//& - "the age of the universe.", units="m s-1", default=0.0) + "the age of the universe.", units="m s-1", default=0.0, scale=US%m_s_to_L_T) call get_param(param_file, mdl, "DEBUG_KAPPA_SHEAR", CS%debug, & "If true, write debugging data for the kappa-shear code. \n"//& "Caution: this option is _very_ verbose and should only "//& From abb1901d63cf350e671e11d1250fc09aba4742ff Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Wed, 10 Jul 2019 18:52:46 -0400 Subject: [PATCH 092/150] +Obsoleted ORIG_MLD_ITERATION in MOM_energetic_PBL Obsoleted the archaic run-time parameter ORIG_MLD_ITERATION in MOM_energetic_PBL. No MOM6-examples test cases have this set to True along with USE_MLD_ITERATION=True, which is the case that is being eliminated. Answers are bitwise idetical in all MOM6-examples test cases, but there is one less entry in some MOM_parameter_doc files. --- src/diagnostics/MOM_obsolete_params.F90 | 1 + .../vertical/MOM_energetic_PBL.F90 | 49 ++++--------------- 2 files changed, 10 insertions(+), 40 deletions(-) diff --git a/src/diagnostics/MOM_obsolete_params.F90 b/src/diagnostics/MOM_obsolete_params.F90 index 1e2eaea51c..f87479775a 100644 --- a/src/diagnostics/MOM_obsolete_params.F90 +++ b/src/diagnostics/MOM_obsolete_params.F90 @@ -163,6 +163,7 @@ subroutine find_obsolete_params(param_file) 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, "ORIG_MLD_ITERATION", .false.) call obsolete_logical(param_file, "CONTINUITY_PPM", .true.) diff --git a/src/parameterizations/vertical/MOM_energetic_PBL.F90 b/src/parameterizations/vertical/MOM_energetic_PBL.F90 index 64d90e02ff..5bdf716f1b 100644 --- a/src/parameterizations/vertical/MOM_energetic_PBL.F90 +++ b/src/parameterizations/vertical/MOM_energetic_PBL.F90 @@ -50,7 +50,6 @@ module MOM_energetic_PBL !/ 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. integer :: max_MLD_its !< The maximum number of iterations that can be used to find a @@ -1411,36 +1410,17 @@ 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. - if (CS%Orig_MLD_iteration) then - ! 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 - 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 + + !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 - !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 + max_MLD = MLD_guess ! We know this guess was too deep 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) @@ -2152,17 +2132,6 @@ 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 "//& - "is limited to resolution.", default=.true.) -! if (CS%Orig_MLD_Iteration) then -! call MOM_error(FATAL, "Flag ORIG_MLD_ITERATION error: "//& -! "If you need to use this setting please "//& -! "report this error, as the code supporting this option "//& -! "is legacy code that is set to be deleted.") -! endif 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. "//& From d217299d2e8f781ab7031c12da5e77ddc403f2e0 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Thu, 11 Jul 2019 04:56:45 -0400 Subject: [PATCH 093/150] +Rescaled units of GV%g_prime Rescaled the units of GV%g_prime to L2 Z-1 T-2 from m2 Z-1 s-2 for enhanced dimensional consistency testing. All answers are bitwise identical. --- src/core/MOM_PressureForce_Montgomery.F90 | 15 ++--- src/core/MOM_PressureForce_analytic_FV.F90 | 4 +- src/core/MOM_PressureForce_blocked_AFV.F90 | 4 +- src/core/MOM_barotropic.F90 | 17 +++--- src/core/MOM_boundary_update.F90 | 2 +- src/core/MOM_open_boundary.F90 | 7 ++- src/core/MOM_verticalGrid.F90 | 2 +- src/diagnostics/MOM_sum_output.F90 | 4 +- .../MOM_coord_initialization.F90 | 61 ++++++++++--------- .../lateral/MOM_lateral_mixing_coeffs.F90 | 4 +- .../lateral/MOM_thickness_diffuse.F90 | 4 +- .../vertical/MOM_entrain_diffusive.F90 | 2 +- .../vertical/MOM_set_diffusivity.F90 | 4 +- src/user/BFB_initialization.F90 | 6 +- src/user/Phillips_initialization.F90 | 4 +- src/user/user_initialization.F90 | 4 +- 16 files changed, 74 insertions(+), 70 deletions(-) diff --git a/src/core/MOM_PressureForce_Montgomery.F90 b/src/core/MOM_PressureForce_Montgomery.F90 index 42c08b8364..16e3e5e211 100644 --- a/src/core/MOM_PressureForce_Montgomery.F90 +++ b/src/core/MOM_PressureForce_Montgomery.F90 @@ -530,17 +530,17 @@ subroutine PressureForce_Mont_Bouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, pbce, !$OMP parallel do default(shared) do j=Jsq,Jeq+1 do i=Isq,Ieq+1 - M(i,j,1) = GV%g_prime(1) * e(i,j,1) + M(i,j,1) = US%L_to_m**2*US%s_to_T**2*GV%g_prime(1) * e(i,j,1) if (use_p_atm) M(i,j,1) = M(i,j,1) + p_atm(i,j) * I_Rho0 enddo do k=2,nz ; do i=Isq,Ieq+1 - M(i,j,k) = M(i,j,k-1) + GV%g_prime(K) * e(i,j,K) + M(i,j,k) = M(i,j,k-1) + US%L_to_m**2*US%s_to_T**2*GV%g_prime(K) * e(i,j,K) enddo ; enddo enddo endif ! use_EOS if (present(pbce)) then - call Set_pbce_Bouss(e, tv_tmp, G, GV, CS%Rho0, CS%GFS_scale, pbce, rho_star) + call Set_pbce_Bouss(e, tv_tmp, G, GV, US, CS%Rho0, CS%GFS_scale, pbce, rho_star) endif ! Calculate the pressure force. On a Cartesian grid, @@ -603,11 +603,12 @@ end subroutine PressureForce_Mont_Bouss !> Determines the partial derivative of the acceleration due !! to pressure forces with the free surface height. -subroutine Set_pbce_Bouss(e, tv, G, GV, Rho0, GFS_scale, pbce, rho_star) +subroutine Set_pbce_Bouss(e, tv, G, GV, US, Rho0, GFS_scale, pbce, rho_star) type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(in) :: e !< Interface height [Z ~> m]. type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamic variables + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, intent(in) :: Rho0 !< The "Boussinesq" ocean density [kg m-3]. real, intent(in) :: GFS_scale !< Ratio between gravity applied to top !! interface and the gravitational acceleration of @@ -690,11 +691,11 @@ subroutine Set_pbce_Bouss(e, tv, G, GV, Rho0, GFS_scale, pbce, rho_star) do j=Jsq,Jeq+1 do i=Isq,Ieq+1 Ihtot(i) = 1.0 / ((e(i,j,1)-e(i,j,nz+1)) + z_neglect) - pbce(i,j,1) = GV%g_prime(1) * GV%H_to_Z + pbce(i,j,1) = US%L_to_m**2*US%s_to_T**2*GV%g_prime(1) * GV%H_to_Z enddo do k=2,nz ; do i=Isq,Ieq+1 pbce(i,j,k) = pbce(i,j,k-1) + & - (GV%g_prime(K)*GV%H_to_Z) * ((e(i,j,K) - e(i,j,nz+1)) * Ihtot(i)) + (US%L_to_m**2*US%s_to_T**2*GV%g_prime(K)*GV%H_to_Z) * ((e(i,j,K) - e(i,j,nz+1)) * Ihtot(i)) enddo ; enddo enddo ! end of j loop endif ! use_EOS @@ -873,7 +874,7 @@ subroutine PressureForce_Mont_init(Time, G, GV, US, param_file, diag, CS, tides_ endif CS%GFS_scale = 1.0 - if (GV%g_prime(1) /= GV%g_Earth) CS%GFS_scale = GV%g_prime(1) / GV%g_Earth + if (GV%g_prime(1) /= GV%LZT_g_Earth) CS%GFS_scale = GV%g_prime(1) / GV%LZT_g_Earth call log_param(param_file, mdl, "GFS / G_EARTH", CS%GFS_scale) diff --git a/src/core/MOM_PressureForce_analytic_FV.F90 b/src/core/MOM_PressureForce_analytic_FV.F90 index e68a699b7a..2fcad455d2 100644 --- a/src/core/MOM_PressureForce_analytic_FV.F90 +++ b/src/core/MOM_PressureForce_analytic_FV.F90 @@ -757,7 +757,7 @@ subroutine PressureForce_AFV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_at endif if (present(pbce)) then - call set_pbce_Bouss(e, tv_tmp, G, GV, CS%Rho0, CS%GFS_scale, pbce) + call set_pbce_Bouss(e, tv_tmp, G, GV, US, CS%Rho0, CS%GFS_scale, pbce) endif if (present(eta)) then @@ -848,7 +848,7 @@ subroutine PressureForce_AFV_init(Time, G, GV, US, param_file, diag, CS, tides_C endif CS%GFS_scale = 1.0 - if (GV%g_prime(1) /= GV%g_Earth) CS%GFS_scale = GV%g_prime(1) / GV%g_Earth + if (GV%g_prime(1) /= GV%LZT_g_Earth) CS%GFS_scale = GV%g_prime(1) / GV%LZT_g_Earth call log_param(param_file, mdl, "GFS / G_EARTH", CS%GFS_scale) diff --git a/src/core/MOM_PressureForce_blocked_AFV.F90 b/src/core/MOM_PressureForce_blocked_AFV.F90 index 4b602373e7..c708c57257 100644 --- a/src/core/MOM_PressureForce_blocked_AFV.F90 +++ b/src/core/MOM_PressureForce_blocked_AFV.F90 @@ -749,7 +749,7 @@ subroutine PressureForce_blk_AFV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, enddo if (present(pbce)) then - call set_pbce_Bouss(e, tv_tmp, G, GV, CS%Rho0, CS%GFS_scale, pbce) + call set_pbce_Bouss(e, tv_tmp, G, GV, US, CS%Rho0, CS%GFS_scale, pbce) endif if (present(eta)) then @@ -840,7 +840,7 @@ subroutine PressureForce_blk_AFV_init(Time, G, GV, US, param_file, diag, CS, tid endif CS%GFS_scale = 1.0 - if (GV%g_prime(1) /= GV%g_Earth) CS%GFS_scale = GV%g_prime(1) / GV%g_Earth + if (GV%g_prime(1) /= GV%LZT_g_Earth) CS%GFS_scale = GV%g_prime(1) / GV%LZT_g_Earth call log_param(param_file, mdl, "GFS / G_EARTH", CS%GFS_scale) diff --git a/src/core/MOM_barotropic.F90 b/src/core/MOM_barotropic.F90 index 33450e8a3d..d69967075b 100644 --- a/src/core/MOM_barotropic.F90 +++ b/src/core/MOM_barotropic.F90 @@ -966,7 +966,7 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, ! Set up fields related to the open boundary conditions. if (apply_OBCs) then - call set_up_BT_OBC(OBC, eta, CS%BT_OBC, CS%BT_Domain, G, GV, MS, ievf-ie, use_BT_cont, & + call set_up_BT_OBC(OBC, eta, CS%BT_OBC, CS%BT_Domain, G, GV, US, MS, ievf-ie, use_BT_cont, & Datu, Datv, BTCL_u, BTCL_v) endif @@ -2279,7 +2279,7 @@ subroutine set_dtbt(G, GV, US, CS, eta, pbce, BT_cont, gtot_est, SSH_add) !! the effective open face areas as a !! function of barotropic flow. real, optional, intent(in) :: gtot_est !< An estimate of the total gravitational - !! acceleration [m2 Z-1 s-2 ~> m s-2]. + !! acceleration [L2 Z-1 T-2 ~> m s-2]. real, optional, intent(in) :: SSH_add !< An additional contribution to SSH to !! provide a margin of error when !! calculating the external wave speed [Z ~> m]. @@ -2352,8 +2352,8 @@ subroutine set_dtbt(G, GV, US, CS, eta, pbce, BT_cont, gtot_est, SSH_add) enddo ; enddo ; enddo else do j=js,je ; do i=is,ie - gtot_E(i,j) = gtot_est * GV%H_to_Z ; gtot_W(i,j) = gtot_est * GV%H_to_Z - gtot_N(i,j) = gtot_est * GV%H_to_Z ; gtot_S(i,j) = gtot_est * GV%H_to_Z + gtot_E(i,j) = US%L_T_to_m_s**2*gtot_est * GV%H_to_Z ; gtot_W(i,j) = US%L_T_to_m_s**2*gtot_est * GV%H_to_Z + gtot_N(i,j) = US%L_T_to_m_s**2*gtot_est * GV%H_to_Z ; gtot_S(i,j) = US%L_T_to_m_s**2*gtot_est * GV%H_to_Z enddo ; enddo endif @@ -2557,7 +2557,7 @@ end subroutine apply_velocity_OBCs !> This subroutine sets up the private structure used to apply the open !! boundary conditions, as developed by Mehmet Ilicak. -subroutine set_up_BT_OBC(OBC, eta, BT_OBC, BT_Domain, G, GV, MS, halo, use_BT_cont, Datu, Datv, BTCL_u, BTCL_v) +subroutine set_up_BT_OBC(OBC, eta, BT_OBC, BT_Domain, G, GV, US, MS, halo, use_BT_cont, Datu, Datv, BTCL_u, BTCL_v) type(ocean_OBC_type), pointer :: OBC !< An associated pointer to an OBC type. type(memory_size_type), intent(in) :: MS !< A type that describes the memory sizes of the !! argument arrays. @@ -2569,6 +2569,7 @@ subroutine set_up_BT_OBC(OBC, eta, BT_OBC, BT_Domain, G, GV, MS, halo, use_BT_co type(MOM_domain_type), intent(inout) :: BT_Domain !< MOM_domain_type associated with wide arrays 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 integer, intent(in) :: halo !< The extra halo size to use here. logical, intent(in) :: use_BT_cont !< If true, use the BT_cont_types to calculate !! transports. @@ -2658,7 +2659,7 @@ subroutine set_up_BT_OBC(OBC, eta, BT_OBC, BT_Domain, G, GV, MS, halo, use_BT_co BT_OBC%H_u(I,j) = eta(i+1,j) endif endif - BT_OBC%Cg_u(I,j) = SQRT(GV%g_prime(1) * GV%H_to_Z*BT_OBC%H_u(i,j)) + BT_OBC%Cg_u(I,j) = US%L_T_to_m_s*SQRT(GV%g_prime(1) * GV%H_to_Z*BT_OBC%H_u(i,j)) endif endif ; enddo ; enddo if (OBC%Flather_u_BCs_exist_globally) then @@ -2710,7 +2711,7 @@ subroutine set_up_BT_OBC(OBC, eta, BT_OBC, BT_Domain, G, GV, MS, halo, use_BT_co BT_OBC%H_v(i,J) = eta(i,j+1) endif endif - BT_OBC%Cg_v(i,J) = SQRT(GV%g_prime(1) * GV%H_to_Z*BT_OBC%H_v(i,J)) + BT_OBC%Cg_v(i,J) = US%L_T_to_m_s*SQRT(GV%g_prime(1) * GV%H_to_Z*BT_OBC%H_v(i,J)) endif endif ; enddo ; enddo if (OBC%Flather_v_BCs_exist_globally) then @@ -3729,7 +3730,7 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, US, param_file, diag, CS, character(len=40) :: mdl = "MOM_barotropic" ! This module's name. real :: Datu(SZIBS_(G),SZJ_(G)) ! Zonal open face area [H m ~> m2 or kg m-1]. real :: Datv(SZI_(G),SZJBS_(G)) ! Meridional open face area [H m ~> m2 or kg m-1]. - real :: gtot_estimate ! Summed GV%g_prime [m2 Z-1 s-2 ~> m s-2], to give an upper-bound estimate for pbce. + real :: gtot_estimate ! Summed GV%g_prime [L2 Z-1 T-2 ~> m s-2], to give an upper-bound estimate for pbce. real :: SSH_extra ! An estimate of how much higher SSH might get, for use ! in calculating the safe external wave speed [Z ~> m]. real :: dtbt_input, dtbt_tmp diff --git a/src/core/MOM_boundary_update.F90 b/src/core/MOM_boundary_update.F90 index ae78c6fd0d..c3ed3c705b 100644 --- a/src/core/MOM_boundary_update.F90 +++ b/src/core/MOM_boundary_update.F90 @@ -146,7 +146,7 @@ subroutine update_OBC_data(OBC, G, GV, US, tv, h, CS, Time) if (CS%use_dyed_channel) & call dyed_channel_update_flow(OBC, CS%dyed_channel_OBC_CSp, G, Time) if (OBC%needs_IO_for_data) & - call update_OBC_segment_data(G, GV, OBC, tv, h, Time) + call update_OBC_segment_data(G, GV, US, OBC, tv, h, Time) end subroutine update_OBC_data diff --git a/src/core/MOM_open_boundary.F90 b/src/core/MOM_open_boundary.F90 index 5624167170..70f3508206 100644 --- a/src/core/MOM_open_boundary.F90 +++ b/src/core/MOM_open_boundary.F90 @@ -2917,9 +2917,10 @@ subroutine open_boundary_test_extern_h(G, OBC, h) end subroutine open_boundary_test_extern_h !> Update the OBC values on the segments. -subroutine update_OBC_segment_data(G, GV, OBC, tv, h, Time) +subroutine update_OBC_segment_data(G, GV, US, OBC, tv, h, Time) type(ocean_grid_type), intent(in) :: 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 type(ocean_OBC_type), pointer :: OBC !< Open boundary structure type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamics structure real, dimension(SZI_(G),SZJ_(G), SZK_(G)), intent(inout) :: h !< Thickness [m] @@ -2980,7 +2981,7 @@ subroutine update_OBC_segment_data(G, GV, OBC, tv, h, Time) if (segment%direction == OBC_DIRECTION_W) ishift=1 I=segment%HI%IsdB do j=segment%HI%jsd,segment%HI%jed - segment%Cg(I,j) = sqrt(GV%g_prime(1)*G%bathyT(i+ishift,j)) + segment%Cg(I,j) = US%L_T_to_m_s*sqrt(GV%g_prime(1)*G%bathyT(i+ishift,j)) segment%Htot(I,j)=0.0 do k=1,G%ke segment%h(I,j,k) = h(i+ishift,j,k) @@ -2993,7 +2994,7 @@ subroutine update_OBC_segment_data(G, GV, OBC, tv, h, Time) if (segment%direction == OBC_DIRECTION_S) jshift=1 J=segment%HI%JsdB do i=segment%HI%isd,segment%HI%ied - segment%Cg(i,J) = sqrt(GV%g_prime(1)*G%bathyT(i,j+jshift)) + segment%Cg(i,J) = US%L_T_to_m_s*sqrt(GV%g_prime(1)*G%bathyT(i,j+jshift)) segment%Htot(i,J)=0.0 do k=1,G%ke segment%h(i,J,k) = h(i,j+jshift,k) diff --git a/src/core/MOM_verticalGrid.F90 b/src/core/MOM_verticalGrid.F90 index 83317192a7..3580ad3cc9 100644 --- a/src/core/MOM_verticalGrid.F90 +++ b/src/core/MOM_verticalGrid.F90 @@ -49,7 +49,7 @@ module MOM_verticalGrid !! Angstrom or larger without changing it at the bit level [H ~> m or kg m-2]. !! If Angstrom is 0 or exceedingly small, this is negligible compared to 1e-17 m. real, allocatable, dimension(:) :: & - g_prime, & !< The reduced gravity at each interface [m2 Z-1 s-2 ~> m s-2]. + g_prime, & !< The reduced gravity at each interface [L2 Z-1 T-2 ~> m s-2]. Rlay !< The target coordinate value (potential density) in each layer [kg m-3]. integer :: nkml = 0 !< The number of layers at the top that should be treated !! as parts of a homogeneous region. diff --git a/src/diagnostics/MOM_sum_output.F90 b/src/diagnostics/MOM_sum_output.F90 index 9399f73a58..d9716759d0 100644 --- a/src/diagnostics/MOM_sum_output.F90 +++ b/src/diagnostics/MOM_sum_output.F90 @@ -664,7 +664,7 @@ subroutine write_energy(u, v, h, tv, day, n, G, GV, US, CS, tracer_CSp, OBC, dt_ hint = Z_0APE(K) + (hbelow - G%bathyT(i,j)) hbot = Z_0APE(K) - G%bathyT(i,j) hbot = (hbot + ABS(hbot)) * 0.5 - PE_pt(i,j,K) = 0.5 * areaTm(i,j) * US%Z_to_m*(GV%Rho0*GV%g_prime(K)) * & + PE_pt(i,j,K) = 0.5 * areaTm(i,j) * US%Z_to_m*(GV%Rho0*US%L_to_m**2*US%s_to_T**2*GV%g_prime(K)) * & (hint * hint - hbot * hbot) enddo enddo ; enddo @@ -673,7 +673,7 @@ subroutine write_energy(u, v, h, tv, day, n, G, GV, US, CS, tracer_CSp, OBC, dt_ do k=nz,1,-1 hint = Z_0APE(K) + eta(i,j,K) ! eta and H_0 have opposite signs. hbot = max(Z_0APE(K) - G%bathyT(i,j), 0.0) - PE_pt(i,j,K) = 0.5 * (areaTm(i,j) * US%Z_to_m*(GV%Rho0*GV%g_prime(K))) * & + PE_pt(i,j,K) = 0.5 * (areaTm(i,j) * US%Z_to_m*(GV%Rho0*US%L_to_m**2*US%s_to_T**2*GV%g_prime(K))) * & (hint * hint - hbot * hbot) enddo enddo ; enddo diff --git a/src/initialization/MOM_coord_initialization.F90 b/src/initialization/MOM_coord_initialization.F90 index 45eb831d6c..c5adfdd74a 100644 --- a/src/initialization/MOM_coord_initialization.F90 +++ b/src/initialization/MOM_coord_initialization.F90 @@ -106,14 +106,14 @@ subroutine MOM_initialize_coord(GV, US, PF, write_geom, output_dir, tv, max_dept "Unrecognized coordinate setup"//trim(config)) end select if (debug) call chksum(GV%Rlay, "MOM_initialize_coord: Rlay ", 1, nz) - if (debug) call chksum(US%m_to_Z*GV%g_prime(:), "MOM_initialize_coord: g_prime ", 1, nz) + if (debug) call chksum(US%m_to_Z*US%L_to_m**2*US%s_to_T**2*GV%g_prime(:), "MOM_initialize_coord: g_prime ", 1, nz) call setVerticalGridAxes( GV%Rlay, GV ) ! Copy the maximum depth across from the input argument GV%max_depth = max_depth ! Write out all of the grid data used by this run. - if (write_geom) call write_vertgrid_file(GV, PF, output_dir) + if (write_geom) call write_vertgrid_file(GV, US, PF, output_dir) call callTree_leave('MOM_initialize_coord()') @@ -126,7 +126,7 @@ subroutine set_coord_from_gprime(Rlay, g_prime, GV, US, param_file) real, dimension(:), intent(out) :: Rlay !< The layers' target coordinate values !! (potential density) [kg m-3]. real, dimension(:), intent(out) :: g_prime !< The reduced gravity across the interfaces - !! [m2 Z-1 s-2 ~> m s-2]. + !! [L2 Z-1 T-2 ~> m s-2]. type(verticalGrid_type), intent(in) :: GV !< The ocean's 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 @@ -141,15 +141,15 @@ 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%mks_g_Earth, scale=US%Z_to_m) + default=GV%mks_g_Earth, scale=US%m_s_to_L_T**2*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) + units="m s-2", fail_if_missing=.true., scale=US%m_s_to_L_T**2*US%Z_to_m) g_prime(1) = g_fs do k=2,nz ; g_prime(k) = g_int ; enddo Rlay(1) = GV%Rho0 - do k=2,nz ; Rlay(k) = Rlay(k-1) + g_prime(k)*(GV%Rho0/GV%g_Earth) ; enddo + do k=2,nz ; Rlay(k) = Rlay(k-1) + g_prime(k)*(GV%Rho0/GV%LZT_g_Earth) ; enddo call callTree_leave(trim(mdl)//'()') @@ -160,7 +160,7 @@ subroutine set_coord_from_layer_density(Rlay, g_prime, GV, US, param_file) real, dimension(:), intent(out) :: Rlay !< The layers' target coordinate values !! (potential density) [kg m-3]. real, dimension(:), intent(out) :: g_prime !< The reduced gravity across the interfaces - !! [m2 Z-1 s-2 ~> m s-2]. + !! [L2 Z-1 T-2 ~> m s-2]. type(verticalGrid_type), intent(in) :: GV !< The ocean's 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 @@ -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%mks_g_Earth, scale=US%Z_to_m) + default=GV%mks_g_Earth, scale=US%m_s_to_L_T**2*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) @@ -191,7 +191,7 @@ subroutine set_coord_from_layer_density(Rlay, g_prime, GV, US, param_file) enddo ! These statements set the interface reduced gravities. ! do k=2,nz - g_prime(k) = (GV%g_Earth/GV%Rho0) * (Rlay(k) - Rlay(k-1)) + g_prime(k) = (GV%LZT_g_Earth/GV%Rho0) * (Rlay(k) - Rlay(k-1)) enddo call callTree_leave(trim(mdl)//'()') @@ -203,7 +203,7 @@ subroutine set_coord_from_TS_ref(Rlay, g_prime, GV, US, param_file, eqn_of_state real, dimension(:), intent(out) :: Rlay !< The layers' target coordinate values !! (potential density) [kg m-3]. real, dimension(:), intent(out) :: g_prime !< The reduced gravity across the interfaces - !! [m2 Z-1 s-2 ~> m s-2]. + !! [L2 Z-1 T-2 ~> m s-2]. type(verticalGrid_type), intent(in) :: GV !< The ocean's 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 @@ -228,10 +228,10 @@ 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%mks_g_Earth, scale=US%Z_to_m) + default=GV%mks_g_Earth, scale=US%m_s_to_L_T**2*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) + units="m s-2", fail_if_missing=.true., scale=US%m_s_to_L_T**2*US%Z_to_m) ! ! These statements set the interface reduced gravities. ! g_prime(1) = g_fs @@ -243,7 +243,7 @@ subroutine set_coord_from_TS_ref(Rlay, g_prime, GV, US, param_file, eqn_of_state call calculate_density(T_ref, S_ref, P_ref, Rlay(1), eqn_of_state) ! These statements set the layer densities. ! - do k=2,nz ; Rlay(k) = Rlay(k-1) + g_prime(k)*(GV%Rho0/GV%g_Earth) ; enddo + do k=2,nz ; Rlay(k) = Rlay(k-1) + g_prime(k)*(GV%Rho0/GV%LZT_g_Earth) ; enddo call callTree_leave(trim(mdl)//'()') end subroutine set_coord_from_TS_ref @@ -254,7 +254,7 @@ subroutine set_coord_from_TS_profile(Rlay, g_prime, GV, US, param_file, & real, dimension(:), intent(out) :: Rlay !< The layers' target coordinate values !! (potential density) [kg m-3]. real, dimension(:), intent(out) :: g_prime !< The reduced gravity across the interfaces - !! [m2 Z-1 s-2 ~> m s-2]. + !! [L2 Z-1 T-2 ~> m s-2]. type(verticalGrid_type), intent(in) :: GV !< The ocean's 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 @@ -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%mks_g_Earth, scale=US%Z_to_m) + default=GV%mks_g_Earth, scale=US%m_s_to_L_T**2*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.) @@ -291,7 +291,7 @@ subroutine set_coord_from_TS_profile(Rlay, g_prime, GV, US, param_file, & g_prime(1) = g_fs do k=1,nz ; Pref(k) = P_ref ; enddo call calculate_density(T0, S0, Pref, Rlay, 1,nz,eqn_of_state) - do k=2,nz; g_prime(k) = (GV%g_Earth/GV%Rho0) * (Rlay(k) - Rlay(k-1)) ; enddo + do k=2,nz; g_prime(k) = (GV%LZT_g_Earth/GV%Rho0) * (Rlay(k) - Rlay(k-1)) ; enddo call callTree_leave(trim(mdl)//'()') end subroutine set_coord_from_TS_profile @@ -302,7 +302,7 @@ subroutine set_coord_from_TS_range(Rlay, g_prime, GV, US, param_file, & real, dimension(:), intent(out) :: Rlay !< The layers' target coordinate values !! (potential density) [kg m-3]. real, dimension(:), intent(out) :: g_prime !< The reduced gravity across the interfaces - !! [m2 Z-1 s-2 ~> m s-2]. + !! [L2 Z-1 T-2 ~> m s-2]. type(verticalGrid_type), intent(in) :: GV !< The ocean's 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 @@ -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%mks_g_Earth, scale=US%Z_to_m) + default=GV%mks_g_Earth, scale=US%m_s_to_L_T**2*US%Z_to_m) k_light = GV%nk_rho_varies + 1 @@ -375,7 +375,7 @@ subroutine set_coord_from_TS_range(Rlay, g_prime, GV, US, param_file, & do k=k_light-1,1,-1 Rlay(k) = 2.0*Rlay(k+1) - Rlay(k+2) enddo - do k=2,nz; g_prime(k) = (GV%g_Earth/GV%Rho0) * (Rlay(k) - Rlay(k-1)); enddo + do k=2,nz; g_prime(k) = (GV%LZT_g_Earth/GV%Rho0) * (Rlay(k) - Rlay(k-1)); enddo call callTree_leave(trim(mdl)//'()') end subroutine set_coord_from_TS_range @@ -385,7 +385,7 @@ subroutine set_coord_from_file(Rlay, g_prime, GV, US, param_file) real, dimension(:), intent(out) :: Rlay !< The layers' target coordinate values !! (potential density) [kg m-3]. real, dimension(:), intent(out) :: g_prime !< The reduced gravity across the interfaces - !! [m2 Z-1 s-2 ~> m s-2]. + !! [L2 Z-1 T-2 ~> m s-2]. type(verticalGrid_type), intent(in) :: GV !< The ocean's 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 @@ -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%mks_g_Earth, scale=US%Z_to_m) + default=GV%mks_g_Earth, scale=US%m_s_to_L_T**2*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, & @@ -417,7 +417,7 @@ subroutine set_coord_from_file(Rlay, g_prime, GV, US, param_file) call read_axis_data(filename, coord_var, Rlay) g_prime(1) = g_fs - do k=2,nz ; g_prime(k) = (GV%g_Earth/GV%Rho0) * (Rlay(k) - Rlay(k-1)) ; enddo + do k=2,nz ; g_prime(k) = (GV%LZT_g_Earth/GV%Rho0) * (Rlay(k) - Rlay(k-1)) ; enddo do k=1,nz ; if (g_prime(k) <= 0.0) then call MOM_error(FATAL, "MOM_initialization set_coord_from_file: "//& "Zero or negative g_primes read from variable "//"Layer"//" in file "//& @@ -436,7 +436,7 @@ subroutine set_coord_linear(Rlay, g_prime, GV, US, param_file) real, dimension(:), intent(out) :: Rlay !< The layers' target coordinate values !! (potential density) [kg m-3]. real, dimension(:), intent(out) :: g_prime !< The reduced gravity across the interfaces - !! [m2 Z-1 s-2 ~> m s-2]. + !! [L2 Z-1 T-2 ~> m s-2]. type(verticalGrid_type), intent(in) :: GV !< The ocean's 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 @@ -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%mks_g_Earth, scale=US%Z_to_m) + default=GV%mks_g_Earth, scale=US%m_s_to_L_T**2*US%Z_to_m) ! This following sets the target layer densities such that a the ! surface interface has density Rlay_ref and the bottom @@ -467,7 +467,7 @@ subroutine set_coord_linear(Rlay, g_prime, GV, US, param_file) ! These statements set the interface reduced gravities. g_prime(1) = g_fs do k=2,nz - g_prime(k) = (GV%g_Earth/GV%Rho0) * (Rlay(k) - Rlay(k-1)) + g_prime(k) = (GV%LZT_g_Earth/GV%Rho0) * (Rlay(k) - Rlay(k-1)) enddo call callTree_leave(trim(mdl)//'()') @@ -480,7 +480,7 @@ subroutine set_coord_to_none(Rlay, g_prime, GV, US, param_file) real, dimension(:), intent(out) :: Rlay !< The layers' target coordinate values !! (potential density) [kg m-3]. real, dimension(:), intent(out) :: g_prime !< The reduced gravity across the interfaces, - !! [m2 Z-1 s-2 ~> m s-2]. + !! [L2 Z-1 T-2 ~> m s-2]. type(verticalGrid_type), intent(in) :: GV !< The ocean's 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 @@ -494,12 +494,12 @@ 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%mks_g_Earth, scale=US%Z_to_m) + default=GV%mks_g_Earth, scale=US%m_s_to_L_T**2*US%Z_to_m) g_prime(1) = g_fs do k=2,nz ; g_prime(k) = 0. ; enddo Rlay(1) = GV%Rho0 - do k=2,nz ; Rlay(k) = Rlay(k-1) + g_prime(k)*(GV%Rho0/GV%g_Earth) ; enddo + do k=2,nz ; Rlay(k) = Rlay(k-1) + g_prime(k)*(GV%Rho0/GV%LZT_g_Earth) ; enddo call callTree_leave(trim(mdl)//'()') @@ -507,8 +507,9 @@ end subroutine set_coord_to_none !> Writes out a file containing any available data related !! to the vertical grid used by the MOM ocean model. -subroutine write_vertgrid_file(GV, param_file, directory) +subroutine write_vertgrid_file(GV, US, param_file, directory) type(verticalGrid_type), intent(in) :: GV !< The ocean's 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 character(len=*), intent(in) :: directory !< The directory into which to place the file. ! Local variables @@ -525,7 +526,7 @@ subroutine write_vertgrid_file(GV, param_file, directory) call create_file(unit, trim(filepath), vars, 2, fields, SINGLE_FILE, GV=GV) call write_field(unit, fields(1), GV%Rlay) - call write_field(unit, fields(2), GV%g_prime) !### RESCALE THIS? + call write_field(unit, fields(2), US%L_T_to_m_s**2*US%m_to_Z*GV%g_prime(:)) call close_file(unit) diff --git a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 index 0df5ca75d0..63348231f3 100644 --- a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 +++ b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 @@ -646,7 +646,7 @@ subroutine calc_slope_functions_using_just_e(h, G, GV, US, CS, e, calculate_slop Hdn = 2.*h(i,j,k)*h(i,j,k-1) / (h(i,j,k) + h(i,j,k-1) + h_neglect) Hup = 2.*h(i+1,j,k)*h(i+1,j,k-1) / (h(i+1,j,k) + h(i+1,j,k-1) + h_neglect) H_geom = sqrt(Hdn*Hup) - N2 = GV%g_prime(k)*US%m_to_Z**2 / (GV%H_to_Z * max(Hdn,Hup,one_meter)) + N2 = US%s_to_T**2*GV%g_prime(k)*US%L_to_Z**2 / (GV%H_to_Z * max(Hdn,Hup,one_meter)) if (min(h(i,j,k-1), h(i+1,j,k-1), h(i,j,k), h(i+1,j,k)) < H_cutoff) & S2 = 0.0 SN_u_local(I,j,k) = (H_geom * GV%H_to_Z) * S2 * N2 @@ -657,7 +657,7 @@ subroutine calc_slope_functions_using_just_e(h, G, GV, US, CS, e, calculate_slop Hdn = 2.*h(i,j,k)*h(i,j,k-1) / (h(i,j,k) + h(i,j,k-1) + h_neglect) Hup = 2.*h(i,j+1,k)*h(i,j+1,k-1) / (h(i,j+1,k) + h(i,j+1,k-1) + h_neglect) H_geom = sqrt(Hdn*Hup) - N2 = GV%g_prime(k)*US%m_to_Z**2 / (GV%H_to_Z * max(Hdn,Hup,one_meter)) + N2 = US%s_to_T**2*GV%g_prime(k)*US%L_to_Z**2 / (GV%H_to_Z * max(Hdn,Hup,one_meter)) if (min(h(i,j,k-1), h(i,j+1,k-1), h(i,j,k), h(i,j+1,k)) < H_cutoff) & S2 = 0.0 SN_v_local(i,J,k) = (H_geom * GV%H_to_Z) * S2 * N2 diff --git a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 index 3ebf159e3d..0c7dec69aa 100644 --- a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 +++ b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 @@ -859,7 +859,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV endif if (CS%id_slope_x > 0) CS%diagSlopeX(I,j,k) = Slope Sfn_unlim_u(I,K) = ((KH_u(I,j,K)*G%dy_Cu(I,j))*US%m_to_Z*Slope) - hN2_u(I,K) = GV%g_prime(K) + hN2_u(I,K) = US%L_to_m**2*US%s_to_T**2*GV%g_prime(K) endif ! if (use_EOS) else ! if (k > nk_linear) hN2_u(I,K) = N2_floor * dz_neglect @@ -1108,7 +1108,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV endif if (CS%id_slope_y > 0) CS%diagSlopeY(I,j,k) = Slope Sfn_unlim_v(i,K) = ((KH_v(i,J,K)*G%dx_Cv(i,J))*US%m_to_Z*Slope) - hN2_v(i,K) = GV%g_prime(K) + hN2_v(i,K) = US%L_to_m**2*US%s_to_T**2*GV%g_prime(K) endif ! if (use_EOS) else ! if (k > nk_linear) hN2_v(i,K) = N2_floor * dz_neglect diff --git a/src/parameterizations/vertical/MOM_entrain_diffusive.F90 b/src/parameterizations/vertical/MOM_entrain_diffusive.F90 index 121191b008..c215c996d9 100644 --- a/src/parameterizations/vertical/MOM_entrain_diffusive.F90 +++ b/src/parameterizations/vertical/MOM_entrain_diffusive.F90 @@ -381,7 +381,7 @@ subroutine entrainment_diffusive(h, tv, fluxes, dt, G, GV, US, CS, ea, eb, & htot(i) = h(i,j,1) - Angstrom enddo if (associated(fluxes%buoy)) then ; do i=is,ie - maxF(i,1) = (dt*fluxes%buoy(i,j)) / (GV%g_prime(2)*US%m_to_Z) + maxF(i,1) = (dt*fluxes%buoy(i,j)) / (US%L_to_m**2*US%s_to_T**2*GV%g_prime(2)*US%m_to_Z) enddo ; endif endif diff --git a/src/parameterizations/vertical/MOM_set_diffusivity.F90 b/src/parameterizations/vertical/MOM_set_diffusivity.F90 index c47f037789..fbc299a4e2 100644 --- a/src/parameterizations/vertical/MOM_set_diffusivity.F90 +++ b/src/parameterizations/vertical/MOM_set_diffusivity.F90 @@ -1800,7 +1800,7 @@ subroutine set_density_ratios(h, tv, kb, G, GV, US, CS, j, ds_dsp1, rho_0) is = G%isc ; ie = G%iec ; nz = G%ke do k=2,nz-1 - if (GV%g_prime(k+1)/=0.) then + if (GV%g_prime(k+1) /= 0.0) then do i=is,ie ds_dsp1(i,k) = GV%g_prime(k) / GV%g_prime(k+1) enddo @@ -1826,7 +1826,7 @@ subroutine set_density_ratios(h, tv, kb, G, GV, US, CS, j, ds_dsp1, rho_0) ! interfaces above and below the buffer layer and the next denser layer. k = kb(i) - I_Drho = (US%s_to_T**2*US%L_to_m**2*g_R0) / (GV%g_prime(k+1)) + I_Drho = 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/user/BFB_initialization.F90 b/src/user/BFB_initialization.F90 index 31223d5686..fd3b7e8225 100644 --- a/src/user/BFB_initialization.F90 +++ b/src/user/BFB_initialization.F90 @@ -38,7 +38,7 @@ module BFB_initialization subroutine BFB_set_coord(Rlay, g_prime, GV, param_file, eqn_of_state) real, dimension(NKMEM_), intent(out) :: Rlay !< Layer potential density. real, dimension(NKMEM_), intent(out) :: g_prime !< The reduced gravity at - !! each interface [m2 Z-1 s-2 ~> m s-2]. + !! each interface [L2 Z-1 T-2 ~> m s-2]. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters type(EOS_type), pointer :: eqn_of_state !< Integer that selects the @@ -62,9 +62,9 @@ subroutine BFB_set_coord(Rlay, g_prime, GV, param_file, eqn_of_state) do k = 1,nz Rlay(k) = (rho_bot - rho_top)/(nz-1)*real(k-1) + rho_top if (k >1) then - g_prime(k) = (Rlay(k) - Rlay(k-1)) * GV%g_Earth/GV%rho0 + g_prime(k) = (Rlay(k) - Rlay(k-1)) * GV%LZT_g_Earth/GV%rho0 else - g_prime(k) = GV%g_Earth + g_prime(k) = GV%LZT_g_Earth endif !Rlay(:) = 0.0 !g_prime(:) = 0.0 diff --git a/src/user/Phillips_initialization.F90 b/src/user/Phillips_initialization.F90 index ab964b5269..af17bb87a5 100644 --- a/src/user/Phillips_initialization.F90 +++ b/src/user/Phillips_initialization.F90 @@ -164,11 +164,11 @@ subroutine Phillips_initialize_velocity(u, v, G, GV, US, param_file, just_read_p ! This uses d/d y_2 atan(y_2 / jet_width) ! u(I,j,k) = u(I,j,k+1) + (1e-3 * jet_height / & ! (jet_width * (1.0 + (y_2 / jet_width)**2))) * & -! (2.0 * GV%g_prime(K+1) * US%T_to_s / (G%CoriolisBu(I,J) + G%CoriolisBu(I,J-1))) +! (2.0 * US%L_to_m**2*US%s_to_T**2*GV%g_prime(K+1) * US%T_to_s / (G%CoriolisBu(I,J) + G%CoriolisBu(I,J-1))) ! This uses d/d y_2 tanh(y_2 / jet_width) u(I,j,k) = u(I,j,k+1) + (1e-3 * (jet_height / jet_width) * & (sech(y_2 / jet_width))**2 ) * & - (2.0 * GV%g_prime(K+1) * US%T_to_s / (G%CoriolisBu(I,J) + G%CoriolisBu(I,J-1))) + (2.0 * US%L_to_m**2*US%s_to_T**2*GV%g_prime(K+1) * US%T_to_s / (G%CoriolisBu(I,J) + G%CoriolisBu(I,J-1))) enddo ; enddo ; enddo do k=1,nz ; do j=js,je ; do I=is-1,ie diff --git a/src/user/user_initialization.F90 b/src/user/user_initialization.F90 index d79e9183bf..bcf1942cad 100644 --- a/src/user/user_initialization.F90 +++ b/src/user/user_initialization.F90 @@ -42,7 +42,7 @@ subroutine USER_set_coord(Rlay, g_prime, GV, param_file, eqn_of_state) !! structure. real, dimension(:), intent(out) :: Rlay !< Layer potential density. real, dimension(:), intent(out) :: g_prime !< The reduced gravity at - !! each interface [m2 Z-1 s-2 ~> m s-2]. + !! each interface [L2 Z-1 T-2 ~> m s-2]. type(param_file_type), intent(in) :: param_file !< A structure indicating the !! open file to parse for model !! parameter values. @@ -247,7 +247,7 @@ end subroutine write_user_log !! - h - Layer thickness [H ~> m or kg m-2]. (Must be positive.) !! - G%bathyT - Basin depth [Z ~> m]. (Must be positive.) !! - G%CoriolisBu - The Coriolis parameter [T-1 ~> s-1]. -!! - GV%g_prime - The reduced gravity at each interface [m2 Z-1 s-2 ~> m s-2]. +!! - GV%g_prime - The reduced gravity at each interface [L2 Z-1 T-2 ~> m s-2]. !! - GV%Rlay - Layer potential density (coordinate variable) [kg m-3]. !! If ENABLE_THERMODYNAMICS is defined: !! - T - Temperature [degC]. From 04dcca4a0581b9565674e106174b3e1eb63d3d75 Mon Sep 17 00:00:00 2001 From: Marshall Ward Date: Thu, 11 Jul 2019 10:32:19 -0400 Subject: [PATCH 094/150] Bugfix: Pure pot. density coord diags w/ one layer For experiments with a single layer (e.g. unit_tests), the "pure potential density coordinate" diagnostics (h_Rlay, uh_Rlay, ...) would apply an interpolation to extend values into the mixed layers. However, most of this subroutine assumes at least two layers, including some "nz / 2" divisions which reduce to zero, and memory accesses to levels greater than nz. Overall, this calculation does not make much sense when there is one layer, for both physical and computational reasons. Normally the `nkmb` parameter is changed from zero to `nz` when not in isopycnal mode, applying the interpolation across the entire column, which avoids the interpolating loops and simply transfers the layered values to the diagnostic. We resolve this issue by only apply "nkmb = z" when there is more than one layer, and transfer values regardless of the mode. --- src/diagnostics/MOM_diagnostics.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/diagnostics/MOM_diagnostics.F90 b/src/diagnostics/MOM_diagnostics.F90 index 45cfb0ac68..952e3c8b49 100644 --- a/src/diagnostics/MOM_diagnostics.F90 +++ b/src/diagnostics/MOM_diagnostics.F90 @@ -275,7 +275,7 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & ! nkmb = nz, on the expectation that loops nkmb+1,nz will not iterate. ! This behavior is ANSI F77 but some compiler options can force at least ! one iteration that would break the following one-line workaround! - if (nkmb==0) nkmb = nz + if (nkmb==0 .and. nz > 1) nkmb = nz if (loc(CS)==0) call MOM_error(FATAL, & "calculate_diagnostic_fields: Module must be initialized before used.") From 2426ab6d9c8061e2c3a9371d21fed34d84e7b170 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Thu, 11 Jul 2019 17:25:09 -0400 Subject: [PATCH 095/150] Removed commented out controlled_forcing codes Removed commented out controlled_forcing calls and other code from the ice_solo_driver, mct_driver, and nuopc_driver code. This capability has never been completed, so until it is working, it is only being retained (in commented out form) in the coupled_driver code. All answers are bitwise identical. --- .../ice_solo_driver/MOM_surface_forcing.F90 | 23 +------------------ .../ice_solo_driver/ice_shelf_driver.F90 | 2 +- config_src/mct_driver/MOM_surface_forcing.F90 | 10 -------- .../nuopc_driver/MOM_surface_forcing.F90 | 20 ---------------- .../solo_driver/MESO_surface_forcing.F90 | 2 +- config_src/unit_drivers/MOM_sum_driver.F90 | 2 +- 6 files changed, 4 insertions(+), 55 deletions(-) diff --git a/config_src/ice_solo_driver/MOM_surface_forcing.F90 b/config_src/ice_solo_driver/MOM_surface_forcing.F90 index 3509016c1f..0a81eaa960 100644 --- a/config_src/ice_solo_driver/MOM_surface_forcing.F90 +++ b/config_src/ice_solo_driver/MOM_surface_forcing.F90 @@ -46,9 +46,6 @@ module MOM_surface_forcing !* The boundaries always run through q grid points (x). * !* * !********+*********+*********+*********+*********+*********+*********+** -!### 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 use MOM_cpu_clock, only : cpu_clock_id, cpu_clock_begin, cpu_clock_end use MOM_cpu_clock, only : CLOCK_MODULE use MOM_diag_mediator, only : post_data, query_averaging_enabled @@ -131,7 +128,6 @@ module MOM_surface_forcing character(len=8) :: wind_stagger type(tracer_flow_control_CS), pointer :: tracer_flow_CSp => NULL() -!### type(ctrl_forcing_CS), pointer :: ctrl_forcing_CSp => NULL() type(MOM_restart_CS), pointer :: restart_CSp => NULL() type(diag_ctrl), pointer :: diag ! structure used to regulate timing of diagnostic output @@ -706,7 +702,7 @@ subroutine buoyancy_forcing_from_files(sfc_state, fluxes, day, dt, G, CS) enddo ; enddo ! Read the SST and SSS fields for damping. - if (CS%restorebuoy) then !### .or. associated(CS%ctrl_forcing_CSp)) then + if (CS%restorebuoy) then call MOM_read_data(trim(CS%inputdir)//trim(CS%SSTrestore_file), "TEMP", & CS%T_Restore(:,:), G%Domain, timelevel=time_lev_monthly) call MOM_read_data(trim(CS%inputdir)//trim(CS%salinityrestore_file), "SALT", & @@ -769,16 +765,6 @@ subroutine buoyancy_forcing_from_files(sfc_state, fluxes, day, dt, G, CS) endif 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_restore, & -!### fluxes%vprec, day, dt, G, CS%ctrl_forcing_CSp) -!### endif - call callTree_leave("buoyancy_forcing_from_files") end subroutine buoyancy_forcing_from_files @@ -1149,15 +1135,12 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, tracer_flow_C elseif (trim(CS%wind_config) == "MESO" .or. trim(CS%buoy_config) == "MESO" ) then call MOM_error(FATAL, "MESO forcing is not available with the ice-shelf"//& "version of MOM_surface_forcing.") -! call MESO_surface_forcing_init(Time, G, param_file, diag, CS%MESO_forcing_CSp) endif call register_forcing_type_diags(Time, diag, US, CS%use_temperature, CS%handles) ! Set up any restart fields associated with the forcing. call restart_init(G, param_file, CS%restart_CSp, "MOM_forcing.res") -!### call register_ctrl_forcing_restarts(G, param_file, CS%ctrl_forcing_CSp, & -!### CS%restart_CSp) call restart_init_end(CS%restart_CSp) if (associated(CS%restart_CSp)) then @@ -1172,8 +1155,6 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, tracer_flow_C endif endif -!### call controlled_forcing_init(Time, G, param_file, diag, CS%ctrl_forcing_CSp) - call user_revise_forcing_init(param_file, CS%urf_CS) call cpu_clock_end(id_clock_forcing) @@ -1189,8 +1170,6 @@ subroutine surface_forcing_end(CS, fluxes) if (present(fluxes)) call deallocate_forcing_type(fluxes) -!### call controlled_forcing_end(CS%ctrl_forcing_CSp) - if (associated(CS)) deallocate(CS) CS => NULL() diff --git a/config_src/ice_solo_driver/ice_shelf_driver.F90 b/config_src/ice_solo_driver/ice_shelf_driver.F90 index 1d6f46427d..828dbf301c 100644 --- a/config_src/ice_solo_driver/ice_shelf_driver.F90 +++ b/config_src/ice_solo_driver/ice_shelf_driver.F90 @@ -148,7 +148,7 @@ program SHELF_main namelist /ice_solo_nml/ date_init, calendar, months, days, hours, minutes, seconds - !####################################################################### + !======================================================================= call write_cputime_start_clock(write_CPU_CSp) diff --git a/config_src/mct_driver/MOM_surface_forcing.F90 b/config_src/mct_driver/MOM_surface_forcing.F90 index 252477b2b5..5d30f3c9cb 100644 --- a/config_src/mct_driver/MOM_surface_forcing.F90 +++ b/config_src/mct_driver/MOM_surface_forcing.F90 @@ -2,9 +2,6 @@ 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 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 @@ -144,7 +141,6 @@ module MOM_surface_forcing integer :: id_srestore = -1 !< id number for time_interp_external. integer :: id_trestore = -1 !< id number for time_interp_external. type(forcing_diags), public :: handles !< diagnostics handles - !### type(ctrl_forcing_CS), pointer :: ctrl_forcing_CSp => NULL() type(MOM_restart_CS), pointer :: restart_CSp => NULL() !< restart pointer type(user_revise_forcing_CS), pointer :: urf_CS => NULL()!< user revise pointer end type surface_forcing_CS @@ -1302,8 +1298,6 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, restore_salt, ! 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) call restart_init_end(CS%restart_CSp) if (associated(CS%restart_CSp)) then @@ -1318,8 +1312,6 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, restore_salt, endif endif -!### call controlled_forcing_init(Time, G, param_file, diag, CS%ctrl_forcing_CSp) - call user_revise_forcing_init(param_file, CS%urf_CS) call cpu_clock_end(id_clock_forcing) @@ -1338,8 +1330,6 @@ subroutine surface_forcing_end(CS, fluxes) if (present(fluxes)) call deallocate_forcing_type(fluxes) -!### call controlled_forcing_end(CS%ctrl_forcing_CSp) - if (associated(CS)) deallocate(CS) CS => NULL() diff --git a/config_src/nuopc_driver/MOM_surface_forcing.F90 b/config_src/nuopc_driver/MOM_surface_forcing.F90 index 5990aec2e0..01cd79acb9 100644 --- a/config_src/nuopc_driver/MOM_surface_forcing.F90 +++ b/config_src/nuopc_driver/MOM_surface_forcing.F90 @@ -3,9 +3,6 @@ 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 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 @@ -148,7 +145,6 @@ module MOM_surface_forcing ! Diagnostics handles type(forcing_diags), public :: handles -!### type(ctrl_forcing_CS), pointer :: ctrl_forcing_CSp => NULL() type(MOM_restart_CS), pointer :: restart_CSp => NULL() type(user_revise_forcing_CS), pointer :: urf_CS => NULL() end type surface_forcing_CS @@ -526,16 +522,6 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, US, CS, & 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 - ! adjust the NET fresh-water flux to zero, if flagged if (CS%adjust_net_fresh_water_to_zero) then sign_for_net_FW_bug = 1. @@ -1310,8 +1296,6 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, restore_salt, ! 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) call restart_init_end(CS%restart_CSp) if (associated(CS%restart_CSp)) then @@ -1326,8 +1310,6 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, restore_salt, endif endif -!### call controlled_forcing_init(Time, G, param_file, diag, CS%ctrl_forcing_CSp) - call user_revise_forcing_init(param_file, CS%urf_CS) call cpu_clock_end(id_clock_forcing) @@ -1344,8 +1326,6 @@ subroutine surface_forcing_end(CS, fluxes) if (present(fluxes)) call deallocate_forcing_type(fluxes) -!### call controlled_forcing_end(CS%ctrl_forcing_CSp) - if (associated(CS)) deallocate(CS) CS => NULL() diff --git a/config_src/solo_driver/MESO_surface_forcing.F90 b/config_src/solo_driver/MESO_surface_forcing.F90 index 1ce96fdac2..37c7f72794 100644 --- a/config_src/solo_driver/MESO_surface_forcing.F90 +++ b/config_src/solo_driver/MESO_surface_forcing.F90 @@ -113,7 +113,7 @@ subroutine MESO_buoyancy_forcing(sfc_state, fluxes, day, dt, G, CS) ! MODIFY THE CODE IN THE FOLLOWING LOOPS TO SET THE BUOYANCY FORCING TERMS. - if (CS%restorebuoy .and. first_call) then !### .or. associated(CS%ctrl_forcing_CSp)) then + if (CS%restorebuoy .and. first_call) then !#CTRL# .or. associated(CS%ctrl_forcing_CSp)) then call safe_alloc_ptr(CS%T_Restore, isd, ied, jsd, jed) call safe_alloc_ptr(CS%S_Restore, isd, ied, jsd, jed) call safe_alloc_ptr(CS%Heat, isd, ied, jsd, jed) diff --git a/config_src/unit_drivers/MOM_sum_driver.F90 b/config_src/unit_drivers/MOM_sum_driver.F90 index 4778bc2167..5673b201ee 100644 --- a/config_src/unit_drivers/MOM_sum_driver.F90 +++ b/config_src/unit_drivers/MOM_sum_driver.F90 @@ -60,7 +60,7 @@ program MOM_main character(len=40) :: mdl = "MOM_main (MOM_sum_driver)" ! This module's name. character(len=200) :: mesg - !####################################################################### + !======================================================================= call MOM_infra_init() ; call io_infra_init() From cf9641fba492256bd41806e8787ed6637bb929f1 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Thu, 11 Jul 2019 17:27:28 -0400 Subject: [PATCH 096/150] +Rescaled the units of pbce Rescaled the units of pbce to L2 H-1 T-2 from m2 H-1 s-2 for enhanced dimensional consistency testing. All answers are bitwise identical. --- src/core/MOM_PressureForce_Montgomery.F90 | 30 ++++++++++++---------- src/core/MOM_PressureForce_analytic_FV.F90 | 2 +- src/core/MOM_PressureForce_blocked_AFV.F90 | 2 +- src/core/MOM_barotropic.F90 | 28 ++++++++++---------- src/core/MOM_checksum_packages.F90 | 6 +++-- src/core/MOM_dynamics_split_RK2.F90 | 10 ++++---- src/core/MOM_dynamics_unsplit.F90 | 6 ++--- src/core/MOM_dynamics_unsplit_RK2.F90 | 4 +-- 8 files changed, 46 insertions(+), 42 deletions(-) diff --git a/src/core/MOM_PressureForce_Montgomery.F90 b/src/core/MOM_PressureForce_Montgomery.F90 index 16e3e5e211..827fb77849 100644 --- a/src/core/MOM_PressureForce_Montgomery.F90 +++ b/src/core/MOM_PressureForce_Montgomery.F90 @@ -306,7 +306,7 @@ subroutine PressureForce_Mont_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, pb ! Note that ddM/dPb = alpha_star(i,j,1) if (present(pbce)) then - call Set_pbce_nonBouss(p, tv_tmp, G, GV, CS%GFS_scale, pbce, alpha_star) + call Set_pbce_nonBouss(p, tv_tmp, G, GV, US, CS%GFS_scale, pbce, alpha_star) endif ! Calculate the pressure force. On a Cartesian grid, @@ -629,7 +629,7 @@ subroutine Set_pbce_Bouss(e, tv, G, GV, US, Rho0, GFS_scale, pbce, rho_star) real :: dR_dT(SZI_(G)) ! Partial derivative of density with temperature [kg m-3 degC-1]. real :: dR_dS(SZI_(G)) ! Partial derivative of density with salinity [kg m-3 ppt-1]. real :: rho_in_situ(SZI_(G)) !In-situ density at the top of a layer [kg m-3]. - real :: G_Rho0 ! G_Earth / Rho0 [m5 Z-1 s-2 kg-1 ~> m4 s-2 kg-1] + real :: G_Rho0 ! A scaled version of g_Earth / Rho0 [L2 m3 Z-1 T-2 kg-1 ~> m4 s-2 kg-1] real :: Rho0xG ! g_Earth * Rho0 [kg s-2 m-1 Z-1 ~> kg s-2 m-2] logical :: use_EOS ! If true, density is calculated from T & S using ! an equation of state. @@ -640,7 +640,7 @@ subroutine Set_pbce_Bouss(e, tv, G, GV, US, Rho0, GFS_scale, pbce, rho_star) Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB ; nz = G%ke Rho0xG = Rho0*GV%g_Earth - G_Rho0 = GV%g_Earth / GV%Rho0 + G_Rho0 = GV%LZT_g_Earth / GV%Rho0 use_EOS = associated(tv%eqn_of_state) z_neglect = GV%H_subroundoff*GV%H_to_Z @@ -650,10 +650,10 @@ subroutine Set_pbce_Bouss(e, tv, G, GV, US, Rho0, GFS_scale, pbce, rho_star) do j=Jsq,Jeq+1 do i=Isq,Ieq+1 Ihtot(i) = GV%H_to_Z / ((e(i,j,1)-e(i,j,nz+1)) + z_neglect) - pbce(i,j,1) = GFS_scale * rho_star(i,j,1) * GV%H_to_Z + pbce(i,j,1) = GFS_scale * US%m_s_to_L_T**2*rho_star(i,j,1) * GV%H_to_Z enddo do k=2,nz ; do i=Isq,Ieq+1 - pbce(i,j,k) = pbce(i,j,k-1) + (rho_star(i,j,k)-rho_star(i,j,k-1)) * & + pbce(i,j,k) = pbce(i,j,k-1) + US%m_s_to_L_T**2*(rho_star(i,j,k)-rho_star(i,j,k-1)) * & ((e(i,j,K) - e(i,j,nz+1)) * Ihtot(i)) enddo ; enddo enddo ! end of j loop @@ -691,11 +691,11 @@ subroutine Set_pbce_Bouss(e, tv, G, GV, US, Rho0, GFS_scale, pbce, rho_star) do j=Jsq,Jeq+1 do i=Isq,Ieq+1 Ihtot(i) = 1.0 / ((e(i,j,1)-e(i,j,nz+1)) + z_neglect) - pbce(i,j,1) = US%L_to_m**2*US%s_to_T**2*GV%g_prime(1) * GV%H_to_Z + pbce(i,j,1) = GV%g_prime(1) * GV%H_to_Z enddo do k=2,nz ; do i=Isq,Ieq+1 pbce(i,j,k) = pbce(i,j,k-1) + & - (US%L_to_m**2*US%s_to_T**2*GV%g_prime(K)*GV%H_to_Z) * ((e(i,j,K) - e(i,j,nz+1)) * Ihtot(i)) + (GV%g_prime(K)*GV%H_to_Z) * ((e(i,j,K) - e(i,j,nz+1)) * Ihtot(i)) enddo ; enddo enddo ! end of j loop endif ! use_EOS @@ -704,24 +704,25 @@ end subroutine Set_pbce_Bouss !> Determines the partial derivative of the acceleration due !! to pressure forces with the column mass. -subroutine Set_pbce_nonBouss(p, tv, G, GV, GFS_scale, pbce, alpha_star) +subroutine Set_pbce_nonBouss(p, tv, G, GV, US, GFS_scale, pbce, alpha_star) type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(in) :: p !< Interface pressures [Pa]. type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamic variables + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, intent(in) :: GFS_scale !< Ratio between gravity applied to top !! interface and the gravitational acceleration of !! the planet [nondim]. Usually this ratio is 1. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(out) :: pbce !< The baroclinic pressure anomaly in each layer due !! to free surface height anomalies - !! [m2 H-1 s-2 ~> m4 kg-2 s-2]. + !! [L2 H-1 T-2 ~> m4 kg-1 s-2]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), optional, intent(in) :: alpha_star !< The layer specific volumes !! (maybe compressibility compensated) [m3 kg-1]. ! Local variables real, dimension(SZI_(G),SZJ_(G)) :: & dpbce, & ! A barotropic correction to the pbce to enable the use of - ! a reduced gravity form of the equations [m4 s-2 kg-1]. - C_htot ! dP_dH divided by the total ocean pressure [m2 kg-1]. + ! a reduced gravity form of the equations [L2 H-1 T-2 ~> m4 kg-1 s-2]. + C_htot ! dP_dH divided by the total ocean pressure [Z2 s2 m-2 T-2 H-1 ~> m2 kg-1]. real :: T_int(SZI_(G)) ! Interface temperature [degC]. real :: S_int(SZI_(G)) ! Interface salinity [ppt]. real :: dR_dT(SZI_(G)) ! Partial derivative of density with temperature [kg m-3 degC-1]. @@ -729,7 +730,8 @@ subroutine Set_pbce_nonBouss(p, tv, G, GV, GFS_scale, pbce, alpha_star) real :: rho_in_situ(SZI_(G)) ! In-situ density at an interface [kg m-3]. real :: alpha_Lay(SZK_(G)) ! The specific volume of each layer [kg m-3]. real :: dalpha_int(SZK_(G)+1) ! The change in specific volume across each interface [kg m-3]. - real :: dP_dH ! A factor that converts from thickness to pressure [Pa H-1 ~> Pa m2 kg-1]. + real :: dP_dH ! A factor that converts from thickness to pressure times other dimensional + ! conversion factors [Z2 s2 Pa m-2 T-2 H-1 ~> Pa m2 kg-1]. real :: dp_neglect ! A thickness that is so small it is usually lost ! in roundoff and can be neglected [Pa]. logical :: use_EOS ! If true, density is calculated from T & S using @@ -740,8 +742,8 @@ subroutine Set_pbce_nonBouss(p, tv, G, GV, GFS_scale, pbce, alpha_star) use_EOS = associated(tv%eqn_of_state) - dP_dH = GV%H_to_Pa - dp_neglect = dP_dH * GV%H_subroundoff + dP_dH = US%m_s_to_L_T**2*GV%H_to_Pa + dp_neglect = GV%H_to_Pa * GV%H_subroundoff do k=1,nz ; alpha_Lay(k) = 1.0 / GV%Rlay(k) ; enddo do k=2,nz ; dalpha_int(K) = alpha_Lay(k-1) - alpha_Lay(k) ; enddo diff --git a/src/core/MOM_PressureForce_analytic_FV.F90 b/src/core/MOM_PressureForce_analytic_FV.F90 index 2fcad455d2..c7d3fae2f4 100644 --- a/src/core/MOM_PressureForce_analytic_FV.F90 +++ b/src/core/MOM_PressureForce_analytic_FV.F90 @@ -412,7 +412,7 @@ subroutine PressureForce_AFV_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p enddo if (present(pbce)) then - call set_pbce_nonBouss(p, tv_tmp, G, GV, CS%GFS_scale, pbce) + call set_pbce_nonBouss(p, tv_tmp, G, GV, US, CS%GFS_scale, pbce) endif if (present(eta)) then diff --git a/src/core/MOM_PressureForce_blocked_AFV.F90 b/src/core/MOM_PressureForce_blocked_AFV.F90 index c708c57257..f866c70e13 100644 --- a/src/core/MOM_PressureForce_blocked_AFV.F90 +++ b/src/core/MOM_PressureForce_blocked_AFV.F90 @@ -392,7 +392,7 @@ subroutine PressureForce_blk_AFV_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, enddo if (present(pbce)) then - call set_pbce_nonBouss(p, tv_tmp, G, GV, CS%GFS_scale, pbce) + call set_pbce_nonBouss(p, tv_tmp, G, GV, US, CS%GFS_scale, pbce) endif if (present(eta)) then diff --git a/src/core/MOM_barotropic.F90 b/src/core/MOM_barotropic.F90 index d69967075b..21bb2d4738 100644 --- a/src/core/MOM_barotropic.F90 +++ b/src/core/MOM_barotropic.F90 @@ -401,7 +401,7 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, type(mech_forcing), intent(in) :: forces !< A structure with the driving mechanical forces real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: pbce !< The baroclinic pressure anomaly in each layer !! due to free surface height anomalies - !! [m2 H-1 s-2 ~> m s-2 or m4 kg-1 s-2]. + !! [L2 H-1 T-2 ~> m s-2 or m4 kg-1 s-2]. real, dimension(SZI_(G),SZJ_(G)), intent(in) :: eta_PF_in !< The 2-D eta field (either SSH anomaly or !! column mass anomaly) that was used to calculate the input !! pressure gradient accelerations (or its final value if @@ -927,15 +927,15 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, !$OMP parallel do default(shared) do j=js,je do k=1,nz ; do I=is-1,ie - gtot_E(i,j) = gtot_E(i,j) + pbce(i,j,k) * wt_u(I,j,k) - gtot_W(i+1,j) = gtot_W(i+1,j) + pbce(i+1,j,k) * wt_u(I,j,k) + gtot_E(i,j) = gtot_E(i,j) + US%L_T_to_m_s**2*pbce(i,j,k) * wt_u(I,j,k) + gtot_W(i+1,j) = gtot_W(i+1,j) + US%L_T_to_m_s**2*pbce(i+1,j,k) * wt_u(I,j,k) enddo ; enddo enddo !$OMP parallel do default(shared) do J=js-1,je do k=1,nz ; do i=is,ie - gtot_N(i,j) = gtot_N(i,j) + pbce(i,j,k) * wt_v(i,J,k) - gtot_S(i,j+1) = gtot_S(i,j+1) + pbce(i,j+1,k) * wt_v(i,J,k) + gtot_N(i,j) = gtot_N(i,j) + US%L_T_to_m_s**2*pbce(i,j,k) * wt_v(i,J,k) + gtot_S(i,j+1) = gtot_S(i,j+1) + US%L_T_to_m_s**2*pbce(i,j+1,k) * wt_v(i,J,k) enddo ; enddo enddo @@ -2132,14 +2132,14 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, do k=1,nz do j=js,je ; do I=is-1,ie accel_layer_u(I,j,k) = u_accel_bt(I,j) - & - ((pbce(i+1,j,k) - gtot_W(i+1,j)) * e_anom(i+1,j) - & - (pbce(i,j,k) - gtot_E(i,j)) * e_anom(i,j)) * CS%IdxCu(I,j) + ((US%L_T_to_m_s**2*pbce(i+1,j,k) - gtot_W(i+1,j)) * e_anom(i+1,j) - & + (US%L_T_to_m_s**2*pbce(i,j,k) - gtot_E(i,j)) * e_anom(i,j)) * CS%IdxCu(I,j) if (abs(accel_layer_u(I,j,k)) < accel_underflow) accel_layer_u(I,j,k) = 0.0 enddo ; enddo do J=js-1,je ; do i=is,ie accel_layer_v(i,J,k) = v_accel_bt(i,J) - & - ((pbce(i,j+1,k) - gtot_S(i,j+1))*e_anom(i,j+1) - & - (pbce(i,j,k) - gtot_N(i,j))*e_anom(i,j)) * CS%IdyCv(i,J) + ((US%L_T_to_m_s**2*pbce(i,j+1,k) - gtot_S(i,j+1))*e_anom(i,j+1) - & + (US%L_T_to_m_s**2*pbce(i,j,k) - gtot_N(i,j))*e_anom(i,j)) * CS%IdyCv(i,J) if (abs(accel_layer_v(i,J,k)) < accel_underflow) accel_layer_v(i,J,k) = 0.0 enddo ; enddo enddo @@ -2274,7 +2274,7 @@ subroutine set_dtbt(G, GV, US, CS, eta, pbce, BT_cont, gtot_est, SSH_add) !! height anomaly or column mass anomaly [H ~> m or kg m-2]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), optional, intent(in) :: pbce !< The baroclinic pressure !! anomaly in each layer due to free surface - !! height anomalies [m2 H-1 s-2 ~> m s-2 or m4 kg-1 s-2]. + !! height anomalies [L2 H-1 T-2 ~> m s-2 or m4 kg-1 s-2]. type(BT_cont_type), optional, pointer :: BT_cont !< A structure with elements that describe !! the effective open face areas as a !! function of barotropic flow. @@ -2345,10 +2345,10 @@ subroutine set_dtbt(G, GV, US, CS, eta, pbce, BT_cont, gtot_est, SSH_add) gtot_N(i,j) = 0.0 ; gtot_S(i,j) = 0.0 enddo ; enddo do k=1,nz ; do j=js,je ; do i=is,ie - gtot_E(i,j) = gtot_E(i,j) + pbce(i,j,k) * CS%frhatu(I,j,k) - gtot_W(i,j) = gtot_W(i,j) + pbce(i,j,k) * CS%frhatu(I-1,j,k) - gtot_N(i,j) = gtot_N(i,j) + pbce(i,j,k) * CS%frhatv(i,J,k) - gtot_S(i,j) = gtot_S(i,j) + pbce(i,j,k) * CS%frhatv(i,J-1,k) + gtot_E(i,j) = gtot_E(i,j) + US%L_T_to_m_s**2*pbce(i,j,k) * CS%frhatu(I,j,k) + gtot_W(i,j) = gtot_W(i,j) + US%L_T_to_m_s**2*pbce(i,j,k) * CS%frhatu(I-1,j,k) + gtot_N(i,j) = gtot_N(i,j) + US%L_T_to_m_s**2*pbce(i,j,k) * CS%frhatv(i,J,k) + gtot_S(i,j) = gtot_S(i,j) + US%L_T_to_m_s**2*pbce(i,j,k) * CS%frhatv(i,J-1,k) enddo ; enddo ; enddo else do j=js,je ; do i=is,ie diff --git a/src/core/MOM_checksum_packages.F90 b/src/core/MOM_checksum_packages.F90 index a71f4bab48..7e054056e6 100644 --- a/src/core/MOM_checksum_packages.F90 +++ b/src/core/MOM_checksum_packages.F90 @@ -10,6 +10,7 @@ module MOM_checksum_packages use MOM_domains, only : sum_across_PEs, min_across_PEs, max_across_PEs use MOM_error_handler, only : MOM_mesg, is_root_pe use MOM_grid, only : ocean_grid_type +use MOM_unit_scaling, only : unit_scale_type use MOM_variables, only : thermo_var_ptrs, surface use MOM_verticalGrid, only : verticalGrid_type @@ -158,7 +159,7 @@ end subroutine MOM_surface_chksum ! ============================================================================= !> Write out chksums for the model's accelerations -subroutine MOM_accel_chksum(mesg, CAu, CAv, PFu, PFv, diffu, diffv, G, GV, pbce, & +subroutine MOM_accel_chksum(mesg, CAu, CAv, PFu, PFv, diffu, diffv, G, GV, US, pbce, & u_accel_bt, v_accel_bt, symmetric) character(len=*), intent(in) :: mesg !< A message that appears on the chksum lines. type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. @@ -181,6 +182,7 @@ subroutine MOM_accel_chksum(mesg, CAu, CAv, PFu, PFv, diffu, diffv, G, GV, pbce, real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & intent(in) :: diffv !< Meridional acceleration due to convergence of !! the along-isopycnal stress tensor [m s-2]. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & optional, intent(in) :: pbce !< The baroclinic pressure anomaly in each layer !! due to free surface height anomalies @@ -207,7 +209,7 @@ subroutine MOM_accel_chksum(mesg, CAu, CAv, PFu, PFv, diffu, diffv, G, GV, pbce, call uvchksum(mesg//" PF[uv]", PFu, PFv, G%HI, haloshift=0, symmetric=sym) call uvchksum(mesg//" diffu", diffu, diffv, G%HI,haloshift=0, symmetric=sym) if (present(pbce)) & - call hchksum(pbce, mesg//" pbce",G%HI,haloshift=0, scale=GV%m_to_H) + call hchksum(pbce, mesg//" pbce",G%HI,haloshift=0, scale=GV%m_to_H*US%L_T_to_m_s**2) if (present(u_accel_bt) .and. present(v_accel_bt)) & call uvchksum(mesg//" [uv]_accel_bt", u_accel_bt, v_accel_bt, G%HI,haloshift=0, symmetric=sym) end subroutine MOM_accel_chksum diff --git a/src/core/MOM_dynamics_split_RK2.F90 b/src/core/MOM_dynamics_split_RK2.F90 index 0fca4d35e3..5a3df49a3c 100644 --- a/src/core/MOM_dynamics_split_RK2.F90 +++ b/src/core/MOM_dynamics_split_RK2.F90 @@ -121,7 +121,7 @@ module MOM_dynamics_split_RK2 !! vhbt is roughly equal to vertical sum of vh. real ALLOCABLE_, dimension(NIMEM_,NJMEM_,NKMEM_) :: pbce !< pbce times eta gives the baroclinic pressure !! anomaly in each layer due to free surface height - !! anomalies [m2 H-1 s-2 ~> m s-2 or m4 kg-1 s-2]. + !! anomalies [L2 H-1 T-2 ~> m s-2 or m4 kg-1 s-2]. real, pointer, dimension(:,:) :: taux_bot => NULL() !< frictional x-bottom stress from the ocean to the seafloor [Pa] real, pointer, dimension(:,:) :: tauy_bot => NULL() !< frictional y-bottom stress from the ocean to the seafloor [Pa] @@ -462,7 +462,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & if (CS%debug) then call MOM_accel_chksum("pre-btstep accel", CS%CAu, CS%CAv, CS%PFu, CS%PFv, & - CS%diffu, CS%diffv, G, GV, CS%pbce, u_bc_accel, v_bc_accel, & + CS%diffu, CS%diffv, G, GV, US, CS%pbce, u_bc_accel, v_bc_accel, & symmetric=sym) call check_redundant("pre-btstep CS%Ca ", CS%Cau, CS%Cav, G) call check_redundant("pre-btstep CS%PF ", CS%PFu, CS%PFv, G) @@ -571,7 +571,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & symmetric=sym, scale=GV%H_to_m) ! call MOM_state_chksum("Predictor 1", up, vp, h, uh, vh, G, GV, haloshift=1) call MOM_accel_chksum("Predictor accel", CS%CAu, CS%CAv, CS%PFu, CS%PFv, & - CS%diffu, CS%diffv, G, GV, CS%pbce, CS%u_accel_bt, CS%v_accel_bt, symmetric=sym) + CS%diffu, CS%diffv, G, GV, US, CS%pbce, CS%u_accel_bt, CS%v_accel_bt, symmetric=sym) call MOM_state_chksum("Predictor 1 init", u_init, v_init, h, uh, vh, G, GV, haloshift=2, & symmetric=sym) call check_redundant("Predictor 1 up", up, vp, G) @@ -721,7 +721,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & if (CS%debug) then call MOM_accel_chksum("corr pre-btstep accel", CS%CAu, CS%CAv, CS%PFu, CS%PFv, & - CS%diffu, CS%diffv, G, GV, CS%pbce, u_bc_accel, v_bc_accel, & + CS%diffu, CS%diffv, G, GV, US, CS%pbce, u_bc_accel, v_bc_accel, & symmetric=sym) call check_redundant("corr pre-btstep CS%Ca ", CS%Cau, CS%Cav, G) call check_redundant("corr pre-btstep CS%PF ", CS%PFu, CS%PFv, G) @@ -775,7 +775,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & symmetric=sym, scale=GV%H_to_m) ! call MOM_state_chksum("Corrector 1", u, v, h, uh, vh, G, GV, haloshift=1) call MOM_accel_chksum("Corrector accel", CS%CAu, CS%CAv, CS%PFu, CS%PFv, & - CS%diffu, CS%diffv, G, GV, CS%pbce, CS%u_accel_bt, CS%v_accel_bt, & + CS%diffu, CS%diffv, G, GV, US, CS%pbce, CS%u_accel_bt, CS%v_accel_bt, & symmetric=sym) endif diff --git a/src/core/MOM_dynamics_unsplit.F90 b/src/core/MOM_dynamics_unsplit.F90 index dd03e11f42..e5020a807b 100644 --- a/src/core/MOM_dynamics_unsplit.F90 +++ b/src/core/MOM_dynamics_unsplit.F90 @@ -336,7 +336,7 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & if (CS%debug) then call MOM_state_chksum("Predictor 1", up, vp, h_av, uh, vh, G, GV) call MOM_accel_chksum("Predictor 1 accel", CS%CAu, CS%CAv, CS%PFu, CS%PFv,& - CS%diffu, CS%diffv, G, GV) + CS%diffu, CS%diffv, G, GV, US) endif ! up <- up + dt/2 d/dz visc d/dz up @@ -404,7 +404,7 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & if (CS%debug) then call MOM_state_chksum("Predictor 2", upp, vpp, h_av, uh, vh, G, GV) call MOM_accel_chksum("Predictor 2 accel", CS%CAu, CS%CAv, CS%PFu, CS%PFv,& - CS%diffu, CS%diffv, G, GV) + CS%diffu, CS%diffv, G, GV, US) endif ! upp <- upp + dt/2 d/dz visc d/dz upp @@ -489,7 +489,7 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & if (CS%debug) then call MOM_state_chksum("Corrector", u, v, h, uh, vh, G, GV) call MOM_accel_chksum("Corrector accel", CS%CAu, CS%CAv, CS%PFu, CS%PFv, & - CS%diffu, CS%diffv, G, GV) + CS%diffu, CS%diffv, G, GV, US) endif if (GV%Boussinesq) then diff --git a/src/core/MOM_dynamics_unsplit_RK2.F90 b/src/core/MOM_dynamics_unsplit_RK2.F90 index b5b547b362..12feba7a95 100644 --- a/src/core/MOM_dynamics_unsplit_RK2.F90 +++ b/src/core/MOM_dynamics_unsplit_RK2.F90 @@ -333,7 +333,7 @@ subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt, if (CS%debug) & call MOM_accel_chksum("Predictor 1 accel", CS%CAu, CS%CAv, CS%PFu, CS%PFv,& - CS%diffu, CS%diffv, G, GV) + CS%diffu, CS%diffv, G, GV, US) ! up[n-1/2] <- up*[n-1/2] + dt/2 d/dz visc d/dz up[n-1/2] call cpu_clock_begin(id_clock_vertvisc) @@ -428,7 +428,7 @@ subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt, if (CS%debug) then call MOM_state_chksum("Corrector", u_in, v_in, h_in, uh, vh, G, GV) call MOM_accel_chksum("Corrector accel", CS%CAu, CS%CAv, CS%PFu, CS%PFv, & - CS%diffu, CS%diffv, G, GV) + CS%diffu, CS%diffv, G, GV, US) endif if (GV%Boussinesq) then From 328858d6fe65ec5dc399d20d05d01553ce3e7667 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Fri, 12 Jul 2019 07:23:02 -0400 Subject: [PATCH 097/150] +Rescaled the units of fluxes%buoy Rescaled the units of fluxes%buoy to L2 T-3 from m2 s-3 for enhanced dimensional consistency testing. This required the addition of unit_scale_type arguments to several initialization or buoyancy flux routines. All answers are bitwise identical. --- .../ice_solo_driver/MOM_surface_forcing.F90 | 10 ++--- .../ice_solo_driver/user_surface_forcing.F90 | 16 ++++---- .../solo_driver/MESO_surface_forcing.F90 | 17 +++++---- .../solo_driver/MOM_surface_forcing.F90 | 38 ++++++++++--------- .../solo_driver/Neverland_surface_forcing.F90 | 18 +++++---- .../solo_driver/user_surface_forcing.F90 | 16 ++++---- src/core/MOM_forcing_type.F90 | 6 +-- .../vertical/MOM_entrain_diffusive.F90 | 2 +- src/user/BFB_surface_forcing.F90 | 17 +++++---- src/user/dumbbell_surface_forcing.F90 | 12 +++--- 10 files changed, 83 insertions(+), 69 deletions(-) diff --git a/config_src/ice_solo_driver/MOM_surface_forcing.F90 b/config_src/ice_solo_driver/MOM_surface_forcing.F90 index 0a81eaa960..efacc07dc5 100644 --- a/config_src/ice_solo_driver/MOM_surface_forcing.F90 +++ b/config_src/ice_solo_driver/MOM_surface_forcing.F90 @@ -98,7 +98,7 @@ module MOM_surface_forcing real :: len_lat ! domain length in latitude real :: Rho0 ! Boussinesq reference density [kg m-3] - real :: G_Earth ! gravitational acceleration [m s-2] + real :: G_Earth ! gravitational acceleration [L2 Z-1 T-2 ~> m s-2] real :: Flux_const ! piston velocity for surface restoring [m s-1] real :: gust_const ! constant unresolved background gustiness for ustar [Pa] @@ -752,7 +752,7 @@ subroutine buoyancy_forcing_from_files(sfc_state, fluxes, day, dt, G, CS) do j=js,je ; do i=is,ie if (G%mask2dT(i,j) > 0) then fluxes%buoy(i,j) = (CS%Dens_Restore(i,j) - sfc_state%sfc_density(i,j)) * & - (CS%G_Earth*CS%Flux_const/CS%Rho0) + (CS%G_Earth * US%m_to_Z*US%T_to_s*CS%Flux_const/CS%Rho0) else fluxes%buoy(i,j) = 0.0 endif @@ -886,8 +886,8 @@ subroutine buoyancy_forcing_linear(sfc_state, fluxes, day, dt, G, CS) "RESTOREBUOY to linear not written yet.") !do j=js,je ; do i=is,ie ! if (G%mask2dT(i,j) > 0) then - ! fluxes%buoy(i,j) = (CS%Dens_Restore(i,j) - sfc_state%sfc_density(i,j)) * & - ! (CS%G_Earth*CS%Flux_const/CS%Rho0) + ! fluxes%buoy(i,j) = (CS%Dens_Restore(i,j) - sfc_state%sfc_density(i,j)) * & + ! (CS%G_Earth * US%m_to_Z*US%T_to_s*CS%Flux_const/CS%Rho0) ! else ! fluxes%buoy(i,j) = 0.0 ! endif @@ -1109,7 +1109,7 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, tracer_flow_C endif call get_param(param_file, mdl, "G_EARTH", CS%G_Earth, & "The gravitational acceleration of the Earth.", & - units="m s-2", default = 9.80) + units="m s-2", default = 9.80, scale=US%m_to_L**2*US%Z_to_m*US%T_to_s**2) call get_param(param_file, mdl, "GUST_CONST", CS%gust_const, & "The background gustiness in the winds.", units="Pa", & diff --git a/config_src/ice_solo_driver/user_surface_forcing.F90 b/config_src/ice_solo_driver/user_surface_forcing.F90 index aa5a302e95..1652db2ceb 100644 --- a/config_src/ice_solo_driver/user_surface_forcing.F90 +++ b/config_src/ice_solo_driver/user_surface_forcing.F90 @@ -80,7 +80,7 @@ module user_surface_forcing logical :: restorebuoy ! If true, use restoring surface buoyancy forcing. real :: Rho0 ! The density used in the Boussinesq ! approximation [kg m-3]. - real :: G_Earth ! The gravitational acceleration [m s-2]. + real :: G_Earth ! The gravitational acceleration [L2 Z-1 T-2 ~> m s-2]. real :: Flux_const ! The restoring rate at the surface [m s-1]. real :: gust_const ! A constant unresolved background gustiness ! that contributes to ustar [Pa]. @@ -149,7 +149,7 @@ end subroutine USER_wind_forcing !> This subroutine specifies the current surface fluxes of buoyancy or !! temperature and fresh water. It may also be modified to add !! surface fluxes of user provided tracers. -subroutine USER_buoyancy_forcing(sfc_state, fluxes, day, dt, G, CS) +subroutine USER_buoyancy_forcing(sfc_state, fluxes, day, dt, G, US, CS) type(surface), intent(inout) :: sfc_state !< A structure containing fields that !! describe the surface state of the ocean. type(forcing), intent(inout) :: fluxes !< A structure containing thermodynamic forcing fields @@ -157,6 +157,7 @@ subroutine USER_buoyancy_forcing(sfc_state, fluxes, day, dt, G, CS) real, intent(in) :: dt !< The amount of time over which !! the fluxes apply [s] type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(user_surface_forcing_CS), pointer :: CS !< A pointer to the control structure returned !! by a previous call to user_surface_forcing_init @@ -180,7 +181,7 @@ subroutine USER_buoyancy_forcing(sfc_state, fluxes, day, dt, G, CS) ! toward [kg m-3]. real :: rhoXcp ! The mean density times the heat capacity [J m-3 degC-1]. real :: buoy_rest_const ! A constant relating density anomalies to the - ! restoring buoyancy flux [m5 s-3 kg-1]. + ! restoring buoyancy flux [L2 m3 T-3 kg-1 ~> m5 s-3 kg-1]. integer :: i, j, is, ie, js, je integer :: isd, ied, jsd, jed @@ -234,7 +235,7 @@ subroutine USER_buoyancy_forcing(sfc_state, fluxes, day, dt, G, CS) enddo ; enddo else ! This is the buoyancy only mode. do j=js,je ; do i=is,ie - ! fluxes%buoy is the buoyancy flux into the ocean [m2 s-3]. A positive + ! fluxes%buoy is the buoyancy flux into the ocean [L2 T-3 ~> m2 s-3]. A positive ! buoyancy flux is of the same sign as heating the ocean. fluxes%buoy(i,j) = 0.0 * G%mask2dT(i,j) enddo ; enddo @@ -268,7 +269,7 @@ subroutine USER_buoyancy_forcing(sfc_state, fluxes, day, dt, G, CS) "Buoyancy restoring used without modification." ) ! The -1 is because density has the opposite sign to buoyancy. - buoy_rest_const = -1.0 * (CS%G_Earth * CS%Flux_const) / CS%Rho0 + buoy_rest_const = -1.0 * (CS%G_Earth * US%m_to_Z*US%T_to_s*CS%Flux_const) / CS%Rho0 do j=js,je ; do i=is,ie ! Set density_restore to an expression for the surface potential ! density [kg m-3] that is being restored toward. @@ -283,9 +284,10 @@ subroutine USER_buoyancy_forcing(sfc_state, fluxes, day, dt, G, CS) end subroutine USER_buoyancy_forcing !> This subroutine initializes the USER_surface_forcing module -subroutine USER_surface_forcing_init(Time, G, param_file, diag, CS) +subroutine USER_surface_forcing_init(Time, G, US, param_file, diag, CS) type(time_type), intent(in) :: Time !< The current model time type(ocean_grid_type), intent(in) :: G !< The ocean's 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(in) :: diag !< A structure that is used to regulate diagnostic output. type(user_surface_forcing_CS), pointer :: CS !< A pointer that is set to point to @@ -311,7 +313,7 @@ subroutine USER_surface_forcing_init(Time, G, param_file, diag, CS) call get_param(param_file, mdl, "G_EARTH", CS%G_Earth, & "The gravitational acceleration of the Earth.", & - units="m s-2", default = 9.80) + units="m s-2", default = 9.80, scale=US%m_to_L**2*US%Z_to_m*US%T_to_s**2) call get_param(param_file, mdl, "RHO_0", CS%Rho0, & "The mean ocean density used with BOUSSINESQ true to "//& "calculate accelerations and the mass for conservation "//& diff --git a/config_src/solo_driver/MESO_surface_forcing.F90 b/config_src/solo_driver/MESO_surface_forcing.F90 index 37c7f72794..ee3cd36b41 100644 --- a/config_src/solo_driver/MESO_surface_forcing.F90 +++ b/config_src/solo_driver/MESO_surface_forcing.F90 @@ -15,6 +15,7 @@ module MESO_surface_forcing use MOM_time_manager, only : time_type, operator(+), operator(/) use MOM_tracer_flow_control, only : call_tracer_set_forcing use MOM_tracer_flow_control, only : tracer_flow_control_CS +use MOM_unit_scaling, only : unit_scale_type use MOM_variables, only : surface implicit none ; private @@ -27,7 +28,7 @@ module MESO_surface_forcing logical :: use_temperature !< If true, temperature and salinity are used as state variables. logical :: restorebuoy !< If true, use restoring surface buoyancy forcing. real :: Rho0 !< The density used in the Boussinesq approximation [kg m-3]. - real :: G_Earth !< The gravitational acceleration [m s-2]. + real :: G_Earth !< The gravitational acceleration [L2 Z-1 T-2 ~> m s-2]. real :: Flux_const !< The restoring rate at the surface [m s-1]. real :: gust_const !< A constant unresolved background gustiness !! that contributes to ustar [Pa]. @@ -54,7 +55,7 @@ module MESO_surface_forcing !> This subroutine sets up the MESO buoyancy forcing, which uses control-theory style !! specification restorative buoyancy fluxes at large scales. -subroutine MESO_buoyancy_forcing(sfc_state, fluxes, day, dt, G, CS) +subroutine MESO_buoyancy_forcing(sfc_state, fluxes, day, dt, G, US, CS) type(surface), intent(inout) :: sfc_state !< A structure containing fields that !! describe the surface state of the ocean. type(forcing), intent(inout) :: fluxes !< A structure containing thermodynamic forcing fields @@ -62,6 +63,7 @@ subroutine MESO_buoyancy_forcing(sfc_state, fluxes, day, dt, G, CS) real, intent(in) :: dt !< The amount of time over which !! the fluxes apply [s] type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(MESO_surface_forcing_CS), pointer :: CS !< A pointer to the control structure returned by !! a previous call to MESO_surface_forcing_init @@ -81,7 +83,7 @@ subroutine MESO_buoyancy_forcing(sfc_state, fluxes, day, dt, G, CS) ! toward [kg m-3]. real :: rhoXcp ! The mean density times the heat capacity [J m-3 degC-1]. real :: buoy_rest_const ! A constant relating density anomalies to the - ! restoring buoyancy flux [m5 s-3 kg-1]. + ! restoring buoyancy flux [L2 m3 T-3 kg-1 ~> m5 s-3 kg-1]. integer :: i, j, is, ie, js, je integer :: isd, ied, jsd, jed @@ -153,7 +155,7 @@ subroutine MESO_buoyancy_forcing(sfc_state, fluxes, day, dt, G, CS) enddo ; enddo else ! This is the buoyancy only mode. do j=js,je ; do i=is,ie - ! fluxes%buoy is the buoyancy flux into the ocean [m2 s-3]. A positive + ! fluxes%buoy is the buoyancy flux into the ocean [L2 T-3 ~> m2 s-3]. A positive ! buoyancy flux is of the same sign as heating the ocean. fluxes%buoy(i,j) = 0.0 * G%mask2dT(i,j) enddo ; enddo @@ -189,7 +191,7 @@ subroutine MESO_buoyancy_forcing(sfc_state, fluxes, day, dt, G, CS) "Buoyancy restoring used without modification." ) ! The -1 is because density has the opposite sign to buoyancy. - buoy_rest_const = -1.0 * (CS%G_Earth * CS%Flux_const) / CS%Rho0 + buoy_rest_const = -1.0 * (CS%G_Earth * US%m_to_Z*US%T_to_s*CS%Flux_const) / CS%Rho0 do j=js,je ; do i=is,ie ! Set density_restore to an expression for the surface potential ! density [kg m-3] that is being restored toward. @@ -204,10 +206,11 @@ subroutine MESO_buoyancy_forcing(sfc_state, fluxes, day, dt, G, CS) end subroutine MESO_buoyancy_forcing !> Initialize the MESO surface forcing module -subroutine MESO_surface_forcing_init(Time, G, param_file, diag, CS) +subroutine MESO_surface_forcing_init(Time, G, US, param_file, diag, CS) type(time_type), intent(in) :: Time !< The current model time type(ocean_grid_type), intent(in) :: G !< The ocean's 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 !< structure used to regulate diagnostic output type(MESO_surface_forcing_CS), pointer :: CS !< A pointer that is set to point to the @@ -233,7 +236,7 @@ subroutine MESO_surface_forcing_init(Time, G, param_file, diag, CS) call get_param(param_file, mdl, "G_EARTH", CS%G_Earth, & "The gravitational acceleration of the Earth.", & - units="m s-2", default = 9.80) + units="m s-2", default = 9.80, scale=US%m_to_L**2*US%Z_to_m*US%T_to_s**2) call get_param(param_file, mdl, "RHO_0", CS%Rho0, & "The mean ocean density used with BOUSSINESQ true to "//& "calculate accelerations and the mass for conservation "//& diff --git a/config_src/solo_driver/MOM_surface_forcing.F90 b/config_src/solo_driver/MOM_surface_forcing.F90 index e31e78e7ec..4d9458a1c9 100644 --- a/config_src/solo_driver/MOM_surface_forcing.F90 +++ b/config_src/solo_driver/MOM_surface_forcing.F90 @@ -79,7 +79,7 @@ module MOM_surface_forcing real :: len_lat !< domain length in latitude real :: Rho0 !< Boussinesq reference density [kg m-3] - real :: G_Earth !< gravitational acceleration [m s-2] + real :: G_Earth !< gravitational acceleration [L2 Z-1 T-2 ~> m s-2] real :: Flux_const !< piston velocity for surface restoring [m s-1] real :: Flux_const_T !< piston velocity for surface temperature restoring [m s-1] real :: Flux_const_S !< piston velocity for surface salinity restoring [m s-1] @@ -301,9 +301,9 @@ subroutine set_forcing(sfc_state, forces, fluxes, day_start, day_interval, G, US if ((CS%variable_buoyforce .or. CS%first_call_set_forcing) .and. & (.not.CS%adiabatic)) then if (trim(CS%buoy_config) == "file") then - call buoyancy_forcing_from_files(sfc_state, fluxes, day_center, dt, G, CS) + call buoyancy_forcing_from_files(sfc_state, fluxes, day_center, dt, G, US, CS) elseif (trim(CS%buoy_config) == "data_override") then - call buoyancy_forcing_from_data_override(sfc_state, fluxes, day_center, dt, G, CS) + call buoyancy_forcing_from_data_override(sfc_state, fluxes, day_center, dt, G, US, CS) elseif (trim(CS%buoy_config) == "zero") then call buoyancy_forcing_zero(sfc_state, fluxes, day_center, dt, G, CS) elseif (trim(CS%buoy_config) == "const") then @@ -311,15 +311,15 @@ subroutine set_forcing(sfc_state, forces, fluxes, day_start, day_interval, G, US elseif (trim(CS%buoy_config) == "linear") then call buoyancy_forcing_linear(sfc_state, fluxes, day_center, dt, G, CS) elseif (trim(CS%buoy_config) == "MESO") then - call MESO_buoyancy_forcing(sfc_state, fluxes, day_center, dt, G, CS%MESO_forcing_CSp) + call MESO_buoyancy_forcing(sfc_state, fluxes, day_center, dt, G, US, CS%MESO_forcing_CSp) elseif (trim(CS%buoy_config) == "Neverland") then - call Neverland_buoyancy_forcing(sfc_state, fluxes, day_center, dt, G, CS%Neverland_forcing_CSp) + call Neverland_buoyancy_forcing(sfc_state, fluxes, day_center, dt, G, US, CS%Neverland_forcing_CSp) elseif (trim(CS%buoy_config) == "SCM_CVmix_tests") then call SCM_CVmix_tests_buoyancy_forcing(sfc_state, fluxes, day_center, G, CS%SCM_CVmix_tests_CSp) elseif (trim(CS%buoy_config) == "USER") then - call USER_buoyancy_forcing(sfc_state, fluxes, day_center, dt, G, CS%user_forcing_CSp) + call USER_buoyancy_forcing(sfc_state, fluxes, day_center, dt, G, US, CS%user_forcing_CSp) elseif (trim(CS%buoy_config) == "BFB") then - call BFB_buoyancy_forcing(sfc_state, fluxes, day_center, dt, G, CS%BFB_forcing_CSp) + call BFB_buoyancy_forcing(sfc_state, fluxes, day_center, dt, G, US, CS%BFB_forcing_CSp) elseif (trim(CS%buoy_config) == "dumbbell") then call dumbbell_buoyancy_forcing(sfc_state, fluxes, day_center, dt, G, CS%dumbbell_forcing_CSp) elseif (trim(CS%buoy_config) == "NONE") then @@ -741,7 +741,7 @@ end subroutine wind_forcing_by_data_override !> Specifies zero surface bouyancy fluxes from input files. -subroutine buoyancy_forcing_from_files(sfc_state, fluxes, day, dt, G, CS) +subroutine buoyancy_forcing_from_files(sfc_state, fluxes, day, dt, G, US, CS) type(surface), intent(inout) :: sfc_state !< A structure containing fields that !! describe the surface state of the ocean. type(forcing), intent(inout) :: fluxes !< A structure containing thermodynamic forcing fields @@ -749,6 +749,7 @@ subroutine buoyancy_forcing_from_files(sfc_state, fluxes, day, dt, G, CS) real, intent(in) :: dt !< The amount of time over which !! the fluxes apply [s] type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(surface_forcing_CS), pointer :: CS !< pointer to control struct returned by !! a previous surface_forcing_init call ! Local variables @@ -990,7 +991,7 @@ subroutine buoyancy_forcing_from_files(sfc_state, fluxes, day, dt, G, CS) do j=js,je ; do i=is,ie if (G%mask2dT(i,j) > 0) then fluxes%buoy(i,j) = (CS%Dens_Restore(i,j) - sfc_state%sfc_density(i,j)) * & - (CS%G_Earth*CS%Flux_const/CS%Rho0) + (CS%G_Earth * US%m_to_Z*US%T_to_s*CS%Flux_const/CS%Rho0) else fluxes%buoy(i,j) = 0.0 endif @@ -1019,7 +1020,7 @@ subroutine buoyancy_forcing_from_files(sfc_state, fluxes, day, dt, G, CS) end subroutine buoyancy_forcing_from_files !> Specifies zero surface bouyancy fluxes from data over-ride. -subroutine buoyancy_forcing_from_data_override(sfc_state, fluxes, day, dt, G, CS) +subroutine buoyancy_forcing_from_data_override(sfc_state, fluxes, day, dt, G, US, CS) type(surface), intent(inout) :: sfc_state !< A structure containing fields that !! describe the surface state of the ocean. type(forcing), intent(inout) :: fluxes !< A structure containing thermodynamic forcing fields @@ -1027,6 +1028,7 @@ subroutine buoyancy_forcing_from_data_override(sfc_state, fluxes, day, dt, G, CS real, intent(in) :: dt !< The amount of time over which !! the fluxes apply [s] type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(surface_forcing_CS), pointer :: CS !< pointer to control struct returned by !! a previous surface_forcing_init call ! Local variables @@ -1134,7 +1136,7 @@ subroutine buoyancy_forcing_from_data_override(sfc_state, fluxes, day, dt, G, CS do j=js,je ; do i=is,ie if (G%mask2dT(i,j) > 0) then fluxes%buoy(i,j) = (CS%Dens_Restore(i,j) - sfc_state%sfc_density(i,j)) * & - (CS%G_Earth*CS%Flux_const/CS%Rho0) + (CS%G_Earth * US%m_to_Z*US%T_to_s*CS%Flux_const/CS%Rho0) else fluxes%buoy(i,j) = 0.0 endif @@ -1333,7 +1335,7 @@ subroutine buoyancy_forcing_linear(sfc_state, fluxes, day, dt, G, CS) !do j=js,je ; do i=is,ie ! if (G%mask2dT(i,j) > 0) then ! fluxes%buoy(i,j) = (CS%Dens_Restore(i,j) - sfc_state%sfc_density(i,j)) * & - ! (CS%G_Earth*CS%Flux_const/CS%Rho0) + ! (CS%G_Earth * US%m_to_Z*US%T_to_s*CS%Flux_const/CS%Rho0) ! else ! fluxes%buoy(i,j) = 0.0 ! endif @@ -1693,7 +1695,7 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, tracer_flow_C endif call get_param(param_file, mdl, "G_EARTH", CS%G_Earth, & "The gravitational acceleration of the Earth.", & - units="m s-2", default = 9.80) + units="m s-2", default = 9.80, scale=US%m_to_L**2*US%Z_to_m*US%T_to_s**2) call get_param(param_file, mdl, "GUST_CONST", CS%gust_const, & "The background gustiness in the winds.", units="Pa", & @@ -1714,15 +1716,15 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, tracer_flow_C ! All parameter settings are now known. if (trim(CS%wind_config) == "USER" .or. trim(CS%buoy_config) == "USER" ) then - call USER_surface_forcing_init(Time, G, param_file, diag, CS%user_forcing_CSp) + call USER_surface_forcing_init(Time, G, US, param_file, diag, CS%user_forcing_CSp) elseif (trim(CS%buoy_config) == "BFB" ) then - call BFB_surface_forcing_init(Time, G, param_file, diag, CS%BFB_forcing_CSp) + call BFB_surface_forcing_init(Time, G, US, param_file, diag, CS%BFB_forcing_CSp) elseif (trim(CS%buoy_config) == "dumbbell" ) then - call dumbbell_surface_forcing_init(Time, G, param_file, diag, CS%dumbbell_forcing_CSp) + call dumbbell_surface_forcing_init(Time, G, US, param_file, diag, CS%dumbbell_forcing_CSp) elseif (trim(CS%wind_config) == "MESO" .or. trim(CS%buoy_config) == "MESO" ) then - call MESO_surface_forcing_init(Time, G, param_file, diag, CS%MESO_forcing_CSp) + call MESO_surface_forcing_init(Time, G, US, param_file, diag, CS%MESO_forcing_CSp) elseif (trim(CS%wind_config) == "Neverland") then - call Neverland_surface_forcing_init(Time, G, param_file, diag, CS%Neverland_forcing_CSp) + call Neverland_surface_forcing_init(Time, G, US, param_file, diag, CS%Neverland_forcing_CSp) elseif (trim(CS%wind_config) == "ideal_hurr" .or.& trim(CS%wind_config) == "SCM_ideal_hurr") then call idealized_hurricane_wind_init(Time, G, param_file, CS%idealized_hurricane_CSp) diff --git a/config_src/solo_driver/Neverland_surface_forcing.F90 b/config_src/solo_driver/Neverland_surface_forcing.F90 index 1fefc005f0..be29466e14 100644 --- a/config_src/solo_driver/Neverland_surface_forcing.F90 +++ b/config_src/solo_driver/Neverland_surface_forcing.F90 @@ -33,7 +33,7 @@ module Neverland_surface_forcing logical :: restorebuoy !< If true, use restoring surface buoyancy forcing. real :: Rho0 !< The density used in the Boussinesq !! approximation [kg m-3]. - real :: G_Earth !< The gravitational acceleration [m s-2]. + real :: G_Earth !< The gravitational acceleration [L2 Z-1 T-2 ~> m s-2]. real :: flux_const !< The restoring rate at the surface [m s-1]. real, dimension(:,:), pointer :: & buoy_restore(:,:) => NULL() !< The pattern to restore buoyancy to. @@ -135,17 +135,18 @@ end function spike !> Surface fluxes of buoyancy for the Neverland configurations. -subroutine Neverland_buoyancy_forcing(sfc_state, fluxes, day, dt, G, CS) +subroutine Neverland_buoyancy_forcing(sfc_state, fluxes, day, dt, G, US, CS) type(surface), intent(inout) :: sfc_state !< A structure containing fields that !! describe the surface state of the ocean. type(forcing), intent(inout) :: fluxes !< Forcing fields. type(time_type), intent(in) :: day !< Time used for determining the fluxes. real, intent(in) :: dt !< Forcing time step (s). - type(ocean_grid_type), intent(inout) :: G !< Grid structure. + type(ocean_grid_type), intent(inout) :: G !< Grid structure. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(Neverland_surface_forcing_CS), pointer :: CS !< Control structure for this module. ! Local variables real :: buoy_rest_const ! A constant relating density anomalies to the - ! restoring buoyancy flux [m5 s-3 kg-1]. + ! restoring buoyancy flux [L2 m3 T-3 kg-1 ~> m5 s-3 kg-1]. real :: density_restore ! De integer :: i, j, is, ie, js, je integer :: isd, ied, jsd, jed @@ -179,7 +180,7 @@ subroutine Neverland_buoyancy_forcing(sfc_state, fluxes, day, dt, G, CS) "Temperature/salinity restoring not coded!" ) else ! This is the buoyancy only mode. do j=js,je ; do i=is,ie - ! fluxes%buoy is the buoyancy flux into the ocean [m2 s-3]. A positive + ! fluxes%buoy is the buoyancy flux into the ocean [L2 T-3 ~> m2 s-3]. A positive ! buoyancy flux is of the same sign as heating the ocean. fluxes%buoy(i,j) = 0.0 * G%mask2dT(i,j) enddo ; enddo @@ -194,7 +195,7 @@ subroutine Neverland_buoyancy_forcing(sfc_state, fluxes, day, dt, G, CS) ! so that the original (unmodified) version is not accidentally used. ! The -1 is because density has the opposite sign to buoyancy. - buoy_rest_const = -1.0 * (CS%G_Earth * CS%flux_const) / CS%Rho0 + buoy_rest_const = -1.0 * (CS%G_Earth * US%m_to_Z*US%T_to_s*CS%Flux_const) / CS%Rho0 do j=js,je ; do i=is,ie ! Set density_restore to an expression for the surface potential ! density [kg m-3] that is being restored toward. @@ -209,9 +210,10 @@ subroutine Neverland_buoyancy_forcing(sfc_state, fluxes, day, dt, G, CS) end subroutine Neverland_buoyancy_forcing !> Initializes the Neverland control structure. -subroutine Neverland_surface_forcing_init(Time, G, param_file, diag, CS) +subroutine Neverland_surface_forcing_init(Time, G, US, param_file, diag, CS) type(time_type), intent(in) :: Time !< The current model time. type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(param_file_type), intent(in) :: param_file !< A structure indicating the open file to parse for !! model parameter values. type(diag_ctrl), target, intent(in) :: diag !< A structure that is used to regulate diagnostic output. @@ -238,7 +240,7 @@ subroutine Neverland_surface_forcing_init(Time, G, param_file, diag, CS) call get_param(param_file, mdl, "G_EARTH", CS%G_Earth, & "The gravitational acceleration of the Earth.", & - units="m s-2", default = 9.80) + units="m s-2", default = 9.80, scale=US%m_to_L**2*US%Z_to_m*US%T_to_s**2) call get_param(param_file, mdl, "RHO_0", CS%Rho0, & "The mean ocean density used with BOUSSINESQ true to "//& "calculate accelerations and the mass for conservation "//& diff --git a/config_src/solo_driver/user_surface_forcing.F90 b/config_src/solo_driver/user_surface_forcing.F90 index 0275072599..92151e6cde 100644 --- a/config_src/solo_driver/user_surface_forcing.F90 +++ b/config_src/solo_driver/user_surface_forcing.F90 @@ -34,7 +34,7 @@ module user_surface_forcing logical :: use_temperature !< If true, temperature and salinity are used as state variables. logical :: restorebuoy !< If true, use restoring surface buoyancy forcing. real :: Rho0 !< The density used in the Boussinesq approximation [kg m-3]. - real :: G_Earth !< The gravitational acceleration [m s-2]. + real :: G_Earth !< The gravitational acceleration [L2 Z-1 s-2 ~> m s-2]. real :: Flux_const !< The restoring rate at the surface [m s-1]. real :: gust_const !< A constant unresolved background gustiness !! that contributes to ustar [Pa]. @@ -98,7 +98,7 @@ end subroutine USER_wind_forcing !> This subroutine specifies the current surface fluxes of buoyancy or !! temperature and fresh water. It may also be modified to add !! surface fluxes of user provided tracers. -subroutine USER_buoyancy_forcing(sfc_state, fluxes, day, dt, G, CS) +subroutine USER_buoyancy_forcing(sfc_state, fluxes, day, dt, G, US, CS) type(surface), intent(inout) :: sfc_state !< A structure containing fields that !! describe the surface state of the ocean. type(forcing), intent(inout) :: fluxes !< A structure containing thermodynamic forcing fields @@ -106,6 +106,7 @@ subroutine USER_buoyancy_forcing(sfc_state, fluxes, day, dt, G, CS) real, intent(in) :: dt !< The amount of time over which !! the fluxes apply [s] type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(user_surface_forcing_CS), pointer :: CS !< A pointer to the control structure returned !! by a previous call to user_surface_forcing_init @@ -130,7 +131,7 @@ subroutine USER_buoyancy_forcing(sfc_state, fluxes, day, dt, G, CS) ! toward [kg m-3]. real :: rhoXcp ! The mean density times the heat capacity [J m-3 degC-1]. real :: buoy_rest_const ! A constant relating density anomalies to the - ! restoring buoyancy flux [m5 s-3 kg-1]. + ! restoring buoyancy flux [L2 m3 T-3 kg-1 ~> m5 s-3 kg-1]. integer :: i, j, is, ie, js, je integer :: isd, ied, jsd, jed @@ -184,7 +185,7 @@ subroutine USER_buoyancy_forcing(sfc_state, fluxes, day, dt, G, CS) enddo ; enddo else ! This is the buoyancy only mode. do j=js,je ; do i=is,ie - ! fluxes%buoy is the buoyancy flux into the ocean [m2 s-3]. A positive + ! fluxes%buoy is the buoyancy flux into the ocean [L2 T-3 ~> m2 s-3]. A positive ! buoyancy flux is of the same sign as heating the ocean. fluxes%buoy(i,j) = 0.0 * G%mask2dT(i,j) enddo ; enddo @@ -218,7 +219,7 @@ subroutine USER_buoyancy_forcing(sfc_state, fluxes, day, dt, G, CS) "Buoyancy restoring used without modification." ) ! The -1 is because density has the opposite sign to buoyancy. - buoy_rest_const = -1.0 * (CS%G_Earth * CS%Flux_const) / CS%Rho0 + buoy_rest_const = -1.0 * (CS%G_Earth * US%m_to_Z*US%T_to_s*CS%Flux_const) / CS%Rho0 do j=js,je ; do i=is,ie ! Set density_restore to an expression for the surface potential ! density [kg m-3] that is being restored toward. @@ -233,9 +234,10 @@ subroutine USER_buoyancy_forcing(sfc_state, fluxes, day, dt, G, CS) end subroutine USER_buoyancy_forcing !> This subroutine initializes the USER_surface_forcing module -subroutine USER_surface_forcing_init(Time, G, param_file, diag, CS) +subroutine USER_surface_forcing_init(Time, G, US, param_file, diag, CS) type(time_type), intent(in) :: Time !< The current model time type(ocean_grid_type), intent(in) :: G !< The ocean's 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(in) :: diag !< A structure that is used to regulate diagnostic output. type(user_surface_forcing_CS), pointer :: CS !< A pointer that is set to point to @@ -261,7 +263,7 @@ subroutine USER_surface_forcing_init(Time, G, param_file, diag, CS) call get_param(param_file, mdl, "G_EARTH", CS%G_Earth, & "The gravitational acceleration of the Earth.", & - units="m s-2", default = 9.80) + units="m s-2", default = 9.80, scale=US%m_to_L**2*US%Z_to_m*US%T_to_s**2) call get_param(param_file, mdl, "RHO_0", CS%Rho0, & "The mean ocean density used with BOUSSINESQ true to "//& "calculate accelerations and the mass for conservation "//& diff --git a/src/core/MOM_forcing_type.F90 b/src/core/MOM_forcing_type.F90 index 79b8c251dd..a3f6e0f2ff 100644 --- a/src/core/MOM_forcing_type.F90 +++ b/src/core/MOM_forcing_type.F90 @@ -56,7 +56,7 @@ module MOM_forcing_type ! surface buoyancy force, used when temperature is not a state variable real, pointer, dimension(:,:) :: & - buoy => NULL() !< buoyancy flux [m2 s-3] + buoy => NULL() !< buoyancy flux [L2 T-3 ~> m2 s-3] ! radiative heat fluxes into the ocean [W m-2] real, pointer, dimension(:,:) :: & @@ -1015,7 +1015,7 @@ subroutine MOM_forcing_chksum(mesg, fluxes, G, US, haloshift) if (associated(fluxes%ustar)) & 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) + call hchksum(fluxes%buoy, mesg//" fluxes%buoy ",G%HI, haloshift=hshift, scale=US%L_to_m**2*US%s_to_T**3) if (associated(fluxes%sw)) & call hchksum(fluxes%sw, mesg//" fluxes%sw",G%HI,haloshift=hshift) if (associated(fluxes%sw_vis_dir)) & @@ -1253,7 +1253,7 @@ subroutine register_forcing_type_diags(Time, diag, US, use_temperature, handles, if (.not. use_temperature) then handles%id_buoy = register_diag_field('ocean_model', 'buoy', diag%axesT1, Time, & - 'Buoyancy forcing', 'm2 s-3') + 'Buoyancy forcing', 'm2 s-3', conversion=US%L_to_m**2*US%s_to_T**3) return endif diff --git a/src/parameterizations/vertical/MOM_entrain_diffusive.F90 b/src/parameterizations/vertical/MOM_entrain_diffusive.F90 index c215c996d9..121191b008 100644 --- a/src/parameterizations/vertical/MOM_entrain_diffusive.F90 +++ b/src/parameterizations/vertical/MOM_entrain_diffusive.F90 @@ -381,7 +381,7 @@ subroutine entrainment_diffusive(h, tv, fluxes, dt, G, GV, US, CS, ea, eb, & htot(i) = h(i,j,1) - Angstrom enddo if (associated(fluxes%buoy)) then ; do i=is,ie - maxF(i,1) = (dt*fluxes%buoy(i,j)) / (US%L_to_m**2*US%s_to_T**2*GV%g_prime(2)*US%m_to_Z) + maxF(i,1) = (dt*fluxes%buoy(i,j)) / (GV%g_prime(2)*US%m_to_Z) enddo ; endif endif diff --git a/src/user/BFB_surface_forcing.F90 b/src/user/BFB_surface_forcing.F90 index 65cf4bc90a..558be86734 100644 --- a/src/user/BFB_surface_forcing.F90 +++ b/src/user/BFB_surface_forcing.F90 @@ -15,6 +15,7 @@ module BFB_surface_forcing use MOM_time_manager, only : time_type, operator(+), operator(/) use MOM_tracer_flow_control, only : call_tracer_set_forcing use MOM_tracer_flow_control, only : tracer_flow_control_CS +use MOM_unit_scaling, only : unit_scale_type use MOM_variables, only : surface implicit none ; private @@ -27,7 +28,7 @@ module BFB_surface_forcing logical :: use_temperature !< If true, temperature and salinity are used as state variables. logical :: restorebuoy !< If true, use restoring surface buoyancy forcing. real :: Rho0 !< The density used in the Boussinesq approximation [kg m-3]. - real :: G_Earth !< The gravitational acceleration [m s-2] + real :: G_Earth !< The gravitational acceleration [L2 Z-1 T-2 ~> m s-2] real :: Flux_const !< The restoring rate at the surface [m s-1]. real :: gust_const !< A constant unresolved background gustiness !! that contributes to ustar [Pa]. @@ -46,7 +47,7 @@ module BFB_surface_forcing contains !> Bouyancy forcing for the boundary-forced-basin (BFB) configuration -subroutine BFB_buoyancy_forcing(state, fluxes, day, dt, G, CS) +subroutine BFB_buoyancy_forcing(state, fluxes, day, dt, G, US, CS) type(surface), intent(inout) :: state !< A structure containing fields that !! describe the surface state of the ocean. type(forcing), intent(inout) :: fluxes !< A structure containing pointers to any @@ -56,6 +57,7 @@ subroutine BFB_buoyancy_forcing(state, fluxes, day, dt, G, CS) real, intent(in) :: dt !< The amount of time over which !! the fluxes apply [s] type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(BFB_surface_forcing_CS), pointer :: CS !< A pointer to the control structure !! returned by a previous call to !! BFB_surface_forcing_init. @@ -66,7 +68,7 @@ subroutine BFB_buoyancy_forcing(state, fluxes, day, dt, G, CS) ! toward [kg m-3]. real :: rhoXcp ! The mean density times the heat capacity [J m-3 degC-1]. real :: buoy_rest_const ! A constant relating density anomalies to the - ! restoring buoyancy flux [m5 s-3 kg-1]. + ! restoring buoyancy flux [L2 m3 T-3 kg-1 ~> m5 s-3 kg-1]. integer :: i, j, is, ie, js, je integer :: isd, ied, jsd, jed @@ -111,7 +113,7 @@ subroutine BFB_buoyancy_forcing(state, fluxes, day, dt, G, CS) enddo ; enddo else ! This is the buoyancy only mode. do j=js,je ; do i=is,ie - ! fluxes%buoy is the buoyancy flux into the ocean [m2 s-3]. A positive + ! fluxes%buoy is the buoyancy flux into the ocean [L2 T-3 ~> m2 s-3]. A positive ! buoyancy flux is of the same sign as heating the ocean. fluxes%buoy(i,j) = 0.0 * G%mask2dT(i,j) enddo ; enddo @@ -145,7 +147,7 @@ subroutine BFB_buoyancy_forcing(state, fluxes, day, dt, G, CS) ! "Buoyancy restoring used without modification." ) ! The -1 is because density has the opposite sign to buoyancy. - buoy_rest_const = -1.0 * (CS%G_Earth * CS%Flux_const) / CS%Rho0 + buoy_rest_const = -1.0 * (CS%G_Earth * US%m_to_Z*US%T_to_s*CS%Flux_const) / CS%Rho0 Temp_restore = 0.0 do j=js,je ; do i=is,ie ! Set density_restore to an expression for the surface potential @@ -170,9 +172,10 @@ subroutine BFB_buoyancy_forcing(state, fluxes, day, dt, G, CS) end subroutine BFB_buoyancy_forcing !> Initialization for forcing the boundary-forced-basin (BFB) configuration -subroutine BFB_surface_forcing_init(Time, G, param_file, diag, CS) +subroutine BFB_surface_forcing_init(Time, G, US, param_file, diag, CS) type(time_type), intent(in) :: Time !< The current model time. type(ocean_grid_type), intent(in) :: G !< The ocean's 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(in) :: diag !< A structure that is used to !! regulate diagnostic output. @@ -197,7 +200,7 @@ subroutine BFB_surface_forcing_init(Time, G, param_file, diag, CS) call get_param(param_file, mdl, "G_EARTH", CS%G_Earth, & "The gravitational acceleration of the Earth.", & - units="m s-2", default = 9.80) + units="m s-2", default = 9.80, scale=US%m_to_L**2*US%Z_to_m*US%T_to_s**2) call get_param(param_file, mdl, "RHO_0", CS%Rho0, & "The mean ocean density used with BOUSSINESQ true to "//& "calculate accelerations and the mass for conservation "//& diff --git a/src/user/dumbbell_surface_forcing.F90 b/src/user/dumbbell_surface_forcing.F90 index 6d3e46bd73..d8b3ad269b 100644 --- a/src/user/dumbbell_surface_forcing.F90 +++ b/src/user/dumbbell_surface_forcing.F90 @@ -15,6 +15,7 @@ module dumbbell_surface_forcing use MOM_time_manager, only : time_type, operator(+), operator(/), get_time use MOM_tracer_flow_control, only : call_tracer_set_forcing use MOM_tracer_flow_control, only : tracer_flow_control_CS +use MOM_unit_scaling, only : unit_scale_type use MOM_variables, only : surface implicit none ; private @@ -27,7 +28,7 @@ module dumbbell_surface_forcing !! state variables. logical :: restorebuoy !< If true, use restoring surface buoyancy forcing. real :: Rho0 !< The density used in the Boussinesq approximation [kg m-3]. - real :: G_Earth !< The gravitational acceleration [m s-2] + real :: G_Earth !< The gravitational acceleration [L2 Z-1 T-2 ~> m s-2] real :: Flux_const !< The restoring rate at the surface [m s-1]. real :: gust_const !< A constant unresolved background gustiness !! that contributes to ustar [Pa]. @@ -64,8 +65,6 @@ subroutine dumbbell_buoyancy_forcing(state, fluxes, day, dt, G, CS) real :: density_restore ! The potential density that is being restored ! toward [kg m-3]. real :: rhoXcp ! The mean density times the heat capacity [J m-3 degC-1]. - real :: buoy_rest_const ! A constant relating density anomalies to the - ! restoring buoyancy flux [m5 s-3 kg-1]. integer :: i, j, is, ie, js, je integer :: isd, ied, jsd, jed @@ -113,7 +112,7 @@ subroutine dumbbell_buoyancy_forcing(state, fluxes, day, dt, G, CS) enddo ; enddo else ! This is the buoyancy only mode. do j=js,je ; do i=is,ie - ! fluxes%buoy is the buoyancy flux into the ocean [m2 s-3]. A positive + ! fluxes%buoy is the buoyancy flux into the ocean [L2 T-3 ~> m2 s-3]. A positive ! buoyancy flux is of the same sign as heating the ocean. fluxes%buoy(i,j) = 0.0 * G%mask2dT(i,j) enddo ; enddo @@ -177,9 +176,10 @@ subroutine dumbbell_dynamic_forcing(state, fluxes, day, dt, G, CS) end subroutine dumbbell_dynamic_forcing !> Reads and sets up the forcing for the dumbbell test case -subroutine dumbbell_surface_forcing_init(Time, G, param_file, diag, CS) +subroutine dumbbell_surface_forcing_init(Time, G, US, param_file, diag, CS) type(time_type), intent(in) :: Time !< The current model time. type(ocean_grid_type), intent(in) :: G !< The ocean's 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(in) :: diag !< A structure that is used to !! regulate diagnostic output. @@ -208,7 +208,7 @@ subroutine dumbbell_surface_forcing_init(Time, G, param_file, diag, CS) call get_param(param_file, mdl, "G_EARTH", CS%G_Earth, & "The gravitational acceleration of the Earth.", & - units="m s-2", default = 9.80) + units="m s-2", default = 9.80, scale=US%m_to_L**2*US%Z_to_m*US%T_to_s**2) call get_param(param_file, mdl, "RHO_0", CS%Rho0, & "The mean ocean density used with BOUSSINESQ true to "//& "calculate accelerations and the mass for conservation "//& From 920c8d8eae58006c5b2e1011ff958e149572a684 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Fri, 12 Jul 2019 13:09:24 -0400 Subject: [PATCH 098/150] +Rescaled buoyancyFlux variable units Rescaled the units of buoyancyFlux returned by the calculateBouyancyFlux routines and the units of the buoyFlux arguments to KPP_calculate and KPP_compute_BLD, all of which are now in [L2 T-3] for dimensional consistency testing. All answers are bitwise identical. --- src/core/MOM_forcing_type.F90 | 40 ++++++++++--------- .../vertical/MOM_CVMix_KPP.F90 | 27 ++++++++----- .../vertical/MOM_diabatic_driver.F90 | 2 +- 3 files changed, 39 insertions(+), 30 deletions(-) diff --git a/src/core/MOM_forcing_type.F90 b/src/core/MOM_forcing_type.F90 index a3f6e0f2ff..27a7170dad 100644 --- a/src/core/MOM_forcing_type.F90 +++ b/src/core/MOM_forcing_type.F90 @@ -881,7 +881,7 @@ subroutine calculateBuoyancyFlux1d(G, GV, US, fluxes, optics, nsw, h, Temp, Salt real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: Salt !< salinity [ppt] type(thermo_var_ptrs), intent(inout) :: tv !< thermodynamics type integer, intent(in) :: j !< j-row to work on - real, dimension(SZI_(G),SZK_(G)+1), intent(inout) :: buoyancyFlux !< buoyancy flux [m2 s-3] + real, dimension(SZI_(G),SZK_(G)+1), intent(inout) :: buoyancyFlux !< buoyancy fluxes [L2 T-3 ~> m2 s-3] real, dimension(SZI_(G)), intent(inout) :: netHeatMinusSW !< surf Heat flux !! [degC H s-1 ~> degC m s-1 or degC kg m-2 s-1] real, dimension(SZI_(G)), intent(inout) :: netSalt !< surf salt flux @@ -889,22 +889,26 @@ subroutine calculateBuoyancyFlux1d(G, GV, US, fluxes, optics, nsw, h, Temp, Salt logical, optional, intent(in) :: skip_diags !< If present and true, skip calculating !! diagnostics inside extractFluxes1d() ! local variables - 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( 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] - real, dimension(SZI_(G),SZK_(G)+1) :: netPen + 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(max(nsw,1), SZI_(G)) :: penSWbnd ! penetrating SW radiation by band + ! [degC H ~> degC m or degC kg m-2] + 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] + real, dimension(SZI_(G),SZK_(G)+1) :: netPen ! The net penetrating shortwave radiation at each level + ! [degC H ~> degC m or degC kg m-2] logical :: useRiverHeatContent logical :: useCalvingHeatContent - real :: depthBeforeScalingFluxes, GoRho - real :: H_limit_fluxes + real :: depthBeforeScalingFluxes ! A depth scale [H ~> m or kg m-2] + real :: GoRho ! The gravitational acceleration divided by mean density times some + ! unit conversion factors [L2 m3 H-1 s kg-1 T-3 ~> m4 kg-1 s-2 or m7 kg-2 s-2] + real :: H_limit_fluxes ! Another depth scale [H ~> m or kg m-2] ! smg: what do we do when have heat fluxes from calving and river? useRiverHeatContent = .False. @@ -912,7 +916,7 @@ subroutine calculateBuoyancyFlux1d(G, GV, US, fluxes, optics, nsw, h, Temp, Salt depthBeforeScalingFluxes = max( GV%Angstrom_H, 1.e-30*GV%m_to_H ) pressure(:) = 0. ! Ignore atmospheric pressure - GoRho = (GV%g_Earth*US%m_to_Z) / GV%Rho0 + GoRho = (GV%LZT_g_Earth*US%m_to_Z * GV%H_to_m*US%T_to_s) / GV%Rho0 start = 1 + G%isc - G%isd npts = 1 + G%iec - G%isc @@ -949,10 +953,10 @@ subroutine calculateBuoyancyFlux1d(G, GV, US, fluxes, optics, nsw, h, Temp, Salt ! Convert to a buoyancy flux, excluding penetrating SW heating buoyancyFlux(G%isc:G%iec,1) = - GoRho * ( dRhodS(G%isc:G%iec) * netSalt(G%isc:G%iec) + & - dRhodT(G%isc:G%iec) * netHeat(G%isc:G%iec) ) * GV%H_to_m ! m^2/s^3 + dRhodT(G%isc:G%iec) * netHeat(G%isc:G%iec) ) ! [L2 T-3 ~> m2 s-3] ! We also have a penetrative buoyancy flux associated with penetrative SW do k=2, G%ke+1 - buoyancyFlux(G%isc:G%iec,k) = - GoRho * ( dRhodT(G%isc:G%iec) * netPen(G%isc:G%iec,k) ) * GV%H_to_m ! m^2/s^3 + buoyancyFlux(G%isc:G%iec,k) = - GoRho * ( dRhodT(G%isc:G%iec) * netPen(G%isc:G%iec,k) ) ! [L2 T-3 ~> m2 s-3] enddo end subroutine calculateBuoyancyFlux1d @@ -971,7 +975,7 @@ subroutine calculateBuoyancyFlux2d(G, GV, US, fluxes, optics, h, Temp, Salt, tv, real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: Temp !< temperature [degC] real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: Salt !< salinity [ppt] type(thermo_var_ptrs), intent(inout) :: tv !< thermodynamics type - real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(inout) :: buoyancyFlux !< buoy flux [m2 s-3] + real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(inout) :: buoyancyFlux !< buoyancy fluxes [L2 T-3 ~> m2 s-3] real, dimension(SZI_(G),SZJ_(G)), optional, intent(inout) :: netHeatMinusSW !< surf temp flux !! [degC H ~> degC m or degC kg m-2] real, dimension(SZI_(G),SZJ_(G)), optional, intent(inout) :: netSalt !< surf salt flux diff --git a/src/parameterizations/vertical/MOM_CVMix_KPP.F90 b/src/parameterizations/vertical/MOM_CVMix_KPP.F90 index 159a88958b..085a5f8157 100644 --- a/src/parameterizations/vertical/MOM_CVMix_KPP.F90 +++ b/src/parameterizations/vertical/MOM_CVMix_KPP.F90 @@ -491,7 +491,7 @@ logical function KPP_init(paramFile, G, GV, US, diag, Time, CS, passive, Waves) 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*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') + 'Surface (and penetrating) buoyancy flux, as used by [CVMix] KPP', 'm2/s3', conversion=US%L_to_m**2*US%s_to_T**3) CS%id_QminusSW = register_diag_field('ocean_model', 'KPP_QminusSW', diag%axesT1, Time, & 'Net temperature flux ignoring short-wave, as used by [CVMix] KPP', 'K m/s') CS%id_netS = register_diag_field('ocean_model', 'KPP_netSalt', diag%axesT1, Time, & @@ -591,7 +591,7 @@ subroutine KPP_calculate(CS, G, GV, US, h, uStar, & 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 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(in) :: buoyFlux !< Surface buoyancy flux [L2 T-3 ~> 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 T-1 ~> m2 s-1] @@ -614,6 +614,7 @@ subroutine KPP_calculate(CS, G, GV, US, h, uStar, & real :: surfFricVel, surfBuoyFlux real :: sigma, sigmaRatio + real :: buoy_scale ! A unit conversion factor for buoyancy fluxes [m2 T3 L-2 s-3 ~> nondim] real :: dh ! The local thickness used for calculating interface positions [m] real :: hcorr ! A cumulative correction arising from inflation of vanished layers [m] @@ -635,6 +636,8 @@ subroutine KPP_calculate(CS, G, GV, US, h, uStar, & if (CS%id_Kd_in > 0) call post_data(CS%id_Kd_in, Kt, CS%diag) + buoy_scale = US%L_to_m**2*US%s_to_T**3 + !$OMP parallel do default(shared) firstprivate(nonLocalTrans) ! loop over horizontal points on processor do j = G%jsc, G%jec @@ -660,7 +663,7 @@ subroutine KPP_calculate(CS, G, GV, US, h, uStar, & enddo ! k-loop finishes - surfBuoyFlux = buoyFlux(i,j,1) ! This is only used in kpp_compute_OBL_depth to limit + surfBuoyFlux = buoy_scale*buoyFlux(i,j,1) ! This is only used in kpp_compute_OBL_depth to limit ! h to Monin-Obukov (default is false, ie. not used) ! Call CVMix/KPP to obtain OBL diffusivities, viscosities and non-local transports @@ -670,12 +673,12 @@ subroutine KPP_calculate(CS, G, GV, US, h, uStar, & !BGR/ Add option for use of surface buoyancy flux with total sw flux. if (CS%SW_METHOD == SW_METHOD_ALL_SW) then - surfBuoyFlux = buoyFlux(i,j,1) + surfBuoyFlux = buoy_scale * buoyFlux(i,j,1) elseif (CS%SW_METHOD == SW_METHOD_MXL_SW) then ! We know the actual buoyancy flux into the OBL - surfBuoyFlux = buoyFlux(i,j,1) - buoyFlux(i,j,int(CS%kOBL(i,j))+1) + surfBuoyFlux = buoy_scale * (buoyFlux(i,j,1) - buoyFlux(i,j,int(CS%kOBL(i,j))+1)) elseif (CS%SW_METHOD == SW_METHOD_LV1_SW) then - surfBuoyFlux = buoyFlux(i,j,1) - buoyFlux(i,j,2) + surfBuoyFlux = buoy_scale * (buoyFlux(i,j,1) - buoyFlux(i,j,2)) endif ! If option "MatchBoth" is selected in CVMix, MOM should be capable of matching. @@ -889,7 +892,7 @@ subroutine KPP_compute_BLD(CS, G, GV, US, h, Temp, Salt, u, v, EOS, uStar, buoyF 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 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(in) :: buoyFlux !< Surface buoyancy flux [L2 T-3 ~> m2 s-3] type(wave_parameters_CS), optional, pointer :: Waves !< Wave CS ! Local variables @@ -916,6 +919,7 @@ subroutine KPP_compute_BLD(CS, G, GV, US, h, Temp, Salt, u, v, EOS, uStar, buoyF real :: zBottomMinusOffset ! Height of bottom plus a little bit [m] real :: SLdepth_0d ! Surface layer depth = surf_layer_ext*OBLdepth. real :: hTot ! Running sum of thickness used in the surface layer average [m] + real :: buoy_scale ! A unit conversion factor for buoyancy fluxes [m2 T3 L-2 s-3 ~> nondim] real :: delH ! Thickness of a layer [m] real :: surfHtemp, surfTemp ! Integral and average of temp over the surface layer real :: surfHsalt, surfSalt ! Integral and average of saln over the surface layer @@ -948,6 +952,7 @@ subroutine KPP_compute_BLD(CS, G, GV, US, h, Temp, Salt, u, v, EOS, uStar, buoyF ! some constants GoRho = GV%mks_g_Earth / GV%Rho0 + buoy_scale = US%L_to_m**2*US%s_to_T**3 ! loop over horizontal points on processor !$OMP parallel do default(shared) @@ -1068,7 +1073,7 @@ subroutine KPP_compute_BLD(CS, G, GV, US, h, Temp, Salt, u, v, EOS, uStar, buoyF pRef = pRef + GV%H_to_Pa * h(i,j,k) ! this difference accounts for penetrating SW - surfBuoyFlux2(k) = buoyFlux(i,j,1) - buoyFlux(i,j,k+1) + surfBuoyFlux2(k) = buoy_scale * (buoyFlux(i,j,1) - buoyFlux(i,j,k+1)) enddo ! k-loop finishes @@ -1138,7 +1143,7 @@ subroutine KPP_compute_BLD(CS, G, GV, US, h, Temp, Salt, u, v, EOS, uStar, buoyF elseif (CS%LT_VT2_METHOD==LT_VT2_MODE_LF17) then CS%CS=cvmix_get_kpp_real('c_s',CS%KPP_params) do k=1,G%ke - WST = (max(0.,-buoyflux(i,j,1))*(-cellHeight(k)))**(1./3.) + WST = (max(0.,-buoy_scale*buoyflux(i,j,1))*(-cellHeight(k)))**(1./3.) LangEnhVT2(k) = sqrt((0.15*WST**3. + 0.17*surfFricVel**3.* & (1.+0.49*CS%La_SL(i,j)**(-2.))) / & (0.2*ws_1d(k)**3/(CS%cs*CS%surf_layer_ext*CS%vonKarman**4.))) @@ -1167,7 +1172,7 @@ subroutine KPP_compute_BLD(CS, G, GV, US, h, Temp, Salt, u, v, EOS, uStar, buoyF N_iface=CS%N(i,j,:)) ! Buoyancy frequency [s-1] - surfBuoyFlux = buoyFlux(i,j,1) ! This is only used in kpp_compute_OBL_depth to limit + surfBuoyFlux = buoy_scale * buoyFlux(i,j,1) ! This is only used in kpp_compute_OBL_depth to limit ! h to Monin-Obukov (default is false, ie. not used) call CVMix_kpp_compute_OBL_depth( & @@ -1244,7 +1249,7 @@ subroutine KPP_compute_BLD(CS, G, GV, US, h, Temp, Salt, u, v, EOS, uStar, buoyF ! ws_cntr=Ws_1d, & ! Turbulent velocity scale profile [m s-1] ! N_iface=CS%N ) ! Buoyancy frequency [s-1] - ! surfBuoyFlux = buoyFlux(i,j,1) ! This is only used in kpp_compute_OBL_depth to limit + ! surfBuoyFlux = buoy_scale*buoyFlux(i,j,1) ! This is only used in kpp_compute_OBL_depth to limit ! ! h to Monin-Obukov (default is false, ie. not used) ! call CVMix_kpp_compute_OBL_depth( & diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index 526dc4dfe3..e0df2f3c3f 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -237,7 +237,7 @@ module MOM_diabatic_driver ! Data arrays for communicating between components real, allocatable, dimension(:,:,:) :: KPP_NLTheat !< KPP non-local transport for heat [m s-1] real, allocatable, dimension(:,:,:) :: KPP_NLTscalar !< KPP non-local transport for scalars [m s-1] - real, allocatable, dimension(:,:,:) :: KPP_buoy_flux !< KPP forcing buoyancy flux [m2 s-3] + real, allocatable, dimension(:,:,:) :: KPP_buoy_flux !< KPP forcing buoyancy flux [L2 T-3 ~> m2 s-3] real, allocatable, dimension(:,:) :: KPP_temp_flux !< KPP effective temperature flux [degC m s-1] real, allocatable, dimension(:,:) :: KPP_salt_flux !< KPP effective salt flux [ppt m s-1] From 6ff142e3f498b1de2bc31feac014a91f0336cf37 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Fri, 12 Jul 2019 13:10:19 -0400 Subject: [PATCH 099/150] Rescaled diagnostics in entrainment_diffusive Rescaled the internal representation of diagnostics in entrainment_diffusive. All answers are bitwise identical. --- src/parameterizations/vertical/MOM_entrain_diffusive.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/parameterizations/vertical/MOM_entrain_diffusive.F90 b/src/parameterizations/vertical/MOM_entrain_diffusive.F90 index 121191b008..df9dfb1604 100644 --- a/src/parameterizations/vertical/MOM_entrain_diffusive.F90 +++ b/src/parameterizations/vertical/MOM_entrain_diffusive.F90 @@ -822,7 +822,7 @@ subroutine entrainment_diffusive(h, tv, fluxes, dt, G, GV, US, CS, ea, eb, & endif if (CS%id_diff_work > 0) then - g_2dt = 0.5 * GV%H_to_Z**2 * (GV%g_Earth / dt) + g_2dt = 0.5 * GV%H_to_Z**2*US%L_to_Z**2 * (GV%LZT_g_Earth / dt) do i=is,ie ; diff_work(i,j,1) = 0.0 ; diff_work(i,j,nz+1) = 0.0 ; enddo if (associated(tv%eqn_of_state)) then if (associated(fluxes%p_surf)) then @@ -2129,7 +2129,7 @@ subroutine entrain_diffusive_init(Time, G, GV, US, param_file, diag, CS) '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) + conversion=US%Z_to_m**3*US%s_to_T**3) end subroutine entrain_diffusive_init From 0cab478f336e9db4a4e1e8e5db67a48374664515 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Fri, 12 Jul 2019 13:10:38 -0400 Subject: [PATCH 100/150] escaled comments in find_TKE_to_Kd Rescaled the internal representation of commented out diagnostics and added some clarifying comments in find_TKE_to_Kd. All answers are bitwise identical. --- src/parameterizations/vertical/MOM_set_diffusivity.F90 | 10 ++++++---- 1 file changed, 6 insertions(+), 4 deletions(-) diff --git a/src/parameterizations/vertical/MOM_set_diffusivity.F90 b/src/parameterizations/vertical/MOM_set_diffusivity.F90 index fbc299a4e2..4ba95b6a22 100644 --- a/src/parameterizations/vertical/MOM_set_diffusivity.F90 +++ b/src/parameterizations/vertical/MOM_set_diffusivity.F90 @@ -772,7 +772,7 @@ subroutine find_TKE_to_Kd(h, tv, dRho_int, N2_lay, j, dt, G, GV, US, CS, & maxEnt(i,kb(i)) = mFkb(i) elseif (k > kb(i)) then maxEnt(i,k) = (1.0/dsp1_ds(i,k))*(maxEnt(i,k-1) + htot(i)) -! maxEnt(i,k) = ds_dsp1(i,k)*(maxEnt(i,k-1) + htot(i)) ! BITWISE CHG +! maxEnt(i,k) = ds_dsp1(i,k)*(maxEnt(i,k-1) + htot(i)) !### BITWISE CHG htot(i) = htot(i) + GV%H_to_Z*(h(i,j,k) - GV%Angstrom_H) endif enddo ; enddo @@ -813,16 +813,18 @@ subroutine find_TKE_to_Kd(h, tv, dRho_int, N2_lay, j, dt, G, GV, US, CS, & TKE_to_Kd(i,k) = 0.0 else ! maxTKE is found by determining the kappa that gives maxEnt. - ! ### This should be 1 / G_Earth * (delta rho_InSitu) ! kappa_max = I_dt * dRho_int(i,K+1) * maxEnt(i,k) * & - ! (GV%H_to_m*h(i,j,k) + dh_max) / dRho_lay - ! maxTKE(i,k) = (GV%g_Earth*US%m_to_Z) * dRho_lay * kappa_max + ! (GV%H_to_Z*h(i,j,k) + dh_max) / dRho_lay + ! maxTKE(i,k) = (GV%LZT_g_Earth*US%L_to_Z**2) * dRho_lay * kappa_max ! dRho_int should already be non-negative, so the max is redundant? dh_max = maxEnt(i,k) * (1.0 + dsp1_ds(i,k)) dRho_lay = 0.5 * max(dRho_int(i,K) + dRho_int(i,K+1), 0.0) maxTKE(i,k) = I_dt * (G_IRho0 * & (0.5*max(dRho_int(i,K+1) + dsp1_ds(i,k)*dRho_int(i,K), 0.0))) * & ((GV%H_to_Z*h(i,j,k) + dh_max) * maxEnt(i,k)) + ! TKE_to_Kd should be rho_InSitu / G_Earth * (delta rho_InSitu) + ! The omega^2 term in TKE_to_Kd is due to a rescaling of the efficiency of turbulent + ! mixing by a factor of N^2 / (N^2 + Omega^2), as proposed by Melet et al., 2013? TKE_to_Kd(i,k) = 1.0 / (G_Rho0 * dRho_lay + & CS%omega**2 * GV%H_to_Z*(h(i,j,k) + H_neglect)) endif From 8462633bf776ed8f26dd0ed4681d7ac371b679ef Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Fri, 12 Jul 2019 13:11:04 -0400 Subject: [PATCH 101/150] Rescaled comments in applyBoundaryFluxesInOut Rescaled the internal representation of commented out diagnostics in applyBoundaryFluxesInOut. All answers are bitwise identical. --- src/parameterizations/vertical/MOM_diabatic_aux.F90 | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/src/parameterizations/vertical/MOM_diabatic_aux.F90 b/src/parameterizations/vertical/MOM_diabatic_aux.F90 index 20380f22c5..cd20e68c08 100644 --- a/src/parameterizations/vertical/MOM_diabatic_aux.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_aux.F90 @@ -916,7 +916,7 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, US, dt, fluxes, optics, nsw, h, t ! 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 +! real :: I_G_Earth ! The inverse of the gravitational acceleration with conversion factors [s2 m-1]. 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 @@ -939,7 +939,7 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, US, dt, fluxes, optics, nsw, h, t calculate_energetics = (present(cTKE) .and. present(dSV_dT) .and. present(dSV_dS)) calculate_buoyancy = present(SkinBuoyFlux) if (calculate_buoyancy) SkinBuoyFlux(:,:) = 0.0 -! I_G_Earth = 1.0 / GV%g_Earth +! I_G_Earth = US%Z_to_m / (US%L_T_to_m_s**2 * GV%LZT_g_Earth) 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 @@ -1001,8 +1001,8 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, US, dt, fluxes, optics, nsw, h, t dSV_dT(:,j,k), dSV_dS(:,j,k), is, ie-is+1, tv%eqn_of_state) do i=is,ie ; dSV_dT_2d(i,k) = dSV_dT(i,j,k) ; enddo ! do i=is,ie -! dT_to_dPE(i,k) = I_G_Earth * US%Z_to_m * d_pres(i) * p_lay(i) * dSV_dT(i,j,k) -! dS_to_dPE(i,k) = I_G_Earth * US%Z_to_m * d_pres(i) * p_lay(i) * dSV_dS(i,j,k) +! dT_to_dPE(i,k) = I_G_Earth * d_pres(i) * p_lay(i) * dSV_dT(i,j,k) +! dS_to_dPE(i,k) = I_G_Earth * d_pres(i) * p_lay(i) * dSV_dS(i,j,k) ! enddo enddo pen_TKE_2d(:,:) = 0.0 From 72dbcedd5ca4dc35e991f70634f894bf310283c6 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Fri, 12 Jul 2019 14:00:29 -0400 Subject: [PATCH 102/150] +Explicitly set optics-related array sizes Explicitly set the sizes of optics-related arguments to mixedlayer_convection, mechanical_entrainment, and sumSWoverBands so that these arrays do not alwasy have to start at 1, thereby facilitating global indexing. This involves adding a new integer argument to sumSWoverBands. All answers are bitwise identical. --- src/core/MOM_forcing_type.F90 | 2 +- .../vertical/MOM_bulk_mixed_layer.F90 | 24 ++++++++----------- .../vertical/MOM_diabatic_aux.F90 | 2 +- .../vertical/MOM_opacity.F90 | 13 ++++++---- 4 files changed, 20 insertions(+), 21 deletions(-) diff --git a/src/core/MOM_forcing_type.F90 b/src/core/MOM_forcing_type.F90 index 27a7170dad..22c3bb82ac 100644 --- a/src/core/MOM_forcing_type.F90 +++ b/src/core/MOM_forcing_type.F90 @@ -936,7 +936,7 @@ subroutine calculateBuoyancyFlux1d(G, GV, US, fluxes, optics, nsw, h, Temp, Salt ! 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, j, dt*US%s_to_T, & + call sumSWoverBands(G, GV, US, h(:,j,:), optics_nbands(optics), 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 7b355ff960..490ca9b32b 100644 --- a/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 +++ b/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 @@ -999,13 +999,11 @@ subroutine mixedlayer_convection(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & !! over a time step [ppt H ~> ppt m or ppt kg m-2]. 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 sea surface in each - !! penetrating band [degC H ~> degC m or degC kg m-2], - !! size nsw x SZI_(G). - real, dimension(:,:,:), intent(in) :: opacity_band !< The opacity in each band of penetrating - !! shortwave radiation [H-1 ~> m-1 or m2 kg-1]. - !! The indicies of opacity_band are band, i, k. + real, dimension(max(nsw,1),SZI_(G)), intent(inout) :: Pen_SW_bnd !< The penetrating shortwave + !! heating at the sea surface in each penetrating + !! band [degC H ~> degC m or degC kg m-2]. + real, dimension(max(nsw,1),SZI_(G),SZK_(GV)), intent(in) :: opacity_band !< The opacity in each band of + !! penetrating shortwave radiation [H-1 ~> m-1 or m2 kg-1]. real, dimension(SZI_(G)), intent(out) :: Conv_en !< The buoyant turbulent kinetic energy source !! 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 @@ -1545,13 +1543,11 @@ subroutine mechanical_entrainment(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & !! 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 - !! sea surface in each penetrating band - !! [degC H ~> degC m or degC kg m-2], - !! size nsw x SZI_(G). - real, dimension(:,:,:), intent(in) :: opacity_band !< The opacity in each band of penetrating - !! shortwave radiation [H-1 ~> m-1 or m2 kg-1]. - !! The indicies of opacity_band are (band, i, k). + real, dimension(max(nsw,1),SZI_(G)), intent(inout) :: Pen_SW_bnd !< The penetrating shortwave + !! heating at the sea surface in each penetrating + !! band [degC H ~> degC m or degC kg m-2]. + real, dimension(max(nsw,1),SZI_(G),SZK_(GV)), intent(in) :: opacity_band !< The opacity in each band of + !! penetrating shortwave radiation [H-1 ~> m-1 or m2 kg-1]. real, dimension(SZI_(G)), intent(inout) :: TKE !< The turbulent kinetic energy !! available for mixing over a time !! step [Z m2 T-2 ~> m3 s-2]. diff --git a/src/parameterizations/vertical/MOM_diabatic_aux.F90 b/src/parameterizations/vertical/MOM_diabatic_aux.F90 index cd20e68c08..483bce6f1b 100644 --- a/src/parameterizations/vertical/MOM_diabatic_aux.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_aux.F90 @@ -1333,7 +1333,7 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, US, dt, fluxes, optics, nsw, h, t 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, j, dt_in_T, & + call sumSWoverBands(G, GV, US, h2d(:,:), optics_nbands(optics), 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, & diff --git a/src/parameterizations/vertical/MOM_opacity.F90 b/src/parameterizations/vertical/MOM_opacity.F90 index 4fc420f24f..899f778380 100644 --- a/src/parameterizations/vertical/MOM_opacity.F90 +++ b/src/parameterizations/vertical/MOM_opacity.F90 @@ -771,13 +771,15 @@ end subroutine absorbRemainingSW !> 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, & +subroutine sumSWoverBands(G, GV, US, h, nsw, 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_(GV)), & intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]. + integer, intent(in) :: nsw !< The number of bands of penetrating shortwave + !! radiation, perhaps from optics_nbands(optics), 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. @@ -787,7 +789,7 @@ subroutine sumSWoverBands(G, GV, US, h, optics, j, dt, & !! 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 + real, dimension(max(nsw,1),SZI_(G)), 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). @@ -803,7 +805,8 @@ subroutine sumSWoverBands(G, GV, US, h, optics, j, dt, & ! 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, dimension(max(nsw,1),SZI_(G)) :: Pen_SW_bnd ! The remaining penetrating shortwave radiation + ! in each band, initially iPen_SW_bnd [degC H ~> degC m or degC kg m-2] real :: SW_trans ! fraction of shortwave radiation not ! absorbed in a layer [nondim] real :: unabsorbed ! fraction of the shortwave radiation @@ -820,14 +823,14 @@ subroutine sumSWoverBands(G, GV, US, h, optics, 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, nsw + integer :: is, ie, nz, i, k, ks, n 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 + 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 From 8da9eb922d9993c88fc4229d3cc975fd61f57e26 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Sun, 14 Jul 2019 15:16:14 -0600 Subject: [PATCH 103/150] changes to the interfaces to bring them more in line with dev/ncar latest --- config_src/mct_driver/MOM_ocean_model.F90 | 38 ++++----- config_src/mct_driver/MOM_surface_forcing.F90 | 78 ++++++++--------- config_src/mct_driver/ocn_comp_mct.F90 | 8 +- config_src/nuopc_driver/MOM_ocean_model.F90 | 64 +++++++------- .../nuopc_driver/MOM_surface_forcing.F90 | 84 +++++++++---------- 5 files changed, 135 insertions(+), 137 deletions(-) diff --git a/config_src/mct_driver/MOM_ocean_model.F90 b/config_src/mct_driver/MOM_ocean_model.F90 index 64ef660dbf..8bb3346021 100644 --- a/config_src/mct_driver/MOM_ocean_model.F90 +++ b/config_src/mct_driver/MOM_ocean_model.F90 @@ -286,15 +286,15 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, gas_fields_ocn, i ! Read all relevant parameters and write them to the model log. call log_version(param_file, mdl, version, "") call get_param(param_file, mdl, "RESTART_CONTROL", OS%Restart_control, & - "An integer whose bits encode which restart files are \n"//& - "written. Add 2 (bit 1) for a time-stamped file, and odd \n"//& - "(bit 0) for a non-time-stamped file. A restart file \n"//& - "will be saved at the end of the run segment for any \n"//& + "An integer whose bits encode which restart files are "//& + "written. Add 2 (bit 1) for a time-stamped file, and odd "//& + "(bit 0) for a non-time-stamped file. A restart file "//& + "will be saved at the end of the run segment for any "//& "non-negative value.", default=1) call get_param(param_file, mdl, "OCEAN_SURFACE_STAGGER", stagger, & - "A case-insensitive character string to indicate the \n"//& - "staggering of the surface velocity field that is \n"//& - "returned to the coupler. Valid values include \n"//& + "A case-insensitive character string to indicate the "//& + "staggering of the surface velocity field that is "//& + "returned to the coupler. Valid values include "//& "'A', 'B', or 'C'.", default="C") if (uppercase(stagger(1:1)) == 'A') then Ocean_sfc%stagger = AGRID @@ -308,17 +308,17 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, gas_fields_ocn, i end if call get_param(param_file, mdl, "RESTORE_SALINITY",OS%restore_salinity, & - "If true, the coupled driver will add a globally-balanced \n"//& - "fresh-water flux that drives sea-surface salinity \n"//& + "If true, the coupled driver will add a globally-balanced "//& + "fresh-water flux that drives sea-surface salinity "//& "toward specified values.", default=.false.) call get_param(param_file, mdl, "RESTORE_TEMPERATURE",OS%restore_temp, & - "If true, the coupled driver will add a \n"//& - "heat flux that drives sea-surface temperauture \n"//& + "If true, the coupled driver will add a "//& + "heat flux that drives sea-surface temperature "//& "toward specified values.", default=.false.) call get_param(param_file, mdl, "RHO_0", Rho0, & - "The mean ocean density used with BOUSSINESQ true to \n"//& - "calculate accelerations and the mass for conservation \n"//& - "properties, or with BOUSSINSEQ false to convert some \n"//& + "The mean ocean density used with BOUSSINESQ true to "//& + "calculate accelerations and the mass for conservation "//& + "properties, or with BOUSSINSEQ false to convert some "//& "parameters from vertical units of m to kg m-2.", & units="kg m-3", default=1035.0) call get_param(param_file, mdl, "G_EARTH", G_Earth, & @@ -339,8 +339,8 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, gas_fields_ocn, i call get_param(param_file, mdl, "LATENT_HEAT_FUSION", OS%latent_heat_fusion, & "The latent heat of fusion.", units="J/kg", default=hlf) call get_param(param_file, mdl, "BERG_AREA_THRESHOLD", OS%berg_area_threshold, & - "Fraction of grid cell which iceberg must occupy, so that fluxes \n"//& - "below berg are set to zero. Not applied for negative \n"//& + "Fraction of grid cell which iceberg must occupy, so that fluxes "//& + "below berg are set to zero. Not applied for negative "//& " values.", units="non-dim", default=-1.0) endif @@ -350,9 +350,9 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, gas_fields_ocn, i ! vertical integrals, since the related 3-d sums are not negligible in cost. call get_param(param_file, mdl, "HFREEZE", HFrz, & - "If HFREEZE > 0, melt potential will be computed. The actual depth \n"//& - "over which melt potential is computed will be min(HFREEZE, OBLD), \n"//& - "where OBLD is the boundary layer depth. If HFREEZE <= 0 (default), \n"//& + "If HFREEZE > 0, melt potential will be computed. The actual depth "//& + "over which melt potential is computed will be min(HFREEZE, OBLD), "//& + "where OBLD is the boundary layer depth. If HFREEZE <= 0 (default), "//& "melt potential will not be computed.", units="m", default=-1.0, do_not_log=.true.) if (HFrz .gt. 0.0) then diff --git a/config_src/mct_driver/MOM_surface_forcing.F90 b/config_src/mct_driver/MOM_surface_forcing.F90 index 3a82794723..47e676a3d3 100644 --- a/config_src/mct_driver/MOM_surface_forcing.F90 +++ b/config_src/mct_driver/MOM_surface_forcing.F90 @@ -1050,12 +1050,12 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, restore_salt, default=".") CS%inputdir = slasher(CS%inputdir) call get_param(param_file, mdl, "ENABLE_THERMODYNAMICS", CS%use_temperature, & - "If true, Temperature and salinity are used as state \n"//& + "If true, Temperature and salinity are used as state "//& "variables.", default=.true.) call get_param(param_file, mdl, "RHO_0", CS%Rho0, & - "The mean ocean density used with BOUSSINESQ true to \n"//& - "calculate accelerations and the mass for conservation \n"//& - "properties, or with BOUSSINSEQ false to convert some \n"//& + "The mean ocean density used with BOUSSINESQ true to "//& + "calculate accelerations and the mass for conservation "//& + "properties, or with BOUSSINSEQ false to convert some "//& "parameters from vertical units of m to kg m-2.", & units="kg m-3", default=1035.0) call get_param(param_file, mdl, "LATENT_HEAT_FUSION", CS%latent_heat_fusion, & @@ -1063,46 +1063,46 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, restore_salt, call get_param(param_file, mdl, "LATENT_HEAT_VAPORIZATION", CS%latent_heat_vapor, & "The latent heat of fusion.", units="J/kg", default=hlv) call get_param(param_file, mdl, "MAX_P_SURF", CS%max_p_surf, & - "The maximum surface pressure that can be exerted by the \n"//& - "atmosphere and floating sea-ice or ice shelves. This is \n"//& - "needed because the FMS coupling structure does not \n"//& - "limit the water that can be frozen out of the ocean and \n"//& - "the ice-ocean heat fluxes are treated explicitly. No \n"//& + "The maximum surface pressure that can be exerted by the "//& + "atmosphere and floating sea-ice or ice shelves. 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. No "//& "limit is applied if a negative value is used.", units="Pa", & default=-1.0) call get_param(param_file, mdl, "ADJUST_NET_SRESTORE_TO_ZERO", & CS%adjust_net_srestore_to_zero, & - "If true, adjusts the salinity restoring seen to zero\n"//& + "If true, adjusts the salinity restoring seen to zero "//& "whether restoring is via a salt flux or virtual precip.",& default=restore_salt) call get_param(param_file, mdl, "ADJUST_NET_SRESTORE_BY_SCALING", & CS%adjust_net_srestore_by_scaling, & - "If true, adjustments to salt restoring to achieve zero net are\n"//& + "If true, adjustments to salt restoring to achieve zero net are "//& "made by scaling values without moving the zero contour.",& default=.false.) call get_param(param_file, mdl, "ADJUST_NET_FRESH_WATER_TO_ZERO", & CS%adjust_net_fresh_water_to_zero, & - "If true, adjusts the net fresh-water forcing seen \n"//& + "If true, adjusts the net fresh-water forcing seen "//& "by the ocean (including restoring) to zero.", default=.false.) if (CS%adjust_net_fresh_water_to_zero) & call get_param(param_file, mdl, "USE_NET_FW_ADJUSTMENT_SIGN_BUG", & CS%use_net_FW_adjustment_sign_bug, & - "If true, use the wrong sign for the adjustment to\n"//& + "If true, use the wrong sign for the adjustment to "//& "the net fresh-water.", default=.false.) call get_param(param_file, mdl, "ADJUST_NET_FRESH_WATER_BY_SCALING", & CS%adjust_net_fresh_water_by_scaling, & - "If true, adjustments to net fresh water to achieve zero net are\n"//& + "If true, adjustments to net fresh water to achieve zero net are "//& "made by scaling values without moving the zero contour.",& default=.false.) call get_param(param_file, mdl, "ICE_SALT_CONCENTRATION", & CS%ice_salt_concentration, & - "The assumed sea-ice salinity needed to reverse engineer the \n"//& + "The assumed sea-ice salinity needed to reverse engineer the "//& "melt flux (or ice-ocean fresh-water flux).", & units="kg/kg", default=0.005) call get_param(param_file, mdl, "USE_LIMITED_PATM_SSH", CS%use_limited_P_SSH, & - "If true, return the sea surface height with the \n"//& - "correction for the atmospheric (and sea-ice) pressure \n"//& - "limited by max_p_surf instead of the full atmospheric \n"//& + "If true, return the sea surface height with the "//& + "correction for the atmospheric (and sea-ice) pressure "//& + "limited by max_p_surf instead of the full atmospheric "//& "pressure.", default=.true.) ! smg: should get_param call should be removed when have A=B code reconciled. @@ -1111,8 +1111,8 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, restore_salt, default=CS%use_temperature,do_not_log=.true.) call get_param(param_file, mdl, "WIND_STAGGER", stagger, & - "A case-insensitive character string to indicate the \n"//& - "staggering of the input wind stress field. Valid \n"//& + "A case-insensitive character string to indicate the "//& + "staggering of the input wind stress field. Valid "//& "values are 'A', 'B', or 'C'.", default="C") if (uppercase(stagger(1:1)) == 'A') then ; CS%wind_stagger = AGRID elseif (uppercase(stagger(1:1)) == 'B') then ; CS%wind_stagger = BGRID_NE @@ -1120,14 +1120,14 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, restore_salt, else ; call MOM_error(FATAL,"surface_forcing_init: WIND_STAGGER = "// & trim(stagger)//" is invalid.") ; endif call get_param(param_file, mdl, "WIND_STRESS_MULTIPLIER", CS%wind_stress_multiplier, & - "A factor multiplying the wind-stress given to the ocean by the\n"//& - "coupler. This is used for testing and should be =1.0 for any\n"//& + "A factor multiplying the wind-stress given to the ocean by the "//& + "coupler. This is used for testing and should be =1.0 for any "//& "production runs.", default=1.0) if (restore_salt) then call get_param(param_file, mdl, "FLUXCONST", CS%Flux_const, & - "The constant that relates the restoring surface fluxes \n"//& - "to the relative surface anomalies (akin to a piston \n"//& + "The constant that relates the restoring surface fluxes "//& + "to the relative surface anomalies (akin to a piston "//& "velocity). Note the non-MKS units.", units="m day-1", & fail_if_missing=.true.) call get_param(param_file, mdl, "SALT_RESTORE_FILE", CS%salt_restore_file, & @@ -1141,19 +1141,19 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, restore_salt, CS%Flux_const = CS%Flux_const / 86400.0 call get_param(param_file, mdl, "SRESTORE_AS_SFLUX", CS%salt_restore_as_sflux, & - "If true, the restoring of salinity is applied as a salt \n"//& + "If true, the restoring of salinity is applied as a salt "//& "flux instead of as a freshwater flux.", default=.false.) call get_param(param_file, mdl, "MAX_DELTA_SRESTORE", CS%max_delta_srestore, & "The maximum salinity difference used in restoring terms.", & units="PSU or g kg-1", default=999.0) call get_param(param_file, mdl, "MASK_SRESTORE_UNDER_ICE", & CS%mask_srestore_under_ice, & - "If true, disables SSS restoring under sea-ice based on a frazil\n"//& + "If true, disables SSS restoring under sea-ice based on a frazil "//& "criteria (SST<=Tf). Only used when RESTORE_SALINITY is True.", & default=.false.) call get_param(param_file, mdl, "MASK_SRESTORE_MARGINAL_SEAS", & CS%mask_srestore_marginal_seas, & - "If true, disable SSS restoring in marginal seas. Only used when\n"//& + "If true, disable SSS restoring in marginal seas. Only used when "//& "RESTORE_SALINITY is True.", default=.false.) call get_param(param_file, mdl, "BASIN_FILE", basin_file, & "A file in which to find the basin masks, in variable 'basin'.", & @@ -1171,8 +1171,8 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, restore_salt, if (restore_temp) then call get_param(param_file, mdl, "FLUXCONST", CS%Flux_const, & - "The constant that relates the restoring surface fluxes \n"//& - "to the relative surface anomalies (akin to a piston \n"//& + "The constant that relates the restoring surface fluxes "//& + "to the relative surface anomalies (akin to a piston "//& "velocity). Note the non-MKS units.", units="m day-1", & fail_if_missing=.true.) call get_param(param_file, mdl, "SST_RESTORE_FILE", CS%temp_restore_file, & @@ -1199,11 +1199,11 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, restore_salt, "The drag coefficient that applies to the tides.", & units="nondim", default=1.0e-4) call get_param(param_file, mdl, "READ_TIDEAMP", CS%read_TIDEAMP, & - "If true, read a file (given by TIDEAMP_FILE) containing \n"//& + "If true, read a file (given by TIDEAMP_FILE) containing "//& "the tidal amplitude with INT_TIDE_DISSIPATION.", default=.false.) if (CS%read_TIDEAMP) then call get_param(param_file, mdl, "TIDEAMP_FILE", TideAmp_file, & - "The path to the file containing the spatially varying \n"//& + "The path to the file containing the spatially varying "//& "tidal amplitudes with INT_TIDE_DISSIPATION.", & default="tideamp.nc") CS%utide=0.0 @@ -1238,14 +1238,14 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, restore_salt, ! constant. call get_param(param_file, mdl, "READ_GUST_2D", CS%read_gust_2d, & - "If true, use a 2-dimensional gustiness supplied from \n"//& + "If true, use a 2-dimensional gustiness supplied from "//& "an input file", default=.false.) call get_param(param_file, mdl, "GUST_CONST", CS%gust_const, & "The background gustiness in the winds.", units="Pa", & default=0.02) if (CS%read_gust_2d) then call get_param(param_file, mdl, "GUST_2D_FILE", gust_file, & - "The file in which the wind gustiness is found in \n"//& + "The file in which the wind gustiness is found in "//& "variable gustiness.") call safe_alloc_ptr(CS%gust,isd,ied,jsd,jed) @@ -1256,31 +1256,31 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, restore_salt, ! 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, & - "If true, sea-ice is rigid enough to exert a \n"//& + "If true, sea-ice is rigid enough to exert a "//& "nonhydrostatic pressure that resist vertical motion.", & default=.false.) if (CS%rigid_sea_ice) then call get_param(param_file, mdl, "SEA_ICE_MEAN_DENSITY", CS%density_sea_ice, & - "A typical density of sea ice, used with the kinematic \n"//& + "A typical density of sea ice, used with the kinematic "//& "viscosity, when USE_RIGID_SEA_ICE is true.", units="kg m-3", & default=900.0) call get_param(param_file, mdl, "SEA_ICE_VISCOSITY", CS%Kv_sea_ice, & - "The kinematic viscosity of sufficiently thick sea ice \n"//& + "The kinematic viscosity of sufficiently thick sea ice "//& "for use in calculating the rigidity of sea ice.", & units="m2 s-1", default=1.0e9) call get_param(param_file, mdl, "SEA_ICE_RIGID_MASS", CS%rigid_sea_ice_mass, & - "The mass of sea-ice per unit area at which the sea-ice \n"//& + "The mass of sea-ice per unit area at which the sea-ice "//& "starts to exhibit rigidity", units="kg m-2", default=1000.0) endif call get_param(param_file, mdl, "ALLOW_ICEBERG_FLUX_DIAGNOSTICS", iceberg_flux_diags, & - "If true, makes available diagnostics of fluxes from icebergs\n"//& + "If true, makes available diagnostics of fluxes from icebergs "//& "as seen by MOM6.", default=.false.) call register_forcing_type_diags(Time, diag, US, CS%use_temperature, CS%handles, & use_berg_fluxes=iceberg_flux_diags) call get_param(param_file, mdl, "ALLOW_FLUX_ADJUSTMENTS", CS%allow_flux_adjustments, & - "If true, allows flux adjustments to specified via the \n"//& + "If true, allows flux adjustments to specified via the "//& "data_table using the component name 'OCN'.", default=.false.) if (CS%allow_flux_adjustments) then call data_override_init(Ocean_domain_in=G%Domain%mpp_domain) diff --git a/config_src/mct_driver/ocn_comp_mct.F90 b/config_src/mct_driver/ocn_comp_mct.F90 index 5ce89fc9f7..5698335b6f 100644 --- a/config_src/mct_driver/ocn_comp_mct.F90 +++ b/config_src/mct_driver/ocn_comp_mct.F90 @@ -259,19 +259,19 @@ subroutine ocn_init_mct( EClock, cdata_o, x2o_o, o2x_o, NLFilename ) if (glb%sw_decomp) then call get_param(param_file, mdl, "SW_c1", glb%c1, & - "Coeff. used to convert net shortwave rad. into \n"//& + "Coeff. used to convert net shortwave rad. into "//& "visible, direct shortwave.", units="nondim", default=0.285) call get_param(param_file, mdl, "SW_c2", glb%c2, & - "Coeff. used to convert net shortwave rad. into \n"//& + "Coeff. used to convert net shortwave rad. into "//& "visible, diffuse shortwave.", units="nondim", default=0.285) call get_param(param_file, mdl, "SW_c3", glb%c3, & - "Coeff. used to convert net shortwave rad. into \n"//& + "Coeff. used to convert net shortwave rad. into "//& "near-IR, direct shortwave.", units="nondim", default=0.215) call get_param(param_file, mdl, "SW_c4", glb%c4, & - "Coeff. used to convert net shortwave rad. into \n"//& + "Coeff. used to convert net shortwave rad. into "//& "near-IR, diffuse shortwave.", units="nondim", default=0.215) else glb%c1 = 0.0; glb%c2 = 0.0; glb%c3 = 0.0; glb%c4 = 0.0 diff --git a/config_src/nuopc_driver/MOM_ocean_model.F90 b/config_src/nuopc_driver/MOM_ocean_model.F90 index 9889887b04..abe583ffcc 100644 --- a/config_src/nuopc_driver/MOM_ocean_model.F90 +++ b/config_src/nuopc_driver/MOM_ocean_model.F90 @@ -286,41 +286,41 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, gas_fields_ocn, i call log_version(param_file, mdl, version, "") call get_param(param_file, mdl, "SINGLE_STEPPING_CALL", OS%single_step_call, & - "If true, advance the state of MOM with a single step \n"//& - "including both dynamics and thermodynamics. If false, \n"//& + "If true, advance the state of MOM with a single step "//& + "including both dynamics and thermodynamics. If false, "//& "the two phases are advanced with separate calls.", default=.true.) call get_param(param_file, mdl, "DT", OS%dt, & - "The (baroclinic) dynamics time step. The time-step that \n"//& - "is actually used will be an integer fraction of the \n"//& + "The (baroclinic) dynamics time step. The time-step that "//& + "is actually used will be an integer fraction of the "//& "forcing time-step.", units="s", fail_if_missing=.true.) call get_param(param_file, mdl, "DT_THERM", OS%dt_therm, & - "The thermodynamic and tracer advection time step. \n"//& - "Ideally DT_THERM should be an integer multiple of DT \n"//& - "and less than the forcing or coupling time-step, unless \n"//& - "THERMO_SPANS_COUPLING is true, in which case DT_THERM \n"//& - "can be an integer multiple of the coupling timestep. By \n"//& + "The thermodynamic and tracer advection time step. "//& + "Ideally DT_THERM should be an integer multiple of DT "//& + "and less than the forcing or coupling time-step, unless "//& + "THERMO_SPANS_COUPLING is true, in which case DT_THERM "//& + "can be an integer multiple of the coupling timestep. By "//& "default DT_THERM is set to DT.", units="s", default=OS%dt) call get_param(param_file, "MOM", "THERMO_SPANS_COUPLING", OS%thermo_spans_coupling, & - "If true, the MOM will take thermodynamic and tracer \n"//& - "timesteps that can be longer than the coupling timestep. \n"//& - "The actual thermodynamic timestep that is used in this \n"//& - "case is the largest integer multiple of the coupling \n"//& + "If true, the MOM will take thermodynamic and tracer "//& + "timesteps that can be longer than the coupling timestep. "//& + "The actual thermodynamic timestep that is used in this "//& + "case is the largest integer multiple of the coupling "//& "timestep that is less than or equal to DT_THERM.", default=.false.) call get_param(param_file, mdl, "DIABATIC_FIRST", OS%diabatic_first, & - "If true, apply diabatic and thermodynamic processes, \n"//& - "including buoyancy forcing and mass gain or loss, \n"//& + "If true, apply diabatic and thermodynamic processes, "//& + "including buoyancy forcing and mass gain or loss, "//& "before stepping the dynamics forward.", default=.false.) call get_param(param_file, mdl, "RESTART_CONTROL", OS%Restart_control, & - "An integer whose bits encode which restart files are \n"//& - "written. Add 2 (bit 1) for a time-stamped file, and odd \n"//& - "(bit 0) for a non-time-stamped file. A restart file \n"//& - "will be saved at the end of the run segment for any \n"//& + "An integer whose bits encode which restart files are "//& + "written. Add 2 (bit 1) for a time-stamped file, and odd "//& + "(bit 0) for a non-time-stamped file. A restart file "//& + "will be saved at the end of the run segment for any "//& "non-negative value.", default=1) call get_param(param_file, mdl, "OCEAN_SURFACE_STAGGER", stagger, & - "A case-insensitive character string to indicate the \n"//& - "staggering of the surface velocity field that is \n"//& - "returned to the coupler. Valid values include \n"//& + "A case-insensitive character string to indicate the "//& + "staggering of the surface velocity field that is "//& + "returned to the coupler. Valid values include "//& "'A', 'B', or 'C'.", default="C") if (uppercase(stagger(1:1)) == 'A') then ; Ocean_sfc%stagger = AGRID elseif (uppercase(stagger(1:1)) == 'B') then ; Ocean_sfc%stagger = BGRID_NE @@ -329,17 +329,17 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, gas_fields_ocn, i trim(stagger)//" is invalid.") ; endif call get_param(param_file, mdl, "RESTORE_SALINITY",OS%restore_salinity, & - "If true, the coupled driver will add a globally-balanced \n"//& - "fresh-water flux that drives sea-surface salinity \n"//& + "If true, the coupled driver will add a globally-balanced "//& + "fresh-water flux that drives sea-surface salinity "//& "toward specified values.", default=.false.) call get_param(param_file, mdl, "RESTORE_TEMPERATURE",OS%restore_temp, & - "If true, the coupled driver will add a \n"//& - "heat flux that drives sea-surface temperauture \n"//& + "If true, the coupled driver will add a "//& + "heat flux that drives sea-surface temperature "//& "toward specified values.", default=.false.) call get_param(param_file, mdl, "RHO_0", Rho0, & - "The mean ocean density used with BOUSSINESQ true to \n"//& - "calculate accelerations and the mass for conservation \n"//& - "properties, or with BOUSSINSEQ false to convert some \n"//& + "The mean ocean density used with BOUSSINESQ true to "//& + "calculate accelerations and the mass for conservation "//& + "properties, or with BOUSSINSEQ false to convert some "//& "parameters from vertical units of m to kg m-2.", & units="kg m-3", default=1035.0) call get_param(param_file, mdl, "G_EARTH", G_Earth, & @@ -355,9 +355,9 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, gas_fields_ocn, i OS%press_to_z = 1.0/(Rho0*G_Earth) call get_param(param_file, mdl, "HFREEZE", HFrz, & - "If HFREEZE > 0, melt potential will be computed. The actual depth \n"//& - "over which melt potential is computed will be min(HFREEZE, OBLD), \n"//& - "where OBLD is the boundary layer depth. If HFREEZE <= 0 (default), \n"//& + "If HFREEZE > 0, melt potential will be computed. The actual depth "//& + "over which melt potential is computed will be min(HFREEZE, OBLD), "//& + "where OBLD is the boundary layer depth. If HFREEZE <= 0 (default), "//& "melt potential will not be computed.", units="m", default=-1.0, do_not_log=.true.) if (HFrz .gt. 0.0) then diff --git a/config_src/nuopc_driver/MOM_surface_forcing.F90 b/config_src/nuopc_driver/MOM_surface_forcing.F90 index 78b3da0c1a..19353bcb7f 100644 --- a/config_src/nuopc_driver/MOM_surface_forcing.F90 +++ b/config_src/nuopc_driver/MOM_surface_forcing.F90 @@ -704,8 +704,6 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, US, CS) wind_stagger = CS%wind_stagger #endif - if ((IOB%wind_stagger == AGRID) .or. (IOB%wind_stagger == BGRID_NE) .or. & - (IOB%wind_stagger == CGRID_NE)) wind_stagger = IOB%wind_stagger if (wind_stagger == BGRID_NE) then ! This is necessary to fill in the halo points. taux_at_q(:,:) = 0.0 ; tauy_at_q(:,:) = 0.0 @@ -1058,12 +1056,12 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, restore_salt, default=".") CS%inputdir = slasher(CS%inputdir) call get_param(param_file, mdl, "ENABLE_THERMODYNAMICS", CS%use_temperature, & - "If true, Temperature and salinity are used as state \n"//& + "If true, Temperature and salinity are used as state "//& "variables.", default=.true.) call get_param(param_file, mdl, "RHO_0", CS%Rho0, & - "The mean ocean density used with BOUSSINESQ true to \n"//& - "calculate accelerations and the mass for conservation \n"//& - "properties, or with BOUSSINSEQ false to convert some \n"//& + "The mean ocean density used with BOUSSINESQ true to "//& + "calculate accelerations and the mass for conservation "//& + "properties, or with BOUSSINSEQ false to convert some "//& "parameters from vertical units of m to kg m-2.", & units="kg m-3", default=1035.0) call get_param(param_file, mdl, "LATENT_HEAT_FUSION", CS%latent_heat_fusion, & @@ -1071,51 +1069,51 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, restore_salt, call get_param(param_file, mdl, "LATENT_HEAT_VAPORIZATION", CS%latent_heat_vapor, & "The latent heat of fusion.", units="J/kg", default=hlv) call get_param(param_file, mdl, "MAX_P_SURF", CS%max_p_surf, & - "The maximum surface pressure that can be exerted by the \n"//& - "atmosphere and floating sea-ice or ice shelves. This is \n"//& - "needed because the FMS coupling structure does not \n"//& - "limit the water that can be frozen out of the ocean and \n"//& - "the ice-ocean heat fluxes are treated explicitly. No \n"//& + "The maximum surface pressure that can be exerted by the "//& + "atmosphere and floating sea-ice or ice shelves. 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. No "//& "limit is applied if a negative value is used.", units="Pa", & default=-1.0) call get_param(param_file, mdl, "ADJUST_NET_SRESTORE_TO_ZERO", & CS%adjust_net_srestore_to_zero, & - "If true, adjusts the salinity restoring seen to zero\n"//& + "If true, adjusts the salinity restoring seen to zero "//& "whether restoring is via a salt flux or virtual precip.",& default=restore_salt) call get_param(param_file, mdl, "ADJUST_NET_SRESTORE_BY_SCALING", & CS%adjust_net_srestore_by_scaling, & - "If true, adjustments to salt restoring to achieve zero net are\n"//& + "If true, adjustments to salt restoring to achieve zero net are "//& "made by scaling values without moving the zero contour.",& default=.false.) call get_param(param_file, mdl, "ADJUST_NET_FRESH_WATER_TO_ZERO", & CS%adjust_net_fresh_water_to_zero, & - "If true, adjusts the net fresh-water forcing seen \n"//& + "If true, adjusts the net fresh-water forcing seen "//& "by the ocean (including restoring) to zero.", default=.false.) if (CS%adjust_net_fresh_water_to_zero) & call get_param(param_file, mdl, "USE_NET_FW_ADJUSTMENT_SIGN_BUG", & CS%use_net_FW_adjustment_sign_bug, & - "If true, use the wrong sign for the adjustment to\n"//& + "If true, use the wrong sign for the adjustment to "//& "the net fresh-water.", default=.false.) call get_param(param_file, mdl, "ADJUST_NET_FRESH_WATER_BY_SCALING", & CS%adjust_net_fresh_water_by_scaling, & - "If true, adjustments to net fresh water to achieve zero net are\n"//& + "If true, adjustments to net fresh water to achieve zero net are "//& "made by scaling values without moving the zero contour.",& default=.false.) call get_param(param_file, mdl, "ICE_SALT_CONCENTRATION", & CS%ice_salt_concentration, & - "The assumed sea-ice salinity needed to reverse engineer the \n"//& + "The assumed sea-ice salinity needed to reverse engineer the "//& "melt flux (or ice-ocean fresh-water flux).", & units="kg/kg", default=0.005) call get_param(param_file, mdl, "USE_LIMITED_PATM_SSH", CS%use_limited_P_SSH, & - "If true, return the sea surface height with the \n"//& - "correction for the atmospheric (and sea-ice) pressure \n"//& - "limited by max_p_surf instead of the full atmospheric \n"//& + "If true, return the sea surface height with the "//& + "correction for the atmospheric (and sea-ice) pressure "//& + "limited by max_p_surf instead of the full atmospheric "//& "pressure.", default=.true.) call get_param(param_file, mdl, "WIND_STAGGER", stagger, & - "A case-insensitive character string to indicate the \n"//& - "staggering of the input wind stress field. Valid \n"//& + "A case-insensitive character string to indicate the "//& + "staggering of the input wind stress field. Valid "//& "values are 'A', 'B', or 'C'.", default="C") if (uppercase(stagger(1:1)) == 'A') then ; CS%wind_stagger = AGRID elseif (uppercase(stagger(1:1)) == 'B') then ; CS%wind_stagger = BGRID_NE @@ -1123,14 +1121,14 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, restore_salt, else ; call MOM_error(FATAL,"surface_forcing_init: WIND_STAGGER = "// & trim(stagger)//" is invalid.") ; endif call get_param(param_file, mdl, "WIND_STRESS_MULTIPLIER", CS%wind_stress_multiplier, & - "A factor multiplying the wind-stress given to the ocean by the\n"//& - "coupler. This is used for testing and should be =1.0 for any\n"//& + "A factor multiplying the wind-stress given to the ocean by the "//& + "coupler. This is used for testing and should be =1.0 for any "//& "production runs.", default=1.0) if (restore_salt) then call get_param(param_file, mdl, "FLUXCONST", CS%Flux_const, & - "The constant that relates the restoring surface fluxes \n"//& - "to the relative surface anomalies (akin to a piston \n"//& + "The constant that relates the restoring surface fluxes "//& + "to the relative surface anomalies (akin to a piston "//& "velocity). Note the non-MKS units.", units="m day-1", & fail_if_missing=.true.) call get_param(param_file, mdl, "SALT_RESTORE_FILE", CS%salt_restore_file, & @@ -1144,19 +1142,19 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, restore_salt, CS%Flux_const = CS%Flux_const / 86400.0 call get_param(param_file, mdl, "SRESTORE_AS_SFLUX", CS%salt_restore_as_sflux, & - "If true, the restoring of salinity is applied as a salt \n"//& + "If true, the restoring of salinity is applied as a salt "//& "flux instead of as a freshwater flux.", default=.false.) call get_param(param_file, mdl, "MAX_DELTA_SRESTORE", CS%max_delta_srestore, & "The maximum salinity difference used in restoring terms.", & units="PSU or g kg-1", default=999.0) call get_param(param_file, mdl, "MASK_SRESTORE_UNDER_ICE", & CS%mask_srestore_under_ice, & - "If true, disables SSS restoring under sea-ice based on a frazil\n"//& + "If true, disables SSS restoring under sea-ice based on a frazil "//& "criteria (SST<=Tf). Only used when RESTORE_SALINITY is True.", & default=.false.) call get_param(param_file, mdl, "MASK_SRESTORE_MARGINAL_SEAS", & CS%mask_srestore_marginal_seas, & - "If true, disable SSS restoring in marginal seas. Only used when\n"//& + "If true, disable SSS restoring in marginal seas. Only used when "//& "RESTORE_SALINITY is True.", default=.false.) call get_param(param_file, mdl, "BASIN_FILE", basin_file, & "A file in which to find the basin masks, in variable 'basin'.", & @@ -1171,14 +1169,14 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, restore_salt, enddo ; enddo endif call get_param(param_file, mdl, "MASK_SRESTORE", CS%mask_srestore, & - "If true, read a file (salt_restore_mask) containing \n"//& + "If true, read a file (salt_restore_mask) containing "//& "a mask for SSS restoring.", default=.false.) endif if (restore_temp) then call get_param(param_file, mdl, "FLUXCONST", CS%Flux_const, & - "The constant that relates the restoring surface fluxes \n"//& - "to the relative surface anomalies (akin to a piston \n"//& + "The constant that relates the restoring surface fluxes "//& + "to the relative surface anomalies (akin to a piston "//& "velocity). Note the non-MKS units.", units="m day-1", & fail_if_missing=.true.) call get_param(param_file, mdl, "SST_RESTORE_FILE", CS%temp_restore_file, & @@ -1195,7 +1193,7 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, restore_salt, "The maximum sst difference used in restoring terms.", & units="degC ", default=999.0) call get_param(param_file, mdl, "MASK_TRESTORE", CS%mask_trestore, & - "If true, read a file (temp_restore_mask) containing \n"//& + "If true, read a file (temp_restore_mask) containing "//& "a mask for SST restoring.", default=.false.) endif @@ -1208,11 +1206,11 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, restore_salt, "The drag coefficient that applies to the tides.", & units="nondim", default=1.0e-4) call get_param(param_file, mdl, "READ_TIDEAMP", CS%read_TIDEAMP, & - "If true, read a file (given by TIDEAMP_FILE) containing \n"//& + "If true, read a file (given by TIDEAMP_FILE) containing "//& "the tidal amplitude with INT_TIDE_DISSIPATION.", default=.false.) if (CS%read_TIDEAMP) then call get_param(param_file, mdl, "TIDEAMP_FILE", TideAmp_file, & - "The path to the file containing the spatially varying \n"//& + "The path to the file containing the spatially varying "//& "tidal amplitudes with INT_TIDE_DISSIPATION.", & default="tideamp.nc") CS%utide=0.0 @@ -1247,14 +1245,14 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, restore_salt, ! constant. call get_param(param_file, mdl, "READ_GUST_2D", CS%read_gust_2d, & - "If true, use a 2-dimensional gustiness supplied from \n"//& + "If true, use a 2-dimensional gustiness supplied from "//& "an input file", default=.false.) call get_param(param_file, mdl, "GUST_CONST", CS%gust_const, & "The background gustiness in the winds.", units="Pa", & default=0.02) if (CS%read_gust_2d) then call get_param(param_file, mdl, "GUST_2D_FILE", gust_file, & - "The file in which the wind gustiness is found in \n"//& + "The file in which the wind gustiness is found in "//& "variable gustiness.") call safe_alloc_ptr(CS%gust,isd,ied,jsd,jed) @@ -1264,31 +1262,31 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, restore_salt, ! 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, & - "If true, sea-ice is rigid enough to exert a \n"//& + "If true, sea-ice is rigid enough to exert a "//& "nonhydrostatic pressure that resist vertical motion.", & default=.false.) if (CS%rigid_sea_ice) then call get_param(param_file, mdl, "SEA_ICE_MEAN_DENSITY", CS%density_sea_ice, & - "A typical density of sea ice, used with the kinematic \n"//& + "A typical density of sea ice, used with the kinematic "//& "viscosity, when USE_RIGID_SEA_ICE is true.", units="kg m-3", & default=900.0) call get_param(param_file, mdl, "SEA_ICE_VISCOSITY", CS%Kv_sea_ice, & - "The kinematic viscosity of sufficiently thick sea ice \n"//& + "The kinematic viscosity of sufficiently thick sea ice "//& "for use in calculating the rigidity of sea ice.", & units="m2 s-1", default=1.0e9) call get_param(param_file, mdl, "SEA_ICE_RIGID_MASS", CS%rigid_sea_ice_mass, & - "The mass of sea-ice per unit area at which the sea-ice \n"//& + "The mass of sea-ice per unit area at which the sea-ice "//& "starts to exhibit rigidity", units="kg m-2", default=1000.0) endif call get_param(param_file, mdl, "ALLOW_ICEBERG_FLUX_DIAGNOSTICS", iceberg_flux_diags, & - "If true, makes available diagnostics of fluxes from icebergs\n"//& + "If true, makes available diagnostics of fluxes from icebergs "//& "as seen by MOM6.", default=.false.) call register_forcing_type_diags(Time, diag, US, CS%use_temperature, CS%handles, & use_berg_fluxes=iceberg_flux_diags) call get_param(param_file, mdl, "ALLOW_FLUX_ADJUSTMENTS", CS%allow_flux_adjustments, & - "If true, allows flux adjustments to specified via the \n"//& + "If true, allows flux adjustments to specified via the "//& "data_table using the component name 'OCN'.", default=.false.) if (CS%allow_flux_adjustments) then call data_override_init(Ocean_domain_in=G%Domain%mpp_domain) From 3995037e68cfeb2164c2ecff67ff291bf3165328 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Sun, 14 Jul 2019 15:24:22 -0600 Subject: [PATCH 104/150] more updates to have caps consistent with dev/ncar --- config_src/mct_driver/MOM_surface_forcing.F90 | 11 ----------- config_src/nuopc_driver/MOM_surface_forcing.F90 | 11 ----------- 2 files changed, 22 deletions(-) diff --git a/config_src/mct_driver/MOM_surface_forcing.F90 b/config_src/mct_driver/MOM_surface_forcing.F90 index 47e676a3d3..38041a8a65 100644 --- a/config_src/mct_driver/MOM_surface_forcing.F90 +++ b/config_src/mct_driver/MOM_surface_forcing.F90 @@ -505,17 +505,6 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, Time, G, US, CS, & net_FW(i,j) = (((fluxes%lprec(i,j) + fluxes%fprec(i,j) + fluxes%seaice_melt(i,j)) + & (fluxes%lrunoff(i,j) + fluxes%frunoff(i,j))) + & (fluxes%evap(i,j) + fluxes%vprec(i,j)) ) * G%areaT(i,j) - ! The following contribution appears to be calculating the volume flux of sea-ice - ! melt. This calculation is clearly WRONG if either sea-ice has variable - ! salinity or the sea-ice is completely fresh. - ! Bob thinks this is trying ensure the net fresh-water of the ocean + sea-ice system - ! is constant. - ! To do this correctly we will need a sea-ice melt field added to IOB. -AJA - ! GMM: as stated above, the following is wrong. CIME deals with volume/mass and - ! heat from sea ice/snow via seaice_melt and seaice_melt_heat, respectively. - if (associated(fluxes%salt_flux) .and. (CS%ice_salt_concentration>0.0)) & - net_FW(i,j) = net_FW(i,j) + G%areaT(i,j) * & - (fluxes%salt_flux(i,j) / CS%ice_salt_concentration) net_FW2(i,j) = net_FW(i,j)/G%areaT(i,j) enddo; enddo diff --git a/config_src/nuopc_driver/MOM_surface_forcing.F90 b/config_src/nuopc_driver/MOM_surface_forcing.F90 index 19353bcb7f..da7956feeb 100644 --- a/config_src/nuopc_driver/MOM_surface_forcing.F90 +++ b/config_src/nuopc_driver/MOM_surface_forcing.F90 @@ -544,17 +544,6 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, US, CS, & (fluxes%lrunoff(i,j) + fluxes%frunoff(i,j))) + & (fluxes%evap(i,j) + fluxes%vprec(i,j)) ) * G%areaT(i,j) - ! The following contribution appears to be calculating the volume flux of sea-ice - ! melt. This calculation is clearly WRONG if either sea-ice has variable - ! salinity or the sea-ice is completely fresh. - ! Bob thinks this is trying ensure the net fresh-water of the ocean + sea-ice system - ! is constant. - ! To do this correctly we will need a sea-ice melt field added to IOB. -AJA - ! GMM: as stated above, the following is wrong. CIME deals with volume/mass and - ! heat from sea ice/snow via seaice_melt and seaice_melt_heat, respectively. - if (associated(IOB%salt_flux) .and. (CS%ice_salt_concentration>0.0)) & - net_FW(i,j) = net_FW(i,j) + sign_for_net_FW_bug * G%areaT(i,j) * & - (IOB%salt_flux(i-i0,j-j0) / CS%ice_salt_concentration) net_FW2(i,j) = net_FW(i,j) / G%areaT(i,j) enddo ; enddo From 891b8366d164f43812990acece1bf41aa3051d0b Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Mon, 15 Jul 2019 04:31:03 -0400 Subject: [PATCH 105/150] (+*)Added KELVIN_WAVE_2018_ANSWERS runtime parameter Added a new runtime paramter, KELVIN_WAVE_2018_ANSWERS, to select code that changes to expressions that are rotationally symmetric and avoids problems that could arise from spatially varying coefficients that are not being recalculated within apatial loops. By default all answers are bitwise identical, but the MOM_parameter_doc files have a new entry if USE_KELVIN_WAVE_OBC is true. --- src/user/Kelvin_initialization.F90 | 84 ++++++++++++++++++------------ 1 file changed, 50 insertions(+), 34 deletions(-) diff --git a/src/user/Kelvin_initialization.F90 b/src/user/Kelvin_initialization.F90 index 7df6390c10..7540347dc1 100644 --- a/src/user/Kelvin_initialization.F90 +++ b/src/user/Kelvin_initialization.F90 @@ -42,6 +42,9 @@ module Kelvin_initialization real :: F_0 !< Coriolis parameter real :: rho_range !< Density range real :: rho_0 !< Mean density + logical :: answers_2018 !< If true, use the order of arithmetic and expressions that recover the + !! answers from the end of 2018. Otherwise, use expressions that give + !! rotational symmetry and eliminate apparent bugs. end type Kelvin_OBC_CS ! This include declares and sets the variable "version". @@ -54,7 +57,10 @@ function register_Kelvin_OBC(param_file, CS, OBC_Reg) type(param_file_type), intent(in) :: param_file !< parameter file. type(Kelvin_OBC_CS), pointer :: CS !< Kelvin wave control structure. type(OBC_registry_type), pointer :: OBC_Reg !< OBC registry. - logical :: register_Kelvin_OBC + + ! Local variables + logical :: register_Kelvin_OBC + logical :: default_2018_answers character(len=40) :: mdl = "register_Kelvin_OBC" !< This subroutine's name. character(len=32) :: casename = "Kelvin wave" !< This case's name. character(len=200) :: config @@ -89,6 +95,13 @@ function register_Kelvin_OBC(param_file, CS, OBC_Reg) CS%coast_offset1 = CS%coast_offset1 * 1.e3 ! Convert to m CS%coast_offset2 = CS%coast_offset2 * 1.e3 ! Convert to m 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, "KELVIN_WAVE_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 that give rotational "//& + "symmetry and eliminate apparent bugs.", default=default_2018_answers) if (CS%mode /= 0) then call get_param(param_file, mdl, "DENSITY_RANGE", CS%rho_range, & default=2.0, do_not_log=.true.) @@ -207,7 +220,7 @@ subroutine Kelvin_set_OBC_data(OBC, CS, G, GV, US, h, Time) omega = 2.0 * PI / (12.42 * 3600.0) ! M2 Tide period val1 = US%m_to_Z * sin(omega * time_sec) else - N0 = sqrt((CS%rho_range / CS%rho_0) * GV%g_Earth * (US%m_to_Z * CS%H0)) + N0 = US%L_to_m*US%s_to_T * sqrt((CS%rho_range / CS%rho_0) * GV%LZT_g_Earth * (US%m_to_Z * CS%H0)) ! Two wavelengths in domain plx = 4.0 * PI / G%len_lon pmz = PI * CS%mode / CS%H0 @@ -240,11 +253,11 @@ subroutine Kelvin_set_OBC_data(OBC, CS, G, GV, US, h, Time) x = (x1 - CS%coast_offset1) * cosa + y1 * sina y = - (x1 - CS%coast_offset1) * sina + y1 * cosa if (CS%mode == 0) then - cff = sqrt(GV%g_Earth * 0.5 * (G%bathyT(i+1,j) + G%bathyT(i,j))) - val2 = fac * exp(- CS%F_0 * y / cff) + cff = sqrt(GV%LZT_g_Earth * 0.5 * (G%bathyT(i+1,j) + G%bathyT(i,j))) + val2 = fac * exp(- US%T_to_s*CS%F_0 * US%m_to_L*y / cff) segment%eta(I,j) = val2 * cos(omega * time_sec) - segment%normal_vel_bt(I,j) = val1 * cff * cosa / & - (0.5 * (G%bathyT(i+1,j) + G%bathyT(i,j))) * val2 + segment%normal_vel_bt(I,j) = US%L_T_to_m_s * (val2 * (val1 * cff * cosa / & + (0.5 * (G%bathyT(i+1,j) + G%bathyT(i,j)))) ) else ! Not rotated yet segment%eta(I,j) = 0.0 @@ -272,18 +285,20 @@ subroutine Kelvin_set_OBC_data(OBC, CS, G, GV, US, h, Time) y1 = 1000. * G%geoLatBu(I,J) x = (x1 - CS%coast_offset1) * cosa + y1 * sina y = - (x1 - CS%coast_offset1) * sina + y1 * cosa - !### Problem: val2 & cff could be a functions of space, but are not set in this loop. - !### Problem: Is val2 in the numerator or denominator below? - if (CS%mode == 0) then - do k=1,nz - segment%tangential_vel(I,J,k) = val1 * cff * sina / & - (0.25 * (G%bathyT(i+1,j) + G%bathyT(i,j) + & - G%bathyT(i+1,j+1) + G%bathyT(i,j+1))) * val2 -!### For rotational symmetry, this should be: -! segment%tangential_vel(I,J,k) = val1 * cff * sina / & -! ( 0.25*((G%bathyT(i,j) + G%bathyT(i+1,j+1)) +& -! (G%bathyT(i+1,j) + G%bathyT(i,j+1))) ) * val2 - enddo + if (CS%answers_2018) then + ! Problem: val2 & cff could be functions of space, but are not set in this loop. + if (CS%mode == 0) then ; do k=1,nz + segment%tangential_vel(I,J,k) = US%L_T_to_m_s * (val2 * (val1 * cff * sina / & + (0.25 * (G%bathyT(i+1,j) + G%bathyT(i,j) + G%bathyT(i+1,j+1) + G%bathyT(i,j+1))) )) + enddo ; endif + else + cff =sqrt(GV%LZT_g_Earth * 0.5 * (G%bathyT(i+1,j) + G%bathyT(i,j))) + val2 = fac * exp(- US%T_to_s*CS%F_0 * US%m_to_L*y / cff) + if (CS%mode == 0) then ; do k=1,nz + segment%tangential_vel(I,J,k) = US%L_T_to_m_s * (val1 * val2 * cff * sina) / & + ( 0.25*((G%bathyT(i,j) + G%bathyT(i+1,j+1)) + (G%bathyT(i+1,j) + G%bathyT(i,j+1))) ) + + enddo ; endif endif enddo ; enddo endif @@ -296,11 +311,11 @@ subroutine Kelvin_set_OBC_data(OBC, CS, G, GV, US, h, Time) x = (x1 - CS%coast_offset1) * cosa + y1 * sina y = - (x1 - CS%coast_offset1) * sina + y1 * cosa if (CS%mode == 0) then - cff = sqrt(GV%g_Earth * 0.5 * (G%bathyT(i,j+1) + G%bathyT(i,j))) - val2 = fac * exp(- 0.5 * US%s_to_T * (G%CoriolisBu(I,J) + G%CoriolisBu(I-1,J)) * y / cff) + cff = sqrt(GV%LZT_g_Earth * 0.5 * (G%bathyT(i,j+1) + G%bathyT(i,j))) + val2 = fac * exp(- 0.5 * (G%CoriolisBu(I,J) + G%CoriolisBu(I-1,J)) * US%m_to_L*y / cff) segment%eta(I,j) = val2 * cos(omega * time_sec) - segment%normal_vel_bt(I,j) = val1 * cff * sina / & - (0.5*(G%bathyT(i+1,j) + G%bathyT(i,j))) * val2 + segment%normal_vel_bt(I,j) = US%L_T_to_m_s * (val1 * cff * sina / & + (0.5*(G%bathyT(i+1,j) + G%bathyT(i,j)))) * val2 else ! Not rotated yet segment%eta(i,J) = 0.0 @@ -326,18 +341,19 @@ subroutine Kelvin_set_OBC_data(OBC, CS, G, GV, US, h, Time) y1 = 1000. * G%geoLatBu(I,J) x = (x1 - CS%coast_offset1) * cosa + y1 * sina y = - (x1 - CS%coast_offset1) * sina + y1 * cosa - !### Problem: val2 & cff could be a functions of space, but are not set in this loop. - !### Problem: Is val2 in the numerator or denominator below? - if (CS%mode == 0) then - do k=1,nz - segment%tangential_vel(I,J,k) = val1 * cff * sina / & - (0.25*(G%bathyT(i+1,j) + G%bathyT(i,j) + & - G%bathyT(i+1,j+1) + G%bathyT(i,j+1))) * val2 -!### This should be: -! segment%tangential_vel(I,J,k) = val1 * cff * sina / & -! ( 0.25*((G%bathyT(i,j) + G%bathyT(i+1,j+1)) +& -! (G%bathyT(i+1,j) + G%bathyT(i,j+1))) ) * val2 - enddo + if (CS%answers_2018) then + ! Problem: val2 & cff could be functions of space, but are not set in this loop. + if (CS%mode == 0) then ; do k=1,nz + segment%tangential_vel(I,J,k) = US%L_T_to_m_s * (val2 * (val1 * cff * sina / & + (0.25*(G%bathyT(i+1,j) + G%bathyT(i,j) + G%bathyT(i+1,j+1) + G%bathyT(i,j+1))))) + enddo ; endif + else + cff = sqrt(GV%LZT_g_Earth * 0.5 * (G%bathyT(i,j+1) + G%bathyT(i,j))) + val2 = fac * exp(- 0.5 * (G%CoriolisBu(I,J) + G%CoriolisBu(I-1,J)) * US%m_to_L*y / cff) + if (CS%mode == 0) then ; do k=1,nz + segment%tangential_vel(I,J,k) = US%L_T_to_m_s * ((val1 * val2 * cff * sina) / & + ( 0.25*((G%bathyT(i,j) + G%bathyT(i+1,j+1)) + (G%bathyT(i+1,j) + G%bathyT(i,j+1))) )) + enddo ; endif endif enddo ; enddo endif From 4b67d3206980f998d7399f3acfe9c2c3e1ebe1b5 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Mon, 15 Jul 2019 04:43:25 -0400 Subject: [PATCH 106/150] Replaced GV%g_Earth with other variables Replaced GV%g_Earth with the fully dimensionally rescaled GV%LZT_g_Earth, the MKS variable GV%mks_g_Earth, or other combinations of variables, like GV%Z_to_H and GV%H_to_Pa, throughout the MOM6 code. All answes are bitwise identical. --- src/core/MOM_PressureForce_Montgomery.F90 | 10 +++++----- src/core/MOM_PressureForce_analytic_FV.F90 | 4 ++-- src/core/MOM_PressureForce_blocked_AFV.F90 | 4 ++-- src/core/MOM_interface_heights.F90 | 4 ++-- src/core/MOM_isopycnal_slopes.F90 | 2 +- src/diagnostics/MOM_diagnostics.F90 | 4 ++-- src/diagnostics/MOM_wave_speed.F90 | 8 ++++---- src/diagnostics/MOM_wave_structure.F90 | 4 ++-- src/initialization/MOM_state_initialization.F90 | 16 ++++++++-------- .../lateral/MOM_mixed_layer_restrat.F90 | 4 ++-- .../lateral/MOM_thickness_diffuse.F90 | 4 ++-- src/user/DOME_initialization.F90 | 10 +++++----- src/user/ISOMIP_initialization.F90 | 4 ++-- src/user/MOM_wave_interface.F90 | 12 ++++++------ src/user/Rossby_front_2d_initialization.F90 | 10 +++++----- 15 files changed, 50 insertions(+), 50 deletions(-) diff --git a/src/core/MOM_PressureForce_Montgomery.F90 b/src/core/MOM_PressureForce_Montgomery.F90 index 827fb77849..eb1812bbd6 100644 --- a/src/core/MOM_PressureForce_Montgomery.F90 +++ b/src/core/MOM_PressureForce_Montgomery.F90 @@ -147,7 +147,7 @@ subroutine PressureForce_Mont_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, pb "can no longer be used with a compressible EOS. Use #define ANALYTIC_FV_PGF.") endif - I_gEarth = 1.0 / GV%g_Earth + I_gEarth = 1.0 / (US%L_T_to_m_s**2 * GV%LZT_g_Earth) dp_neglect = GV%H_to_Pa * GV%H_subroundoff do k=1,nz ; alpha_Lay(k) = 1.0 / GV%Rlay(k) ; enddo do k=2,nz ; dalpha_int(K) = alpha_Lay(k-1) - alpha_Lay(k) ; enddo @@ -206,12 +206,12 @@ subroutine PressureForce_Mont_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, pb call calc_tidal_forcing(CS%Time, SSH, e_tidal, G, CS%tides_CSp, m_to_Z=US%m_to_Z) !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - geopot_bot(i,j) = -GV%g_Earth*(e_tidal(i,j) + G%bathyT(i,j)) + geopot_bot(i,j) = -US%L_T_to_m_s**2 * GV%LZT_g_Earth*(e_tidal(i,j) + G%bathyT(i,j)) enddo ; enddo else !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - geopot_bot(i,j) = -GV%g_Earth*G%bathyT(i,j) + geopot_bot(i,j) = -US%L_T_to_m_s**2 * GV%LZT_g_Earth*G%bathyT(i,j) enddo ; enddo endif @@ -435,7 +435,7 @@ subroutine PressureForce_Mont_Bouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, pbce, h_neglect = GV%H_subroundoff * GV%H_to_Z I_Rho0 = 1.0/CS%Rho0 - G_Rho0 = GV%g_Earth/GV%Rho0 + G_Rho0 = US%L_T_to_m_s**2 * GV%LZT_g_Earth/GV%Rho0 if (CS%tides) then ! Determine the surface height anomaly for calculating self attraction @@ -639,7 +639,7 @@ subroutine Set_pbce_Bouss(e, tv, G, GV, US, Rho0, GFS_scale, pbce, rho_star) Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB ; nz = G%ke - Rho0xG = Rho0*GV%g_Earth + Rho0xG = Rho0*US%L_T_to_m_s**2 * GV%LZT_g_Earth G_Rho0 = GV%LZT_g_Earth / GV%Rho0 use_EOS = associated(tv%eqn_of_state) z_neglect = GV%H_subroundoff*GV%H_to_Z diff --git a/src/core/MOM_PressureForce_analytic_FV.F90 b/src/core/MOM_PressureForce_analytic_FV.F90 index c7d3fae2f4..b6e6d049e7 100644 --- a/src/core/MOM_PressureForce_analytic_FV.F90 +++ b/src/core/MOM_PressureForce_analytic_FV.F90 @@ -195,7 +195,7 @@ subroutine PressureForce_AFV_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p dp_neglect = GV%H_to_Pa * GV%H_subroundoff alpha_ref = 1.0/CS%Rho0 - g_Earth_z = GV%g_Earth + g_Earth_z = US%L_T_to_m_s**2 * GV%LZT_g_Earth I_gEarth = 1.0 / g_Earth_z if (use_p_atm) then @@ -532,7 +532,7 @@ subroutine PressureForce_AFV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_at h_neglect = GV%H_subroundoff dz_neglect = GV%H_subroundoff * GV%H_to_Z I_Rho0 = 1.0/GV%Rho0 - g_Earth_z = GV%g_Earth + g_Earth_z = US%L_T_to_m_s**2 * GV%LZT_g_Earth G_Rho0 = g_Earth_z/GV%Rho0 rho_ref = CS%Rho0 diff --git a/src/core/MOM_PressureForce_blocked_AFV.F90 b/src/core/MOM_PressureForce_blocked_AFV.F90 index f866c70e13..5531736632 100644 --- a/src/core/MOM_PressureForce_blocked_AFV.F90 +++ b/src/core/MOM_PressureForce_blocked_AFV.F90 @@ -191,7 +191,7 @@ subroutine PressureForce_blk_AFV_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, dp_neglect = GV%H_to_Pa * GV%H_subroundoff alpha_ref = 1.0/CS%Rho0 - g_Earth_z = GV%g_Earth + g_Earth_z = US%L_T_to_m_s**2 * GV%LZT_g_Earth I_gEarth = 1.0 / g_Earth_z if (use_p_atm) then @@ -516,7 +516,7 @@ subroutine PressureForce_blk_AFV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, h_neglect = GV%H_subroundoff dz_neglect = GV%H_subroundoff * GV%H_to_Z I_Rho0 = 1.0/GV%Rho0 - g_Earth_z = GV%g_Earth + g_Earth_z = US%L_T_to_m_s**2 * GV%LZT_g_Earth G_Rho0 = g_Earth_z / GV%Rho0 rho_ref = CS%Rho0 diff --git a/src/core/MOM_interface_heights.F90 b/src/core/MOM_interface_heights.F90 index de0064932d..7d12f0b9e9 100644 --- a/src/core/MOM_interface_heights.F90 +++ b/src/core/MOM_interface_heights.F90 @@ -67,7 +67,7 @@ subroutine find_eta_3d(h, tv, G, GV, US, eta, eta_bt, halo_size, eta_to_m) Z_to_eta = 1.0 ; if (present(eta_to_m)) Z_to_eta = US%Z_to_m / eta_to_m H_to_eta = GV%H_to_Z * Z_to_eta H_to_rho_eta = GV%H_to_kg_m2 * (US%m_to_Z * Z_to_eta) - I_gEarth = Z_to_eta / GV%g_Earth + I_gEarth = Z_to_eta / (US%Z_to_m * GV%mks_g_Earth) !$OMP parallel default(shared) private(dilate,htot) !$OMP do @@ -174,7 +174,7 @@ subroutine find_eta_2d(h, tv, G, GV, US, eta, eta_bt, halo_size, eta_to_m) Z_to_eta = 1.0 ; if (present(eta_to_m)) Z_to_eta = US%Z_to_m / eta_to_m H_to_eta = GV%H_to_Z * Z_to_eta H_to_rho_eta = GV%H_to_kg_m2 * (US%m_to_Z * Z_to_eta) - I_gEarth = Z_to_eta / GV%g_Earth + I_gEarth = Z_to_eta / (US%Z_to_m * GV%mks_g_Earth) !$OMP parallel default(shared) private(htot) !$OMP do diff --git a/src/core/MOM_isopycnal_slopes.F90 b/src/core/MOM_isopycnal_slopes.F90 index 11975aa5dc..99032c317a 100644 --- a/src/core/MOM_isopycnal_slopes.F90 +++ b/src/core/MOM_isopycnal_slopes.F90 @@ -122,7 +122,7 @@ subroutine calc_isoneutral_slopes(G, GV, US, h, e, tv, dt_kappa_smooth, & present_N2_u = PRESENT(N2_u) present_N2_v = PRESENT(N2_v) - G_Rho0 = (GV%g_Earth*L_to_Z*US%m_to_Z) / GV%Rho0 + G_Rho0 = (US%L_to_Z*US%L_to_m*L_to_z*US%s_to_T**2*GV%LZT_g_Earth) / GV%Rho0 if (present_N2_u) then do j=js,je ; do I=is-1,ie N2_u(I,j,1) = 0. diff --git a/src/diagnostics/MOM_diagnostics.F90 b/src/diagnostics/MOM_diagnostics.F90 index 0f5553721b..f5ce456492 100644 --- a/src/diagnostics/MOM_diagnostics.F90 +++ b/src/diagnostics/MOM_diagnostics.F90 @@ -832,7 +832,7 @@ subroutine calculate_vertical_integrals(h, tv, p_surf, G, GV, US, CS) do j=js,je ; do i=is,ie ; mass(i,j) = 0.0 ; enddo ; enddo if (GV%Boussinesq) then if (associated(tv%eqn_of_state)) then - IG_Earth = 1.0 / (GV%g_Earth*US%m_to_Z) + IG_Earth = 1.0 / GV%mks_g_Earth ! do j=js,je ; do i=is,ie ; z_bot(i,j) = -P_SURF(i,j)/GV%H_to_Pa ; enddo ; enddo do j=js,je ; do i=is,ie ; z_bot(i,j) = 0.0 ; enddo ; enddo do k=1,nz @@ -841,7 +841,7 @@ subroutine calculate_vertical_integrals(h, tv, p_surf, G, GV, US, CS) z_bot(i,j) = z_top(i,j) - GV%H_to_Z*h(i,j,k) enddo ; enddo call int_density_dz(tv%T(:,:,k), tv%S(:,:,k), & - z_top, z_bot, 0.0, GV%Rho0, GV%g_Earth, & + z_top, z_bot, 0.0, GV%Rho0, GV%mks_g_Earth*US%Z_to_m, & G%HI, G%HI, tv%eqn_of_state, dpress) do j=js,je ; do i=is,ie mass(i,j) = mass(i,j) + dpress(i,j) * IG_Earth diff --git a/src/diagnostics/MOM_wave_speed.F90 b/src/diagnostics/MOM_wave_speed.F90 index 0c4b0386a4..35adc79753 100644 --- a/src/diagnostics/MOM_wave_speed.F90 +++ b/src/diagnostics/MOM_wave_speed.F90 @@ -132,8 +132,8 @@ subroutine wave_speed(h, tv, G, GV, US, cg1, CS, full_halos, use_ebt_mode, & endif S => tv%S ; T => tv%T - g_Rho0 = GV%g_Earth / GV%Rho0 - Z_to_Pa = GV%g_Earth * GV%Rho0 + g_Rho0 = US%L_T_to_m_s**2 * GV%LZT_g_Earth / GV%Rho0 + Z_to_Pa = GV%Z_to_H * GV%H_to_Pa use_EOS = associated(tv%eqn_of_state) rescale = 1024.0**4 ; I_rescale = 1.0/rescale @@ -599,9 +599,9 @@ subroutine wave_speeds(h, tv, G, GV, US, nmodes, cn, CS, full_halos) endif ; endif S => tv%S ; T => tv%T - g_Rho0 = GV%g_Earth / GV%Rho0 + g_Rho0 = US%L_T_to_m_s**2 * GV%LZT_g_Earth / GV%Rho0 use_EOS = associated(tv%eqn_of_state) - Z_to_Pa = GV%g_Earth * GV%Rho0 + Z_to_Pa = GV%Z_to_H * GV%H_to_Pa min_h_frac = tol1 / real(nz) !$OMP parallel do default(private) shared(is,ie,js,je,nz,h,G,GV,US,min_h_frac,use_EOS,T,S, & diff --git a/src/diagnostics/MOM_wave_structure.F90 b/src/diagnostics/MOM_wave_structure.F90 index c289c540f0..098569529c 100644 --- a/src/diagnostics/MOM_wave_structure.F90 +++ b/src/diagnostics/MOM_wave_structure.F90 @@ -178,10 +178,10 @@ subroutine wave_structure(h, tv, G, GV, US, cn, ModeNum, freq, CS, En, full_halo Pi = (4.0*atan(1.0)) S => tv%S ; T => tv%T - g_Rho0 = GV%g_Earth /GV%Rho0 + g_Rho0 = US%L_T_to_m_s**2 * GV%LZT_g_Earth /GV%Rho0 use_EOS = associated(tv%eqn_of_state) - H_to_pres = GV%g_Earth * GV%Rho0 + H_to_pres = GV%Z_to_H*GV%H_to_Pa rescale = 1024.0**4 ; I_rescale = 1.0/rescale min_h_frac = tol1 / real(nz) diff --git a/src/initialization/MOM_state_initialization.F90 b/src/initialization/MOM_state_initialization.F90 index aec93f0942..60d8c4b0d0 100644 --- a/src/initialization/MOM_state_initialization.F90 +++ b/src/initialization/MOM_state_initialization.F90 @@ -938,8 +938,8 @@ subroutine convert_thickness(h, G, GV, US, tv) Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB max_itt = 10 Boussinesq = GV%Boussinesq - I_gEarth = 1.0 / (GV%g_Earth*US%m_to_Z) - Hm_rho_to_Pa = GV%g_Earth * GV%H_to_Z ! = GV%H_to_Pa / GV%Rho0 + I_gEarth = 1.0 / (GV%mks_g_Earth) + Hm_rho_to_Pa = GV%mks_g_Earth * GV%H_to_m ! = GV%H_to_Pa / GV%Rho0 if (Boussinesq) then call MOM_error(FATAL,"Not yet converting thickness with Boussinesq approx.") @@ -980,7 +980,7 @@ subroutine convert_thickness(h, G, GV, US, tv) enddo else do k=1,nz ; do j=js,je ; do i=is,ie - h(i,j,k) = (h(i,j,k) * GV%Rlay(k)) * Hm_rho_to_Pa + h(i,j,k) = (h(i,j,k) * GV%Rlay(k)) * Hm_rho_to_Pa * GV%kg_m2_to_H**2 ! This is mathematically equivalent to ! h(i,j,k) = h(i,j,k) * (GV%Rlay(k) / GV%Rho0) enddo ; enddo ; enddo @@ -1141,7 +1141,7 @@ subroutine trim_for_ice(PF, G, GV, US, ALE_CSp, tv, h, just_read_params) endif do j=G%jsc,G%jec ; do i=G%isc,G%iec - call cut_off_column_top(GV%ke, tv, GV, GV%g_Earth, G%bathyT(i,j), & + call cut_off_column_top(GV%ke, tv, GV, GV%mks_g_Earth*US%Z_to_m, G%bathyT(i,j), & min_thickness, tv%T(i,j,:), T_t(i,j,:), T_b(i,j,:), & tv%S(i,j,:), S_t(i,j,:), S_b(i,j,:), p_surf(i,j), h(i,j,:), remap_CS, & z_tol=1.0e-5*US%m_to_Z) @@ -2389,15 +2389,15 @@ subroutine MOM_state_init_tests(G, GV, US, tv) S_t(k) = 35.-(0./500.)*e(k) S(k) = 35.+(0./500.)*z(k) S_b(k) = 35.-(0./500.)*e(k+1) - call calculate_density(0.5*(T_t(k)+T_b(k)), 0.5*(S_t(k)+S_b(k)), -GV%Rho0*(GV%g_Earth*US%m_to_Z)*z(k), & + call calculate_density(0.5*(T_t(k)+T_b(k)), 0.5*(S_t(k)+S_b(k)), -GV%Rho0*GV%mks_g_Earth*z(k), & rho(k), tv%eqn_of_state) - P_tot = P_tot + (GV%g_Earth*US%m_to_Z) * rho(k) * h(k) + P_tot = P_tot + GV%mks_g_Earth * rho(k) * h(k) enddo P_t = 0. do k = 1, nk call find_depth_of_pressure_in_cell(T_t(k), T_b(k), S_t(k), S_b(k), e(K), e(K+1), & - P_t, 0.5*P_tot, GV%Rho0, (GV%g_Earth*US%m_to_Z), tv%eqn_of_state, P_b, z_out) + P_t, 0.5*P_tot, GV%Rho0, GV%mks_g_Earth, tv%eqn_of_state, P_b, z_out) write(0,*) k,P_t,P_b,0.5*P_tot,e(K),e(K+1),z_out P_t = P_b enddo @@ -2407,7 +2407,7 @@ subroutine MOM_state_init_tests(G, GV, US, tv) write(0,*) ' ==================================================================== ' write(0,*) '' write(0,*) h - call cut_off_column_top(nk, tv, GV, (GV%g_Earth*US%m_to_Z), -e(nk+1), GV%Angstrom_H, & + call cut_off_column_top(nk, tv, GV, GV%mks_g_Earth, -e(nk+1), GV%Angstrom_H, & T, T_t, T_b, S, S_t, S_b, 0.5*P_tot, h, remap_CS) write(0,*) h diff --git a/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 b/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 index f763f562b0..ef92a56595 100644 --- a/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 +++ b/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 @@ -281,7 +281,7 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var uDml(:) = 0.0 ; vDml(:) = 0.0 uDml_slow(:) = 0.0 ; vDml_slow(:) = 0.0 I4dt = 0.25 / dt - g_Rho0 = GV%g_Earth / GV%Rho0 + g_Rho0 = GV%LZT_g_Earth*US%L_to_m**2*US%s_to_T**2 / GV%Rho0 h_neglect = GV%H_subroundoff dz_neglect = GV%H_subroundoff*GV%H_to_Z proper_averaging = .not. CS%MLE_use_MLD_ave_bug @@ -607,7 +607,7 @@ subroutine mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, dt, G, GV, US, CS) uDml(:) = 0.0 ; vDml(:) = 0.0 I4dt = 0.25 / dt - g_Rho0 = GV%g_Earth / GV%Rho0 + g_Rho0 = GV%LZT_g_Earth*US%L_to_m**2*US%s_to_T**2 / GV%Rho0 use_EOS = associated(tv%eqn_of_state) h_neglect = GV%H_subroundoff dz_neglect = GV%H_subroundoff*GV%H_to_Z diff --git a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 index 0c7dec69aa..16dc56f4f3 100644 --- a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 +++ b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 @@ -640,10 +640,10 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV I4dt = 0.25 / dt I_slope_max2 = 1.0 / (CS%slope_max**2) - G_scale = GV%g_Earth * GV%H_to_m + G_scale = GV%LZT_g_Earth*US%L_to_m**2*US%s_to_T**2 * GV%H_to_m h_neglect = GV%H_subroundoff ; h_neglect2 = h_neglect**2 dz_neglect = GV%H_subroundoff*GV%H_to_Z - G_rho0 = GV%g_Earth / GV%Rho0 + G_rho0 = GV%LZT_g_Earth*US%L_to_m**2*US%s_to_T**2 / GV%Rho0 N2_floor = CS%N2_floor*US%Z_to_m**2 use_EOS = associated(tv%eqn_of_state) diff --git a/src/user/DOME_initialization.F90 b/src/user/DOME_initialization.F90 index e3685ae16f..ce13e45b14 100644 --- a/src/user/DOME_initialization.F90 +++ b/src/user/DOME_initialization.F90 @@ -267,7 +267,7 @@ subroutine DOME_set_OBC_data(OBC, tv, G, GV, US, param_file, tr_Reg) real :: tr_0, y1, y2, tr_k, rst, rsb, rc, v_k, lon_im1 real :: D_edge ! The thickness [Z ~> m], of the dense fluid at the ! inner edge of the inflow. - real :: g_prime_tot ! The reduced gravity across all layers [m2 Z-1 s-2 ~> m s-2]. + real :: g_prime_tot ! The reduced gravity across all layers [L2 Z-1 T-2 ~> m s-2]. real :: Def_Rad ! The deformation radius, based on fluid of ! thickness D_edge, in the same units as lat. real :: Ri_trans ! The shear Richardson number in the transition @@ -290,9 +290,9 @@ subroutine DOME_set_OBC_data(OBC, tv, G, GV, US, param_file, tr_Reg) if (.not.associated(OBC)) return - g_prime_tot = (GV%g_Earth/GV%Rho0)*2.0 - Def_Rad = sqrt(D_edge*g_prime_tot) / (1.0e-4*1000.0) - tr_0 = (-D_edge*sqrt(D_edge*g_prime_tot)*0.5e3*Def_Rad) * GV%Z_to_H + g_prime_tot = (GV%LZT_g_Earth / GV%Rho0)*2.0 + Def_Rad = US%L_to_m*sqrt(D_edge*g_prime_tot) / (1.0e-4*US%T_to_s * 1000.0) + tr_0 = (-D_edge*sqrt(D_edge*g_prime_tot)*0.5e3*US%s_to_T*US%L_to_m*Def_Rad) * GV%Z_to_H if (OBC%number_of_segments /= 1) then call MOM_error(WARNING, 'Error in DOME OBC segment setup', .true.) @@ -317,7 +317,7 @@ subroutine DOME_set_OBC_data(OBC, tv, G, GV, US, param_file, tr_Reg) y2 = (2.0*Ri_trans*rsb + Ri_trans + 2.0)/(2.0 - Ri_trans) tr_k = tr_0 * (2.0/(Ri_trans*(2.0-Ri_trans))) * & ((log(y1)+1.0)/y1 - (log(y2)+1.0)/y2) - v_k = -sqrt(D_edge*g_prime_tot)*log((2.0 + Ri_trans*(1.0 + 2.0*rc)) / & + v_k = -US%L_T_to_m_s*sqrt(D_edge*g_prime_tot)*log((2.0 + Ri_trans*(1.0 + 2.0*rc)) / & (2.0 - Ri_trans)) if (k == nz) tr_k = tr_k + tr_0 * (2.0/(Ri_trans*(2.0+Ri_trans))) * & log((2.0+Ri_trans)/(2.0-Ri_trans)) diff --git a/src/user/ISOMIP_initialization.F90 b/src/user/ISOMIP_initialization.F90 index cce8b43a71..56ca631022 100644 --- a/src/user/ISOMIP_initialization.F90 +++ b/src/user/ISOMIP_initialization.F90 @@ -107,13 +107,13 @@ subroutine ISOMIP_initialize_topography(D, G, param_file, max_depth, US) else do j=js,je ; do i=is,ie ! 3D setup - ! #### TEST ####### + ! ===== TEST ===== !if (G%geoLonT(i,j)<500.) then ! xtil = 500.*1.0e3/xbar !else ! xtil = G%geoLonT(i,j)*1.0e3/xbar !endif - ! ##### TEST ##### + ! ===== TEST ===== xtil = G%geoLonT(i,j)*1.0e3/xbar diff --git a/src/user/MOM_wave_interface.F90 b/src/user/MOM_wave_interface.F90 index 9e09ea9bba..d05c8b1734 100644 --- a/src/user/MOM_wave_interface.F90 +++ b/src/user/MOM_wave_interface.F90 @@ -562,11 +562,11 @@ subroutine Update_Stokes_Drift(G, GV, US, CS, h, ustar) elseif (PartitionMode==1) then if (CS%StkLevelMode==0) then ! Take the value at the midpoint - CMN_FAC = exp(MidPoint*2.*(2.*PI*CS%Freq_Cen(b))**2/(GV%g_Earth*US%m_to_Z**2)) + CMN_FAC = exp(MidPoint*2.*(2.*PI*CS%Freq_Cen(b)*US%T_to_s)**2/(US%L_to_Z**2*GV%LZT_g_Earth)) elseif (CS%StkLevelMode==1) then ! Use a numerical integration and then ! divide by layer thickness - WN = (2.*PI*CS%Freq_Cen(b))**2 / (GV%g_Earth*US%m_to_Z**2) !bgr bug-fix missing g + WN = (2.*PI*CS%Freq_Cen(b)*US%T_to_s)**2 / (US%L_to_Z**2*GV%LZT_g_Earth) !bgr bug-fix missing g CMN_FAC = (exp(2.*WN*Top)-exp(2.*WN*Bottom)) / (2.*WN*(Top-Bottom)) endif endif @@ -606,11 +606,11 @@ subroutine Update_Stokes_Drift(G, GV, US, CS, h, ustar) elseif (PartitionMode==1) then if (CS%StkLevelMode==0) then ! Take the value at the midpoint - CMN_FAC = exp(MidPoint*2.*(2.*PI*CS%Freq_Cen(b))**2/(GV%g_Earth*US%m_to_Z**2)) + CMN_FAC = exp(MidPoint*2.*(2.*PI*CS%Freq_Cen(b)*US%T_to_s)**2/(US%L_to_Z**2*GV%LZT_g_Earth)) elseif (CS%StkLevelMode==1) then ! Use a numerical integration and then ! divide by layer thickness - WN = (2.*PI*CS%Freq_Cen(b))**2 / (GV%g_Earth*US%m_to_Z**2) + WN = (2.*PI*CS%Freq_Cen(b)*US%T_to_s)**2 / (US%L_to_Z**2*GV%LZT_g_Earth) CMN_FAC = (exp(2.*WN*Top)-exp(2.*WN*Bottom)) / (2.*WN*(Top-Bottom)) endif endif @@ -824,7 +824,7 @@ subroutine Surface_Bands_by_data_override(day_center, G, GV, US, CS) endif NUMBANDS = ID do B = 1,NumBands - CS%WaveNum_Cen(b) = (2.*PI*CS%Freq_Cen(b))**2 / (GV%g_Earth*US%m_to_Z**2) + CS%WaveNum_Cen(b) = (2.*PI*CS%Freq_Cen(b)*US%T_to_s)**2 / (US%L_to_Z**2*GV%LZT_g_Earth) enddo endif @@ -1344,7 +1344,7 @@ subroutine ust_2_u10_coare3p5(USTair, U10, GV, US) CT=CT+1 u10a = u10 alpha = min(0.028, 0.0017 * u10 - 0.005) - z0rough = alpha * USTair**2 / GV%g_Earth ! Compute z0rough from ustar guess + z0rough = alpha * (US%m_s_to_L_T*USTair)**2 / GV%LZT_g_Earth ! Compute z0rough from ustar guess z0 = z0sm + z0rough CD = ( vonkar / log(10.*US%m_to_Z / z0) )**2 ! Compute CD from derived roughness u10 = USTair/sqrt(CD) ! Compute new u10 from derived CD, while loop diff --git a/src/user/Rossby_front_2d_initialization.F90 b/src/user/Rossby_front_2d_initialization.F90 index a32a2978b7..f09db8525a 100644 --- a/src/user/Rossby_front_2d_initialization.F90 +++ b/src/user/Rossby_front_2d_initialization.F90 @@ -177,11 +177,11 @@ subroutine Rossby_front_initialize_velocity(u, v, h, G, GV, US, param_file, just real :: y ! Non-dimensional coordinate across channel, 0..pi real :: T_range ! Range of salinities and temperatures over the vertical - real :: dUdT ! Factor to convert dT/dy into dU/dz, g*alpha/f + real :: dUdT ! Factor to convert dT/dy into dU/dz, g*alpha/f [L2 Z-1 T-1 degC-1 ~> m s-1 degC-1] real :: dRho_dT real :: Dml, zi, zc, zm ! Depths [Z ~> m]. real :: f ! The local Coriolis parameter [T-1 ~> s-1] - real :: Ty + real :: Ty ! The meridional temperature gradient [degC L-1 ~> degC m-1] real :: hAtU ! Interpolated layer thickness [Z ~> m]. integer :: i, j, k, is, ie, js, je, nz logical :: just_read ! If true, just read parameters but set nothing. @@ -205,16 +205,16 @@ subroutine Rossby_front_initialize_velocity(u, v, h, G, GV, US, param_file, just do j = G%jsc,G%jec ; do I = G%isc-1,G%iec+1 f = 0.5* (G%CoriolisBu(I,j) + G%CoriolisBu(I,j-1) ) dUdT = 0.0 ; if (abs(f) > 0.0) & - dUdT = ( GV%g_Earth * dRho_dT ) / ( US%s_to_T * f * GV%Rho0 ) + dUdT = ( GV%LZT_g_Earth*dRho_dT ) / ( f * GV%Rho0 ) Dml = Hml( G, G%geoLatT(i,j) ) - Ty = dTdy( G, T_range, G%geoLatT(i,j) ) + Ty = US%L_to_m*dTdy( G, T_range, G%geoLatT(i,j) ) zi = 0. do k = 1, nz hAtU = 0.5*(h(i,j,k)+h(i+1,j,k)) * GV%H_to_Z zi = zi - hAtU ! Bottom interface position zc = zi - 0.5*hAtU ! Position of middle of cell zm = max( zc + Dml, 0. ) ! Height above bottom of mixed layer - u(I,j,k) = dUdT * Ty * zm ! Thermal wind starting at base of ML + u(I,j,k) = US%L_T_to_m_s * dUdT * Ty * zm ! Thermal wind starting at base of ML enddo enddo ; enddo From 8f9411749296d725667218eb40e89756beb56b19 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Mon, 15 Jul 2019 08:14:21 -0400 Subject: [PATCH 107/150] +Replaced GV%LZT_g_Earth with GV%g_Earth Renamed GV%LZT_g_Earth to GV%g_Earth and eliminated the separate GV%g_Earth, which is no longer in use anywhere in the MOM6 code. All answers are bitwise identical. --- src/core/MOM_PressureForce_Montgomery.F90 | 14 +++++++------- src/core/MOM_PressureForce_analytic_FV.F90 | 6 +++--- src/core/MOM_PressureForce_blocked_AFV.F90 | 6 +++--- src/core/MOM_forcing_type.F90 | 2 +- src/core/MOM_isopycnal_slopes.F90 | 2 +- src/core/MOM_verticalGrid.F90 | 6 ++---- src/diagnostics/MOM_wave_speed.F90 | 4 ++-- src/diagnostics/MOM_wave_structure.F90 | 2 +- src/initialization/MOM_coord_initialization.F90 | 16 ++++++++-------- .../lateral/MOM_mixed_layer_restrat.F90 | 4 ++-- .../lateral/MOM_thickness_diffuse.F90 | 4 ++-- .../vertical/MOM_bulk_mixed_layer.F90 | 16 ++++++++-------- .../vertical/MOM_diabatic_aux.F90 | 6 +++--- .../vertical/MOM_diapyc_energy_req.F90 | 4 ++-- .../vertical/MOM_energetic_PBL.F90 | 2 +- .../vertical/MOM_entrain_diffusive.F90 | 2 +- .../vertical/MOM_internal_tide_input.F90 | 2 +- .../vertical/MOM_kappa_shear.F90 | 2 +- src/parameterizations/vertical/MOM_opacity.F90 | 4 ++-- .../vertical/MOM_set_diffusivity.F90 | 12 ++++++------ .../vertical/MOM_set_viscosity.F90 | 6 +++--- src/user/BFB_initialization.F90 | 4 ++-- src/user/DOME_initialization.F90 | 2 +- src/user/Kelvin_initialization.F90 | 10 +++++----- src/user/MOM_wave_interface.F90 | 12 ++++++------ src/user/Rossby_front_2d_initialization.F90 | 2 +- 26 files changed, 75 insertions(+), 77 deletions(-) diff --git a/src/core/MOM_PressureForce_Montgomery.F90 b/src/core/MOM_PressureForce_Montgomery.F90 index eb1812bbd6..2c143baab1 100644 --- a/src/core/MOM_PressureForce_Montgomery.F90 +++ b/src/core/MOM_PressureForce_Montgomery.F90 @@ -147,7 +147,7 @@ subroutine PressureForce_Mont_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, pb "can no longer be used with a compressible EOS. Use #define ANALYTIC_FV_PGF.") endif - I_gEarth = 1.0 / (US%L_T_to_m_s**2 * GV%LZT_g_Earth) + I_gEarth = 1.0 / (US%L_T_to_m_s**2 * GV%g_Earth) dp_neglect = GV%H_to_Pa * GV%H_subroundoff do k=1,nz ; alpha_Lay(k) = 1.0 / GV%Rlay(k) ; enddo do k=2,nz ; dalpha_int(K) = alpha_Lay(k-1) - alpha_Lay(k) ; enddo @@ -206,12 +206,12 @@ subroutine PressureForce_Mont_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, pb call calc_tidal_forcing(CS%Time, SSH, e_tidal, G, CS%tides_CSp, m_to_Z=US%m_to_Z) !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - geopot_bot(i,j) = -US%L_T_to_m_s**2 * GV%LZT_g_Earth*(e_tidal(i,j) + G%bathyT(i,j)) + geopot_bot(i,j) = -US%L_T_to_m_s**2 * GV%g_Earth*(e_tidal(i,j) + G%bathyT(i,j)) enddo ; enddo else !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - geopot_bot(i,j) = -US%L_T_to_m_s**2 * GV%LZT_g_Earth*G%bathyT(i,j) + geopot_bot(i,j) = -US%L_T_to_m_s**2 * GV%g_Earth*G%bathyT(i,j) enddo ; enddo endif @@ -435,7 +435,7 @@ subroutine PressureForce_Mont_Bouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, pbce, h_neglect = GV%H_subroundoff * GV%H_to_Z I_Rho0 = 1.0/CS%Rho0 - G_Rho0 = US%L_T_to_m_s**2 * GV%LZT_g_Earth/GV%Rho0 + G_Rho0 = US%L_T_to_m_s**2 * GV%g_Earth/GV%Rho0 if (CS%tides) then ! Determine the surface height anomaly for calculating self attraction @@ -639,8 +639,8 @@ subroutine Set_pbce_Bouss(e, tv, G, GV, US, Rho0, GFS_scale, pbce, rho_star) Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB ; nz = G%ke - Rho0xG = Rho0*US%L_T_to_m_s**2 * GV%LZT_g_Earth - G_Rho0 = GV%LZT_g_Earth / GV%Rho0 + Rho0xG = Rho0*US%L_T_to_m_s**2 * GV%g_Earth + G_Rho0 = GV%g_Earth / GV%Rho0 use_EOS = associated(tv%eqn_of_state) z_neglect = GV%H_subroundoff*GV%H_to_Z @@ -876,7 +876,7 @@ subroutine PressureForce_Mont_init(Time, G, GV, US, param_file, diag, CS, tides_ endif CS%GFS_scale = 1.0 - if (GV%g_prime(1) /= GV%LZT_g_Earth) CS%GFS_scale = GV%g_prime(1) / GV%LZT_g_Earth + if (GV%g_prime(1) /= GV%g_Earth) CS%GFS_scale = GV%g_prime(1) / GV%g_Earth call log_param(param_file, mdl, "GFS / G_EARTH", CS%GFS_scale) diff --git a/src/core/MOM_PressureForce_analytic_FV.F90 b/src/core/MOM_PressureForce_analytic_FV.F90 index b6e6d049e7..d23b343cf4 100644 --- a/src/core/MOM_PressureForce_analytic_FV.F90 +++ b/src/core/MOM_PressureForce_analytic_FV.F90 @@ -195,7 +195,7 @@ subroutine PressureForce_AFV_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p dp_neglect = GV%H_to_Pa * GV%H_subroundoff alpha_ref = 1.0/CS%Rho0 - g_Earth_z = US%L_T_to_m_s**2 * GV%LZT_g_Earth + g_Earth_z = US%L_T_to_m_s**2 * GV%g_Earth I_gEarth = 1.0 / g_Earth_z if (use_p_atm) then @@ -532,7 +532,7 @@ subroutine PressureForce_AFV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_at h_neglect = GV%H_subroundoff dz_neglect = GV%H_subroundoff * GV%H_to_Z I_Rho0 = 1.0/GV%Rho0 - g_Earth_z = US%L_T_to_m_s**2 * GV%LZT_g_Earth + g_Earth_z = US%L_T_to_m_s**2 * GV%g_Earth G_Rho0 = g_Earth_z/GV%Rho0 rho_ref = CS%Rho0 @@ -848,7 +848,7 @@ subroutine PressureForce_AFV_init(Time, G, GV, US, param_file, diag, CS, tides_C endif CS%GFS_scale = 1.0 - if (GV%g_prime(1) /= GV%LZT_g_Earth) CS%GFS_scale = GV%g_prime(1) / GV%LZT_g_Earth + if (GV%g_prime(1) /= GV%g_Earth) CS%GFS_scale = GV%g_prime(1) / GV%g_Earth call log_param(param_file, mdl, "GFS / G_EARTH", CS%GFS_scale) diff --git a/src/core/MOM_PressureForce_blocked_AFV.F90 b/src/core/MOM_PressureForce_blocked_AFV.F90 index 5531736632..c9e1b2707c 100644 --- a/src/core/MOM_PressureForce_blocked_AFV.F90 +++ b/src/core/MOM_PressureForce_blocked_AFV.F90 @@ -191,7 +191,7 @@ subroutine PressureForce_blk_AFV_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, dp_neglect = GV%H_to_Pa * GV%H_subroundoff alpha_ref = 1.0/CS%Rho0 - g_Earth_z = US%L_T_to_m_s**2 * GV%LZT_g_Earth + g_Earth_z = US%L_T_to_m_s**2 * GV%g_Earth I_gEarth = 1.0 / g_Earth_z if (use_p_atm) then @@ -516,7 +516,7 @@ subroutine PressureForce_blk_AFV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, h_neglect = GV%H_subroundoff dz_neglect = GV%H_subroundoff * GV%H_to_Z I_Rho0 = 1.0/GV%Rho0 - g_Earth_z = US%L_T_to_m_s**2 * GV%LZT_g_Earth + g_Earth_z = US%L_T_to_m_s**2 * GV%g_Earth G_Rho0 = g_Earth_z / GV%Rho0 rho_ref = CS%Rho0 @@ -840,7 +840,7 @@ subroutine PressureForce_blk_AFV_init(Time, G, GV, US, param_file, diag, CS, tid endif CS%GFS_scale = 1.0 - if (GV%g_prime(1) /= GV%LZT_g_Earth) CS%GFS_scale = GV%g_prime(1) / GV%LZT_g_Earth + if (GV%g_prime(1) /= GV%g_Earth) CS%GFS_scale = GV%g_prime(1) / GV%g_Earth call log_param(param_file, mdl, "GFS / G_EARTH", CS%GFS_scale) diff --git a/src/core/MOM_forcing_type.F90 b/src/core/MOM_forcing_type.F90 index 22c3bb82ac..7df4213a2f 100644 --- a/src/core/MOM_forcing_type.F90 +++ b/src/core/MOM_forcing_type.F90 @@ -916,7 +916,7 @@ subroutine calculateBuoyancyFlux1d(G, GV, US, fluxes, optics, nsw, h, Temp, Salt depthBeforeScalingFluxes = max( GV%Angstrom_H, 1.e-30*GV%m_to_H ) pressure(:) = 0. ! Ignore atmospheric pressure - GoRho = (GV%LZT_g_Earth*US%m_to_Z * GV%H_to_m*US%T_to_s) / GV%Rho0 + GoRho = (GV%g_Earth*US%m_to_Z * GV%H_to_m*US%T_to_s) / GV%Rho0 start = 1 + G%isc - G%isd npts = 1 + G%iec - G%isc diff --git a/src/core/MOM_isopycnal_slopes.F90 b/src/core/MOM_isopycnal_slopes.F90 index 99032c317a..f386868aa1 100644 --- a/src/core/MOM_isopycnal_slopes.F90 +++ b/src/core/MOM_isopycnal_slopes.F90 @@ -122,7 +122,7 @@ subroutine calc_isoneutral_slopes(G, GV, US, h, e, tv, dt_kappa_smooth, & present_N2_u = PRESENT(N2_u) present_N2_v = PRESENT(N2_v) - G_Rho0 = (US%L_to_Z*US%L_to_m*L_to_z*US%s_to_T**2*GV%LZT_g_Earth) / GV%Rho0 + G_Rho0 = (US%L_to_Z*US%L_to_m*L_to_z*US%s_to_T**2*GV%g_Earth) / GV%Rho0 if (present_N2_u) then do j=js,je ; do I=is-1,ie N2_u(I,j,1) = 0. diff --git a/src/core/MOM_verticalGrid.F90 b/src/core/MOM_verticalGrid.F90 index 3580ad3cc9..c11de0d0dd 100644 --- a/src/core/MOM_verticalGrid.F90 +++ b/src/core/MOM_verticalGrid.F90 @@ -26,9 +26,8 @@ module MOM_verticalGrid ! Commonly used parameters 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 :: 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]. @@ -124,8 +123,7 @@ 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%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 + GV%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, & diff --git a/src/diagnostics/MOM_wave_speed.F90 b/src/diagnostics/MOM_wave_speed.F90 index 35adc79753..5c7dabeed9 100644 --- a/src/diagnostics/MOM_wave_speed.F90 +++ b/src/diagnostics/MOM_wave_speed.F90 @@ -132,7 +132,7 @@ subroutine wave_speed(h, tv, G, GV, US, cg1, CS, full_halos, use_ebt_mode, & endif S => tv%S ; T => tv%T - g_Rho0 = US%L_T_to_m_s**2 * GV%LZT_g_Earth / GV%Rho0 + g_Rho0 = US%L_T_to_m_s**2 * GV%g_Earth / GV%Rho0 Z_to_Pa = GV%Z_to_H * GV%H_to_Pa use_EOS = associated(tv%eqn_of_state) @@ -599,7 +599,7 @@ subroutine wave_speeds(h, tv, G, GV, US, nmodes, cn, CS, full_halos) endif ; endif S => tv%S ; T => tv%T - g_Rho0 = US%L_T_to_m_s**2 * GV%LZT_g_Earth / GV%Rho0 + g_Rho0 = US%L_T_to_m_s**2 * GV%g_Earth / GV%Rho0 use_EOS = associated(tv%eqn_of_state) Z_to_Pa = GV%Z_to_H * GV%H_to_Pa diff --git a/src/diagnostics/MOM_wave_structure.F90 b/src/diagnostics/MOM_wave_structure.F90 index 098569529c..0b7155826a 100644 --- a/src/diagnostics/MOM_wave_structure.F90 +++ b/src/diagnostics/MOM_wave_structure.F90 @@ -178,7 +178,7 @@ subroutine wave_structure(h, tv, G, GV, US, cn, ModeNum, freq, CS, En, full_halo Pi = (4.0*atan(1.0)) S => tv%S ; T => tv%T - g_Rho0 = US%L_T_to_m_s**2 * GV%LZT_g_Earth /GV%Rho0 + g_Rho0 = US%L_T_to_m_s**2 * GV%g_Earth /GV%Rho0 use_EOS = associated(tv%eqn_of_state) H_to_pres = GV%Z_to_H*GV%H_to_Pa diff --git a/src/initialization/MOM_coord_initialization.F90 b/src/initialization/MOM_coord_initialization.F90 index c5adfdd74a..fd77676008 100644 --- a/src/initialization/MOM_coord_initialization.F90 +++ b/src/initialization/MOM_coord_initialization.F90 @@ -149,7 +149,7 @@ subroutine set_coord_from_gprime(Rlay, g_prime, GV, US, param_file) g_prime(1) = g_fs do k=2,nz ; g_prime(k) = g_int ; enddo Rlay(1) = GV%Rho0 - do k=2,nz ; Rlay(k) = Rlay(k-1) + g_prime(k)*(GV%Rho0/GV%LZT_g_Earth) ; enddo + do k=2,nz ; Rlay(k) = Rlay(k-1) + g_prime(k)*(GV%Rho0/GV%g_Earth) ; enddo call callTree_leave(trim(mdl)//'()') @@ -191,7 +191,7 @@ subroutine set_coord_from_layer_density(Rlay, g_prime, GV, US, param_file) enddo ! These statements set the interface reduced gravities. ! do k=2,nz - g_prime(k) = (GV%LZT_g_Earth/GV%Rho0) * (Rlay(k) - Rlay(k-1)) + g_prime(k) = (GV%g_Earth/GV%Rho0) * (Rlay(k) - Rlay(k-1)) enddo call callTree_leave(trim(mdl)//'()') @@ -243,7 +243,7 @@ subroutine set_coord_from_TS_ref(Rlay, g_prime, GV, US, param_file, eqn_of_state call calculate_density(T_ref, S_ref, P_ref, Rlay(1), eqn_of_state) ! These statements set the layer densities. ! - do k=2,nz ; Rlay(k) = Rlay(k-1) + g_prime(k)*(GV%Rho0/GV%LZT_g_Earth) ; enddo + do k=2,nz ; Rlay(k) = Rlay(k-1) + g_prime(k)*(GV%Rho0/GV%g_Earth) ; enddo call callTree_leave(trim(mdl)//'()') end subroutine set_coord_from_TS_ref @@ -291,7 +291,7 @@ subroutine set_coord_from_TS_profile(Rlay, g_prime, GV, US, param_file, & g_prime(1) = g_fs do k=1,nz ; Pref(k) = P_ref ; enddo call calculate_density(T0, S0, Pref, Rlay, 1,nz,eqn_of_state) - do k=2,nz; g_prime(k) = (GV%LZT_g_Earth/GV%Rho0) * (Rlay(k) - Rlay(k-1)) ; enddo + do k=2,nz; g_prime(k) = (GV%g_Earth/GV%Rho0) * (Rlay(k) - Rlay(k-1)) ; enddo call callTree_leave(trim(mdl)//'()') end subroutine set_coord_from_TS_profile @@ -375,7 +375,7 @@ subroutine set_coord_from_TS_range(Rlay, g_prime, GV, US, param_file, & do k=k_light-1,1,-1 Rlay(k) = 2.0*Rlay(k+1) - Rlay(k+2) enddo - do k=2,nz; g_prime(k) = (GV%LZT_g_Earth/GV%Rho0) * (Rlay(k) - Rlay(k-1)); enddo + do k=2,nz; g_prime(k) = (GV%g_Earth/GV%Rho0) * (Rlay(k) - Rlay(k-1)); enddo call callTree_leave(trim(mdl)//'()') end subroutine set_coord_from_TS_range @@ -417,7 +417,7 @@ subroutine set_coord_from_file(Rlay, g_prime, GV, US, param_file) call read_axis_data(filename, coord_var, Rlay) g_prime(1) = g_fs - do k=2,nz ; g_prime(k) = (GV%LZT_g_Earth/GV%Rho0) * (Rlay(k) - Rlay(k-1)) ; enddo + do k=2,nz ; g_prime(k) = (GV%g_Earth/GV%Rho0) * (Rlay(k) - Rlay(k-1)) ; enddo do k=1,nz ; if (g_prime(k) <= 0.0) then call MOM_error(FATAL, "MOM_initialization set_coord_from_file: "//& "Zero or negative g_primes read from variable "//"Layer"//" in file "//& @@ -467,7 +467,7 @@ subroutine set_coord_linear(Rlay, g_prime, GV, US, param_file) ! These statements set the interface reduced gravities. g_prime(1) = g_fs do k=2,nz - g_prime(k) = (GV%LZT_g_Earth/GV%Rho0) * (Rlay(k) - Rlay(k-1)) + g_prime(k) = (GV%g_Earth/GV%Rho0) * (Rlay(k) - Rlay(k-1)) enddo call callTree_leave(trim(mdl)//'()') @@ -499,7 +499,7 @@ subroutine set_coord_to_none(Rlay, g_prime, GV, US, param_file) g_prime(1) = g_fs do k=2,nz ; g_prime(k) = 0. ; enddo Rlay(1) = GV%Rho0 - do k=2,nz ; Rlay(k) = Rlay(k-1) + g_prime(k)*(GV%Rho0/GV%LZT_g_Earth) ; enddo + do k=2,nz ; Rlay(k) = Rlay(k-1) + g_prime(k)*(GV%Rho0/GV%g_Earth) ; enddo call callTree_leave(trim(mdl)//'()') diff --git a/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 b/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 index ef92a56595..546f320136 100644 --- a/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 +++ b/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 @@ -281,7 +281,7 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var uDml(:) = 0.0 ; vDml(:) = 0.0 uDml_slow(:) = 0.0 ; vDml_slow(:) = 0.0 I4dt = 0.25 / dt - g_Rho0 = GV%LZT_g_Earth*US%L_to_m**2*US%s_to_T**2 / GV%Rho0 + g_Rho0 = GV%g_Earth*US%L_to_m**2*US%s_to_T**2 / GV%Rho0 h_neglect = GV%H_subroundoff dz_neglect = GV%H_subroundoff*GV%H_to_Z proper_averaging = .not. CS%MLE_use_MLD_ave_bug @@ -607,7 +607,7 @@ subroutine mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, dt, G, GV, US, CS) uDml(:) = 0.0 ; vDml(:) = 0.0 I4dt = 0.25 / dt - g_Rho0 = GV%LZT_g_Earth*US%L_to_m**2*US%s_to_T**2 / GV%Rho0 + g_Rho0 = GV%g_Earth*US%L_to_m**2*US%s_to_T**2 / GV%Rho0 use_EOS = associated(tv%eqn_of_state) h_neglect = GV%H_subroundoff dz_neglect = GV%H_subroundoff*GV%H_to_Z diff --git a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 index 16dc56f4f3..0f9b4a3067 100644 --- a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 +++ b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 @@ -640,10 +640,10 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV I4dt = 0.25 / dt I_slope_max2 = 1.0 / (CS%slope_max**2) - G_scale = GV%LZT_g_Earth*US%L_to_m**2*US%s_to_T**2 * GV%H_to_m + G_scale = GV%g_Earth*US%L_to_m**2*US%s_to_T**2 * GV%H_to_m h_neglect = GV%H_subroundoff ; h_neglect2 = h_neglect**2 dz_neglect = GV%H_subroundoff*GV%H_to_Z - G_rho0 = GV%LZT_g_Earth*US%L_to_m**2*US%s_to_T**2 / GV%Rho0 + G_rho0 = GV%g_Earth*US%L_to_m**2*US%s_to_T**2 / GV%Rho0 N2_floor = CS%N2_floor*US%Z_to_m**2 use_EOS = associated(tv%eqn_of_state) diff --git a/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 b/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 index 490ca9b32b..48287bb86c 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%L_to_m**2*GV%LZT_g_Earth*US%m_to_Z) * Irho0**2 + RmixConst = 0.5*CS%rivermix_depth * (US%L_to_m**2*GV%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%L_to_m**2*GV%LZT_g_Earth * GV%H_to_Z**2) / (2.0 * GV%Rho0) + g_H2_2Rho0 = (US%L_to_m**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 @@ -1068,7 +1068,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%L_to_m**2*GV%LZT_g_Earth * GV%H_to_Z**2) / (2.0 * GV%Rho0) + g_H2_2Rho0 = (US%L_to_m**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 @@ -1609,7 +1609,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%L_to_m**2*GV%LZT_g_Earth * GV%H_to_Z) / (2.0 * GV%Rho0) + g_H_2Rho0 = (US%L_to_m**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 @@ -2359,8 +2359,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%L_to_m**2*GV%LZT_g_Earth - Rho0xG = GV%Rho0 * US%L_to_m**2*GV%LZT_g_Earth + g_2 = 0.5 * US%L_to_m**2*GV%g_Earth + Rho0xG = GV%Rho0 * US%L_to_m**2*GV%g_Earth Idt_H2 = GV%H_to_Z**2 / dt_diag I2Rho0 = 0.5 / GV%Rho0 Angstrom = GV%Angstrom_H @@ -3161,8 +3161,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%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) + g_H2_2Rho0dt = (US%L_to_m**2*GV%g_Earth * GV%H_to_Z**2) / (2.0 * GV%Rho0 * dt_diag) + g_H2_2dt = (US%L_to_m**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 diff --git a/src/parameterizations/vertical/MOM_diabatic_aux.F90 b/src/parameterizations/vertical/MOM_diabatic_aux.F90 index 483bce6f1b..ca6185aa5d 100644 --- a/src/parameterizations/vertical/MOM_diabatic_aux.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_aux.F90 @@ -749,7 +749,7 @@ subroutine diagnoseMLDbyDensityDifference(id_MLD, h, tv, densityDiff, G, GV, US, id_SQ = -1 ; if (PRESENT(id_MLDsq)) id_SQ = id_MLDsq - gE_rho0 = US%L_to_Z**2*GV%LZT_g_Earth / GV%Rho0 + gE_rho0 = US%L_to_Z**2*GV%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 @@ -939,13 +939,13 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, US, dt, fluxes, optics, nsw, h, t calculate_energetics = (present(cTKE) .and. present(dSV_dT) .and. present(dSV_dS)) calculate_buoyancy = present(SkinBuoyFlux) if (calculate_buoyancy) SkinBuoyFlux(:,:) = 0.0 -! I_G_Earth = US%Z_to_m / (US%L_T_to_m_s**2 * GV%LZT_g_Earth) +! I_G_Earth = US%Z_to_m / (US%L_T_to_m_s**2 * GV%g_Earth) 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 SurfPressure(:) = 0.0 - GoRho = US%L_to_Z**2*GV%LZT_g_Earth / GV%Rho0 + GoRho = US%L_to_Z**2*GV%g_Earth / GV%Rho0 start = 1 + G%isc - G%isd npts = 1 + G%iec - G%isc endif diff --git a/src/parameterizations/vertical/MOM_diapyc_energy_req.F90 b/src/parameterizations/vertical/MOM_diapyc_energy_req.F90 index cd7723f4fa..e9c5e6a3d0 100644 --- a/src/parameterizations/vertical/MOM_diapyc_energy_req.F90 +++ b/src/parameterizations/vertical/MOM_diapyc_energy_req.F90 @@ -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) = ((US%L_to_Z**2*GV%LZT_g_Earth) * rho_here / (0.5*GV%H_to_Z*(h_tr(k-1) + h_tr(k)))) * & + N2(K) = ((US%L_to_Z**2*GV%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) = ((US%L_to_Z**2*GV%LZT_g_Earth) * rho_here / (0.5*GV%H_to_Z*(h_tr(k-1) + h_tr(k)))) * & + N2(K) = ((US%L_to_Z**2*GV%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 diff --git a/src/parameterizations/vertical/MOM_energetic_PBL.F90 b/src/parameterizations/vertical/MOM_energetic_PBL.F90 index 5bdf716f1b..485ae1e942 100644 --- a/src/parameterizations/vertical/MOM_energetic_PBL.F90 +++ b/src/parameterizations/vertical/MOM_energetic_PBL.F90 @@ -806,7 +806,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%L_to_Z**2 * GV%LZT_g_Earth * dMass ! Equivalent to GV%H_to_Pa * h(k) with rescaling + dPres = US%L_to_Z**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) diff --git a/src/parameterizations/vertical/MOM_entrain_diffusive.F90 b/src/parameterizations/vertical/MOM_entrain_diffusive.F90 index df9dfb1604..a4d8e985cf 100644 --- a/src/parameterizations/vertical/MOM_entrain_diffusive.F90 +++ b/src/parameterizations/vertical/MOM_entrain_diffusive.F90 @@ -822,7 +822,7 @@ subroutine entrainment_diffusive(h, tv, fluxes, dt, G, GV, US, CS, ea, eb, & endif if (CS%id_diff_work > 0) then - g_2dt = 0.5 * GV%H_to_Z**2*US%L_to_Z**2 * (GV%LZT_g_Earth / dt) + g_2dt = 0.5 * GV%H_to_Z**2*US%L_to_Z**2 * (GV%g_Earth / dt) do i=is,ie ; diff_work(i,j,1) = 0.0 ; diff_work(i,j,nz+1) = 0.0 ; enddo if (associated(tv%eqn_of_state)) then if (associated(fluxes%p_surf)) then diff --git a/src/parameterizations/vertical/MOM_internal_tide_input.F90 b/src/parameterizations/vertical/MOM_internal_tide_input.F90 index 52156ac337..5859834e75 100644 --- a/src/parameterizations/vertical/MOM_internal_tide_input.F90 +++ b/src/parameterizations/vertical/MOM_internal_tide_input.F90 @@ -185,7 +185,7 @@ subroutine find_N2_bottom(h, tv, T_f, S_f, h2, fluxes, G, GV, US, N2_bot) 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 = (US%L_to_Z**2*GV%LZT_g_Earth) / GV%Rho0 + G_Rho0 = (US%L_to_Z**2*GV%g_Earth) / GV%Rho0 ! Find the (limited) density jump across each interface. do i=is,ie diff --git a/src/parameterizations/vertical/MOM_kappa_shear.F90 b/src/parameterizations/vertical/MOM_kappa_shear.F90 index 2d6f26dd10..547840732d 100644 --- a/src/parameterizations/vertical/MOM_kappa_shear.F90 +++ b/src/parameterizations/vertical/MOM_kappa_shear.F90 @@ -795,7 +795,7 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & Ri_crit = CS%Rino_crit gR0 = GV%z_to_H*GV%H_to_Pa - g_R0 = (US%L_to_Z**2 * GV%LZT_g_Earth) / GV%Rho0 + g_R0 = (US%L_to_Z**2 * GV%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 899f778380..b57645db67 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**2 * US%L_to_Z**2*GV%LZT_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%g_Earth * GV%H_to_kg_m2) * GV%H_to_kg_m2 else - g_Hconv2 = US%m_to_Z**2 * US%L_to_Z**2*GV%LZT_g_Earth * GV%H_to_kg_m2**2 + g_Hconv2 = US%m_to_Z**2 * US%L_to_Z**2*GV%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 4ba95b6a22..c3bc7dd674 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 = (US%L_to_Z**2 * GV%LZT_g_Earth) / GV%Rho0 + G_Rho0 = (US%L_to_Z**2 * GV%g_Earth) / GV%Rho0 if (CS%answers_2018) then I_Rho0 = 1.0 / GV%Rho0 - G_IRho0 = (US%L_to_Z**2 * GV%LZT_g_Earth) * I_Rho0 + G_IRho0 = (US%L_to_Z**2 * GV%g_Earth) * I_Rho0 else G_IRho0 = G_Rho0 endif @@ -815,7 +815,7 @@ subroutine find_TKE_to_Kd(h, tv, dRho_int, N2_lay, j, dt, G, GV, US, CS, & ! maxTKE is found by determining the kappa that gives maxEnt. ! kappa_max = I_dt * dRho_int(i,K+1) * maxEnt(i,k) * & ! (GV%H_to_Z*h(i,j,k) + dh_max) / dRho_lay - ! maxTKE(i,k) = (GV%LZT_g_Earth*US%L_to_Z**2) * dRho_lay * kappa_max + ! maxTKE(i,k) = (GV%g_Earth*US%L_to_Z**2) * dRho_lay * kappa_max ! dRho_int should already be non-negative, so the max is redundant? dh_max = maxEnt(i,k) * (1.0 + dsp1_ds(i,k)) dRho_lay = 0.5 * max(dRho_int(i,K) + dRho_int(i,K+1), 0.0) @@ -884,7 +884,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 = (US%L_to_Z**2 * GV%LZT_g_Earth) / GV%Rho0 + G_Rho0 = (US%L_to_Z**2 * GV%g_Earth) / GV%Rho0 H_neglect = GV%H_subroundoff ! Find the (limited) density jump across each interface. @@ -1172,7 +1172,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%L_to_Z**2 * GV%LZT_g_Earth) + R0_g = GV%Rho0 / (US%L_to_Z**2 * GV%g_Earth) do K=2,nz ; Rint(K) = 0.5*(GV%Rlay(k-1)+GV%Rlay(k)) ; enddo @@ -1814,7 +1814,7 @@ subroutine set_density_ratios(h, tv, kb, G, GV, US, CS, j, ds_dsp1, rho_0) enddo if (CS%bulkmixedlayer) then - g_R0 = GV%LZT_g_Earth / GV%Rho0 + g_R0 = GV%g_Earth / GV%Rho0 kmb = GV%nk_rho_varies eps = 0.1 do i=is,ie ; p_ref(i) = tv%P_Ref ; enddo diff --git a/src/parameterizations/vertical/MOM_set_viscosity.F90 b/src/parameterizations/vertical/MOM_set_viscosity.F90 index 912ae64d44..7fccfc5dea 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 / (US%L_to_Z**2 * GV%LZT_g_Earth)) * GV%Z_to_H + Rho0x400_G = 400.0*(GV%Rho0 / (US%L_to_Z**2 * GV%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/(US%L_to_Z**2 * GV%LZT_g_Earth)) * GV%Z_to_H + Rho0x400_G = 400.0*(GV%Rho0/(US%L_to_Z**2 * GV%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) @@ -1142,7 +1142,7 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS, symmetri h_neglect = GV%H_subroundoff h_tiny = 2.0*GV%Angstrom_H + h_neglect ! 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 + g_H_Rho0 = (US%s_to_T**2*US%L_to_m**2*GV%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/BFB_initialization.F90 b/src/user/BFB_initialization.F90 index fd3b7e8225..055e6af00f 100644 --- a/src/user/BFB_initialization.F90 +++ b/src/user/BFB_initialization.F90 @@ -62,9 +62,9 @@ subroutine BFB_set_coord(Rlay, g_prime, GV, param_file, eqn_of_state) do k = 1,nz Rlay(k) = (rho_bot - rho_top)/(nz-1)*real(k-1) + rho_top if (k >1) then - g_prime(k) = (Rlay(k) - Rlay(k-1)) * GV%LZT_g_Earth/GV%rho0 + g_prime(k) = (Rlay(k) - Rlay(k-1)) * GV%g_Earth/GV%rho0 else - g_prime(k) = GV%LZT_g_Earth + g_prime(k) = GV%g_Earth endif !Rlay(:) = 0.0 !g_prime(:) = 0.0 diff --git a/src/user/DOME_initialization.F90 b/src/user/DOME_initialization.F90 index ce13e45b14..73d2f7905b 100644 --- a/src/user/DOME_initialization.F90 +++ b/src/user/DOME_initialization.F90 @@ -290,7 +290,7 @@ subroutine DOME_set_OBC_data(OBC, tv, G, GV, US, param_file, tr_Reg) if (.not.associated(OBC)) return - g_prime_tot = (GV%LZT_g_Earth / GV%Rho0)*2.0 + g_prime_tot = (GV%g_Earth / GV%Rho0)*2.0 Def_Rad = US%L_to_m*sqrt(D_edge*g_prime_tot) / (1.0e-4*US%T_to_s * 1000.0) tr_0 = (-D_edge*sqrt(D_edge*g_prime_tot)*0.5e3*US%s_to_T*US%L_to_m*Def_Rad) * GV%Z_to_H diff --git a/src/user/Kelvin_initialization.F90 b/src/user/Kelvin_initialization.F90 index 7540347dc1..60fd96d900 100644 --- a/src/user/Kelvin_initialization.F90 +++ b/src/user/Kelvin_initialization.F90 @@ -220,7 +220,7 @@ subroutine Kelvin_set_OBC_data(OBC, CS, G, GV, US, h, Time) omega = 2.0 * PI / (12.42 * 3600.0) ! M2 Tide period val1 = US%m_to_Z * sin(omega * time_sec) else - N0 = US%L_to_m*US%s_to_T * sqrt((CS%rho_range / CS%rho_0) * GV%LZT_g_Earth * (US%m_to_Z * CS%H0)) + N0 = US%L_to_m*US%s_to_T * sqrt((CS%rho_range / CS%rho_0) * GV%g_Earth * (US%m_to_Z * CS%H0)) ! Two wavelengths in domain plx = 4.0 * PI / G%len_lon pmz = PI * CS%mode / CS%H0 @@ -253,7 +253,7 @@ subroutine Kelvin_set_OBC_data(OBC, CS, G, GV, US, h, Time) x = (x1 - CS%coast_offset1) * cosa + y1 * sina y = - (x1 - CS%coast_offset1) * sina + y1 * cosa if (CS%mode == 0) then - cff = sqrt(GV%LZT_g_Earth * 0.5 * (G%bathyT(i+1,j) + G%bathyT(i,j))) + cff = sqrt(GV%g_Earth * 0.5 * (G%bathyT(i+1,j) + G%bathyT(i,j))) val2 = fac * exp(- US%T_to_s*CS%F_0 * US%m_to_L*y / cff) segment%eta(I,j) = val2 * cos(omega * time_sec) segment%normal_vel_bt(I,j) = US%L_T_to_m_s * (val2 * (val1 * cff * cosa / & @@ -292,7 +292,7 @@ subroutine Kelvin_set_OBC_data(OBC, CS, G, GV, US, h, Time) (0.25 * (G%bathyT(i+1,j) + G%bathyT(i,j) + G%bathyT(i+1,j+1) + G%bathyT(i,j+1))) )) enddo ; endif else - cff =sqrt(GV%LZT_g_Earth * 0.5 * (G%bathyT(i+1,j) + G%bathyT(i,j))) + cff =sqrt(GV%g_Earth * 0.5 * (G%bathyT(i+1,j) + G%bathyT(i,j))) val2 = fac * exp(- US%T_to_s*CS%F_0 * US%m_to_L*y / cff) if (CS%mode == 0) then ; do k=1,nz segment%tangential_vel(I,J,k) = US%L_T_to_m_s * (val1 * val2 * cff * sina) / & @@ -311,7 +311,7 @@ subroutine Kelvin_set_OBC_data(OBC, CS, G, GV, US, h, Time) x = (x1 - CS%coast_offset1) * cosa + y1 * sina y = - (x1 - CS%coast_offset1) * sina + y1 * cosa if (CS%mode == 0) then - cff = sqrt(GV%LZT_g_Earth * 0.5 * (G%bathyT(i,j+1) + G%bathyT(i,j))) + cff = sqrt(GV%g_Earth * 0.5 * (G%bathyT(i,j+1) + G%bathyT(i,j))) val2 = fac * exp(- 0.5 * (G%CoriolisBu(I,J) + G%CoriolisBu(I-1,J)) * US%m_to_L*y / cff) segment%eta(I,j) = val2 * cos(omega * time_sec) segment%normal_vel_bt(I,j) = US%L_T_to_m_s * (val1 * cff * sina / & @@ -348,7 +348,7 @@ subroutine Kelvin_set_OBC_data(OBC, CS, G, GV, US, h, Time) (0.25*(G%bathyT(i+1,j) + G%bathyT(i,j) + G%bathyT(i+1,j+1) + G%bathyT(i,j+1))))) enddo ; endif else - cff = sqrt(GV%LZT_g_Earth * 0.5 * (G%bathyT(i,j+1) + G%bathyT(i,j))) + cff = sqrt(GV%g_Earth * 0.5 * (G%bathyT(i,j+1) + G%bathyT(i,j))) val2 = fac * exp(- 0.5 * (G%CoriolisBu(I,J) + G%CoriolisBu(I-1,J)) * US%m_to_L*y / cff) if (CS%mode == 0) then ; do k=1,nz segment%tangential_vel(I,J,k) = US%L_T_to_m_s * ((val1 * val2 * cff * sina) / & diff --git a/src/user/MOM_wave_interface.F90 b/src/user/MOM_wave_interface.F90 index d05c8b1734..0da6285f37 100644 --- a/src/user/MOM_wave_interface.F90 +++ b/src/user/MOM_wave_interface.F90 @@ -562,11 +562,11 @@ subroutine Update_Stokes_Drift(G, GV, US, CS, h, ustar) elseif (PartitionMode==1) then if (CS%StkLevelMode==0) then ! Take the value at the midpoint - CMN_FAC = exp(MidPoint*2.*(2.*PI*CS%Freq_Cen(b)*US%T_to_s)**2/(US%L_to_Z**2*GV%LZT_g_Earth)) + CMN_FAC = exp(MidPoint*2.*(2.*PI*CS%Freq_Cen(b)*US%T_to_s)**2/(US%L_to_Z**2*GV%g_Earth)) elseif (CS%StkLevelMode==1) then ! Use a numerical integration and then ! divide by layer thickness - WN = (2.*PI*CS%Freq_Cen(b)*US%T_to_s)**2 / (US%L_to_Z**2*GV%LZT_g_Earth) !bgr bug-fix missing g + WN = (2.*PI*CS%Freq_Cen(b)*US%T_to_s)**2 / (US%L_to_Z**2*GV%g_Earth) !bgr bug-fix missing g CMN_FAC = (exp(2.*WN*Top)-exp(2.*WN*Bottom)) / (2.*WN*(Top-Bottom)) endif endif @@ -606,11 +606,11 @@ subroutine Update_Stokes_Drift(G, GV, US, CS, h, ustar) elseif (PartitionMode==1) then if (CS%StkLevelMode==0) then ! Take the value at the midpoint - CMN_FAC = exp(MidPoint*2.*(2.*PI*CS%Freq_Cen(b)*US%T_to_s)**2/(US%L_to_Z**2*GV%LZT_g_Earth)) + CMN_FAC = exp(MidPoint*2.*(2.*PI*CS%Freq_Cen(b)*US%T_to_s)**2/(US%L_to_Z**2*GV%g_Earth)) elseif (CS%StkLevelMode==1) then ! Use a numerical integration and then ! divide by layer thickness - WN = (2.*PI*CS%Freq_Cen(b)*US%T_to_s)**2 / (US%L_to_Z**2*GV%LZT_g_Earth) + WN = (2.*PI*CS%Freq_Cen(b)*US%T_to_s)**2 / (US%L_to_Z**2*GV%g_Earth) CMN_FAC = (exp(2.*WN*Top)-exp(2.*WN*Bottom)) / (2.*WN*(Top-Bottom)) endif endif @@ -824,7 +824,7 @@ subroutine Surface_Bands_by_data_override(day_center, G, GV, US, CS) endif NUMBANDS = ID do B = 1,NumBands - CS%WaveNum_Cen(b) = (2.*PI*CS%Freq_Cen(b)*US%T_to_s)**2 / (US%L_to_Z**2*GV%LZT_g_Earth) + CS%WaveNum_Cen(b) = (2.*PI*CS%Freq_Cen(b)*US%T_to_s)**2 / (US%L_to_Z**2*GV%g_Earth) enddo endif @@ -1344,7 +1344,7 @@ subroutine ust_2_u10_coare3p5(USTair, U10, GV, US) CT=CT+1 u10a = u10 alpha = min(0.028, 0.0017 * u10 - 0.005) - z0rough = alpha * (US%m_s_to_L_T*USTair)**2 / GV%LZT_g_Earth ! Compute z0rough from ustar guess + z0rough = alpha * (US%m_s_to_L_T*USTair)**2 / GV%g_Earth ! Compute z0rough from ustar guess z0 = z0sm + z0rough CD = ( vonkar / log(10.*US%m_to_Z / z0) )**2 ! Compute CD from derived roughness u10 = USTair/sqrt(CD) ! Compute new u10 from derived CD, while loop diff --git a/src/user/Rossby_front_2d_initialization.F90 b/src/user/Rossby_front_2d_initialization.F90 index f09db8525a..9676464330 100644 --- a/src/user/Rossby_front_2d_initialization.F90 +++ b/src/user/Rossby_front_2d_initialization.F90 @@ -205,7 +205,7 @@ subroutine Rossby_front_initialize_velocity(u, v, h, G, GV, US, param_file, just do j = G%jsc,G%jec ; do I = G%isc-1,G%iec+1 f = 0.5* (G%CoriolisBu(I,j) + G%CoriolisBu(I,j-1) ) dUdT = 0.0 ; if (abs(f) > 0.0) & - dUdT = ( GV%LZT_g_Earth*dRho_dT ) / ( f * GV%Rho0 ) + dUdT = ( GV%g_Earth*dRho_dT ) / ( f * GV%Rho0 ) Dml = Hml( G, G%geoLatT(i,j) ) Ty = US%L_to_m*dTdy( G, T_range, G%geoLatT(i,j) ) zi = 0. From 50c389fc72b2b72d1cfc130ccf0a4b01b10ca947 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Mon, 15 Jul 2019 10:39:23 -0400 Subject: [PATCH 108/150] Rescaled variables in set_viscous_ML Changed the dimensions of the variables used to calculate a bulk Richardson number in set_viscous_ML to use units of L2 T-2 for velocities squared. All answers are bitwise identical. --- .../vertical/MOM_set_viscosity.F90 | 13 ++++++------- 1 file changed, 6 insertions(+), 7 deletions(-) diff --git a/src/parameterizations/vertical/MOM_set_viscosity.F90 b/src/parameterizations/vertical/MOM_set_viscosity.F90 index 7fccfc5dea..641415893c 100644 --- a/src/parameterizations/vertical/MOM_set_viscosity.F90 +++ b/src/parameterizations/vertical/MOM_set_viscosity.F90 @@ -1059,7 +1059,7 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS, symmetri real :: Uh2 ! The squared magnitude of the difference between the velocity ! integrated through the mixed layer and the velocity of the ! interior layer layer times the depth of the the mixed layer - ! [H2 m2 s-2 ~> m4 s-2 or kg2 m-2 s-2]. + ! [H2 Z2 T-2 ~> m4 s-2 or kg2 m-2 s-2]. real :: htot_vel ! Sum of the layer thicknesses up to some point [H ~> m or kg m-2]. real :: hwtot ! Sum of the thicknesses used to calculate ! the near-bottom velocity magnitude [H ~> m or kg m-2]. @@ -1079,14 +1079,14 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS, symmetri real :: u_at_v ! The zonal velocity at a meridonal velocity point [m s-1]. real :: gHprime ! The mixed-layer internal gravity wave speed squared, based ! on the mixed layer thickness and density difference across - ! the base of the mixed layer [m2 s-2]. + ! the base of the mixed layer [L2 T-2 ~> m2 s-2]. real :: RiBulk ! The bulk Richardson number below which water is in the ! viscous mixed layer, including reduction for turbulent ! decay. Nondimensional. real :: dt_Rho0 ! The time step divided by the conversion from the layer ! thickness to layer mass [s H m2 kg-1 ~> s m3 kg-1 or s]. real :: g_H_Rho0 ! The gravitational acceleration times the conversion from H to m divided - ! by the mean density [m5 s-2 H-1 kg-1 ~> m4 s-2 kg-1 or m7 s-2 kg-2]. + ! by the mean density [L2 m3 T-2 H-1 kg-1 ~> m4 s-2 kg-1 or m7 s-2 kg-2]. real :: ustarsq ! 400 times the square of ustar, times ! Rho0 divided by G_Earth and the conversion ! from m to thickness units [H kg m-3 ~> kg m-2 or kg2 m-5]. @@ -1141,8 +1141,7 @@ 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 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%g_Earth*GV%H_to_Z) / GV%Rho0 + g_H_Rho0 = (GV%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 "//& @@ -1240,7 +1239,7 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS, symmetri I_2hlay = 1.0 / (h(i,j,k) + h(i+1,j,k)) v_at_u = 0.5 * (h(i,j,k) * (v(i,J,k) + v(i,J-1,k)) + & h(i+1,j,k) * (v(i+1,J,k) + v(i+1,J-1,k))) * I_2hlay - Uh2 = (uhtot(I) - htot(I)*u(I,j,k))**2 + (vhtot(I) - htot(I)*v_at_u)**2 + Uh2 = US%m_s_to_L_T**2*((uhtot(I) - htot(I)*u(I,j,k))**2 + (vhtot(I) - htot(I)*v_at_u)**2) if (use_EOS) then T_lay = (h(i,j,k)*tv%T(i,j,k) + h(i+1,j,k)*tv%T(i+1,j,k)) * I_2hlay @@ -1477,7 +1476,7 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS, symmetri I_2hlay = 1.0 / (h(i,j,k) + h(i,j+1,k)) u_at_v = 0.5 * (h(i,j,k) * (u(I-1,j,k) + u(I,j,k)) + & h(i,j+1,k) * (u(I-1,j+1,k) + u(I,j+1,k))) * I_2hlay - Uh2 = (uhtot(I) - htot(I)*u_at_v)**2 + (vhtot(I) - htot(I)*v(i,J,k))**2 + Uh2 = US%m_s_to_L_T**2*((uhtot(I) - htot(I)*u_at_v)**2 + (vhtot(I) - htot(I)*v(i,J,k))**2) if (use_EOS) then T_lay = (h(i,j,k)*tv%T(i,j,k) + h(i,j+1,k)*tv%T(i,j+1,k)) * I_2hlay From 2aad166c8cf48629c296b4d55d0d7d7f35079d77 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Mon, 15 Jul 2019 15:12:02 -0400 Subject: [PATCH 109/150] (*)+Harmonized the two versions of vert_fill_TS There are two versions of vert_fill_TS in MOM_isopycnal_slopes.F90 and MOM_thickness_diffuse.F90. This commit changes how they handle massless layers and brings the two versions closer together, including combining the diffusivity and timestep arguments into a single argument of their product and adding a new optional logical argument to cause the isopycnal_slopes version to reproduce the answers from the thickness_diffuse version. Also added a the existing runtime parameter KD_SMOOTH to MOM_set_diffusivity for use when SET_DIFF_2018_ANSWERS is false, but this does not change the MOM_parameter_doc files. All answers are bitwise identical in the existing MOM6-examples test cases, but there could be answer changes when there are zero thickness layers. --- src/core/MOM_isopycnal_slopes.F90 | 70 +++++++++++-------- .../lateral/MOM_thickness_diffuse.F90 | 43 ++++++------ .../vertical/MOM_internal_tide_input.F90 | 2 +- .../vertical/MOM_set_diffusivity.F90 | 29 +++++--- 4 files changed, 84 insertions(+), 60 deletions(-) diff --git a/src/core/MOM_isopycnal_slopes.F90 b/src/core/MOM_isopycnal_slopes.F90 index f386868aa1..4af99ac322 100644 --- a/src/core/MOM_isopycnal_slopes.F90 +++ b/src/core/MOM_isopycnal_slopes.F90 @@ -331,65 +331,79 @@ end subroutine calc_isoneutral_slopes !> Returns tracer arrays (nominally T and S) with massless layers filled with !! sensible values, by diffusing vertically with a small but constant diffusivity. -subroutine vert_fill_TS(h, T_in, S_in, kappa_dt, T_f, S_f, G, GV, halo_here) +subroutine vert_fill_TS(h, T_in, S_in, kappa_dt, T_f, S_f, G, GV, halo_here, larger_h_denom) 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)), intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: T_in !< Temperature [degC] - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: S_in !< Salinity [ppt] + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: T_in !< Input temperature [degC] + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: S_in !< Input salinity [ppt] real, intent(in) :: kappa_dt !< A vertical diffusivity to use for smoothing !! times a smoothing timescale [Z2 ~> m2]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(out) :: T_f !< Filled temperature [degC] - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(out) :: S_f !< Filed salinity [ppt] - integer, optional, intent(in) :: halo_here !< Halo width over which to compute + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(out) :: S_f !< Filled salinity [ppt] + integer, optional, intent(in) :: halo_here !< Number of halo points to work on, + !! 0 by default + logical, optional, intent(in) :: larger_h_denom !< Present and true, add a large + !! enough minimal thickness in the denominator of + !! the flux calculations so that the fluxes are + !! never so large as eliminate the transmission + !! of information across groups of massless layers. ! Local variables real :: ent(SZI_(G),SZK_(G)+1) ! The diffusive entrainment (kappa*dt)/dz ! between layers in a timestep [H ~> m or kg m-2]. real :: b1(SZI_(G)), d1(SZI_(G)) ! b1, c1, and d1 are variables used by the real :: c1(SZI_(G),SZK_(G)) ! tridiagonal solver. - real :: kap_dt_x2 ! The product of 2*kappa*dt, converted to - ! the same units as h squared, [H2 ~> m2 or kg2 m-4]. - real :: h_neglect ! A negligible thickness [H ~> m or kg m-2], to - ! allow for zero thicknesses. + real :: kap_dt_x2 ! The 2*kappa_dt converted to H units [H2 ~> m2 or kg2 m-4]. + real :: h_neglect ! A negligible thickness [H ~> m or kg m-2], to allow for zero thicknesses. + real :: h0 ! A negligible thickness to allow for zero thickness layers without + ! completely decouping groups of layers [H ~> m or kg m-2]. + ! Often 0 < h_neglect << h0. + 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]. integer :: i, j, k, is, ie, js, je, nz, halo halo=0 ; if (present(halo_here)) halo = max(halo_here,0) - is = G%isc-halo ; ie = G%iec+halo ; js = G%jsc-halo ; je = G%jec+halo - nz = G%ke + is = G%isc-halo ; ie = G%iec+halo ; js = G%jsc-halo ; je = G%jec+halo ; nz = GV%ke - kap_dt_x2 = (2.0*kappa_dt)*GV%Z_to_H**2 h_neglect = GV%H_subroundoff + kap_dt_x2 = (2.0*kappa_dt)*GV%Z_to_H**2 + h0 = h_neglect + if (present(larger_h_denom)) then + if (larger_h_denom) h0 = 1.0e-16*sqrt(kappa_dt)*GV%Z_to_H + endif if (kap_dt_x2 <= 0.0) then -!$OMP parallel do default(none) shared(is,ie,js,je,nz,T_f,T_in,S_f,S_in) + !$OMP parallel do default(shared) do k=1,nz ; do j=js,je ; do i=is,ie T_f(i,j,k) = T_in(i,j,k) ; S_f(i,j,k) = S_in(i,j,k) enddo ; enddo ; enddo else -!$OMP parallel do default(none) private(ent,b1,d1,c1) & -!$OMP shared(is,ie,js,je,nz,kap_dt_x2,h,h_neglect,T_f,S_f,T_in,S_in) + !$OMP parallel do default(shared) private(ent,b1,d1,c1,h_tr) do j=js,je do i=is,ie - ent(i,2) = kap_dt_x2 / ((h(i,j,1)+h(i,j,2)) + h_neglect) - b1(i) = 1.0 / (h(i,j,1)+ent(i,2)) - d1(i) = b1(i) * h(i,j,1) - T_f(i,j,1) = (b1(i)*h(i,j,1))*T_in(i,j,1) - S_f(i,j,1) = (b1(i)*h(i,j,1))*S_in(i,j,1) + ent(i,2) = kap_dt_x2 / ((h(i,j,1)+h(i,j,2)) + h0) + h_tr = h(i,j,1) + h_neglect + b1(i) = 1.0 / (h_tr + ent(i,2)) + d1(i) = b1(i) * h_tr + T_f(i,j,1) = (b1(i)*h_tr)*T_in(i,j,1) + S_f(i,j,1) = (b1(i)*h_tr)*S_in(i,j,1) enddo do k=2,nz-1 ; do i=is,ie - ent(i,K+1) = kap_dt_x2 / ((h(i,j,k)+h(i,j,k+1)) + h_neglect) + ent(i,K+1) = kap_dt_x2 / ((h(i,j,k)+h(i,j,k+1)) + h0) + h_tr = h(i,j,k) + h_neglect c1(i,k) = ent(i,K) * b1(i) - b1(i) = 1.0 / ((h(i,j,k) + d1(i)*ent(i,K)) + ent(i,K+1)) - d1(i) = b1(i) * (h(i,j,k) + d1(i)*ent(i,K)) - T_f(i,j,k) = b1(i) * (h(i,j,k)*T_in(i,j,k) + ent(i,K)*T_f(i,j,k-1)) - S_f(i,j,k) = b1(i) * (h(i,j,k)*S_in(i,j,k) + ent(i,K)*S_f(i,j,k-1)) + b1(i) = 1.0 / ((h_tr + d1(i)*ent(i,K)) + ent(i,K+1)) + d1(i) = b1(i) * (h_tr + d1(i)*ent(i,K)) + T_f(i,j,k) = b1(i) * (h_tr*T_in(i,j,k) + ent(i,K)*T_f(i,j,k-1)) + S_f(i,j,k) = b1(i) * (h_tr*S_in(i,j,k) + ent(i,K)*S_f(i,j,k-1)) enddo ; enddo do i=is,ie c1(i,nz) = ent(i,nz) * b1(i) - b1(i) = 1.0 / (h(i,j,nz) + d1(i)*ent(i,nz) + h_neglect) - T_f(i,j,nz) = b1(i) * (h(i,j,nz)*T_in(i,j,nz) + ent(i,nz)*T_f(i,j,nz-1)) - S_f(i,j,nz) = b1(i) * (h(i,j,nz)*S_in(i,j,nz) + ent(i,nz)*S_f(i,j,nz-1)) + h_tr = h(i,j,nz) + h_neglect + b1(i) = 1.0 / (h_tr + d1(i)*ent(i,nz)) + T_f(i,j,nz) = b1(i) * (h_tr*T_in(i,j,nz) + ent(i,nz)*T_f(i,j,nz-1)) + S_f(i,j,nz) = b1(i) * (h_tr*S_in(i,j,nz) + ent(i,nz)*S_f(i,j,nz-1)) enddo do k=nz-1,1,-1 ; do i=is,ie T_f(i,j,k) = T_f(i,j,k) + c1(i,k+1)*T_f(i,j,k+1) diff --git a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 index 0f9b4a3067..de1eebfe69 100644 --- a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 +++ b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 @@ -664,7 +664,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV find_work = (associated(CS%GMwork) .or. find_work) if (use_EOS) then - call vert_fill_TS(h, tv%T, tv%S, CS%kappa_smooth, dt, T, S, G, GV, 1) + call vert_fill_TS(h, tv%T, tv%S, CS%kappa_smooth*dt, T, S, G, GV, 1) endif if (CS%use_FGNV_streamfn .and. .not. associated(cg1)) call MOM_error(FATAL, & @@ -1745,16 +1745,16 @@ subroutine add_detangling_Kh(h, e, Kh_u, Kh_v, KH_u_CFL, KH_v_CFL, tv, dt, G, GV end subroutine add_detangling_Kh -!> Fills tracer values in massless layers with sensible values by diffusing +!> Fills tracer values (nominally T and S) in massless layers with sensible values by diffusing !! vertically with a (small) constant diffusivity. -subroutine vert_fill_TS(h, T_in, S_in, kappa, dt, T_f, S_f, G, GV, halo_here) - type(ocean_grid_type), intent(in) :: G !< Ocean grid structure - type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness [H ~> m or kg m-2] +subroutine vert_fill_TS(h, T_in, S_in, kappa_dt, T_f, S_f, G, GV, halo_here) + 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)), intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: T_in !< Input temperature [degC] real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: S_in !< Input salinity [ppt] - real, intent(in) :: kappa !< Constant diffusivity to use [Z2 T-1 ~> m2 s-1] - real, intent(in) :: dt !< Time increment [T ~> s] + real, intent(in) :: kappa_dt !< A vertical diffusivity to use for smoothing + !! times a smoothing timescale [Z2 ~> m2]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(out) :: T_f !< Filled temperature [degC] real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(out) :: S_f !< Filled salinity [ppt] integer, optional, intent(in) :: halo_here !< Number of halo points to work on, @@ -1764,37 +1764,36 @@ subroutine vert_fill_TS(h, T_in, S_in, kappa, dt, T_f, S_f, G, GV, halo_here) ! between layers in a timestep [H ~> m or kg m-2]. real :: b1(SZI_(G)), d1(SZI_(G)) ! b1, c1, and d1 are variables used by the real :: c1(SZI_(G),SZK_(G)) ! tridiagonal solver. - real :: kap_dt_x2 ! The product of 2*kappa*dt [H2 ~> m2 or kg2 m-4]. - real :: h0 ! A negligible thickness to allow for zero - ! thicknesses [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]. 0 < h_neglect << h0. + real :: kap_dt_x2 ! The 2*kappa_dt converted to H units [H2 ~> m2 or kg2 m-4]. + real :: h_neglect ! A negligible thickness [H ~> m or kg m-2], to allow for zero thicknesses. + real :: h0 ! A negligible thickness to allow for zero thickness layers without + ! completely decouping groups of layers [H ~> m or kg m-2]. + ! Often 0 < h_neglect << h0. 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]. integer :: i, j, k, is, ie, js, je, nz, halo halo=0 ; if (present(halo_here)) halo = max(halo_here,0) - is = G%isc-halo ; ie = G%iec+halo ; js = G%jsc-halo ; je = G%jec+halo - nz = G%ke + is = G%isc-halo ; ie = G%iec+halo ; js = G%jsc-halo ; je = G%jec+halo ; nz = GV%ke + h_neglect = GV%H_subroundoff - kap_dt_x2 = (2.0*kappa*dt)*GV%Z_to_H**2 - h0 = 1.0e-16*sqrt(kappa*dt)*GV%Z_to_H + kap_dt_x2 = (2.0*kappa_dt)*GV%Z_to_H**2 + h0 = 1.0e-16*sqrt(kappa_dt)*GV%Z_to_H if (kap_dt_x2 <= 0.0) then -!$OMP parallel do default(none) shared(is,ie,js,je,nz,T_f,T_in,S_f,S_in) + !$OMP parallel do default(shared) do k=1,nz ; do j=js,je ; do i=is,ie T_f(i,j,k) = T_in(i,j,k) ; S_f(i,j,k) = S_in(i,j,k) enddo ; enddo ; enddo else -!$OMP parallel do default(none) private(ent,b1,d1,c1,h_tr) & -!$OMP shared(is,ie,js,je,nz,kap_dt_x2,h,h0,h_neglect,T_f,S_f,T_in,S_in) - do j=js,je + !$OMP parallel do default(shared) private(ent,b1,d1,c1,h_tr) + do j=js,je do i=is,ie ent(i,2) = kap_dt_x2 / ((h(i,j,1)+h(i,j,2)) + h0) h_tr = h(i,j,1) + h_neglect b1(i) = 1.0 / (h_tr + ent(i,2)) - d1(i) = b1(i) * h(i,j,1) + d1(i) = b1(i) * h_tr T_f(i,j,1) = (b1(i)*h_tr)*T_in(i,j,1) S_f(i,j,1) = (b1(i)*h_tr)*S_in(i,j,1) enddo diff --git a/src/parameterizations/vertical/MOM_internal_tide_input.F90 b/src/parameterizations/vertical/MOM_internal_tide_input.F90 index 5859834e75..f51849dbb9 100644 --- a/src/parameterizations/vertical/MOM_internal_tide_input.F90 +++ b/src/parameterizations/vertical/MOM_internal_tide_input.F90 @@ -112,7 +112,7 @@ subroutine set_int_tide_input(u, v, h, tv, fluxes, itide, dt, G, GV, US, CS) ! Smooth the properties through massless layers. if (use_EOS) then - call vert_fill_TS(h, tv%T, tv%S, CS%kappa_fill, dt*US%s_to_T, 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) diff --git a/src/parameterizations/vertical/MOM_set_diffusivity.F90 b/src/parameterizations/vertical/MOM_set_diffusivity.F90 index c3bc7dd674..2c62ff5d8f 100644 --- a/src/parameterizations/vertical/MOM_set_diffusivity.F90 +++ b/src/parameterizations/vertical/MOM_set_diffusivity.F90 @@ -81,6 +81,8 @@ 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 :: Kd_smooth !< Vertical diffusivity used to interpolate more + !! sensible values of T & S into thin layers [Z2 T-1 ~> m2 s-1]. type(diag_ctrl), pointer :: diag => NULL() !< structure to regulate diagnostic output timing logical :: limit_dissipation !< If enabled, dissipation is limited to be larger @@ -267,8 +269,7 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt_in_T, integer :: i, j, k, is, ie, js, je, nz integer :: isd, ied, jsd, jed - real :: kappa_fill ! diffusivity used to fill massless layers [Z2 T-1 ~> m2 s-1] - real :: dt_fill ! timestep used to fill massless layers [T ~> s] + real :: kappa_dt_fill ! diffusivity times a timestep used to fill massless layers [Z2 ~> m2] 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 @@ -280,8 +281,11 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt_in_T, I_Rho0 = 1.0 / GV%Rho0 ! ### Dimensional parameters - kappa_fill = 1.e-3 * US%m2_s_to_Z2_T - dt_fill = 7200. * US%s_to_T + if (CS%answers_2018) then + kappa_dt_fill = US%m_to_Z**2 * 1.e-3 * 7200. + else + kappa_dt_fill = CS%Kd_smooth * dt_in_T + endif Omega2 = CS%omega * CS%omega use_EOS = associated(tv%eqn_of_state) @@ -334,7 +338,7 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt_in_T, call hchksum(tv%S, "before vert_fill_TS tv%S",G%HI) call hchksum(h, "before vert_fill_TS h",G%HI, scale=GV%H_to_m) endif - 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, kappa_dt_fill, T_f, S_f, G, GV) if (CS%debug) then call hchksum(tv%T, "after vert_fill_TS tv%T",G%HI) call hchksum(tv%S, "after vert_fill_TS tv%S",G%HI) @@ -350,7 +354,7 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt_in_T, call cpu_clock_begin(id_clock_kappaShear) if (CS%Vertex_shear) then call full_convection(G, GV, h, tv, T_adj, S_adj, fluxes%p_surf, & - (GV%Z_to_H**2)*kappa_fill*dt_fill, halo=1) + (GV%Z_to_H**2)*kappa_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_in_T, G, GV, US, CS%kappaShear_CSp) @@ -771,8 +775,11 @@ subroutine find_TKE_to_Kd(h, tv, dRho_int, N2_lay, j, dt, G, GV, US, CS, & if (k == kb(i)) then maxEnt(i,kb(i)) = mFkb(i) elseif (k > kb(i)) then - maxEnt(i,k) = (1.0/dsp1_ds(i,k))*(maxEnt(i,k-1) + htot(i)) -! maxEnt(i,k) = ds_dsp1(i,k)*(maxEnt(i,k-1) + htot(i)) !### BITWISE CHG + if (CS%answers_2018) then + maxEnt(i,k) = (1.0/dsp1_ds(i,k))*(maxEnt(i,k-1) + htot(i)) + else + maxEnt(i,k) = ds_dsp1(i,k)*(maxEnt(i,k-1) + htot(i)) + endif htot(i) = htot(i) + GV%H_to_Z*(h(i,j,k) - GV%Angstrom_H) endif enddo ; enddo @@ -1595,7 +1602,7 @@ subroutine add_MLrad_diffusivity(h, fluxes, j, G, GV, US, CS, Kd_lay, TKE_to_Kd, do i=is,ie ; if (do_i(i)) then dzL = GV%H_to_Z*h(i,j,k) ; z1 = dzL*I_decay(i) if (CS%ML_Rad_bug) then - !### These expresssions are dimensionally inconsistent. -RWH + ! 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 @@ -2082,6 +2089,10 @@ subroutine set_diffusivity_init(Time, G, GV, US, param_file, diag, CS, int_tide_ if (CS%use_LOTW_BBL_diffusivity .and. CS%Kd_max<=0.) call MOM_error(FATAL, & "set_diffusivity_init: KD_MAX must be set (positive) when "// & "USE_LOTW_BBL_DIFFUSIVITY=True.") + call get_param(param_file, mdl, "KD_SMOOTH", CS%Kd_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*US%T_to_s) call get_param(param_file, mdl, "DEBUG", CS%debug, & "If true, write out verbose debugging data.", & From 140d22fea177efb441f1766960ffe0ba6933b025 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Mon, 15 Jul 2019 17:28:54 -0400 Subject: [PATCH 110/150] +Removed one variant of vert_fill_TS Removed the version of vert_fill_TS from MOM_thickness_diffuse.F90 because identical functionality can be obtained via MOM_isopycnal_slopes, provided that the optioanl argument larger_h_denom=.true. is used. All answers are bitwise identical, but there has been a relocation to a new module and a slight change in one of the public interfaces. --- src/core/MOM_isopycnal_slopes.F90 | 2 +- .../lateral/MOM_thickness_diffuse.F90 | 83 +------------------ .../vertical/MOM_internal_tide_input.F90 | 34 ++++---- .../vertical/MOM_set_diffusivity.F90 | 4 +- 4 files changed, 24 insertions(+), 99 deletions(-) diff --git a/src/core/MOM_isopycnal_slopes.F90 b/src/core/MOM_isopycnal_slopes.F90 index 4af99ac322..ab5ce700a7 100644 --- a/src/core/MOM_isopycnal_slopes.F90 +++ b/src/core/MOM_isopycnal_slopes.F90 @@ -13,7 +13,7 @@ module MOM_isopycnal_slopes #include -public calc_isoneutral_slopes +public calc_isoneutral_slopes, vert_fill_TS ! 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 diff --git a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 index de1eebfe69..7fd3a30985 100644 --- a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 +++ b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 @@ -13,6 +13,7 @@ module MOM_thickness_diffuse use MOM_file_parser, only : get_param, log_version, param_file_type use MOM_grid, only : ocean_grid_type use MOM_interface_heights, only : find_eta +use MOM_isopycnal_slopes, only : vert_fill_TS use MOM_lateral_mixing_coeffs, only : VarMix_CS use MOM_MEKE_types, only : MEKE_type use MOM_unit_scaling, only : unit_scale_type @@ -24,7 +25,8 @@ module MOM_thickness_diffuse #include public thickness_diffuse, thickness_diffuse_init, thickness_diffuse_end -public vert_fill_TS, thickness_diffuse_get_KH +! public vert_fill_TS +public thickness_diffuse_get_KH ! 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 @@ -664,7 +666,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV find_work = (associated(CS%GMwork) .or. find_work) if (use_EOS) then - call vert_fill_TS(h, tv%T, tv%S, CS%kappa_smooth*dt, T, S, G, GV, 1) + call vert_fill_TS(h, tv%T, tv%S, CS%kappa_smooth*dt, T, S, G, GV, 1, larger_h_denom=.true.) endif if (CS%use_FGNV_streamfn .and. .not. associated(cg1)) call MOM_error(FATAL, & @@ -1745,83 +1747,6 @@ subroutine add_detangling_Kh(h, e, Kh_u, Kh_v, KH_u_CFL, KH_v_CFL, tv, dt, G, GV end subroutine add_detangling_Kh -!> Fills tracer values (nominally T and S) in massless layers with sensible values by diffusing -!! vertically with a (small) constant diffusivity. -subroutine vert_fill_TS(h, T_in, S_in, kappa_dt, T_f, S_f, G, GV, halo_here) - 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)), intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: T_in !< Input temperature [degC] - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: S_in !< Input salinity [ppt] - real, intent(in) :: kappa_dt !< A vertical diffusivity to use for smoothing - !! times a smoothing timescale [Z2 ~> m2]. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(out) :: T_f !< Filled temperature [degC] - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(out) :: S_f !< Filled salinity [ppt] - integer, optional, intent(in) :: halo_here !< Number of halo points to work on, - !! 0 by default - ! Local variables - real :: ent(SZI_(G),SZK_(G)+1) ! The diffusive entrainment (kappa*dt)/dz - ! between layers in a timestep [H ~> m or kg m-2]. - real :: b1(SZI_(G)), d1(SZI_(G)) ! b1, c1, and d1 are variables used by the - real :: c1(SZI_(G),SZK_(G)) ! tridiagonal solver. - real :: kap_dt_x2 ! The 2*kappa_dt converted to H units [H2 ~> m2 or kg2 m-4]. - real :: h_neglect ! A negligible thickness [H ~> m or kg m-2], to allow for zero thicknesses. - real :: h0 ! A negligible thickness to allow for zero thickness layers without - ! completely decouping groups of layers [H ~> m or kg m-2]. - ! Often 0 < h_neglect << h0. - 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]. - integer :: i, j, k, is, ie, js, je, nz, halo - - halo=0 ; if (present(halo_here)) halo = max(halo_here,0) - - is = G%isc-halo ; ie = G%iec+halo ; js = G%jsc-halo ; je = G%jec+halo ; nz = GV%ke - - h_neglect = GV%H_subroundoff - kap_dt_x2 = (2.0*kappa_dt)*GV%Z_to_H**2 - h0 = 1.0e-16*sqrt(kappa_dt)*GV%Z_to_H - - if (kap_dt_x2 <= 0.0) then - !$OMP parallel do default(shared) - do k=1,nz ; do j=js,je ; do i=is,ie - T_f(i,j,k) = T_in(i,j,k) ; S_f(i,j,k) = S_in(i,j,k) - enddo ; enddo ; enddo - else - !$OMP parallel do default(shared) private(ent,b1,d1,c1,h_tr) - do j=js,je - do i=is,ie - ent(i,2) = kap_dt_x2 / ((h(i,j,1)+h(i,j,2)) + h0) - h_tr = h(i,j,1) + h_neglect - b1(i) = 1.0 / (h_tr + ent(i,2)) - d1(i) = b1(i) * h_tr - T_f(i,j,1) = (b1(i)*h_tr)*T_in(i,j,1) - S_f(i,j,1) = (b1(i)*h_tr)*S_in(i,j,1) - enddo - do k=2,nz-1 ; do i=is,ie - ent(i,K+1) = kap_dt_x2 / ((h(i,j,k)+h(i,j,k+1)) + h0) - h_tr = h(i,j,k) + h_neglect - c1(i,k) = ent(i,K) * b1(i) - b1(i) = 1.0 / ((h_tr + d1(i)*ent(i,K)) + ent(i,K+1)) - d1(i) = b1(i) * (h_tr + d1(i)*ent(i,K)) - T_f(i,j,k) = b1(i) * (h_tr*T_in(i,j,k) + ent(i,K)*T_f(i,j,k-1)) - S_f(i,j,k) = b1(i) * (h_tr*S_in(i,j,k) + ent(i,K)*S_f(i,j,k-1)) - enddo ; enddo - do i=is,ie - c1(i,nz) = ent(i,nz) * b1(i) - h_tr = h(i,j,nz) + h_neglect - b1(i) = 1.0 / (h_tr + d1(i)*ent(i,nz)) - T_f(i,j,nz) = b1(i) * (h_tr*T_in(i,j,nz) + ent(i,nz)*T_f(i,j,nz-1)) - S_f(i,j,nz) = b1(i) * (h_tr*S_in(i,j,nz) + ent(i,nz)*S_f(i,j,nz-1)) - enddo - do k=nz-1,1,-1 ; do i=is,ie - T_f(i,j,k) = T_f(i,j,k) + c1(i,k+1)*T_f(i,j,k+1) - S_f(i,j,k) = S_f(i,j,k) + c1(i,k+1)*S_f(i,j,k+1) - enddo ; enddo - enddo - endif - -end subroutine vert_fill_TS - !> Initialize the thickness diffusion module/structure subroutine thickness_diffuse_init(Time, G, GV, US, param_file, diag, CDp, CS) type(time_type), intent(in) :: Time !< Current model time diff --git a/src/parameterizations/vertical/MOM_internal_tide_input.F90 b/src/parameterizations/vertical/MOM_internal_tide_input.F90 index f51849dbb9..2f51d22b91 100644 --- a/src/parameterizations/vertical/MOM_internal_tide_input.F90 +++ b/src/parameterizations/vertical/MOM_internal_tide_input.F90 @@ -3,22 +3,22 @@ module MOM_int_tide_input ! This file is part of MOM6. See LICENSE.md for the license. -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, 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 -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_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 -use MOM_EOS, only : calculate_density, calculate_density_derivs +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, 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 +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_io, only : slasher, vardesc, MOM_read_data +use MOM_isopycnal_slopes, 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 +use MOM_EOS, only : calculate_density, calculate_density_derivs implicit none ; private @@ -112,7 +112,7 @@ subroutine set_int_tide_input(u, v, h, tv, fluxes, itide, dt, G, GV, US, CS) ! Smooth the properties through massless layers. if (use_EOS) then - call vert_fill_TS(h, tv%T, tv%S, CS%kappa_fill*dt*US%s_to_T, 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, larger_h_denom=.true.) endif call find_N2_bottom(h, tv, T_f, S_f, itide%h2, fluxes, G, GV, US, N2_bot) diff --git a/src/parameterizations/vertical/MOM_set_diffusivity.F90 b/src/parameterizations/vertical/MOM_set_diffusivity.F90 index 2c62ff5d8f..dee3422a7a 100644 --- a/src/parameterizations/vertical/MOM_set_diffusivity.F90 +++ b/src/parameterizations/vertical/MOM_set_diffusivity.F90 @@ -17,6 +17,7 @@ module MOM_set_diffusivity use MOM_full_convection, only : full_convection use MOM_grid, only : ocean_grid_type use MOM_internal_tides, only : int_tide_CS, get_lowmode_loss +use MOM_isopycnal_slopes, only : vert_fill_TS use MOM_tidal_mixing, only : tidal_mixing_CS, calculate_tidal_mixing use MOM_tidal_mixing, only : setup_tidal_diagnostics, post_tidal_diagnostics use MOM_intrinsic_functions, only : invcosh @@ -30,7 +31,6 @@ module MOM_set_diffusivity use MOM_bkgnd_mixing, only : calculate_bkgnd_mixing, bkgnd_mixing_init, bkgnd_mixing_cs use MOM_bkgnd_mixing, only : bkgnd_mixing_end, sfc_bkgnd_mixing use MOM_string_functions, only : uppercase -use MOM_thickness_diffuse, only : vert_fill_TS use MOM_unit_scaling, only : unit_scale_type use MOM_variables, only : thermo_var_ptrs, vertvisc_type, p3d use MOM_verticalGrid, only : verticalGrid_type @@ -338,7 +338,7 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt_in_T, call hchksum(tv%S, "before vert_fill_TS tv%S",G%HI) call hchksum(h, "before vert_fill_TS h",G%HI, scale=GV%H_to_m) endif - call vert_fill_TS(h, tv%T, tv%S, kappa_dt_fill, T_f, S_f, G, GV) + call vert_fill_TS(h, tv%T, tv%S, kappa_dt_fill, T_f, S_f, G, GV, larger_h_denom=.true.) if (CS%debug) then call hchksum(tv%T, "after vert_fill_TS tv%T",G%HI) call hchksum(tv%S, "after vert_fill_TS tv%S",G%HI) From 7c90fa004ddb6a95801e608b516e19a674998c3b Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Tue, 16 Jul 2019 11:50:32 -0600 Subject: [PATCH 111/150] changes to get MOM_ocean_model.F90 closer to nuopc_driver --- config_src/mct_driver/MOM_ocean_model.F90 | 850 +++++++++++------- config_src/mct_driver/MOM_surface_forcing.F90 | 3 +- 2 files changed, 504 insertions(+), 349 deletions(-) diff --git a/config_src/mct_driver/MOM_ocean_model.F90 b/config_src/mct_driver/MOM_ocean_model.F90 index 8bb3346021..aa375809c2 100644 --- a/config_src/mct_driver/MOM_ocean_model.F90 +++ b/config_src/mct_driver/MOM_ocean_model.F90 @@ -1,21 +1,15 @@ +!> Top-level module for the MOM6 ocean model in coupled mode. module MOM_ocean_model ! This file is part of MOM6. See LICENSE.md for the license. -!----------------------------------------------------------------------- -! ! This is the top level module for the MOM6 ocean model. It contains routines ! for initialization, termination and update of ocean model state. This ! particular version wraps all of the calls for MOM6 in the calls that had ! been used for MOM4. ! -! Robert Hallberg -! -! -! ! This code is a stop-gap wrapper of the MOM6 code to enable it to be called ! in the same way as MOM4. -! use MOM, only : initialize_MOM, step_MOM, MOM_control_struct, MOM_end use MOM, only : extract_surface_state, allocate_surface_state, finish_MOM_initialization @@ -25,7 +19,7 @@ module MOM_ocean_model use MOM_diag_mediator, only : diag_ctrl, enable_averaging, disable_averaging use MOM_diag_mediator, only : diag_mediator_close_registration, diag_mediator_end use MOM_domains, only : pass_var, pass_vector, AGRID, BGRID_NE, CGRID_NE -use MOM_domains, only : TO_ALL, Omit_Corners, fill_symmetric_edges +use MOM_domains, only : TO_ALL, Omit_Corners use MOM_error_handler, only : MOM_error, FATAL, WARNING, is_root_pe use MOM_error_handler, only : callTree_enter, callTree_leave use MOM_file_parser, only : get_param, log_version, close_param_file, param_file_type @@ -35,15 +29,13 @@ module MOM_ocean_model use MOM_forcing_type, only : copy_back_forcing_fields, set_net_mass_forcing use MOM_forcing_type, only : set_derived_forcing_fields use MOM_forcing_type, only : forcing_diagnostics, mech_forcing_diags -use MOM_forcing_type, only : allocate_mech_forcing use MOM_get_input, only : Get_MOM_Input, directories use MOM_grid, only : ocean_grid_type use MOM_io, only : close_file, file_exists, read_data, write_version_number use MOM_marine_ice, only : iceberg_forces, iceberg_fluxes, marine_ice_init, marine_ice_CS use MOM_restart, only : MOM_restart_CS, save_restart use MOM_string_functions, only : uppercase -use MOM_surface_forcing, only : surface_forcing_init -use MOM_surface_forcing, only : convert_IOB_to_fluxes +use MOM_surface_forcing, only : surface_forcing_init, convert_IOB_to_fluxes use MOM_surface_forcing, only : convert_IOB_to_forces, ice_ocn_bnd_type_chksum use MOM_surface_forcing, only : ice_ocean_boundary_type, surface_forcing_CS use MOM_surface_forcing, only : forcing_save_restart @@ -64,24 +56,15 @@ module MOM_ocean_model use coupler_types_mod, only : coupler_type_set_diags, coupler_type_send_data use mpp_domains_mod, only : domain2d, mpp_get_layout, mpp_get_global_domain use mpp_domains_mod, only : mpp_define_domains, mpp_get_compute_domain, mpp_get_data_domain +use atmos_ocean_fluxes_mod, only : aof_set_coupler_flux use fms_mod, only : stdout use mpp_mod, only : mpp_chksum use MOM_EOS, only : gsw_sp_from_sr, gsw_pt_from_ct -use MOM_wave_interface, only : wave_parameters_CS, MOM_wave_interface_init -use MOM_wave_interface, only : MOM_wave_interface_init_lite, Update_Surface_Waves +use MOM_wave_interface, only: wave_parameters_CS, MOM_wave_interface_init +use MOM_wave_interface, only: MOM_wave_interface_init_lite, Update_Surface_Waves ! MCT specfic routines -use ocn_cpl_indices, only : cpl_indices_type -use MOM_coms, only : reproducing_sum -use MOM_cpu_clock, only : cpu_clock_id, cpu_clock_begin, cpu_clock_end -use MOM_spatial_means, only : adjust_area_mean_to_zero -use MOM_diag_mediator, only : safe_alloc_ptr use MOM_domains, only : MOM_infra_end -use user_revise_forcing, only : user_alter_forcing -use data_override_mod, only : data_override - -! FMS modules -use time_interp_external_mod, only : time_interp_external #include @@ -92,35 +75,37 @@ module MOM_ocean_model implicit none ; public public ocean_model_init, ocean_model_end, update_ocean_model -public get_ocean_grid ! add by Jiande public ocean_model_save_restart, Ocean_stock_pe +public ice_ocean_boundary_type public ocean_model_init_sfc, ocean_model_flux_init public ocean_model_restart +public ice_ocn_bnd_type_chksum public ocean_public_type_chksum public ocean_model_data_get -public ice_ocn_bnd_type_chksum +public get_ocean_grid +!> This interface extracts a named scalar field or array from the ocean surface or public type interface ocean_model_data_get module procedure ocean_model_data1D_get module procedure ocean_model_data2D_get end interface + !> This type is used for communication with other components via the FMS coupler. !! The element names and types can be changed only with great deliberation, hence !! the persistnce of things like the cutsy element name "avg_kount". type, public :: ocean_public_type type(domain2d) :: Domain !< The domain for the surface fields. - logical :: is_ocean_pe !! .true. on processors that run the ocean model. + logical :: is_ocean_pe !< .true. on processors that run the ocean model. character(len=32) :: instance_name = '' !< A name that can be used to identify !! this instance of an ocean model, for example !! in ensembles when writing messages. integer, pointer, dimension(:) :: pelist => NULL() !< The list of ocean PEs. logical, pointer, dimension(:,:) :: maskmap =>NULL() !< A pointer to an array - !! indicating which logical processors are actually - !! used for the ocean code. The other logical - !! processors would be all land points and are not - !! assigned to actual processors. This need not be - !! assigned if all logical processors are used. + !! indicating which logical processors are actually used for + !! the ocean code. The other logical processors would be all + !! land points and are not assigned to actual processors. + !! This need not be assigned if all logical processors are used. integer :: stagger = -999 !< The staggering relative to the tracer points !! points of the two velocity components. Valid entries @@ -140,38 +125,38 @@ module MOM_ocean_model !! i.e. dzt(1) + eta_t + patm/rho0/grav (m) frazil =>NULL(), & !< Accumulated heating (in Joules/m^2) from frazil !! formation in the ocean. - melt_potential => NULL(), & !< Accumulated heat used to melt sea ice (in W/m^2) + melt_potential => NULL(), & !< Instantaneous heat used to melt sea ice (in J/m^2) area => NULL(), & !< cell area of the ocean surface, in m2. OBLD => NULL() !< Ocean boundary layer depth, in m. - type(coupler_2d_bc_type) :: fields !< A structure that may contain an - !! array of named tracer-related fields. - integer :: avg_kount !< Used for accumulating averages of this type. + type(coupler_2d_bc_type) :: fields !< A structure that may contain named + !! arrays of tracer-related surface fields. + integer :: avg_kount !< A count of contributions to running + !! sums, used externally by the FMS coupler + !! for accumulating averages of this type. integer, dimension(2) :: axes = 0 !< Axis numbers that are available - ! for I/O using this surface data. + !! for I/O using this surface data. end type ocean_public_type -!> Contains information about the ocean state, although it is not necessary that -!! this is implemented with all models. This type is NOT private, and can therefore CANNOT vary -!! between different ocean models. -type, public :: ocean_state_type - logical :: is_ocean_PE = .false. !< True if this is an ocean PE. - type(time_type) :: Time !< The ocean model's time and master clock. - integer :: Restart_control !< An integer that is bit-tested to determine whether - !! incremental restart files are saved and whether they - !! have a time stamped name. +1 (bit 0) for generic - !! files and +2 (bit 1) for time-stamped files. A - !! restart file is saved at the end of a run segment - !! unless Restart_control is negative. +!> The ocean_state_type contains all information about the state of the ocean, +!! with a format that is private so it can be readily changed without disrupting +!! other coupled components. +type, public :: ocean_state_type ; + ! This type is private, and can therefore vary between different ocean models. + logical :: is_ocean_PE = .false. !< True if this is an ocean PE. + type(time_type) :: Time !< The ocean model's time and master clock. + integer :: Restart_control !< An integer that is bit-tested to determine whether + !! incremental restart files are saved and whether they + !! have a time stamped name. +1 (bit 0) for generic + !! files and +2 (bit 1) for time-stamped files. A + !! restart file is saved at the end of a run segment + !! unless Restart_control is negative. + integer :: nstep = 0 !< The number of calls to update_ocean. logical :: use_ice_shelf !< If true, the ice shelf model is enabled. - logical :: icebergs_apply_rigid_boundary !< If true, the icebergs can change ocean bd condition. - real :: kv_iceberg !< The viscosity of the icebergs in m2/s (for ice rigidity) - real :: berg_area_threshold !< Fraction of grid cell which iceberg must occupy - !! so that fluxes below are set to zero. (0.5 is a - !! good value to use. Not applied for negative values. - real :: latent_heat_fusion !< Latent heat of fusion - real :: density_iceberg !< A typical density of icebergs in kg/m3 (for ice rigidity) - type(ice_shelf_CS), pointer :: Ice_shelf_CSp => NULL() !< ice shelf structure. + logical :: use_waves !< If true use wave coupling. + + logical :: icebergs_alter_ocean !< If true, the icebergs can change ocean the + !! ocean dynamics and forcing fluxes. logical :: restore_salinity !< If true, the coupled MOM driver adds a term to !! restore salinity to a specified value. logical :: restore_temp !< If true, the coupled MOM driver adds a term to @@ -186,23 +171,49 @@ module MOM_ocean_model !! fields necessary to integrate only the tracer advection !! and diffusion equation read in from files stored from !! a previous integration of the prognostic model. - type(directories) :: dirs !< A structure containing several relevant directory paths. - type(mech_forcing) :: forces!< A structure with the driving mechanical surface forces - type(forcing) :: fluxes !< A structure containing pointers to - !! the ocean forcing fields. - type(forcing) :: flux_tmp !< A secondary structure containing pointers to the + + logical :: single_step_call !< If true, advance the state of MOM with a single + !! step including both dynamics and thermodynamics. + !! If false, the two phases are advanced with + !! separate calls. The default is true. + ! The following 3 variables are only used here if single_step_call is false. + real :: dt !< (baroclinic) dynamics time step (seconds) + real :: dt_therm !< thermodynamics time step (seconds) + logical :: thermo_spans_coupling !< If true, thermodynamic and tracer time + !! steps can span multiple coupled time steps. + logical :: diabatic_first !< If true, apply diabatic and thermodynamic + !! processes before time stepping the dynamics. + + type(directories) :: dirs !< A structure containing several relevant directory paths. + type(mech_forcing) :: forces !< A structure with the driving mechanical surface forces + type(forcing) :: fluxes !< A structure containing pointers to + !! the thermodynamic ocean forcing fields. + type(forcing) :: flux_tmp !< A secondary structure containing pointers to the !! ocean forcing fields for when multiple coupled !! timesteps are taken per thermodynamic step. - type(surface) :: sfc_state !< A structure containing pointers to + type(surface) :: sfc_state !< A structure containing pointers to !! the ocean surface state fields. - type(ocean_grid_type), pointer :: grid => NULL() !< A pointer to a grid structure - !! containing metrics and related information. - type(verticalGrid_type), pointer :: GV => NULL() !< A pointer to a vertical grid - !! structure containing metrics and related information. + type(ocean_grid_type), pointer :: & + grid => NULL() !< A pointer to a grid structure containing metrics + !! and related information. + type(verticalGrid_type), pointer :: & + GV => NULL() !< A pointer to a structure containing information + !! about the vertical grid. type(unit_scale_type), pointer :: US => NULL() !< A pointer to a structure containing !! dimensional unit scaling factors. - type(MOM_control_struct), pointer :: MOM_CSp => NULL() - type(surface_forcing_CS), pointer :: forcing_CSp => NULL() + type(MOM_control_struct), pointer :: & + MOM_CSp => NULL() !< A pointer to the MOM control structure + type(ice_shelf_CS), pointer :: & + Ice_shelf_CSp => NULL() !< A pointer to the control structure for the + !! ice shelf model that couples with MOM6. This + !! is null if there is no ice shelf. + type(marine_ice_CS), pointer :: & + marine_ice_CSp => NULL() !< A pointer to the control structure for the + !! marine ice effects module. + type(wave_parameters_cs), pointer :: & + Waves !< A structure containing pointers to the surface wave fields + type(surface_forcing_CS), pointer :: & + forcing_CSp => NULL() !< A pointer to the MOM forcing control structure type(MOM_restart_CS), pointer :: & restart_CSp => NULL() !< A pointer set to the restart control structure !! that will be used for MOM restart files. @@ -210,26 +221,19 @@ module MOM_ocean_model diag => NULL() !< A pointer to the diagnostic regulatory structure end type ocean_state_type -integer :: id_clock_forcing - -!======================================================================= contains -!======================================================================= - -!======================================================================= -! -! -! -! Initialize the ocean model. -! -!> Initializes the ocean model, including registering fields +!> ocean_model_init initializes the ocean model, including registering fields !! for restarts and reading restart files if appropriate. +!! +!! This subroutine initializes both the ocean state and the ocean surface type. +!! Because of the way that indicies and domains are handled, Ocean_sfc must have +!! been used in a previous call to initialize_ocean_type. subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, gas_fields_ocn, input_restart_file) type(ocean_public_type), target, & - intent(inout) :: Ocean_sfc !< A structure containing various - !! publicly visible ocean surface properties after initialization, - !! the data in this type is intent(out). + intent(inout) :: Ocean_sfc !< A structure containing various publicly + !! visible ocean surface properties after initialization, + !! the data in this type is intent out. type(ocean_state_type), pointer :: OS !< A structure whose internal !! contents are private to ocean_model_mod that may be used to !! contain all information about the ocean's interior state. @@ -242,28 +246,24 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, gas_fields_ocn, i !! tracer fluxes, and can be used to spawn related !! internal variables in the ice model. character(len=*), optional, intent(in) :: input_restart_file !< If present, name of restart file to read - -! This subroutine initializes both the ocean state and the ocean surface type. -! Because of the way that indicies and domains are handled, Ocean_sfc must have -! been used in a previous call to initialize_ocean_type. - - real :: Rho0 !< The Boussinesq ocean density [kg m-3]. - real :: G_Earth !< The gravitational acceleration [m s-2]. - !! This include declares and sets the variable "version". - real :: HFrz !< If HFrz > 0 (m), melt potential will be computed. - !! The actual depth over which melt potential is computed will - !! min(HFrz, OBLD), where OBLD is the boundary layer depth. - !! If HFrz <= 0 (default), melt potential will not be computed. + ! Local variables + real :: Rho0 ! The Boussinesq ocean density, in kg m-3. + real :: G_Earth ! The gravitational acceleration in m s-2. + real :: HFrz !< If HFrz > 0 (m), melt potential will be computed. + !! The actual depth over which melt potential is computed will + !! min(HFrz, OBLD), where OBLD is the boundary layer depth. + !! If HFrz <= 0 (default), melt potential will not be computed. logical :: use_melt_pot!< If true, allocate melt_potential array +! This include declares and sets the variable "version". #include "version_variable.h" - character(len=40) :: mdl = "ocean_model_init" !< This module's name. + character(len=40) :: mdl = "ocean_model_init" ! This module's name. character(len=48) :: stagger - logical :: use_temperature integer :: secs, days type(param_file_type) :: param_file !< A structure to parse for run-time parameters + logical :: use_temperature - call callTree_enter("ocean_model_init(), ocn_comp_mct.F90") + call callTree_enter("ocean_model_init(), ocean_model_MOM.F90") if (associated(OS)) then call MOM_error(WARNING, "ocean_model_init called with an associated "// & "ocean_state_type structure. Model is already initialized.") @@ -277,14 +277,41 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, gas_fields_ocn, i OS%Time = Time_in call initialize_MOM(OS%Time, Time_init, param_file, OS%dirs, OS%MOM_CSp, & OS%restart_CSp, Time_in, offline_tracer_mode=OS%offline_tracer_mode, & - input_restart_file=input_restart_file, diag_ptr=OS%diag, & - count_calls=.true.) - call get_MOM_state_elements(OS%MOM_CSp, G=OS%grid, GV=OS%GV, US=OS%US, C_p=OS%fluxes%C_p, & + input_restart_file=input_restart_file, & + diag_ptr=OS%diag, count_calls=.true.) + call get_MOM_state_elements(OS%MOM_CSp, G=OS%grid, GV=OS%GV, US=OS%US, C_p=OS%C_p, & use_temp=use_temperature) - OS%C_p = OS%fluxes%C_p + OS%fluxes%C_p = OS%C_p ! Read all relevant parameters and write them to the model log. call log_version(param_file, mdl, version, "") + + call get_param(param_file, mdl, "SINGLE_STEPPING_CALL", OS%single_step_call, & + "If true, advance the state of MOM with a single step "//& + "including both dynamics and thermodynamics. If false, "//& + "the two phases are advanced with separate calls.", default=.true.) + call get_param(param_file, mdl, "DT", OS%dt, & + "The (baroclinic) dynamics time step. The time-step that "//& + "is actually used will be an integer fraction of the "//& + "forcing time-step.", units="s", fail_if_missing=.true.) + call get_param(param_file, mdl, "DT_THERM", OS%dt_therm, & + "The thermodynamic and tracer advection time step. "//& + "Ideally DT_THERM should be an integer multiple of DT "//& + "and less than the forcing or coupling time-step, unless "//& + "THERMO_SPANS_COUPLING is true, in which case DT_THERM "//& + "can be an integer multiple of the coupling timestep. By "//& + "default DT_THERM is set to DT.", units="s", default=OS%dt) + call get_param(param_file, "MOM", "THERMO_SPANS_COUPLING", OS%thermo_spans_coupling, & + "If true, the MOM will take thermodynamic and tracer "//& + "timesteps that can be longer than the coupling timestep. "//& + "The actual thermodynamic timestep that is used in this "//& + "case is the largest integer multiple of the coupling "//& + "timestep that is less than or equal to DT_THERM.", default=.false.) + call get_param(param_file, mdl, "DIABATIC_FIRST", OS%diabatic_first, & + "If true, apply diabatic and thermodynamic processes, "//& + "including buoyancy forcing and mass gain or loss, "//& + "before stepping the dynamics forward.", default=.false.) + call get_param(param_file, mdl, "RESTART_CONTROL", OS%Restart_control, & "An integer whose bits encode which restart files are "//& "written. Add 2 (bit 1) for a time-stamped file, and odd "//& @@ -296,16 +323,11 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, gas_fields_ocn, i "staggering of the surface velocity field that is "//& "returned to the coupler. Valid values include "//& "'A', 'B', or 'C'.", default="C") - if (uppercase(stagger(1:1)) == 'A') then - Ocean_sfc%stagger = AGRID - elseif (uppercase(stagger(1:1)) == 'B') then - Ocean_sfc%stagger = BGRID_NE - elseif (uppercase(stagger(1:1)) == 'C') then - Ocean_sfc%stagger = CGRID_NE - else - call MOM_error(FATAL,"ocean_model_init: OCEAN_SURFACE_STAGGER = "// & - trim(stagger)//" is invalid.") - end if + if (uppercase(stagger(1:1)) == 'A') then ; Ocean_sfc%stagger = AGRID + elseif (uppercase(stagger(1:1)) == 'B') then ; Ocean_sfc%stagger = BGRID_NE + elseif (uppercase(stagger(1:1)) == 'C') then ; Ocean_sfc%stagger = CGRID_NE + else ; call MOM_error(FATAL,"ocean_model_init: OCEAN_SURFACE_STAGGER = "// & + trim(stagger)//" is invalid.") ; endif call get_param(param_file, mdl, "RESTORE_SALINITY",OS%restore_salinity, & "If true, the coupled driver will add a globally-balanced "//& @@ -328,26 +350,23 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, gas_fields_ocn, i call get_param(param_file, mdl, "ICE_SHELF", OS%use_ice_shelf, & "If true, enables the ice shelf model.", default=.false.) - call get_param(param_file, mdl, "ICEBERGS_APPLY_RIGID_BOUNDARY", OS%icebergs_apply_rigid_boundary, & + call get_param(param_file, mdl, "ICEBERGS_APPLY_RIGID_BOUNDARY", OS%icebergs_alter_ocean, & "If true, allows icebergs to change boundary condition felt by ocean", default=.false.) - if (OS%icebergs_apply_rigid_boundary) then - call get_param(param_file, mdl, "KV_ICEBERG", OS%kv_iceberg, & - "The viscosity of the icebergs", units="m2 s-1",default=1.0e10) - call get_param(param_file, mdl, "DENSITY_ICEBERGS", OS%density_iceberg, & - "A typical density of icebergs.", units="kg m-3", default=917.0) - call get_param(param_file, mdl, "LATENT_HEAT_FUSION", OS%latent_heat_fusion, & - "The latent heat of fusion.", units="J/kg", default=hlf) - call get_param(param_file, mdl, "BERG_AREA_THRESHOLD", OS%berg_area_threshold, & - "Fraction of grid cell which iceberg must occupy, so that fluxes "//& - "below berg are set to zero. Not applied for negative "//& - " values.", units="non-dim", default=-1.0) - endif + ! MV: question for Gustavo - what to do with the following? - OS%press_to_z = 1.0/(Rho0*G_Earth) + ! call get_param(param_file, mdl, "KV_ICEBERG", OS%kv_iceberg, & + ! "The viscosity of the icebergs", units="m2 s-1",default=1.0e10) + ! call get_param(param_file, mdl, "DENSITY_ICEBERGS", OS%density_iceberg, & + ! "A typical density of icebergs.", units="kg m-3", default=917.0) + ! call get_param(param_file, mdl, "LATENT_HEAT_FUSION", OS%latent_heat_fusion, & + ! "The latent heat of fusion.", units="J/kg", default=hlf) + ! call get_param(param_file, mdl, "BERG_AREA_THRESHOLD", OS%berg_area_threshold, & + ! "Fraction of grid cell which iceberg must occupy, so that fluxes "//& + ! "below berg are set to zero. Not applied for negative "//& + ! " values.", units="non-dim", default=-1.0) - ! Consider using a run-time flag to determine whether to do the diagnostic - ! vertical integrals, since the related 3-d sums are not negligible in cost. + OS%press_to_z = 1.0/(Rho0*G_Earth) call get_param(param_file, mdl, "HFREEZE", HFrz, & "If HFREEZE > 0, melt potential will be computed. The actual depth "//& @@ -361,8 +380,10 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, gas_fields_ocn, i use_melt_pot=.false. endif - call allocate_surface_state(OS%sfc_state, OS%grid, use_temperature, do_integrals=.true., & - gas_fields_ocn=gas_fields_ocn, use_meltpot=use_melt_pot) + ! Consider using a run-time flag to determine whether to do the diagnostic + ! vertical integrals, since the related 3-d sums are not negligible in cost. + call allocate_surface_state(OS%sfc_state, OS%grid, use_temperature, & + do_integrals=.true., gas_fields_ocn=gas_fields_ocn, use_meltpot=use_melt_pot) call surface_forcing_init(Time_in, OS%grid, OS%US, param_file, OS%diag, & OS%forcing_CSp, OS%restore_salinity, OS%restore_temp) @@ -371,12 +392,28 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, gas_fields_ocn, i call initialize_ice_shelf(param_file, OS%grid, OS%Time, OS%ice_shelf_CSp, & OS%diag, OS%forces, OS%fluxes) endif - if (OS%icebergs_apply_rigid_boundary) then - !call allocate_forcing_type(OS%grid, OS%fluxes, iceberg=.true.) - !This assumes that the iceshelf and ocean are on the same grid. I hope this is true - if (.not. OS%use_ice_shelf) call allocate_forcing_type(OS%grid, OS%fluxes, ustar=.true., shelf=.true.) + + if (OS%icebergs_alter_ocean) then + call marine_ice_init(OS%Time, OS%grid, param_file, OS%diag, OS%marine_ice_CSp) + if (.not. OS%use_ice_shelf) & + call allocate_forcing_type(OS%grid, OS%fluxes, shelf=.true.) + endif + + call get_param(param_file, mdl, "USE_WAVES", OS%Use_Waves, & + "If true, enables surface wave modules.", default=.false.) + if (OS%use_waves) then + call MOM_wave_interface_init(OS%Time, OS%grid, OS%GV, OS%US, param_file, OS%Waves, OS%diag) + else + call MOM_wave_interface_init_lite(param_file) endif + ! MV - what to do with the following? + ! if (OS%icebergs_apply_rigid_boundary) then + ! !call allocate_forcing_type(OS%grid, OS%fluxes, iceberg=.true.) + ! !This assumes that the iceshelf and ocean are on the same grid. I hope this is true + ! if (.not. OS%use_ice_shelf) call allocate_forcing_type(OS%grid, OS%fluxes, ustar=.true., shelf=.true.) + ! endif + if (associated(OS%grid%Domain%maskmap)) then call initialize_ocean_public_type(OS%grid%Domain%mpp_domain, Ocean_sfc, & OS%diag, maskmap=OS%grid%Domain%maskmap, & @@ -389,6 +426,9 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, gas_fields_ocn, i ! This call can only occur here if the coupler_bc_type variables have been ! initialized already using the information from gas_fields_ocn. if (present(gas_fields_ocn)) then + call coupler_type_set_diags(Ocean_sfc%fields, "ocean_sfc", & + Ocean_sfc%axes(1:2), Time_in) + call extract_surface_state(OS%MOM_CSp, OS%sfc_state) call convert_state_to_ocean_type(OS%sfc_state, Ocean_sfc, OS%grid) @@ -397,60 +437,69 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, gas_fields_ocn, i call close_param_file(param_file) call diag_mediator_close_registration(OS%diag) - call callTree_leave("ocean_model_init(") + if (is_root_pe()) & + write(*,'(/12x,a/)') '======== COMPLETED MOM INITIALIZATION ========' + call callTree_leave("ocean_model_init(") end subroutine ocean_model_init -! NAME="ocean_model_init" -!======================================================================= -! -! -! -! Update in time the ocean model fields. This code wraps the call to step_MOM -! with MOM4's call. -! -! - -!> Updates the ocean model fields. This code wraps the call to step_MOM with MOM6's call. -!! It uses the forcing to advance the ocean model's state from the -!! input value of Ocean_state (which must be for time time_start_update) for a time interval -!! of Ocean_coupling_time_step, returning the publicly visible ocean surface properties in -!! Ocean_sfc and storing the new ocean properties in Ocean_state. +!> update_ocean_model uses the forcing in Ice_ocean_boundary to advance the +!! ocean model's state from the input value of Ocean_state (which must be for +!! time time_start_update) for a time interval of Ocean_coupling_time_step, +!! returning the publicly visible ocean surface properties in Ocean_sfc and +!! storing the new ocean properties in Ocean_state. subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & - time_start_update, Ocean_coupling_time_step) - + time_start_update, Ocean_coupling_time_step, & + update_dyn, update_thermo, Ocn_fluxes_used) type(ice_ocean_boundary_type), & intent(in) :: Ice_ocean_boundary !< A structure containing the !! various forcing fields coming from the ice. - type(ocean_state_type), & pointer :: OS !< A pointer to a private structure containing !! the internal ocean state. - type(ocean_public_type), & intent(inout) :: Ocean_sfc !< A structure containing all the !! publicly visible ocean surface fields after !! a coupling time step. The data in this type is !! intent out. - type(time_type), intent(in) :: time_start_update !< The time at the beginning of the update step. type(time_type), intent(in) :: Ocean_coupling_time_step !< The amount of time over !! which to advance the ocean. - - ! local variables - type(time_type) :: Master_time !< This allows step_MOM to temporarily change - !! the time that is seen by internal modules. - type(time_type) :: Time1 !< The value of the ocean model's time at the - !! start of a call to step_MOM. - integer :: index_bnds(4) ! The computational domain index bounds in the ice-ocn boundary type - real :: weight !< Flux accumulation weight - real :: time_step !< The time step of a call to step_MOM in seconds. + logical, optional, intent(in) :: update_dyn !< If present and false, do not do updates + !! due to the ocean dynamics. + logical, optional, intent(in) :: update_thermo !< If present and false, do not do updates + !! due to the ocean thermodynamics or remapping. + logical, optional, intent(in) :: Ocn_fluxes_used !< If present, this indicates whether the + !! cumulative thermodynamic fluxes from the ocean, + !! like frazil, have been used and should be reset. + ! Local variables + type(time_type) :: Master_time ! This allows step_MOM to temporarily change + ! the time that is seen by internal modules. + type(time_type) :: Time1 ! The value of the ocean model's time at the + ! start of a call to step_MOM. + integer :: index_bnds(4) ! The computational domain index bounds in the + ! ice-ocean boundary type. + real :: weight ! Flux accumulation weight + real :: dt_coupling ! The coupling time step in seconds. + integer :: nts ! The number of baroclinic dynamics time steps + ! within dt_coupling. + real :: dt_therm ! A limited and quantized version of OS%dt_therm (sec) + real :: dt_dyn ! The dynamics time step in sec. + real :: dtdia ! The diabatic time step in sec. + real :: t_elapsed_seg ! The elapsed time in this update segment, in s. + integer :: n, n_max, n_last_thermo + type(time_type) :: Time2 ! A temporary time. + logical :: thermo_does_span_coupling ! If true, thermodynamic forcing spans + ! multiple dynamic timesteps. + logical :: do_dyn ! If true, step the ocean dynamics and transport. + logical :: do_thermo ! If true, step the ocean thermodynamics. + logical :: step_thermo ! If true, take a thermodynamic step. integer :: secs, days integer :: is, ie, js, je call callTree_enter("update_ocean_model(), MOM_ocean_model.F90") call get_time(Ocean_coupling_time_step, secs, days) - time_step = 86400.0*real(days) + real(secs) + dt_coupling = 86400.0*real(days) + real(secs) if (time_start_update /= OS%Time) then call MOM_error(WARNING, "update_ocean_model: internal clock does not "//& @@ -464,6 +513,9 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & return endif + do_dyn = .true. ; if (present(update_dyn)) do_dyn = update_dyn + do_thermo = .true. ; if (present(update_thermo)) do_thermo = update_thermo + ! This is benign but not necessary if ocean_model_init_sfc was called or if ! OS%sfc_state%tr_fields was spawned in ocean_model_init. Consider removing it. is = OS%grid%isc ; ie = OS%grid%iec ; js = OS%grid%jsc ; je = OS%grid%jec @@ -481,62 +533,84 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & if (OS%fluxes%fluxes_used) then ! GMM, is enable_averaging needed now? - call enable_averaging(time_step, OS%Time + Ocean_coupling_time_step, OS%diag) - - ! Import fluxes from coupler to ocean. Also, perform do SST and SSS restoring, if needed. - call convert_IOB_to_fluxes(Ice_ocean_boundary, OS%fluxes, OS%Time, OS%grid, OS%US, OS%forcing_CSp, & - OS%sfc_state, OS%restore_salinity, OS%restore_temp) - - ! Fields that exist in both the forcing and mech_forcing types must be copied. - call copy_common_forcing_fields(OS%forces, OS%fluxes, OS%grid) - -#ifdef _USE_GENERIC_TRACER - call MOM_generic_tracer_fluxes_accumulate(OS%fluxes, weight) !here weight=1, just saving the current fluxes -#endif + call enable_averaging(dt_coupling, OS%Time + Ocean_coupling_time_step, OS%diag) + if (do_thermo) & + call convert_IOB_to_fluxes(Ice_ocean_boundary, OS%fluxes, index_bnds, OS%Time, & + OS%grid, OS%US, OS%forcing_CSp, OS%sfc_state, & + OS%restore_salinity, OS%restore_temp) + ! Add ice shelf fluxes if (OS%use_ice_shelf) then - call shelf_calc_flux(OS%sfc_state, OS%fluxes, OS%Time, time_step, OS%Ice_shelf_CSp) - call add_shelf_forces(OS%grid, OS%Ice_shelf_CSp, OS%forces) + if (do_thermo) & + call shelf_calc_flux(OS%sfc_state, OS%fluxes, OS%Time, dt_coupling, OS%Ice_shelf_CSp) + if (do_dyn) & + call add_shelf_forces(OS%grid, OS%Ice_shelf_CSp, OS%forces) + endif + if (OS%icebergs_alter_ocean) then + if (do_dyn) & + call iceberg_forces(OS%grid, OS%forces, OS%use_ice_shelf, & + OS%sfc_state, dt_coupling, OS%marine_ice_CSp) + if (do_thermo) & + call iceberg_fluxes(OS%grid, OS%fluxes, OS%use_ice_shelf, & + OS%sfc_state, dt_coupling, OS%marine_ice_CSp) endif ! GMM, check ocean_model_MOM.F90 to enable the following option !if (OS%icebergs_apply_rigid_boundary) then ! This assumes that the iceshelf and ocean are on the same grid. I hope this is true. ! call add_berg_flux_to_shelf(OS%grid, OS%forces,OS%fluxes,OS%use_ice_shelf,OS%density_iceberg, & - ! OS%kv_iceberg, OS%latent_heat_fusion, OS%sfc_state, time_step, OS%berg_area_threshold) + ! OS%kv_iceberg, OS%latent_heat_fusion, OS%sfc_state, dt_coupling, OS%berg_area_threshold) !endif + ! Fields that exist in both the forcing and mech_forcing types must be copied. + call copy_common_forcing_fields(OS%forces, OS%fluxes, OS%grid) + +#ifdef _USE_GENERIC_TRACER + call enable_averaging(dt_coupling, OS%Time + Ocean_coupling_time_step, OS%diag) !Is this needed? + call MOM_generic_tracer_fluxes_accumulate(OS%fluxes, weight) !here weight=1, just saving the current fluxes +#endif + ! Indicate that there are new unused fluxes. OS%fluxes%fluxes_used = .false. - OS%fluxes%dt_buoy_accum = time_step + OS%fluxes%dt_buoy_accum = dt_coupling else OS%flux_tmp%C_p = OS%fluxes%C_p - ! Import fluxes from coupler to ocean. Also, perform do SST and SSS restoring, if needed. - call convert_IOB_to_fluxes(Ice_ocean_boundary, OS%fluxes, OS%Time, OS%grid, OS%US, OS%forcing_CSp, & - OS%sfc_state, OS%restore_salinity, OS%restore_temp) + if (do_thermo) & + call convert_IOB_to_fluxes(Ice_ocean_boundary, OS%flux_tmp, index_bnds, OS%Time, & + OS%grid, OS%US, OS%forcing_CSp, OS%sfc_state, OS%restore_salinity,OS%restore_temp) if (OS%use_ice_shelf) then - call shelf_calc_flux(OS%sfc_state, OS%flux_tmp, OS%Time, time_step, OS%Ice_shelf_CSp) - call add_shelf_forces(OS%grid, OS%Ice_shelf_CSp, OS%forces) + if (do_thermo) & + call shelf_calc_flux(OS%sfc_state, OS%flux_tmp, OS%Time, dt_coupling, OS%Ice_shelf_CSp) + if (do_dyn) & + call add_shelf_forces(OS%grid, OS%Ice_shelf_CSp, OS%forces) + endif + if (OS%icebergs_alter_ocean) then + if (do_dyn) & + call iceberg_forces(OS%grid, OS%forces, OS%use_ice_shelf, & + OS%sfc_state, dt_coupling, OS%marine_ice_CSp) + if (do_thermo) & + call iceberg_fluxes(OS%grid, OS%flux_tmp, OS%use_ice_shelf, & + OS%sfc_state, dt_coupling, OS%marine_ice_CSp) endif ! GMM, check ocean_model_MOM.F90 to enable the following option !if (OS%icebergs_apply_rigid_boundary) then !This assumes that the iceshelf and ocean are on the same grid. I hope this is true ! call add_berg_flux_to_shelf(OS%grid, OS%forces, OS%flux_tmp, OS%use_ice_shelf,OS%density_iceberg, & - ! OS%kv_iceberg, OS%latent_heat_fusion, OS%sfc_state, time_step, OS%berg_area_threshold) + ! OS%kv_iceberg, OS%latent_heat_fusion, OS%sfc_state, dt_coupling, OS%berg_area_threshold) !endif - ! Accumulate the forcing over time steps - call forcing_accumulate(OS%flux_tmp, OS%forces, OS%fluxes, time_step, OS%grid, weight) + call forcing_accumulate(OS%flux_tmp, OS%forces, OS%fluxes, dt_coupling, OS%grid, weight) ! Some of the fields that exist in both the forcing and mech_forcing types - ! are time-averages must be copied back to the forces type. + ! (e.g., ustar) are time-averages must be copied back to the forces type. call copy_back_forcing_fields(OS%fluxes, OS%forces, OS%grid) + #ifdef _USE_GENERIC_TRACER call MOM_generic_tracer_fluxes_accumulate(OS%flux_tmp, weight) !weight of the current flux in the running average #endif @@ -545,6 +619,10 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & call set_derived_forcing_fields(OS%forces, OS%fluxes, OS%grid, OS%US, OS%GV%Rho0) call set_net_mass_forcing(OS%fluxes, OS%forces, OS%grid) + if (OS%use_waves) then + call Update_Surface_Waves(OS%grid, OS%GV, OS%US, OS%time, ocean_coupling_time_step, OS%waves) + endif + if (OS%nstep==0) then call finish_MOM_initialization(OS%Time, OS%dirs, OS%MOM_CSp, OS%restart_CSp) endif @@ -553,16 +631,81 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & Master_time = OS%Time ; Time1 = OS%Time if(OS%offline_tracer_mode) then - call step_offline(OS%forces, OS%fluxes, OS%sfc_state, Time1, time_step, OS%MOM_CSp) + call step_offline(OS%forces, OS%fluxes, OS%sfc_state, Time1, dt_coupling, OS%MOM_CSp) + + elseif ((.not.do_thermo) .or. (.not.do_dyn)) then + ! The call sequence is being orchestrated from outside of update_ocean_model. + call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, Time1, dt_coupling, OS%MOM_CSp, & + Waves=OS%Waves, do_dynamics=do_thermo, do_thermodynamics=do_dyn, & + reset_therm=Ocn_fluxes_used) + + elseif (OS%single_step_call) then + call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, Time1, dt_coupling, OS%MOM_CSp, Waves=OS%Waves) + else - call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, Time1, time_step, OS%MOM_CSp) + n_max = 1 ; if (dt_coupling > OS%dt) n_max = ceiling(dt_coupling/OS%dt - 0.001) + dt_dyn = dt_coupling / real(n_max) + thermo_does_span_coupling = (OS%thermo_spans_coupling .and. & + (OS%dt_therm > 1.5*dt_coupling)) + + if (thermo_does_span_coupling) then + dt_therm = dt_coupling * floor(OS%dt_therm / dt_coupling + 0.001) + nts = floor(dt_therm/dt_dyn + 0.001) + else + nts = MAX(1,MIN(n_max,floor(OS%dt_therm/dt_dyn + 0.001))) + n_last_thermo = 0 + endif + + Time2 = Time1 ; t_elapsed_seg = 0.0 + do n=1,n_max + if (OS%diabatic_first) then + if (thermo_does_span_coupling) call MOM_error(FATAL, & + "MOM is not yet set up to have restarts that work with "//& + "THERMO_SPANS_COUPLING and DIABATIC_FIRST.") + if (modulo(n-1,nts)==0) then + dtdia = dt_dyn*min(nts,n_max-(n-1)) + call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, Time2, dtdia, OS%MOM_CSp, & + Waves=OS%Waves, do_dynamics=.false., do_thermodynamics=.true., & + start_cycle=(n==1), end_cycle=.false., cycle_length=dt_coupling) + endif + + call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, Time2, dt_dyn, OS%MOM_CSp, & + Waves=OS%Waves, do_dynamics=.true., do_thermodynamics=.false., & + start_cycle=.false., end_cycle=(n==n_max), cycle_length=dt_coupling) + else + call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, Time2, dt_dyn, OS%MOM_CSp, & + Waves=OS%Waves, do_dynamics=.true., do_thermodynamics=.false., & + start_cycle=(n==1), end_cycle=.false., cycle_length=dt_coupling) + + step_thermo = .false. + if (thermo_does_span_coupling) then + dtdia = dt_therm + step_thermo = MOM_state_is_synchronized(OS%MOM_CSp, adv_dyn=.true.) + elseif ((modulo(n,nts)==0) .or. (n==n_max)) then + dtdia = dt_dyn*(n - n_last_thermo) + n_last_thermo = n + step_thermo = .true. + endif + + if (step_thermo) then + ! Back up Time2 to the start of the thermodynamic segment. + Time2 = Time2 - set_time(int(floor((dtdia - dt_dyn) + 0.5))) + call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, Time2, dtdia, OS%MOM_CSp, & + Waves=OS%Waves, do_dynamics=.false., do_thermodynamics=.true., & + start_cycle=.false., end_cycle=(n==n_max), cycle_length=dt_coupling) + endif + endif + + t_elapsed_seg = t_elapsed_seg + dt_dyn + Time2 = Time1 + set_time(int(floor(t_elapsed_seg + 0.5))) + enddo endif OS%Time = Master_time + Ocean_coupling_time_step OS%nstep = OS%nstep + 1 - call enable_averaging(time_step, OS%Time, OS%diag) - call mech_forcing_diags(OS%forces, time_step, OS%grid, OS%diag, OS%forcing_CSp%handles) + call enable_averaging(dt_coupling, OS%Time, OS%diag) + call mech_forcing_diags(OS%forces, dt_coupling, OS%grid, OS%diag, OS%forcing_CSp%handles) call disable_averaging(OS%diag) if (OS%fluxes%fluxes_used) then @@ -576,28 +719,20 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & ! call convert_state_to_ocean_type(OS%sfc_state, Ocean_sfc, OS%grid, & ! Ice_ocean_boundary%p, OS%press_to_z) call convert_state_to_ocean_type(OS%sfc_state, Ocean_sfc, OS%grid) + call coupler_type_send_data(Ocean_sfc%fields, OS%Time) call callTree_leave("update_ocean_model()") - end subroutine update_ocean_model -! NAME="update_ocean_model" -!======================================================================= -! -! -! -! write out restart file. -! Arguments: -! timestamp (optional, intent(in)) : A character string that represents the model time, -! used for writing restart. timestamp will prepend to -! the any restart file name as a prefix. -! -! -subroutine ocean_model_restart(OS, timestamp) +!> This subroutine writes out the ocean model restart file. +subroutine ocean_model_restart(OS, timestamp, restartname) type(ocean_state_type), pointer :: OS !< A pointer to the structure containing the !! internal ocean state being saved to a restart file character(len=*), optional, intent(in) :: timestamp !< An optional timestamp string that should be !! prepended to the file name. (Currently this is unused.) + character(len=*), optional, intent(in) :: restartname !< Name of restart file to use + !! This option distinguishes the cesm interface from the + !! non-cesm interface if (.not.MOM_state_is_synchronized(OS%MOM_CSp)) & call MOM_error(WARNING, "End of MOM_main reached with inconsistent "//& @@ -607,54 +742,56 @@ subroutine ocean_model_restart(OS, timestamp) "was called with unused buoyancy fluxes. For conservation, the ocean "//& "restart files can only be created after the buoyancy forcing is applied.") - if (BTEST(OS%Restart_control,1)) then - call save_restart(OS%dirs%restart_output_dir, OS%Time, OS%grid, & - OS%restart_CSp, .true., GV=OS%GV) - call forcing_save_restart(OS%forcing_CSp, OS%grid, OS%Time, & - OS%dirs%restart_output_dir, .true.) - if (OS%use_ice_shelf) then - call ice_shelf_save_restart(OS%Ice_shelf_CSp, OS%Time, OS%dirs%restart_output_dir, .true.) - endif - endif - if (BTEST(OS%Restart_control,0)) then - call save_restart(OS%dirs%restart_output_dir, OS%Time, OS%grid, & - OS%restart_CSp, GV=OS%GV) - call forcing_save_restart(OS%forcing_CSp, OS%grid, OS%Time, & - OS%dirs%restart_output_dir) - if (OS%use_ice_shelf) then - call ice_shelf_save_restart(OS%Ice_shelf_CSp, OS%Time, OS%dirs%restart_output_dir) - endif - endif + if (present(restartname)) then + call save_restart(OS%dirs%restart_output_dir, OS%Time, OS%grid, & + OS%restart_CSp, GV=OS%GV, filename=restartname) + call forcing_save_restart(OS%forcing_CSp, OS%grid, OS%Time, & + OS%dirs%restart_output_dir) ! Is this needed? + if (OS%use_ice_shelf) then + call ice_shelf_save_restart(OS%Ice_shelf_CSp, OS%Time, & + OS%dirs%restart_output_dir) + endif + else + if (BTEST(OS%Restart_control,1)) then + call save_restart(OS%dirs%restart_output_dir, OS%Time, OS%grid, & + OS%restart_CSp, .true., GV=OS%GV) + call forcing_save_restart(OS%forcing_CSp, OS%grid, OS%Time, & + OS%dirs%restart_output_dir, .true.) + if (OS%use_ice_shelf) then + call ice_shelf_save_restart(OS%Ice_shelf_CSp, OS%Time, OS%dirs%restart_output_dir, .true.) + endif + endif + if (BTEST(OS%Restart_control,0)) then + call save_restart(OS%dirs%restart_output_dir, OS%Time, OS%grid, & + OS%restart_CSp, GV=OS%GV) + call forcing_save_restart(OS%forcing_CSp, OS%grid, OS%Time, & + OS%dirs%restart_output_dir) + if (OS%use_ice_shelf) then + call ice_shelf_save_restart(OS%Ice_shelf_CSp, OS%Time, OS%dirs%restart_output_dir) + endif + endif + end if end subroutine ocean_model_restart ! NAME="ocean_model_restart" -!======================================================================= -! -! -! -! Close down the ocean model -! - -!> Terminates the model run, saving the ocean state in a -!! restart file and deallocating any data associated with the ocean. +!> ocean_model_end terminates the model run, saving the ocean state in a restart +!! and deallocating any data associated with the ocean. subroutine ocean_model_end(Ocean_sfc, Ocean_state, Time) - type(ocean_public_type), intent(inout) :: Ocean_sfc !< An ocean_public_type structure that is to be - !! deallocated upon termination. - type(ocean_state_type), pointer :: Ocean_state!< pointer to the structure containing the internal - ! !! ocean state to be deallocated upon termination. - type(time_type), intent(in) :: Time !< The model time, used for writing restarts. - + type(ocean_public_type), intent(inout) :: Ocean_sfc !< An ocean_public_type structure that is + !! to be deallocated upon termination. + type(ocean_state_type), pointer :: Ocean_state !< A pointer to the structure containing + !! the internal ocean state to be deallocated + !! upon termination. + type(time_type), intent(in) :: Time !< The model time, used for writing restarts. + + call ocean_model_save_restart(Ocean_state, Time) call diag_mediator_end(Time, Ocean_state%diag, end_diag_manager=.true.) ! print time stats call MOM_infra_end call MOM_end(Ocean_state%MOM_CSp) if (Ocean_state%use_ice_shelf) call ice_shelf_end(Ocean_state%Ice_shelf_CSp) - end subroutine ocean_model_end -! NAME="ocean_model_end" - -!======================================================================= !> ocean_model_save_restart causes restart files associated with the ocean to be !! written out. @@ -666,12 +803,6 @@ subroutine ocean_model_save_restart(OS, Time, directory, filename_suffix) !! write these restart files. character(len=*), optional, intent(in) :: filename_suffix !< An optional suffix (e.g., a time-stamp) !! to append to the restart file names. -! Arguments: Ocean_state - A structure containing the internal ocean state (in). -! (in) Time - The model time at this call. This is needed for mpp_write calls. -! (in, opt) directory - An optional directory into which to write these restart files. -! (in, opt) filename_suffix - An optional suffix (e.g., a time-stamp) to append -! to the restart file names. - ! Note: This is a new routine - it will need to exist for the new incremental ! checkpointing. It will also be called by ocean_model_end, giving the same ! restart behavior as now in FMS. @@ -685,11 +816,8 @@ subroutine ocean_model_save_restart(OS, Time, directory, filename_suffix) "was called with unused buoyancy fluxes. For conservation, the ocean "//& "restart files can only be created after the buoyancy forcing is applied.") - if (present(directory)) then - restart_dir = directory - else - restart_dir = OS%dirs%restart_output_dir - endif + if (present(directory)) then ; restart_dir = directory + else ; restart_dir = OS%dirs%restart_output_dir ; endif call save_restart(restart_dir, Time, OS%grid, OS%restart_CSp, GV=OS%GV) @@ -701,23 +829,25 @@ subroutine ocean_model_save_restart(OS, Time, directory, filename_suffix) end subroutine ocean_model_save_restart -!======================================================================= - -!> Initializes domain and state variables contained in the ocean public type. +!> Initialize the public ocean type subroutine initialize_ocean_public_type(input_domain, Ocean_sfc, diag, maskmap, & gas_fields_ocn) - type(domain2D), intent(in) :: input_domain !< The FMS domain for the input structure - type(ocean_public_type), intent(inout) :: Ocean_sfc !< Ocean surface state - type(diag_ctrl), intent(in) :: diag !< A structure used to control diagnostics. - logical, intent(in), optional :: maskmap(:,:) !< A pointer to an array indicating which - !! logical processors are actually used for the ocean code. + type(domain2D), intent(in) :: input_domain !< The ocean model domain description + type(ocean_public_type), intent(inout) :: Ocean_sfc !< A structure containing various publicly + !! visible ocean surface properties after initialization, whose + !! elements are allocated here. + type(diag_ctrl), intent(in) :: diag !< A structure that regulates diagnsotic output + logical, dimension(:,:), & + optional, intent(in) :: maskmap !< A mask indicating which virtual processors + !! are actually in use. If missing, all are used. type(coupler_1d_bc_type), & optional, intent(in) :: gas_fields_ocn !< If present, this type describes the - !! ocean and surface-ice fields that will participate - !! in the calculation of additional gas or other - !! tracer fluxes. - ! local variables + !! ocean and surface-ice fields that will participate + !! in the calculation of additional gas or other + !! tracer fluxes. integer :: xsz, ysz, layout(2) + ! ice-ocean-boundary fields are always allocated using absolute indicies + ! and have no halos. integer :: isc, iec, jsc, jec call mpp_get_layout(input_domain,layout) @@ -757,25 +887,31 @@ subroutine initialize_ocean_public_type(input_domain, Ocean_sfc, diag, maskmap, end subroutine initialize_ocean_public_type -!> Translates the coupler's ocean_data_type into MOM6's surface state variable. -!! This may eventually be folded into the MOM6's code that calculates the -!! surface state in the first place. -subroutine convert_state_to_ocean_type(state, Ocean_sfc, G, patm, press_to_z) - type(surface), intent(inout) :: state - type(ocean_public_type), target, intent(inout) :: Ocean_sfc !< Ocean surface state - type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure - real, optional, intent(in) :: patm(:,:) !< Atmospheric pressure. - real, optional, intent(in) :: press_to_z !< Factor to tranform atmospheric - !! pressure to z? - - ! local variables +!> This subroutine translates the coupler's ocean_data_type into MOM's +!! surface state variable. This may eventually be folded into the MOM +!! code that calculates the surface state in the first place. +!! Note the offset in the arrays because the ocean_data_type has no +!! halo points in its arrays and always uses absolute indicies. +subroutine convert_state_to_ocean_type(sfc_state, Ocean_sfc, G, patm, press_to_z) + type(surface), intent(inout) :: sfc_state !< A structure containing fields that + !! describe the surface state of the ocean. + type(ocean_public_type), & + target, intent(inout) :: Ocean_sfc !< A structure containing various publicly + !! visible ocean surface fields, whose elements + !! have their data set here. + type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure + real, optional, intent(in) :: patm(:,:) !< The pressure at the ocean surface, in Pa. + real, optional, intent(in) :: press_to_z !< A conversion factor between pressure and + !! ocean depth in m, usually 1/(rho_0*g), in m Pa-1. + + ! Local variables real :: IgR0 character(len=48) :: val_str integer :: isc_bnd, iec_bnd, jsc_bnd, jec_bnd integer :: i, j, i0, j0, is, ie, js, je is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec - call pass_vector(state%u,state%v,G%Domain) + call pass_vector(sfc_state%u,sfc_state%v,G%Domain) call mpp_get_compute_domain(Ocean_sfc%Domain, isc_bnd, iec_bnd, & jsc_bnd, jec_bnd) @@ -786,55 +922,76 @@ subroutine convert_state_to_ocean_type(state, Ocean_sfc, G, patm, press_to_z) endif i0 = is - isc_bnd ; j0 = js - jsc_bnd - if (state%T_is_conT) then + if (sfc_state%T_is_conT) then ! Convert the surface T from conservative T to potential T. do j=jsc_bnd,jec_bnd ; do i=isc_bnd,iec_bnd - Ocean_sfc%t_surf(i,j) = gsw_pt_from_ct(state%SSS(i+i0,j+j0), & - state%SST(i+i0,j+j0)) + CELSIUS_KELVIN_OFFSET + Ocean_sfc%t_surf(i,j) = gsw_pt_from_ct(sfc_state%SSS(i+i0,j+j0), & + sfc_state%SST(i+i0,j+j0)) + CELSIUS_KELVIN_OFFSET enddo ; enddo else do j=jsc_bnd,jec_bnd ; do i=isc_bnd,iec_bnd - Ocean_sfc%t_surf(i,j) = state%SST(i+i0,j+j0) + CELSIUS_KELVIN_OFFSET + Ocean_sfc%t_surf(i,j) = sfc_state%SST(i+i0,j+j0) + CELSIUS_KELVIN_OFFSET enddo ; enddo endif - if (state%S_is_absS) then + if (sfc_state%S_is_absS) then ! Convert the surface S from absolute salinity to practical salinity. do j=jsc_bnd,jec_bnd ; do i=isc_bnd,iec_bnd - Ocean_sfc%s_surf(i,j) = gsw_sp_from_sr(state%SSS(i+i0,j+j0)) + Ocean_sfc%s_surf(i,j) = gsw_sp_from_sr(sfc_state%SSS(i+i0,j+j0)) enddo ; enddo else do j=jsc_bnd,jec_bnd ; do i=isc_bnd,iec_bnd - Ocean_sfc%s_surf(i,j) = state%SSS(i+i0,j+j0) + Ocean_sfc%s_surf(i,j) = sfc_state%SSS(i+i0,j+j0) enddo ; enddo endif - do j=jsc_bnd,jec_bnd ; do i=isc_bnd,iec_bnd - Ocean_sfc%sea_lev(i,j) = state%sea_lev(i+i0,j+j0) - Ocean_sfc%area(i,j) = G%areaT(i+i0,j+j0) - if (present(patm)) & - Ocean_sfc%sea_lev(i,j) = Ocean_sfc%sea_lev(i,j) + patm(i,j) * press_to_z - if (associated(state%frazil)) & - Ocean_sfc%frazil(i,j) = state%frazil(i+i0,j+j0) - if (allocated(state%melt_potential)) & - Ocean_sfc%melt_potential(i,j) = state%melt_potential(i+i0,j+j0) - if (allocated(state%Hml)) & - Ocean_sfc%OBLD(i,j) = state%Hml(i+i0,j+j0) - enddo ; enddo + if (present(patm)) then + do j=jsc_bnd,jec_bnd ; do i=isc_bnd,iec_bnd + Ocean_sfc%sea_lev(i,j) = sfc_state%sea_lev(i+i0,j+j0) + patm(i,j) * press_to_z + Ocean_sfc%area(i,j) = G%areaT(i+i0,j+j0) + enddo ; enddo + else + do j=jsc_bnd,jec_bnd ; do i=isc_bnd,iec_bnd + Ocean_sfc%sea_lev(i,j) = sfc_state%sea_lev(i+i0,j+j0) + Ocean_sfc%area(i,j) = G%areaT(i+i0,j+j0) + enddo ; enddo + endif + + if (associated(sfc_state%frazil)) then + do j=jsc_bnd,jec_bnd ; do i=isc_bnd,iec_bnd + Ocean_sfc%frazil(i,j) = sfc_state%frazil(i+i0,j+j0) + enddo ; enddo + endif + + if (allocated(sfc_state%melt_potential)) then + do j=jsc_bnd,jec_bnd ; do i=isc_bnd,iec_bnd + Ocean_sfc%melt_potential(i,j) = sfc_state%melt_potential(i+i0,j+j0) + enddo ; enddo + endif + + if (allocated(sfc_state%Hml)) then + do j=jsc_bnd,jec_bnd ; do i=isc_bnd,iec_bnd + Ocean_sfc%OBLD(i,j) = sfc_state%Hml(i+i0,j+j0) + enddo ; enddo + endif if (Ocean_sfc%stagger == AGRID) then do j=jsc_bnd,jec_bnd ; do i=isc_bnd,iec_bnd - Ocean_sfc%u_surf(i,j) = G%mask2dT(i+i0,j+j0)*0.5*(state%u(I+i0,j+j0)+state%u(I-1+i0,j+j0)) - Ocean_sfc%v_surf(i,j) = G%mask2dT(i+i0,j+j0)*0.5*(state%v(i+i0,J+j0)+state%v(i+i0,J-1+j0)) + Ocean_sfc%u_surf(i,j) = G%mask2dT(i+i0,j+j0) * & + 0.5*(sfc_state%u(I+i0,j+j0)+sfc_state%u(I-1+i0,j+j0)) + Ocean_sfc%v_surf(i,j) = G%mask2dT(i+i0,j+j0) * & + 0.5*(sfc_state%v(i+i0,J+j0)+sfc_state%v(i+i0,J-1+j0)) enddo ; enddo elseif (Ocean_sfc%stagger == BGRID_NE) then do j=jsc_bnd,jec_bnd ; do i=isc_bnd,iec_bnd - Ocean_sfc%u_surf(i,j) = G%mask2dBu(I+i0,J+j0)*0.5*(state%u(I+i0,j+j0)+state%u(I+i0,j+j0+1)) - Ocean_sfc%v_surf(i,j) = G%mask2dBu(I+i0,J+j0)*0.5*(state%v(i+i0,J+j0)+state%v(i+i0+1,J+j0)) + Ocean_sfc%u_surf(i,j) = G%mask2dBu(I+i0,J+j0) * & + 0.5*(sfc_state%u(I+i0,j+j0)+sfc_state%u(I+i0,j+j0+1)) + Ocean_sfc%v_surf(i,j) = G%mask2dBu(I+i0,J+j0) * & + 0.5*(sfc_state%v(i+i0,J+j0)+sfc_state%v(i+i0+1,J+j0)) enddo ; enddo elseif (Ocean_sfc%stagger == CGRID_NE) then do j=jsc_bnd,jec_bnd ; do i=isc_bnd,iec_bnd - Ocean_sfc%u_surf(i,j) = G%mask2dCu(I+i0,j+j0)*state%u(I+i0,j+j0) - Ocean_sfc%v_surf(i,j) = G%mask2dCv(i+i0,J+j0)*state%v(i+i0,J+j0) + Ocean_sfc%u_surf(i,j) = G%mask2dCu(I+i0,j+j0)*sfc_state%u(I+i0,j+j0) + Ocean_sfc%v_surf(i,j) = G%mask2dCv(i+i0,J+j0)*sfc_state%v(i+i0,J+j0) enddo ; enddo else write(val_str, '(I8)') Ocean_sfc%stagger @@ -842,25 +999,25 @@ subroutine convert_state_to_ocean_type(state, Ocean_sfc, G, patm, press_to_z) "Ocean_sfc%stagger has the unrecognized value of "//trim(val_str)) endif - if (coupler_type_initialized(state%tr_fields)) then + if (coupler_type_initialized(sfc_state%tr_fields)) then if (.not.coupler_type_initialized(Ocean_sfc%fields)) then call MOM_error(FATAL, "convert_state_to_ocean_type: "//& "Ocean_sfc%fields has not been initialized.") endif - call coupler_type_copy_data(state%tr_fields, Ocean_sfc%fields) + call coupler_type_copy_data(sfc_state%tr_fields, Ocean_sfc%fields) endif end subroutine convert_state_to_ocean_type -!> This subroutine extracts the surface properties from the ocean's internal +!> This subroutine extracts the surface properties from the ocean's internal !! state and stores them in the ocean type returned to the calling ice model. !! It has to be separate from the ocean_initialization call because the coupler !! module allocates the space for some of these variables. subroutine ocean_model_init_sfc(OS, Ocean_sfc) - type(ocean_state_type), pointer :: OS !< A pointer to the structure containing the - !! internal ocean state (in). - type(ocean_public_type), intent(inout) :: Ocean_sfc !< Ocean surface state - + type(ocean_state_type), pointer :: OS !< The structure with the complete ocean state + type(ocean_public_type), intent(inout) :: Ocean_sfc !< A structure containing various publicly + !! visible ocean surface properties after initialization, whose + !! elements have their data set here. integer :: is, ie, js, je is = OS%grid%isc ; ie = OS%grid%iec ; js = OS%grid%jsc ; je = OS%grid%jec @@ -872,9 +1029,6 @@ subroutine ocean_model_init_sfc(OS, Ocean_sfc) call convert_state_to_ocean_type(OS%sfc_state, Ocean_sfc, OS%grid) end subroutine ocean_model_init_sfc -! - -!======================================================================= !> ocean_model_flux_init is used to initialize properties of the air-sea fluxes !! as determined by various run-time parameters. It can be called from @@ -899,16 +1053,13 @@ subroutine ocean_model_flux_init(OS, verbosity) end subroutine ocean_model_flux_init -!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~! -! Ocean_stock_pe - returns stocks of heat, water, etc. for conservation checks.! -!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~! !> Ocean_stock_pe - returns the integrated stocks of heat, water, etc. for conservation checks. !! Because of the way FMS is coded, only the root PE has the integrated amount, !! while all other PEs get 0. subroutine Ocean_stock_pe(OS, index, value, time_index) use stock_constants_mod, only : ISTOCK_WATER, ISTOCK_HEAT,ISTOCK_SALT type(ocean_state_type), pointer :: OS !< A structure containing the internal ocean state. - !! The data in OS is intent(in). + !! The data in OS is intent in. integer, intent(in) :: index !< The stock index for the quantity of interest. real, intent(out) :: value !< Sum returned for the conservation quantity of interest. integer, optional, intent(in) :: time_index !< An unused optional argument, present only for @@ -944,13 +1095,18 @@ subroutine Ocean_stock_pe(OS, index, value, time_index) end subroutine Ocean_stock_pe +!> This subroutine extracts a named 2-D field from the ocean surface or public type subroutine ocean_model_data2D_get(OS,Ocean, name, array2D,isc,jsc) use MOM_constants, only : CELSIUS_KELVIN_OFFSET - type(ocean_state_type), pointer :: OS - type(ocean_public_type), intent(in) :: Ocean - character(len=*) , intent(in) :: name - real, dimension(isc:,jsc:), intent(out):: array2D - integer , intent(in) :: isc,jsc + type(ocean_state_type), pointer :: OS !< A pointer to the structure containing the + !! internal ocean state (intent in). + type(ocean_public_type), intent(in) :: Ocean !< A structure containing various publicly + !! visible ocean surface fields. + character(len=*) , intent(in) :: name !< The name of the field to extract + real, dimension(isc:,jsc:), intent(out):: array2D !< The values of the named field, it must + !! cover only the computational domain + integer , intent(in) :: isc !< The starting i-index of array2D + integer , intent(in) :: jsc !< The starting j-index of array2D integer :: g_isc, g_iec, g_jsc, g_jec,g_isd, g_ied, g_jsd, g_jed, i, j @@ -1006,33 +1162,39 @@ subroutine ocean_model_data2D_get(OS,Ocean, name, array2D,isc,jsc) case('sin_rot') array2D(isc:,jsc:) = OS%grid%sin_rot(g_isc:g_iec,g_jsc:g_jec) ! =0 case default - call MOM_error(FATAL,'ocean_model_data2D_get: unknown argument name='//name) + call MOM_error(FATAL,'get_ocean_grid_data2D: unknown argument name='//name) end select end subroutine ocean_model_data2D_get -subroutine ocean_model_data1D_get(OS,Ocean, name, value) - type(ocean_state_type), pointer :: OS - type(ocean_public_type), intent(in) :: Ocean - character(len=*) , intent(in) :: name - real , intent(out):: value +!> This subroutine extracts a named scalar field from the ocean surface or public type +subroutine ocean_model_data1D_get(OS, Ocean, name, value) + type(ocean_state_type), pointer :: OS !< A pointer to the structure containing the + !! internal ocean state (intent in). + type(ocean_public_type), intent(in) :: Ocean !< A structure containing various publicly + !! visible ocean surface fields. + character(len=*) , intent(in) :: name !< The name of the field to extract + real , intent(out):: value !< The value of the named field if (.not.associated(OS)) return if (.not.OS%is_ocean_pe) return select case(name) case('c_p') - value = OS%C_p + value = OS%C_p case default - call MOM_error(FATAL,'ocean_model_data1D_get: unknown argument name='//name) + call MOM_error(FATAL,'get_ocean_grid_data1D: unknown argument name='//name) end select + end subroutine ocean_model_data1D_get +!> Write out FMS-format checsums on fields from the ocean surface state subroutine ocean_public_type_chksum(id, timestep, ocn) - character(len=*), intent(in) :: id - integer , intent(in) :: timestep - type(ocean_public_type), intent(in) :: ocn - integer :: n,m, outunit + character(len=*), intent(in) :: id !< An identifying string for this call + integer, intent(in) :: timestep !< The number of elapsed timesteps + type(ocean_public_type), intent(in) :: ocn !< A structure containing various publicly + !! visible ocean surface fields. + integer :: n, m, outunit outunit = stdout() @@ -1043,28 +1205,20 @@ subroutine ocean_public_type_chksum(id, timestep, ocn) write(outunit,100) 'ocean%v_surf ',mpp_chksum(ocn%v_surf ) write(outunit,100) 'ocean%sea_lev ',mpp_chksum(ocn%sea_lev) write(outunit,100) 'ocean%frazil ',mpp_chksum(ocn%frazil ) - write(outunit,100) 'ocean%OBLD ',mpp_chksum(ocn%OBLD ) write(outunit,100) 'ocean%melt_potential ',mpp_chksum(ocn%melt_potential) call coupler_type_write_chksums(ocn%fields, outunit, 'ocean%') 100 FORMAT(" CHECKSUM::",A20," = ",Z20) + end subroutine ocean_public_type_chksum -!======================================================================= -! -! -! -! Obtain the ocean grid. -! -! subroutine get_ocean_grid(OS, Gridp) + ! Obtain the ocean grid. type(ocean_state_type) :: OS - type(ocean_grid_type) , pointer :: Gridp + type(ocean_grid_type) , pointer :: Gridp Gridp => OS%grid return - end subroutine get_ocean_grid -! NAME="get_ocean_grid" end module MOM_ocean_model diff --git a/config_src/mct_driver/MOM_surface_forcing.F90 b/config_src/mct_driver/MOM_surface_forcing.F90 index 38041a8a65..0e2b82d87b 100644 --- a/config_src/mct_driver/MOM_surface_forcing.F90 +++ b/config_src/mct_driver/MOM_surface_forcing.F90 @@ -205,7 +205,7 @@ module MOM_surface_forcing !! See \ref section_ocn_import for a summary of the surface fluxes that are !! passed from MCT to MOM6, including fluxes that need to be included in !! the future. -subroutine convert_IOB_to_fluxes(IOB, fluxes, Time, G, US, CS, & +subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, US, CS, & sfc_state, restore_salt, restore_temp) type(ice_ocean_boundary_type), & @@ -215,6 +215,7 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, Time, G, US, CS, & type(forcing), intent(inout) :: fluxes !< A structure containing pointers to !! all possible mass, heat or salt flux forcing fields. !! Unused fields have NULL ptrs. + integer, dimension(4), intent(in) :: index_bounds !< The i- and j- size of the arrays in IOB. type(time_type), intent(in) :: Time !< The time of the fluxes, used for interpolating the !! salinity to the right time, when it is being restored. type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure From 3135f6291377dfc2c19dee64aab4e4269ae52891 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Tue, 16 Jul 2019 11:51:09 -0600 Subject: [PATCH 112/150] removed trailing whitespace --- config_src/mct_driver/MOM_ocean_model.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/config_src/mct_driver/MOM_ocean_model.F90 b/config_src/mct_driver/MOM_ocean_model.F90 index aa375809c2..69deaf4ab9 100644 --- a/config_src/mct_driver/MOM_ocean_model.F90 +++ b/config_src/mct_driver/MOM_ocean_model.F90 @@ -140,7 +140,7 @@ module MOM_ocean_model !> The ocean_state_type contains all information about the state of the ocean, !! with a format that is private so it can be readily changed without disrupting !! other coupled components. -type, public :: ocean_state_type ; +type, public :: ocean_state_type ; ! This type is private, and can therefore vary between different ocean models. logical :: is_ocean_PE = .false. !< True if this is an ocean PE. type(time_type) :: Time !< The ocean model's time and master clock. @@ -539,7 +539,7 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & call convert_IOB_to_fluxes(Ice_ocean_boundary, OS%fluxes, index_bnds, OS%Time, & OS%grid, OS%US, OS%forcing_CSp, OS%sfc_state, & OS%restore_salinity, OS%restore_temp) - + ! Add ice shelf fluxes if (OS%use_ice_shelf) then if (do_thermo) & From ebd503022a763f1b34268def4054257051008320 Mon Sep 17 00:00:00 2001 From: Marshall Ward Date: Tue, 16 Jul 2019 16:01:00 -0400 Subject: [PATCH 113/150] Stronger conditional registration of FrictWorkMax The MEKE criteria for using the FrictWorkMax diagnostic was not sufficient, since it is possible to use MEKE while still unable to compute some of the terms required for FrictWorkMax. We resolve this by adding the MEKE_type struct as an argument for hor_visc_init, and use the same information when computing FrictWorkMax to determine whether to register FrictWorkMax. This changes the API by adding MEKE to most of the timestep initializations, but should not affect answers. --- src/core/MOM.F90 | 10 ++++++---- src/core/MOM_dynamics_split_RK2.F90 | 2 +- src/core/MOM_dynamics_unsplit.F90 | 5 +++-- src/core/MOM_dynamics_unsplit_RK2.F90 | 5 +++-- src/parameterizations/lateral/MOM_hor_visc.F90 | 15 +++++++-------- 5 files changed, 20 insertions(+), 17 deletions(-) diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index dd521b8eef..b660221582 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -2309,13 +2309,15 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & elseif (CS%use_RK2) then call initialize_dyn_unsplit_RK2(CS%u, CS%v, CS%h, Time, G, GV, US, & param_file, diag, CS%dyn_unsplit_RK2_CSp, restart_CSp, & - CS%ADp, CS%CDp, MOM_internal_state, CS%OBC, CS%update_OBC_CSp, & - CS%ALE_CSp, CS%set_visc_CSp, CS%visc, dirs, CS%ntrunc) + CS%ADp, CS%CDp, MOM_internal_state, CS%MEKE, CS%OBC, & + CS%update_OBC_CSp, CS%ALE_CSp, CS%set_visc_CSp, CS%visc, dirs, & + CS%ntrunc) else call initialize_dyn_unsplit(CS%u, CS%v, CS%h, Time, G, GV, US, & param_file, diag, CS%dyn_unsplit_CSp, restart_CSp, & - CS%ADp, CS%CDp, MOM_internal_state, CS%OBC, CS%update_OBC_CSp, & - CS%ALE_CSp, CS%set_visc_CSp, CS%visc, dirs, CS%ntrunc) + CS%ADp, CS%CDp, MOM_internal_state, CS%MEKE, CS%OBC, & + CS%update_OBC_CSp, CS%ALE_CSp, CS%set_visc_CSp, CS%visc, dirs, & + CS%ntrunc) endif call callTree_waypoint("dynamics initialized (initialize_MOM)") diff --git a/src/core/MOM_dynamics_split_RK2.F90 b/src/core/MOM_dynamics_split_RK2.F90 index 0fca4d35e3..418a826e86 100644 --- a/src/core/MOM_dynamics_split_RK2.F90 +++ b/src/core/MOM_dynamics_split_RK2.F90 @@ -1110,7 +1110,7 @@ subroutine initialize_dyn_split_RK2(u, v, h, uh, vh, eta, Time, G, GV, US, param if (use_tides) call tidal_forcing_init(Time, G, param_file, CS%tides_CSp) call PressureForce_init(Time, G, GV, US, param_file, diag, CS%PressureForce_CSp, & CS%tides_CSp) - call hor_visc_init(Time, G, US, param_file, diag, CS%hor_visc_CSp) + call hor_visc_init(Time, G, US, param_file, diag, CS%hor_visc_CSp, MEKE) call vertvisc_init(MIS, Time, G, GV, US, param_file, diag, CS%ADp, dirs, & ntrunc, CS%vertvisc_CSp) if (.not.associated(setVisc_CSp)) call MOM_error(FATAL, & diff --git a/src/core/MOM_dynamics_unsplit.F90 b/src/core/MOM_dynamics_unsplit.F90 index dd03e11f42..a4c661e98f 100644 --- a/src/core/MOM_dynamics_unsplit.F90 +++ b/src/core/MOM_dynamics_unsplit.F90 @@ -559,7 +559,7 @@ end subroutine register_restarts_dyn_unsplit !> Initialize parameters and allocate memory associated with the unsplit dynamics module. subroutine initialize_dyn_unsplit(u, v, h, Time, G, GV, US, param_file, diag, CS, & - restart_CS, Accel_diag, Cont_diag, MIS, & + restart_CS, Accel_diag, Cont_diag, MIS, MEKE, & OBC, update_OBC_CSp, ALE_CSp, setVisc_CSp, & visc, dirs, ntrunc) type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. @@ -589,6 +589,7 @@ subroutine initialize_dyn_unsplit(u, v, h, Time, G, GV, US, param_file, diag, CS type(ocean_internal_state), intent(inout) :: MIS !< The "MOM6 Internal State" !! structure, used to pass around pointers !! to various arrays for diagnostic purposes. + type(MEKE_type), pointer :: MEKE !< MEKE data type(ocean_OBC_type), pointer :: OBC !< If open boundary conditions are !! used, this points to the ocean_OBC_type !! that was set up in MOM_initialization. @@ -654,7 +655,7 @@ subroutine initialize_dyn_unsplit(u, v, h, Time, G, GV, US, param_file, diag, CS if (use_tides) call tidal_forcing_init(Time, G, param_file, CS%tides_CSp) call PressureForce_init(Time, G, GV, US, param_file, diag, CS%PressureForce_CSp, & CS%tides_CSp) - call hor_visc_init(Time, G, US, param_file, diag, CS%hor_visc_CSp) + call hor_visc_init(Time, G, US, param_file, diag, CS%hor_visc_CSp, MEKE) call vertvisc_init(MIS, Time, G, GV, US, param_file, diag, CS%ADp, dirs, & ntrunc, CS%vertvisc_CSp) if (.not.associated(setVisc_CSp)) call MOM_error(FATAL, & diff --git a/src/core/MOM_dynamics_unsplit_RK2.F90 b/src/core/MOM_dynamics_unsplit_RK2.F90 index b5b547b362..1f6de7abac 100644 --- a/src/core/MOM_dynamics_unsplit_RK2.F90 +++ b/src/core/MOM_dynamics_unsplit_RK2.F90 @@ -505,7 +505,7 @@ end subroutine register_restarts_dyn_unsplit_RK2 !> Initialize parameters and allocate memory associated with the unsplit RK2 dynamics module. subroutine initialize_dyn_unsplit_RK2(u, v, h, Time, G, GV, US, param_file, diag, CS, & - restart_CS, Accel_diag, Cont_diag, MIS, & + restart_CS, Accel_diag, Cont_diag, MIS, MEKE, & OBC, update_OBC_CSp, ALE_CSp, setVisc_CSp, & visc, dirs, ntrunc) type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. @@ -532,6 +532,7 @@ subroutine initialize_dyn_unsplit_RK2(u, v, h, Time, G, GV, US, param_file, diag type(ocean_internal_state), intent(inout) :: MIS !< The "MOM6 Internal State" !! structure, used to pass around pointers !! to various arrays for diagnostic purposes. + type(MEKE_type), pointer :: MEKE !< MEKE data type(ocean_OBC_type), pointer :: OBC !< If open boundary conditions !! are used, this points to the ocean_OBC_type !! that was set up in MOM_initialization. @@ -614,7 +615,7 @@ subroutine initialize_dyn_unsplit_RK2(u, v, h, Time, G, GV, US, param_file, diag if (use_tides) call tidal_forcing_init(Time, G, param_file, CS%tides_CSp) call PressureForce_init(Time, G, GV, US, param_file, diag, CS%PressureForce_CSp, & CS%tides_CSp) - call hor_visc_init(Time, G, US, param_file, diag, CS%hor_visc_CSp) + call hor_visc_init(Time, G, US, param_file, diag, CS%hor_visc_CSp, MEKE) call vertvisc_init(MIS, Time, G, GV, US, param_file, diag, CS%ADp, dirs, & ntrunc, CS%vertvisc_CSp) if (.not.associated(setVisc_CSp)) call MOM_error(FATAL, & diff --git a/src/parameterizations/lateral/MOM_hor_visc.F90 b/src/parameterizations/lateral/MOM_hor_visc.F90 index 422c510237..0cbd78993d 100644 --- a/src/parameterizations/lateral/MOM_hor_visc.F90 +++ b/src/parameterizations/lateral/MOM_hor_visc.F90 @@ -1371,7 +1371,7 @@ end subroutine horizontal_viscosity !> Allocates space for and calculates static variables used by horizontal_viscosity(). !! hor_visc_init calculates and stores the values of a number of metric functions that !! are used in horizontal_viscosity(). -subroutine hor_visc_init(Time, G, US, param_file, diag, CS) +subroutine hor_visc_init(Time, G, US, param_file, diag, CS, MEKE) type(time_type), intent(in) :: Time !< Current model time. type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type @@ -1379,6 +1379,7 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS) !! parameters. type(diag_ctrl), target, intent(inout) :: diag !< Structure to regulate diagnostic output. type(hor_visc_CS), pointer :: CS !< Pointer to the control structure for this module + type(MEKE_type), pointer :: MEKE !< MEKE data ! Local variables real, dimension(SZIB_(G),SZJ_(G)) :: u0u, u0v real, dimension(SZI_(G),SZJB_(G)) :: v0u, v0v @@ -1419,7 +1420,6 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS) ! valid parameters. logical :: split ! If true, use the split time stepping scheme. ! If false and USE_GME = True, issue a FATAL error. - logical :: use_MEKE ! True if MEKE has been enabled character(len=64) :: inputdir, filename real :: deg2rad ! Converts degrees to radians real :: slat_fn ! sin(lat)**Kh_pwr_of_sine @@ -1693,9 +1693,6 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS) return ! We are not using either Laplacian or Bi-harmonic lateral viscosity endif - call get_param(param_file, mdl, "USE_MEKE", use_MEKE, default=.false., & - do_not_log=.true.) - deg2rad = atan(1.0) / 45. ALLOC_(CS%dx2h(isd:ied,jsd:jed)) ; CS%dx2h(:,:) = 0.0 @@ -2086,9 +2083,11 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS) CS%id_FrictWork_diss = register_diag_field('ocean_model','FrictWork_diss',diag%axesTL,Time,& 'Integral work done by lateral friction terms (excluding diffusion of energy)', 'W m-2') - if (use_MEKE) then - CS%id_FrictWorkMax = register_diag_field('ocean_model','FrictWorkMax',diag%axesTL,Time,& - 'Maximum possible integral work done by lateral friction terms', 'W m-2') + if (associated(MEKE)) then + if (associated(MEKE%mom_src)) then + CS%id_FrictWorkMax = register_diag_field('ocean_model', 'FrictWorkMax', diag%axesTL, Time,& + 'Maximum possible integral work done by lateral friction terms', 'W m-2') + endif endif CS%id_FrictWorkIntz = register_diag_field('ocean_model','FrictWorkIntz',diag%axesT1,Time, & From dd1484cbe72e66cdc7e73614bd1d06fd0b7c1879 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 16 Jul 2019 16:25:00 -0400 Subject: [PATCH 114/150] +Added HOR_VISC_2018_ANSWERS & rescaled variables Added the runtime parameter HOR_VISC_2018_ANSWERS to permit the elimination of a dimensional constant without changing answers. Rescaled the units of several time variables in MOM_hor_visc. Also added comments indicating issues with the GME options and suggests for how to correct them. All answers are bitwise identical, but there is a new entry in the MOM_parameter_doc files. --- .../lateral/MOM_hor_visc.F90 | 237 +++++++++++------- 1 file changed, 146 insertions(+), 91 deletions(-) diff --git a/src/parameterizations/lateral/MOM_hor_visc.F90 b/src/parameterizations/lateral/MOM_hor_visc.F90 index 422c510237..7e29e20c13 100644 --- a/src/parameterizations/lateral/MOM_hor_visc.F90 +++ b/src/parameterizations/lateral/MOM_hor_visc.F90 @@ -46,7 +46,7 @@ module MOM_hor_visc !! biharmonic viscosity to guarantee stability. real :: bound_coef !< The nondimensional coefficient of the ratio of !! the viscosity bounds to the theoretical maximum - !! for stability without considering other terms. + !! for stability without considering other terms [nondim]. !! The default is 0.8. logical :: Smagorinsky_Kh !< If true, use Smagorinsky nonlinear eddy !! viscosity. KH is the background value. @@ -79,6 +79,9 @@ module MOM_hor_visc logical :: res_scale_MEKE !< If true, the viscosity contribution from MEKE is scaled by !! the resolution function. logical :: use_GME !< If true, use GME backscatter scheme. + 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. real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: Kh_bg_xx !< The background Laplacian viscosity at h points [m2 s-1]. @@ -148,18 +151,18 @@ module MOM_hor_visc ! The following variables are precalculated time-invariant combinations of ! parameters and metric terms. real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: & - Laplac2_const_xx, & !< Laplacian metric-dependent constants [nondim] - Biharm5_const_xx, & !< Biharmonic metric-dependent constants [nondim] - Laplac3_const_xx, & !< Laplacian metric-dependent constants [nondim] - Biharm_const_xx, & !< Biharmonic metric-dependent constants [nondim] - Biharm_const2_xx !< Biharmonic metric-dependent constants [nondim] + Laplac2_const_xx, & !< Laplacian metric-dependent constants [m2] + Biharm5_const_xx, & !< Biharmonic metric-dependent constants [m5] + Laplac3_const_xx, & !< Laplacian metric-dependent constants [m3] + Biharm_const_xx, & !< Biharmonic metric-dependent constants [m4] + Biharm_const2_xx !< Biharmonic metric-dependent constants [T m4 ~> s m4] real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEMB_PTR_) :: & - Laplac2_const_xy, & !< Laplacian metric-dependent constants [nondim] - Biharm5_const_xy, & !< Biharmonic metric-dependent constants [nondim] - Laplac3_const_xy, & !< Laplacian metric-dependent constants [nondim] - Biharm_const_xy, & !< Biharmonic metric-dependent constants [nondim] - Biharm_const2_xy !< Biharmonic metric-dependent constants [nondim] + Laplac2_const_xy, & !< Laplacian metric-dependent constants [m2] + Biharm5_const_xy, & !< Biharmonic metric-dependent constants [m5] + Laplac3_const_xy, & !< Laplacian metric-dependent constants [m3] + Biharm_const_xy, & !< Biharmonic metric-dependent constants [m4] + Biharm_const2_xy !< Biharmonic metric-dependent constants [T m4 ~> s m4] type(diag_ctrl), pointer :: diag => NULL() !< structure to regulate diagnostics @@ -309,7 +312,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, real :: mod_Leith ! nondimensional coefficient for divergence part of modified Leith ! viscosity. Here set equal to nondimensional Laplacian Leith constant. ! This is set equal to zero if modified Leith is not used. - real :: Shear_mag ! magnitude of the shear [s-1] + real :: Shear_mag ! magnitude of the shear [T-1 ~> s-1] real :: vert_vort_mag ! magnitude of the vertical vorticity gradient [m-1 s-1] real :: h2uq, h2vq ! temporary variables [H2 ~> m2 or kg2 m-4]. real :: hu, hv ! Thicknesses interpolated by arithmetic means to corner @@ -327,14 +330,17 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, real :: Kh_scale ! A factor between 0 and 1 by which the horizontal ! Laplacian viscosity is rescaled [nondim] real :: RoScl ! The scaling function for MEKE source term [nondim] - real :: FatH ! abs(f) at h-point for MEKE source term [s-1] + real :: FatH ! abs(f) at h-point for MEKE source term [T-1 ~> s-1] real :: local_strain ! Local variable for interpolating computed strain rates [s-1]. real :: meke_res_fn ! A copy of the resolution scaling factor if being applied to MEKE. Otherwise =1. real :: GME_coeff ! The GME (negative) viscosity coefficient [m2 s-1] real :: GME_coeff_limiter ! Maximum permitted value of the GME coefficient [m2 s-1] - real :: FWfrac ! Fraction of maximum theoretical energy transfer to use when scaling GME coefficient + real :: FWfrac ! Fraction of maximum theoretical energy transfer to use when scaling GME coefficient [nondim] real :: DY_dxBu, DX_dyBu - real :: H0 ! Depth used to scale down GME coefficient in shallow areas [m] + real :: Sh_F_pow ! The ratio of shear over the absolute value of f raised to some power and rescaled [nondim] + real :: backscat_subround ! The ratio of f over Shear_mag that is so small that the backscatter + ! calculation gives the same value as if f were 0 [nondim]. + real :: H0_GME ! Depth used to scale down GME coefficient in shallow areas [Z ~> m] logical :: rescale_Kh, legacy_bound logical :: find_FrictWork logical :: apply_OBC = .false. @@ -368,6 +374,10 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, if (CS%id_FrictWorkIntz > 0) find_FrictWork = .true. if (associated(MEKE)) then if (associated(MEKE%mom_src)) find_FrictWork = .true. + backscat_subround = 0.0 + if (find_FrictWork .and. associated(MEKE%mom_src) .and. (MEKE%backscatter_Ro_c > 0.0) .and. & + (MEKE%backscatter_Ro_Pow /= 0.0)) & + backscat_subround = (1.0e-16/MEKE%backscatter_Ro_c)**(1.0/MEKE%backscatter_Ro_Pow) endif rescale_Kh = .false. @@ -391,7 +401,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, if (CS%use_GME) then ! GME tapers off above this depth - H0 = 1000.0 + H0_GME = 1000.0*US%m_to_Z FWfrac = 1.0 GME_coeff_limiter = 1e7 @@ -407,6 +417,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, call barotropic_get_tav(BT, ubtav, vbtav, G) call pass_vector(ubtav, vbtav, G%Domain) + !### The following loop range should be: do j=js-1,je+1 ; do i=is-1,ie+1 do j=js,je ; do i=is,ie dudx_bt(i,j) = CS%DY_dxT(i,j)*(G%IdyCu(I,j) * ubtav(I,j) - & G%IdyCu(I-1,j) * ubtav(I-1,j)) @@ -414,9 +425,12 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, G%IdxCv(i,J-1) * vbtav(i,J-1)) enddo; enddo + !### These should be combined into a vactor pass call pass_var(dudx_bt, G%Domain, complete=.true.) call pass_var(dvdy_bt, G%Domain, complete=.true.) + !### These loop bounds should be: + !### do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 do j=Jsq-1,Jeq+2 ; do i=Isq-1,Ieq+2 sh_xx_bt(i,j) = dudx_bt(i,j) - dvdy_bt(i,j) enddo ; enddo @@ -429,14 +443,19 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, - ubtav(I,j)*G%IdxCu(I,j)) enddo ; enddo + !### These should be combined into a vactor pass call pass_var(dvdx_bt, G%Domain, position=CORNER, complete=.true.) call pass_var(dudy_bt, G%Domain, position=CORNER, complete=.true.) if (CS%no_slip) then + !### These loop bounds should be + !### do J=js-1,Jeq ; do I=is-1,Ieq do J=js-2,Jeq+1 ; do I=is-2,Ieq+1 sh_xy_bt(I,J) = (2.0-G%mask2dBu(I,J)) * ( dvdx_bt(I,J) + dudy_bt(I,J) ) enddo ; enddo else + !### These loop bounds should be + !### do J=js-1,Jeq ; do I=is-1,Ieq do J=js-2,Jeq+1 ; do I=is-2,Ieq+1 sh_xy_bt(I,J) = G%mask2dBu(I,J) * ( dvdx_bt(I,J) + dudy_bt(I,J) ) enddo ; enddo @@ -445,20 +464,28 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, ! Get thickness diffusivity for use in GME ! call thickness_diffuse_get_KH(thickness_diffuse, KH_u_GME, KH_v_GME, G) + !### These loops bounds should probably be: do j=js-1,je+1 ; do i=is-1,is+1 + !### Group the 4-point sums so they are rotationally invariant.` do j=Jsq-1,Jeq+2 ; do i=Isq-1,Ieq+2 grad_vel_mag_bt_h(i,j) = boundary_mask(i,j) * (dudx_bt(i,j)**2 + dvdy_bt(i,j)**2 + & (0.25*(dvdx_bt(I,J)+dvdx_bt(I-1,J)+dvdx_bt(I,J-1)+dvdx_bt(I-1,J-1)) )**2 + & (0.25*(dudy_bt(I,J)+dudy_bt(I-1,J)+dudy_bt(I,J-1)+dudy_bt(I-1,J-1)) )**2) enddo ; enddo + !### max_diss_rate_bt is not used. if (associated(MEKE)) then ; if (associated(MEKE%mom_src)) then + !### These loops bounds should be: do j=js-1,je+1 ; do i=is-1,is+1 do j=Jsq-1,Jeq+2 ; do i=Isq-1,Ieq+2 max_diss_rate_bt(i,j) = 2.0*MEKE%MEKE(i,j) * grad_vel_mag_bt_h(i,j) enddo ; enddo endif ; endif + !### boundary_mask is defined at h points, not q points as used here. + !### boundary_mask has only been defined over the range is:ie, js:je. + !### Group the 4-point sums so they are rotationally invariant.` + !### The following loop range should be: do J=js-1,Jeq ; do I=is-1,Ieq do J=js-2,Jeq+1 ; do I=is-2,Ieq+1 - grad_vel_mag_bt_q(I,J) = boundary_mask(i,j) * (dvdx_bt(i,j)**2 + dudy_bt(i,j)**2 + & + grad_vel_mag_bt_q(I,J) = boundary_mask(i,j) * (dvdx_bt(I,J)**2 + dudy_bt(I,J)**2 + & (0.25*(dudx_bt(i,j)+dudx_bt(i+1,j)+dudx_bt(i,j+1)+dudx_bt(i+1,j+1)))**2 + & (0.25*(dvdy_bt(i,j)+dvdy_bt(i+1,j)+dvdy_bt(i,j+1)+dvdy_bt(i+1,j+1)) )**2) enddo ; enddo @@ -477,7 +504,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, !$OMP bhstr_xx, bhstr_xy,FatH,RoScl, hu, hv, h_u, h_v, & !$OMP vort_xy,vort_xy_dx,vort_xy_dy,Vort_mag,AhLth,KhLth, & !$OMP div_xx, div_xx_dx, div_xx_dy, local_strain, & - !$OMP meke_res_fn, & + !$OMP meke_res_fn,Sh_F_pow, & !$OMP Shear_mag, h2uq, h2vq, hq, Kh_scale, hrat_min) do k=1,nz @@ -719,12 +746,16 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, (h(i,j,k) + GV%H_subroundoff) enddo ; enddo + !### Adding so many halo updates will make this code very slow! + !### With the correct index range, this halo update is unnecessary. call pass_var(div_xx, G%Domain, complete=.true.) ! Divergence gradient + !### This index range should be: do j=Jsq,Jeq+1 ; do I=Isq-1,Ieq+1 do j=Jsq-1,Jeq+2 ; do I=is-2,Ieq+1 div_xx_dx(I,j) = G%IdxCu(I,j)*(div_xx(i+1,j) - div_xx(i,j)) enddo ; enddo + !### This index range should be: do j=Jsq-1,Jeq+1 ; do i=Isq,Ieq+1 do J=js-2,Jeq+1 ; do i=Isq-1,Ieq+2 div_xx_dy(i,J) = G%IdyCv(i,J)*(div_xx(i,j+1) - div_xx(i,j)) enddo ; enddo @@ -732,13 +763,16 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, call pass_vector(div_xx_dx, div_xx_dy, G%Domain) ! Magnitude of divergence gradient + ! Why use the magnitude of the average instead of the average magnitude? + !### This index range should be: do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 do j=Jsq-1,Jeq+2 ; do i=Isq-1,Ieq+2 - grad_div_mag_h(i,j) =sqrt((0.5*(div_xx_dx(I,j) + div_xx_dx(I-1,j)))**2 + & - (0.5 * (div_xx_dy(i,J) + div_xx_dy(i,J-1)))**2) + grad_div_mag_h(i,j) = sqrt((0.5*(div_xx_dx(I,j) + div_xx_dx(I-1,j)))**2 + & + (0.5*(div_xx_dy(i,J) + div_xx_dy(i,J-1)))**2) enddo ; enddo + !### This index range should be: do J=js-1,Jeq ; do I=is-1,Ieq do J=js-2,Jeq+1 ; do I=is-2,Ieq+1 - grad_div_mag_q(I,J) =sqrt((0.5*(div_xx_dx(I,j) + div_xx_dx(I,j+1)))**2 + & - (0.5 * (div_xx_dy(i,J) + div_xx_dy(i+1,J)))**2) + grad_div_mag_q(I,J) = sqrt((0.5*(div_xx_dx(I,j) + div_xx_dx(I,j+1)))**2 + & + (0.5*(div_xx_dy(i,J) + div_xx_dy(i+1,J)))**2) enddo ; enddo else @@ -749,9 +783,11 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, do J=js-2,Jeq+1 ; do i=Isq-1,Ieq+2 div_xx_dy(i,J) = 0.0 enddo ; enddo + !### This index range should be: do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 do j=Jsq-1,Jeq+2 ; do i=Isq-1,Ieq+2 grad_div_mag_h(i,j) = 0.0 enddo ; enddo + !### This index range should be: do J=js-1,Jeq ; do I=is-1,Ieq do J=js-2,Jeq+1 ; do I=is-2,Ieq+1 grad_div_mag_q(I,J) = 0.0 enddo ; enddo @@ -760,31 +796,34 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, ! Add in beta for the Leith viscosity if (CS%use_beta_in_Leith) then + !### beta_h and beta_q are never used. do j=Jsq-1,Jeq+2 ; do i=Isq-1,Ieq+2 beta_h(i,j) = sqrt( G%dF_dx(i,j)**2 + G%dF_dy(i,j)**2 ) enddo; enddo do J=js-2,Jeq+1 ; do I=is-2,Ieq+1 beta_q(I,J) = sqrt( (0.25*(G%dF_dx(i,j)+G%dF_dx(i+1,j)+G%dF_dx(i,j+1)+G%dF_dx(i+1,j+1))**2) + & - (0.25*(G%dF_dy(i,j)+G%dF_dy(i+1,j)+G%dF_dy(i,j+1)+G%dF_dy(i+1,j+1))**2) ) + (0.25*(G%dF_dy(i,j)+G%dF_dy(i+1,j)+G%dF_dy(i,j+1)+G%dF_dy(i+1,j+1))**2) ) enddo ; enddo do J=js-2,Jeq+1 ; do i=is-1,Ieq+1 - vort_xy_dx(i,J) = vort_xy_dx(i,J) + 0.5 * ( G%dF_dx(i,j) + G%dF_dx(i,j+1)) + vort_xy_dx(i,J) = vort_xy_dx(i,J) + 0.5 * ( G%dF_dx(i,j) + G%dF_dx(i,j+1)) enddo ; enddo do j=js-1,Jeq+1 ; do I=is-2,Ieq+1 - vort_xy_dy(I,j) = vort_xy_dy(I,j) + 0.5 * ( G%dF_dy(i,j) + G%dF_dy(i+1,j)) + vort_xy_dy(I,j) = vort_xy_dy(I,j) + 0.5 * ( G%dF_dy(i,j) + G%dF_dy(i+1,j)) enddo ; enddo endif ! CS%use_beta_in_Leith if (CS%use_QG_Leith_visc) then + !### This should be do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 do j=Jsq-1,Jeq+2 ; do i=Isq-1,Ieq+2 - grad_vort_mag_h_2d(i,j) = SQRT((0.5*(vort_xy_dx(i,J) + vort_xy_dx(i,J-1)))**2 + (0.5*(vort_xy_dy(I,j) + & - vort_xy_dy(I-1,j)))**2 ) - enddo; enddo + grad_vort_mag_h_2d(i,j) = SQRT((0.5*(vort_xy_dx(i,J) + vort_xy_dx(i,J-1)))**2 + & + (0.5*(vort_xy_dy(I,j) + vort_xy_dy(I-1,j)))**2 ) + enddo ; enddo + !### This index range should be: do J=js-1,Jeq ; do I=is-1,Ieq do J=js-2,Jeq+1 ; do I=is-2,Ieq+1 - grad_vort_mag_q_2d(I,J) = SQRT((0.5*(vort_xy_dx(i,J) + vort_xy_dx(i+1,J)))**2 + (0.5*(vort_xy_dy(I,j) + & - vort_xy_dy(I,j+1)))**2 ) + grad_vort_mag_q_2d(I,J) = SQRT((0.5*(vort_xy_dx(i,J) + vort_xy_dx(i+1,J)))**2 + & + (0.5*(vort_xy_dy(I,j) + vort_xy_dy(I,j+1)))**2 ) enddo ; enddo call calc_QG_Leith_viscosity(VarMix, G, GV, h, k, div_xx_dx, div_xx_dy, & @@ -792,22 +831,24 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, endif + !### This should be do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 do j=Jsq-1,Jeq+2 ; do i=Isq-1,Ieq+2 - grad_vort_mag_h(i,j) = SQRT((0.5*(vort_xy_dx(i,J) + vort_xy_dx(i,J-1)))**2 + (0.5*(vort_xy_dy(I,j) + & - vort_xy_dy(I-1,j)))**2 ) - enddo; enddo + grad_vort_mag_h(i,j) = SQRT((0.5*(vort_xy_dx(i,J) + vort_xy_dx(i,J-1)))**2 + & + (0.5*(vort_xy_dy(I,j) + vort_xy_dy(I-1,j)))**2 ) + enddo ; enddo + !### This index range should be: do J=js-1,Jeq ; do I=is-1,Ieq do J=js-2,Jeq+1 ; do I=is-2,Ieq+1 - grad_vort_mag_q(I,J) = SQRT((0.5*(vort_xy_dx(i,J) + vort_xy_dx(i+1,J)))**2 + (0.5*(vort_xy_dy(I,j) + & - vort_xy_dy(I,j+1)))**2 ) + grad_vort_mag_q(I,J) = SQRT((0.5*(vort_xy_dx(i,J) + vort_xy_dx(i+1,J)))**2 + & + (0.5*(vort_xy_dy(I,j) + vort_xy_dy(I,j+1)))**2 ) enddo ; enddo endif ! CS%Leith_Kh meke_res_fn = 1. - do J=Jsq,Jeq+1 ; do i=Isq,Ieq+1 + do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 if ((CS%Smagorinsky_Kh) .or. (CS%Smagorinsky_Ah)) then - Shear_mag = sqrt(sh_xx(i,j)*sh_xx(i,j) + & + Shear_mag = US%T_to_s * sqrt(sh_xx(i,j)*sh_xx(i,j) + & 0.25*((sh_xy(I-1,J-1)*sh_xy(I-1,J-1) + sh_xy(I,J)*sh_xy(I,J)) + & (sh_xy(I-1,J)*sh_xy(I-1,J) + sh_xy(I,J-1)*sh_xy(I,J-1)))) endif @@ -828,7 +869,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, ! Determine the Laplacian viscosity at h points, using the ! largest value from several parameterizations. Kh = CS%Kh_bg_xx(i,j) ! Static (pre-computed) background viscosity - if (CS%Smagorinsky_Kh) Kh = max( Kh, CS%Laplac2_const_xx(i,j) * Shear_mag ) + if (CS%Smagorinsky_Kh) Kh = max( Kh, CS%Laplac2_const_xx(i,j) * US%s_to_T*Shear_mag ) if (CS%Leith_Kh) Kh = max( Kh, CS%Laplac3_const_xx(i,j) * vert_vort_mag*inv_PI3) ! All viscosity contributions above are subject to resolution scaling if (rescale_Kh) Kh = VarMix%Res_fn_h(i,j) * Kh @@ -873,10 +914,10 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, if ((CS%Smagorinsky_Ah) .or. (CS%Leith_Ah)) then if (CS%Smagorinsky_Ah) then if (CS%bound_Coriolis) then - AhSm = Shear_mag * (CS%Biharm_const_xx(i,j) + & - CS%Biharm_const2_xx(i,j)*Shear_mag) + AhSm = US%s_to_T*Shear_mag * (CS%Biharm_const_xx(i,j) + & + CS%Biharm_const2_xx(i,j)*Shear_mag) else - AhSm = CS%Biharm_const_xx(i,j) * Shear_mag + AhSm = CS%Biharm_const_xx(i,j) * US%s_to_T*Shear_mag endif endif if (CS%Leith_Ah) AhLth = CS%biharm5_const_xx(i,j) * vert_vort_mag * inv_PI5 @@ -944,7 +985,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, do J=js-1,Jeq ; do I=is-1,Ieq if ((CS%Smagorinsky_Kh) .or. (CS%Smagorinsky_Ah)) then - Shear_mag = sqrt(sh_xy(I,J)*sh_xy(I,J) + & + Shear_mag = US%T_to_s * sqrt(sh_xy(I,J)*sh_xy(I,J) + & 0.25*((sh_xx(i,j)*sh_xx(i,j) + sh_xx(i+1,j+1)*sh_xx(i+1,j+1)) + & (sh_xx(i,j+1)*sh_xx(i,j+1) + sh_xx(i+1,j)*sh_xx(i+1,j)))) endif @@ -990,7 +1031,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, ! Determine the Laplacian viscosity at q points, using the ! largest value from several parameterizations. Kh = CS%Kh_bg_xy(i,j) ! Static (pre-computed) background viscosity - if (CS%Smagorinsky_Kh) Kh = max( Kh, CS%Laplac2_const_xy(I,J) * Shear_mag ) + if (CS%Smagorinsky_Kh) Kh = max( Kh, CS%Laplac2_const_xy(I,J) * US%s_to_T*Shear_mag ) if (CS%Leith_Kh) Kh = max( Kh, CS%Laplac3_const_xy(I,J) * vert_vort_mag*inv_PI3) ! All viscosity contributions above are subject to resolution scaling if (rescale_Kh) Kh = VarMix%Res_fn_q(i,j) * Kh @@ -1039,10 +1080,10 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, if (CS%Smagorinsky_Ah .or. CS%Leith_Ah) then if (CS%Smagorinsky_Ah) then if (CS%bound_Coriolis) then - AhSm = Shear_mag * (CS%Biharm_const_xy(I,J) + & + AhSm = US%s_to_T*Shear_mag * (CS%Biharm_const_xy(I,J) + & CS%Biharm_const2_xy(I,J)*Shear_mag) else - AhSm = CS%Biharm_const_xy(I,J) * Shear_mag + AhSm = CS%Biharm_const_xy(I,J) * US%s_to_T*Shear_mag endif endif if (CS%Leith_Ah) AhLth = CS%Biharm5_const_xy(I,J) * vert_vort_mag * inv_PI5 @@ -1077,6 +1118,8 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, if (find_FrictWork) then if (CS%biharmonic) call pass_vector(u0, v0, G%Domain) + !### These should be a vactor pass + !### Adding so many halo updates will make this code very slow! call pass_var(dudx, G%Domain, complete=.true.) call pass_var(dvdy, G%Domain, complete=.true.) call pass_var(dvdx, G%Domain, position=CORNER, complete=.true.) @@ -1134,23 +1177,20 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, if (CS%use_GME) then + if (.not. (associated(MEKE))) call MOM_error(FATAL, "MEKE must be enabled for GME to be used.") - if (.not. (associated(MEKE))) call MOM_error(FATAL, & - "MEKE must be enabled for GME to be used.") - - do J=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - + do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 + GME_coeff = 0.0 if ((max_diss_rate(i,j,k) > 0) .and. (grad_vel_mag_bt_h(i,j)>0) ) then - GME_coeff = (MIN(G%bathyT(i,j)/H0,1.0)**2) * FWfrac*max_diss_rate(i,j,k) / grad_vel_mag_bt_h(i,j) -! GME_coeff = (MIN(G%bathyT(i,j)/H0,1.0)**2) * FWfrac*target_diss_rate_GME(i,j,k) / grad_vel_mag_bt_h(i,j) - else - GME_coeff = 0.0 - endif + GME_coeff = FWfrac*max_diss_rate(i,j,k) / grad_vel_mag_bt_h(i,j) +! GME_coeff = FWfrac*target_diss_rate_GME(i,j,k) / grad_vel_mag_bt_h(i,j) - ! apply mask - GME_coeff = GME_coeff * boundary_mask(i,j) + if ((G%bathyT(i,j) < H0_GME) .and. (H0_GME > 0.0)) & + GME_coeff = (G%bathyT(i,j) / H0_GME)**2 * GME_coeff - GME_coeff = MIN(GME_coeff, GME_coeff_limiter) + ! apply mask and limiter + GME_coeff = MIN(GME_coeff * boundary_mask(i,j), GME_coeff_limiter) + endif if ((CS%id_GME_coeff_h>0) .or. find_FrictWork) GME_coeff_h(i,j,k) = GME_coeff @@ -1158,21 +1198,20 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, enddo ; enddo - do J=js-1,Jeq ; do I=is-1,Ieq - - if ((max_diss_rate(i,j,k) > 0) .and. (grad_vel_mag_bt_q(i,j)>0) ) then - GME_coeff = (MIN(G%bathyT(i,j)/H0,1.0)**2) * FWfrac*max_diss_rate(i,j,k) / grad_vel_mag_bt_q(I,J) -! GME_coeff = (MIN(G%bathyT(i,j)/H0,1.0)**2) * FWfrac*target_diss_rate_GME(i,j,k) / grad_vel_mag_bt_q(I,J) - else - GME_coeff = 0.0 + GME_coeff = 0.0 + if ((max_diss_rate(i,j,k) > 0) .and. (grad_vel_mag_bt_q(I,J)>0) ) then + !### target_diss_rate_GME and max_diss_rate are defined at h points, not q points as used here. + GME_coeff = FWfrac*max_diss_rate(i,j,k) / grad_vel_mag_bt_q(I,J) +! GME_coeff = FWfrac*target_diss_rate_GME(i,j,k) / grad_vel_mag_bt_q(I,J) + if ((G%bathyT(i,j) < H0_GME) .and. (H0_GME > 0.0)) & + GME_coeff = (G%bathyT(i,j) / H0_GME)**2 * GME_coeff + + !### boundary_mask is defined at h points, not q points as used here. + ! apply mask and limiter + GME_coeff = MIN(GME_coeff * boundary_mask(i,j), GME_coeff_limiter) endif - ! apply mask - GME_coeff = GME_coeff * boundary_mask(i,j) - - GME_coeff = MIN(GME_coeff, GME_coeff_limiter) - if (CS%id_GME_coeff_q>0) GME_coeff_q(I,J,k) = GME_coeff str_xy_GME(I,J) = GME_coeff * sh_xy_bt(I,J) @@ -1216,8 +1255,6 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, endif ! use_GME - - ! Evaluate 1/h x.Div(h Grad u) or the biharmonic equivalent. do j=js,je ; do I=Isq,Ieq diffu(I,j,k) = ((G%IdyCu(I,j)*(CS%DY2h(i,j) *str_xx(i,j) - & @@ -1293,18 +1330,28 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, endif if (MEKE%backscatter_Ro_c /= 0.) then do j=js,je ; do i=is,ie - FatH = 0.25*US%s_to_T*( (abs(G%CoriolisBu(I-1,J-1)) + abs(G%CoriolisBu(I,J))) + & - (abs(G%CoriolisBu(I-1,J)) + abs(G%CoriolisBu(I,J-1))) ) - Shear_mag = sqrt(sh_xx(i,j)*sh_xx(i,j) + & + FatH = 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))) ) + Shear_mag = US%T_to_s * sqrt(sh_xx(i,j)*sh_xx(i,j) + & 0.25*((sh_xy(I-1,J-1)*sh_xy(I-1,J-1) + sh_xy(I,J)*sh_xy(I,J)) + & (sh_xy(I-1,J)*sh_xy(I-1,J) + sh_xy(I,J-1)*sh_xy(I,J-1)))) - FatH = FatH ** MEKE%backscatter_Ro_pow ! f^n - !### Note the hard-coded dimensional constant in the following line. - Shear_mag = ( ( Shear_mag ** MEKE%backscatter_Ro_pow ) + 1.e-30 ) & - * MEKE%backscatter_Ro_c ! c * D^n - ! The Rossby number function is g(Ro) = 1/(1+c.Ro^n) - ! RoScl = 1 - g(Ro) - RoScl = Shear_mag / ( FatH + Shear_mag ) ! = 1 - f^n/(f^n+c*D^n) + if (CS%answers_2018) then + FatH = (US%s_to_T*FatH)**MEKE%backscatter_Ro_pow ! f^n + ! Note the hard-coded dimensional constant in the following line that can not + ! be rescaled for dimensional consistency. + Shear_mag = ( ( (US%s_to_T*Shear_mag)**MEKE%backscatter_Ro_pow ) + 1.e-30 ) & + * MEKE%backscatter_Ro_c ! c * D^n + ! The Rossby number function is g(Ro) = 1/(1+c.Ro^n) + ! RoScl = 1 - g(Ro) + RoScl = Shear_mag / ( FatH + Shear_mag ) ! = 1 - f^n/(f^n+c*D^n) + else + if (FatH <= backscat_subround*Shear_mag) then + RoScl = 1.0 + else + Sh_F_pow = MEKE%backscatter_Ro_c * (Shear_mag / FatH)**MEKE%backscatter_Ro_pow + RoScl = Sh_F_pow / (1.0 + Sh_F_pow) ! = 1 - f^n/(f^n+c*D^n) + endif + endif MEKE%mom_src(i,j) = MEKE%mom_src(i,j) + GV%H_to_kg_m2 * ( & ((str_xx(i,j)-RoScl*bhstr_xx(i,j))*(u(I,j,k)-u(I-1,j,k))*G%IdxT(i,j) & -(str_xx(i,j)-RoScl*bhstr_xx(i,j))*(v(i,J,k)-v(i,J-1,k))*G%IdyT(i,j)) & @@ -1391,8 +1438,8 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS) real :: Kh_Limit ! A coefficient [s-1] used, along with the ! grid spacing, to limit Laplacian viscosity. real :: fmax ! maximum absolute value of f at the four - ! vorticity points around a thickness point [s-1] - real :: BoundCorConst ! A constant used when using viscosity to bound the Coriolis accelerations [s2 m-2] + ! vorticity points around a thickness point [T-1 ~> s-1] + real :: BoundCorConst ! A constant used when using viscosity to bound the Coriolis accelerations [T2 L-2 ~> s2 m-2] real :: Ah_Limit ! coefficient [s-1] used, along with the ! grid spacing, to limit biharmonic viscosity real :: Kh ! Lapacian horizontal viscosity [m2 s-1] @@ -1410,7 +1457,7 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS) real :: maxvel ! largest permitted velocity components [m s-1] real :: bound_Cor_vel ! grid-scale velocity variations at which value ! the quadratically varying biharmonic viscosity - ! balances Coriolis acceleration [m s-1] + ! balances Coriolis acceleration [L T-1 ~> m s-1] real :: Kh_sin_lat ! Amplitude of latitudinally dependent viscosity [m2 s-1] real :: Kh_pwr_of_sine ! Power used to raise sin(lat) when using Kh_sin_lat logical :: bound_Cor_def ! parameter setting of BOUND_CORIOLIS @@ -1420,6 +1467,7 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS) logical :: split ! If true, use the split time stepping scheme. ! If false and USE_GME = True, issue a FATAL error. logical :: use_MEKE ! True if MEKE has been enabled + logical :: default_2018_answers character(len=64) :: inputdir, filename real :: deg2rad ! Converts degrees to radians real :: slat_fn ! sin(lat)**Kh_pwr_of_sine @@ -1466,6 +1514,13 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS) ! parameter spelling checks. call get_param(param_file, mdl, "GET_ALL_PARAMS", get_all, default=.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, "HOR_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=default_2018_answers) call get_param(param_file, mdl, "LAPLACIAN", CS%Laplacian, & "If true, use a Laplacian horizontal viscosity.", & default=.false.) @@ -1625,7 +1680,7 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS) "The velocity scale at which BOUND_CORIOLIS_BIHARM causes "//& "the biharmonic drag to have comparable magnitude to the "//& "Coriolis acceleration. The default is set by MAXVEL.", & - units="m s-1", default=maxvel) + units="m s-1", default=maxvel, scale=US%m_s_to_L_T) endif endif @@ -1905,9 +1960,9 @@ 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 = 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 = 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) = US%m_to_L**2*(grid_sp_h2 * grid_sp_h2 * grid_sp_h2) * & (fmax * BoundCorConst) endif endif @@ -1929,8 +1984,8 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS) if (CS%Smagorinsky_Ah) then CS%Biharm_const_xy(I,J) = Smag_bi_const * (grid_sp_q2 * grid_sp_q2) if (CS%bound_Coriolis) then - CS%Biharm_const2_xy(I,J) = (grid_sp_q2 * grid_sp_q2 * grid_sp_q2) * & - (abs(US%s_to_T*G%CoriolisBu(I,J)) * BoundCorConst) + CS%Biharm_const2_xy(I,J) = US%m_to_L**2*(grid_sp_q2 * grid_sp_q2 * grid_sp_q2) * & + (abs(G%CoriolisBu(I,J)) * BoundCorConst) endif endif if (CS%Leith_Ah) then From 7d354febd31a9d0b4fa0c40aa0a7d7955efe7db2 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 16 Jul 2019 17:42:16 -0400 Subject: [PATCH 115/150] +Changed the units of diffv to [m s-1 T-1] Changed the units of diffu and diffv as returned by MOM_hor_visc to [m s-1 T-1] for dimensional consistency testing. Additional unit changes will come automatically after the units of horizontal viscosities are rescaled. All answers are bitwise identical, but the units of some arguments to public functions and elements of types have been rescaled. --- src/core/MOM_checksum_packages.F90 | 6 +++--- src/core/MOM_dynamics_split_RK2.F90 | 12 ++++++------ src/core/MOM_dynamics_unsplit.F90 | 8 ++++---- src/core/MOM_dynamics_unsplit_RK2.F90 | 16 ++++++++-------- src/core/MOM_variables.F90 | 8 ++++---- src/diagnostics/MOM_PointAccel.F90 | 8 ++++---- src/diagnostics/MOM_diagnostics.F90 | 9 +++++---- src/parameterizations/lateral/MOM_hor_visc.F90 | 12 ++++++------ 8 files changed, 40 insertions(+), 39 deletions(-) diff --git a/src/core/MOM_checksum_packages.F90 b/src/core/MOM_checksum_packages.F90 index 7e054056e6..755cdac2b9 100644 --- a/src/core/MOM_checksum_packages.F90 +++ b/src/core/MOM_checksum_packages.F90 @@ -178,10 +178,10 @@ subroutine MOM_accel_chksum(mesg, CAu, CAv, PFu, PFv, diffu, diffv, G, GV, US, p !! (equal to -dM/dy) [m s-2]. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & intent(in) :: diffu !< Zonal acceleration due to convergence of the - !! along-isopycnal stress tensor [m s-2]. + !! along-isopycnal stress tensor [m s-1 T-1 ~> m s-2]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & intent(in) :: diffv !< Meridional acceleration due to convergence of - !! the along-isopycnal stress tensor [m s-2]. + !! the along-isopycnal stress tensor [m s-1 T-1 ~> m s-2]. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & optional, intent(in) :: pbce !< The baroclinic pressure anomaly in each layer @@ -207,7 +207,7 @@ subroutine MOM_accel_chksum(mesg, CAu, CAv, PFu, PFv, diffu, diffv, G, GV, US, p ! and js...je as their extent. call uvchksum(mesg//" CA[uv]", CAu, CAv, G%HI, haloshift=0, symmetric=sym) call uvchksum(mesg//" PF[uv]", PFu, PFv, G%HI, haloshift=0, symmetric=sym) - call uvchksum(mesg//" diffu", diffu, diffv, G%HI,haloshift=0, symmetric=sym) + call uvchksum(mesg//" diffu", diffu, diffv, G%HI,haloshift=0, symmetric=sym, scale=US%s_to_T) if (present(pbce)) & call hchksum(pbce, mesg//" pbce",G%HI,haloshift=0, scale=GV%m_to_H*US%L_T_to_m_s**2) if (present(u_accel_bt) .and. present(v_accel_bt)) & diff --git a/src/core/MOM_dynamics_split_RK2.F90 b/src/core/MOM_dynamics_split_RK2.F90 index 5a3df49a3c..497d74cdd4 100644 --- a/src/core/MOM_dynamics_split_RK2.F90 +++ b/src/core/MOM_dynamics_split_RK2.F90 @@ -71,12 +71,12 @@ module MOM_dynamics_split_RK2 real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_,NKMEM_) :: & CAu, & !< CAu = f*v - u.grad(u) [m s-2] PFu, & !< PFu = -dM/dx [m s-2] - diffu !< Zonal acceleration due to convergence of the along-isopycnal stress tensor [m s-2] + diffu !< Zonal acceleration due to convergence of the along-isopycnal stress tensor [m s-1 T-1 ~> m s-2] real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_,NKMEM_) :: & CAv, & !< CAv = -f*u - u.grad(v) [m s-2] PFv, & !< PFv = -dM/dy [m s-2] - diffv !< Meridional acceleration due to convergence of the along-isopycnal stress tensor [m s-2] + diffv !< Meridional acceleration due to convergence of the along-isopycnal stress tensor [m s-1 T-1 ~> m s-2] real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_,NKMEM_) :: visc_rem_u !< Both the fraction of the zonal momentum originally in a @@ -449,10 +449,10 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & !$OMP parallel do default(shared) do k=1,nz do j=js,je ; do I=Isq,Ieq - u_bc_accel(I,j,k) = (CS%Cau(I,j,k) + CS%PFu(I,j,k)) + CS%diffu(I,j,k) + u_bc_accel(I,j,k) = (CS%Cau(I,j,k) + CS%PFu(I,j,k)) + US%s_to_T*CS%diffu(I,j,k) enddo ; enddo do J=Jsq,Jeq ; do i=is,ie - v_bc_accel(i,J,k) = (CS%Cav(i,J,k) + CS%PFv(i,J,k)) + CS%diffv(i,J,k) + v_bc_accel(i,J,k) = (CS%Cav(i,J,k) + CS%PFv(i,J,k)) + US%s_to_T*CS%diffv(i,J,k) enddo ; enddo enddo if (associated(CS%OBC)) then @@ -708,10 +708,10 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & !$OMP parallel do default(shared) do k=1,nz do j=js,je ; do I=Isq,Ieq - u_bc_accel(I,j,k) = (CS%Cau(I,j,k) + CS%PFu(I,j,k)) + CS%diffu(I,j,k) + u_bc_accel(I,j,k) = (CS%Cau(I,j,k) + CS%PFu(I,j,k)) + US%s_to_T*CS%diffu(I,j,k) enddo ; enddo do J=Jsq,Jeq ; do i=is,ie - v_bc_accel(i,J,k) = (CS%Cav(i,J,k) + CS%PFv(i,J,k)) + CS%diffv(i,J,k) + v_bc_accel(i,J,k) = (CS%Cav(i,J,k) + CS%PFv(i,J,k)) + US%s_to_T*CS%diffv(i,J,k) enddo ; enddo enddo if (associated(CS%OBC)) then diff --git a/src/core/MOM_dynamics_unsplit.F90 b/src/core/MOM_dynamics_unsplit.F90 index e5020a807b..2d59655e41 100644 --- a/src/core/MOM_dynamics_unsplit.F90 +++ b/src/core/MOM_dynamics_unsplit.F90 @@ -109,12 +109,12 @@ module MOM_dynamics_unsplit real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_,NKMEM_) :: & CAu, & !< CAu = f*v - u.grad(u) [m s-2]. PFu, & !< PFu = -dM/dx [m s-2]. - diffu !< Zonal acceleration due to convergence of the along-isopycnal stress tensor [m s-2]. + diffu !< Zonal acceleration due to convergence of the along-isopycnal stress tensor [m s-1 T-1 ~> mm s-2]. real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_,NKMEM_) :: & CAv, & !< CAv = -f*u - u.grad(v) [m s-2]. PFv, & !< PFv = -dM/dy [m s-2]. - diffv !< Meridional acceleration due to convergence of the along-isopycnal stress tensor [m s-2]. + diffv !< Meridional acceleration due to convergence of the along-isopycnal stress tensor [m s-1 T-1 ~> m s-2]. real, pointer, dimension(:,:) :: taux_bot => NULL() !< frictional x-bottom stress from the ocean to the seafloor (Pa) real, pointer, dimension(:,:) :: tauy_bot => NULL() !< frictional y-bottom stress from the ocean to the seafloor (Pa) @@ -283,10 +283,10 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & h_av(i,j,k) = (h(i,j,k) + hp(i,j,k)) * 0.5 enddo ; enddo do j=js,je ; do I=Isq,Ieq - u(I,j,k) = u(I,j,k) + dt * CS%diffu(I,j,k) * G%mask2dCu(I,j) + u(I,j,k) = u(I,j,k) + dt * US%s_to_T*CS%diffu(I,j,k) * G%mask2dCu(I,j) enddo ; enddo do J=Jsq,Jeq ; do i=is,ie - v(i,J,k) = v(i,J,k) + dt * CS%diffv(i,J,k) * G%mask2dCv(i,J) + v(i,J,k) = v(i,J,k) + dt * US%s_to_T*CS%diffv(i,J,k) * G%mask2dCv(i,J) enddo ; enddo do j=js-2,je+2 ; do I=Isq-2,Ieq+2 uhtr(i,j,k) = uhtr(i,j,k) + 0.5*dt*uh(i,j,k) diff --git a/src/core/MOM_dynamics_unsplit_RK2.F90 b/src/core/MOM_dynamics_unsplit_RK2.F90 index 12feba7a95..78a025a1a0 100644 --- a/src/core/MOM_dynamics_unsplit_RK2.F90 +++ b/src/core/MOM_dynamics_unsplit_RK2.F90 @@ -106,12 +106,12 @@ module MOM_dynamics_unsplit_RK2 real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_,NKMEM_) :: & CAu, & !< CAu = f*v - u.grad(u) [m s-2]. PFu, & !< PFu = -dM/dx [m s-2]. - diffu !< Zonal acceleration due to convergence of the along-isopycnal stress tensor [m s-2]. + diffu !< Zonal acceleration due to convergence of the along-isopycnal stress tensor [m s-1 T-1 ~> m s-2]. real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_,NKMEM_) :: & CAv, & !< CAv = -f*u - u.grad(v) [m s-2]. PFv, & !< PFv = -dM/dy [m s-2]. - diffv !< Meridional acceleration due to convergence of the along-isopycnal stress tensor [m s-2]. + diffv !< Meridional acceleration due to convergence of the along-isopycnal stress tensor [m s-1 T-1 ~> m s-2]. real, pointer, dimension(:,:) :: taux_bot => NULL() !< frictional x-bottom stress from the ocean to the seafloor (Pa) real, pointer, dimension(:,:) :: tauy_bot => NULL() !< frictional y-bottom stress from the ocean to the seafloor (Pa) @@ -323,11 +323,11 @@ subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt, call cpu_clock_begin(id_clock_mom_update) do k=1,nz ; do j=js,je ; do I=Isq,Ieq up(I,j,k) = G%mask2dCu(I,j) * (u_in(I,j,k) + dt_pred * & - ((CS%PFu(I,j,k) + CS%CAu(I,j,k)) + CS%diffu(I,j,k))) + ((CS%PFu(I,j,k) + CS%CAu(I,j,k)) + US%s_to_T*CS%diffu(I,j,k))) enddo ; enddo ; enddo do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie vp(i,J,k) = G%mask2dCv(i,J) * (v_in(i,J,k) + dt_pred * & - ((CS%PFv(i,J,k) + CS%CAv(i,J,k)) + CS%diffv(i,J,k))) + ((CS%PFv(i,J,k) + CS%CAv(i,J,k)) + US%s_to_T*CS%diffv(i,J,k))) enddo ; enddo ; enddo call cpu_clock_end(id_clock_mom_update) @@ -380,15 +380,15 @@ subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt, ! u*[n+1] = u[n] + dt * ( PFu + CAu ) do k=1,nz ; do j=js,je ; do I=Isq,Ieq up(I,j,k) = G%mask2dCu(I,j) * (u_in(I,j,k) + dt * (1.+CS%begw) * & - ((CS%PFu(I,j,k) + CS%CAu(I,j,k)) + CS%diffu(I,j,k))) + ((CS%PFu(I,j,k) + CS%CAu(I,j,k)) + US%s_to_T*CS%diffu(I,j,k))) u_in(I,j,k) = G%mask2dCu(I,j) * (u_in(I,j,k) + dt * & - ((CS%PFu(I,j,k) + CS%CAu(I,j,k)) + CS%diffu(I,j,k))) + ((CS%PFu(I,j,k) + CS%CAu(I,j,k)) + US%s_to_T*CS%diffu(I,j,k))) enddo ; enddo ; enddo do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie vp(i,J,k) = G%mask2dCv(i,J) * (v_in(i,J,k) + dt * (1.+CS%begw) * & - ((CS%PFv(i,J,k) + CS%CAv(i,J,k)) + CS%diffv(i,J,k))) + ((CS%PFv(i,J,k) + CS%CAv(i,J,k)) + US%s_to_T*CS%diffv(i,J,k))) v_in(i,J,k) = G%mask2dCv(i,J) * (v_in(i,J,k) + dt * & - ((CS%PFv(i,J,k) + CS%CAv(i,J,k)) + CS%diffv(i,J,k))) + ((CS%PFv(i,J,k) + CS%CAv(i,J,k)) + US%s_to_T*CS%diffv(i,J,k))) enddo ; enddo ; enddo ! up[n] <- up* + dt d/dz visc d/dz up diff --git a/src/core/MOM_variables.F90 b/src/core/MOM_variables.F90 index 8df0b31406..071d63246f 100644 --- a/src/core/MOM_variables.F90 +++ b/src/core/MOM_variables.F90 @@ -138,8 +138,8 @@ module MOM_variables CAv => NULL(), & !< Pointer to the meridional Coriolis and Advective acceleration [m s-2] PFu => NULL(), & !< Pointer to the zonal Pressure force acceleration [m s-2] PFv => NULL(), & !< Pointer to the meridional Pressure force acceleration [m s-2] - diffu => NULL(), & !< Pointer to the zonal acceleration due to lateral viscosity [m s-2] - diffv => NULL(), & !< Pointer to the meridional acceleration due to lateral viscosity [m s-2] + diffu => NULL(), & !< Pointer to the zonal acceleration due to lateral viscosity [m s-1 T-1 ~> m s-2] + diffv => NULL(), & !< Pointer to the meridional acceleration due to lateral viscosity [m s-1 T-1 ~> m s-2] pbce => NULL(), & !< Pointer to the baroclinic pressure force dependency on free surface movement !! [m2 s-2 H-1 ~> m s-2 or m4 kg-1 s-2] u_accel_bt => NULL(), & !< Pointer to the zonal barotropic-solver acceleration [m s-2] @@ -156,8 +156,8 @@ module MOM_variables ! Each of the following fields has nz layers. real, pointer, dimension(:,:,:) :: & - diffu => NULL(), & !< Zonal acceleration due to along isopycnal viscosity [m s-2] - diffv => NULL(), & !< Meridional acceleration due to along isopycnal viscosity [m s-2] + diffu => NULL(), & !< Zonal acceleration due to along isopycnal viscosity [m s-1 T-1 ~> m s-2] + diffv => NULL(), & !< Meridional acceleration due to along isopycnal viscosity [m s-1 T-1 ~> m s-2] CAu => NULL(), & !< Zonal Coriolis and momentum advection accelerations [m s-2] CAv => NULL(), & !< Meridional Coriolis and momentum advection accelerations [m s-2] PFu => NULL(), & !< Zonal acceleration due to pressure forces [m s-2] diff --git a/src/diagnostics/MOM_PointAccel.F90 b/src/diagnostics/MOM_PointAccel.F90 index 9c2f0b6adf..d488171fc5 100644 --- a/src/diagnostics/MOM_PointAccel.F90 +++ b/src/diagnostics/MOM_PointAccel.F90 @@ -192,7 +192,7 @@ subroutine write_u_accel(I, j, um, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st write(file,'(/,"PFu: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (dt*ADp%PFu(I,j,k)); enddo write(file,'(/,"diffu: ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (dt*ADp%diffu(I,j,k)); enddo + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (dt*US%s_to_T*ADp%diffu(I,j,k)); enddo if (associated(ADp%gradKEu)) then write(file,'(/,"KEu: ",$)') @@ -358,7 +358,7 @@ subroutine write_u_accel(I, j, um, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st write(file,'(/,"diffu: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(F10.6," ",$)') & - (dt*ADp%diffu(I,j,k)*Inorm(k)); enddo + (dt*US%s_to_T*ADp%diffu(I,j,k)*Inorm(k)); enddo if (associated(ADp%gradKEu)) then write(file,'(/,"KEu: ",$)') @@ -526,7 +526,7 @@ subroutine write_v_accel(i, J, vm, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (dt*ADp%PFv(i,J,k)); enddo write(file,'(/,"diffv: ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (dt*ADp%diffv(i,J,k)); enddo + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (dt*US%s_to_T*ADp%diffv(i,J,k)); enddo if (associated(ADp%gradKEv)) then write(file,'(/,"KEv: ",$)') @@ -688,7 +688,7 @@ subroutine write_v_accel(i, J, vm, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st (dt*ADp%PFv(i,J,k)*Inorm(k)); enddo write(file,'(/,"diffv: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(F10.6," ",$)') & - (dt*ADp%diffv(i,J,k)*Inorm(k)); enddo + (dt*US%s_to_T*ADp%diffv(i,J,k)*Inorm(k)); enddo if (associated(ADp%gradKEu)) then write(file,'(/,"KEv: ",$)') diff --git a/src/diagnostics/MOM_diagnostics.F90 b/src/diagnostics/MOM_diagnostics.F90 index 419301b3bc..0a687cf8b4 100644 --- a/src/diagnostics/MOM_diagnostics.F90 +++ b/src/diagnostics/MOM_diagnostics.F90 @@ -266,7 +266,7 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & call diag_restore_grids(CS%diag) - call calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, GV, CS) + call calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, GV, US, CS) endif ! smg: is the following robust to ALE? It seems a bit opaque. @@ -878,7 +878,7 @@ subroutine calculate_vertical_integrals(h, tv, p_surf, G, GV, US, CS) end subroutine calculate_vertical_integrals !> This subroutine calculates terms in the mechanical energy budget. -subroutine calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, GV, CS) +subroutine calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, GV, US, CS) type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & @@ -895,6 +895,7 @@ subroutine calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, GV, CS) !! [H m2 s-1 ~> m3 s-1 or kg s-1]. type(accel_diag_ptrs), intent(in) :: ADp !< Structure pointing to accelerations in momentum equation. type(cont_diag_ptrs), intent(in) :: CDp !< Structure pointing to terms in continuity equations. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(diagnostics_CS), intent(inout) :: CS !< Control structure returned by a previous call to !! diagnostics_init. @@ -1036,10 +1037,10 @@ subroutine calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, GV, CS) if (associated(CS%KE_horvisc)) then do k=1,nz do j=js,je ; do I=Isq,Ieq - KE_u(I,j) = uh(I,j,k)*G%dxCu(I,j)*ADp%diffu(I,j,k) + KE_u(I,j) = uh(I,j,k)*G%dxCu(I,j)*US%s_to_T*ADp%diffu(I,j,k) enddo ; enddo do J=Jsq,Jeq ; do i=is,ie - KE_v(i,J) = vh(i,J,k)*G%dyCv(i,J)*ADp%diffv(i,J,k) + KE_v(i,J) = vh(i,J,k)*G%dyCv(i,J)*US%s_to_T*ADp%diffv(i,J,k) enddo ; enddo if (.not.G%symmetric) & call do_group_pass(CS%pass_KE_uv, G%domain) diff --git a/src/parameterizations/lateral/MOM_hor_visc.F90 b/src/parameterizations/lateral/MOM_hor_visc.F90 index 7e29e20c13..20b908558a 100644 --- a/src/parameterizations/lateral/MOM_hor_visc.F90 +++ b/src/parameterizations/lateral/MOM_hor_visc.F90 @@ -207,10 +207,10 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, intent(inout) :: h !< Layer thicknesses [H ~> m or kg m-2]. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & intent(out) :: diffu !< Zonal acceleration due to convergence of - !! along-coordinate stress tensor [m s-2] + !! along-coordinate stress tensor [m s-1 T-1 ~> m s-2] real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & intent(out) :: diffv !< Meridional acceleration due to convergence - !! of along-coordinate stress tensor [m s-2]. + !! of along-coordinate stress tensor [m s-1 T-1 ~> m s-2]. type(MEKE_type), pointer :: MEKE !< Pointer to a structure containing fields !! related to Mesoscale Eddy Kinetic Energy. type(VarMix_CS), pointer :: VarMix !< Pointer to a structure with fields that @@ -1257,7 +1257,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, ! Evaluate 1/h x.Div(h Grad u) or the biharmonic equivalent. do j=js,je ; do I=Isq,Ieq - diffu(I,j,k) = ((G%IdyCu(I,j)*(CS%DY2h(i,j) *str_xx(i,j) - & + diffu(I,j,k) = US%T_to_s*((G%IdyCu(I,j)*(CS%DY2h(i,j) *str_xx(i,j) - & CS%DY2h(i+1,j)*str_xx(i+1,j)) + & G%IdxCu(I,j)*(CS%DX2q(I,J-1)*str_xy(I,J-1) - & CS%DX2q(I,J) *str_xy(I,J))) * & @@ -1279,7 +1279,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, ! Evaluate 1/h y.Div(h Grad u) or the biharmonic equivalent. do J=Jsq,Jeq ; do i=is,ie - diffv(i,J,k) = ((G%IdyCv(i,J)*(CS%DY2q(I-1,J)*str_xy(I-1,J) - & + diffv(i,J,k) = US%T_to_s*((G%IdyCv(i,J)*(CS%DY2q(I-1,J)*str_xy(I-1,J) - & CS%DY2q(I,J) *str_xy(I,J)) - & G%IdxCv(i,J)*(CS%DX2h(i,j) *str_xx(i,j) - & CS%DX2h(i,j+1)*str_xx(i,j+1))) * & @@ -2088,10 +2088,10 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS) ! Register fields for output from this module. CS%id_diffu = register_diag_field('ocean_model', 'diffu', diag%axesCuL, Time, & - 'Zonal Acceleration from Horizontal Viscosity', 'm s-2') + 'Zonal Acceleration from Horizontal Viscosity', 'm s-2', conversion=US%s_to_T) CS%id_diffv = register_diag_field('ocean_model', 'diffv', diag%axesCvL, Time, & - 'Meridional Acceleration from Horizontal Viscosity', 'm s-2') + 'Meridional Acceleration from Horizontal Viscosity', 'm s-2', conversion=US%s_to_T) if (CS%biharmonic) then CS%id_Ah_h = register_diag_field('ocean_model', 'Ahh', diag%axesTL, Time, & From b5be6a31055f22b87369ae574bcc5e742c861185 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 16 Jul 2019 18:10:29 -0400 Subject: [PATCH 116/150] Changed the units of str_xx to [H m2 s-1 T-1] Changed the units of the 6 str_xx and str_xy variables in MOM_hor_visc to [H m2 s-1 T-1] for dimensional consistency testing. All answers are bitwise identical. --- .../lateral/MOM_hor_visc.F90 | 34 +++++++++---------- 1 file changed, 17 insertions(+), 17 deletions(-) diff --git a/src/parameterizations/lateral/MOM_hor_visc.F90 b/src/parameterizations/lateral/MOM_hor_visc.F90 index 20b908558a..5d180680ce 100644 --- a/src/parameterizations/lateral/MOM_hor_visc.F90 +++ b/src/parameterizations/lateral/MOM_hor_visc.F90 @@ -240,9 +240,9 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, div_xx, & ! Estimate of horizontal divergence at h-points [s-1] sh_xx, & ! horizontal tension (du/dx - dv/dy) including metric terms [s-1] sh_xx_bt, & ! barotropic horizontal tension (du/dx - dv/dy) including metric terms [s-1] - str_xx,& ! str_xx is the diagonal term in the stress tensor [H m2 s-2 ~> m3 s-2 or kg s-2] - str_xx_GME,& ! smoothed diagonal term in the stress tensor from GME [H m2 s-2] - bhstr_xx,& ! A copy of str_xx that only contains the biharmonic contribution [H m2 s-2 ~> m3 s-2 or kg s-2] + str_xx,& ! str_xx is the diagonal term in the stress tensor [H m2 s-1 T-1 ~> m3 s-2 or kg s-2] + str_xx_GME,& ! smoothed diagonal term in the stress tensor from GME [H m2 s-1 T-1 ~> m3 s-2 or kg s-2] + bhstr_xx,& ! A copy of str_xx that only contains the biharmonic contribution [H m2 T-1 s-1 ~> m3 s-2 or kg s-2] FrictWorkIntz, & ! depth integrated energy dissipated by lateral friction [W m-2] Leith_Kh_h, & ! Leith Laplacian viscosity at h-points [m2 s-1] Leith_Ah_h, & ! Leith bi-harmonic viscosity at h-points [m4 s-1] @@ -895,7 +895,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, if ((CS%id_Kh_h>0) .or. find_FrictWork) Kh_h(i,j,k) = Kh if (CS%id_div_xx_h>0) div_xx_h(i,j,k) = div_xx(i,j) - str_xx(i,j) = -Kh * sh_xx(i,j) + str_xx(i,j) = -US%T_to_s*Kh * sh_xx(i,j) else ! not Laplacian str_xx(i,j) = 0.0 endif ! Laplacian @@ -904,7 +904,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, ! Shearing-strain averaged to h-points local_strain = 0.25 * ( (sh_xy(I,J) + sh_xy(I-1,J-1)) + (sh_xy(I-1,J) + sh_xy(I,J-1)) ) ! *Add* the shear-strain contribution to the xx-component of stress - str_xx(i,j) = str_xx(i,j) - CS%Kh_aniso * CS%n1n2_h(i,j) * CS%n1n1_m_n2n2_h(i,j) * local_strain + str_xx(i,j) = str_xx(i,j) - US%T_to_s*CS%Kh_aniso * CS%n1n2_h(i,j) * CS%n1n1_m_n2n2_h(i,j) * local_strain endif if (CS%biharmonic) then @@ -936,12 +936,12 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, if ((CS%id_Ah_h>0) .or. find_FrictWork) Ah_h(i,j,k) = Ah - str_xx(i,j) = str_xx(i,j) + Ah * & + str_xx(i,j) = str_xx(i,j) + US%T_to_s*Ah * & (CS%DY_dxT(i,j)*(G%IdyCu(I,j)*u0(I,j) - G%IdyCu(I-1,j)*u0(I-1,j)) - & CS%DX_dyT(i,j) *(G%IdxCv(i,J)*v0(i,J) - G%IdxCv(i,J-1)*v0(i,J-1))) ! Keep a copy of the biharmonic contribution for backscatter parameterization - bhstr_xx(i,j) = Ah * & + bhstr_xx(i,j) = US%T_to_s*Ah * & (CS%DY_dxT(i,j)*(G%IdyCu(I,j)*u0(I,j) - G%IdyCu(I-1,j)*u0(I-1,j)) - & CS%DX_dyT(i,j) *(G%IdxCv(i,J)*v0(i,J) - G%IdxCv(i,J-1)*v0(i,J-1))) bhstr_xx(i,j) = bhstr_xx(i,j) * (h(i,j,k) * CS%reduction_xx(i,j)) @@ -1061,7 +1061,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, if (CS%id_Kh_q>0) Kh_q(I,J,k) = Kh if (CS%id_vort_xy_q>0) vort_xy_q(I,J,k) = vort_xy(I,J) - str_xy(I,J) = -Kh * sh_xy(I,J) + str_xy(I,J) = -US%T_to_s*Kh * sh_xy(I,J) else ! not Laplacian str_xy(I,J) = 0.0 endif ! Laplacian @@ -1070,7 +1070,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, ! Horizontal-tension averaged to q-points local_strain = 0.25 * ( (sh_xx(i,j) + sh_xx(i+1,j+1)) + (sh_xx(i+1,j) + sh_xx(i,j+1)) ) ! *Add* the tension contribution to the xy-component of stress - str_xy(I,J) = str_xy(I,J) - CS%Kh_aniso * CS%n1n2_q(i,j) * CS%n1n1_m_n2n2_q(i,j) * local_strain + str_xy(I,J) = str_xy(I,J) - US%T_to_s*CS%Kh_aniso * CS%n1n2_q(i,j) * CS%n1n1_m_n2n2_q(i,j) * local_strain endif if (CS%biharmonic) then @@ -1105,10 +1105,10 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, if (CS%id_Ah_q>0) Ah_q(I,J,k) = Ah - str_xy(I,J) = str_xy(I,J) + Ah * ( dvdx(I,J) + dudy(I,J) ) + str_xy(I,J) = str_xy(I,J) + US%T_to_s*Ah * ( dvdx(I,J) + dudy(I,J) ) ! Keep a copy of the biharmonic contribution for backscatter parameterization - bhstr_xy(I,J) = Ah * ( dvdx(I,J) + dudy(I,J) ) * & + bhstr_xy(I,J) = US%T_to_s*Ah * ( dvdx(I,J) + dudy(I,J) ) * & (hq(I,J) * G%mask2dBu(I,J) * CS%reduction_xy(I,J)) endif ! biharmonic @@ -1194,7 +1194,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, if ((CS%id_GME_coeff_h>0) .or. find_FrictWork) GME_coeff_h(i,j,k) = GME_coeff - str_xx_GME(i,j) = GME_coeff * sh_xx_bt(i,j) + str_xx_GME(i,j) = US%T_to_s*GME_coeff * sh_xx_bt(i,j) enddo ; enddo @@ -1213,7 +1213,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, endif if (CS%id_GME_coeff_q>0) GME_coeff_q(I,J,k) = GME_coeff - str_xy_GME(I,J) = GME_coeff * sh_xy_bt(I,J) + str_xy_GME(I,J) = US%T_to_s*GME_coeff * sh_xy_bt(I,J) enddo ; enddo @@ -1257,7 +1257,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, ! Evaluate 1/h x.Div(h Grad u) or the biharmonic equivalent. do j=js,je ; do I=Isq,Ieq - diffu(I,j,k) = US%T_to_s*((G%IdyCu(I,j)*(CS%DY2h(i,j) *str_xx(i,j) - & + diffu(I,j,k) = ((G%IdyCu(I,j)*(CS%DY2h(i,j) *str_xx(i,j) - & CS%DY2h(i+1,j)*str_xx(i+1,j)) + & G%IdxCu(I,j)*(CS%DX2q(I,J-1)*str_xy(I,J-1) - & CS%DX2q(I,J) *str_xy(I,J))) * & @@ -1279,7 +1279,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, ! Evaluate 1/h y.Div(h Grad u) or the biharmonic equivalent. do J=Jsq,Jeq ; do i=is,ie - diffv(i,J,k) = US%T_to_s*((G%IdyCv(i,J)*(CS%DY2q(I-1,J)*str_xy(I-1,J) - & + diffv(i,J,k) = ((G%IdyCv(i,J)*(CS%DY2q(I-1,J)*str_xy(I-1,J) - & CS%DY2q(I,J) *str_xy(I,J)) - & G%IdxCv(i,J)*(CS%DX2h(i,j) *str_xx(i,j) - & CS%DX2h(i,j+1)*str_xx(i,j+1))) * & @@ -1301,7 +1301,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, if (find_FrictWork) then ; do j=js,je ; do i=is,ie ! Diagnose str_xx*d_x u - str_yy*d_y v + str_xy*(d_y u + d_x v) ! This is the old formulation that includes energy diffusion - FrictWork(i,j,k) = GV%H_to_kg_m2 * ( & + FrictWork(i,j,k) = US%s_to_T*GV%H_to_kg_m2 * ( & (str_xx(i,j)*(u(I,j,k)-u(I-1,j,k))*G%IdxT(i,j) & -str_xx(i,j)*(v(i,J,k)-v(i,J-1,k))*G%IdyT(i,j)) & +0.25*((str_xy(I,J)*( & @@ -1352,7 +1352,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, RoScl = Sh_F_pow / (1.0 + Sh_F_pow) ! = 1 - f^n/(f^n+c*D^n) endif endif - MEKE%mom_src(i,j) = MEKE%mom_src(i,j) + GV%H_to_kg_m2 * ( & + MEKE%mom_src(i,j) = MEKE%mom_src(i,j) + US%s_to_T*GV%H_to_kg_m2 * ( & ((str_xx(i,j)-RoScl*bhstr_xx(i,j))*(u(I,j,k)-u(I-1,j,k))*G%IdxT(i,j) & -(str_xx(i,j)-RoScl*bhstr_xx(i,j))*(v(i,J,k)-v(i,J-1,k))*G%IdyT(i,j)) & +0.25*(((str_xy(I,J)-RoScl*bhstr_xy(I,J))*( & From f72454b8b0e529719221ea968c5a684a29817858 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Tue, 16 Jul 2019 18:12:28 -0600 Subject: [PATCH 117/150] changes to have minimal differences between nuopc and mct --- config_src/mct_driver/MOM_ocean_model.F90 | 34 - config_src/mct_driver/MOM_surface_forcing.F90 | 777 +++++++++--------- config_src/mct_driver/ocn_cap_methods.F90 | 9 +- config_src/mct_driver/ocn_comp_mct.F90 | 61 +- config_src/nuopc_driver/MOM_ocean_model.F90 | 99 ++- .../nuopc_driver/MOM_surface_forcing.F90 | 7 +- 6 files changed, 505 insertions(+), 482 deletions(-) diff --git a/config_src/mct_driver/MOM_ocean_model.F90 b/config_src/mct_driver/MOM_ocean_model.F90 index 69deaf4ab9..2a984916aa 100644 --- a/config_src/mct_driver/MOM_ocean_model.F90 +++ b/config_src/mct_driver/MOM_ocean_model.F90 @@ -353,19 +353,6 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, gas_fields_ocn, i call get_param(param_file, mdl, "ICEBERGS_APPLY_RIGID_BOUNDARY", OS%icebergs_alter_ocean, & "If true, allows icebergs to change boundary condition felt by ocean", default=.false.) - ! MV: question for Gustavo - what to do with the following? - - ! call get_param(param_file, mdl, "KV_ICEBERG", OS%kv_iceberg, & - ! "The viscosity of the icebergs", units="m2 s-1",default=1.0e10) - ! call get_param(param_file, mdl, "DENSITY_ICEBERGS", OS%density_iceberg, & - ! "A typical density of icebergs.", units="kg m-3", default=917.0) - ! call get_param(param_file, mdl, "LATENT_HEAT_FUSION", OS%latent_heat_fusion, & - ! "The latent heat of fusion.", units="J/kg", default=hlf) - ! call get_param(param_file, mdl, "BERG_AREA_THRESHOLD", OS%berg_area_threshold, & - ! "Fraction of grid cell which iceberg must occupy, so that fluxes "//& - ! "below berg are set to zero. Not applied for negative "//& - ! " values.", units="non-dim", default=-1.0) - OS%press_to_z = 1.0/(Rho0*G_Earth) call get_param(param_file, mdl, "HFREEZE", HFrz, & @@ -407,13 +394,6 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, gas_fields_ocn, i call MOM_wave_interface_init_lite(param_file) endif - ! MV - what to do with the following? - ! if (OS%icebergs_apply_rigid_boundary) then - ! !call allocate_forcing_type(OS%grid, OS%fluxes, iceberg=.true.) - ! !This assumes that the iceshelf and ocean are on the same grid. I hope this is true - ! if (.not. OS%use_ice_shelf) call allocate_forcing_type(OS%grid, OS%fluxes, ustar=.true., shelf=.true.) - ! endif - if (associated(OS%grid%Domain%maskmap)) then call initialize_ocean_public_type(OS%grid%Domain%mpp_domain, Ocean_sfc, & OS%diag, maskmap=OS%grid%Domain%maskmap, & @@ -556,13 +536,6 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & OS%sfc_state, dt_coupling, OS%marine_ice_CSp) endif - ! GMM, check ocean_model_MOM.F90 to enable the following option - !if (OS%icebergs_apply_rigid_boundary) then - ! This assumes that the iceshelf and ocean are on the same grid. I hope this is true. - ! call add_berg_flux_to_shelf(OS%grid, OS%forces,OS%fluxes,OS%use_ice_shelf,OS%density_iceberg, & - ! OS%kv_iceberg, OS%latent_heat_fusion, OS%sfc_state, dt_coupling, OS%berg_area_threshold) - !endif - ! Fields that exist in both the forcing and mech_forcing types must be copied. call copy_common_forcing_fields(OS%forces, OS%fluxes, OS%grid) @@ -598,13 +571,6 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & OS%sfc_state, dt_coupling, OS%marine_ice_CSp) endif - ! GMM, check ocean_model_MOM.F90 to enable the following option - !if (OS%icebergs_apply_rigid_boundary) then - !This assumes that the iceshelf and ocean are on the same grid. I hope this is true - ! call add_berg_flux_to_shelf(OS%grid, OS%forces, OS%flux_tmp, OS%use_ice_shelf,OS%density_iceberg, & - ! OS%kv_iceberg, OS%latent_heat_fusion, OS%sfc_state, dt_coupling, OS%berg_area_threshold) - !endif - call forcing_accumulate(OS%flux_tmp, OS%forces, OS%fluxes, dt_coupling, OS%grid, weight) ! Some of the fields that exist in both the forcing and mech_forcing types diff --git a/config_src/mct_driver/MOM_surface_forcing.F90 b/config_src/mct_driver/MOM_surface_forcing.F90 index 0e2b82d87b..0fc0efe532 100644 --- a/config_src/mct_driver/MOM_surface_forcing.F90 +++ b/config_src/mct_driver/MOM_surface_forcing.F90 @@ -38,42 +38,42 @@ module MOM_surface_forcing use coupler_types_mod, only : coupler_type_copy_data use data_override_mod, only : data_override_init, data_override use fms_mod, only : stdout -use fms_mod, only : read_data use mpp_mod, only : mpp_chksum use time_interp_external_mod, only : init_external_field, time_interp_external use time_interp_external_mod, only : time_interp_external_init -! MCT specfic routines -use ocn_cpl_indices, only : cpl_indices_type - implicit none ; private #include -public IOB_allocate public convert_IOB_to_fluxes public convert_IOB_to_forces public surface_forcing_init -public ice_ocn_bnd_type_chksum public forcing_save_restart -public apply_flux_adjustments +public ice_ocn_bnd_type_chksum + +private apply_flux_adjustments +private apply_force_adjustments +private surface_forcing_end !> Contains pointers to the forcing fields which may be used to drive MOM. !! All fluxes are positive downward. -type, public :: surface_forcing_CS ; +type, public :: surface_forcing_CS ; private integer :: wind_stagger !< AGRID, BGRID_NE, or CGRID_NE (integer values !! from MOM_domains) to indicate the staggering of !! the winds that are being provided in calls to - !! update_ocean_model. CIME uses AGRID, so this option - !! is being hard coded for now. - logical :: use_temperature !< If true, temp and saln used as state variables + !! update_ocean_model. + logical :: use_temperature !! If true, temp and saln used as state variables 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 [m^2] + real :: latent_heat_fusion !< latent heat of fusion [J/kg] + real :: latent_heat_vapor !< latent heat of vaporization [J/kg] + 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 @@ -84,127 +84,122 @@ 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(:,:) :: & TKE_tidal => NULL(), & !< turbulent kinetic energy introduced to the - !! bottom boundary layer by drag on the tidal flows, - !! in W m-2. + !! bottom boundary layer by drag on the tidal flows [W m-2] gust => NULL(), & !< spatially varying unresolved background - !! gustiness that contributes to ustar (Pa). + !! 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-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]. + ustar_tidal => NULL() !< tidal contribution to the bottom friction velocity [m/s] + 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] logical :: read_tideamp !< If true, spatially varying tidal amplitude read from a file. 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 - !! only used to convert the ice pressure into - !! appropriate units for use with Kv_sea_ice. + 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 + !! 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, in kg m-2, - !! typically of order 1000 kg m-2. + !! typically of order 1000 [kg m-2]. logical :: allow_flux_adjustments !< If true, use data_override to obtain flux adjustments - real :: Flux_const !< piston velocity for surface restoring [m s-1] - logical :: salt_restore_as_sflux !< If true, SSS restore as salt flux instead of water flux - logical :: adjust_net_srestore_to_zero !< adjust srestore to zero (for both salt_flux or vprec) + real :: Flux_const !< piston velocity for surface restoring [m/s] + logical :: salt_restore_as_sflux !< If true, SSS restore as salt flux instead of water flux + logical :: adjust_net_srestore_to_zero !< adjust srestore to zero (for both salt_flux or vprec) logical :: adjust_net_srestore_by_scaling !< adjust srestore w/o moving zero contour logical :: adjust_net_fresh_water_to_zero !< adjust net surface fresh-water (w/ restoring) to zero - logical :: use_net_FW_adjustment_sign_bug ! use the wrong sign when adjusting net FW + logical :: use_net_FW_adjustment_sign_bug !< use the wrong sign when adjusting net FW logical :: adjust_net_fresh_water_by_scaling !< adjust net surface fresh-water w/o moving zero contour logical :: mask_srestore_under_ice !< If true, use an ice mask defined by frazil - !! criteria for salinity restoring. - real :: ice_salt_concentration !< salt concentration for sea ice (kg/kg) + !< criteria for salinity restoring. + real :: ice_salt_concentration !< salt concentration for sea ice [kg/kg] logical :: mask_srestore_marginal_seas !< if true, then mask SSS restoring in marginal seas 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 SSS restoring + real, pointer, dimension(:,:) :: basin_mask => NULL() !< mask for SSS restoring by basin type(diag_ctrl), pointer :: diag !< structure to regulate diagnostic output timing character(len=200) :: inputdir !< directory where NetCDF input files are character(len=200) :: salt_restore_file !< filename for salt restoring data character(len=30) :: salt_restore_var_name !< name of surface salinity in salt_restore_file - logical :: mask_srestore ! if true, apply a 2-dimensional mask to the surface - ! salinity restoring fluxes. The masking file should be - ! in inputdir/salt_restore_mask.nc and the field should - ! be named 'mask' - real, pointer, dimension(:,:) :: srestore_mask => NULL() ! mask for SSS restoring + logical :: mask_srestore !< if true, apply a 2-dimensional mask to the surface + !< salinity restoring fluxes. The masking file should be + !< in inputdir/salt_restore_mask.nc and the field should + !! be named 'mask' + real, pointer, dimension(:,:) :: srestore_mask => NULL() !< mask for SSS restoring character(len=200) :: temp_restore_file !< filename for sst restoring data character(len=30) :: temp_restore_var_name !< name of surface temperature in temp_restore_file - logical :: mask_trestore ! if true, apply a 2-dimensional mask to the surface - ! temperature restoring fluxes. The masking file should be - ! in inputdir/temp_restore_mask.nc and the field should - ! be named 'mask' - real, pointer, dimension(:,:) :: trestore_mask => NULL() ! mask for SST restoring + logical :: mask_trestore !< if true, apply a 2-dimensional mask to the surface + !! temperature restoring fluxes. The masking file should be + !! in inputdir/temp_restore_mask.nc and the field should + !! be named 'mask' + real, pointer, dimension(:,:) :: trestore_mask => NULL() !< mask for SST restoring integer :: id_srestore = -1 !< id number for time_interp_external. integer :: id_trestore = -1 !< id number for time_interp_external. - type(forcing_diags), public :: handles !< diagnostics handles + + ! Diagnostics handles + type(forcing_diags), public :: handles + !### type(ctrl_forcing_CS), pointer :: ctrl_forcing_CSp => NULL() - type(MOM_restart_CS), pointer :: restart_CSp => NULL() !< restart pointer - type(user_revise_forcing_CS), pointer :: urf_CS => NULL()!< user revise pointer + type(MOM_restart_CS), pointer :: restart_CSp => NULL() + type(user_revise_forcing_CS), pointer :: urf_CS => NULL() end type surface_forcing_CS -! ice_ocean_boundary_type is a structure corresponding to forcing, but with -! the elements, units, and conventions that exactly conform to the use for -! MOM-based coupled models. +!> Structure corresponding to forcing, but with the elements, units, and conventions +!! that exactly conform to the use for MOM-based coupled models. type, public :: ice_ocean_boundary_type - real, pointer, dimension(:,:) :: latent_flux =>NULL() !< latent flux (W/m2) - real, pointer, dimension(:,:) :: rofl_flux =>NULL() !< liquid runoff (W/m2) - real, pointer, dimension(:,:) :: rofi_flux =>NULL() !< ice runoff (W/m2) - real, pointer, dimension(:,:) :: u_flux =>NULL() !< i-direction wind stress (Pa) - real, pointer, dimension(:,:) :: v_flux =>NULL() !< j-direction wind stress (Pa) - real, pointer, dimension(:,:) :: t_flux =>NULL() !< sensible heat flux (W/m2) - real, pointer, dimension(:,:) :: seaice_melt_heat =>NULL() !< sea ice and snow melt heat flux (W/m2) - real, pointer, dimension(:,:) :: seaice_melt =>NULL() !< water flux due to sea ice and snow melting (kg/m2/s) - real, pointer, dimension(:,:) :: q_flux =>NULL() !< specific humidity flux (kg/m2/s) - real, pointer, dimension(:,:) :: salt_flux =>NULL() !< salt flux (kg/m2/s) - real, pointer, dimension(:,:) :: lw_flux =>NULL() !< long wave radiation (W/m2) - real, pointer, dimension(:,:) :: sw_flux_vis_dir =>NULL() !< direct visible sw radiation (W/m2) - real, pointer, dimension(:,:) :: sw_flux_vis_dif =>NULL() !< diffuse visible sw radiation (W/m2) - real, pointer, dimension(:,:) :: sw_flux_nir_dir =>NULL() !< direct Near InfraRed sw radiation (W/m2) - real, pointer, dimension(:,:) :: sw_flux_nir_dif =>NULL() !< diffuse Near InfraRed sw radiation (W/m2) - real, pointer, dimension(:,:) :: lprec =>NULL() !< mass flux of liquid precip (kg/m2/s) - real, pointer, dimension(:,:) :: fprec =>NULL() !< mass flux of frozen precip (kg/m2/s) - real, pointer, dimension(:,:) :: runoff =>NULL() !< mass flux of liquid runoff (kg/m2/s) - real, pointer, dimension(:,:) :: calving =>NULL() !< mass flux of frozen runoff (kg/m2/s) - real, pointer, dimension(:,:) :: ustar_berg =>NULL() !< frictional velocity beneath icebergs [m s-1] - real, pointer, dimension(:,:) :: area_berg =>NULL() !< area covered by icebergs(m2/m2) - real, pointer, dimension(:,:) :: mass_berg =>NULL() !< mass of icebergs(kg/m2) - real, pointer, dimension(:,:) :: runoff_hflx =>NULL() !< heat content of liquid runoff (W/m2) - real, pointer, dimension(:,:) :: calving_hflx =>NULL() !< heat content of frozen runoff (W/m2) - real, pointer, dimension(:,:) :: p =>NULL() !< pressure of overlying ice and atmosphere - !< on ocean surface (Pa) - real, pointer, dimension(:,:) :: mi =>NULL() !< mass of ice (kg/m2) - real, pointer, dimension(:,:) :: ice_rigidity =>NULL() !< rigidity of the sea ice, sea-ice and - !! ice-shelves, expressed as a coefficient - !! for divergence damping, as determined - !! outside of the ocean model in (m3/s) - integer :: xtype !< The type of the exchange - REGRID, REDIST or DIRECT - type(coupler_2d_bc_type) :: fluxes !< A structure that may contain an array of - !! named fields used for passive tracer fluxes. - integer :: wind_stagger = -999 !< A flag indicating the spatial discretization of - !! wind stresses. This flag may be set by the - !! flux-exchange code, based on what the sea-ice - !! model is providing. Otherwise, the value from - !! the surface_forcing_CS is used. + real, pointer, dimension(:,:) :: rofl_flux =>NULL() !< liquid runoff [W/m2] + real, pointer, dimension(:,:) :: rofi_flux =>NULL() !< ice runoff [W/m2] + real, pointer, dimension(:,:) :: u_flux =>NULL() !< i-direction wind stress [Pa] + real, pointer, dimension(:,:) :: v_flux =>NULL() !< j-direction wind stress [Pa] + real, pointer, dimension(:,:) :: t_flux =>NULL() !< sensible heat flux [W/m2] + real, pointer, dimension(:,:) :: q_flux =>NULL() !< specific humidity flux [kg/m2/s] + real, pointer, dimension(:,:) :: salt_flux =>NULL() !< salt flux [kg/m2/s] + real, pointer, dimension(:,:) :: seaice_melt_heat =>NULL() !< sea ice and snow melt heat flux [W/m2] + real, pointer, dimension(:,:) :: seaice_melt =>NULL() !< water flux due to sea ice and snow melting [kg/m2/s] + real, pointer, dimension(:,:) :: lw_flux =>NULL() !< long wave radiation [W/m2] + real, pointer, dimension(:,:) :: sw_flux_vis_dir =>NULL() !< direct visible sw radiation [W/m2] + real, pointer, dimension(:,:) :: sw_flux_vis_dif =>NULL() !< diffuse visible sw radiation [W/m2] + real, pointer, dimension(:,:) :: sw_flux_nir_dir =>NULL() !< direct Near InfraRed sw radiation [W/m2] + real, pointer, dimension(:,:) :: sw_flux_nir_dif =>NULL() !< diffuse Near InfraRed sw radiation [W/m2] + real, pointer, dimension(:,:) :: lprec =>NULL() !< mass flux of liquid precip [kg/m2/s] + real, pointer, dimension(:,:) :: fprec =>NULL() !< mass flux of frozen precip [kg/m2/s] + real, pointer, dimension(:,:) :: runoff =>NULL() !< mass flux of liquid runoff [kg/m2/s] + real, pointer, dimension(:,:) :: calving =>NULL() !< mass flux of frozen runoff [kg/m2/s] + real, pointer, dimension(:,:) :: ustar_berg =>NULL() !< frictional velocity beneath icebergs [m/s] + real, pointer, dimension(:,:) :: area_berg =>NULL() !< area covered by icebergs[m2/m2] + real, pointer, dimension(:,:) :: mass_berg =>NULL() !< mass of icebergs(kg/m2) + real, pointer, dimension(:,:) :: runoff_hflx =>NULL() !< heat content of liquid runoff [W/m2] + real, pointer, dimension(:,:) :: calving_hflx =>NULL() !< heat content of frozen runoff [W/m2] + real, pointer, dimension(:,:) :: p =>NULL() !< pressure of overlying ice and atmosphere + !< on ocean surface [Pa] + real, pointer, dimension(:,:) :: mi =>NULL() !< mass of ice [kg/m2] + real, pointer, dimension(:,:) :: ice_rigidity =>NULL() !< rigidity of the sea ice, sea-ice and + !! ice-shelves, expressed as a coefficient + !! for divergence damping, as determined + !! outside of the ocean model in [m3/s] + integer :: xtype !< The type of the exchange - REGRID, REDIST or DIRECT + type(coupler_2d_bc_type) :: fluxes !< A structure that may contain an array of + !! named fields used for passive tracer fluxes. + integer :: wind_stagger = -999 !< A flag indicating the spatial discretization of + !! wind stresses. This flag may be set by the + !! flux-exchange code, based on what the sea-ice + !! model is providing. Otherwise, the value from + !! the surface_forcing_CS is used. end type ice_ocean_boundary_type integer :: id_clock_forcing -!======================================================================= contains -!======================================================================= - -!> This function has a few purposes: 1) it allocates and initializes the data -!! in the fluxes structure; 2) it imports surface fluxes using data from -!! the coupler; and 3) it can apply restoring in SST and SSS. -!! See \ref section_ocn_import for a summary of the surface fluxes that are -!! passed from MCT to MOM6, including fluxes that need to be included in -!! the future. + +!> This subroutine translates the Ice_ocean_boundary_type into a MOM +!! thermodynamic forcing type, including changes of units, sign conventions, +!! and putting the fields into arrays with MOM-standard halos. subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, US, CS, & sfc_state, restore_salt, restore_temp) @@ -212,8 +207,8 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, US, CS, & target, intent(in) :: IOB !< An ice-ocean boundary type with fluxes to drive !! the ocean in a coupled model - type(forcing), intent(inout) :: fluxes !< A structure containing pointers to - !! all possible mass, heat or salt flux forcing fields. + type(forcing), intent(inout) :: fluxes !< A structure containing pointers to all + !! possible mass, heat or salt flux forcing fields. !! Unused fields have NULL ptrs. integer, dimension(4), intent(in) :: index_bounds !< The i- and j- size of the arrays in IOB. type(time_type), intent(in) :: Time !< The time of the fluxes, used for interpolating the @@ -229,34 +224,37 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, US, CS, & ! local variables real, dimension(SZI_(G),SZJ_(G)) :: & - data_restore, & ! The surface value toward which to restore (g/kg or degC) - SST_anom, & ! Instantaneous sea surface temperature anomalies from a target value (deg C) - SSS_anom, & ! Instantaneous sea surface salinity anomalies from a target value (g/kg) - SSS_mean, & ! A (mean?) salinity about which to normalize local salinity - ! anomalies when calculating restorative precipitation anomalies (g/kg) - PmE_adj, & ! The adjustment to PminusE that will cause the salinity - ! to be restored toward its target value (kg/(m^2 * s)) - net_FW, & ! The area integrated net freshwater flux into the ocean (kg/s) - net_FW2, & ! The area integrated net freshwater flux into the ocean (kg/s) - work_sum, & ! A 2-d array that is used as the work space for a global - ! sum, used with units of m2 or (kg/s) - open_ocn_mask ! a binary field indicating where ice is present based on frazil criteria - - integer :: i, j, k, is, ie, js, je, Isq, Ieq, Jsq, Jeq, i0, j0 + data_restore, & !< The surface value toward which to restore [g/kg or degC] + SST_anom, & !< Instantaneous sea surface temperature anomalies from a target value [deg C] + SSS_anom, & !< Instantaneous sea surface salinity anomalies from a target value [g/kg] + SSS_mean, & !< A (mean?) salinity about which to normalize local salinity + !! anomalies when calculating restorative precipitation anomalies [g/kg] + PmE_adj, & !< The adjustment to PminusE that will cause the salinity + !! to be restored toward its target value [kg/(m^2 * s)] + net_FW, & !< The area integrated net freshwater flux into the ocean [kg/s] + net_FW2, & !< The area integrated net freshwater flux into the ocean [kg/s] + work_sum, & !< A 2-d array that is used as the work space for a global + !! sum, used with units of m2 or [kg/s] + open_ocn_mask !< a binary field indicating where ice is present based on frazil criteria + + integer :: i, j, is, ie, js, je, Isq, Ieq, Jsq, Jeq, i0, j0 integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB, isr, ier, jsr, jer + integer :: isc_bnd, iec_bnd, jsc_bnd, jec_bnd - logical :: restore_salinity ! local copy of the argument restore_salt, if it - ! is present, or false (no restoring) otherwise. - logical :: restore_sst ! local copy of the argument restore_temp, if it - ! is present, or false (no restoring) otherwise. - real :: delta_sss ! temporary storage for sss diff from restoring value - real :: delta_sst ! temporary storage for sst diff from restoring value + logical :: restore_salinity !< local copy of the argument restore_salt, if it + !! is present, or false (no restoring) otherwise. + logical :: restore_sst !< local copy of the argument restore_temp, if it + !! is present, or false (no restoring) otherwise. + real :: delta_sss !< temporary storage for sss diff from restoring value + real :: delta_sst !< temporary storage for sst diff from restoring value - real :: C_p ! heat capacity of seawater ( J/(K kg) ) - real :: sign_for_net_FW_bug ! Should be +1. but an old bug can be recovered by using -1. + real :: C_p !< heat capacity of seawater ( J/(K kg) ) + real :: sign_for_net_FW_bug !< Should be +1. but an old bug can be recovered by using -1. call cpu_clock_begin(id_clock_forcing) + isc_bnd = index_bounds(1) ; iec_bnd = index_bounds(2) + jsc_bnd = index_bounds(3) ; jec_bnd = index_bounds(4) is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed @@ -291,6 +289,11 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, US, CS, & call safe_alloc_ptr(fluxes%p_surf,isd,ied,jsd,jed) call safe_alloc_ptr(fluxes%p_surf_full,isd,ied,jsd,jed) + if (CS%use_limited_P_SSH) then + fluxes%p_surf_SSH => fluxes%p_surf + else + fluxes%p_surf_SSH => fluxes%p_surf_full + endif call safe_alloc_ptr(fluxes%salt_flux,isd,ied,jsd,jed) call safe_alloc_ptr(fluxes%salt_flux_in,isd,ied,jsd,jed) @@ -314,11 +317,26 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, US, CS, & fluxes%dt_buoy_accum = 0.0 endif ! endif for allocation and initialization + + if (((associated(IOB%ustar_berg) .and. (.not.associated(fluxes%ustar_berg))) & + .or. (associated(IOB%area_berg) .and. (.not.associated(fluxes%area_berg)))) & + .or. (associated(IOB%mass_berg) .and. (.not.associated(fluxes%mass_berg)))) & + call allocate_forcing_type(G, fluxes, iceberg=.true.) + + if ((.not.coupler_type_initialized(fluxes%tr_fluxes)) .and. & + coupler_type_initialized(IOB%fluxes)) & + call coupler_type_spawn(IOB%fluxes, fluxes%tr_fluxes, & + (/is,is,ie,ie/), (/js,js,je,je/)) + ! It might prove valuable to use the same array extents as the rest of the + ! ocean model, rather than using haloless arrays, in which case the last line + ! would be: ( (/isd,is,ie,ied/), (/jsd,js,je,jed/)) + if (CS%allow_flux_adjustments) then fluxes%heat_added(:,:)=0.0 fluxes%salt_flux_added(:,:)=0.0 endif + ! allocation and initialization on first call to this routine if (CS%area_surf < 0.0) then do j=js,je ; do i=is,ie work_sum(i,j) = G%areaT(i,j) * G%mask2dT(i,j) @@ -346,7 +364,7 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, US, CS, & delta_sss = data_restore(i,j)- sfc_state%SSS(i,j) delta_sss = sign(1.0,delta_sss)*min(abs(delta_sss),CS%max_delta_srestore) fluxes%salt_flux(i,j) = 1.e-3*G%mask2dT(i,j) * (CS%Rho0*CS%Flux_const)* & - (CS%basin_mask(i,j)*open_ocn_mask(i,j)) *delta_sss ! kg Salt m-2 s-1 + (CS%basin_mask(i,j)*open_ocn_mask(i,j)*CS%srestore_mask(i,j)) *delta_sss ! kg Salt m-2 s-1 enddo; enddo if (CS%adjust_net_srestore_to_zero) then if (CS%adjust_net_srestore_by_scaling) then @@ -364,7 +382,7 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, US, CS, & if (G%mask2dT(i,j) > 0.5) then delta_sss = sfc_state%SSS(i,j) - data_restore(i,j) delta_sss = sign(1.0,delta_sss)*min(abs(delta_sss),CS%max_delta_srestore) - fluxes%vprec(i,j) = (CS%basin_mask(i,j)*open_ocn_mask(i,j))* & + fluxes%vprec(i,j) = (CS%basin_mask(i,j)*open_ocn_mask(i,j)*CS%srestore_mask(i,j))* & (CS%Rho0*CS%Flux_const) * & delta_sss / (0.5*(sfc_state%SSS(i,j) + data_restore(i,j))) endif @@ -390,77 +408,79 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, US, CS, & do j=js,je ; do i=is,ie delta_sst = data_restore(i,j)- sfc_state%SST(i,j) delta_sst = sign(1.0,delta_sst)*min(abs(delta_sst),CS%max_delta_trestore) - fluxes%heat_added(i,j) = G%mask2dT(i,j) * (CS%Rho0*fluxes%C_p) * delta_sst * CS%Flux_const ! W m-2 + fluxes%heat_added(i,j) = G%mask2dT(i,j) * CS%trestore_mask(i,j) * & + (CS%Rho0*fluxes%C_p) * delta_sst * CS%Flux_const ! W m-2 enddo; enddo endif - ! obtain fluxes from IOB + ! obtain fluxes from IOB; note the staggering of indices i0 = 0; j0 = 0 do j=js,je ; do i=is,ie ! liquid precipitation (rain) - if (associated(fluxes%lprec)) & - fluxes%lprec(i,j) = G%mask2dT(i,j) * IOB%lprec(i-i0,j-j0) + if (associated(IOB%lprec)) & + fluxes%lprec(i,j) = IOB%lprec(i-i0,j-j0) * G%mask2dT(i,j) ! frozen precipitation (snow) - if (associated(fluxes%fprec)) & - fluxes%fprec(i,j) = G%mask2dT(i,j) * IOB%fprec(i-i0,j-j0) + if (associated(IOB%fprec)) & + fluxes%fprec(i,j) = IOB%fprec(i-i0,j-j0) * G%mask2dT(i,j) ! evaporation - if (associated(fluxes%evap)) & - fluxes%evap(i,j) = G%mask2dT(i,j) * IOB%q_flux(i-i0,j-j0) + if (associated(IOB%q_flux)) & + fluxes%evap(i,j) = IOB%q_flux(i-i0,j-j0) * G%mask2dT(i,j) - ! river runoff flux - if (associated(fluxes%lrunoff)) & - fluxes%lrunoff(i,j) = G%mask2dT(i,j) * IOB%rofl_flux(i-i0,j-j0) + ! liquid runoff flux + if (associated(IOB%rofl_flux)) then + 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 ! ice runoff flux - if (associated(fluxes%frunoff)) & - fluxes%frunoff(i,j) = G%mask2dT(i,j) * IOB%rofi_flux(i-i0,j-j0) - - ! GMM, we don't have an icebergs yet so the following is not needed - !if (((associated(IOB%ustar_berg) .and. (.not. associated(fluxes%ustar_berg))) & - ! .or. (associated(IOB%area_berg) .and. (.not. associated(fluxes%area_berg)))) & - ! .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) - !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)) & - ! fluxes%mass_berg(i,j) = IOB%mass_berg(i-i0,j-j0) * G%mask2dT(i,j) + 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 + + 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) + + 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)) & + fluxes%mass_berg(i,j) = IOB%mass_berg(i-i0,j-j0) * G%mask2dT(i,j) ! GMM, cime does not not have an equivalent for heat_content_lrunoff and ! heat_content_frunoff. I am seeting these to zero for now. if (associated(fluxes%heat_content_lrunoff)) & fluxes%heat_content_lrunoff(i,j) = 0.0 * G%mask2dT(i,j) - if (associated(fluxes%heat_content_frunoff)) & fluxes%heat_content_frunoff(i,j) = 0.0 * 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) + ! longwave radiation, sum up and down (W/m2) - if (associated(fluxes%LW)) & - fluxes%LW(i,j) = G%mask2dT(i,j) * IOB%lw_flux(i-i0,j-j0) + if (associated(IOB%lw_flux)) & + fluxes%LW(i,j) = IOB%lw_flux(i-i0,j-j0) * G%mask2dT(i,j) ! sensible heat flux (W/m2) - if (associated(fluxes%sens)) & - fluxes%sens(i,j) = G%mask2dT(i,j) * IOB%t_flux(i-i0,j-j0) + if (associated(IOB%t_flux)) & + fluxes%sens(i,j) = IOB%t_flux(i-i0,j-j0) * G%mask2dT(i,j) - ! sea ice and snow melt heat flux (W/m2) - if (associated(fluxes%seaice_melt_heat)) & - fluxes%seaice_melt_heat(i,j) = G%mask2dT(i,j) * IOB%seaice_melt_heat(i-i0,j-j0) + ! sea ice and snow melt heat flux [W/m2] + if (associated(IOB%seaice_melt_heat)) & + fluxes%seaice_melt_heat(i,j) = G%mask2dT(i,j) * IOB%seaice_melt_heat(i-i0,j-j0) - ! water flux due to sea ice and snow melt (kg/m2/s) - if (associated(fluxes%seaice_melt)) & - fluxes%seaice_melt(i,j) = G%mask2dT(i,j) * IOB%seaice_melt(i-i0,j-j0) + ! water flux due to sea ice and snow melt [kg/m2/s] + if (associated(IOB%seaice_melt)) & + fluxes%seaice_melt(i,j) = G%mask2dT(i,j) * IOB%seaice_melt(i-i0,j-j0) ! latent heat flux (W/m^2) - ! old method, latent = IOB%q_flux(i-i0,j-j0)*CS%latent_heat_vapor - !if (associated(fluxes%latent)) & - ! fluxes%latent(i,j) = G%mask2dT(i,j) * IOB%latent_flux(i-i0,j-j0) - ! new method fluxes%latent(i,j) = 0.0 ! contribution from frozen ppt - if (associated(fluxes%fprec)) then + if (associated(IOB%fprec)) then fluxes%latent(i,j) = fluxes%latent(i,j) + IOB%fprec(i-i0,j-j0)*CS%latent_heat_fusion fluxes%latent_fprec_diag(i,j) = G%mask2dT(i,j) * IOB%fprec(i-i0,j-j0)*CS%latent_heat_fusion endif @@ -478,25 +498,43 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, US, CS, & if (associated(IOB%sw_flux_vis_dir)) & fluxes%sw_vis_dir(i,j) = G%mask2dT(i,j) * IOB%sw_flux_vis_dir(i-i0,j-j0) + if (associated(IOB%sw_flux_vis_dif)) & fluxes%sw_vis_dif(i,j) = G%mask2dT(i,j) * IOB%sw_flux_vis_dif(i-i0,j-j0) + if (associated(IOB%sw_flux_nir_dir)) & fluxes%sw_nir_dir(i,j) = G%mask2dT(i,j) * IOB%sw_flux_nir_dir(i-i0,j-j0) + if (associated(IOB%sw_flux_nir_dif)) & fluxes%sw_nir_dif(i,j) = G%mask2dT(i,j) * IOB%sw_flux_nir_dif(i-i0,j-j0) fluxes%sw(i,j) = fluxes%sw_vis_dir(i,j) + fluxes%sw_vis_dif(i,j) + & fluxes%sw_nir_dir(i,j) + fluxes%sw_nir_dif(i,j) - ! salt flux - ! more salt restoring logic - if (associated(fluxes%salt_flux)) & - fluxes%salt_flux(i,j) = G%mask2dT(i,j)*(fluxes%salt_flux(i,j) - IOB%salt_flux(i-i0,j-j0)) + enddo; enddo - if (associated(fluxes%salt_flux_in)) & - fluxes%salt_flux_in(i,j) = G%mask2dT(i,j)*(-IOB%salt_flux(i-i0,j-j0)) + ! applied surface pressure from atmosphere and cryosphere + if (associated(IOB%p)) then + if (CS%max_p_surf >= 0.0) then + do j=js,je ; do i=is,ie + fluxes%p_surf_full(i,j) = G%mask2dT(i,j) * IOB%p(i-i0,j-j0) + fluxes%p_surf(i,j) = MIN(fluxes%p_surf_full(i,j),CS%max_p_surf) + enddo; enddo + else + do j=js,je ; do i=is,ie + fluxes%p_surf_full(i,j) = G%mask2dT(i,j) * IOB%p(i-i0,j-j0) + fluxes%p_surf(i,j) = fluxes%p_surf_full(i,j) + enddo; enddo + endif + fluxes%accumulate_p_surf = .true. ! Multiple components may contribute to surface pressure. + endif - enddo; enddo + if (associated(IOB%salt_flux)) then + do j=js,je ; do i=is,ie + fluxes%salt_flux(i,j) = G%mask2dT(i,j)*(fluxes%salt_flux(i,j) + IOB%salt_flux(i-i0,j-j0)) + fluxes%salt_flux_in(i,j) = G%mask2dT(i,j)*( IOB%salt_flux(i-i0,j-j0) ) + enddo ; enddo + endif ! adjust the NET fresh-water flux to zero, if flagged if (CS%adjust_net_fresh_water_to_zero) then @@ -523,6 +561,10 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, US, CS, & endif endif + if (coupler_type_initialized(fluxes%tr_fluxes) .and. & + coupler_type_initialized(IOB%fluxes)) & + call coupler_type_copy_data(IOB%fluxes, fluxes%tr_fluxes) + if (CS%allow_flux_adjustments) then ! Apply adjustments to fluxes call apply_flux_adjustments(G, CS, Time, fluxes) @@ -535,8 +577,6 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, US, CS, & end subroutine convert_IOB_to_fluxes -!======================================================================= - !> This subroutine translates the Ice_ocean_boundary_type into a MOM !! mechanical forcing type, including changes of units, sign conventions, !! and putting the fields into arrays with MOM-standard halos. @@ -553,52 +593,53 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, US, CS) type(surface_forcing_CS),pointer :: CS !< A pointer to the control structure returned by a !! previous call to surface_forcing_init. + ! local variables real, dimension(SZIB_(G),SZJB_(G)) :: & - taux_at_q, & ! Zonal wind stresses at q points (Pa) - tauy_at_q ! Meridional wind stresses at q points (Pa) + taux_at_q, & !< Zonal wind stresses at q points [Pa] + tauy_at_q !< Meridional wind stresses at q points [Pa] real, dimension(SZI_(G),SZJ_(G)) :: & - rigidity_at_h, & ! Ice rigidity at tracer points (m3 s-1) - taux_at_h, & ! Zonal wind stresses at h points (Pa) - tauy_at_h ! Meridional wind stresses at h points (Pa) - - real :: gustiness ! unresolved gustiness that contributes to ustar (Pa) - 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 :: 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) - - integer :: wind_stagger ! AGRID, BGRID_NE, or CGRID_NE (integers from MOM_domains) + rigidity_at_h, & !< Ice rigidity at tracer points (m3 s-1) + taux_at_h, & !< Zonal wind stresses at h points [Pa] + tauy_at_h !< Meridional wind stresses at h points [Pa] + + real :: gustiness !< unresolved gustiness that contributes to ustar [Pa] + 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 :: 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) + + integer :: wind_stagger !< AGRID, BGRID_NE, or CGRID_NE (integers from MOM_domains) integer :: i, j, is, ie, js, je, Isq, Ieq, Jsq, Jeq, i0, j0 integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB, isr, ier, jsr, jer integer :: isc_bnd, iec_bnd, jsc_bnd, jec_bnd call cpu_clock_begin(id_clock_forcing) + isc_bnd = index_bounds(1) ; iec_bnd = index_bounds(2) + jsc_bnd = index_bounds(3) ; jec_bnd = index_bounds(4) is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed IsdB = G%IsdB ; IedB = G%IedB ; JsdB = G%JsdB ; JedB = G%JedB isr = is-isd+1 ; ier = ie-isd+1 ; jsr = js-jsd+1 ; jer = je-jsd+1 - - !isc_bnd = index_bounds(1) ; iec_bnd = index_bounds(2) - !jsc_bnd = index_bounds(3) ; jec_bnd = index_bounds(4) - !if (is_root_pe()) write(*,*)'isc_bnd, jsc_bnd, iec_bnd, jec_bnd',isc_bnd, jsc_bnd, iec_bnd, jec_bnd !i0 = is - isc_bnd ; j0 = js - jsc_bnd - i0 = 0; j0 = 0 ! TODO: is this right? + i0 = 0; j0 = 0 Irho0 = 1.0/CS%Rho0 ! allocation and initialization if this is the first time that this ! mechanical forcing type has been used. if (.not.forces%initialized) then - call allocate_mech_forcing(G, forces, stress=.true., ustar=.true., & - press=.true.) + + call allocate_mech_forcing(G, forces, stress=.true., ustar=.true., press=.true.) + call safe_alloc_ptr(forces%p_surf,isd,ied,jsd,jed) call safe_alloc_ptr(forces%p_surf_full,isd,ied,jsd,jed) + if (CS%rigid_sea_ice) then call safe_alloc_ptr(forces%rigidity_ice_u,IsdB,IedB,jsd,jed) call safe_alloc_ptr(forces%rigidity_ice_v,isd,ied,JsdB,JedB) @@ -607,29 +648,44 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, US, CS) forces%initialized = .true. endif + if ( (associated(IOB%area_berg) .and. (.not. associated(forces%area_berg))) .or. & + (associated(IOB%mass_berg) .and. (.not. associated(forces%mass_berg))) ) & + call allocate_mech_forcing(G, forces, iceberg=.true.) + if (associated(IOB%ice_rigidity)) then + rigidity_at_h(:,:) = 0.0 + call safe_alloc_ptr(forces%rigidity_ice_u,IsdB,IedB,jsd,jed) + call safe_alloc_ptr(forces%rigidity_ice_v,isd,ied,JsdB,JedB) + endif + + forces%accumulate_rigidity = .true. ! Multiple components may contribute to rigidity. if (associated(forces%rigidity_ice_u)) forces%rigidity_ice_u(:,:) = 0.0 if (associated(forces%rigidity_ice_v)) forces%rigidity_ice_v(:,:) = 0.0 !applied surface pressure from atmosphere and cryosphere - !sea-level pressure (Pa) - do j=js,je ; do i=is,ie - if (associated(forces%p_surf_full) .and. associated(forces%p_surf)) then - forces%p_surf_full(i,j) = G%mask2dT(i,j) * IOB%p(i-i0,j-j0) - - if (CS%max_p_surf >= 0.0) then + if (CS%use_limited_P_SSH) then + forces%p_surf_SSH => forces%p_surf + else + forces%p_surf_SSH => forces%p_surf_full + endif + if (associated(IOB%p)) then + if (CS%max_p_surf >= 0.0) then + do j=js,je ; do i=is,ie + forces%p_surf_full(i,j) = G%mask2dT(i,j) * IOB%p(i-i0,j-j0) forces%p_surf(i,j) = MIN(forces%p_surf_full(i,j),CS%max_p_surf) - else + enddo ; enddo + else + do j=js,je ; do i=is,ie + forces%p_surf_full(i,j) = G%mask2dT(i,j) * IOB%p(i-i0,j-j0) forces%p_surf(i,j) = forces%p_surf_full(i,j) - endif - + enddo ; enddo endif - enddo; enddo - - if (CS%use_limited_P_SSH) then - forces%p_surf_SSH => forces%p_surf else - forces%p_surf_SSH => forces%p_surf_full + do j=js,je ; do i=is,ie + forces%p_surf_full(i,j) = 0.0 + forces%p_surf(i,j) = 0.0 + enddo ; enddo endif + forces%accumulate_p_surf = .true. ! Multiple components may contribute to surface pressure. ! GMM, CIME uses AGRID. All the BGRID_NE code can be cleaned later wind_stagger = AGRID @@ -645,6 +701,15 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, US, CS) ! obtain fluxes from IOB; note the staggering of indices do j=js,je ; do i=is,ie + if (associated(IOB%area_berg)) & + forces%area_berg(i,j) = IOB%area_berg(i-i0,j-j0) * G%mask2dT(i,j) + + if (associated(IOB%mass_berg)) & + forces%mass_berg(i,j) = IOB%mass_berg(i-i0,j-j0) * G%mask2dT(i,j) + + if (associated(IOB%ice_rigidity)) & + rigidity_at_h(i,j) = IOB%ice_rigidity(i-i0,j-j0) * G%mask2dT(i,j) + if (wind_stagger == BGRID_NE) then if (associated(IOB%u_flux)) taux_at_q(I,J) = IOB%u_flux(i-i0,j-j0) * CS%wind_stress_multiplier if (associated(IOB%v_flux)) tauy_at_q(I,J) = IOB%v_flux(i-i0,j-j0) * CS%wind_stress_multiplier @@ -662,7 +727,7 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, US, CS) if (wind_stagger == BGRID_NE) then if (G%symmetric) & call fill_symmetric_edges(taux_at_q, tauy_at_q, G%Domain, stagger=BGRID_NE) - call pass_vector(taux_at_q, tauy_at_q, G%Domain, stagger=BGRID_NE) + call pass_vector(taux_at_q, tauy_at_q, G%Domain, stagger=BGRID_NE, halo=1) do j=js,je ; do I=Isq,Ieq forces%taux(I,j) = 0.0 @@ -699,7 +764,7 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, US, CS) enddo; enddo elseif (wind_stagger == AGRID) then - call pass_vector(taux_at_h, tauy_at_h, G%Domain,stagger=AGRID) + call pass_vector(taux_at_h, tauy_at_h, G%Domain, To_All+Omit_Corners, stagger=AGRID, halo=1) do j=js,je ; do I=Isq,Ieq forces%taux(I,j) = 0.0 @@ -727,7 +792,7 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, US, CS) else ! C-grid wind stresses. if (G%symmetric) & call fill_symmetric_edges(forces%taux, forces%tauy, G%Domain) - call pass_vector(forces%taux, forces%tauy, G%Domain) + call pass_vector(forces%taux, forces%tauy, G%Domain, halo=1) do j=js,je ; do i=is,ie taux2 = 0.0 @@ -750,6 +815,18 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, US, CS) endif ! endif for wind related fields ! sea ice related dynamic fields + if (associated(IOB%ice_rigidity)) then + call pass_var(rigidity_at_h, G%Domain, halo=1) + do I=is-1,ie ; do j=js,je + forces%rigidity_ice_u(I,j) = forces%rigidity_ice_u(I,j) + & + min(rigidity_at_h(i,j), rigidity_at_h(i+1,j)) + enddo ; enddo + do i=is,ie ; do J=js-1,je + forces%rigidity_ice_v(i,J) = forces%rigidity_ice_v(i,J) + & + min(rigidity_at_h(i,j), rigidity_at_h(i,j+1)) + enddo ; enddo + endif + if (CS%rigid_sea_ice) then call pass_var(forces%p_surf_full, G%Domain, halo=1) I_GEarth = 1.0 / G%G_Earth @@ -785,129 +862,52 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, US, CS) call cpu_clock_end(id_clock_forcing) end subroutine convert_IOB_to_forces -!======================================================================= - -!> Allocates ice-ocean boundary type containers and sets to 0. -subroutine IOB_allocate(IOB, isc, iec, jsc, jec) - type(ice_ocean_boundary_type), intent(inout) :: IOB !< An ice-ocean boundary type with fluxes to drive - integer, intent(in) :: isc, iec, jsc, jec !< The ocean's local grid size - - allocate ( IOB% latent_flux (isc:iec,jsc:jec), & - IOB% rofl_flux (isc:iec,jsc:jec), & - IOB% rofi_flux (isc:iec,jsc:jec), & - IOB% u_flux (isc:iec,jsc:jec), & - IOB% v_flux (isc:iec,jsc:jec), & - IOB% t_flux (isc:iec,jsc:jec), & - IOB% seaice_melt_heat (isc:iec,jsc:jec),& - IOB% seaice_melt (isc:iec,jsc:jec), & - IOB% q_flux (isc:iec,jsc:jec), & - IOB% salt_flux (isc:iec,jsc:jec), & - IOB% lw_flux (isc:iec,jsc:jec), & - IOB% sw_flux_vis_dir (isc:iec,jsc:jec), & - IOB% sw_flux_vis_dif (isc:iec,jsc:jec), & - IOB% sw_flux_nir_dir (isc:iec,jsc:jec), & - IOB% sw_flux_nir_dif (isc:iec,jsc:jec), & - IOB% lprec (isc:iec,jsc:jec), & - IOB% fprec (isc:iec,jsc:jec), & - IOB% ustar_berg (isc:iec,jsc:jec), & - IOB% area_berg (isc:iec,jsc:jec), & - IOB% mass_berg (isc:iec,jsc:jec), & - IOB% calving (isc:iec,jsc:jec), & - IOB% runoff_hflx (isc:iec,jsc:jec), & - IOB% calving_hflx (isc:iec,jsc:jec), & - IOB% mi (isc:iec,jsc:jec), & - IOB% p (isc:iec,jsc:jec)) - - IOB%latent_flux = 0.0 - IOB%rofl_flux = 0.0 - IOB%rofi_flux = 0.0 - IOB%u_flux = 0.0 - IOB%v_flux = 0.0 - IOB%t_flux = 0.0 - IOB%seaice_melt_heat = 0.0 - IOB%seaice_melt = 0.0 - IOB%q_flux = 0.0 - IOB%salt_flux = 0.0 - IOB%lw_flux = 0.0 - IOB%sw_flux_vis_dir = 0.0 - IOB%sw_flux_vis_dif = 0.0 - IOB%sw_flux_nir_dir = 0.0 - IOB%sw_flux_nir_dif = 0.0 - IOB%lprec = 0.0 - IOB%fprec = 0.0 - IOB%ustar_berg = 0.0 - IOB%area_berg = 0.0 - IOB%mass_berg = 0.0 - IOB%calving = 0.0 - IOB%runoff_hflx = 0.0 - IOB%calving_hflx = 0.0 - IOB%mi = 0.0 - IOB%p = 0.0 - -end subroutine IOB_allocate - -!======================================================================= - -!> Adds flux adjustments obtained via data_override +!> Adds thermodynamic flux adjustments obtained via data_override !! Component name is 'OCN' !! Available adjustments are: -!! - taux_adj (Zonal wind stress delta, positive to the east, in Pa) -!! - tauy_adj (Meridional wind stress delta, positive to the north, in Pa) +!! - hflx_adj (Heat flux into the ocean, in W m-2) +!! - sflx_adj (Salt flux into the ocean, in kg salt m-2 s-1) +!! - prcme_adj (Fresh water flux into the ocean, in kg m-2 s-1) subroutine apply_flux_adjustments(G, CS, Time, fluxes) type(ocean_grid_type), intent(inout) :: G !< Ocean grid structure type(surface_forcing_CS), pointer :: CS !< Surface forcing control structure type(time_type), intent(in) :: Time !< Model time structure - type(forcing), optional, intent(inout) :: fluxes !< Surface fluxes structure + type(forcing), intent(inout) :: fluxes !< Surface fluxes structure ! Local variables - real, dimension(SZI_(G),SZJ_(G)) :: tempx_at_h ! Delta to zonal wind stress at h points (Pa) - real, dimension(SZI_(G),SZJ_(G)) :: tempy_at_h ! Delta to meridional wind stress at h points (Pa) - real, dimension(SZI_(G),SZJ_(G)) :: temp_at_h ! Fluxes at h points (W m-2 or kg m-2 s-1) + real, dimension(SZI_(G),SZJ_(G)) :: temp_at_h !< Fluxes at h points [W m-2 or kg m-2 s-1] integer :: isc, iec, jsc, jec, i, j - real :: dLonDx, dLonDy, rDlon, cosA, sinA, zonal_tau, merid_tau - logical :: overrode_x, overrode_y, overrode_h + logical :: overrode_h - isc = G%isc; iec = G%iec - jsc = G%jsc; jec = G%jec + isc = G%isc; iec = G%iec ; jsc = G%jsc; jec = G%jec overrode_h = .false. call data_override('OCN', 'hflx_adj', temp_at_h(isc:iec,jsc:jec), Time, override=overrode_h) - if (overrode_h) then - do j=G%jsc,G%jec ; do i=G%isc,G%iec - fluxes%heat_added(i,j) = fluxes%heat_added(i,j) + temp_at_h(i,j)* G%mask2dT(i,j) - enddo; enddo - endif - - call pass_var(fluxes%heat_added, G%Domain) + if (overrode_h) then ; do j=jsc,jec ; do i=isc,iec + fluxes%heat_added(i,j) = fluxes%heat_added(i,j) + temp_at_h(i,j)* G%mask2dT(i,j) + enddo ; enddo ; endif + ! Not needed? ! if (overrode_h) call pass_var(fluxes%heat_added, G%Domain) overrode_h = .false. call data_override('OCN', 'sflx_adj', temp_at_h(isc:iec,jsc:jec), Time, override=overrode_h) - if (overrode_h) then - do j=G%jsc,G%jec ; do i=G%isc,G%iec - fluxes%salt_flux_added(i,j) = fluxes%salt_flux_added(i,j) + temp_at_h(i,j)* G%mask2dT(i,j) - enddo; enddo - endif + if (overrode_h) then ; do j=jsc,jec ; do i=isc,iec + fluxes%salt_flux_added(i,j) = fluxes%salt_flux_added(i,j) + temp_at_h(i,j)* G%mask2dT(i,j) + enddo ; enddo ; endif + ! Not needed? ! if (overrode_h) call pass_var(fluxes%salt_flux_added, G%Domain) - call pass_var(fluxes%salt_flux_added, G%Domain) overrode_h = .false. - call data_override('OCN', 'prcme_adj', temp_at_h(isc:iec,jsc:jec), Time, override=overrode_h) - if (overrode_h) then - do j=G%jsc,G%jec ; do i=G%isc,G%iec - fluxes%vprec(i,j) = fluxes%vprec(i,j) + temp_at_h(i,j)* G%mask2dT(i,j) - enddo; enddo - endif - - call pass_var(fluxes%vprec, G%Domain) + if (overrode_h) then ; do j=jsc,jec ; do i=isc,iec + fluxes%vprec(i,j) = fluxes%vprec(i,j) + temp_at_h(i,j)* G%mask2dT(i,j) + enddo ; enddo ; endif + ! Not needed? ! if (overrode_h) call pass_var(fluxes%vprec, G%Domain) end subroutine apply_flux_adjustments -!======================================================================= - !> Adds mechanical forcing adjustments obtained via data_override !! Component name is 'OCN' !! Available adjustments are: @@ -920,8 +920,8 @@ subroutine apply_force_adjustments(G, CS, Time, forces) type(mech_forcing), intent(inout) :: forces !< A structure with the driving mechanical forces ! Local variables - real, dimension(SZI_(G),SZJ_(G)) :: tempx_at_h ! Delta to zonal wind stress at h points (Pa) - real, dimension(SZI_(G),SZJ_(G)) :: tempy_at_h ! Delta to meridional wind stress at h points (Pa) + real, dimension(SZI_(G),SZJ_(G)) :: tempx_at_h !< Delta to zonal wind stress at h points [Pa] + real, dimension(SZI_(G),SZJ_(G)) :: tempy_at_h !< Delta to meridional wind stress at h points [Pa] integer :: isc, iec, jsc, jec, i, j real :: dLonDx, dLonDy, rDlon, cosA, sinA, zonal_tau, merid_tau @@ -966,54 +966,52 @@ subroutine apply_force_adjustments(G, CS, Time, forces) end subroutine apply_force_adjustments -!======================================================================= - -!> Saves restart fields associated with the forcing +!> Save any restart files associated with the surface forcing. subroutine forcing_save_restart(CS, G, Time, directory, time_stamped, & filename_suffix) - type(surface_forcing_CS), pointer :: CS !< pointer to the control structure - !! returned by a previous call to - !! surface_forcing_init + type(surface_forcing_CS), pointer :: CS !< A pointer to the control structure returned + !! by a previous call to surface_forcing_init type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure - type(time_type), intent(in) :: Time !< model time at this call - character(len=*), intent(in) :: directory !< optional directory into which - !! to write these restart files - logical, optional, intent(in) :: time_stamped !< If true, the restart file - !! names include a unique time - !! stamp - character(len=*), optional, intent(in) :: filename_suffix !< optional suffix - !! (e.g., a time-stamp) to append to the - !! restart file names + type(time_type), intent(in) :: Time !< The current model time + character(len=*), intent(in) :: directory !< The directory into which to write the + !! restart files + logical, optional, intent(in) :: time_stamped !< If true, the restart file names include + !! a unique time stamp. The default is false. + character(len=*), optional, intent(in) :: filename_suffix !< An optional suffix (e.g., a time- + !! stamp) to append to the restart file names. + if (.not.associated(CS)) return if (.not.associated(CS%restart_CSp)) return call save_restart(directory, Time, G, CS%restart_CSp, time_stamped) end subroutine forcing_save_restart -!======================================================================= - -!> Initializes surface forcing: get relevant parameters and allocate arrays. +!> Initialize the surface forcing, including setting parameters and allocating permanent memory. subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, restore_salt, restore_temp) type(time_type), intent(in) :: Time !< The current model time type(ocean_grid_type), intent(in) :: G !< The ocean's 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 output - type(surface_forcing_CS), pointer :: CS !< A pointer that is set to point to the - !! control structure for this module - logical, optional, intent(in) :: restore_salt, restore_temp !< If present and true, - !! temp/salt restoring will be applied + type(diag_ctrl), target, intent(inout) :: diag !< A structure that is used to regulate + !! diagnostic output + type(surface_forcing_CS), pointer :: CS !< A pointer that is set to point to the control + !! structure for this module + logical, optional, intent(in) :: restore_salt !< If present and true surface salinity + !! restoring will be applied in this model. + logical, optional, intent(in) :: restore_temp !< If present and true surface temperature + !! restoring will be applied in this model. - ! local variables - real :: utide !< The RMS tidal velocity [m s-1]. + ! Local variables + real :: utide ! The RMS tidal velocity, in m s-1. type(directories) :: dirs logical :: new_sim, iceberg_flux_diags 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" - character(len=40) :: mdl = "ocn_comp_mct" ! This module's name. + character(len=40) :: mdl = "MOM_surface_forcing" ! This module's name. character(len=48) :: stagger + character(len=48) :: flnam character(len=240) :: basin_file integer :: i, j, isd, ied, jsd, jed @@ -1031,7 +1029,7 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, restore_salt, CS%diag => diag - call write_version_number (version) + call write_version_number(version) ! Read all relevant parameters and write them to the model log. call log_version(param_file, mdl, version, "") @@ -1151,12 +1149,15 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, restore_salt, basin_file = trim(CS%inputdir) // trim(basin_file) call safe_alloc_ptr(CS%basin_mask,isd,ied,jsd,jed) ; CS%basin_mask(:,:) = 1.0 if (CS%mask_srestore_marginal_seas) then - call read_data(basin_file,'basin',CS%basin_mask,domain=G%domain%mpp_domain,timelevel=1) + call MOM_read_data(basin_file,'basin',CS%basin_mask,G%domain, timelevel=1) do j=jsd,jed ; do i=isd,ied if (CS%basin_mask(i,j) >= 6.0) then ; CS%basin_mask(i,j) = 0.0 else ; CS%basin_mask(i,j) = 1.0 ; endif enddo ; enddo endif + call get_param(param_file, mdl, "MASK_SRESTORE", CS%mask_srestore, & + "If true, read a file (salt_restore_mask) containing "//& + "a mask for SSS restoring.", default=.false.) endif if (restore_temp) then @@ -1172,16 +1173,19 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, restore_salt, "The name of the surface temperature variable to read from "//& "SST_RESTORE_FILE for restoring sst.", & default="temp") -! Convert CS%Flux_const from m day-1 to m s-1. + ! Convert CS%Flux_const from m day-1 to m s-1. CS%Flux_const = CS%Flux_const / 86400.0 call get_param(param_file, mdl, "MAX_DELTA_TRESTORE", CS%max_delta_trestore, & "The maximum sst difference used in restoring terms.", & units="degC ", default=999.0) + call get_param(param_file, mdl, "MASK_TRESTORE", CS%mask_trestore, & + "If true, read a file (temp_restore_mask) containing "//& + "a mask for SST restoring.", default=.false.) endif -! Optionally read tidal amplitude from input file [m s-1] on model grid. +! Optionally read tidal amplitude from input file (m s-1) on model grid. ! Otherwise use default tidal amplitude for bottom frictionally-generated ! dissipation. Default cd_tides is chosen to yield approx 1 TWatt of ! work done against tides globally using OSU tidal amplitude. @@ -1208,7 +1212,7 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, restore_salt, if (CS%read_TIDEAMP) then TideAmp_file = trim(CS%inputdir) // trim(TideAmp_file) - call read_data(TideAmp_file,'tideamp',CS%TKE_tidal,domain=G%domain%mpp_domain,timelevel=1) + call MOM_read_data(TideAmp_file,'tideamp',CS%TKE_tidal,G%domain,timelevel=1) 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) @@ -1240,8 +1244,7 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, restore_salt, call safe_alloc_ptr(CS%gust,isd,ied,jsd,jed) gust_file = trim(CS%inputdir) // trim(gust_file) - call read_data(gust_file,'gustiness',CS%gust,domain=G%domain%mpp_domain, & - timelevel=1) ! units should be Pa + call MOM_read_data(gust_file,'gustiness',CS%gust,G%domain, timelevel=1) ! units should be Pa endif ! See whether sufficiently thick sea ice should be treated as rigid. @@ -1279,11 +1282,21 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, restore_salt, if (present(restore_salt)) then ; if (restore_salt) then salt_file = trim(CS%inputdir) // trim(CS%salt_restore_file) CS%id_srestore = init_external_field(salt_file, CS%salt_restore_var_name, domain=G%Domain%mpp_domain) + call safe_alloc_ptr(CS%srestore_mask,isd,ied,jsd,jed); CS%srestore_mask(:,:) = 1.0 + if (CS%mask_srestore) then ! read a 2-d file containing a mask for restoring fluxes + flnam = trim(CS%inputdir) // 'salt_restore_mask.nc' + call MOM_read_data(flnam,'mask', CS%srestore_mask, G%domain, timelevel=1) + endif endif ; endif if (present(restore_temp)) then ; if (restore_temp) then temp_file = trim(CS%inputdir) // trim(CS%temp_restore_file) CS%id_trestore = init_external_field(temp_file, CS%temp_restore_var_name, domain=G%Domain%mpp_domain) + call safe_alloc_ptr(CS%trestore_mask,isd,ied,jsd,jed); CS%trestore_mask(:,:) = 1.0 + if (CS%mask_trestore) then ! read a 2-d file containing a mask for restoring fluxes + flnam = trim(CS%inputdir) // 'temp_restore_mask.nc' + call MOM_read_data(flnam, 'mask', CS%trestore_mask, G%domain, timelevel=1) + endif endif ; endif ! Set up any restart fields associated with the forcing. @@ -1311,16 +1324,14 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, restore_salt, call cpu_clock_end(id_clock_forcing) end subroutine surface_forcing_init -!======================================================================= - -!> Finalizes surface forcing: deallocate surface forcing control structure +!> Clean up and deallocate any memory associated with this module and its children. subroutine surface_forcing_end(CS, fluxes) - type(surface_forcing_CS), pointer :: CS - type(forcing), optional, intent(inout) :: fluxes -! Arguments: CS - A pointer to the control structure returned by a previous -! call to surface_forcing_init, it will be deallocated here. -! (inout) fluxes - A structure containing pointers to any possible -! forcing fields. Unused fields have NULL ptrs. + type(surface_forcing_CS), pointer :: CS !< A pointer to the control structure returned by + !! a previous call to surface_forcing_init, it will + !! be deallocated here. + type(forcing), optional, intent(inout) :: fluxes !< A structure containing pointers to all + !! possible mass, heat or salt flux forcing fields. + !! If present, it will be deallocated here. if (present(fluxes)) call deallocate_forcing_type(fluxes) @@ -1331,42 +1342,44 @@ subroutine surface_forcing_end(CS, fluxes) end subroutine surface_forcing_end -!======================================================================= - +!> Write out a set of messages with checksums of the fields in an ice_ocen_boundary type subroutine ice_ocn_bnd_type_chksum(id, timestep, iobt) - character(len=*), intent(in) :: id - integer , intent(in) :: timestep - type(ice_ocean_boundary_type), intent(in) :: iobt + character(len=*), intent(in) :: id !< An identifying string for this call + integer, intent(in) :: timestep !< The number of elapsed timesteps + type(ice_ocean_boundary_type), & + intent(in) :: iobt !< An ice-ocean boundary type with fluxes to drive the + !! ocean in a coupled model whose checksums are reported + + ! local variables integer :: n,m, outunit outunit = stdout() write(outunit,*) "BEGIN CHECKSUM(ice_ocean_boundary_type):: ", id, timestep - write(outunit,100) 'iobt%u_flux ', mpp_chksum( iobt%u_flux ) - write(outunit,100) 'iobt%v_flux ', mpp_chksum( iobt%v_flux ) - write(outunit,100) 'iobt%t_flux ', mpp_chksum( iobt%t_flux ) - write(outunit,100) 'iobt%seaice_melt_heat', mpp_chksum( iobt%seaice_melt_heat) - write(outunit,100) 'iobt%seaice_melt ', mpp_chksum( iobt%seaice_melt ) - write(outunit,100) 'iobt%q_flux ', mpp_chksum( iobt%q_flux ) - write(outunit,100) 'iobt%rofl_flux ', mpp_chksum( iobt%rofl_flux ) - write(outunit,100) 'iobt%rofi_flux ', mpp_chksum( iobt%rofi_flux ) - write(outunit,100) 'iobt%salt_flux ', mpp_chksum( iobt%salt_flux ) - write(outunit,100) 'iobt%lw_flux ', mpp_chksum( iobt%lw_flux ) - write(outunit,100) 'iobt%sw_flux_vis_dir ', mpp_chksum( iobt%sw_flux_vis_dir ) - write(outunit,100) 'iobt%sw_flux_vis_dif ', mpp_chksum( iobt%sw_flux_vis_dif ) - write(outunit,100) 'iobt%sw_flux_nir_dir ', mpp_chksum( iobt%sw_flux_nir_dir ) - write(outunit,100) 'iobt%sw_flux_nir_dif ', mpp_chksum( iobt%sw_flux_nir_dif ) - write(outunit,100) 'iobt%lprec ', mpp_chksum( iobt%lprec ) - write(outunit,100) 'iobt%fprec ', mpp_chksum( iobt%fprec ) - write(outunit,100) 'iobt%calving ', mpp_chksum( iobt%calving ) - write(outunit,100) 'iobt%p ', mpp_chksum( iobt%p ) + write(outunit,100) 'iobt%u_flux ' , mpp_chksum( iobt%u_flux ) + write(outunit,100) 'iobt%v_flux ' , mpp_chksum( iobt%v_flux ) + write(outunit,100) 'iobt%t_flux ' , mpp_chksum( iobt%t_flux ) + write(outunit,100) 'iobt%q_flux ' , mpp_chksum( iobt%q_flux ) + write(outunit,100) 'iobt%salt_flux ' , mpp_chksum( iobt%salt_flux ) + write(outunit,100) 'iobt%seaice_melt_heat' , mpp_chksum( iobt%seaice_melt_heat) + write(outunit,100) 'iobt%seaice_melt ' , mpp_chksum( iobt%seaice_melt ) + write(outunit,100) 'iobt%lw_flux ' , mpp_chksum( iobt%lw_flux ) + write(outunit,100) 'iobt%sw_flux_vis_dir' , mpp_chksum( iobt%sw_flux_vis_dir) + write(outunit,100) 'iobt%sw_flux_vis_dif' , mpp_chksum( iobt%sw_flux_vis_dif) + write(outunit,100) 'iobt%sw_flux_nir_dir' , mpp_chksum( iobt%sw_flux_nir_dir) + write(outunit,100) 'iobt%sw_flux_nir_dif' , mpp_chksum( iobt%sw_flux_nir_dif) + write(outunit,100) 'iobt%lprec ' , mpp_chksum( iobt%lprec ) + write(outunit,100) 'iobt%fprec ' , mpp_chksum( iobt%fprec ) + write(outunit,100) 'iobt%runoff ' , mpp_chksum( iobt%runoff ) + write(outunit,100) 'iobt%calving ' , mpp_chksum( iobt%calving ) + write(outunit,100) 'iobt%p ' , mpp_chksum( iobt%p ) if (associated(iobt%ustar_berg)) & - write(outunit,100) 'iobt%ustar_berg ', mpp_chksum( iobt%ustar_berg ) + write(outunit,100) 'iobt%ustar_berg ' , mpp_chksum( iobt%ustar_berg ) if (associated(iobt%area_berg)) & - write(outunit,100) 'iobt%area_berg ', mpp_chksum( iobt%area_berg ) + write(outunit,100) 'iobt%area_berg ' , mpp_chksum( iobt%area_berg ) if (associated(iobt%mass_berg)) & - write(outunit,100) 'iobt%mass_berg ', mpp_chksum( iobt%mass_berg ) + write(outunit,100) 'iobt%mass_berg ' , mpp_chksum( iobt%mass_berg ) 100 FORMAT(" CHECKSUM::",A20," = ",Z20) call coupler_type_write_chksums(iobt%fluxes, outunit, 'iobt%') diff --git a/config_src/mct_driver/ocn_cap_methods.F90 b/config_src/mct_driver/ocn_cap_methods.F90 index 7723f51a6c..7e06b014d4 100644 --- a/config_src/mct_driver/ocn_cap_methods.F90 +++ b/config_src/mct_driver/ocn_cap_methods.F90 @@ -71,9 +71,6 @@ subroutine ocn_import(x2o, ind, grid, ice_ocean_boundary, ocean_public, logunit, ! sensible heat flux (W/m2) ice_ocean_boundary%t_flux(i,j) = x2o(ind%x2o_Foxx_sen,k) - ! latent heat flux (W/m^2) - ice_ocean_boundary%latent_flux(i,j) = x2o(ind%x2o_Foxx_lat,k) - ! snow&ice melt heat flux (W/m^2) ice_ocean_boundary%seaice_melt_heat(i,j) = x2o(ind%x2o_Fioi_melth,k) @@ -89,8 +86,8 @@ subroutine ocn_import(x2o, ind, grid, ice_ocean_boundary, ocean_public, logunit, ! surface pressure ice_ocean_boundary%p(i,j) = x2o(ind%x2o_Sa_pslv,k) * GRID%mask2dT(i,j) - ! salt flux (minus sign needed here -GMM) - ice_ocean_boundary%salt_flux(i,j) = -x2o(ind%x2o_Fioi_salt,k) * GRID%mask2dT(i,j) + ! salt flux + ice_ocean_boundary%salt_flux(i,j) = x2o(ind%x2o_Fioi_salt,k) * GRID%mask2dT(i,j) ! 1) visible, direct shortwave (W/m2) ! 2) visible, diffuse shortwave (W/m2) @@ -127,8 +124,6 @@ subroutine ocn_import(x2o, ind, grid, ice_ocean_boundary, ocean_public, logunit, day,secs,j,i,ice_ocean_boundary%seaice_melt_heat(i,j) write(logunit,F01)'import: day, secs, j, i, seaice_melt = ',& day,secs,j,i,ice_ocean_boundary%seaice_melt(i,j) - write(logunit,F01)'import: day, secs, j, i, latent_flux = ',& - day,secs,j,i,ice_ocean_boundary%latent_flux(i,j) write(logunit,F01)'import: day, secs, j, i, runoff = ',& day,secs,j,i,ice_ocean_boundary%rofl_flux(i,j) + ice_ocean_boundary%rofi_flux(i,j) write(logunit,F01)'import: day, secs, j, i, psurf = ',& diff --git a/config_src/mct_driver/ocn_comp_mct.F90 b/config_src/mct_driver/ocn_comp_mct.F90 index 5698335b6f..8d9133d08b 100644 --- a/config_src/mct_driver/ocn_comp_mct.F90 +++ b/config_src/mct_driver/ocn_comp_mct.F90 @@ -24,8 +24,6 @@ module ocn_comp_mct shr_file_getLogUnit, shr_file_getLogLevel, & shr_file_setLogUnit, shr_file_setLogLevel -use MOM_surface_forcing, only: IOB_allocate, ice_ocean_boundary_type - ! MOM6 modules use MOM, only: extract_surface_state use MOM_variables, only: surface @@ -49,7 +47,7 @@ module ocn_comp_mct use MOM_ocean_model, only: ocean_public_type, ocean_state_type use MOM_ocean_model, only: ocean_model_init , update_ocean_model, ocean_model_end use MOM_ocean_model, only: convert_state_to_ocean_type -use MOM_surface_forcing, only: surface_forcing_CS, forcing_save_restart +use MOM_surface_forcing, only: surface_forcing_CS, forcing_save_restart, ice_ocean_boundary_type use ocn_cap_methods, only: ocn_import, ocn_export ! FMS modules @@ -813,4 +811,61 @@ end subroutine ocean_model_init_sfc !! CO2 !! DMS +!> Allocates ice-ocean boundary type containers and sets to 0. +subroutine IOB_allocate(IOB, isc, iec, jsc, jec) + type(ice_ocean_boundary_type), intent(inout) :: IOB !< An ice-ocean boundary type with fluxes to drive + integer, intent(in) :: isc, iec, jsc, jec !< The ocean's local grid size + + allocate ( IOB% rofl_flux (isc:iec,jsc:jec), & + IOB% rofi_flux (isc:iec,jsc:jec), & + IOB% u_flux (isc:iec,jsc:jec), & + IOB% v_flux (isc:iec,jsc:jec), & + IOB% t_flux (isc:iec,jsc:jec), & + IOB% seaice_melt_heat (isc:iec,jsc:jec),& + IOB% seaice_melt (isc:iec,jsc:jec), & + IOB% q_flux (isc:iec,jsc:jec), & + IOB% salt_flux (isc:iec,jsc:jec), & + IOB% lw_flux (isc:iec,jsc:jec), & + IOB% sw_flux_vis_dir (isc:iec,jsc:jec), & + IOB% sw_flux_vis_dif (isc:iec,jsc:jec), & + IOB% sw_flux_nir_dir (isc:iec,jsc:jec), & + IOB% sw_flux_nir_dif (isc:iec,jsc:jec), & + IOB% lprec (isc:iec,jsc:jec), & + IOB% fprec (isc:iec,jsc:jec), & + IOB% ustar_berg (isc:iec,jsc:jec), & + IOB% area_berg (isc:iec,jsc:jec), & + IOB% mass_berg (isc:iec,jsc:jec), & + IOB% calving (isc:iec,jsc:jec), & + IOB% runoff_hflx (isc:iec,jsc:jec), & + IOB% calving_hflx (isc:iec,jsc:jec), & + IOB% mi (isc:iec,jsc:jec), & + IOB% p (isc:iec,jsc:jec)) + + IOB%rofl_flux = 0.0 + IOB%rofi_flux = 0.0 + IOB%u_flux = 0.0 + IOB%v_flux = 0.0 + IOB%t_flux = 0.0 + IOB%seaice_melt_heat = 0.0 + IOB%seaice_melt = 0.0 + IOB%q_flux = 0.0 + IOB%salt_flux = 0.0 + IOB%lw_flux = 0.0 + IOB%sw_flux_vis_dir = 0.0 + IOB%sw_flux_vis_dif = 0.0 + IOB%sw_flux_nir_dir = 0.0 + IOB%sw_flux_nir_dif = 0.0 + IOB%lprec = 0.0 + IOB%fprec = 0.0 + IOB%ustar_berg = 0.0 + IOB%area_berg = 0.0 + IOB%mass_berg = 0.0 + IOB%calving = 0.0 + IOB%runoff_hflx = 0.0 + IOB%calving_hflx = 0.0 + IOB%mi = 0.0 + IOB%p = 0.0 + +end subroutine IOB_allocate + end module ocn_comp_mct diff --git a/config_src/nuopc_driver/MOM_ocean_model.F90 b/config_src/nuopc_driver/MOM_ocean_model.F90 index abe583ffcc..f0ba14ac1d 100644 --- a/config_src/nuopc_driver/MOM_ocean_model.F90 +++ b/config_src/nuopc_driver/MOM_ocean_model.F90 @@ -11,57 +11,57 @@ module MOM_ocean_model ! This code is a stop-gap wrapper of the MOM6 code to enable it to be called ! in the same way as MOM4. -use MOM, only : initialize_MOM, step_MOM, MOM_control_struct, MOM_end -use MOM, only : extract_surface_state, allocate_surface_state, finish_MOM_initialization -use MOM, only : get_MOM_state_elements, MOM_state_is_synchronized -use MOM, only : get_ocean_stocks, step_offline -use MOM_constants, only : CELSIUS_KELVIN_OFFSET, hlf -use MOM_diag_mediator, only : diag_ctrl, enable_averaging, disable_averaging -use MOM_diag_mediator, only : diag_mediator_close_registration, diag_mediator_end -use MOM_domains, only : pass_var, pass_vector, AGRID, BGRID_NE, CGRID_NE -use MOM_domains, only : TO_ALL, Omit_Corners -use MOM_error_handler, only : MOM_error, FATAL, WARNING, is_root_pe -use MOM_error_handler, only : callTree_enter, callTree_leave -use MOM_file_parser, only : get_param, log_version, close_param_file, param_file_type -use MOM_forcing_type, only : allocate_forcing_type -use MOM_forcing_type, only : forcing, mech_forcing -use MOM_forcing_type, only : forcing_accumulate, copy_common_forcing_fields -use MOM_forcing_type, only : copy_back_forcing_fields, set_net_mass_forcing -use MOM_forcing_type, only : set_derived_forcing_fields -use MOM_forcing_type, only : forcing_diagnostics, mech_forcing_diags -use MOM_get_input, only : Get_MOM_Input, directories -use MOM_grid, only : ocean_grid_type -use MOM_io, only : close_file, file_exists, read_data, write_version_number -use MOM_marine_ice, only : iceberg_forces, iceberg_fluxes, marine_ice_init, marine_ice_CS -use MOM_restart, only : MOM_restart_CS, save_restart -use MOM_string_functions, only : uppercase -use MOM_surface_forcing, only : surface_forcing_init, convert_IOB_to_fluxes -use MOM_surface_forcing, only : convert_IOB_to_forces, ice_ocn_bnd_type_chksum -use MOM_surface_forcing, only : ice_ocean_boundary_type, surface_forcing_CS -use MOM_surface_forcing, only : forcing_save_restart -use MOM_time_manager, only : time_type, get_time, set_time, operator(>) -use MOM_time_manager, only : operator(+), operator(-), operator(*), operator(/) -use MOM_time_manager, only : operator(/=), operator(<=), operator(>=) -use MOM_time_manager, only : operator(<), real_to_time_type, time_type_to_real +use MOM, only : initialize_MOM, step_MOM, MOM_control_struct, MOM_end +use MOM, only : extract_surface_state, allocate_surface_state, finish_MOM_initialization +use MOM, only : get_MOM_state_elements, MOM_state_is_synchronized +use MOM, only : get_ocean_stocks, step_offline +use MOM_constants, only : CELSIUS_KELVIN_OFFSET, hlf +use MOM_diag_mediator, only : diag_ctrl, enable_averaging, disable_averaging +use MOM_diag_mediator, only : diag_mediator_close_registration, diag_mediator_end +use MOM_domains, only : pass_var, pass_vector, AGRID, BGRID_NE, CGRID_NE +use MOM_domains, only : TO_ALL, Omit_Corners +use MOM_error_handler, only : MOM_error, FATAL, WARNING, is_root_pe +use MOM_error_handler, only : callTree_enter, callTree_leave +use MOM_file_parser, only : get_param, log_version, close_param_file, param_file_type +use MOM_forcing_type, only : allocate_forcing_type +use MOM_forcing_type, only : forcing, mech_forcing +use MOM_forcing_type, only : forcing_accumulate, copy_common_forcing_fields +use MOM_forcing_type, only : copy_back_forcing_fields, set_net_mass_forcing +use MOM_forcing_type, only : set_derived_forcing_fields +use MOM_forcing_type, only : forcing_diagnostics, mech_forcing_diags +use MOM_get_input, only : Get_MOM_Input, directories +use MOM_grid, only : ocean_grid_type +use MOM_io, only : close_file, file_exists, read_data, write_version_number +use MOM_marine_ice, only : iceberg_forces, iceberg_fluxes, marine_ice_init, marine_ice_CS +use MOM_restart, only : MOM_restart_CS, save_restart +use MOM_string_functions, only : uppercase +use MOM_surface_forcing, only : surface_forcing_init, convert_IOB_to_fluxes +use MOM_surface_forcing, only : convert_IOB_to_forces, ice_ocn_bnd_type_chksum +use MOM_surface_forcing, only : ice_ocean_boundary_type, surface_forcing_CS +use MOM_surface_forcing, only : forcing_save_restart +use MOM_time_manager, only : time_type, get_time, set_time, operator(>) +use MOM_time_manager, only : operator(+), operator(-), operator(*), operator(/) +use MOM_time_manager, only : operator(/=), operator(<=), operator(>=) +use MOM_time_manager, only : operator(<), real_to_time_type, time_type_to_real use MOM_tracer_flow_control, only : call_tracer_register, tracer_flow_control_init use MOM_tracer_flow_control, only : call_tracer_flux_init use MOM_unit_scaling, only : unit_scale_type -use MOM_variables, only : surface -use MOM_verticalGrid, only : verticalGrid_type -use MOM_ice_shelf, only : initialize_ice_shelf, shelf_calc_flux, ice_shelf_CS -use MOM_ice_shelf, only : add_shelf_forces, ice_shelf_end, ice_shelf_save_restart -use coupler_types_mod, only : coupler_1d_bc_type, coupler_2d_bc_type -use coupler_types_mod, only : coupler_type_spawn, coupler_type_write_chksums -use coupler_types_mod, only : coupler_type_initialized, coupler_type_copy_data -use coupler_types_mod, only : coupler_type_set_diags, coupler_type_send_data -use mpp_domains_mod, only : domain2d, mpp_get_layout, mpp_get_global_domain -use mpp_domains_mod, only : mpp_define_domains, mpp_get_compute_domain, mpp_get_data_domain -use atmos_ocean_fluxes_mod, only : aof_set_coupler_flux -use fms_mod, only : stdout -use mpp_mod, only : mpp_chksum -use MOM_EOS, only : gsw_sp_from_sr, gsw_pt_from_ct -use MOM_wave_interface, only: wave_parameters_CS, MOM_wave_interface_init -use MOM_wave_interface, only: MOM_wave_interface_init_lite, Update_Surface_Waves +use MOM_variables, only : surface +use MOM_verticalGrid, only : verticalGrid_type +use MOM_ice_shelf, only : initialize_ice_shelf, shelf_calc_flux, ice_shelf_CS +use MOM_ice_shelf, only : add_shelf_forces, ice_shelf_end, ice_shelf_save_restart +use coupler_types_mod, only : coupler_1d_bc_type, coupler_2d_bc_type +use coupler_types_mod, only : coupler_type_spawn, coupler_type_write_chksums +use coupler_types_mod, only : coupler_type_initialized, coupler_type_copy_data +use coupler_types_mod, only : coupler_type_set_diags, coupler_type_send_data +use mpp_domains_mod, only : domain2d, mpp_get_layout, mpp_get_global_domain +use mpp_domains_mod, only : mpp_define_domains, mpp_get_compute_domain, mpp_get_data_domain +use atmos_ocean_fluxes_mod, only : aof_set_coupler_flux +use fms_mod, only : stdout +use mpp_mod, only : mpp_chksum +use MOM_EOS, only : gsw_sp_from_sr, gsw_pt_from_ct +use MOM_wave_interface, only: wave_parameters_CS, MOM_wave_interface_init +use MOM_wave_interface, only: MOM_wave_interface_init_lite, Update_Surface_Waves #include @@ -260,7 +260,6 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, gas_fields_ocn, i integer :: secs, days type(param_file_type) :: param_file !< A structure to parse for run-time parameters logical :: use_temperature - type(time_type) :: dt_geometric, dt_savedays, dt_from_base call callTree_enter("ocean_model_init(), ocean_model_MOM.F90") if (associated(OS)) then @@ -476,7 +475,7 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & integer :: secs, days integer :: is, ie, js, je - call callTree_enter("update_ocean_model(), ocean_model_MOM.F90") + call callTree_enter("update_ocean_model(), MOM_ocean_model.F90") call get_time(Ocean_coupling_time_step, secs, days) dt_coupling = 86400.0*real(days) + real(secs) diff --git a/config_src/nuopc_driver/MOM_surface_forcing.F90 b/config_src/nuopc_driver/MOM_surface_forcing.F90 index da7956feeb..26121ff62d 100644 --- a/config_src/nuopc_driver/MOM_surface_forcing.F90 +++ b/config_src/nuopc_driver/MOM_surface_forcing.F90 @@ -222,7 +222,7 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, US, CS, & logical, optional, intent(in) :: restore_salt !< If true, salinity is restored to a target value. logical, optional, intent(in) :: restore_temp !< If true, temperature is restored to a target value. - ! local varibles + ! local variables real, dimension(SZI_(G),SZJ_(G)) :: & data_restore, & !< The surface value toward which to restore [g/kg or degC] SST_anom, & !< Instantaneous sea surface temperature anomalies from a target value [deg C] @@ -767,12 +767,7 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, US, CS) enddo ; enddo elseif (wind_stagger == AGRID) then - !TODO: which one of these is correct? -#ifdef CESMCOUPLED - call pass_vector(taux_at_h, tauy_at_h, G%Domain,stagger=AGRID) -#else call pass_vector(taux_at_h, tauy_at_h, G%Domain, To_All+Omit_Corners, stagger=AGRID, halo=1) -#endif do j=js,je ; do I=Isq,Ieq forces%taux(I,j) = 0.0 From 562297c83a9841751ef2942b946b95313aee2267 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Tue, 16 Jul 2019 18:16:06 -0600 Subject: [PATCH 118/150] more changes to have minimal differences between nuopc and mct --- config_src/mct_driver/MOM_surface_forcing.F90 | 8 -------- 1 file changed, 8 deletions(-) diff --git a/config_src/mct_driver/MOM_surface_forcing.F90 b/config_src/mct_driver/MOM_surface_forcing.F90 index 0fc0efe532..cf1461467c 100644 --- a/config_src/mct_driver/MOM_surface_forcing.F90 +++ b/config_src/mct_driver/MOM_surface_forcing.F90 @@ -66,9 +66,6 @@ module MOM_surface_forcing logical :: use_temperature !! If true, temp and saln used as state variables 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] @@ -1093,11 +1090,6 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, restore_salt, "limited by max_p_surf instead of the full atmospheric "//& "pressure.", default=.true.) -! smg: should get_param call should be removed when have A=B code reconciled. -! this param is used to distinguish how to diagnose surface heat content from water. - call get_param(param_file, mdl, "BULKMIXEDLAYER", CS%bulkmixedlayer, & - default=CS%use_temperature,do_not_log=.true.) - call get_param(param_file, mdl, "WIND_STAGGER", stagger, & "A case-insensitive character string to indicate the "//& "staggering of the input wind stress field. Valid "//& From 9320b6a31f7626f149f4f5494c5371720b094b59 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Wed, 17 Jul 2019 04:47:07 -0400 Subject: [PATCH 119/150] Changed laterat viscosity units to [m2 T-1] Changed the units of lateral viscosities to [m2 T-1] and the units of biharmonic viscosities to [m4 T-1] in MOM_hor_visc.F90 for expanded dimensional consistency testing. All answers are bitwise identical. --- .../lateral/MOM_hor_visc.F90 | 153 +++++++++--------- 1 file changed, 77 insertions(+), 76 deletions(-) diff --git a/src/parameterizations/lateral/MOM_hor_visc.F90 b/src/parameterizations/lateral/MOM_hor_visc.F90 index 5d180680ce..02773a7da7 100644 --- a/src/parameterizations/lateral/MOM_hor_visc.F90 +++ b/src/parameterizations/lateral/MOM_hor_visc.F90 @@ -66,14 +66,14 @@ module MOM_hor_visc !! scales quadratically with the velocity shears. logical :: use_Kh_bg_2d !< Read 2d background viscosity from a file. real :: Kh_bg_min !< The minimum value allowed for Laplacian horizontal - !! viscosity [m2 s-1]. The default is 0.0 + !! viscosity [m2 T-1 ~> m2 s-1]. The default is 0.0 logical :: use_land_mask !< Use the land mask for the computation of thicknesses !! at velocity locations. This eliminates the dependence on !! arbitrary values over land or outside of the domain. !! Default is False to maintain answers with legacy experiments !! but should be changed to True for new experiments. logical :: anisotropic !< If true, allow anisotropic component to the viscosity. - real :: Kh_aniso !< The anisotropic viscosity [m2 s-1]. + real :: Kh_aniso !< The anisotropic viscosity [m2 T-1 ~> m2 s-1]. logical :: dynamic_aniso !< If true, the anisotropic viscosity is recomputed as a function !! of state. This is set depending on ANISOTROPIC_MODE. logical :: res_scale_MEKE !< If true, the viscosity contribution from MEKE is scaled by @@ -84,15 +84,15 @@ module MOM_hor_visc !! forms of the same expressions. real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: Kh_bg_xx - !< The background Laplacian viscosity at h points [m2 s-1]. + !< The background Laplacian viscosity at h points [m2 T-1 ~> m2 s-1]. !! The actual viscosity may be the larger of this !! viscosity and the Smagorinsky and Leith viscosities. real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: Kh_bg_2d - !< The background Laplacian viscosity at h points [m2 s-1]. + !< The background Laplacian viscosity at h points [m2 T-1 ~> m2 s-1]. !! The actual viscosity may be the larger of this !! viscosity and the Smagorinsky and Leith viscosities. real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: Ah_bg_xx - !< The background biharmonic viscosity at h points [m4 s-1]. + !< The background biharmonic viscosity at h points [m4 T-1 ~> m4 s-1]. !! The actual viscosity may be the larger of this !! viscosity and the Smagorinsky and Leith viscosities. real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: Biharm5_const2_xx @@ -104,17 +104,17 @@ module MOM_hor_visc !< The amount by which stresses through h points are reduced !! due to partial barriers. Nondimensional. real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: & - Kh_Max_xx, & !< The maximum permitted Laplacian viscosity [m2 s-1]. - Ah_Max_xx, & !< The maximum permitted biharmonic viscosity [m4 s-1]. + Kh_Max_xx, & !< The maximum permitted Laplacian viscosity [m2 T-1 ~> m2 s-1]. + Ah_Max_xx, & !< The maximum permitted biharmonic viscosity [m4 T-1 ~> m4 s-1]. n1n2_h, & !< Factor n1*n2 in the anisotropic direction tensor at h-points n1n1_m_n2n2_h !< Factor n1**2-n2**2 in the anisotropic direction tensor at h-points real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEMB_PTR_) :: Kh_bg_xy - !< The background Laplacian viscosity at q points [m2 s-1]. + !< The background Laplacian viscosity at q points [m2 T-1 ~> m2 s-1]. !! The actual viscosity may be the larger of this !! viscosity and the Smagorinsky and Leith viscosities. real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEMB_PTR_) :: Ah_bg_xy - !< The background biharmonic viscosity at q points [m4 s-1]. + !< The background biharmonic viscosity at q points [m4 T-1 ~> m4 s-1]. !! The actual viscosity may be the larger of this !! viscosity and the Smagorinsky and Leith viscosities. real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEMB_PTR_) :: Biharm5_const2_xy @@ -126,8 +126,8 @@ module MOM_hor_visc !< The amount by which stresses through q points are reduced !! due to partial barriers [nondim]. real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEMB_PTR_) :: & - Kh_Max_xy, & !< The maximum permitted Laplacian viscosity [m2 s-1]. - Ah_Max_xy, & !< The maximum permitted biharmonic viscosity [m4 s-1]. + Kh_Max_xy, & !< The maximum permitted Laplacian viscosity [m2 T-1 ~> m2 s-1]. + Ah_Max_xy, & !< The maximum permitted biharmonic viscosity [m4 T-1 ~> m4 s-1]. n1n2_q, & !< Factor n1*n2 in the anisotropic direction tensor at q-points n1n1_m_n2n2_q !< Factor n1**2-n2**2 in the anisotropic direction tensor at q-points @@ -278,7 +278,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, 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)) :: & - Ah_q, & ! biharmonic viscosity at corner points [m4 s-1] + Ah_q, & ! biharmonic viscosity at corner points [m4 T-1 ~> m4 s-1] Kh_q, & ! Laplacian viscosity at corner points [m2 s-1] vort_xy_q, & ! vertical vorticity at corner points [s-1] GME_coeff_q !< GME coeff. at q-points [m2 s-1] @@ -288,8 +288,8 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, real, dimension(SZI_(G),SZJB_(G),SZK_(G)+1) :: & KH_v_GME !< interface height diffusivities in v-columns [m2 s-1] real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: & - Ah_h, & ! biharmonic viscosity at thickness points [m4 s-1] - Kh_h, & ! Laplacian viscosity at thickness points [m2 s-1] + Ah_h, & ! biharmonic viscosity at thickness points [m4 T-1 ~> m4 s-1] + Kh_h, & ! Laplacian viscosity at thickness points [m2 T-1 ~> m2 s-1] diss_rate, & ! MKE dissipated by parameterized shear production [m2 s-3] max_diss_rate, & ! maximum possible energy dissipated by lateral friction [m2 s-3] target_diss_rate_GME, & ! the maximum theoretical dissipation plus the amount spuriously dissipated @@ -303,11 +303,11 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: & KH_t_GME, & !< interface height diffusivities in t-columns [m2 s-1] GME_coeff_h !< GME coeff. at h-points [m2 s-1] - real :: Ah ! biharmonic viscosity [m4 s-1] - real :: Kh ! Laplacian viscosity [m2 s-1] - real :: AhSm ! Smagorinsky biharmonic viscosity [m4 s-1] - real :: KhSm ! Smagorinsky Laplacian viscosity [m2 s-1] - real :: AhLth ! 2D Leith biharmonic viscosity [m4 s-1] + real :: Ah ! biharmonic viscosity [m4 T-1 ~> m4 s-1] + real :: Kh ! Laplacian viscosity [m2 T-1 ~> m2 s-1] + real :: AhSm ! Smagorinsky biharmonic viscosity [m4 T-1 ~> m4 s-1] +! real :: KhSm ! Smagorinsky Laplacian viscosity [m2 T-1 ~> m2 s-1] + real :: AhLth ! 2D Leith biharmonic viscosity [m4 T-1 ~> m4 s-1] real :: KhLth ! 2D Leith Laplacian viscosity [m2 s-1] real :: mod_Leith ! nondimensional coefficient for divergence part of modified Leith ! viscosity. Here set equal to nondimensional Laplacian Leith constant. @@ -499,7 +499,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, !$OMP use_MEKE_Au, MEKE, hq, & !$OMP mod_Leith, legacy_bound, div_xx_h, vort_xy_q) & !$OMP private(u0, v0, sh_xx, str_xx, visc_bound_rem, & - !$OMP sh_xy, str_xy, Ah, Kh, AhSm, KhSm, dvdx, dudy, & + !$OMP sh_xy, str_xy, Ah, Kh, AhSm, dvdx, dudy, & !$OMP sh_xx_bt, sh_xy_bt, dvdx_bt, dudy_bt, & !$OMP bhstr_xx, bhstr_xy,FatH,RoScl, hu, hv, h_u, h_v, & !$OMP vort_xy,vort_xy_dx,vort_xy_dy,Vort_mag,AhLth,KhLth, & @@ -869,15 +869,15 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, ! Determine the Laplacian viscosity at h points, using the ! largest value from several parameterizations. Kh = CS%Kh_bg_xx(i,j) ! Static (pre-computed) background viscosity - if (CS%Smagorinsky_Kh) Kh = max( Kh, CS%Laplac2_const_xx(i,j) * US%s_to_T*Shear_mag ) - if (CS%Leith_Kh) Kh = max( Kh, CS%Laplac3_const_xx(i,j) * vert_vort_mag*inv_PI3) + if (CS%Smagorinsky_Kh) Kh = max( Kh, CS%Laplac2_const_xx(i,j) * Shear_mag ) + if (CS%Leith_Kh) Kh = max( Kh, CS%Laplac3_const_xx(i,j) * US%T_to_s*vert_vort_mag*inv_PI3) ! All viscosity contributions above are subject to resolution scaling if (rescale_Kh) Kh = VarMix%Res_fn_h(i,j) * Kh if (CS%res_scale_MEKE) meke_res_fn = VarMix%Res_fn_h(i,j) ! Older method of bounding for stability if (legacy_bound) Kh = min(Kh, CS%Kh_Max_xx(i,j)) Kh = max( Kh, CS%Kh_bg_min ) ! Place a floor on the viscosity, if desired. - if (use_MEKE_Ku) Kh = Kh + MEKE%Ku(i,j) * meke_res_fn ! *Add* the MEKE contribution (might be negative) + if (use_MEKE_Ku) Kh = Kh + US%T_to_s*MEKE%Ku(i,j) * meke_res_fn ! *Add* the MEKE contribution (might be negative) if (CS%anisotropic) Kh = Kh + CS%Kh_aniso * ( 1. - CS%n1n2_h(i,j)**2 ) ! *Add* the tension component ! of anisotropic viscosity @@ -895,7 +895,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, if ((CS%id_Kh_h>0) .or. find_FrictWork) Kh_h(i,j,k) = Kh if (CS%id_div_xx_h>0) div_xx_h(i,j,k) = div_xx(i,j) - str_xx(i,j) = -US%T_to_s*Kh * sh_xx(i,j) + str_xx(i,j) = -Kh * sh_xx(i,j) else ! not Laplacian str_xx(i,j) = 0.0 endif ! Laplacian @@ -904,7 +904,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, ! Shearing-strain averaged to h-points local_strain = 0.25 * ( (sh_xy(I,J) + sh_xy(I-1,J-1)) + (sh_xy(I-1,J) + sh_xy(I,J-1)) ) ! *Add* the shear-strain contribution to the xx-component of stress - str_xx(i,j) = str_xx(i,j) - US%T_to_s*CS%Kh_aniso * CS%n1n2_h(i,j) * CS%n1n1_m_n2n2_h(i,j) * local_strain + str_xx(i,j) = str_xx(i,j) - CS%Kh_aniso * CS%n1n2_h(i,j) * CS%n1n1_m_n2n2_h(i,j) * local_strain endif if (CS%biharmonic) then @@ -914,21 +914,21 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, if ((CS%Smagorinsky_Ah) .or. (CS%Leith_Ah)) then if (CS%Smagorinsky_Ah) then if (CS%bound_Coriolis) then - AhSm = US%s_to_T*Shear_mag * (CS%Biharm_const_xx(i,j) + & - CS%Biharm_const2_xx(i,j)*Shear_mag) + AhSm = Shear_mag * (CS%Biharm_const_xx(i,j) + & + CS%Biharm_const2_xx(i,j)*Shear_mag) else - AhSm = CS%Biharm_const_xx(i,j) * US%s_to_T*Shear_mag + AhSm = CS%Biharm_const_xx(i,j) * Shear_mag endif endif - if (CS%Leith_Ah) AhLth = CS%biharm5_const_xx(i,j) * vert_vort_mag * inv_PI5 - Ah = MAX(MAX(CS%Ah_bg_xx(i,j), AhSm),AhLth) + if (CS%Leith_Ah) AhLth = CS%biharm5_const_xx(i,j) * US%T_to_s*vert_vort_mag * inv_PI5 + Ah = MAX(MAX(CS%Ah_bg_xx(i,j), AhSm), AhLth) if (CS%bound_Ah .and. .not.CS%better_bound_Ah) & Ah = MIN(Ah, CS%Ah_Max_xx(i,j)) else Ah = CS%Ah_bg_xx(i,j) endif ! Smagorinsky_Ah or Leith_Ah - if (use_MEKE_Au) Ah = Ah + MEKE%Au(i,j) ! *Add* the MEKE contribution + if (use_MEKE_Au) Ah = Ah + US%T_to_s*MEKE%Au(i,j) ! *Add* the MEKE contribution if (CS%better_bound_Ah) then Ah = MIN(Ah, visc_bound_rem*hrat_min*CS%Ah_Max_xx(i,j)) @@ -936,12 +936,12 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, if ((CS%id_Ah_h>0) .or. find_FrictWork) Ah_h(i,j,k) = Ah - str_xx(i,j) = str_xx(i,j) + US%T_to_s*Ah * & + str_xx(i,j) = str_xx(i,j) + Ah * & (CS%DY_dxT(i,j)*(G%IdyCu(I,j)*u0(I,j) - G%IdyCu(I-1,j)*u0(I-1,j)) - & CS%DX_dyT(i,j) *(G%IdxCv(i,J)*v0(i,J) - G%IdxCv(i,J-1)*v0(i,J-1))) ! Keep a copy of the biharmonic contribution for backscatter parameterization - bhstr_xx(i,j) = US%T_to_s*Ah * & + bhstr_xx(i,j) = Ah * & (CS%DY_dxT(i,j)*(G%IdyCu(I,j)*u0(I,j) - G%IdyCu(I-1,j)*u0(I-1,j)) - & CS%DX_dyT(i,j) *(G%IdxCv(i,J)*v0(i,J) - G%IdxCv(i,J-1)*v0(i,J-1))) bhstr_xx(i,j) = bhstr_xx(i,j) * (h(i,j,k) * CS%reduction_xx(i,j)) @@ -1031,8 +1031,8 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, ! Determine the Laplacian viscosity at q points, using the ! largest value from several parameterizations. Kh = CS%Kh_bg_xy(i,j) ! Static (pre-computed) background viscosity - if (CS%Smagorinsky_Kh) Kh = max( Kh, CS%Laplac2_const_xy(I,J) * US%s_to_T*Shear_mag ) - if (CS%Leith_Kh) Kh = max( Kh, CS%Laplac3_const_xy(I,J) * vert_vort_mag*inv_PI3) + if (CS%Smagorinsky_Kh) Kh = max( Kh, CS%Laplac2_const_xy(I,J) * Shear_mag ) + if (CS%Leith_Kh) Kh = max( Kh, CS%Laplac3_const_xy(I,J) * US%T_to_s*vert_vort_mag*inv_PI3) ! All viscosity contributions above are subject to resolution scaling if (rescale_Kh) Kh = VarMix%Res_fn_q(i,j) * Kh if (CS%res_scale_MEKE) meke_res_fn = VarMix%Res_fn_q(i,j) @@ -1040,7 +1040,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, if (legacy_bound) Kh = min(Kh, CS%Kh_Max_xy(i,j)) Kh = max( Kh, CS%Kh_bg_min ) ! Place a floor on the viscosity, if desired. if (use_MEKE_Ku) then ! *Add* the MEKE contribution (might be negative) - Kh = Kh + 0.25*( (MEKE%Ku(I,J)+MEKE%Ku(I+1,J+1)) & + Kh = Kh + US%T_to_s*0.25*( (MEKE%Ku(I,J)+MEKE%Ku(I+1,J+1)) & +(MEKE%Ku(I+1,J)+MEKE%Ku(I,J+1)) ) * meke_res_fn endif ! Older method of bounding for stability @@ -1061,7 +1061,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, if (CS%id_Kh_q>0) Kh_q(I,J,k) = Kh if (CS%id_vort_xy_q>0) vort_xy_q(I,J,k) = vort_xy(I,J) - str_xy(I,J) = -US%T_to_s*Kh * sh_xy(I,J) + str_xy(I,J) = -Kh * sh_xy(I,J) else ! not Laplacian str_xy(I,J) = 0.0 endif ! Laplacian @@ -1070,7 +1070,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, ! Horizontal-tension averaged to q-points local_strain = 0.25 * ( (sh_xx(i,j) + sh_xx(i+1,j+1)) + (sh_xx(i+1,j) + sh_xx(i,j+1)) ) ! *Add* the tension contribution to the xy-component of stress - str_xy(I,J) = str_xy(I,J) - US%T_to_s*CS%Kh_aniso * CS%n1n2_q(i,j) * CS%n1n1_m_n2n2_q(i,j) * local_strain + str_xy(I,J) = str_xy(I,J) - CS%Kh_aniso * CS%n1n2_q(i,j) * CS%n1n1_m_n2n2_q(i,j) * local_strain endif if (CS%biharmonic) then @@ -1080,14 +1080,14 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, if (CS%Smagorinsky_Ah .or. CS%Leith_Ah) then if (CS%Smagorinsky_Ah) then if (CS%bound_Coriolis) then - AhSm = US%s_to_T*Shear_mag * (CS%Biharm_const_xy(I,J) + & - CS%Biharm_const2_xy(I,J)*Shear_mag) + AhSm = Shear_mag * (CS%Biharm_const_xy(I,J) + & + CS%Biharm_const2_xy(I,J)*Shear_mag) else - AhSm = CS%Biharm_const_xy(I,J) * US%s_to_T*Shear_mag + AhSm = CS%Biharm_const_xy(I,J) * Shear_mag endif endif - if (CS%Leith_Ah) AhLth = CS%Biharm5_const_xy(I,J) * vert_vort_mag * inv_PI5 - Ah = MAX(MAX(CS%Ah_bg_xy(I,J), AhSm),AhLth) + if (CS%Leith_Ah) AhLth = CS%Biharm5_const_xy(I,J) * US%T_to_s*vert_vort_mag * inv_PI5 + Ah = MAX(MAX(CS%Ah_bg_xy(I,J), AhSm), AhLth) if (CS%bound_Ah .and. .not.CS%better_bound_Ah) & Ah = MIN(Ah, CS%Ah_Max_xy(I,J)) else @@ -1095,8 +1095,8 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, endif ! Smagorinsky_Ah or Leith_Ah if (use_MEKE_Au) then ! *Add* the MEKE contribution - Ah = Ah + 0.25*( (MEKE%Au(I,J)+MEKE%Au(I+1,J+1)) & - +(MEKE%Au(I+1,J)+MEKE%Au(I,J+1)) ) + Ah = Ah + US%T_to_s*0.25*( (MEKE%Au(I,J)+MEKE%Au(I+1,J+1)) & + +(MEKE%Au(I+1,J)+MEKE%Au(I,J+1)) ) endif if (CS%better_bound_Ah) then @@ -1105,10 +1105,10 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, if (CS%id_Ah_q>0) Ah_q(I,J,k) = Ah - str_xy(I,J) = str_xy(I,J) + US%T_to_s*Ah * ( dvdx(I,J) + dudy(I,J) ) + str_xy(I,J) = str_xy(I,J) + Ah * ( dvdx(I,J) + dudy(I,J) ) ! Keep a copy of the biharmonic contribution for backscatter parameterization - bhstr_xy(I,J) = US%T_to_s*Ah * ( dvdx(I,J) + dudy(I,J) ) * & + bhstr_xy(I,J) = Ah * ( dvdx(I,J) + dudy(I,J) ) * & (hq(I,J) * G%mask2dBu(I,J) * CS%reduction_xy(I,J)) endif ! biharmonic @@ -1150,8 +1150,8 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, do j=js,je ; do i=is,ie ! Diagnose -Kh * |del u|^2 - Ah * |del^2 u|^2 - diss_rate(i,j,k) = -Kh_h(i,j,k) * grad_vel_mag_h(i,j) - & - Ah_h(i,j,k) * grad_d2vel_mag_h(i,j) + diss_rate(i,j,k) = -US%s_to_T*Kh_h(i,j,k) * grad_vel_mag_h(i,j) - & + US%s_to_T*Ah_h(i,j,k) * grad_d2vel_mag_h(i,j) if (associated(MEKE)) then ; if (associated(MEKE%mom_src)) then ! This is the maximum possible amount of energy that can be converted @@ -1435,18 +1435,18 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS) real :: grid_sp_h3 ! Harmonic mean of the squares of the grid^(3/2) [m3] real :: grid_sp_q2 ! spacings at h and q points [m2] real :: grid_sp_q3 ! spacings at h and q points^(3/2) [m3] - real :: Kh_Limit ! A coefficient [s-1] used, along with the + real :: Kh_Limit ! A coefficient [T-1 ~> s-1] used, along with the ! grid spacing, to limit Laplacian viscosity. real :: fmax ! maximum absolute value of f at the four ! vorticity points around a thickness point [T-1 ~> s-1] real :: BoundCorConst ! A constant used when using viscosity to bound the Coriolis accelerations [T2 L-2 ~> s2 m-2] - real :: Ah_Limit ! coefficient [s-1] used, along with the + real :: Ah_Limit ! coefficient [T-1 ~> s-1] used, along with the ! grid spacing, to limit biharmonic viscosity real :: Kh ! Lapacian horizontal viscosity [m2 s-1] real :: Ah ! biharmonic horizontal viscosity [m4 s-1] - real :: Kh_vel_scale ! this speed [m s-1] times grid spacing gives Lap visc - real :: Ah_vel_scale ! this speed [m s-1] times grid spacing cubed gives bih visc - real :: Ah_time_scale ! damping time-scale for biharmonic visc + real :: Kh_vel_scale ! this speed [m T-1 ~> m s-1] times grid spacing gives Lap visc + real :: Ah_vel_scale ! this speed [m T-1 ~> m s-1] times grid spacing cubed gives bih visc + real :: Ah_time_scale ! damping time-scale for biharmonic visc [T ~> s] real :: Smag_Lap_const ! nondimensional Laplacian Smagorinsky constant real :: Smag_bi_const ! nondimensional biharmonic Smagorinsky constant real :: Leith_Lap_const ! nondimensional Laplacian Leith constant @@ -1458,7 +1458,7 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS) real :: bound_Cor_vel ! grid-scale velocity variations at which value ! the quadratically varying biharmonic viscosity ! balances Coriolis acceleration [L T-1 ~> m s-1] - real :: Kh_sin_lat ! Amplitude of latitudinally dependent viscosity [m2 s-1] + real :: Kh_sin_lat ! Amplitude of latitudinally dependent viscosity [m2 T-1 ~> m2 s-1] real :: Kh_pwr_of_sine ! Power used to raise sin(lat) when using Kh_sin_lat logical :: bound_Cor_def ! parameter setting of BOUND_CORIOLIS logical :: get_all ! If true, read and log all parameters, regardless of @@ -1527,20 +1527,20 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS) if (CS%Laplacian .or. get_all) then call get_param(param_file, mdl, "KH", Kh, & "The background Laplacian horizontal viscosity.", & - units = "m2 s-1", default=0.0) + units = "m2 s-1", default=0.0, scale=US%T_to_s) call get_param(param_file, mdl, "KH_BG_MIN", CS%Kh_bg_min, & "The minimum value allowed for Laplacian horizontal viscosity, KH.", & - units = "m2 s-1", default=0.0) + units = "m2 s-1", default=0.0, scale=US%T_to_s) call get_param(param_file, mdl, "KH_VEL_SCALE", Kh_vel_scale, & "The velocity scale which is multiplied by the grid "//& "spacing to calculate the Laplacian viscosity. "//& "The final viscosity is the largest of this scaled "//& "viscosity, the Smagorinsky and Leith viscosities, and KH.", & - units="m s-1", default=0.0) + units="m s-1", default=0.0, scale=US%T_to_s) call get_param(param_file, mdl, "KH_SIN_LAT", Kh_sin_lat, & "The amplitude of a latitudinally-dependent background "//& "viscosity of the form KH_SIN_LAT*(SIN(LAT)**KH_PWR_OF_SINE).", & - units = "m2 s-1", default=0.0) + units = "m2 s-1", default=0.0, scale=US%T_to_s) if (Kh_sin_lat>0. .or. get_all) & call get_param(param_file, mdl, "KH_PWR_OF_SINE", Kh_pwr_of_sine, & "The power used to raise SIN(LAT) when using a latitudinally "//& @@ -1603,7 +1603,7 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS) if (CS%anisotropic .or. get_all) then call get_param(param_file, mdl, "KH_ANISO", CS%Kh_aniso, & "The background Laplacian anisotropic horizontal viscosity.", & - units = "m2 s-1", default=0.0) + units = "m2 s-1", default=0.0, scale=US%T_to_s) call get_param(param_file, mdl, "ANISOTROPIC_MODE", aniso_mode, & "Selects the mode for setting the direction of anistropy.\n"//& "\t 0 - Points along the grid i-direction.\n"//& @@ -1631,19 +1631,19 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS) if (CS%biharmonic .or. get_all) then call get_param(param_file, mdl, "AH", Ah, & "The background biharmonic horizontal viscosity.", & - units = "m4 s-1", default=0.0) + units = "m4 s-1", default=0.0, scale=US%T_to_s) call get_param(param_file, mdl, "AH_VEL_SCALE", Ah_vel_scale, & "The velocity scale which is multiplied by the cube of "//& "the grid spacing to calculate the biharmonic viscosity. "//& "The final viscosity is the largest of this scaled "//& "viscosity, the Smagorinsky and Leith viscosities, and AH.", & - units="m s-1", default=0.0) + units="m s-1", default=0.0, scale=US%T_to_s) call get_param(param_file, mdl, "AH_TIME_SCALE", Ah_time_scale, & "A time scale whose inverse is multiplied by the fourth "//& "power of the grid spacing to calculate biharmonic viscosity. "//& "The final viscosity is the largest of all viscosity "//& "formulations in use. 0.0 means that it's not used.", & - units="s", default=0.0) + units="s", default=0.0, scale=US%s_to_T) call get_param(param_file, mdl, "SMAGORINSKY_AH", CS%Smagorinsky_Ah, & "If true, use a biharmonic Smagorinsky nonlinear eddy "//& "viscosity.", default=.false.) @@ -1807,7 +1807,7 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS) call get_param(param_file, mdl, "INPUTDIR", inputdir, default=".") inputdir = slasher(inputdir) call MOM_read_data(trim(inputdir)//trim(filename), 'Kh', CS%Kh_bg_2d, & - G%domain, timelevel=1) + G%domain, timelevel=1, scale=US%T_to_s) call pass_var(CS%Kh_bg_2d, G%domain) endif @@ -1881,7 +1881,7 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS) if (CS%Laplacian) then ! The 0.3 below was 0.4 in MOM1.10. The change in hq requires ! this to be less than 1/3, rather than 1/2 as before. - if (CS%bound_Kh .or. CS%bound_Ah) Kh_Limit = 0.3 / (dt*4.0) + if (CS%bound_Kh .or. CS%bound_Ah) Kh_Limit = 0.3 / (US%s_to_T*dt*4.0) ! Calculate and store the background viscosity at h-points do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 @@ -1920,6 +1920,7 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS) CS%Kh_bg_xy(I,J) = MAX(Kh, Kh_vel_scale * sqrt(grid_sp_q2)) ! Use the larger of the above and values read from a file + !### This expression uses inconsistent staggering if (CS%use_Kh_bg_2d) CS%Kh_bg_xy(I,J) = MAX(CS%Kh_bg_2d(i,j), CS%Kh_bg_xy(I,J)) ! Use the larger of the above and a function of sin(latitude) @@ -1950,7 +1951,7 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS) CS%Ah_bg_xy(:,:) = 0.0 ! The 0.3 below was 0.4 in MOM1.10. The change in hq requires ! this to be less than 1/3, rather than 1/2 as before. - if (CS%better_bound_Ah .or. CS%bound_Ah) Ah_Limit = 0.3 / (dt*64.0) + if (CS%better_bound_Ah .or. CS%bound_Ah) Ah_Limit = 0.3 / (US%s_to_T*dt*64.0) if (CS%Smagorinsky_Ah .and. CS%bound_Coriolis) & BoundCorConst = 1.0 / (5.0*(bound_Cor_vel*bound_Cor_vel)) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 @@ -1970,7 +1971,7 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS) CS%biharm5_const_xx(i,j) = Leith_bi_const * (grid_sp_h3 * grid_sp_h2) endif CS%Ah_bg_xx(i,j) = MAX(Ah, Ah_vel_scale * grid_sp_h2 * sqrt(grid_sp_h2)) - if (Ah_time_scale>0.) CS%Ah_bg_xx(i,j) = & + if (Ah_time_scale > 0.) CS%Ah_bg_xx(i,j) = & MAX(CS%Ah_bg_xx(i,j), (grid_sp_h2 * grid_sp_h2) / Ah_time_scale) if (CS%bound_Ah .and. .not.CS%better_bound_Ah) then CS%Ah_Max_xx(i,j) = Ah_Limit * (grid_sp_h2 * grid_sp_h2) @@ -1993,7 +1994,7 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS) endif CS%Ah_bg_xy(I,J) = MAX(Ah, Ah_vel_scale * grid_sp_q2 * sqrt(grid_sp_q2)) - if (Ah_time_scale>0.) CS%Ah_bg_xy(i,j) = & + if (Ah_time_scale > 0.) CS%Ah_bg_xy(i,j) = & MAX(CS%Ah_bg_xy(i,j), (grid_sp_q2 * grid_sp_q2) / Ah_time_scale) if (CS%bound_Ah .and. .not.CS%better_bound_Ah) then CS%Ah_Max_xy(I,J) = Ah_Limit * (grid_sp_q2 * grid_sp_q2) @@ -2013,7 +2014,7 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS) max(G%IdxCv(i,J)*G%IareaCv(i,J), G%IdxCv(i,J-1)*G%IareaCv(i,J-1)) ) ) CS%Kh_Max_xx(i,j) = 0.0 if (denom > 0.0) & - CS%Kh_Max_xx(i,j) = CS%bound_coef * 0.25 * Idt / denom + CS%Kh_Max_xx(i,j) = CS%bound_coef * 0.25 * US%T_to_s*Idt / denom enddo ; enddo do J=js-1,Jeq ; do I=is-1,Ieq denom = max( & @@ -2023,7 +2024,7 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS) max(G%IdyCv(i,J)*G%IareaCv(i,J), G%IdyCv(i+1,J)*G%IareaCv(i+1,J)) ) ) CS%Kh_Max_xy(I,J) = 0.0 if (denom > 0.0) & - CS%Kh_Max_xy(I,J) = CS%bound_coef * 0.25 * Idt / denom + CS%Kh_Max_xy(I,J) = CS%bound_coef * 0.25 * US%T_to_s*Idt / denom enddo ; enddo endif @@ -2066,7 +2067,7 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS) max(G%IdxCv(i,J)*G%IareaCv(i,J), G%IdxCv(i,J-1)*G%IareaCv(i,J-1)) ) ) CS%Ah_Max_xx(I,J) = 0.0 if (denom > 0.0) & - CS%Ah_Max_xx(I,J) = CS%bound_coef * 0.5 * Idt / denom + CS%Ah_Max_xx(I,J) = CS%bound_coef * 0.5 * US%T_to_s*Idt / denom enddo ; enddo do J=js-1,Jeq ; do I=is-1,Ieq @@ -2081,7 +2082,7 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS) max(G%IdyCv(i,J)*G%IareaCv(i,J), G%IdyCv(i+1,J)*G%IareaCv(i+1,J)) ) ) CS%Ah_Max_xy(I,J) = 0.0 if (denom > 0.0) & - CS%Ah_Max_xy(I,J) = CS%bound_coef * 0.5 * Idt / denom + CS%Ah_Max_xy(I,J) = CS%bound_coef * 0.5 * US%T_to_s*Idt / denom enddo ; enddo endif @@ -2095,24 +2096,24 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS) if (CS%biharmonic) then CS%id_Ah_h = register_diag_field('ocean_model', 'Ahh', diag%axesTL, Time, & - 'Biharmonic Horizontal Viscosity at h Points', 'm4 s-1', & + 'Biharmonic Horizontal Viscosity at h Points', 'm4 s-1', conversion=US%s_to_T, & cmor_field_name='difmxybo', & cmor_long_name='Ocean lateral biharmonic viscosity', & cmor_standard_name='ocean_momentum_xy_biharmonic_diffusivity') CS%id_Ah_q = register_diag_field('ocean_model', 'Ahq', diag%axesBL, Time, & - 'Biharmonic Horizontal Viscosity at q Points', 'm4 s-1') + 'Biharmonic Horizontal Viscosity at q Points', 'm4 s-1', conversion=US%s_to_T) endif if (CS%Laplacian) then CS%id_Kh_h = register_diag_field('ocean_model', 'Khh', diag%axesTL, Time, & - 'Laplacian Horizontal Viscosity at h Points', 'm2 s-1', & + 'Laplacian Horizontal Viscosity at h Points', 'm2 s-1', conversion=US%s_to_T, & cmor_field_name='difmxylo', & cmor_long_name='Ocean lateral Laplacian viscosity', & cmor_standard_name='ocean_momentum_xy_laplacian_diffusivity') CS%id_Kh_q = register_diag_field('ocean_model', 'Khq', diag%axesBL, Time, & - 'Laplacian Horizontal Viscosity at q Points', 'm2 s-1') + 'Laplacian Horizontal Viscosity at q Points', 'm2 s-1', conversion=US%s_to_T) if (CS%Leith_Kh) then CS%id_vort_xy_q = register_diag_field('ocean_model', 'vort_xy_q', diag%axesBL, Time, & From 1a6243458cf8a8cae1feee2479d685dc0cec8533 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Wed, 17 Jul 2019 06:17:37 -0400 Subject: [PATCH 120/150] Changed the timestep units to [T} in hor_visc_init Changed the units of the timestep to [T} in hor_visc_init and of vert_vort_mag to [T-1 m-1] in horizontal_viscosity. Also added a variant of the grad_vel_mag_h calculation with parentheses for rotational symmetry when answers_2018 = False. Changed the marks around suggestions for correcting issues with the recently added GME code to #GME# to help in finding them. All answers are bitwise identical. --- .../lateral/MOM_hor_visc.F90 | 157 +++++++++--------- 1 file changed, 83 insertions(+), 74 deletions(-) diff --git a/src/parameterizations/lateral/MOM_hor_visc.F90 b/src/parameterizations/lateral/MOM_hor_visc.F90 index 02773a7da7..14f505fc66 100644 --- a/src/parameterizations/lateral/MOM_hor_visc.F90 +++ b/src/parameterizations/lateral/MOM_hor_visc.F90 @@ -242,7 +242,8 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, sh_xx_bt, & ! barotropic horizontal tension (du/dx - dv/dy) including metric terms [s-1] str_xx,& ! str_xx is the diagonal term in the stress tensor [H m2 s-1 T-1 ~> m3 s-2 or kg s-2] str_xx_GME,& ! smoothed diagonal term in the stress tensor from GME [H m2 s-1 T-1 ~> m3 s-2 or kg s-2] - bhstr_xx,& ! A copy of str_xx that only contains the biharmonic contribution [H m2 T-1 s-1 ~> m3 s-2 or kg s-2] + bhstr_xx,& ! A copy of str_xx that only contains the biharmonic contribution + ! [H m2 T-1 s-1 ~> m3 s-2 or kg s-2] FrictWorkIntz, & ! depth integrated energy dissipated by lateral friction [W m-2] Leith_Kh_h, & ! Leith Laplacian viscosity at h-points [m2 s-1] Leith_Ah_h, & ! Leith bi-harmonic viscosity at h-points [m4 s-1] @@ -264,7 +265,8 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, sh_xy_bt, & ! barotropic horizontal shearing strain (du/dy + dv/dx) inc. metric terms [s-1] str_xy, & ! str_xy is the cross term in the stress tensor [H m2 s-2 ~> m3 s-2 or kg s-2] str_xy_GME, & ! smoothed cross term in the stress tensor from GME [H m2 s-2] - bhstr_xy, & ! A copy of str_xy that only contains the biharmonic contribution [H m2 s-2 ~> m3 s-2 or kg s-2] + bhstr_xy, & ! A copy of str_xy that only contains the biharmonic contribution + ! [H m2 s-2 ~> m3 s-2 or kg s-2] vort_xy, & ! Vertical vorticity (dv/dx - du/dy) including metric terms [s-1] Leith_Kh_q, & ! Leith Laplacian viscosity at q-points [m2 s-1] Leith_Ah_q, & ! Leith bi-harmonic viscosity at q-points [m4 s-1] @@ -273,8 +275,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 [H ~> m or kg m-2] - ! 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)) :: & @@ -290,13 +292,13 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: & Ah_h, & ! biharmonic viscosity at thickness points [m4 T-1 ~> m4 s-1] Kh_h, & ! Laplacian viscosity at thickness points [m2 T-1 ~> m2 s-1] - diss_rate, & ! MKE dissipated by parameterized shear production [m2 s-3] + diss_rate, & ! MKE dissipated by parameterized shear production [m2 s-3] max_diss_rate, & ! maximum possible energy dissipated by lateral friction [m2 s-3] target_diss_rate_GME, & ! the maximum theoretical dissipation plus the amount spuriously dissipated ! by friction [m2 s-3] FrictWork, & ! work done by MKE dissipation mechanisms [W m-2] - FrictWork_diss, & ! negative definite work done by MKE dissipation mechanisms [W m-2] - FrictWorkMax, & ! maximum possible work done by MKE dissipation mechanisms [W m-2] + FrictWork_diss, & ! negative definite work done by MKE dissipation mechanisms [W m-2] + FrictWorkMax, & ! maximum possible work done by MKE dissipation mechanisms [W m-2] FrictWork_GME, & ! work done by GME [W m-2] div_xx_h ! horizontal divergence [s-1] !real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1) :: & @@ -313,7 +315,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, ! viscosity. Here set equal to nondimensional Laplacian Leith constant. ! This is set equal to zero if modified Leith is not used. real :: Shear_mag ! magnitude of the shear [T-1 ~> s-1] - real :: vert_vort_mag ! magnitude of the vertical vorticity gradient [m-1 s-1] + real :: vert_vort_mag ! magnitude of the vertical vorticity gradient [m-1 T-1 ~> m-1 s-1] real :: h2uq, h2vq ! temporary variables [H2 ~> m2 or kg2 m-4]. real :: hu, hv ! Thicknesses interpolated by arithmetic means to corner ! points; these are first interpolated to u or v velocity @@ -336,7 +338,8 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, real :: GME_coeff ! The GME (negative) viscosity coefficient [m2 s-1] real :: GME_coeff_limiter ! Maximum permitted value of the GME coefficient [m2 s-1] real :: FWfrac ! Fraction of maximum theoretical energy transfer to use when scaling GME coefficient [nondim] - real :: DY_dxBu, DX_dyBu + real :: DY_dxBu ! Ratio of meridional over zonal grid spacing at vertices [nondim] + real :: DX_dyBu ! Ratio of zonal over meridiononal grid spacing at vertices [nondim] real :: Sh_F_pow ! The ratio of shear over the absolute value of f raised to some power and rescaled [nondim] real :: backscat_subround ! The ratio of f over Shear_mag that is so small that the backscatter ! calculation gives the same value as if f were 0 [nondim]. @@ -371,7 +374,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, if (.not.(CS%Laplacian .or. CS%biharmonic)) return find_FrictWork = (CS%id_FrictWork > 0) - if (CS%id_FrictWorkIntz > 0) find_FrictWork = .true. + if (CS%id_FrictWorkIntz > 0) find_FrictWork = .true. if (associated(MEKE)) then if (associated(MEKE%mom_src)) find_FrictWork = .true. backscat_subround = 0.0 @@ -417,7 +420,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, call barotropic_get_tav(BT, ubtav, vbtav, G) call pass_vector(ubtav, vbtav, G%Domain) - !### The following loop range should be: do j=js-1,je+1 ; do i=is-1,ie+1 + !#GME# The following loop range should be: do j=js-1,je+1 ; do i=is-1,ie+1 do j=js,je ; do i=is,ie dudx_bt(i,j) = CS%DY_dxT(i,j)*(G%IdyCu(I,j) * ubtav(I,j) - & G%IdyCu(I-1,j) * ubtav(I-1,j)) @@ -425,12 +428,12 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, G%IdxCv(i,J-1) * vbtav(i,J-1)) enddo; enddo - !### These should be combined into a vactor pass + !#GME# These should be combined into a vactor pass call pass_var(dudx_bt, G%Domain, complete=.true.) call pass_var(dvdy_bt, G%Domain, complete=.true.) - !### These loop bounds should be: - !### do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 + !#GME# These loop bounds should be: + !#GME# do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 do j=Jsq-1,Jeq+2 ; do i=Isq-1,Ieq+2 sh_xx_bt(i,j) = dudx_bt(i,j) - dvdy_bt(i,j) enddo ; enddo @@ -443,19 +446,19 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, - ubtav(I,j)*G%IdxCu(I,j)) enddo ; enddo - !### These should be combined into a vactor pass + !#GME# These should be combined into a vactor pass call pass_var(dvdx_bt, G%Domain, position=CORNER, complete=.true.) call pass_var(dudy_bt, G%Domain, position=CORNER, complete=.true.) if (CS%no_slip) then - !### These loop bounds should be - !### do J=js-1,Jeq ; do I=is-1,Ieq + !#GME# These loop bounds should be + !#GME# do J=js-1,Jeq ; do I=is-1,Ieq do J=js-2,Jeq+1 ; do I=is-2,Ieq+1 sh_xy_bt(I,J) = (2.0-G%mask2dBu(I,J)) * ( dvdx_bt(I,J) + dudy_bt(I,J) ) enddo ; enddo else - !### These loop bounds should be - !### do J=js-1,Jeq ; do I=is-1,Ieq + !#GME# These loop bounds should be + !#GME# do J=js-1,Jeq ; do I=is-1,Ieq do J=js-2,Jeq+1 ; do I=is-2,Ieq+1 sh_xy_bt(I,J) = G%mask2dBu(I,J) * ( dvdx_bt(I,J) + dudy_bt(I,J) ) enddo ; enddo @@ -464,26 +467,26 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, ! Get thickness diffusivity for use in GME ! call thickness_diffuse_get_KH(thickness_diffuse, KH_u_GME, KH_v_GME, G) - !### These loops bounds should probably be: do j=js-1,je+1 ; do i=is-1,is+1 - !### Group the 4-point sums so they are rotationally invariant.` + !#GME# These loops bounds should probably be: do j=js-1,je+1 ; do i=is-1,is+1 + !#GME# Group the 4-point sums so they are rotationally invariant.` do j=Jsq-1,Jeq+2 ; do i=Isq-1,Ieq+2 grad_vel_mag_bt_h(i,j) = boundary_mask(i,j) * (dudx_bt(i,j)**2 + dvdy_bt(i,j)**2 + & (0.25*(dvdx_bt(I,J)+dvdx_bt(I-1,J)+dvdx_bt(I,J-1)+dvdx_bt(I-1,J-1)) )**2 + & (0.25*(dudy_bt(I,J)+dudy_bt(I-1,J)+dudy_bt(I,J-1)+dudy_bt(I-1,J-1)) )**2) enddo ; enddo - !### max_diss_rate_bt is not used. + !#GME# max_diss_rate_bt is not used. if (associated(MEKE)) then ; if (associated(MEKE%mom_src)) then - !### These loops bounds should be: do j=js-1,je+1 ; do i=is-1,is+1 + !#GME# These loops bounds should be: do j=js-1,je+1 ; do i=is-1,is+1 do j=Jsq-1,Jeq+2 ; do i=Isq-1,Ieq+2 max_diss_rate_bt(i,j) = 2.0*MEKE%MEKE(i,j) * grad_vel_mag_bt_h(i,j) enddo ; enddo endif ; endif - !### boundary_mask is defined at h points, not q points as used here. - !### boundary_mask has only been defined over the range is:ie, js:je. - !### Group the 4-point sums so they are rotationally invariant.` - !### The following loop range should be: do J=js-1,Jeq ; do I=is-1,Ieq + !#GME# boundary_mask is defined at h points, not q points as used here. + !#GME# boundary_mask has only been defined over the range is:ie, js:je. + !#GME# Group the 4-point sums so they are rotationally invariant.` + !#GME# The following loop range should be: do J=js-1,Jeq ; do I=is-1,Ieq do J=js-2,Jeq+1 ; do I=is-2,Ieq+1 grad_vel_mag_bt_q(I,J) = boundary_mask(i,j) * (dvdx_bt(I,J)**2 + dudy_bt(I,J)**2 + & (0.25*(dudx_bt(i,j)+dudx_bt(i+1,j)+dudx_bt(i,j+1)+dudx_bt(i+1,j+1)))**2 + & @@ -746,30 +749,31 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, (h(i,j,k) + GV%H_subroundoff) enddo ; enddo - !### Adding so many halo updates will make this code very slow! - !### With the correct index range, this halo update is unnecessary. + !#GME# Adding so many halo updates will make this code very slow! + !#GME# With the correct index range, this halo update is unnecessary. call pass_var(div_xx, G%Domain, complete=.true.) ! Divergence gradient - !### This index range should be: do j=Jsq,Jeq+1 ; do I=Isq-1,Ieq+1 + !#GME# This index range should be: do j=Jsq,Jeq+1 ; do I=Isq-1,Ieq+1 do j=Jsq-1,Jeq+2 ; do I=is-2,Ieq+1 div_xx_dx(I,j) = G%IdxCu(I,j)*(div_xx(i+1,j) - div_xx(i,j)) enddo ; enddo - !### This index range should be: do j=Jsq-1,Jeq+1 ; do i=Isq,Ieq+1 + !#GME# This index range should be: do j=Jsq-1,Jeq+1 ; do i=Isq,Ieq+1 do J=js-2,Jeq+1 ; do i=Isq-1,Ieq+2 div_xx_dy(i,J) = G%IdyCv(i,J)*(div_xx(i,j+1) - div_xx(i,j)) enddo ; enddo + !#GME# With the correct index ranges, this halo update is unnecessary. call pass_vector(div_xx_dx, div_xx_dy, G%Domain) ! Magnitude of divergence gradient ! Why use the magnitude of the average instead of the average magnitude? - !### This index range should be: do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 + !#GME# This index range should be: do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 do j=Jsq-1,Jeq+2 ; do i=Isq-1,Ieq+2 grad_div_mag_h(i,j) = sqrt((0.5*(div_xx_dx(I,j) + div_xx_dx(I-1,j)))**2 + & (0.5*(div_xx_dy(i,J) + div_xx_dy(i,J-1)))**2) enddo ; enddo - !### This index range should be: do J=js-1,Jeq ; do I=is-1,Ieq + !#GME# This index range should be: do J=js-1,Jeq ; do I=is-1,Ieq do J=js-2,Jeq+1 ; do I=is-2,Ieq+1 grad_div_mag_q(I,J) = sqrt((0.5*(div_xx_dx(I,j) + div_xx_dx(I,j+1)))**2 + & (0.5*(div_xx_dy(i,J) + div_xx_dy(i+1,J)))**2) @@ -783,11 +787,11 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, do J=js-2,Jeq+1 ; do i=Isq-1,Ieq+2 div_xx_dy(i,J) = 0.0 enddo ; enddo - !### This index range should be: do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 + !#GME# This index range should be: do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 do j=Jsq-1,Jeq+2 ; do i=Isq-1,Ieq+2 grad_div_mag_h(i,j) = 0.0 enddo ; enddo - !### This index range should be: do J=js-1,Jeq ; do I=is-1,Ieq + !#GME# This index range should be: do J=js-1,Jeq ; do I=is-1,Ieq do J=js-2,Jeq+1 ; do I=is-2,Ieq+1 grad_div_mag_q(I,J) = 0.0 enddo ; enddo @@ -796,7 +800,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, ! Add in beta for the Leith viscosity if (CS%use_beta_in_Leith) then - !### beta_h and beta_q are never used. + !#GME# beta_h and beta_q are never used. do j=Jsq-1,Jeq+2 ; do i=Isq-1,Ieq+2 beta_h(i,j) = sqrt( G%dF_dx(i,j)**2 + G%dF_dy(i,j)**2 ) enddo; enddo @@ -815,12 +819,12 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, if (CS%use_QG_Leith_visc) then - !### This should be do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 + !#GME# This should be do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 do j=Jsq-1,Jeq+2 ; do i=Isq-1,Ieq+2 grad_vort_mag_h_2d(i,j) = SQRT((0.5*(vort_xy_dx(i,J) + vort_xy_dx(i,J-1)))**2 + & (0.5*(vort_xy_dy(I,j) + vort_xy_dy(I-1,j)))**2 ) enddo ; enddo - !### This index range should be: do J=js-1,Jeq ; do I=is-1,Ieq + !#GME# This index range should be: do J=js-1,Jeq ; do I=is-1,Ieq do J=js-2,Jeq+1 ; do I=is-2,Ieq+1 grad_vort_mag_q_2d(I,J) = SQRT((0.5*(vort_xy_dx(i,J) + vort_xy_dx(i+1,J)))**2 + & (0.5*(vort_xy_dy(I,j) + vort_xy_dy(I,j+1)))**2 ) @@ -831,12 +835,12 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, endif - !### This should be do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 + !#GME# This should be do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 do j=Jsq-1,Jeq+2 ; do i=Isq-1,Ieq+2 grad_vort_mag_h(i,j) = SQRT((0.5*(vort_xy_dx(i,J) + vort_xy_dx(i,J-1)))**2 + & (0.5*(vort_xy_dy(I,j) + vort_xy_dy(I-1,j)))**2 ) enddo ; enddo - !### This index range should be: do J=js-1,Jeq ; do I=is-1,Ieq + !#GME# This index range should be: do J=js-1,Jeq ; do I=is-1,Ieq do J=js-2,Jeq+1 ; do I=is-2,Ieq+1 grad_vort_mag_q(I,J) = SQRT((0.5*(vort_xy_dx(i,J) + vort_xy_dx(i+1,J)))**2 + & (0.5*(vort_xy_dy(I,j) + vort_xy_dy(I,j+1)))**2 ) @@ -854,9 +858,9 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, endif if ((CS%Leith_Kh) .or. (CS%Leith_Ah)) then if (CS%use_QG_Leith_visc) then - vert_vort_mag = MIN(grad_vort_mag_h(i,j) + grad_div_mag_h(i,j),3*grad_vort_mag_h_2d(i,j)) + vert_vort_mag = US%T_to_s*MIN(grad_vort_mag_h(i,j) + grad_div_mag_h(i,j),3*grad_vort_mag_h_2d(i,j)) else - vert_vort_mag = grad_vort_mag_h(i,j) + grad_div_mag_h(i,j) + vert_vort_mag = US%T_to_s*(grad_vort_mag_h(i,j) + grad_div_mag_h(i,j)) endif endif if (CS%better_bound_Ah .or. CS%better_bound_Kh) then @@ -870,14 +874,15 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, ! largest value from several parameterizations. Kh = CS%Kh_bg_xx(i,j) ! Static (pre-computed) background viscosity if (CS%Smagorinsky_Kh) Kh = max( Kh, CS%Laplac2_const_xx(i,j) * Shear_mag ) - if (CS%Leith_Kh) Kh = max( Kh, CS%Laplac3_const_xx(i,j) * US%T_to_s*vert_vort_mag*inv_PI3) + if (CS%Leith_Kh) Kh = max( Kh, CS%Laplac3_const_xx(i,j) * vert_vort_mag*inv_PI3) ! All viscosity contributions above are subject to resolution scaling if (rescale_Kh) Kh = VarMix%Res_fn_h(i,j) * Kh if (CS%res_scale_MEKE) meke_res_fn = VarMix%Res_fn_h(i,j) ! Older method of bounding for stability if (legacy_bound) Kh = min(Kh, CS%Kh_Max_xx(i,j)) Kh = max( Kh, CS%Kh_bg_min ) ! Place a floor on the viscosity, if desired. - if (use_MEKE_Ku) Kh = Kh + US%T_to_s*MEKE%Ku(i,j) * meke_res_fn ! *Add* the MEKE contribution (might be negative) + if (use_MEKE_Ku) & + Kh = Kh + US%T_to_s*MEKE%Ku(i,j) * meke_res_fn ! *Add* the MEKE contribution (might be negative) if (CS%anisotropic) Kh = Kh + CS%Kh_aniso * ( 1. - CS%n1n2_h(i,j)**2 ) ! *Add* the tension component ! of anisotropic viscosity @@ -920,7 +925,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, AhSm = CS%Biharm_const_xx(i,j) * Shear_mag endif endif - if (CS%Leith_Ah) AhLth = CS%biharm5_const_xx(i,j) * US%T_to_s*vert_vort_mag * inv_PI5 + if (CS%Leith_Ah) AhLth = CS%biharm5_const_xx(i,j) * vert_vort_mag * inv_PI5 Ah = MAX(MAX(CS%Ah_bg_xx(i,j), AhSm), AhLth) if (CS%bound_Ah .and. .not.CS%better_bound_Ah) & Ah = MIN(Ah, CS%Ah_Max_xx(i,j)) @@ -991,9 +996,9 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, endif if ((CS%Leith_Kh) .or. (CS%Leith_Ah)) then if (CS%use_QG_Leith_visc) then - vert_vort_mag = MIN(grad_vort_mag_q(I,J) + grad_div_mag_q(I,J), 3*grad_vort_mag_q_2d(I,J)) + vert_vort_mag = US%T_to_s*MIN(grad_vort_mag_q(I,J) + grad_div_mag_q(I,J), 3*grad_vort_mag_q_2d(I,J)) else - vert_vort_mag = grad_vort_mag_q(I,J) + grad_div_mag_q(I,J) + vert_vort_mag = US%T_to_s*(grad_vort_mag_q(I,J) + grad_div_mag_q(I,J)) endif endif h2uq = 4.0 * h_u(I,j) * h_u(I,j+1) @@ -1032,7 +1037,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, ! largest value from several parameterizations. Kh = CS%Kh_bg_xy(i,j) ! Static (pre-computed) background viscosity if (CS%Smagorinsky_Kh) Kh = max( Kh, CS%Laplac2_const_xy(I,J) * Shear_mag ) - if (CS%Leith_Kh) Kh = max( Kh, CS%Laplac3_const_xy(I,J) * US%T_to_s*vert_vort_mag*inv_PI3) + if (CS%Leith_Kh) Kh = max( Kh, CS%Laplac3_const_xy(I,J) * vert_vort_mag*inv_PI3) ! All viscosity contributions above are subject to resolution scaling if (rescale_Kh) Kh = VarMix%Res_fn_q(i,j) * Kh if (CS%res_scale_MEKE) meke_res_fn = VarMix%Res_fn_q(i,j) @@ -1086,7 +1091,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, AhSm = CS%Biharm_const_xy(I,J) * Shear_mag endif endif - if (CS%Leith_Ah) AhLth = CS%Biharm5_const_xy(I,J) * US%T_to_s*vert_vort_mag * inv_PI5 + if (CS%Leith_Ah) AhLth = CS%Biharm5_const_xy(I,J) * vert_vort_mag * inv_PI5 Ah = MAX(MAX(CS%Ah_bg_xy(I,J), AhSm), AhLth) if (CS%bound_Ah .and. .not.CS%better_bound_Ah) & Ah = MIN(Ah, CS%Ah_Max_xy(I,J)) @@ -1117,20 +1122,24 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, if (find_FrictWork) then + !### I suspect that this halo update is not needed. if (CS%biharmonic) call pass_vector(u0, v0, G%Domain) - !### These should be a vactor pass - !### Adding so many halo updates will make this code very slow! - call pass_var(dudx, G%Domain, complete=.true.) - call pass_var(dvdy, G%Domain, complete=.true.) - call pass_var(dvdx, G%Domain, position=CORNER, complete=.true.) - call pass_var(dudy, G%Domain, position=CORNER, complete=.true.) + !#GME# Group the 4-point sums so they are rotationally invariant.` if (CS%Laplacian) then - do j=js,je ; do i=is,ie - grad_vel_mag_h(i,j) = boundary_mask(i,j) * (dudx(i,j)**2 + dvdy(i,j)**2 + & - (0.25*(dvdx(I,J)+dvdx(I-1,J)+dvdx(I,J-1)+dvdx(I-1,J-1)) )**2 + & - (0.25*(dudy(I,J)+dudy(I-1,J)+dudy(I,J-1)+dudy(I-1,J-1)) )**2) - enddo ; enddo + if (CS%answers_2018) then + do j=js,je ; do i=is,ie + grad_vel_mag_h(i,j) = boundary_mask(i,j) * (dudx(i,j)**2 + dvdy(i,j)**2 + & + (0.25*(dvdx(I,J)+dvdx(I-1,J)+dvdx(I,J-1)+dvdx(I-1,J-1)) )**2 + & + (0.25*(dudy(I,J)+dudy(I-1,J)+dudy(I,J-1)+dudy(I-1,J-1)) )**2) + enddo ; enddo + else + do j=js,je ; do i=is,ie + grad_vel_mag_h(i,j) = boundary_mask(i,j) * ((dudx(i,j)**2 + dvdy(i,j)**2) + & + ((0.25*((dvdx(I,J) + dvdx(I-1,J-1)) + (dvdx(I-1,J) + dvdx(I,J-1))) )**2 + & + (0.25*((dudy(I,J) + dudy(I-1,J-1)) + (dudy(I-1,J) + dudy(I,J-1))) )**2)) + enddo ; enddo + endif else do j=js,je ; do i=is,ie grad_vel_mag_h(i,j) = 0.0 @@ -1140,7 +1149,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, if (CS%biharmonic) then do j=js,je ; do i=is,ie grad_d2vel_mag_h(i,j) = boundary_mask(i,j) * ((0.5*(u0(I,j) + u0(I-1,j)))**2 + & - (0.5*(v0(i,J) + v0(i,J-1)))**2) + (0.5*(v0(i,J) + v0(i,J-1)))**2) enddo ; enddo else do j=js,je ; do i=is,ie @@ -1175,7 +1184,6 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, enddo ; enddo endif - if (CS%use_GME) then if (.not. (associated(MEKE))) call MOM_error(FATAL, "MEKE must be enabled for GME to be used.") @@ -1201,13 +1209,13 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, do J=js-1,Jeq ; do I=is-1,Ieq GME_coeff = 0.0 if ((max_diss_rate(i,j,k) > 0) .and. (grad_vel_mag_bt_q(I,J)>0) ) then - !### target_diss_rate_GME and max_diss_rate are defined at h points, not q points as used here. + !#GME# target_diss_rate_GME and max_diss_rate are defined at h points, not q points as used here. GME_coeff = FWfrac*max_diss_rate(i,j,k) / grad_vel_mag_bt_q(I,J) ! GME_coeff = FWfrac*target_diss_rate_GME(i,j,k) / grad_vel_mag_bt_q(I,J) if ((G%bathyT(i,j) < H0_GME) .and. (H0_GME > 0.0)) & GME_coeff = (G%bathyT(i,j) / H0_GME)**2 * GME_coeff - !### boundary_mask is defined at h points, not q points as used here. + !#GME# boundary_mask is defined at h points, not q points as used here. ! apply mask and limiter GME_coeff = MIN(GME_coeff * boundary_mask(i,j), GME_coeff_limiter) endif @@ -1439,7 +1447,8 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS) ! grid spacing, to limit Laplacian viscosity. real :: fmax ! maximum absolute value of f at the four ! vorticity points around a thickness point [T-1 ~> s-1] - real :: BoundCorConst ! A constant used when using viscosity to bound the Coriolis accelerations [T2 L-2 ~> s2 m-2] + real :: BoundCorConst ! A constant used when using viscosity to bound the Coriolis accelerations + ! [T2 L-2 ~> s2 m-2] real :: Ah_Limit ! coefficient [T-1 ~> s-1] used, along with the ! grid spacing, to limit biharmonic viscosity real :: Kh ! Lapacian horizontal viscosity [m2 s-1] @@ -1451,8 +1460,8 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS) real :: Smag_bi_const ! nondimensional biharmonic Smagorinsky constant real :: Leith_Lap_const ! nondimensional Laplacian Leith constant real :: Leith_bi_const ! nondimensional biharmonic Leith constant - real :: dt ! dynamics time step [s] - real :: Idt ! inverse of dt [s-1] + real :: dt ! The dynamics time step [T ~> s] + real :: Idt ! The inverse of dt [T-1 ~> s-1] real :: denom ! work variable; the denominator of a fraction real :: maxvel ! largest permitted velocity components [m s-1] real :: bound_Cor_vel ! grid-scale velocity variations at which value @@ -1733,7 +1742,7 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS) if (CS%bound_Kh .or. CS%bound_Ah .or. CS%better_bound_Kh .or. CS%better_bound_Ah) & call get_param(param_file, mdl, "DT", dt, & - "The (baroclinic) dynamics time step.", units="s", & + "The (baroclinic) dynamics time step.", units="s", scale=US%s_to_T, & fail_if_missing=.true.) if (CS%no_slip .and. CS%biharmonic) & @@ -1881,7 +1890,7 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS) if (CS%Laplacian) then ! The 0.3 below was 0.4 in MOM1.10. The change in hq requires ! this to be less than 1/3, rather than 1/2 as before. - if (CS%bound_Kh .or. CS%bound_Ah) Kh_Limit = 0.3 / (US%s_to_T*dt*4.0) + if (CS%bound_Kh .or. CS%bound_Ah) Kh_Limit = 0.3 / (dt*4.0) ! Calculate and store the background viscosity at h-points do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 @@ -1951,7 +1960,7 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS) CS%Ah_bg_xy(:,:) = 0.0 ! The 0.3 below was 0.4 in MOM1.10. The change in hq requires ! this to be less than 1/3, rather than 1/2 as before. - if (CS%better_bound_Ah .or. CS%bound_Ah) Ah_Limit = 0.3 / (US%s_to_T*dt*64.0) + if (CS%better_bound_Ah .or. CS%bound_Ah) Ah_Limit = 0.3 / (dt*64.0) if (CS%Smagorinsky_Ah .and. CS%bound_Coriolis) & BoundCorConst = 1.0 / (5.0*(bound_Cor_vel*bound_Cor_vel)) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 @@ -2014,7 +2023,7 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS) max(G%IdxCv(i,J)*G%IareaCv(i,J), G%IdxCv(i,J-1)*G%IareaCv(i,J-1)) ) ) CS%Kh_Max_xx(i,j) = 0.0 if (denom > 0.0) & - CS%Kh_Max_xx(i,j) = CS%bound_coef * 0.25 * US%T_to_s*Idt / denom + CS%Kh_Max_xx(i,j) = CS%bound_coef * 0.25 * Idt / denom enddo ; enddo do J=js-1,Jeq ; do I=is-1,Ieq denom = max( & @@ -2024,7 +2033,7 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS) max(G%IdyCv(i,J)*G%IareaCv(i,J), G%IdyCv(i+1,J)*G%IareaCv(i+1,J)) ) ) CS%Kh_Max_xy(I,J) = 0.0 if (denom > 0.0) & - CS%Kh_Max_xy(I,J) = CS%bound_coef * 0.25 * US%T_to_s*Idt / denom + CS%Kh_Max_xy(I,J) = CS%bound_coef * 0.25 * Idt / denom enddo ; enddo endif @@ -2067,7 +2076,7 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS) max(G%IdxCv(i,J)*G%IareaCv(i,J), G%IdxCv(i,J-1)*G%IareaCv(i,J-1)) ) ) CS%Ah_Max_xx(I,J) = 0.0 if (denom > 0.0) & - CS%Ah_Max_xx(I,J) = CS%bound_coef * 0.5 * US%T_to_s*Idt / denom + CS%Ah_Max_xx(I,J) = CS%bound_coef * 0.5 * Idt / denom enddo ; enddo do J=js-1,Jeq ; do I=is-1,Ieq @@ -2082,7 +2091,7 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS) max(G%IdyCv(i,J)*G%IareaCv(i,J), G%IdyCv(i+1,J)*G%IareaCv(i+1,J)) ) ) CS%Ah_Max_xy(I,J) = 0.0 if (denom > 0.0) & - CS%Ah_Max_xy(I,J) = CS%bound_coef * 0.5 * US%T_to_s*Idt / denom + CS%Ah_Max_xy(I,J) = CS%bound_coef * 0.5 * Idt / denom enddo ; enddo endif From 94dc2eb405eb873038e2386b84a7b114f86c7af2 Mon Sep 17 00:00:00 2001 From: matthew harrison Date: Wed, 17 Jul 2019 11:02:09 -0400 Subject: [PATCH 121/150] fix indexing error for salt OBC reservoir --- src/core/MOM_open_boundary.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/core/MOM_open_boundary.F90 b/src/core/MOM_open_boundary.F90 index 5624167170..b6068f4596 100644 --- a/src/core/MOM_open_boundary.F90 +++ b/src/core/MOM_open_boundary.F90 @@ -3389,12 +3389,12 @@ subroutine update_OBC_segment_data(G, GV, OBC, tv, h, Time) do k=1,nz; do j=js_obc2, je_obc; do i=is_obc2,ie_obc segment%tr_Reg%Tr(2)%t(i,j,k) = segment%field(m)%buffer_dst(i,j,k) enddo ; enddo ; enddo - if (.not. segment%tr_Reg%Tr(1)%is_initialized) then + if (.not. segment%tr_Reg%Tr(2)%is_initialized) then !if the tracer reservoir has not yet been initialized, then set to external value. do k=1,nz; do j=js_obc2, je_obc; do i=is_obc2,ie_obc segment%tr_Reg%Tr(2)%tres(i,j,k) = segment%tr_Reg%Tr(2)%t(i,j,k) enddo ; enddo ; enddo - segment%tr_Reg%Tr(1)%is_initialized=.true. + segment%tr_Reg%Tr(2)%is_initialized=.true. endif else segment%tr_Reg%Tr(2)%OBC_inflow_conc = segment%field(m)%value From ee369fb8eea472842de977bfc411472746645877 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Wed, 17 Jul 2019 11:24:23 -0400 Subject: [PATCH 122/150] +Changed the units of MEKE%Ku [m2 T-1] Changed the units of MEKE%Ku and MEKE%Au to [m2 T-1], including adding code to allow for the dimensional scaling to change across restarts and moving the halo updates on any MEKE variables read from restart files to the end of MEKE_init. Also change the units of GME_coeff in horizontal_viscosity to [m2 T-1]. This also required adding a unit_scale_type argument to MEKE_init. All answers are bitwise identical, but the units for some variables in a publicly visible type have changed. --- src/core/MOM.F90 | 2 +- src/parameterizations/lateral/MOM_MEKE.F90 | 106 +++++++++++------- .../lateral/MOM_MEKE_types.F90 | 12 +- .../lateral/MOM_hor_visc.F90 | 59 +++++----- 4 files changed, 102 insertions(+), 77 deletions(-) diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index dd521b8eef..c3e930e863 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -2281,7 +2281,7 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & call cpu_clock_end(id_clock_MOM_init) call callTree_waypoint("ALE initialized (initialize_MOM)") - CS%useMEKE = MEKE_init(Time, G, param_file, diag, CS%MEKE_CSp, CS%MEKE, restart_CSp) + CS%useMEKE = MEKE_init(Time, G, US, param_file, diag, CS%MEKE_CSp, CS%MEKE, restart_CSp) call VarMix_init(Time, G, GV, US, param_file, diag, CS%VarMix) call set_visc_init(Time, G, GV, US, param_file, diag, CS%visc, CS%set_visc_CSp, restart_CSp, CS%OBC) diff --git a/src/parameterizations/lateral/MOM_MEKE.F90 b/src/parameterizations/lateral/MOM_MEKE.F90 index 2027a7bc41..b7819ee710 100644 --- a/src/parameterizations/lateral/MOM_MEKE.F90 +++ b/src/parameterizations/lateral/MOM_MEKE.F90 @@ -562,13 +562,13 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h call cpu_clock_begin(CS%id_clock_pass) call do_group_pass(CS%pass_Kh, G%Domain) call cpu_clock_end(CS%id_clock_pass) - endif + endif endif ! Calculate viscosity for the main model to use if (CS%viscosity_coeff_Ku /=0.) then do j=js,je ; do i=is,ie - MEKE%Ku(i,j) = CS%viscosity_coeff_Ku*sqrt(2.*max(0.,MEKE%MEKE(i,j)))*LmixScale(i,j) + MEKE%Ku(i,j) = US%T_to_s*CS%viscosity_coeff_Ku*sqrt(2.*max(0.,MEKE%MEKE(i,j)))*LmixScale(i,j) enddo ; enddo call cpu_clock_begin(CS%id_clock_pass) call do_group_pass(CS%pass_Ku, G%Domain) @@ -577,7 +577,7 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h if (CS%viscosity_coeff_Au /=0.) then do j=js,je ; do i=is,ie - MEKE%Au(i,j) = CS%viscosity_coeff_Au*sqrt(2.*max(0.,MEKE%MEKE(i,j)))*LmixScale(i,j)**3 + MEKE%Au(i,j) = US%T_to_s*CS%viscosity_coeff_Au*sqrt(2.*max(0.,MEKE%MEKE(i,j)))*LmixScale(i,j)**3 enddo ; enddo call cpu_clock_begin(CS%id_clock_pass) call do_group_pass(CS%pass_Au, G%Domain) @@ -929,22 +929,26 @@ end subroutine MEKE_lengthScales_0d !> Initializes the MOM_MEKE module and reads parameters. !! Returns True if module is to be used, otherwise returns False. -logical function MEKE_init(Time, G, param_file, diag, CS, MEKE, restart_CS) +logical function MEKE_init(Time, G, US, param_file, diag, CS, MEKE, restart_CS) type(time_type), intent(in) :: Time !< The current model time. type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(param_file_type), intent(in) :: param_file !< Parameter file parser structure. type(diag_ctrl), target, intent(inout) :: diag !< Diagnostics structure. type(MEKE_CS), pointer :: CS !< MEKE control structure. type(MEKE_type), pointer :: MEKE !< MEKE-related fields. type(MOM_restart_CS), pointer :: restart_CS !< Restart control structure for MOM_MEKE. -! Local variables - integer :: is, ie, js, je, isd, ied, jsd, jed, nz + + ! Local variables + 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, is, ie, js, je, isd, ied, jsd, jed logical :: laplacian, biharmonic, useVarMix, coldStart -! 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_MEKE" ! This module's name. - 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 isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed ! Determine whether this module will be used @@ -1139,37 +1143,9 @@ logical function MEKE_init(Time, G, param_file, diag, CS, MEKE, restart_CS) ! Identify if any lateral diffusive processes are active CS%kh_flux_enabled = .false. - if (CS%MEKE_KH >= 0.0 & - .or. CS%KhMEKE_FAC > 0.0 & - .or. CS%MEKE_advection_factor >0.0) & + if ((CS%MEKE_KH >= 0.0) .or. (CS%KhMEKE_FAC > 0.0) .or. (CS%MEKE_advection_factor >0.0)) & CS%kh_flux_enabled = .true. -! In the case of a restart, these fields need a halo update - if (associated(MEKE%MEKE)) then - call create_group_pass(CS%pass_MEKE, MEKE%MEKE, G%Domain) - call do_group_pass(CS%pass_MEKE, G%Domain) - endif - if (associated(MEKE%Kh)) then - call create_group_pass(CS%pass_Kh, MEKE%Kh, G%Domain) - call do_group_pass(CS%pass_Kh, G%Domain) - endif - if (associated(MEKE%Kh_diff)) then - call create_group_pass(CS%pass_Kh_diff, MEKE%Kh_diff, G%Domain) - call do_group_pass(CS%pass_Kh_diff, G%Domain) - endif - if (associated(MEKE%Ku)) then - call create_group_pass(CS%pass_Ku, MEKE%Ku, G%Domain) - call do_group_pass(CS%pass_Ku, G%Domain) - endif - if (associated(MEKE%Au)) then - call create_group_pass(CS%pass_Au, MEKE%Au, G%Domain) - call do_group_pass(CS%pass_Au, G%Domain) - endif - if (allocated(CS%del2MEKE)) then - call create_group_pass(CS%pass_del2MEKE, CS%del2MEKE, G%Domain) - call do_group_pass(CS%pass_del2MEKE, G%Domain) - endif - ! Register fields for output from this module. CS%diag => diag CS%id_MEKE = register_diag_field('ocean_model', 'MEKE', diag%axesT1, Time, & @@ -1179,10 +1155,10 @@ logical function MEKE_init(Time, G, param_file, diag, CS, MEKE, restart_CS) 'MEKE derived diffusivity', 'm2 s-1') if (.not. associated(MEKE%Kh)) CS%id_Kh = -1 CS%id_Ku = register_diag_field('ocean_model', 'MEKE_KU', diag%axesT1, Time, & - 'MEKE derived lateral viscosity', 'm2 s-1') + 'MEKE derived lateral viscosity', 'm2 s-1', conversion=US%s_to_T) if (.not. associated(MEKE%Ku)) CS%id_Ku = -1 CS%id_Au = register_diag_field('ocean_model', 'MEKE_AU', diag%axesT1, Time, & - 'MEKE derived lateral biharmonic viscosity', 'm4 s-1') + 'MEKE derived lateral biharmonic viscosity', 'm4 s-1', conversion=US%s_to_T) if (.not. associated(MEKE%Au)) CS%id_Au = -1 CS%id_Ue = register_diag_field('ocean_model', 'MEKE_Ue', diag%axesT1, Time, & 'MEKE derived eddy-velocity scale', 'm s-1') @@ -1226,14 +1202,60 @@ logical function MEKE_init(Time, G, param_file, diag, CS, MEKE, restart_CS) CS%id_clock_pass = cpu_clock_id('(Ocean continuity halo updates)', grain=CLOCK_ROUTINE) - ! Detect whether this instant of MEKE_init() is at the beginning of a run + ! Detect whether this instance of MEKE_init() is at the beginning of a run ! or after a restart. If at the beginning, we will initialize MEKE to a local ! equilibrium. - CS%initialize = .not.query_initialized(MEKE%MEKE,"MEKE",restart_CS) + CS%initialize = .not.query_initialized(MEKE%MEKE, "MEKE", restart_CS) if (coldStart) CS%initialize = .false. if (CS%initialize) call MOM_error(WARNING, & "MEKE_init: Initializing MEKE with a local equilibrium balance.") + ! Account for possible changes in dimensional scaling for variables that have been + ! read from a restart file. + 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 + + if (I_T_rescale /= 1.0) then + if (associated(MEKE%Ku)) then ; if (query_initialized(MEKE%Ku, "MEKE_Ku", restart_CS)) then + do j=js,je ; do i=is,ie + MEKE%Ku(i,j) = I_T_rescale * MEKE%Ku(i,j) + enddo ; enddo + endif ; endif + if (associated(MEKE%Au)) then ; if (query_initialized(MEKE%Au, "MEKE_Au", restart_CS)) then + do j=js,je ; do i=is,ie + MEKE%Au(i,j) = I_T_rescale * MEKE%Au(i,j) + enddo ; enddo + endif ; endif + endif + + ! Set up group passes. In the case of a restart, these fields need a halo update now. + !### At least 4 of these group passes can be combined. + if (associated(MEKE%MEKE)) then + call create_group_pass(CS%pass_MEKE, MEKE%MEKE, G%Domain) + if (.not.CS%initialize) call do_group_pass(CS%pass_MEKE, G%Domain) + endif + if (associated(MEKE%Kh)) then + call create_group_pass(CS%pass_Kh, MEKE%Kh, G%Domain) + call do_group_pass(CS%pass_Kh, G%Domain) + endif + if (associated(MEKE%Kh_diff)) then + call create_group_pass(CS%pass_Kh_diff, MEKE%Kh_diff, G%Domain) + call do_group_pass(CS%pass_Kh_diff, G%Domain) + endif + if (associated(MEKE%Ku)) then + call create_group_pass(CS%pass_Ku, MEKE%Ku, G%Domain) + call do_group_pass(CS%pass_Ku, G%Domain) + endif + if (associated(MEKE%Au)) then + call create_group_pass(CS%pass_Au, MEKE%Au, G%Domain) + call do_group_pass(CS%pass_Au, G%Domain) + endif + if (allocated(CS%del2MEKE)) then + call create_group_pass(CS%pass_del2MEKE, CS%del2MEKE, G%Domain) + call do_group_pass(CS%pass_del2MEKE, G%Domain) + endif + end function MEKE_init !> Allocates memory and register restart fields for the MOM_MEKE module. diff --git a/src/parameterizations/lateral/MOM_MEKE_types.F90 b/src/parameterizations/lateral/MOM_MEKE_types.F90 index 95106f1fdb..438e394e3b 100644 --- a/src/parameterizations/lateral/MOM_MEKE_types.F90 +++ b/src/parameterizations/lateral/MOM_MEKE_types.F90 @@ -13,13 +13,15 @@ module MOM_MEKE_types mom_src => NULL(),& !< MEKE source from lateral friction in the momentum equations [W m-2]. GME_snk => NULL(),& !< MEKE sink from GME backscatter in the momentum equations [W m-2]. Kh => NULL(), & !< The MEKE-derived lateral mixing coefficient [m2 s-1]. - Kh_diff => NULL(), & !< Uses the non-MEKE-derived thickness diffusion coefficient to diffuse MEKE [m2 s-1]. + Kh_diff => NULL(), & !< Uses the non-MEKE-derived thickness diffusion coefficient to diffuse + !! MEKE [m2 s-1]. Rd_dx_h => NULL() !< The deformation radius compared with the grid spacing [nondim]. !! Rd_dx_h is copied from VarMix_CS. - real, dimension(:,:), pointer :: Ku => NULL() !< The MEKE-derived lateral viscosity coefficient [m2 s-1]. - !! This viscosity can be negative when representing backscatter - !! from unresolved eddies (see Jansen and Held, 2014). - real, dimension(:,:), pointer :: Au => NULL() !< The MEKE-derived lateral biharmonic viscosity coefficient [m4 s-1]. + real, dimension(:,:), pointer :: Ku => NULL() !< The MEKE-derived lateral viscosity coefficient + !! [m2 T-1 ~> m2 s-1]. This viscosity can be negative when representing + !! backscatter from unresolved eddies (see Jansen and Held, 2014). + real, dimension(:,:), pointer :: Au => NULL() !< The MEKE-derived lateral biharmonic viscosity + !! coefficient [m4 T-1 ~> m4 s-1]. ! Parameters real :: KhTh_fac = 1.0 !< Multiplier to map Kh(MEKE) to KhTh [nondim] real :: KhTr_fac = 1.0 !< Multiplier to map Kh(MEKE) to KhTr [nondim]. diff --git a/src/parameterizations/lateral/MOM_hor_visc.F90 b/src/parameterizations/lateral/MOM_hor_visc.F90 index 14f505fc66..1dcb35555e 100644 --- a/src/parameterizations/lateral/MOM_hor_visc.F90 +++ b/src/parameterizations/lateral/MOM_hor_visc.F90 @@ -283,12 +283,13 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, Ah_q, & ! biharmonic viscosity at corner points [m4 T-1 ~> m4 s-1] Kh_q, & ! Laplacian viscosity at corner points [m2 s-1] vort_xy_q, & ! vertical vorticity at corner points [s-1] - GME_coeff_q !< GME coeff. at q-points [m2 s-1] + GME_coeff_q !< GME coeff. at q-points [m2 T-1 ~> m2 s-1] - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)+1) :: & - KH_u_GME !< interface height diffusivities in u-columns [m2 s-1] - real, dimension(SZI_(G),SZJB_(G),SZK_(G)+1) :: & - KH_v_GME !< interface height diffusivities in v-columns [m2 s-1] + ! These 3-d arrays are unused. + ! real, dimension(SZIB_(G),SZJ_(G),SZK_(G)+1) :: & + ! KH_u_GME !< interface height diffusivities in u-columns [m2 s-1] + ! real, dimension(SZI_(G),SZJB_(G),SZK_(G)+1) :: & + ! KH_v_GME !< interface height diffusivities in v-columns [m2 s-1] real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: & Ah_h, & ! biharmonic viscosity at thickness points [m4 T-1 ~> m4 s-1] Kh_h, & ! Laplacian viscosity at thickness points [m2 T-1 ~> m2 s-1] @@ -301,16 +302,16 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, FrictWorkMax, & ! maximum possible work done by MKE dissipation mechanisms [W m-2] FrictWork_GME, & ! work done by GME [W m-2] div_xx_h ! horizontal divergence [s-1] - !real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1) :: & + ! real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1) :: & real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: & - KH_t_GME, & !< interface height diffusivities in t-columns [m2 s-1] - GME_coeff_h !< GME coeff. at h-points [m2 s-1] + ! KH_t_GME, & !< interface height diffusivities in t-columns [m2 s-1] + GME_coeff_h !< GME coeff. at h-points [m2 T-1 ~> m2 s-1] real :: Ah ! biharmonic viscosity [m4 T-1 ~> m4 s-1] real :: Kh ! Laplacian viscosity [m2 T-1 ~> m2 s-1] real :: AhSm ! Smagorinsky biharmonic viscosity [m4 T-1 ~> m4 s-1] ! real :: KhSm ! Smagorinsky Laplacian viscosity [m2 T-1 ~> m2 s-1] real :: AhLth ! 2D Leith biharmonic viscosity [m4 T-1 ~> m4 s-1] - real :: KhLth ! 2D Leith Laplacian viscosity [m2 s-1] +! real :: KhLth ! 2D Leith Laplacian viscosity [m2 s-1] real :: mod_Leith ! nondimensional coefficient for divergence part of modified Leith ! viscosity. Here set equal to nondimensional Laplacian Leith constant. ! This is set equal to zero if modified Leith is not used. @@ -335,8 +336,8 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, real :: FatH ! abs(f) at h-point for MEKE source term [T-1 ~> s-1] real :: local_strain ! Local variable for interpolating computed strain rates [s-1]. real :: meke_res_fn ! A copy of the resolution scaling factor if being applied to MEKE. Otherwise =1. - real :: GME_coeff ! The GME (negative) viscosity coefficient [m2 s-1] - real :: GME_coeff_limiter ! Maximum permitted value of the GME coefficient [m2 s-1] + real :: GME_coeff ! The GME (negative) viscosity coefficient [m2 T-1 ~> m2 s-1] + real :: GME_coeff_limiter ! Maximum permitted value of the GME coefficient [m2 T-1 ~> m2 s-1] real :: FWfrac ! Fraction of maximum theoretical energy transfer to use when scaling GME coefficient [nondim] real :: DY_dxBu ! Ratio of meridional over zonal grid spacing at vertices [nondim] real :: DX_dyBu ! Ratio of zonal over meridiononal grid spacing at vertices [nondim] @@ -406,7 +407,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, ! GME tapers off above this depth H0_GME = 1000.0*US%m_to_Z FWfrac = 1.0 - GME_coeff_limiter = 1e7 + GME_coeff_limiter = 1e7*US%T_to_s ! initialize diag. array with zeros GME_coeff_h(:,:,:) = 0.0 @@ -497,7 +498,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, !$OMP parallel do default(none) shared(Isq,Ieq,Jsq,Jeq,nz,CS,G,GV,u,v,is,js,ie,je,h, & !$OMP rescale_Kh,VarMix,h_neglect,h_neglect3, & - !$OMP Kh_h,Ah_h,Kh_q,Ah_q,diffu,apply_OBC,OBC,diffv, & + !$OMP Kh_h,Ah_h,Kh_q,Ah_q,diffu,diffv,apply_OBC,OBC, & !$OMP find_FrictWork,FrictWork,use_MEKE_Ku, & !$OMP use_MEKE_Au, MEKE, hq, & !$OMP mod_Leith, legacy_bound, div_xx_h, vort_xy_q) & @@ -505,7 +506,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, !$OMP sh_xy, str_xy, Ah, Kh, AhSm, dvdx, dudy, & !$OMP sh_xx_bt, sh_xy_bt, dvdx_bt, dudy_bt, & !$OMP bhstr_xx, bhstr_xy,FatH,RoScl, hu, hv, h_u, h_v, & - !$OMP vort_xy,vort_xy_dx,vort_xy_dy,Vort_mag,AhLth,KhLth, & + !$OMP vort_xy,vort_xy_dx,vort_xy_dy,Vort_mag,AhLth, & !$OMP div_xx, div_xx_dx, div_xx_dy, local_strain, & !$OMP meke_res_fn,Sh_F_pow, & !$OMP Shear_mag, h2uq, h2vq, hq, Kh_scale, hrat_min) @@ -882,7 +883,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, if (legacy_bound) Kh = min(Kh, CS%Kh_Max_xx(i,j)) Kh = max( Kh, CS%Kh_bg_min ) ! Place a floor on the viscosity, if desired. if (use_MEKE_Ku) & - Kh = Kh + US%T_to_s*MEKE%Ku(i,j) * meke_res_fn ! *Add* the MEKE contribution (might be negative) + Kh = Kh + MEKE%Ku(i,j) * meke_res_fn ! *Add* the MEKE contribution (might be negative) if (CS%anisotropic) Kh = Kh + CS%Kh_aniso * ( 1. - CS%n1n2_h(i,j)**2 ) ! *Add* the tension component ! of anisotropic viscosity @@ -933,7 +934,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, Ah = CS%Ah_bg_xx(i,j) endif ! Smagorinsky_Ah or Leith_Ah - if (use_MEKE_Au) Ah = Ah + US%T_to_s*MEKE%Au(i,j) ! *Add* the MEKE contribution + if (use_MEKE_Au) Ah = Ah + MEKE%Au(i,j) ! *Add* the MEKE contribution if (CS%better_bound_Ah) then Ah = MIN(Ah, visc_bound_rem*hrat_min*CS%Ah_Max_xx(i,j)) @@ -1045,8 +1046,8 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, if (legacy_bound) Kh = min(Kh, CS%Kh_Max_xy(i,j)) Kh = max( Kh, CS%Kh_bg_min ) ! Place a floor on the viscosity, if desired. if (use_MEKE_Ku) then ! *Add* the MEKE contribution (might be negative) - Kh = Kh + US%T_to_s*0.25*( (MEKE%Ku(I,J)+MEKE%Ku(I+1,J+1)) & - +(MEKE%Ku(I+1,J)+MEKE%Ku(I,J+1)) ) * meke_res_fn + Kh = Kh + 0.25*( (MEKE%Ku(i,j) + MEKE%Ku(i+1,j+1)) + & + (MEKE%Ku(i+1,j) + MEKE%Ku(i,j+1)) ) * meke_res_fn endif ! Older method of bounding for stability if (CS%anisotropic) Kh = Kh + CS%Kh_aniso * CS%n1n2_q(I,J)**2 ! *Add* the shear component @@ -1100,8 +1101,8 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, endif ! Smagorinsky_Ah or Leith_Ah if (use_MEKE_Au) then ! *Add* the MEKE contribution - Ah = Ah + US%T_to_s*0.25*( (MEKE%Au(I,J)+MEKE%Au(I+1,J+1)) & - +(MEKE%Au(I+1,J)+MEKE%Au(I,J+1)) ) + Ah = Ah + 0.25*( (MEKE%Au(I,J) + MEKE%Au(I+1,J+1)) + & + (MEKE%Au(I+1,J) + MEKE%Au(I,J+1)) ) endif if (CS%better_bound_Ah) then @@ -1190,8 +1191,8 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 GME_coeff = 0.0 if ((max_diss_rate(i,j,k) > 0) .and. (grad_vel_mag_bt_h(i,j)>0) ) then - GME_coeff = FWfrac*max_diss_rate(i,j,k) / grad_vel_mag_bt_h(i,j) -! GME_coeff = FWfrac*target_diss_rate_GME(i,j,k) / grad_vel_mag_bt_h(i,j) + GME_coeff = FWfrac*US%T_to_s*max_diss_rate(i,j,k) / grad_vel_mag_bt_h(i,j) +! GME_coeff = FWfrac*US%T_to_s*target_diss_rate_GME(i,j,k) / grad_vel_mag_bt_h(i,j) if ((G%bathyT(i,j) < H0_GME) .and. (H0_GME > 0.0)) & GME_coeff = (G%bathyT(i,j) / H0_GME)**2 * GME_coeff @@ -1202,7 +1203,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, if ((CS%id_GME_coeff_h>0) .or. find_FrictWork) GME_coeff_h(i,j,k) = GME_coeff - str_xx_GME(i,j) = US%T_to_s*GME_coeff * sh_xx_bt(i,j) + str_xx_GME(i,j) = GME_coeff * sh_xx_bt(i,j) enddo ; enddo @@ -1210,8 +1211,8 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, GME_coeff = 0.0 if ((max_diss_rate(i,j,k) > 0) .and. (grad_vel_mag_bt_q(I,J)>0) ) then !#GME# target_diss_rate_GME and max_diss_rate are defined at h points, not q points as used here. - GME_coeff = FWfrac*max_diss_rate(i,j,k) / grad_vel_mag_bt_q(I,J) -! GME_coeff = FWfrac*target_diss_rate_GME(i,j,k) / grad_vel_mag_bt_q(I,J) + GME_coeff = FWfrac*US%T_to_s*max_diss_rate(i,j,k) / grad_vel_mag_bt_q(I,J) +! GME_coeff = FWfrac*US%T_to_s*target_diss_rate_GME(i,j,k) / grad_vel_mag_bt_q(I,J) if ((G%bathyT(i,j) < H0_GME) .and. (H0_GME > 0.0)) & GME_coeff = (G%bathyT(i,j) / H0_GME)**2 * GME_coeff @@ -1221,7 +1222,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, endif if (CS%id_GME_coeff_q>0) GME_coeff_q(I,J,k) = GME_coeff - str_xy_GME(I,J) = US%T_to_s*GME_coeff * sh_xy_bt(I,J) + str_xy_GME(I,J) = GME_coeff * sh_xy_bt(I,J) enddo ; enddo @@ -1244,7 +1245,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, if (associated(MEKE%GME_snk)) then do j=js,je ; do i=is,ie - FrictWork_GME(i,j,k) = GME_coeff_h(i,j,k) * h(i,j,k) * GV%H_to_kg_m2 * grad_vel_mag_bt_h(i,j) + FrictWork_GME(i,j,k) = US%s_to_T*GME_coeff_h(i,j,k) * h(i,j,k) * GV%H_to_kg_m2 * grad_vel_mag_bt_h(i,j) enddo ; enddo endif @@ -2136,10 +2137,10 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS) if (CS%use_GME) then CS%id_GME_coeff_h = register_diag_field('ocean_model', 'GME_coeff_h', diag%axesTL, Time, & - 'GME coefficient at h Points', 'm^2 s-1') + 'GME coefficient at h Points', 'm2 s-1', conversion=US%s_to_T) CS%id_GME_coeff_q = register_diag_field('ocean_model', 'GME_coeff_q', diag%axesBL, Time, & - 'GME coefficient at q Points', 'm^2 s-1') + 'GME coefficient at q Points', 'm2 s-1', conversion=US%s_to_T) CS%id_FrictWork_GME = register_diag_field('ocean_model','FrictWork_GME',diag%axesTL,Time,& 'Integral work done by lateral friction terms in GME (excluding diffusion of energy)', 'W m-2') From e6e33dbd9ec19b80b40610219060f767afbb8287 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Wed, 17 Jul 2019 14:43:29 -0400 Subject: [PATCH 123/150] Grouped MEKE halo updates Combined halo updates inside of the MEKE code into group passes to reduce latency. Also made del2MEKE into a local variable and removed it from the MEKE control structure. All answers are bitwise identical. --- src/parameterizations/lateral/MOM_MEKE.F90 | 121 +++++++-------------- 1 file changed, 38 insertions(+), 83 deletions(-) diff --git a/src/parameterizations/lateral/MOM_MEKE.F90 b/src/parameterizations/lateral/MOM_MEKE.F90 index b7819ee710..54726fe9fb 100644 --- a/src/parameterizations/lateral/MOM_MEKE.F90 +++ b/src/parameterizations/lateral/MOM_MEKE.F90 @@ -9,9 +9,7 @@ module MOM_MEKE use MOM_cpu_clock, only : cpu_clock_id, cpu_clock_begin, cpu_clock_end, CLOCK_ROUTINE use MOM_diag_mediator, only : post_data, register_diag_field, safe_alloc_ptr use MOM_diag_mediator, only : diag_ctrl, time_type -use MOM_domains, only : create_group_pass, do_group_pass -use MOM_domains, only : group_pass_type -use MOM_domains, only : pass_var, pass_vector +use MOM_domains, only : create_group_pass, do_group_pass, group_pass_type use MOM_error_handler, only : MOM_error, FATAL, WARNING, NOTE, MOM_mesg use MOM_file_parser, only : read_param, get_param, log_version, param_file_type use MOM_grid, only : ocean_grid_type @@ -80,9 +78,6 @@ module MOM_MEKE logical :: initialize !< If True, invokes a steady state solver to calculate MEKE. logical :: debug !< If true, write out checksums of data for debugging - ! Optional storage - real, dimension(:,:), allocatable :: del2MEKE !< Laplacian of MEKE, used for bi-harmonic diffusion. - type(diag_ctrl), pointer :: diag => NULL() !< A type that regulates diagnostics output !>@{ Diagnostic handles integer :: id_MEKE = -1, id_Ue = -1, id_Kh = -1, id_src = -1 @@ -95,12 +90,8 @@ module MOM_MEKE ! Infrastructure integer :: id_clock_pass !< Clock for group pass calls - type(group_pass_type) :: pass_MEKE !< Type for group halo pass calls - type(group_pass_type) :: pass_Kh !< Type for group halo pass calls - type(group_pass_type) :: pass_Kh_diff !< Type for group halo pass calls - type(group_pass_type) :: pass_Ku !< Type for group halo pass calls - type(group_pass_type) :: pass_Au !< Type for group halo pass calls - type(group_pass_type) :: pass_del2MEKE !< Type for group halo pass calls + type(group_pass_type) :: pass_MEKE !< Group halo pass handle for MEKE%MEKE and maybe MEKE%Kh_diff + type(group_pass_type) :: pass_Kh !< Group halo pass handle for MEKE%Kh, MEKE%Ku, and/or MEKE%Au end type MEKE_CS contains @@ -132,6 +123,8 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h MEKE_GME_snk, & ! The MEKE sink from GME backscatter [m2 s-3]. drag_rate_visc, & drag_rate, & ! The MEKE spindown timescale due to bottom drag [s-1]. + del2MEKE, & ! Laplacian of MEKE, used for bi-harmonic diffusion [s-2]. + del4MEKE, & ! MEKE tendency arising from the biharmonic of MEKE [m2 s-2]. LmixScale, & ! Square of eddy mixing length [m2]. barotrFac2, & ! Ratio of EKE_barotropic / EKE [nondim] bottomFac2 ! Ratio of EKE_bottom / EKE [nondim] @@ -358,8 +351,9 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h enddo ; enddo endif !$OMP end parallel - if (CS%MEKE_KH >= 0.0 .or. CS%KhMEKE_FAC > 0.0 .or. CS%MEKE_K4 >= 0.0) then - ! Update halos for lateral or bi-harmonic diffusion + + if (CS%kh_flux_enabled .or. CS%MEKE_K4 >= 0.0) then + ! Update MEKE in the halos for lateral or bi-harmonic diffusion call cpu_clock_begin(CS%id_clock_pass) call do_group_pass(CS%pass_MEKE, G%Domain) call cpu_clock_end(CS%id_clock_pass) @@ -368,7 +362,7 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h if (CS%MEKE_K4 >= 0.0) then ! Calculate Laplacian of MEKE !$OMP parallel do default(shared) - do j=js,je ; do I=is-1,ie + do j=js-1,je+1 ; do I=is-2,ie+1 MEKE_uflux(I,j) = ((G%dy_Cu(I,j)*G%IdxCu(I,j)) * G%mask2dCu(I,j)) * & (MEKE%MEKE(i+1,j) - MEKE%MEKE(i,j)) ! MEKE_uflux(I,j) = ((G%dy_Cu(I,j)*G%IdxCu(I,j)) * & @@ -376,23 +370,21 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h ! (MEKE%MEKE(i+1,j) - MEKE%MEKE(i,j)) enddo ; enddo !$OMP parallel do default(shared) - do J=js-1,je ; do i=is,ie + do J=js-2,je+1 ; do i=is-1,ie+1 MEKE_vflux(i,J) = ((G%dx_Cv(i,J)*G%IdyCv(i,J)) * G%mask2dCv(i,J)) * & (MEKE%MEKE(i,j+1) - MEKE%MEKE(i,j)) ! MEKE_vflux(i,J) = ((G%dx_Cv(i,J)*G%IdyCv(i,J)) * & ! ((2.0*mass(i,j)*mass(i,j+1)) / ((mass(i,j)+mass(i,j+1)) + mass_neglect)) ) * & ! (MEKE%MEKE(i,j+1) - MEKE%MEKE(i,j)) enddo ; enddo + !$OMP parallel do default(shared) - do j=js,je ; do i=is,ie - CS%del2MEKE(i,j) = G%IareaT(i,j) * & + do j=js-1,je+1 ; do i=is-1,ie+1 + del2MEKE(i,j) = G%IareaT(i,j) * & ((MEKE_uflux(I,j) - MEKE_uflux(I-1,j)) + (MEKE_vflux(i,J) - MEKE_vflux(i,J-1))) - ! CS%del2MEKE(i,j) = (G%IareaT(i,j)*I_mass(i,j)) * & + ! del2MEKE(i,j) = (G%IareaT(i,j)*I_mass(i,j)) * & ! ((MEKE_uflux(I,j) - MEKE_uflux(I-1,j)) + (MEKE_vflux(i,J) - MEKE_vflux(i,J-1))) enddo ; enddo - call cpu_clock_begin(CS%id_clock_pass) - call do_group_pass(CS%pass_del2MEKE, G%Domain) - call cpu_clock_end(CS%id_clock_pass) ! Bi-harmonic diffusion of MEKE !$OMP parallel do default(shared) private(K4_here,Inv_Kh_max) @@ -405,7 +397,7 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h MEKE_uflux(I,j) = ((K4_here * (G%dy_Cu(I,j)*G%IdxCu(I,j))) * & ((2.0*mass(i,j)*mass(i+1,j)) / ((mass(i,j)+mass(i+1,j)) + mass_neglect)) ) * & - (CS%del2MEKE(i+1,j) - CS%del2MEKE(i,j)) + (del2MEKE(i+1,j) - del2MEKE(i,j)) enddo ; enddo !$OMP parallel do default(shared) private(K4_here,Inv_Kh_max) do J=js-1,je ; do i=is,ie @@ -416,17 +408,18 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h MEKE_vflux(i,J) = ((K4_here * (G%dx_Cv(i,J)*G%IdyCv(i,J))) * & ((2.0*mass(i,j)*mass(i,j+1)) / ((mass(i,j)+mass(i,j+1)) + mass_neglect)) ) * & - (CS%del2MEKE(i,j+1) - CS%del2MEKE(i,j)) + (del2MEKE(i,j+1) - del2MEKE(i,j)) enddo ; enddo + ! Store tendency arising from the bi-harmonic in del4MEKE !$OMP parallel do default(shared) - ! Store tendency of bi-harmonic in del2MEKE do j=js,je ; do i=is,ie - CS%del2MEKE(i,j) = (sdt*(G%IareaT(i,j)*I_mass(i,j))) * & + del4MEKE(i,j) = (sdt*(G%IareaT(i,j)*I_mass(i,j))) * & ((MEKE_uflux(I-1,j) - MEKE_uflux(I,j)) + & (MEKE_vflux(i,J-1) - MEKE_vflux(i,J))) enddo ; enddo endif ! + if (CS%kh_flux_enabled) then ! Lateral diffusion of MEKE Kh_here = max(0.,CS%MEKE_Kh) @@ -492,7 +485,7 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h if (CS%MEKE_K4 >= 0.0) then !$OMP parallel do default(shared) do j=js,je ; do i=is,ie - MEKE%MEKE(i,j) = MEKE%MEKE(i,j) + CS%del2MEKE(i,j) + MEKE%MEKE(i,j) = MEKE%MEKE(i,j) + del4MEKE(i,j) enddo ; enddo endif @@ -559,9 +552,6 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h MEKE%Kh(i,j) = (CS%MEKE_KhCoeff*sqrt(2.*max(0.,barotrFac2(i,j)*MEKE%MEKE(i,j)))*LmixScale(i,j)) enddo ; enddo endif - call cpu_clock_begin(CS%id_clock_pass) - call do_group_pass(CS%pass_Kh, G%Domain) - call cpu_clock_end(CS%id_clock_pass) endif endif @@ -570,21 +560,20 @@ 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,ie MEKE%Ku(i,j) = US%T_to_s*CS%viscosity_coeff_Ku*sqrt(2.*max(0.,MEKE%MEKE(i,j)))*LmixScale(i,j) enddo ; enddo - call cpu_clock_begin(CS%id_clock_pass) - call do_group_pass(CS%pass_Ku, G%Domain) - call cpu_clock_end(CS%id_clock_pass) endif if (CS%viscosity_coeff_Au /=0.) then do j=js,je ; do i=is,ie MEKE%Au(i,j) = US%T_to_s*CS%viscosity_coeff_Au*sqrt(2.*max(0.,MEKE%MEKE(i,j)))*LmixScale(i,j)**3 enddo ; enddo + endif + + if (associated(MEKE%Kh) .or. associated(MEKE%Ku) .or. associated(MEKE%Au)) then call cpu_clock_begin(CS%id_clock_pass) - call do_group_pass(CS%pass_Au, G%Domain) + call do_group_pass(CS%pass_Kh, G%Domain) call cpu_clock_end(CS%id_clock_pass) endif - ! Offer fields for averaging. if (CS%id_MEKE>0) call post_data(CS%id_MEKE, MEKE%MEKE, CS%diag) if (CS%id_Ue>0) call post_data(CS%id_Ue, sqrt(max(0.,2.0*MEKE%MEKE)), CS%diag) @@ -656,22 +645,15 @@ subroutine MEKE_equilibrium(CS, MEKE, G, GV, US, SN_u, SN_v, drag_rate_visc, I_m ! This avoids extremes values in equilibrium solution due to bad values in SN_u, SN_v SN = min( min(SN_u(I,j) , SN_u(I-1,j)) , min(SN_v(i,J), SN_v(i,J-1)) ) - FatH = 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))) !< Coriolis parameter at h points + FatH = 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))) ! Coriolis parameter at h points ! Since zero-bathymetry cells are masked, this avoids calculations on land if (CS%MEKE_topographic_beta == 0. .or. G%bathyT(i,j) == 0.) then beta_topo_x = 0. ; beta_topo_y = 0. else - !### These expressions should be recast to use a single division, but it will change answers. - !beta_topo_x = CS%MEKE_topographic_beta * FatH & - ! * 0.5 * (G%bathyT(i+1,j) - G%bathyT(i-1,j)) * G%IdxT(i,j) / G%bathyT(i,j) - !beta_topo_y = CS%MEKE_topographic_beta * FatH & - ! * 0.5 * (G%bathyT(i,j+1) - G%bathyT(i,j-1)) * G&IdxT(i,j) / G%bathyT(i,j) - !beta_topo_x = CS%MEKE_topographic_beta * FatH / G%bathyT(i,j) & - ! * (G%bathyT(i+1,j) - G%bathyT(i-1,j)) / 2. / G%dxT(i,j) - !beta_topo_y = CS%MEKE_topographic_beta * FatH / G%bathyT(i,j) & - ! * (G%bathyT(i,j+1) - G%bathyT(i,j-1)) / 2. / G%dyT(i,j) + !### Consider different combinations of these estimates of topographic beta, and the use + ! of the water column thickness instead of the bathymetric depth. beta_topo_x = CS%MEKE_topographic_beta * FatH * 0.5 * ( & (G%bathyT(i+1,j)-G%bathyT(i,j)) * G%IdxCu(I,j) & /max(G%bathyT(i+1,j),G%bathyT(i,j), GV%H_subroundoff) & @@ -817,15 +799,8 @@ subroutine MEKE_lengthScales(CS, MEKE, G, GV, US, SN_u, SN_v, & if (CS%MEKE_topographic_beta == 0. .or. G%bathyT(i,j) == 0.0) then beta_topo_x = 0. ; beta_topo_y = 0. else - !### These expressions should be recast to use a single division, but it will change answers. - !beta_topo_x = CS%MEKE_topographic_beta * FatH & - ! * 0.5 * (G%bathyT(i+1,j) - G%bathyT(i-1,j)) * G%IdxT(i,j) / G%bathyT(i,j) - !beta_topo_y = CS%MEKE_topographic_beta * FatH & - ! * 0.5 * (G%bathyT(i,j+1) - G%bathyT(i,j-1)) * G&IdxT(i,j) / G%bathyT(i,j) - !beta_topo_x = CS%MEKE_topographic_beta * FatH / G%bathyT(i,j) & - ! * (G%bathyT(i+1,j) - G%bathyT(i-1,j)) / 2. / G%dxT(i,j) - !beta_topo_y = CS%MEKE_topographic_beta * FatH / G%bathyT(i,j) & - ! * (G%bathyT(i,j+1) - G%bathyT(i,j-1)) / 2. / G%dyT(i,j) + !### Consider different combinations of these estimates of topographic beta, and the use + ! of the water column thickness instead of the bathymetric depth. beta_topo_x = CS%MEKE_topographic_beta * FatH * 0.5 * ( & (G%bathyT(i+1,j)-G%bathyT(i,j)) * G%IdxCu(I,j) & /max(G%bathyT(i+1,j),G%bathyT(i,j), GV%H_subroundoff) & @@ -1136,14 +1111,9 @@ logical function MEKE_init(Time, G, US, param_file, diag, CS, MEKE, restart_CS) call get_param(param_file, mdl, "DEBUG", CS%debug, default=.false., do_not_log=.true.) - ! Allocation of storage NOT shared with other modules - if (CS%MEKE_K4>=0.) then - allocate(CS%del2MEKE(isd:ied,jsd:jed)) ; CS%del2MEKE(:,:) = 0.0 - endif - ! Identify if any lateral diffusive processes are active CS%kh_flux_enabled = .false. - if ((CS%MEKE_KH >= 0.0) .or. (CS%KhMEKE_FAC > 0.0) .or. (CS%MEKE_advection_factor >0.0)) & + if ((CS%MEKE_KH >= 0.0) .or. (CS%KhMEKE_FAC > 0.0) .or. (CS%MEKE_advection_factor > 0.0)) & CS%kh_flux_enabled = .true. ! Register fields for output from this module. @@ -1230,31 +1200,17 @@ logical function MEKE_init(Time, G, US, param_file, diag, CS, MEKE, restart_CS) endif ! Set up group passes. In the case of a restart, these fields need a halo update now. - !### At least 4 of these group passes can be combined. if (associated(MEKE%MEKE)) then call create_group_pass(CS%pass_MEKE, MEKE%MEKE, G%Domain) + if (associated(MEKE%Kh_diff)) call create_group_pass(CS%pass_MEKE, MEKE%Kh_diff, G%Domain) if (.not.CS%initialize) call do_group_pass(CS%pass_MEKE, G%Domain) endif - if (associated(MEKE%Kh)) then - call create_group_pass(CS%pass_Kh, MEKE%Kh, G%Domain) + if (associated(MEKE%Kh)) call create_group_pass(CS%pass_Kh, MEKE%Kh, G%Domain) + if (associated(MEKE%Ku)) call create_group_pass(CS%pass_Kh, MEKE%Ku, G%Domain) + if (associated(MEKE%Au)) call create_group_pass(CS%pass_Kh, MEKE%Au, G%Domain) + + if (associated(MEKE%Kh) .or. associated(MEKE%Ku) .or. associated(MEKE%Au)) & call do_group_pass(CS%pass_Kh, G%Domain) - endif - if (associated(MEKE%Kh_diff)) then - call create_group_pass(CS%pass_Kh_diff, MEKE%Kh_diff, G%Domain) - call do_group_pass(CS%pass_Kh_diff, G%Domain) - endif - if (associated(MEKE%Ku)) then - call create_group_pass(CS%pass_Ku, MEKE%Ku, G%Domain) - call do_group_pass(CS%pass_Ku, G%Domain) - endif - if (associated(MEKE%Au)) then - call create_group_pass(CS%pass_Au, MEKE%Au, G%Domain) - call do_group_pass(CS%pass_Au, G%Domain) - endif - if (allocated(CS%del2MEKE)) then - call create_group_pass(CS%pass_del2MEKE, CS%del2MEKE, G%Domain) - call do_group_pass(CS%pass_del2MEKE, G%Domain) - endif end function MEKE_init @@ -1310,7 +1266,7 @@ subroutine MEKE_alloc_register_restart(HI, param_file, MEKE, restart_CS) endif if (MEKE_KhCoeff>=0.) then allocate(MEKE%Kh(isd:ied,jsd:jed)) ; MEKE%Kh(:,:) = 0.0 - vd = var_desc("MEKE_Kh", "m2 s-1",hor_grid='h',z_grid='1', & + vd = var_desc("MEKE_Kh", "m2 s-1", hor_grid='h', z_grid='1', & longname="Lateral diffusivity from Mesoscale Eddy Kinetic Energy") call register_restart_field(MEKE%Kh, vd, .false., restart_CS) endif @@ -1355,7 +1311,6 @@ subroutine MEKE_end(MEKE, CS) if (associated(MEKE%Kh_diff)) deallocate(MEKE%Kh_diff) if (associated(MEKE%Ku)) deallocate(MEKE%Ku) if (associated(MEKE%Au)) deallocate(MEKE%Au) - if (allocated(CS%del2MEKE)) deallocate(CS%del2MEKE) deallocate(MEKE) end subroutine MEKE_end From e5992d8e749c1048284f5464b1601c4a3a8eb98d Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Wed, 17 Jul 2019 15:09:47 -0400 Subject: [PATCH 124/150] Removed a halo update in horizontal_viscosity Eliminated an unnecessary halo update in horizontal_viscosity. All answers are bitwise identical. --- src/parameterizations/lateral/MOM_hor_visc.F90 | 6 +----- 1 file changed, 1 insertion(+), 5 deletions(-) diff --git a/src/parameterizations/lateral/MOM_hor_visc.F90 b/src/parameterizations/lateral/MOM_hor_visc.F90 index 1dcb35555e..d2551b191b 100644 --- a/src/parameterizations/lateral/MOM_hor_visc.F90 +++ b/src/parameterizations/lateral/MOM_hor_visc.F90 @@ -1123,10 +1123,6 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, if (find_FrictWork) then - !### I suspect that this halo update is not needed. - if (CS%biharmonic) call pass_vector(u0, v0, G%Domain) - - !#GME# Group the 4-point sums so they are rotationally invariant.` if (CS%Laplacian) then if (CS%answers_2018) then do j=js,je ; do i=is,ie @@ -2483,7 +2479,7 @@ end subroutine hor_visc_end !! Large et al., 2001, proposed enhancing viscosity in a particular direction and the !! approach was generalized in Smith and McWilliams, 2003. We use the second form of their !! two coefficient anisotropic viscosity (section 4.3). We also replace their -!! \f$A^\prime\f$ nd $D$ such that \f$2A^\prime = 2 \kappa_h + D\f$ and +!! \f$A^\prime\f$ and $D$ such that \f$2A^\prime = 2 \kappa_h + D\f$ and !! \f$\kappa_a = D\f$ so that \f$\kappa_h\f$ can be considered the isotropic !! viscosity and \f$\kappa_a=D\f$ can be consider the anisotropic viscosity. The !! direction of anisotropy is defined by a unit vector \f$\hat{\bf From ba1c7af78e467fa1e09a2da0208d12074081f5fe Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Wed, 17 Jul 2019 16:09:47 -0400 Subject: [PATCH 125/150] +Added the runtime parameter VERY_SMALL_FREQUENCY Added a new runtime parameter, VERY_SMALL_FREQUENCY, to control how close to zero some frequencies that appear in the denominator of some expressions for the resolutoin functions can get. Also added some comments and rearranged some code addressing problems in calc_QG_Leith_viscosity. By default, all answers in the MOM6-examples test cases are bitwise identical, but there is a new entry in the MOM_parameter_doc.all files. --- .../lateral/MOM_lateral_mixing_coeffs.F90 | 109 +++++++++--------- 1 file changed, 57 insertions(+), 52 deletions(-) diff --git a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 index 63348231f3..bcd3155cad 100644 --- a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 +++ b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 @@ -761,14 +761,15 @@ subroutine calc_QG_Leith_viscosity(CS, G, GV, h, k, div_xx_dx, div_xx_dy, vort_x inv_PI3 = 1.0/((4.0*atan(1.0))**3) - ! update halos + !### I believe this halo update to be unnecessary. -RWH call pass_var(h, G%Domain) if ((k > 1) .and. (k < nz)) then ! Add in stretching term for the QG Leith vsicosity ! if (CS%use_QG_Leith) then -! do j=js-1,Jeq+1 ; do I=is-2,Ieq+1 + + !### do j=js-1,je+1 ; do I=is-2,Ieq+1 do j=js-2,Jeq+2 ; do I=is-2,Ieq+1 h_at_slope_above = 2. * ( h(i,j,k-1) * h(i+1,j,k-1) ) * ( h(i,j,k) * h(i+1,j,k) ) / & ( ( h(i,j,k-1) * h(i+1,j,k-1) ) * ( h(i,j,k) + h(i+1,j,k) ) & @@ -780,7 +781,8 @@ subroutine calc_QG_Leith_viscosity(CS, G, GV, h, k, div_xx_dx, div_xx_dy, vort_x dslopex_dz(I,j) = 2. * ( CS%slope_x(i,j,k) - CS%slope_x(i,j,k+1) ) * Ih h_at_u(I,j) = 2. * ( h_at_slope_above * h_at_slope_below ) * Ih enddo ; enddo -! do J=js-2,Jeq+1 ; do i=is-1,Ieq+1 + + !### do J=js-2,Jeq+1 ; do i=is-1,ie+1 do J=js-2,Jeq+1 ; do i=is-2,Ieq+2 h_at_slope_above = 2. * ( h(i,j,k-1) * h(i,j+1,k-1) ) * ( h(i,j,k) * h(i,j+1,k) ) / & ( ( h(i,j,k-1) * h(i,j+1,k-1) ) * ( h(i,j,k) + h(i,j+1,k) ) & @@ -793,6 +795,7 @@ subroutine calc_QG_Leith_viscosity(CS, G, GV, h, k, div_xx_dx, div_xx_dy, vort_x h_at_v(i,J) = 2. * ( h_at_slope_above * h_at_slope_below ) * Ih enddo ; enddo + !### do J=js-1,je ; do i=is-1,Ieq+1 do J=js-2,Jeq+1 ; do i=is-1,Ieq+1 f = 0.5 * ( G%CoriolisBu(I,J) + G%CoriolisBu(I-1,J) ) vort_xy_dx(i,J) = vort_xy_dx(i,J) - f * & @@ -801,8 +804,10 @@ subroutine calc_QG_Leith_viscosity(CS, G, GV, h, k, div_xx_dx, div_xx_dy, vort_x ( ( h_at_u(I,j) + h_at_u(I-1,j+1) ) + ( h_at_u(I-1,j) + h_at_u(I,j+1) ) + GV%H_subroundoff) enddo ; enddo + !### do j=js-1,Jeq+1 ; do I=is-1,ie do j=js-1,Jeq+1 ; do I=is-2,Ieq+1 f = 0.5 * ( G%CoriolisBu(I,J) + G%CoriolisBu(I,J-1) ) + !### I think that this should be vort_xy_dy(I,j) = vort_xy_dy(I,j) - f * & vort_xy_dy(I,j) = vort_xy_dx(I,j) - f * & ( ( h_at_v(i,J) * dslopey_dz(i,J) + h_at_v(i+1,J-1) * dslopey_dz(i+1,J-1) ) & + ( h_at_v(i,J-1) * dslopey_dz(i,J-1) + h_at_v(i+1,J) * dslopey_dz(i+1,J) ) ) / & @@ -810,51 +815,49 @@ subroutine calc_QG_Leith_viscosity(CS, G, GV, h, k, div_xx_dx, div_xx_dy, vort_x enddo ; enddo endif ! k > 1 + !### I believe this halo update to be unnecessary. -RWH call pass_vector(vort_xy_dy,vort_xy_dx,G%Domain) - if (CS%use_QG_Leith_GM) then + if (CS%use_QG_Leith_GM) then + + do j=js,je ; do I=is-1,Ieq + grad_vort_mag_u(I,j) = SQRT(vort_xy_dy(I,j)**2 + (0.25*(vort_xy_dx(i,J) + vort_xy_dx(i+1,J) & + + vort_xy_dx(i,J-1) + vort_xy_dx(i+1,J-1)))**2) + grad_div_mag_u(I,j) = SQRT(div_xx_dx(I,j)**2 + (0.25*(div_xx_dy(i,J) + div_xx_dy(i+1,J) & + + div_xx_dy(i,J-1) + div_xx_dy(i+1,J-1)))**2) if (CS%use_beta_in_QG_Leith) then - do j=Jsq-1,Jeq+2 ; do I=is-2,Ieq+1 - beta_u(I,j) = sqrt( (0.5*(G%dF_dx(i,j)+G%dF_dx(i+1,j))**2) + & - (0.5*(G%dF_dy(i,j)+G%dF_dy(i+1,j))**2) ) - enddo ; enddo - do J=js-2,Jeq+1 ; do i=Isq-1,Ieq+2 - beta_v(i,J) = sqrt( (0.5*(G%dF_dx(i,j)+G%dF_dx(i,j+1))**2) + & - (0.5*(G%dF_dy(i,j)+G%dF_dy(i,j+1))**2) ) - enddo ; enddo + beta_u(I,j) = sqrt( (0.5*(G%dF_dx(i,j)+G%dF_dx(i+1,j))**2) + & + (0.5*(G%dF_dy(i,j)+G%dF_dy(i+1,j))**2) ) + CS%KH_u_QG(I,j,k) = MIN(grad_vort_mag_u(I,j) + grad_div_mag_u(I,j), beta_u(I,j)*3) & + * CS%Laplac3_const_u(I,j) * inv_PI3 + else + CS%KH_u_QG(I,j,k) = (grad_vort_mag_u(I,j) + grad_div_mag_u(I,j)) & + * CS%Laplac3_const_u(I,j) * inv_PI3 endif + enddo ; enddo - do j=js-1,Jeq+1 ; do I=is-2,Ieq - grad_vort_mag_u(I,j) = SQRT(vort_xy_dy(I,j)**2 + (0.25*(vort_xy_dx(i,J) + vort_xy_dx(i+1,J) & - + vort_xy_dx(i,J-1) + vort_xy_dx(i+1,J-1)))**2) - grad_div_mag_u(I,j) = SQRT(div_xx_dx(I,j)**2 + (0.25*(div_xx_dy(i,J) + div_xx_dy(i+1,J) & - + div_xx_dy(i,J-1) + div_xx_dy(i+1,J-1)))**2) - if (CS%use_beta_in_QG_Leith) then - CS%KH_u_QG(I,j,k) = MIN(grad_vort_mag_u(I,j) + grad_div_mag_u(I,j), beta_u(I,j)*3) & - * CS%Laplac3_const_u(I,j) * inv_PI3 - else - CS%KH_u_QG(I,j,k) = (grad_vort_mag_u(I,j) + grad_div_mag_u(I,j)) & - * CS%Laplac3_const_u(I,j) * inv_PI3 - endif - enddo ; enddo + do J=js-1,Jeq ; do i=is,ie + grad_vort_mag_v(i,J) = SQRT(vort_xy_dx(i,J)**2 + (0.25*(vort_xy_dy(I,j) + vort_xy_dy(I-1,j) & + + vort_xy_dy(I,j+1) + vort_xy_dy(I-1,j+1)))**2) + grad_div_mag_v(i,J) = SQRT(div_xx_dy(i,J)**2 + (0.25*(div_xx_dx(I,j) + div_xx_dx(I-1,j) & + + div_xx_dx(I,j+1) + div_xx_dx(I-1,j+1)))**2) + if (CS%use_beta_in_QG_Leith) then + beta_v(i,J) = sqrt( (0.5*(G%dF_dx(i,j)+G%dF_dx(i,j+1))**2) + & + (0.5*(G%dF_dy(i,j)+G%dF_dy(i,j+1))**2) ) + CS%KH_v_QG(i,J,k) = MIN(grad_vort_mag_v(i,J) + grad_div_mag_v(i,J), beta_v(i,J)*3) & + * CS%Laplac3_const_v(i,J) * inv_PI3 + else + CS%KH_v_QG(i,J,k) = (grad_vort_mag_v(i,J) + grad_div_mag_v(i,J)) & + * CS%Laplac3_const_v(i,J) * inv_PI3 + endif + enddo ; enddo + ! post diagnostics - do J=js-2,Jeq ; do i=is-1,Ieq+1 - grad_vort_mag_v(i,J) = SQRT(vort_xy_dx(i,J)**2 + (0.25*(vort_xy_dy(I,j) + vort_xy_dy(I-1,j) & - + vort_xy_dy(I,j+1) + vort_xy_dy(I-1,j+1)))**2) - grad_div_mag_v(i,J) = SQRT(div_xx_dy(i,J)**2 + (0.25*(div_xx_dx(I,j) + div_xx_dx(I-1,j) & - + div_xx_dx(I,j+1) + div_xx_dx(I-1,j+1)))**2) - if (CS%use_beta_in_QG_Leith) then - CS%KH_v_QG(i,J,k) = MIN(grad_vort_mag_v(i,J) + grad_div_mag_v(i,J), beta_v(i,J)*3) & - * CS%Laplac3_const_v(i,J) * inv_PI3 - else - CS%KH_v_QG(i,J,k) = (grad_vort_mag_v(i,J) + grad_div_mag_v(i,J)) & - * CS%Laplac3_const_v(i,J) * inv_PI3 - endif - enddo ; enddo - ! post diagnostics + if (k==nz) then if (CS%id_KH_v_QG > 0) call post_data(CS%id_KH_v_QG, CS%KH_v_QG, CS%diag) if (CS%id_KH_u_QG > 0) call post_data(CS%id_KH_u_QG, CS%KH_u_QG, CS%diag) endif + endif end subroutine calc_QG_Leith_viscosity @@ -870,9 +873,8 @@ subroutine VarMix_init(Time, G, GV, US, param_file, diag, CS) ! Local variables real :: KhTr_Slope_Cff, KhTh_Slope_Cff, oneOrTwo, N2_filter_depth real :: KhTr_passivity_coeff - real :: absurdly_small_freq2 ! A miniscule frequency - ! squared that is used to avoid division by 0 [s-2]. This - ! value is roughly (pi / (the age of the universe) )^2. + real :: absurdly_small_freq ! A miniscule frequency that is used to avoid division by 0 [T-1 ~> s-1]. The + ! default value is roughly (pi / (the age of the universe)). logical :: Gill_equatorial_Ld, use_FGNV_streamfn, use_MEKE, in_use real :: MLE_front_length real :: Leith_Lap_const ! The non-dimensional coefficient in the Leith viscosity @@ -901,7 +903,6 @@ 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 in [s-2]. ! Read all relevant parameters and write them to the model log. call log_version(param_file, mdl, version, "") @@ -947,6 +948,10 @@ subroutine VarMix_init(Time, G, GV, US, param_file, diag, CS) "stored for re-use. This uses more memory but avoids calling "//& "the equation of state more times than should be necessary.", & default=.false.) + call get_param(param_file, mdl, "VERY_SMALL_FREQUENCY", absurdly_small_freq, & + "A miniscule frequency that is used to avoid division by 0. The default "//& + "value is roughly (pi / (the age of the universe)).", & + default=1.0e-17, units="s-1", scale=US%T_to_s) call get_param(param_file, mdl, "KHTH_USE_FGNV_STREAMFUNCTION", use_FGNV_streamfn, & default=.false., do_not_log=.true.) CS%calculate_cg1 = CS%calculate_cg1 .or. use_FGNV_streamfn @@ -1110,8 +1115,8 @@ subroutine VarMix_init(Time, G, GV, US, param_file, diag, CS) endif do J=js-1,Jeq ; do I=is-1,Ieq - CS%f2_dx2_q(I,J) = (G%dxBu(I,J)**2 + G%dyBu(I,J)**2) * & - max(US%s_to_T**2 * G%CoriolisBu(I,J)**2, absurdly_small_freq2) + CS%f2_dx2_q(I,J) = US%s_to_T**2 * (G%dxBu(I,J)**2 + G%dyBu(I,J)**2) * & + max(G%CoriolisBu(I,J)**2, absurdly_small_freq**2) CS%beta_dx2_q(I,J) = oneOrTwo * (G%dxBu(I,J)**2 + G%dyBu(I,J)**2) * (US%s_to_T * sqrt(0.5 * & ( (((G%CoriolisBu(I,J)-G%CoriolisBu(I-1,J)) * G%IdxCv(i,J))**2 + & ((G%CoriolisBu(I+1,J)-G%CoriolisBu(I,J)) * G%IdxCv(i+1,J))**2) + & @@ -1120,8 +1125,8 @@ subroutine VarMix_init(Time, G, GV, US, param_file, diag, CS) enddo ; enddo do j=js,je ; do I=is-1,Ieq - CS%f2_dx2_u(I,j) = (G%dxCu(I,j)**2 + G%dyCu(I,j)**2) * & - max(0.5*US%s_to_T**2 * (G%CoriolisBu(I,J)**2+G%CoriolisBu(I,J-1)**2), absurdly_small_freq2) + CS%f2_dx2_u(I,j) = US%s_to_T**2 *(G%dxCu(I,j)**2 + G%dyCu(I,j)**2) * & + max(0.5* (G%CoriolisBu(I,J)**2+G%CoriolisBu(I,J-1)**2), absurdly_small_freq**2) CS%beta_dx2_u(I,j) = oneOrTwo * (G%dxCu(I,j)**2 + G%dyCu(I,j)**2) * (US%s_to_T * sqrt( & 0.25*( (((G%CoriolisBu(I,J-1)-G%CoriolisBu(I-1,J-1)) * G%IdxCv(i,J-1))**2 + & ((G%CoriolisBu(I+1,J)-G%CoriolisBu(I,J)) * G%IdxCv(i+1,J))**2) + & @@ -1131,8 +1136,8 @@ subroutine VarMix_init(Time, G, GV, US, param_file, diag, CS) enddo ; enddo do J=js-1,Jeq ; do i=is,ie - CS%f2_dx2_v(i,J) = (G%dxCv(i,J)**2 + G%dyCv(i,J)**2) * & - max(0.5*US%s_to_T**2 * (G%CoriolisBu(I,J)**2+G%CoriolisBu(I-1,J)**2), absurdly_small_freq2) + CS%f2_dx2_v(i,J) = US%s_to_T**2*(G%dxCv(i,J)**2 + G%dyCv(i,J)**2) * & + max(0.5*(G%CoriolisBu(I,J)**2+G%CoriolisBu(I-1,J)**2), absurdly_small_freq**2) CS%beta_dx2_v(i,J) = oneOrTwo * (G%dxCv(i,J)**2 + G%dyCv(i,J)**2) * (US%s_to_T * sqrt( & ((G%CoriolisBu(I,J)-G%CoriolisBu(I-1,J)) * G%IdxCv(i,J))**2 + & 0.25*( (((G%CoriolisBu(I,J)-G%CoriolisBu(I,J-1)) * G%IdyCu(I,j))**2 + & @@ -1154,10 +1159,10 @@ subroutine VarMix_init(Time, G, GV, US, param_file, diag, CS) allocate(CS%beta_dx2_h(isd:ied,jsd:jed)); CS%beta_dx2_h(:,:) = 0.0 allocate(CS%f2_dx2_h(isd:ied,jsd:jed)) ; CS%f2_dx2_h(:,:) = 0.0 do j=js-1,je+1 ; do i=is-1,ie+1 - CS%f2_dx2_h(i,j) = (G%dxT(i,j)**2 + G%dyT(i,j)**2) * & - max(0.25 * US%s_to_T**2 * ((G%CoriolisBu(I,J)**2 + G%CoriolisBu(I-1,J-1)**2) + & + CS%f2_dx2_h(i,j) = US%s_to_T**2 * (G%dxT(i,j)**2 + G%dyT(i,j)**2) * & + max(0.25 * ((G%CoriolisBu(I,J)**2 + G%CoriolisBu(I-1,J-1)**2) + & (G%CoriolisBu(I-1,J)**2 + G%CoriolisBu(I,J-1)**2)), & - absurdly_small_freq2) + absurdly_small_freq**2) CS%beta_dx2_h(i,j) = oneOrTwo * (G%dxT(i,j)**2 + G%dyT(i,j)**2) * (US%s_to_T * sqrt(0.5 * & ( (((G%CoriolisBu(I,J)-G%CoriolisBu(I-1,J)) * G%IdxCv(i,J))**2 + & ((G%CoriolisBu(I,J-1)-G%CoriolisBu(I-1,J-1)) * G%IdxCv(i,J-1))**2) + & From 1769edee7341b16e4db95587416890cd06c36a52 Mon Sep 17 00:00:00 2001 From: Marshall Ward Date: Wed, 17 Jul 2019 16:18:28 -0400 Subject: [PATCH 126/150] (*) Remap opacity diagnostic to tanh() This patch remaps the opacity diagnostic to a tanh function, i.e. op -> 1/L * tanh(op * L) where L is arbitrarily set to 10^-10 (1 Angstrom). For op << 1/L, the diagnostic is nearly equivalent to the model opacity. For values comparable and larger than L, the diagnostic approaches 1/L, a sufficiently large value to reproduce the effects of a divergent opacity. This allows us to safely manipulate and store the opacity while also avoiding infinite values and floating point overflow. This change will modify the opacity diagnostic, but should not affect the dynamic state. --- src/parameterizations/vertical/MOM_opacity.F90 | 12 ++++++++++-- 1 file changed, 10 insertions(+), 2 deletions(-) diff --git a/src/parameterizations/vertical/MOM_opacity.F90 b/src/parameterizations/vertical/MOM_opacity.F90 index 4fc420f24f..8f2e9e5523 100644 --- a/src/parameterizations/vertical/MOM_opacity.F90 +++ b/src/parameterizations/vertical/MOM_opacity.F90 @@ -82,6 +82,9 @@ module MOM_opacity character*(10), parameter :: SINGLE_EXP_STRING = "SINGLE_EXP" !< String to specify the opacity scheme character*(10), parameter :: DOUBLE_EXP_STRING = "DOUBLE_EXP" !< String to specify the opacity scheme +real, parameter :: op_diag_len = 1e-10 !< Lengthscale L used to remap opacity + !! from op to 1/L * tanh(op * L) + contains !> This sets the opacity of sea water based based on one of several different schemes. @@ -165,6 +168,7 @@ subroutine set_opacity(optics, sw_total, sw_vis_dir, sw_vis_dif, sw_nir_dir, sw_ endif endif endif + if (query_averaging_enabled(CS%diag)) then if (CS%id_sw_pen > 0) then !$OMP parallel do default(shared) @@ -199,7 +203,10 @@ subroutine set_opacity(optics, sw_total, sw_vis_dir, sw_vis_dif, sw_nir_dir, sw_ do n=1,optics%nbands ; if (CS%id_opacity(n) > 0) then !$OMP parallel do default(shared) do k=1,nz ; do j=js,je ; do i=is,ie - tmp(i,j,k) = optics%opacity_band(n,i,j,k) + ! Remap opacity (op) to 1/L * tanh(op * L) where L is one Angstrom. + ! This gives a nearly identical value when op << 1/L but allows one to + ! store the values when opacity is divergent (i.e. opaque). + tmp(i,j,k) = tanh(op_diag_len * optics%opacity_band(n,i,j,k)) / op_diag_len enddo ; enddo ; enddo call post_data(CS%id_opacity(n), tmp, CS%diag) endif ; enddo @@ -1093,7 +1100,8 @@ subroutine opacity_init(Time, G, GV, US, param_file, diag, CS, optics) do n=1,optics%nbands write(bandnum,'(i3)') n shortname = 'opac_'//trim(adjustl(bandnum)) - longname = 'Opacity for shortwave radiation in band '//trim(adjustl(bandnum)) + longname = 'Opacity for shortwave radiation in band '//trim(adjustl(bandnum)) & + // ', saved as L^-1 tanh(Opacity * L) for L = 10^-10 m' CS%id_opacity(n) = register_diag_field('ocean_model', shortname, diag%axesTL, Time, & longname, 'm-1') enddo From 76ec07e15e8c0fe9eea51ee5a0fb947506a21fc8 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Wed, 17 Jul 2019 17:25:38 -0400 Subject: [PATCH 127/150] Rescaled the units of VarMix_CS%f2_dx2_h Rescaled the units of the f2_dx2_... and beta_dx2_... elements of VarMix_CS. These particular arrays are only used in calc_resoln_function, and because these are raised to arbitrary powers they have to be rescaled back to mks units in some cases. All answers are bitwise identical in the MOM6-examples test cases. --- .../lateral/MOM_lateral_mixing_coeffs.F90 | 121 +++++++++--------- .../lateral/MOM_thickness_diffuse.F90 | 4 +- 2 files changed, 64 insertions(+), 61 deletions(-) diff --git a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 index bcd3155cad..70b80b38cb 100644 --- a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 +++ b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 @@ -57,29 +57,29 @@ module MOM_lateral_mixing_coeffs L2v => NULL(), & !< Length scale^2 at v-points [m2] cg1 => NULL(), & !< The first baroclinic gravity wave speed [m s-1]. Res_fn_h => NULL(), & !< Non-dimensional function of the ratio the first baroclinic - !! deformation radius to the grid spacing at h points. + !! deformation radius to the grid spacing at h points [nondim]. Res_fn_q => NULL(), & !< Non-dimensional function of the ratio the first baroclinic - !! deformation radius to the grid spacing at q points. + !! deformation radius to the grid spacing at q points [nondim]. Res_fn_u => NULL(), & !< Non-dimensional function of the ratio the first baroclinic - !! deformation radius to the grid spacing at u points. + !! deformation radius to the grid spacing at u points [nondim]. Res_fn_v => NULL(), & !< Non-dimensional function of the ratio the first baroclinic - !! deformation radius to the grid spacing at v points. + !! deformation radius to the grid spacing at v points [nondim]. beta_dx2_h => NULL(), & !< The magnitude of the gradient of the Coriolis parameter - !! times the grid spacing squared at h points. + !! times the grid spacing squared at h points [m T-1 ~> m s-1]. beta_dx2_q => NULL(), & !< The magnitude of the gradient of the Coriolis parameter - !! times the grid spacing squared at q points. + !! times the grid spacing squared at q points [m T-1 ~> m s-1]. beta_dx2_u => NULL(), & !< The magnitude of the gradient of the Coriolis parameter - !! times the grid spacing squared at u points. + !! times the grid spacing squared at u points [m T-1 ~> m s-1]. beta_dx2_v => NULL(), & !< The magnitude of the gradient of the Coriolis parameter - !! times the grid spacing squared at v points. + !! times the grid spacing squared at v points [m T-1 ~> m s-1]. f2_dx2_h => NULL(), & !< The Coriolis parameter squared times the grid - !! spacing squared at h [m-2 s-2]. + !! spacing squared at h [m2 T-2 ~> m2 s-2]. f2_dx2_q => NULL(), & !< The Coriolis parameter squared times the grid - !! spacing squared at q [m-2 s-2]. + !! spacing squared at q [m2 T-2 ~> m2 s-2]. f2_dx2_u => NULL(), & !< The Coriolis parameter squared times the grid - !! spacing squared at u [m-2 s-2]. + !! spacing squared at u [m2 T-2 ~> m2 s-2]. f2_dx2_v => NULL(), & !< The Coriolis parameter squared times the grid - !! spacing squared at v [m-2 s-2]. + !! spacing squared at v [m2 T-2 ~> m2 s-2]. Rd_dx_h => NULL() !< Deformation radius over grid spacing [nondim] real, dimension(:,:,:), pointer :: & @@ -151,11 +151,14 @@ subroutine calc_resoln_function(h, tv, G, GV, US, CS) type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(VarMix_CS), pointer :: CS !< Variable mixing coefficients + ! Local variables - real :: cg1_q ! The gravity wave speed interpolated to q points [m s-1]. - real :: cg1_u ! The gravity wave speed interpolated to u points [m s-1]. - real :: cg1_v ! The gravity wave speed interpolated to v points [m s-1]. - real :: dx_term + ! Depending on the power-function being used, dimensional rescaling may be limited, so some + ! of the following variables have units that depend on that power. + real :: cg1_q ! The gravity wave speed interpolated to q points [m T-1 ~> m s-1] or [m s-1]. + real :: cg1_u ! The gravity wave speed interpolated to u points [m T-1 ~> m s-1] or [m s-1]. + real :: cg1_v ! The gravity wave speed interpolated to v points [m T-1 ~> m s-1] or [m s-1]. + real :: dx_term ! A term in the denominator [m2 T-2 ~> m2 s-2] or [m2 s-2] integer :: power_2 integer :: is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz integer :: i, j, k @@ -196,8 +199,8 @@ subroutine calc_resoln_function(h, tv, G, GV, US, CS) !$OMP parallel default(none) shared(is,ie,js,je,CS) !$OMP do do j=js-1,je+1 ; do i=is-1,ie+1 - CS%Rd_dx_h(i,j) = CS%cg1(i,j) / & - (sqrt(CS%f2_dx2_h(i,j) + CS%cg1(i,j)*CS%beta_dx2_h(i,j))) + CS%Rd_dx_h(i,j) = US%T_to_s*CS%cg1(i,j) / & + (sqrt(CS%f2_dx2_h(i,j) + US%T_to_s*CS%cg1(i,j)*CS%beta_dx2_h(i,j))) enddo ; enddo !$OMP end parallel if (query_averaging_enabled(CS%diag)) then @@ -240,8 +243,8 @@ subroutine calc_resoln_function(h, tv, G, GV, US, CS) if (CS%Res_fn_power_visc >= 100) then !$OMP do do j=js-1,je+1 ; do i=is-1,ie+1 - dx_term = CS%f2_dx2_h(i,j) + CS%cg1(i,j)*CS%beta_dx2_h(i,j) - if ((CS%Res_coef_visc * CS%cg1(i,j))**2 > dx_term) then + dx_term = CS%f2_dx2_h(i,j) + US%T_to_s*CS%cg1(i,j)*CS%beta_dx2_h(i,j) + if ((CS%Res_coef_visc * US%T_to_s*CS%cg1(i,j))**2 > dx_term) then CS%Res_fn_h(i,j) = 0.0 else CS%Res_fn_h(i,j) = 1.0 @@ -249,7 +252,7 @@ subroutine calc_resoln_function(h, tv, G, GV, US, CS) enddo ; enddo !$OMP do do J=js-1,Jeq ; do I=is-1,Ieq - cg1_q = 0.25 * ((CS%cg1(i,j) + CS%cg1(i+1,j+1)) + & + cg1_q = US%T_to_s * 0.25 * ((CS%cg1(i,j) + CS%cg1(i+1,j+1)) + & (CS%cg1(i+1,j) + CS%cg1(i,j+1))) dx_term = CS%f2_dx2_q(I,J) + cg1_q * CS%beta_dx2_q(I,J) if ((CS%Res_coef_visc * cg1_q)**2 > dx_term) then @@ -261,12 +264,12 @@ subroutine calc_resoln_function(h, tv, G, GV, US, CS) elseif (CS%Res_fn_power_visc == 2) then !$OMP do do j=js-1,je+1 ; do i=is-1,ie+1 - dx_term = CS%f2_dx2_h(i,j) + CS%cg1(i,j)*CS%beta_dx2_h(i,j) - CS%Res_fn_h(i,j) = dx_term / (dx_term + (CS%Res_coef_visc * CS%cg1(i,j))**2) + dx_term = CS%f2_dx2_h(i,j) + US%T_to_s*CS%cg1(i,j)*CS%beta_dx2_h(i,j) + CS%Res_fn_h(i,j) = dx_term / (dx_term + (CS%Res_coef_visc * US%T_to_s*CS%cg1(i,j))**2) enddo ; enddo !$OMP do do J=js-1,Jeq ; do I=is-1,Ieq - cg1_q = 0.25 * ((CS%cg1(i,j) + CS%cg1(i+1,j+1)) + & + cg1_q = US%T_to_s * 0.25 * ((CS%cg1(i,j) + CS%cg1(i+1,j+1)) + & (CS%cg1(i+1,j) + CS%cg1(i,j+1))) dx_term = CS%f2_dx2_q(I,J) + cg1_q * CS%beta_dx2_q(I,J) CS%Res_fn_q(I,J) = dx_term / (dx_term + (CS%Res_coef_visc * cg1_q)**2) @@ -275,7 +278,7 @@ subroutine calc_resoln_function(h, tv, G, GV, US, CS) power_2 = CS%Res_fn_power_visc / 2 !$OMP do do j=js-1,je+1 ; do i=is-1,ie+1 - dx_term = (CS%f2_dx2_h(i,j) + CS%cg1(i,j)*CS%beta_dx2_h(i,j))**power_2 + dx_term = (US%s_to_T**2*CS%f2_dx2_h(i,j) + CS%cg1(i,j)*US%s_to_T*CS%beta_dx2_h(i,j))**power_2 CS%Res_fn_h(i,j) = dx_term / & (dx_term + (CS%Res_coef_visc * CS%cg1(i,j))**CS%Res_fn_power_visc) enddo ; enddo @@ -283,15 +286,15 @@ subroutine calc_resoln_function(h, tv, G, GV, US, CS) do J=js-1,Jeq ; do I=is-1,Ieq cg1_q = 0.25 * ((CS%cg1(i,j) + CS%cg1(i+1,j+1)) + & (CS%cg1(i+1,j) + CS%cg1(i,j+1))) - dx_term = (CS%f2_dx2_q(I,J) + cg1_q * CS%beta_dx2_q(I,J))**power_2 + dx_term = (US%s_to_T**2*CS%f2_dx2_q(I,J) + cg1_q * US%s_to_T*CS%beta_dx2_q(I,J))**power_2 CS%Res_fn_q(I,J) = dx_term / & (dx_term + (CS%Res_coef_visc * cg1_q)**CS%Res_fn_power_visc) enddo ; enddo else !$OMP do do j=js-1,je+1 ; do i=is-1,ie+1 - dx_term = (sqrt(CS%f2_dx2_h(i,j) + & - CS%cg1(i,j)*CS%beta_dx2_h(i,j)))**CS%Res_fn_power_visc + dx_term = (US%s_to_T*sqrt(CS%f2_dx2_h(i,j) + & + US%T_to_s*CS%cg1(i,j)*CS%beta_dx2_h(i,j)))**CS%Res_fn_power_visc CS%Res_fn_h(i,j) = dx_term / & (dx_term + (CS%Res_coef_visc * CS%cg1(i,j))**CS%Res_fn_power_visc) enddo ; enddo @@ -299,8 +302,8 @@ subroutine calc_resoln_function(h, tv, G, GV, US, CS) do J=js-1,Jeq ; do I=is-1,Ieq cg1_q = 0.25 * ((CS%cg1(i,j) + CS%cg1(i+1,j+1)) + & (CS%cg1(i+1,j) + CS%cg1(i,j+1))) - dx_term = (sqrt(CS%f2_dx2_q(I,J) + & - cg1_q * CS%beta_dx2_q(I,J)))**CS%Res_fn_power_visc + dx_term = (US%s_to_T*sqrt(CS%f2_dx2_q(I,J) + & + US%T_to_s*cg1_q * CS%beta_dx2_q(I,J)))**CS%Res_fn_power_visc CS%Res_fn_q(I,J) = dx_term / & (dx_term + (CS%Res_coef_visc * cg1_q)**CS%Res_fn_power_visc) enddo ; enddo @@ -317,7 +320,7 @@ subroutine calc_resoln_function(h, tv, G, GV, US, CS) if (CS%Res_fn_power_khth >= 100) then !$OMP do do j=js,je ; do I=is-1,Ieq - cg1_u = 0.5 * (CS%cg1(i,j) + CS%cg1(i+1,j)) + cg1_u = 0.5 * US%T_to_s * (CS%cg1(i,j) + CS%cg1(i+1,j)) dx_term = CS%f2_dx2_u(I,j) + cg1_u * CS%beta_dx2_u(I,j) if ((CS%Res_coef_khth * cg1_u)**2 > dx_term) then CS%Res_fn_u(I,j) = 0.0 @@ -327,7 +330,7 @@ subroutine calc_resoln_function(h, tv, G, GV, US, CS) enddo ; enddo !$OMP do do J=js-1,Jeq ; do i=is,ie - cg1_v = 0.5 * (CS%cg1(i,j) + CS%cg1(i,j+1)) + cg1_v = 0.5 * US%T_to_s * (CS%cg1(i,j) + CS%cg1(i,j+1)) dx_term = CS%f2_dx2_v(i,J) + cg1_v * CS%beta_dx2_v(i,J) if ((CS%Res_coef_khth * cg1_v)**2 > dx_term) then CS%Res_fn_v(i,J) = 0.0 @@ -338,13 +341,13 @@ subroutine calc_resoln_function(h, tv, G, GV, US, CS) elseif (CS%Res_fn_power_khth == 2) then !$OMP do do j=js,je ; do I=is-1,Ieq - cg1_u = 0.5 * (CS%cg1(i,j) + CS%cg1(i+1,j)) + cg1_u = 0.5 * US%T_to_s * (CS%cg1(i,j) + CS%cg1(i+1,j)) dx_term = CS%f2_dx2_u(I,j) + cg1_u * CS%beta_dx2_u(I,j) CS%Res_fn_u(I,j) = dx_term / (dx_term + (CS%Res_coef_khth * cg1_u)**2) enddo ; enddo !$OMP do do J=js-1,Jeq ; do i=is,ie - cg1_v = 0.5 * (CS%cg1(i,j) + CS%cg1(i,j+1)) + cg1_v = 0.5 * US%T_to_s * (CS%cg1(i,j) + CS%cg1(i,j+1)) dx_term = CS%f2_dx2_v(i,J) + cg1_v * CS%beta_dx2_v(i,J) CS%Res_fn_v(i,J) = dx_term / (dx_term + (CS%Res_coef_khth * cg1_v)**2) enddo ; enddo @@ -353,14 +356,14 @@ subroutine calc_resoln_function(h, tv, G, GV, US, CS) !$OMP do do j=js,je ; do I=is-1,Ieq cg1_u = 0.5 * (CS%cg1(i,j) + CS%cg1(i+1,j)) - dx_term = (CS%f2_dx2_u(I,j) + cg1_u * CS%beta_dx2_u(I,j))**power_2 + dx_term = (US%s_to_T**2*CS%f2_dx2_u(I,j) + cg1_u * US%s_to_T*CS%beta_dx2_u(I,j))**power_2 CS%Res_fn_u(I,j) = dx_term / & (dx_term + (CS%Res_coef_khth * cg1_u)**CS%Res_fn_power_khth) enddo ; enddo !$OMP do do J=js-1,Jeq ; do i=is,ie cg1_v = 0.5 * (CS%cg1(i,j) + CS%cg1(i,j+1)) - dx_term = (CS%f2_dx2_v(i,J) + cg1_v * CS%beta_dx2_v(i,J))**power_2 + dx_term = (US%s_to_T**2*CS%f2_dx2_v(i,J) + cg1_v * US%s_to_T*CS%beta_dx2_v(i,J))**power_2 CS%Res_fn_v(i,J) = dx_term / & (dx_term + (CS%Res_coef_khth * cg1_v)**CS%Res_fn_power_khth) enddo ; enddo @@ -368,16 +371,16 @@ subroutine calc_resoln_function(h, tv, G, GV, US, CS) !$OMP do do j=js,je ; do I=is-1,Ieq cg1_u = 0.5 * (CS%cg1(i,j) + CS%cg1(i+1,j)) - dx_term = (sqrt(CS%f2_dx2_u(I,j) + & - cg1_u * CS%beta_dx2_u(I,j)))**CS%Res_fn_power_khth + dx_term = (US%s_to_T*sqrt(CS%f2_dx2_u(I,j) + & + US%T_to_s*cg1_u * CS%beta_dx2_u(I,j)))**CS%Res_fn_power_khth CS%Res_fn_u(I,j) = dx_term / & (dx_term + (CS%Res_coef_khth * cg1_u)**CS%Res_fn_power_khth) enddo ; enddo !$OMP do do J=js-1,Jeq ; do i=is,ie cg1_v = 0.5 * (CS%cg1(i,j) + CS%cg1(i,j+1)) - dx_term = (sqrt(CS%f2_dx2_v(i,J) + & - cg1_v * CS%beta_dx2_v(i,J)))**CS%Res_fn_power_khth + dx_term = (US%s_to_T*sqrt(CS%f2_dx2_v(i,J) + & + US%T_to_s*cg1_v * CS%beta_dx2_v(i,J)))**CS%Res_fn_power_khth CS%Res_fn_v(i,J) = dx_term / & (dx_term + (CS%Res_coef_khth * cg1_v)**CS%Res_fn_power_khth) enddo ; enddo @@ -583,7 +586,7 @@ subroutine calc_slope_functions_using_just_e(h, G, GV, US, CS, e, calculate_slop 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 :: S2 ! Interface slope squared [nondim] - real :: N2 ! Brunt-Vaisala frequency [s-1] + real :: N2 ! Brunt-Vaisala frequency squared [T-2 ~> s-2] real :: Hup, Hdn ! Thickness from above, below [H ~> m or kg m-2] real :: H_geom ! The geometric mean of Hup*Hdn [H ~> m or kg m-2]. real :: Z_to_L ! A conversion factor between from units for e to the @@ -591,8 +594,8 @@ subroutine calc_slope_functions_using_just_e(h, G, GV, US, CS, e, calculate_slop real :: one_meter ! One meter in thickness units [H ~> m or kg m-2]. integer :: is, ie, js, je, nz integer :: i, j, k, kb_max - real :: SN_u_local(SZIB_(G), SZJ_(G),SZK_(G)) - real :: SN_v_local(SZI_(G), SZJB_(G),SZK_(G)) + real :: S2N2_u_local(SZIB_(G), SZJ_(G),SZK_(G)) + real :: S2N2_v_local(SZI_(G), SZJB_(G),SZK_(G)) if (.not. associated(CS)) call MOM_error(FATAL, "calc_slope_function:"// & "Module must be initialized before it is used.") @@ -646,10 +649,10 @@ subroutine calc_slope_functions_using_just_e(h, G, GV, US, CS, e, calculate_slop Hdn = 2.*h(i,j,k)*h(i,j,k-1) / (h(i,j,k) + h(i,j,k-1) + h_neglect) Hup = 2.*h(i+1,j,k)*h(i+1,j,k-1) / (h(i+1,j,k) + h(i+1,j,k-1) + h_neglect) H_geom = sqrt(Hdn*Hup) - N2 = US%s_to_T**2*GV%g_prime(k)*US%L_to_Z**2 / (GV%H_to_Z * max(Hdn,Hup,one_meter)) + N2 = GV%g_prime(k)*US%L_to_Z**2 / (GV%H_to_Z * max(Hdn,Hup,one_meter)) if (min(h(i,j,k-1), h(i+1,j,k-1), h(i,j,k), h(i+1,j,k)) < H_cutoff) & S2 = 0.0 - SN_u_local(I,j,k) = (H_geom * GV%H_to_Z) * S2 * N2 + S2N2_u_local(I,j,k) = (H_geom * GV%H_to_Z) * S2 * N2 enddo ; enddo do J=js-1,je ; do i=is,ie S2 = ( E_y(i,J)**2 + 0.25*( & @@ -657,10 +660,10 @@ subroutine calc_slope_functions_using_just_e(h, G, GV, US, CS, e, calculate_slop Hdn = 2.*h(i,j,k)*h(i,j,k-1) / (h(i,j,k) + h(i,j,k-1) + h_neglect) Hup = 2.*h(i,j+1,k)*h(i,j+1,k-1) / (h(i,j+1,k) + h(i,j+1,k-1) + h_neglect) H_geom = sqrt(Hdn*Hup) - N2 = US%s_to_T**2*GV%g_prime(k)*US%L_to_Z**2 / (GV%H_to_Z * max(Hdn,Hup,one_meter)) + N2 = GV%g_prime(k)*US%L_to_Z**2 / (GV%H_to_Z * max(Hdn,Hup,one_meter)) if (min(h(i,j,k-1), h(i,j+1,k-1), h(i,j,k), h(i,j+1,k)) < H_cutoff) & S2 = 0.0 - SN_v_local(i,J,k) = (H_geom * GV%H_to_Z) * S2 * N2 + S2N2_v_local(i,J,k) = (H_geom * GV%H_to_Z) * S2 * N2 enddo ; enddo enddo ! k @@ -668,14 +671,14 @@ subroutine calc_slope_functions_using_just_e(h, G, GV, US, CS, e, calculate_slop do j=js,je do I=is-1,ie ; CS%SN_u(I,j) = 0.0 ; enddo do k=nz,CS%VarMix_Ktop,-1 ; do I=is-1,ie - CS%SN_u(I,j) = CS%SN_u(I,j) + SN_u_local(I,j,k) + CS%SN_u(I,j) = CS%SN_u(I,j) + S2N2_u_local(I,j,k) enddo ; enddo ! SN above contains S^2*N^2*H, convert to vertical average of S*N do I=is-1,ie !SN_u(I,j) = sqrt( SN_u(I,j) / ( max(G%bathyT(I,j), G%bathyT(I+1,j)) + GV%Angstrom_Z ) )) !The code below behaves better than the line above. Not sure why? AJA if ( min(G%bathyT(I,j), G%bathyT(I+1,j)) > H_cutoff*GV%H_to_Z ) then - CS%SN_u(I,j) = G%mask2dCu(I,j) * sqrt( CS%SN_u(I,j) / & + CS%SN_u(I,j) = G%mask2dCu(I,j) * US%s_to_T * sqrt( CS%SN_u(I,j) / & (max(G%bathyT(I,j), G%bathyT(I+1,j))) ) else CS%SN_u(I,j) = 0.0 @@ -686,13 +689,13 @@ subroutine calc_slope_functions_using_just_e(h, G, GV, US, CS, e, calculate_slop do J=js-1,je do i=is,ie ; CS%SN_v(i,J) = 0.0 ; enddo do k=nz,CS%VarMix_Ktop,-1 ; do i=is,ie - CS%SN_v(i,J) = CS%SN_v(i,J) + SN_v_local(i,J,k) + CS%SN_v(i,J) = CS%SN_v(i,J) + S2N2_v_local(i,J,k) enddo ; enddo do i=is,ie !SN_v(i,J) = sqrt( SN_v(i,J) / ( max(G%bathyT(i,J), G%bathyT(i,J+1)) + GV%Angstrom_Z ) )) !The code below behaves better than the line above. Not sure why? AJA if ( min(G%bathyT(I,j), G%bathyT(I+1,j)) > H_cutoff*GV%H_to_Z ) then - CS%SN_v(i,J) = G%mask2dCv(i,J) * sqrt( CS%SN_v(i,J) / & + CS%SN_v(i,J) = G%mask2dCv(i,J) * US%s_to_T * sqrt( CS%SN_v(i,J) / & (max(G%bathyT(i,J), G%bathyT(i,J+1))) ) else CS%SN_v(I,j) = 0.0 @@ -1115,9 +1118,9 @@ subroutine VarMix_init(Time, G, GV, US, param_file, diag, CS) endif do J=js-1,Jeq ; do I=is-1,Ieq - CS%f2_dx2_q(I,J) = US%s_to_T**2 * (G%dxBu(I,J)**2 + G%dyBu(I,J)**2) * & + CS%f2_dx2_q(I,J) = (G%dxBu(I,J)**2 + G%dyBu(I,J)**2) * & max(G%CoriolisBu(I,J)**2, absurdly_small_freq**2) - CS%beta_dx2_q(I,J) = oneOrTwo * (G%dxBu(I,J)**2 + G%dyBu(I,J)**2) * (US%s_to_T * sqrt(0.5 * & + CS%beta_dx2_q(I,J) = oneOrTwo * (G%dxBu(I,J)**2 + G%dyBu(I,J)**2) * (sqrt(0.5 * & ( (((G%CoriolisBu(I,J)-G%CoriolisBu(I-1,J)) * G%IdxCv(i,J))**2 + & ((G%CoriolisBu(I+1,J)-G%CoriolisBu(I,J)) * G%IdxCv(i+1,J))**2) + & (((G%CoriolisBu(I,J)-G%CoriolisBu(I,J-1)) * G%IdyCu(I,j))**2 + & @@ -1125,9 +1128,9 @@ subroutine VarMix_init(Time, G, GV, US, param_file, diag, CS) enddo ; enddo do j=js,je ; do I=is-1,Ieq - CS%f2_dx2_u(I,j) = US%s_to_T**2 *(G%dxCu(I,j)**2 + G%dyCu(I,j)**2) * & + CS%f2_dx2_u(I,j) = (G%dxCu(I,j)**2 + G%dyCu(I,j)**2) * & max(0.5* (G%CoriolisBu(I,J)**2+G%CoriolisBu(I,J-1)**2), absurdly_small_freq**2) - CS%beta_dx2_u(I,j) = oneOrTwo * (G%dxCu(I,j)**2 + G%dyCu(I,j)**2) * (US%s_to_T * sqrt( & + CS%beta_dx2_u(I,j) = oneOrTwo * (G%dxCu(I,j)**2 + G%dyCu(I,j)**2) * (sqrt( & 0.25*( (((G%CoriolisBu(I,J-1)-G%CoriolisBu(I-1,J-1)) * G%IdxCv(i,J-1))**2 + & ((G%CoriolisBu(I+1,J)-G%CoriolisBu(I,J)) * G%IdxCv(i+1,J))**2) + & (((G%CoriolisBu(I+1,J-1)-G%CoriolisBu(I,J-1)) * G%IdxCv(i+1,J-1))**2 + & @@ -1136,9 +1139,9 @@ subroutine VarMix_init(Time, G, GV, US, param_file, diag, CS) enddo ; enddo do J=js-1,Jeq ; do i=is,ie - CS%f2_dx2_v(i,J) = US%s_to_T**2*(G%dxCv(i,J)**2 + G%dyCv(i,J)**2) * & + CS%f2_dx2_v(i,J) = (G%dxCv(i,J)**2 + G%dyCv(i,J)**2) * & max(0.5*(G%CoriolisBu(I,J)**2+G%CoriolisBu(I-1,J)**2), absurdly_small_freq**2) - CS%beta_dx2_v(i,J) = oneOrTwo * (G%dxCv(i,J)**2 + G%dyCv(i,J)**2) * (US%s_to_T * sqrt( & + CS%beta_dx2_v(i,J) = oneOrTwo * (G%dxCv(i,J)**2 + G%dyCv(i,J)**2) * (sqrt( & ((G%CoriolisBu(I,J)-G%CoriolisBu(I-1,J)) * G%IdxCv(i,J))**2 + & 0.25*( (((G%CoriolisBu(I,J)-G%CoriolisBu(I,J-1)) * G%IdyCu(I,j))**2 + & ((G%CoriolisBu(I-1,J+1)-G%CoriolisBu(I-1,J)) * G%IdyCu(I-1,j+1))**2) + & @@ -1159,11 +1162,11 @@ subroutine VarMix_init(Time, G, GV, US, param_file, diag, CS) allocate(CS%beta_dx2_h(isd:ied,jsd:jed)); CS%beta_dx2_h(:,:) = 0.0 allocate(CS%f2_dx2_h(isd:ied,jsd:jed)) ; CS%f2_dx2_h(:,:) = 0.0 do j=js-1,je+1 ; do i=is-1,ie+1 - CS%f2_dx2_h(i,j) = US%s_to_T**2 * (G%dxT(i,j)**2 + G%dyT(i,j)**2) * & + CS%f2_dx2_h(i,j) = (G%dxT(i,j)**2 + G%dyT(i,j)**2) * & max(0.25 * ((G%CoriolisBu(I,J)**2 + G%CoriolisBu(I-1,J-1)**2) + & (G%CoriolisBu(I-1,J)**2 + G%CoriolisBu(I,J-1)**2)), & absurdly_small_freq**2) - CS%beta_dx2_h(i,j) = oneOrTwo * (G%dxT(i,j)**2 + G%dyT(i,j)**2) * (US%s_to_T * sqrt(0.5 * & + CS%beta_dx2_h(i,j) = oneOrTwo * (G%dxT(i,j)**2 + G%dyT(i,j)**2) * (sqrt(0.5 * & ( (((G%CoriolisBu(I,J)-G%CoriolisBu(I-1,J)) * G%IdxCv(i,J))**2 + & ((G%CoriolisBu(I,J-1)-G%CoriolisBu(I-1,J-1)) * G%IdxCv(i,J-1))**2) + & (((G%CoriolisBu(I,J)-G%CoriolisBu(I,J-1)) * G%IdyCu(I,j))**2 + & diff --git a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 index 7fd3a30985..04d3847e88 100644 --- a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 +++ b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 @@ -356,8 +356,8 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp !$OMP do if (CS%use_GME_thickness_diffuse) then - do k=1,nz+1 ; do j=js-1,je ; do I=is,ie - CS%KH_v_GME(I,j,k) = KH_v(I,j,k) + do k=1,nz+1 ; do J=js-1,je ; do i=is,ie + CS%KH_v_GME(i,J,k) = KH_v(i,J,k) enddo ; enddo ; enddo endif From 4ecb7d585dd48ee4b849add2d6bf47817aa75641 Mon Sep 17 00:00:00 2001 From: Alistair Adcroft Date: Sun, 21 Jul 2019 16:39:15 +0000 Subject: [PATCH 128/150] More useful message when detecting bad surface state When the surface state went out of user-specified bounds we reported an error such as: ``` WARNING from PE 130: Extreme surface sfc_state detected: i= 18 j= 18 x= -60.625 y= -72.075 D= 1.9385E+01 SSH=-1.1945E+00 SST=-2.5183E+00 SSS= 3.2605E+01 U-= 0.0000E+00 U+=-8.9452E-03 V-= 0.0000E+00 V+= 0.0000E+00 ``` The i,j here are the on-core local i,j and the x,y are the geographic location (so you can find the location on a map). Neither of these are particularly useful when looking at actual model output unless you are adept on porjections. This commit changes the message to: ``` WARNING from PE 130: Extreme surface sfc_state detected: i= 958 j= 89 lon= -60.625 lat= -72.075 x= -60.042 y= -72.075 D= 1.9385E+01 SSH=-1.1945E+00 SST=-2.5183E+00 SSS= 3.2605E+01 U-= 0.0000E+00 U+=-8.9452E-0 3 V-= 0.0000E+00 V+= 0.0000E+00 ``` which allows you to look at model output using either indices or coordinates and still find the location on a map. - Changes the reported i,j-location to global index - Adds the diagnostic grid-lon,lat to report --- src/core/MOM.F90 | 18 +++++++++++------- 1 file changed, 11 insertions(+), 7 deletions(-) diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index f219891900..3cfcaa1880 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -2701,7 +2701,7 @@ subroutine extract_surface_state(CS, sfc_state) real :: T_freeze !< freezing temperature [degC] real :: delT(SZI_(CS%G)) !< T-T_freeze [degC] logical :: use_temperature !< If true, temp and saln used as state variables. - integer :: i, j, k, is, ie, js, je, nz, numberOfErrors + integer :: i, j, k, is, ie, js, je, nz, numberOfErrors, ig, jg integer :: isd, ied, jsd, jed integer :: iscB, iecB, jscB, jecB, isdB, iedB, jsdB, jedB logical :: localError @@ -2980,18 +2980,22 @@ subroutine extract_surface_state(CS, sfc_state) if (localError) then numberOfErrors=numberOfErrors+1 if (numberOfErrors<9) then ! Only report details for the first few errors + ig = i + G%HI%idg_offset ! Global i-index + jg = j + G%HI%jdg_offset ! Global j-index if (use_temperature) then - write(msg(1:240),'(2(a,i4,x),2(a,f8.3,x),8(a,es11.4,x))') & - 'Extreme surface sfc_state detected: i=',i,'j=',j, & - 'x=',G%geoLonT(i,j), 'y=',G%geoLatT(i,j), & + write(msg(1:240),'(2(a,i4,x),4(a,f8.3,x),8(a,es11.4,x))') & + 'Extreme surface sfc_state detected: i=',ig,'j=',jg, & + 'lon=',G%geoLonT(i,j), 'lat=',G%geoLatT(i,j), & + 'x=',G%gridLonT(ig), 'y=',G%gridLatT(jg), & 'D=',bathy_m, 'SSH=',sfc_state%sea_lev(i,j), & 'SST=',sfc_state%SST(i,j), 'SSS=',sfc_state%SSS(i,j), & 'U-=',sfc_state%u(I-1,j), 'U+=',sfc_state%u(I,j), & 'V-=',sfc_state%v(i,J-1), 'V+=',sfc_state%v(i,J) else - write(msg(1:240),'(2(a,i4,x),2(a,f8.3,x),6(a,es11.4))') & - 'Extreme surface sfc_state detected: i=',i,'j=',j, & - 'x=',G%geoLonT(i,j), 'y=',G%geoLatT(i,j), & + write(msg(1:240),'(2(a,i4,x),4(a,f8.3,x),6(a,es11.4))') & + 'Extreme surface sfc_state detected: i=',ig,'j=',jg, & + 'lon=',G%geoLonT(i,j), 'lat=',G%geoLatT(i,j), & + 'x=',G%gridLonT(i), 'y=',G%gridLatT(j), & 'D=',bathy_m, 'SSH=',sfc_state%sea_lev(i,j), & 'U-=',sfc_state%u(I-1,j), 'U+=',sfc_state%u(I,j), & 'V-=',sfc_state%v(i,J-1), 'V+=',sfc_state%v(i,J) From 8bc76a8fe53a6463aa6de309237489b43bbba079 Mon Sep 17 00:00:00 2001 From: Alistair Adcroft Date: Sun, 21 Jul 2019 16:58:29 +0000 Subject: [PATCH 129/150] Allows vector-of-reals debugging parameters When defining a parameter with get_param() we can indicate that the parameter is for debugging purposes with the optional argument `debuggingParam=.true.`. This had been implemented for scalar reals but not for a vector of reals. --- src/framework/MOM_file_parser.F90 | 14 ++++++++++---- 1 file changed, 10 insertions(+), 4 deletions(-) diff --git a/src/framework/MOM_file_parser.F90 b/src/framework/MOM_file_parser.F90 index 1d1e153ab9..4746a36f9e 100644 --- a/src/framework/MOM_file_parser.F90 +++ b/src/framework/MOM_file_parser.F90 @@ -1370,7 +1370,7 @@ end subroutine log_param_real !> Log the name and values of an array of real model parameter in documentation files. subroutine log_param_real_array(CS, modulename, varname, value, desc, & - units, default) + units, default, debuggingParam) type(param_file_type), intent(in) :: CS !< The control structure for the file_parser module, !! it is also a structure to parse for run-time parameters character(len=*), intent(in) :: modulename !< The name of the calling module @@ -1380,6 +1380,8 @@ subroutine log_param_real_array(CS, modulename, varname, value, desc, & !! present, this parameter is not written to a doc file character(len=*), optional, intent(in) :: units !< The units of this parameter real, optional, intent(in) :: default !< The default value of the parameter + logical, optional, intent(in) :: debuggingParam !< If present and true, this parameter is + !! logged in the debugging parameter file character(len=1320) :: mesg character(len=240) :: myunits @@ -1396,7 +1398,8 @@ subroutine log_param_real_array(CS, modulename, varname, value, desc, & myunits="not defined"; if (present(units)) write(myunits(1:240),'(A)') trim(units) if (present(desc)) & - call doc_param(CS%doc, varname, desc, myunits, value, default) + call doc_param(CS%doc, varname, desc, myunits, value, default, & + debuggingParam=debuggingParam) end subroutine log_param_real_array @@ -1739,7 +1742,8 @@ end subroutine get_param_real !> This subroutine reads the values of an array of real model parameters from a parameter file !! and logs them in documentation files. subroutine get_param_real_array(CS, modulename, varname, value, desc, units, & - default, fail_if_missing, do_not_read, do_not_log, static_value, scale, unscaled) + default, fail_if_missing, do_not_read, do_not_log, debuggingParam, & + static_value, scale, unscaled) type(param_file_type), intent(in) :: CS !< The control structure for the file_parser module, !! it is also a structure to parse for run-time parameters character(len=*), intent(in) :: modulename !< The name of the calling module @@ -1759,6 +1763,8 @@ subroutine get_param_real_array(CS, modulename, varname, value, desc, units, & !! value for this parameter, although it might be logged. logical, optional, intent(in) :: do_not_log !< If present and true, do not log this !! parameter to the documentation files + logical, optional, intent(in) :: debuggingParam !< If present and true, this parameter is + !! logged in the debugging parameter file real, optional, intent(in) :: scale !< A scaling factor that the parameter is !! multiplied by before it is returned. real, dimension(:), optional, intent(out) :: unscaled !< The value of the parameter that would be @@ -1777,7 +1783,7 @@ subroutine get_param_real_array(CS, modulename, varname, value, desc, units, & if (do_log) then call log_param_real_array(CS, modulename, varname, value, desc, & - units, default) + units, default, debuggingParam) endif if (present(unscaled)) unscaled(:) = value(:) From a029b089d57c95bf2562a6628b3370886fde35eb Mon Sep 17 00:00:00 2001 From: Marshall Ward Date: Mon, 22 Jul 2019 13:24:46 -0400 Subject: [PATCH 130/150] KE_adv diag calculation using mask2d The KE_adv diagnostic is a sum of values multiplied by -1, which will assign a -0.0 value for zero-initialized states. This can lead to reproducibility problems for symmetric and nonsymmetric grids, since many intermediate calculations rely on masking of the u field and do not apply masks to subsequent steps. This can occur when a MPP domain is bordered by land, where calculations on the S and W boundaries of a symmetric grids are computed as if they are unmasked, and would be assigned a -0.0 value. For nonsymmetric grids, these values were never computed and would retain a +0.0 value. We resolve this by re-initalizing the KE_u and KE_v fields, since they are re-used as buffers for several diagnostics, and exclude masked points from the calculation. This ensures +0.0 values in any land boundaries across symmetric grids. If the masking is applied to other fields using `KE_u` and `KE_v`, then we may be able to remove the re-initialization step. While +/-0.0 are arithmetically identical in all cases, this fix will preserve bitwise reproducibility and is a step towards phasing out the `abs()` operation in the checksums. --- src/diagnostics/MOM_diagnostics.F90 | 10 ++++++++-- 1 file changed, 8 insertions(+), 2 deletions(-) diff --git a/src/diagnostics/MOM_diagnostics.F90 b/src/diagnostics/MOM_diagnostics.F90 index 7997571404..d40d4577f1 100644 --- a/src/diagnostics/MOM_diagnostics.F90 +++ b/src/diagnostics/MOM_diagnostics.F90 @@ -994,12 +994,18 @@ subroutine calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, GV, CS) endif if (associated(CS%KE_adv)) then + ! NOTE: All terms in KE_adv are multipled by -1, which can easily produce + ! negative zeros and may signal a reproducibility issue over land. + ! We resolve this by re-initializing and only evaluating over water points. + KE_u(:,:) = 0. ; KE_v(:,:) = 0. do k=1,nz do j=js,je ; do I=Isq,Ieq - KE_u(I,j) = uh(I,j,k)*G%dxCu(I,j)*ADp%gradKEu(I,j,k) + if (G%mask2dCu(i,j) /= 0.) & + KE_u(I,j) = uh(I,j,k)*G%dxCu(I,j)*ADp%gradKEu(I,j,k) enddo ; enddo do J=Jsq,Jeq ; do i=is,ie - KE_v(i,J) = vh(i,J,k)*G%dyCv(i,J)*ADp%gradKEv(i,J,k) + if (G%mask2dCv(i,j) /= 0.) & + KE_v(i,J) = vh(i,J,k)*G%dyCv(i,J)*ADp%gradKEv(i,J,k) enddo ; enddo do j=js,je ; do i=is,ie KE_h(i,j) = -CS%KE(i,j,k) * G%IareaT(i,j) * & From 3467662c7587ff677962bf9041dfad0bff9f6774 Mon Sep 17 00:00:00 2001 From: Marshall Ward Date: Mon, 22 Jul 2019 13:39:05 -0400 Subject: [PATCH 131/150] Conditional registration of KPP_OBLdepth_original The diagnostic KPP_OBLdepth_original requires a nonzero CS%n_smooth value, but it is currently possible to register this diagnostic even when this parameter is unset. This patch only registers the diagnostic when n_smooth is defined. --- src/parameterizations/vertical/MOM_CVMix_KPP.F90 | 10 ++++++---- 1 file changed, 6 insertions(+), 4 deletions(-) diff --git a/src/parameterizations/vertical/MOM_CVMix_KPP.F90 b/src/parameterizations/vertical/MOM_CVMix_KPP.F90 index 159a88958b..075e89426e 100644 --- a/src/parameterizations/vertical/MOM_CVMix_KPP.F90 +++ b/src/parameterizations/vertical/MOM_CVMix_KPP.F90 @@ -468,10 +468,12 @@ logical function KPP_init(paramFile, G, GV, US, diag, Time, CS, passive, Waves) ! CMOR names are placeholders; must be modified by time period ! for CMOR compliance. Diag manager will be used for omlmax and ! omldamax. - CS%id_OBLdepth_original = register_diag_field('ocean_model', 'KPP_OBLdepth_original', diag%axesT1, Time, & - 'Thickness of the surface Ocean Boundary Layer without smoothing calculated by [CVMix] KPP', 'meter', & - cmor_field_name='oml', cmor_long_name='ocean_mixed_layer_thickness_defined_by_mixing_scheme', & - cmor_units='m', cmor_standard_name='Ocean Mixed Layer Thickness Defined by Mixing Scheme') + if (CS%n_smooth > 0) then + CS%id_OBLdepth_original = register_diag_field('ocean_model', 'KPP_OBLdepth_original', diag%axesT1, Time, & + 'Thickness of the surface Ocean Boundary Layer without smoothing calculated by [CVMix] KPP', 'meter', & + cmor_field_name='oml', cmor_long_name='ocean_mixed_layer_thickness_defined_by_mixing_scheme', & + cmor_units='m', cmor_standard_name='Ocean Mixed Layer Thickness Defined by Mixing Scheme') + endif CS%id_BulkDrho = register_diag_field('ocean_model', 'KPP_BulkDrho', diag%axesTL, Time, & 'Bulk difference in density used in Bulk Richardson number, as used by [CVMix] KPP', 'kg/m3') CS%id_BulkUz2 = register_diag_field('ocean_model', 'KPP_BulkUz2', diag%axesTL, Time, & From 1094bdd6d2fbed6724446ccbcd60836001afe1f3 Mon Sep 17 00:00:00 2001 From: Alistair Adcroft Date: Tue, 23 Jul 2019 12:34:22 +0000 Subject: [PATCH 132/150] Use f2e2c86f6c0eb commit for FMS in .testing - Prior to rolling forward the FMS submodule in MOM6-examples, this rolls evaluates that version in the Travis-CI pipeline. - f2e2c86f6c0eb includes changes necessary to build MOM6 on MacOS. --- .testing/Makefile | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.testing/Makefile b/.testing/Makefile index ee561375a3..6bafa2191e 100644 --- a/.testing/Makefile +++ b/.testing/Makefile @@ -2,7 +2,7 @@ # e.g. make MEMORY_SHAPE=dynamic_symmetric REPRO=1 OPENMP=1 # Versions to use -FMS_COMMIT ?= xanadu +FMS_COMMIT ?= f2e2c86f6c0eb6d389a20509a8a60fa22924e16b MKMF_COMMIT ?= master # Where to clone from From f0fec84f1cde95ebd0dcefad8fc7fe2f593ffcc5 Mon Sep 17 00:00:00 2001 From: "brandon.reichl" Date: Tue, 23 Jul 2019 10:05:44 -0400 Subject: [PATCH 133/150] Adding scale_factor and add_offset for MOM_horizontal_regridding.F90 netCDF inputs in horiz_interp_and_extrap_tracer_record --- src/framework/MOM_horizontal_regridding.F90 | 10 +++++++++- 1 file changed, 9 insertions(+), 1 deletion(-) diff --git a/src/framework/MOM_horizontal_regridding.F90 b/src/framework/MOM_horizontal_regridding.F90 index 21d581978a..2113d5156e 100644 --- a/src/framework/MOM_horizontal_regridding.F90 +++ b/src/framework/MOM_horizontal_regridding.F90 @@ -303,6 +303,7 @@ subroutine horiz_interp_and_extrap_tracer_record(filename, varnam, conversion, real, dimension(:), allocatable :: lat_inp, last_row real :: max_lat, min_lat, pole, max_depth, npole real :: roundoff ! The magnitude of roundoff, usually ~2e-16. + real :: add_offset, scale_factor logical :: add_np character(len=8) :: laynum type(horiz_interp_type) :: Interp @@ -376,6 +377,13 @@ subroutine horiz_interp_and_extrap_tracer_record(filename, varnam, conversion, if (rcode /= 0) call MOM_error(FATAL,"error finding missing value for "//& trim(varnam)//" in file "// trim(filename)//" in hinterp_extrap") + rcode = NF90_GET_ATT(ncid, varid, "add_offset", add_offset) + if (rcode /= 0) add_offset = 0.0 + + rcode = NF90_GET_ATT(ncid, varid, "scale_factor", scale_factor) + if (rcode /= 0) scale_factor = 1.0 + + if (allocated(lon_in)) deallocate(lon_in) if (allocated(lat_in)) deallocate(lat_in) if (allocated(z_in)) deallocate(z_in) @@ -499,7 +507,7 @@ subroutine horiz_interp_and_extrap_tracer_record(filename, varnam, conversion, do i=1,id if (abs(tr_inp(i,j)-missing_value) > abs(roundoff*missing_value)) then mask_in(i,j) = 1.0 - tr_inp(i,j) = tr_inp(i,j) * conversion + tr_inp(i,j) = (tr_inp(i,j)*scale_factor+add_offset) * conversion else tr_inp(i,j) = missing_value endif From d8a5970a81db33d668ab55da426656ab0b4ebe84 Mon Sep 17 00:00:00 2001 From: Raphael Dussin Date: Tue, 23 Jul 2019 13:19:14 -0400 Subject: [PATCH 134/150] unit change, fix #934 --- src/core/MOM.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index 3cfcaa1880..901b15fd4a 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -2009,7 +2009,7 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & endif call register_tracer(CS%tv%T, CS%tracer_Reg, param_file, dG%HI, GV, & tr_desc=vd_T, registry_diags=.true., flux_nameroot='T', & - flux_units='W m-2', flux_longname='Heat', & + flux_units='W', flux_longname='Heat', & flux_scale=conv2watt, convergence_units='W m-2', & convergence_scale=conv2watt, CMOR_tendprefix="opottemp", diag_form=2) call register_tracer(CS%tv%S, CS%tracer_Reg, param_file, dG%HI, GV, & From 1305e73b24bb1a566c5c0904be4061ff01cb373a Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Mon, 29 Jul 2019 16:23:51 -0600 Subject: [PATCH 135/150] Rename modules in MCT --- ...M_ocean_model.F90 => MOM_MCT_ocean_model.F90} | 16 ++++++++-------- ...e_forcing.F90 => MOM_MCT_surface_forcing.F90} | 6 +++--- config_src/mct_driver/ocn_cap_methods.F90 | 16 ++++++++-------- config_src/mct_driver/ocn_comp_mct.F90 | 8 ++++---- 4 files changed, 23 insertions(+), 23 deletions(-) rename config_src/mct_driver/{MOM_ocean_model.F90 => MOM_MCT_ocean_model.F90} (99%) rename config_src/mct_driver/{MOM_surface_forcing.F90 => MOM_MCT_surface_forcing.F90} (99%) diff --git a/config_src/mct_driver/MOM_ocean_model.F90 b/config_src/mct_driver/MOM_MCT_ocean_model.F90 similarity index 99% rename from config_src/mct_driver/MOM_ocean_model.F90 rename to config_src/mct_driver/MOM_MCT_ocean_model.F90 index 2a984916aa..f341f39ddc 100644 --- a/config_src/mct_driver/MOM_ocean_model.F90 +++ b/config_src/mct_driver/MOM_MCT_ocean_model.F90 @@ -1,5 +1,5 @@ !> Top-level module for the MOM6 ocean model in coupled mode. -module MOM_ocean_model +module MOM_MCT_ocean_model ! This file is part of MOM6. See LICENSE.md for the license. @@ -35,10 +35,10 @@ module MOM_ocean_model use MOM_marine_ice, only : iceberg_forces, iceberg_fluxes, marine_ice_init, marine_ice_CS use MOM_restart, only : MOM_restart_CS, save_restart use MOM_string_functions, only : uppercase -use MOM_surface_forcing, only : surface_forcing_init, convert_IOB_to_fluxes -use MOM_surface_forcing, only : convert_IOB_to_forces, ice_ocn_bnd_type_chksum -use MOM_surface_forcing, only : ice_ocean_boundary_type, surface_forcing_CS -use MOM_surface_forcing, only : forcing_save_restart +use MOM_MCT_surface_forcing, only : surface_forcing_init, convert_IOB_to_fluxes +use MOM_MCT_surface_forcing, only : convert_IOB_to_forces, ice_ocn_bnd_type_chksum +use MOM_MCT_surface_forcing, only : ice_ocean_boundary_type, surface_forcing_CS +use MOM_MCT_surface_forcing, only : forcing_save_restart use MOM_time_manager, only : time_type, get_time, set_time, operator(>) use MOM_time_manager, only : operator(+), operator(-), operator(*), operator(/) use MOM_time_manager, only : operator(/=), operator(<=), operator(>=) @@ -263,7 +263,7 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, gas_fields_ocn, i type(param_file_type) :: param_file !< A structure to parse for run-time parameters logical :: use_temperature - call callTree_enter("ocean_model_init(), ocean_model_MOM.F90") + call callTree_enter("ocean_model_init(), MOM_MCT_ocean_model.F90") if (associated(OS)) then call MOM_error(WARNING, "ocean_model_init called with an associated "// & "ocean_state_type structure. Model is already initialized.") @@ -477,7 +477,7 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & integer :: secs, days integer :: is, ie, js, je - call callTree_enter("update_ocean_model(), MOM_ocean_model.F90") + call callTree_enter("update_ocean_model(), MOM_MCT_ocean_model.F90") call get_time(Ocean_coupling_time_step, secs, days) dt_coupling = 86400.0*real(days) + real(secs) @@ -1187,4 +1187,4 @@ subroutine get_ocean_grid(OS, Gridp) return end subroutine get_ocean_grid -end module MOM_ocean_model +end module MOM_MCT_ocean_model diff --git a/config_src/mct_driver/MOM_surface_forcing.F90 b/config_src/mct_driver/MOM_MCT_surface_forcing.F90 similarity index 99% rename from config_src/mct_driver/MOM_surface_forcing.F90 rename to config_src/mct_driver/MOM_MCT_surface_forcing.F90 index cf1461467c..d022dfba12 100644 --- a/config_src/mct_driver/MOM_surface_forcing.F90 +++ b/config_src/mct_driver/MOM_MCT_surface_forcing.F90 @@ -1,4 +1,4 @@ -module MOM_surface_forcing +module MOM_MCT_surface_forcing ! This file is part of MOM6. See LICENSE.md for the license. @@ -1006,7 +1006,7 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, restore_salt, 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" - character(len=40) :: mdl = "MOM_surface_forcing" ! This module's name. + character(len=40) :: mdl = "MOM_MCT_surface_forcing" ! This module's name. character(len=48) :: stagger character(len=48) :: flnam character(len=240) :: basin_file @@ -1378,4 +1378,4 @@ subroutine ice_ocn_bnd_type_chksum(id, timestep, iobt) end subroutine ice_ocn_bnd_type_chksum -end module MOM_surface_forcing +end module MOM_MCT_surface_forcing diff --git a/config_src/mct_driver/ocn_cap_methods.F90 b/config_src/mct_driver/ocn_cap_methods.F90 index 7e06b014d4..daee81b1e8 100644 --- a/config_src/mct_driver/ocn_cap_methods.F90 +++ b/config_src/mct_driver/ocn_cap_methods.F90 @@ -1,13 +1,13 @@ module ocn_cap_methods - use ESMF, only: ESMF_clock, ESMF_time, ESMF_ClockGet, ESMF_TimeGet - use MOM_ocean_model, only: ocean_public_type, ocean_state_type - use MOM_surface_forcing, only: ice_ocean_boundary_type - use MOM_grid, only: ocean_grid_type - use MOM_domains, only: pass_var - use MOM_error_handler, only: is_root_pe - use mpp_domains_mod, only: mpp_get_compute_domain - use ocn_cpl_indices, only: cpl_indices_type + use ESMF, only: ESMF_clock, ESMF_time, ESMF_ClockGet, ESMF_TimeGet + use MOM_MCT_ocean_model, only: ocean_public_type, ocean_state_type + use MOM_MCT_surface_forcing, only: ice_ocean_boundary_type + use MOM_grid, only: ocean_grid_type + use MOM_domains, only: pass_var + use MOM_error_handler, only: is_root_pe + use mpp_domains_mod, only: mpp_get_compute_domain + use ocn_cpl_indices, only: cpl_indices_type implicit none private diff --git a/config_src/mct_driver/ocn_comp_mct.F90 b/config_src/mct_driver/ocn_comp_mct.F90 index 8d9133d08b..d06e9ce26a 100644 --- a/config_src/mct_driver/ocn_comp_mct.F90 +++ b/config_src/mct_driver/ocn_comp_mct.F90 @@ -44,10 +44,10 @@ module ocn_comp_mct use mpp_domains_mod, only: mpp_get_compute_domain ! Previously inlined - now in separate modules -use MOM_ocean_model, only: ocean_public_type, ocean_state_type -use MOM_ocean_model, only: ocean_model_init , update_ocean_model, ocean_model_end -use MOM_ocean_model, only: convert_state_to_ocean_type -use MOM_surface_forcing, only: surface_forcing_CS, forcing_save_restart, ice_ocean_boundary_type +use MOM_MCT_ocean_model, only: ocean_public_type, ocean_state_type +use MOM_MCT_ocean_model, only: ocean_model_init , update_ocean_model, ocean_model_end +use MOM_MCT_ocean_model, only: convert_state_to_ocean_type +use MOM_MCT_surface_forcing, only: surface_forcing_CS, forcing_save_restart, ice_ocean_boundary_type use ocn_cap_methods, only: ocn_import, ocn_export ! FMS modules From 3b2ad3f5910e4004f0ecabb6fdabd901cf6fb6ee Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Mon, 29 Jul 2019 16:25:11 -0600 Subject: [PATCH 136/150] Rename modules in NUOPC --- ...an_model.F90 => MOM_NUOPC_ocean_model.F90} | 14 +-- ...cing.F90 => MOM_NUOPC_surface_forcing.F90} | 6 +- .../nuopc_driver/{mom_cap.F90 => MOM_cap.F90} | 106 +++++++++--------- ...om_cap_methods.F90 => MOM_cap_methods.F90} | 52 ++++----- .../{mom_cap_time.F90 => MOM_cap_time.F90} | 4 +- config_src/nuopc_driver/ocn_comp_NUOPC.F90 | 3 + config_src/nuopc_driver/ocn_comp_nuopc.F90 | 3 - 7 files changed, 94 insertions(+), 94 deletions(-) rename config_src/nuopc_driver/{MOM_ocean_model.F90 => MOM_NUOPC_ocean_model.F90} (99%) rename config_src/nuopc_driver/{MOM_surface_forcing.F90 => MOM_NUOPC_surface_forcing.F90} (99%) rename config_src/nuopc_driver/{mom_cap.F90 => MOM_cap.F90} (96%) rename config_src/nuopc_driver/{mom_cap_methods.F90 => MOM_cap_methods.F90} (94%) rename config_src/nuopc_driver/{mom_cap_time.F90 => MOM_cap_time.F90} (99%) create mode 100644 config_src/nuopc_driver/ocn_comp_NUOPC.F90 delete mode 100644 config_src/nuopc_driver/ocn_comp_nuopc.F90 diff --git a/config_src/nuopc_driver/MOM_ocean_model.F90 b/config_src/nuopc_driver/MOM_NUOPC_ocean_model.F90 similarity index 99% rename from config_src/nuopc_driver/MOM_ocean_model.F90 rename to config_src/nuopc_driver/MOM_NUOPC_ocean_model.F90 index f0ba14ac1d..441674020c 100644 --- a/config_src/nuopc_driver/MOM_ocean_model.F90 +++ b/config_src/nuopc_driver/MOM_NUOPC_ocean_model.F90 @@ -1,5 +1,5 @@ !> Top-level module for the MOM6 ocean model in coupled mode. -module MOM_ocean_model +module MOM_NUOPC_ocean_model ! This file is part of MOM6. See LICENSE.md for the license. @@ -35,10 +35,6 @@ module MOM_ocean_model use MOM_marine_ice, only : iceberg_forces, iceberg_fluxes, marine_ice_init, marine_ice_CS use MOM_restart, only : MOM_restart_CS, save_restart use MOM_string_functions, only : uppercase -use MOM_surface_forcing, only : surface_forcing_init, convert_IOB_to_fluxes -use MOM_surface_forcing, only : convert_IOB_to_forces, ice_ocn_bnd_type_chksum -use MOM_surface_forcing, only : ice_ocean_boundary_type, surface_forcing_CS -use MOM_surface_forcing, only : forcing_save_restart use MOM_time_manager, only : time_type, get_time, set_time, operator(>) use MOM_time_manager, only : operator(+), operator(-), operator(*), operator(/) use MOM_time_manager, only : operator(/=), operator(<=), operator(>=) @@ -62,6 +58,10 @@ module MOM_ocean_model use MOM_EOS, only : gsw_sp_from_sr, gsw_pt_from_ct use MOM_wave_interface, only: wave_parameters_CS, MOM_wave_interface_init use MOM_wave_interface, only: MOM_wave_interface_init_lite, Update_Surface_Waves +use MOM_NUOPC_surface_forcing, only : surface_forcing_init, convert_IOB_to_fluxes +use MOM_NUOPC_surface_forcing, only : convert_IOB_to_forces, ice_ocn_bnd_type_chksum +use MOM_NUOPC_surface_forcing, only : ice_ocean_boundary_type, surface_forcing_CS +use MOM_NUOPC_surface_forcing, only : forcing_save_restart #include @@ -475,7 +475,7 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & integer :: secs, days integer :: is, ie, js, je - call callTree_enter("update_ocean_model(), MOM_ocean_model.F90") + call callTree_enter("update_ocean_model(), MOM_NUOPC_ocean_model.F90") call get_time(Ocean_coupling_time_step, secs, days) dt_coupling = 86400.0*real(days) + real(secs) @@ -1174,4 +1174,4 @@ subroutine get_ocean_grid(OS, Gridp) return end subroutine get_ocean_grid -end module MOM_ocean_model +end module MOM_NUOPC_ocean_model diff --git a/config_src/nuopc_driver/MOM_surface_forcing.F90 b/config_src/nuopc_driver/MOM_NUOPC_surface_forcing.F90 similarity index 99% rename from config_src/nuopc_driver/MOM_surface_forcing.F90 rename to config_src/nuopc_driver/MOM_NUOPC_surface_forcing.F90 index 26121ff62d..b8e6adf11b 100644 --- a/config_src/nuopc_driver/MOM_surface_forcing.F90 +++ b/config_src/nuopc_driver/MOM_NUOPC_surface_forcing.F90 @@ -1,5 +1,5 @@ !> Converts the input ESMF data (import data) to a MOM-specific data type (surface_forcing_CS). -module MOM_surface_forcing +module MOM_NUOPC_surface_forcing ! This file is part of MOM6. See LICENSE.md for the license. @@ -1011,7 +1011,7 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, restore_salt, 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" - character(len=40) :: mdl = "MOM_surface_forcing" ! This module's name. + character(len=40) :: mdl = "MOM_NUOPC_surface_forcing" ! This module's name. character(len=48) :: stagger character(len=48) :: flnam character(len=240) :: basin_file @@ -1383,4 +1383,4 @@ subroutine ice_ocn_bnd_type_chksum(id, timestep, iobt) end subroutine ice_ocn_bnd_type_chksum -end module MOM_surface_forcing +end module MOM_NUOPC_surface_forcing diff --git a/config_src/nuopc_driver/mom_cap.F90 b/config_src/nuopc_driver/MOM_cap.F90 similarity index 96% rename from config_src/nuopc_driver/mom_cap.F90 rename to config_src/nuopc_driver/MOM_cap.F90 index 0e46a454f7..cf182eb0d7 100644 --- a/config_src/nuopc_driver/mom_cap.F90 +++ b/config_src/nuopc_driver/MOM_cap.F90 @@ -35,11 +35,11 @@ !! of model code, making calls into it and exposing model data structures in a !! standard way. !! -!! The MOM cap package includes the cap code itself (mom_cap.F90, mom_cap_methods.F90 -!! and mom_cap_time.F90), a set of time utilities (time_utils.F90) for converting between ESMF and FMS -!! time type and two modules MOM_ocean_model.F90 and MOM_surface_forcing.F90. MOM_surface_forcing.F90 +!! The MOM cap package includes the cap code itself (MOM_cap.F90, MOM_cap_methods.F90 +!! and MOM_cap_time.F90), a set of time utilities (time_utils.F90) for converting between ESMF and FMS +!! time type and two modules MOM_NUOPC_ocean_model.F90 and MOM_NUOPC_surface_forcing.F90. MOM_NUOPC_surface_forcing.F90 !! converts the input ESMF data (import data) to a MOM-specific data type (surface_forcing_CS). -!! MOM_ocean_model.F90 contains routines for initialization, update and finalization of the ocean model state. +!! MOM_NUOPC_ocean_model.F90 contains routines for initialization, update and finalization of the ocean model state. !! !! @subsection CapSubroutines Cap Subroutines !! @@ -60,15 +60,15 @@ !! !! Phase | MOM Cap Subroutine | Description !! ---------|--------------------------------------------------------------------|-------------------------------------- -!! Init | [InitializeP0] (@ref mom_cap_mod::initializep0) | Sets the Initialize Phase Definition +!! Init | [InitializeP0] (@ref MOM_cap_mod::initializep0) | Sets the Initialize Phase Definition !! | (IPD) version to use -!! Init | [InitializeAdvertise] (@ref mom_cap_mod::initializeadvertise) | Advertises standard names of import +!! Init | [InitializeAdvertise] (@ref MOM_cap_mod::initializeadvertise) | Advertises standard names of import !! | and export fields -!! Init | [InitializeRealize] (@ref mom_cap_mod::initializerealize) | Creates an ESMF_Grid or ESMF_Mesh +!! Init | [InitializeRealize] (@ref MOM_cap_mod::initializerealize) | Creates an ESMF_Grid or ESMF_Mesh !! | as well as ESMF_Fields for import !! | and export fields -!! Run | [ModelAdvance] (@ref mom_cap_mod::modeladvance) | Advances the model by a timestep -!! Final | [Finalize] (@ref mom_cap_mod::ocean_model_finalize) | Cleans up +!! Run | [ModelAdvance] (@ref MOM_cap_mod::modeladvance) | Advances the model by a timestep +!! Final | [Finalize] (@ref MOM_cap_mod::ocean_model_finalize) | Cleans up !! !! @section UnderlyingModelInterfaces Underlying Model Interfaces !! @@ -81,7 +81,7 @@ !! Note that for either the `ESMF_Grid` or `ESMF_Mesh` representation, the fields are translated into !! a 2D MOM specific surface boundary type and the distinction between the two is no longer there. !! Calls related to creating the grid are located in the [InitializeRealize] -!! (@ref mom_cap_mod::initializerealize) subroutine, which is called by the NUOPC infrastructure +!! (@ref MOM_cap_mod::initializerealize) subroutine, which is called by the NUOPC infrastructure !! during the intialization sequence. !! !! The cap determines parameters for setting up the grid by calling subroutines in the @@ -112,7 +112,7 @@ !! !! @subsection Initialization Initialization !! -!! During the [InitializeAdvertise] (@ref mom_cap_mod::initializeadvertise) phase, calls are +!! During the [InitializeAdvertise] (@ref MOM_cap_mod::initializeadvertise) phase, calls are !! made to MOM's native initialization subroutines, including `fms_init()`, `constants_init()`, !! `field_manager_init()`, `diag_manager_init()`, and `set_calendar_type()`. The MPI communicator !! is pulled in through the ESMF VM object for the MOM component. The dt and start time are set @@ -121,7 +121,7 @@ !! !! @subsection Run Run !! -!! The [ModelAdvance] (@ref mom_cap_mod::modeladvance) subroutine is called by the NUOPC +!! The [ModelAdvance] (@ref MOM_cap_mod::modeladvance) subroutine is called by the NUOPC !! infrastructure when it's time for MOM to advance in time. During this subroutine, there is a !! call into the MOM update routine: !! @@ -184,7 +184,7 @@ !! \f] !! @subsection Finalization Finalization !! -!! NUOPC infrastructure calls [ocean_model_finalize] (@ref mom_cap_mod::ocean_model_finalize) +!! NUOPC infrastructure calls [ocean_model_finalize] (@ref MOM_cap_mod::ocean_model_finalize) !! at the end of the run. This subroutine is a hook to call into MOM's native shutdown !! procedures: !! @@ -272,11 +272,11 @@ !! so that it can maintain state there if desired. !! The member of type `ice_ocean_boundary_type` is populated by this cap !! with incoming coupling fields from other components. These three derived types are allocated during the -!! [InitializeAdvertise] (@ref mom_cap_mod::initializeadvertise) phase. Also during that +!! [InitializeAdvertise] (@ref MOM_cap_mod::initializeadvertise) phase. Also during that !! phase, the `ice_ocean_boundary` type members are all allocated using bounds retrieved !! from `mpp_get_compute_domain()`. !! -!! During the [InitializeRealize] (@ref mom_cap_mod::initializerealize) phase, +!! During the [InitializeRealize] (@ref MOM_cap_mod::initializerealize) phase, !! `ESMF_Field`s are created for each of the coupling fields in the `ice_ocean_boundary` !! and `ocean_public_type` members of the internal state. These fields directly reference into the members of !! the `ice_ocean_boundary` and `ocean_public_type` so that memory-to-memory copies are not required to move @@ -289,7 +289,7 @@ !! "DumpFields" has been set to "true". In this case the cap will write out NetCDF files !! with names "field_ocn_import_.nc" and "field_ocn_export_.nc". !! Additionally, calls will be made to the cap subroutine [dumpMomInternal] -!! (@ref mom_cap_mod::dumpmominternal) to write out model internal fields to files +!! (@ref MOM_cap_mod::dumpmominternal) to write out model internal fields to files !! named "field_ocn_internal_.nc". In all cases these NetCDF files will !! contain a time series of field data. !! @@ -303,7 +303,7 @@ !! * `DumpFields` - when set to "true", write out diagnostic NetCDF files for import/export/internal fields !! * `ProfileMemory` - when set to "true", write out memory usage information to the ESMF log files; this !! information is written when entering and leaving the [ModelAdvance] -!! (@ref mom_cap_mod::modeladvance) subroutine and before and after the call to +!! (@ref MOM_cap_mod::modeladvance) subroutine and before and after the call to !! `update_ocean_model()`. !! * `restart_interval` - integer number of seconds indicating the interval at !! which to call `ocean_model_restart()`; no restarts written if set to 0 @@ -311,7 +311,7 @@ !! !> This module contains a set of subroutines that are required by NUOPC. -module mom_cap_mod +module MOM_cap_mod use constants_mod, only: constants_init use diag_manager_mod, only: diag_manager_init, diag_manager_end use field_manager_mod, only: field_manager_init, field_manager_end @@ -340,13 +340,13 @@ module mom_cap_mod use MOM_get_input, only: Get_MOM_Input, directories use MOM_domains, only: pass_var use MOM_error_handler, only: is_root_pe -use MOM_ocean_model, only: ice_ocean_boundary_type +use MOM_NUOPC_ocean_model, only: ice_ocean_boundary_type use MOM_grid, only: ocean_grid_type, get_global_grid_size -use MOM_ocean_model, only: ocean_model_restart, ocean_public_type, ocean_state_type -use MOM_ocean_model, only: ocean_model_init_sfc -use MOM_ocean_model, only: ocean_model_init, update_ocean_model, ocean_model_end, get_ocean_grid -use mom_cap_time, only: AlarmInit -use mom_cap_methods, only: mom_import, mom_export, mom_set_geomtype +use MOM_NUOPC_ocean_model, only: ocean_model_restart, ocean_public_type, ocean_state_type +use MOM_NUOPC_ocean_model, only: ocean_model_init_sfc +use MOM_NUOPC_ocean_model, only: ocean_model_init, update_ocean_model, ocean_model_end, get_ocean_grid +use MOM_cap_time, only: AlarmInit +use MOM_cap_methods, only: mom_import, mom_export, mom_set_geomtype #ifdef CESMCOUPLED use shr_file_mod, only: shr_file_setLogUnit, shr_file_getLogUnit #endif @@ -465,7 +465,7 @@ subroutine SetServices(gcomp, rc) integer, intent(out) :: rc !< return code ! local variables - character(len=*),parameter :: subname='(mom_cap:SetServices)' + character(len=*),parameter :: subname='(MOM_cap:SetServices)' rc = ESMF_SUCCESS @@ -559,7 +559,7 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) logical :: isPresent, isSet integer :: iostat character(len=64) :: value, logmsg - character(len=*),parameter :: subname='(mom_cap:InitializeP0)' + character(len=*),parameter :: subname='(MOM_cap:InitializeP0)' rc = ESMF_SUCCESS @@ -581,7 +581,7 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) if (isPresent .and. isSet) write_diagnostics=(trim(value)=="true") write(logmsg,*) write_diagnostics - call ESMF_LogWrite('mom_cap:DumpFields = '//trim(logmsg), ESMF_LOGMSG_INFO, rc=rc) + call ESMF_LogWrite('MOM_cap:DumpFields = '//trim(logmsg), ESMF_LOGMSG_INFO, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & @@ -596,7 +596,7 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) return if (isPresent .and. isSet) profile_memory=(trim(value)=="true") write(logmsg,*) profile_memory - call ESMF_LogWrite('mom_cap:ProfileMemory = '//trim(logmsg), ESMF_LOGMSG_INFO, rc=rc) + call ESMF_LogWrite('MOM_cap:ProfileMemory = '//trim(logmsg), ESMF_LOGMSG_INFO, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & @@ -611,7 +611,7 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) return if (isPresent .and. isSet) grid_attach_area=(trim(value)=="true") write(logmsg,*) grid_attach_area - call ESMF_LogWrite('mom_cap:GridAttachArea = '//trim(logmsg), ESMF_LOGMSG_INFO, rc=rc) + call ESMF_LogWrite('MOM_cap:GridAttachArea = '//trim(logmsg), ESMF_LOGMSG_INFO, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & @@ -626,7 +626,7 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) return if (isPresent .and. isSet) then scalar_field_name = trim(value) - call ESMF_LogWrite('mom_cap:ScalarFieldName = '//trim(scalar_field_name), ESMF_LOGMSG_INFO, rc=rc) + call ESMF_LogWrite('MOM_cap:ScalarFieldName = '//trim(scalar_field_name), ESMF_LOGMSG_INFO, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & @@ -649,7 +649,7 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) return endif write(logmsg,*) scalar_field_count - call ESMF_LogWrite('mom_cap:ScalarFieldCount = '//trim(logmsg), ESMF_LOGMSG_INFO, rc=rc) + call ESMF_LogWrite('MOM_cap:ScalarFieldCount = '//trim(logmsg), ESMF_LOGMSG_INFO, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & @@ -672,7 +672,7 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) return endif write(logmsg,*) scalar_field_idx_grid_nx - call ESMF_LogWrite('mom_cap:ScalarFieldIdxGridNX = '//trim(logmsg), ESMF_LOGMSG_INFO, rc=rc) + call ESMF_LogWrite('MOM_cap:ScalarFieldIdxGridNX = '//trim(logmsg), ESMF_LOGMSG_INFO, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & @@ -695,7 +695,7 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) return endif write(logmsg,*) scalar_field_idx_grid_ny - call ESMF_LogWrite('mom_cap:ScalarFieldIdxGridNY = '//trim(logmsg), ESMF_LOGMSG_INFO, rc=rc) + call ESMF_LogWrite('MOM_cap:ScalarFieldIdxGridNY = '//trim(logmsg), ESMF_LOGMSG_INFO, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & @@ -755,7 +755,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) logical :: existflag integer :: userRc character(len=512) :: restartfile ! Path/Name of restart file - character(len=*), parameter :: subname='(mom_cap:InitializeAdvertise)' + character(len=*), parameter :: subname='(MOM_cap:InitializeAdvertise)' character(len=32) :: calendar !-------------------------------- @@ -890,7 +890,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) if (isPresent .and. isSet) then read(cvalue,*) starttype else - call ESMF_LogWrite('mom_cap:start_type unset - using input.nml for restart option', & + call ESMF_LogWrite('MOM_cap:start_type unset - using input.nml for restart option', & ESMF_LOGMSG_INFO, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & @@ -913,7 +913,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) endif if (len_trim(runtype) > 0) then - call ESMF_LogWrite('mom_cap:startup = '//trim(runtype), ESMF_LOGMSG_INFO, rc=rc) + call ESMF_LogWrite('MOM_cap:startup = '//trim(runtype), ESMF_LOGMSG_INFO, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & @@ -938,7 +938,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) file=__FILE__)) & return ! bail out if (existflag) then - call ESMF_LogWrite('mom_cap: called user GetRestartFileToRead', ESMF_LOGMSG_INFO, rc=rc) + call ESMF_LogWrite('MOM_cap: called user GetRestartFileToRead', ESMF_LOGMSG_INFO, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & @@ -953,13 +953,13 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) return if (isPresent .and. isSet) then restartfile = trim(cvalue) - call ESMF_LogWrite('mom_cap: RestartFileToRead = '//trim(restartfile), ESMF_LOGMSG_INFO, rc=rc) + call ESMF_LogWrite('MOM_cap: RestartFileToRead = '//trim(restartfile), ESMF_LOGMSG_INFO, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return else - call ESMF_LogWrite('mom_cap: restart requested, no RestartFileToRead attribute provided-will use input.nml',& + call ESMF_LogWrite('MOM_cap: restart requested, no RestartFileToRead attribute provided-will use input.nml',& ESMF_LOGMSG_WARNING, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & @@ -1159,7 +1159,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) integer, allocatable :: gindex(:) ! global index space character(len=128) :: fldname character(len=256) :: cvalue - character(len=*), parameter :: subname='(mom_cap:InitializeRealize)' + character(len=*), parameter :: subname='(MOM_cap:InitializeRealize)' !-------------------------------- rc = ESMF_SUCCESS @@ -1637,7 +1637,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) endif !--------------------------------- - ! Set module variable geomtype in mom_cap_methods + ! Set module variable geomtype in MOM_cap_methods !--------------------------------- call mom_set_geomtype(geomtype) @@ -1674,7 +1674,7 @@ subroutine DataInitialize(gcomp, rc) integer :: fieldCount, n type(ESMF_Field) :: field character(len=64),allocatable :: fieldNameList(:) - character(len=*),parameter :: subname='(mom_cap:DataInitialize)' + character(len=*),parameter :: subname='(MOM_cap:DataInitialize)' !-------------------------------- ! query the Component for its clock, importState and exportState @@ -1788,7 +1788,7 @@ subroutine ModelAdvance(gcomp, rc) integer :: seconds, day, year, month, hour, minute character(ESMF_MAXSTR) :: restartname, cvalue character(240) :: msgString - character(len=*),parameter :: subname='(mom_cap:ModelAdvance)' + character(len=*),parameter :: subname='(MOM_cap:ModelAdvance)' rc = ESMF_SUCCESS if(profile_memory) call ESMF_VMLogMemInfo("Entering MOM Model_ADVANCE: ") @@ -1978,7 +1978,7 @@ subroutine ModelAdvance(gcomp, rc) file=__FILE__)) & return ! bail out if (existflag) then - call ESMF_LogWrite("mom_cap: called user GetRestartFileToWrite method", ESMF_LOGMSG_INFO, rc=rc) + call ESMF_LogWrite("MOM_cap: called user GetRestartFileToWrite method", ESMF_LOGMSG_INFO, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & @@ -1991,7 +1991,7 @@ subroutine ModelAdvance(gcomp, rc) return ! bail out if (isPresent .and. isSet) then restartname = trim(cvalue) - call ESMF_LogWrite("mom_cap: User RestartFileToWrite: "//trim(restartname), ESMF_LOGMSG_INFO, rc=rc) + call ESMF_LogWrite("MOM_cap: User RestartFileToWrite: "//trim(restartname), ESMF_LOGMSG_INFO, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & @@ -2014,7 +2014,7 @@ subroutine ModelAdvance(gcomp, rc) return ! bail out write(restartname,'(A,".mom6.r.",I4.4,"-",I2.2,"-",I2.2,"-",I2.2,"-",I2.2,"-",I2.2)') & "ocn", year, month, day, hour, minute, seconds - call ESMF_LogWrite("mom_cap: Using default restart filename: "//trim(restartname), ESMF_LOGMSG_INFO, rc=rc) + call ESMF_LogWrite("MOM_cap: Using default restart filename: "//trim(restartname), ESMF_LOGMSG_INFO, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & @@ -2084,7 +2084,7 @@ subroutine ModelSetRunClock(gcomp, rc) type(ESMF_ALARM) :: restart_alarm logical :: isPresent, isSet logical :: first_time = .true. - character(len=*),parameter :: subname='mom_cap:(ModelSetRunClock) ' + character(len=*),parameter :: subname='MOM_cap:(ModelSetRunClock) ' !-------------------------------- rc = ESMF_SUCCESS @@ -2247,7 +2247,7 @@ subroutine ocean_model_finalize(gcomp, rc) type(ESMF_Clock) :: clock type(ESMF_Time) :: currTime character(len=64) :: timestamp - character(len=*),parameter :: subname='(mom_cap:ocean_model_finalize)' + character(len=*),parameter :: subname='(MOM_cap:ocean_model_finalize)' write(*,*) 'MOM: --- finalize called ---' rc = ESMF_SUCCESS @@ -2302,7 +2302,7 @@ subroutine State_SetScalar(value, scalar_id, State, mytask, scalar_name, scalar_ ! local variables type(ESMF_Field) :: field real(ESMF_KIND_R8), pointer :: farrayptr(:,:) - character(len=*), parameter :: subname='(mom_cap:State_SetScalar)' + character(len=*), parameter :: subname='(MOM_cap:State_SetScalar)' !-------------------------------------------------------- rc = ESMF_SUCCESS @@ -2343,7 +2343,7 @@ subroutine MOM_RealizeFields(state, nfields, field_defs, tag, grid, mesh, rc) type(ESMF_Field) :: field real(ESMF_KIND_R8), pointer :: fldptr1d(:) ! for mesh real(ESMF_KIND_R8), pointer :: fldptr2d(:,:) ! for grid - character(len=*),parameter :: subname='(mom_cap:MOM_RealizeFields)' + character(len=*),parameter :: subname='(MOM_cap:MOM_RealizeFields)' !-------------------------------------------------------- rc = ESMF_SUCCESS @@ -2448,7 +2448,7 @@ subroutine SetScalarField(field, rc) ! local variables type(ESMF_Distgrid) :: distgrid type(ESMF_Grid) :: grid - character(len=*), parameter :: subname='(mom_cap:SetScalarField)' + character(len=*), parameter :: subname='(MOM_cap:SetScalarField)' rc = ESMF_SUCCESS @@ -2489,7 +2489,7 @@ subroutine fld_list_add(num, fldlist, stdname, transferOffer, shortname) ! local variables integer :: rc - character(len=*), parameter :: subname='(mom_cap:fld_list_add)' + character(len=*), parameter :: subname='(MOM_cap:fld_list_add)' ! fill in the new entry num = num + 1 @@ -2525,4 +2525,4 @@ subroutine shr_file_getLogUnit(nunit) end subroutine shr_file_getLogUnit #endif -end module mom_cap_mod +end module MOM_cap_mod diff --git a/config_src/nuopc_driver/mom_cap_methods.F90 b/config_src/nuopc_driver/MOM_cap_methods.F90 similarity index 94% rename from config_src/nuopc_driver/mom_cap_methods.F90 rename to config_src/nuopc_driver/MOM_cap_methods.F90 index 8d9543137a..36b8ea97bc 100644 --- a/config_src/nuopc_driver/mom_cap_methods.F90 +++ b/config_src/nuopc_driver/MOM_cap_methods.F90 @@ -1,25 +1,25 @@ !> Contains import/export methods for both NEMS and CMEPS. -module mom_cap_methods - -use ESMF, only: ESMF_Clock, ESMF_ClockGet, ESMF_time, ESMF_TimeGet -use ESMF, only: ESMF_TimeInterval, ESMF_TimeIntervalGet -use ESMF, only: ESMF_State, ESMF_StateGet -use ESMF, only: ESMF_Field, ESMF_FieldGet, ESMF_FieldCreate -use ESMF, only: ESMF_GridComp, ESMF_Mesh, ESMF_Grid, ESMF_GridCreate -use ESMF, only: ESMF_DistGrid, ESMF_DistGridCreate -use ESMF, only: ESMF_KIND_R8, ESMF_SUCCESS, ESMF_LogFoundError -use ESMF, only: ESMF_LOGERR_PASSTHRU, ESMF_LOGMSG_INFO, ESMF_LOGWRITE -use ESMF, only: ESMF_LogSetError, ESMF_RC_MEM_ALLOCATE -use ESMF, only: ESMF_StateItem_Flag, ESMF_STATEITEM_NOTFOUND -use ESMF, only: ESMF_GEOMTYPE_FLAG, ESMF_GEOMTYPE_GRID, ESMF_GEOMTYPE_MESH -use ESMF, only: ESMF_RC_VAL_OUTOFRANGE, ESMF_INDEX_DELOCAL, ESMF_MESHLOC_ELEMENT -use ESMF, only: ESMF_TYPEKIND_R8 -use ESMF, only: operator(/=), operator(==) -use MOM_ocean_model, only: ocean_public_type, ocean_state_type -use MOM_surface_forcing, only: ice_ocean_boundary_type -use MOM_grid, only: ocean_grid_type -use MOM_domains, only: pass_var -use mpp_domains_mod, only: mpp_get_compute_domain +module MOM_cap_methods + +use ESMF, only: ESMF_Clock, ESMF_ClockGet, ESMF_time, ESMF_TimeGet +use ESMF, only: ESMF_TimeInterval, ESMF_TimeIntervalGet +use ESMF, only: ESMF_State, ESMF_StateGet +use ESMF, only: ESMF_Field, ESMF_FieldGet, ESMF_FieldCreate +use ESMF, only: ESMF_GridComp, ESMF_Mesh, ESMF_Grid, ESMF_GridCreate +use ESMF, only: ESMF_DistGrid, ESMF_DistGridCreate +use ESMF, only: ESMF_KIND_R8, ESMF_SUCCESS, ESMF_LogFoundError +use ESMF, only: ESMF_LOGERR_PASSTHRU, ESMF_LOGMSG_INFO, ESMF_LOGWRITE +use ESMF, only: ESMF_LogSetError, ESMF_RC_MEM_ALLOCATE +use ESMF, only: ESMF_StateItem_Flag, ESMF_STATEITEM_NOTFOUND +use ESMF, only: ESMF_GEOMTYPE_FLAG, ESMF_GEOMTYPE_GRID, ESMF_GEOMTYPE_MESH +use ESMF, only: ESMF_RC_VAL_OUTOFRANGE, ESMF_INDEX_DELOCAL, ESMF_MESHLOC_ELEMENT +use ESMF, only: ESMF_TYPEKIND_R8 +use ESMF, only: operator(/=), operator(==) +use MOM_NUOPC_ocean_model, only: ocean_public_type, ocean_state_type +use MOM_NUOPC_surface_forcing, only: ice_ocean_boundary_type +use MOM_grid, only: ocean_grid_type +use MOM_domains, only: pass_var +use mpp_domains_mod, only: mpp_get_compute_domain ! By default make data private implicit none; private @@ -646,7 +646,7 @@ subroutine State_GetFldPtr_1d(State, fldname, fldptr, rc) ! local variables type(ESMF_Field) :: lfield integer :: lrc - character(len=*),parameter :: subname='(mom_cap:State_GetFldPtr)' + character(len=*),parameter :: subname='(MOM_cap:State_GetFldPtr)' call ESMF_StateGet(State, itemName=trim(fldname), field=lfield, rc=lrc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & @@ -673,7 +673,7 @@ subroutine State_GetFldPtr_2d(State, fldname, fldptr, rc) ! local variables type(ESMF_Field) :: lfield integer :: lrc - character(len=*),parameter :: subname='(mom_cap:State_GetFldPtr)' + character(len=*),parameter :: subname='(MOM_cap:State_GetFldPtr)' call ESMF_StateGet(State, itemName=trim(fldname), field=lfield, rc=lrc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & @@ -712,7 +712,7 @@ subroutine State_GetImport(state, fldname, isc, iec, jsc, jec, output, do_sum, r integer :: lbnd1,lbnd2 real(ESMF_KIND_R8), pointer :: dataPtr1d(:) real(ESMF_KIND_R8), pointer :: dataPtr2d(:,:) - character(len=*) , parameter :: subname='(mom_cap_methods:state_getimport)' + character(len=*) , parameter :: subname='(MOM_cap_methods:state_getimport)' ! ---------------------------------------------- rc = ESMF_SUCCESS @@ -793,7 +793,7 @@ subroutine State_SetExport(state, fldname, isc, iec, jsc, jec, input, ocean_grid integer :: lbnd1,lbnd2 real(ESMF_KIND_R8), pointer :: dataPtr1d(:) real(ESMF_KIND_R8), pointer :: dataPtr2d(:,:) - character(len=*) , parameter :: subname='(mom_cap_methods:state_setexport)' + character(len=*) , parameter :: subname='(MOM_cap_methods:state_setexport)' ! ---------------------------------------------- rc = ESMF_SUCCESS @@ -850,4 +850,4 @@ subroutine State_SetExport(state, fldname, isc, iec, jsc, jec, input, ocean_grid end subroutine State_SetExport -end module mom_cap_methods +end module MOM_cap_methods diff --git a/config_src/nuopc_driver/mom_cap_time.F90 b/config_src/nuopc_driver/MOM_cap_time.F90 similarity index 99% rename from config_src/nuopc_driver/mom_cap_time.F90 rename to config_src/nuopc_driver/MOM_cap_time.F90 index 3f36a131f9..daf9889c43 100644 --- a/config_src/nuopc_driver/mom_cap_time.F90 +++ b/config_src/nuopc_driver/MOM_cap_time.F90 @@ -4,7 +4,7 @@ !! determine if/how these could be offered more generally in a !! shared library. For now we really want the MOM cap to only !! depend on MOM and ESMF/NUOPC. -module mom_cap_time +module MOM_cap_time ! !USES: use ESMF , only : ESMF_Time, ESMF_Clock, ESMF_Calendar, ESMF_Alarm @@ -405,4 +405,4 @@ subroutine date2ymd (date, year, month, day) end subroutine date2ymd -end module +end module MOM_cap_time diff --git a/config_src/nuopc_driver/ocn_comp_NUOPC.F90 b/config_src/nuopc_driver/ocn_comp_NUOPC.F90 new file mode 100644 index 0000000000..6d25b9a1ae --- /dev/null +++ b/config_src/nuopc_driver/ocn_comp_NUOPC.F90 @@ -0,0 +1,3 @@ +module ocn_comp_NUOPC + use MOM_cap_mod +end module ocn_comp_NUOPC diff --git a/config_src/nuopc_driver/ocn_comp_nuopc.F90 b/config_src/nuopc_driver/ocn_comp_nuopc.F90 deleted file mode 100644 index 51b8a85c26..0000000000 --- a/config_src/nuopc_driver/ocn_comp_nuopc.F90 +++ /dev/null @@ -1,3 +0,0 @@ -module ocn_comp_nuopc - use mom_cap_mod -end module ocn_comp_nuopc From 21a5e37d6989a12a5833cd9a08d0ad30a5af15a0 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 30 Jul 2019 07:33:23 -0400 Subject: [PATCH 137/150] Rescaled units in MOM_barotropic.F90 Rescaled the units of internal variables in MOM_barotropic.F90 for dimensional consistency testing. Also corrected some comments. All answers are bitwise identical, including in tests where the units of time and length are rescaled. --- src/core/MOM_barotropic.F90 | 905 ++++++++++++++++++------------------ 1 file changed, 458 insertions(+), 447 deletions(-) diff --git a/src/core/MOM_barotropic.F90 b/src/core/MOM_barotropic.F90 index 21bb2d4738..25bcaa9d5b 100644 --- a/src/core/MOM_barotropic.F90 +++ b/src/core/MOM_barotropic.F90 @@ -65,18 +65,18 @@ module MOM_barotropic !> The barotropic stepping open boundary condition type type, private :: BT_OBC_type - real, dimension(:,:), pointer :: Cg_u => NULL() !< The external wave speed at u-points [m s-1]. - real, dimension(:,:), pointer :: Cg_v => NULL() !< The external wave speed at u-points [m s-1]. + real, dimension(:,:), pointer :: Cg_u => NULL() !< The external wave speed at u-points [L T-1 ~> m s-1]. + real, dimension(:,:), pointer :: Cg_v => NULL() !< The external wave speed at u-points [L T-1 ~> m s-1]. real, dimension(:,:), pointer :: H_u => NULL() !< The total thickness at the u-points [H ~> m or kg m-2]. real, dimension(:,:), pointer :: H_v => NULL() !< The total thickness at the v-points [H ~> m or kg m-2]. real, dimension(:,:), pointer :: uhbt => NULL() !< The zonal barotropic thickness fluxes specified - !! for open boundary conditions (if any) [H m2 s-1 ~> m3 s-1 or kg s-1]. + !! for open boundary conditions (if any) [H L2 T-1 ~> m3 s-1 or kg s-1]. real, dimension(:,:), pointer :: vhbt => NULL() !< The meridional barotropic thickness fluxes specified - !! for open boundary conditions (if any) [H m2 s-1 ~> m3 s-1 or kg s-1]. + !! for open boundary conditions (if any) [H L2 T-1 ~> m3 s-1 or kg s-1]. real, dimension(:,:), pointer :: ubt_outer => NULL() !< The zonal velocities just outside the domain, - !! as set by the open boundary conditions [m s-1]. + !! as set by the open boundary conditions [L T-1 ~> m s-1]. real, dimension(:,:), pointer :: vbt_outer => NULL() !< The meridional velocities just outside the domain, - !! as set by the open boundary conditions [m s-1]. + !! as set by the open boundary conditions [L T-1 ~> m s-1]. real, dimension(:,:), pointer :: eta_outer_u => NULL() !< The surface height outside of the domain !! at a u-point with an open boundary condition [H ~> m or kg m-2]. real, dimension(:,:), pointer :: eta_outer_v => NULL() !< The surface height outside of the domain @@ -99,33 +99,33 @@ module MOM_barotropic !> The barotropic stepping control stucture type, public :: barotropic_CS ; private real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_,NKMEM_) :: frhatu - !< The fraction of the total column thickness interpolated to u grid points in each layer, nondim. + !< The fraction of the total column thickness interpolated to u grid points in each layer [nondim]. real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_,NKMEM_) :: frhatv - !< The fraction of the total column thickness interpolated to v grid points in each layer, nondim. + !< The fraction of the total column thickness interpolated to v grid points in each layer [nondim]. real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_) :: IDatu !< Inverse of the basin depth at u grid points [Z-1 ~> m-1]. real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_) :: lin_drag_u !< A spatially varying linear drag coefficient acting on the zonal barotropic flow - !! [H s-1 ~> m s-1 or kg m-2 s-1]. + !! [H T-1 ~> m s-1 or kg m-2 s-1]. real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_) :: uhbt_IC !< The barotropic solvers estimate of the zonal transport as the initial condition for - !! the next call to btstep [H m2 s-1 ~> m3 s-1 or kg s-1]. + !! the next call to btstep [H L2 T-1 ~> m3 s-1 or kg s-1]. real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_) :: ubt_IC !< The barotropic solvers estimate of the zonal velocity that will be the initial - !! condition for the next call to btstep [m s-1]. + !! condition for the next call to btstep [L T-1 ~> m s-1]. real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_) :: ubtav !< The barotropic zonal velocity averaged over the baroclinic time step [m s-1]. real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_) :: IDatv !< Inverse of the basin depth at v grid points [Z-1 ~> m-1]. real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_) :: lin_drag_v !< A spatially varying linear drag coefficient acting on the zonal barotropic flow - !! [H s-1 ~> m s-1 or kg m-2 s-1]. + !! [H T-1 ~> m s-1 or kg m-2 s-1]. real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_) :: vhbt_IC !< The barotropic solvers estimate of the zonal transport as the initial condition for - !! the next call to btstep [H m2 s-1 ~> m3 s-1 or kg s-1]. + !! the next call to btstep [H L2 T-1 ~> m3 s-1 or kg s-1]. real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_) :: vbt_IC !< The barotropic solvers estimate of the zonal velocity that will be the initial - !! condition for the next call to btstep [m s-1]. + !! condition for the next call to btstep [L T-1 ~> m s-1]. real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_) :: vbtav !< The barotropic meridional velocity averaged over the baroclinic time step [m s-1]. real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: eta_cor @@ -134,24 +134,24 @@ module MOM_barotropic !! calculation over a baroclinic timestep [H ~> m or kg m-2]. real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: eta_cor_bound !< A limit on the rate at which eta_cor can be applied while avoiding instability - !! [H s-1 ~> m s-1 or kg m-2 s-1]. This is only used if CS%bound_BT_corr is true. + !! [H T-1 ~> m s-1 or kg m-2 s-1]. This is only used if CS%bound_BT_corr is true. real ALLOCABLE_, dimension(NIMEMW_,NJMEMW_) :: & ua_polarity, & !< Test vector components for checking grid polarity. va_polarity, & !< Test vector components for checking grid polarity. bathyT !< A copy of bathyT (ocean bottom depth) with wide halos [Z ~> m] real ALLOCABLE_, dimension(NIMEMW_,NJMEMW_) :: IareaT !< This is a copy of G%IareaT with wide halos, but will - !! still utilize the macro IareaT when referenced, m-2. + !! still utilize the macro IareaT when referenced, [L-2 ~> m-2]. real ALLOCABLE_, dimension(NIMEMBW_,NJMEMW_) :: & D_u_Cor, & !< A simply averaged depth at u points [Z ~> m]. - dy_Cu, & !< A copy of G%dy_Cu with wide halos [m]. - IdxCu !< A copy of G%IdxCu with wide halos [m-1]. + dy_Cu, & !< A copy of G%dy_Cu with wide halos [L ~> m]. + IdxCu !< A copy of G%IdxCu with wide halos [L-1 ~> m-1]. real ALLOCABLE_, dimension(NIMEMW_,NJMEMBW_) :: & D_v_Cor, & !< A simply averaged depth at v points [Z ~> m]. - dx_Cv, & !< A copy of G%dx_Cv with wide halos [m]. - IdyCv !< A copy of G%IdyCv with wide halos [m-1]. + dx_Cv, & !< A copy of G%dx_Cv with wide halos [L ~> m]. + IdyCv !< A copy of G%IdyCv with wide halos [L-1 ~> m-1]. real ALLOCABLE_, dimension(NIMEMBW_,NJMEMBW_) :: & - q_D !< f / D at PV points [Z-1 s-1 ~> m-1 s-1]. + q_D !< f / D at PV points [Z-1 T-1 ~> m-1 s-1]. real, dimension(:,:,:), pointer :: frhatu1 => NULL() !< Predictor step values of frhatu stored for diagnostics. real, dimension(:,:,:), pointer :: frhatv1 => NULL() !< Predictor step values of frhatv stored for diagnostics. @@ -164,10 +164,10 @@ module MOM_barotropic real :: dtbt_fraction !< The fraction of the maximum time-step that !! should used. The default is 0.98. real :: dtbt_max !< The maximum stable barotropic time step [s]. - real :: dt_bt_filter !< The time-scale over which the barotropic mode - !! solutions are filtered [s]. This can never - !! be taken to be longer than 2*dt. The default, 0, - !! applies no filtering. + real :: dt_bt_filter !< The time-scale over which the barotropic mode solutions are + !! filtered [T ~> s] if positive, or as a fraction of DT if + !! negative [nondim]. This can never be taken to be longer than 2*dt. + !! Set this to 0 to apply no filtering. integer :: nstep_last = 0 !< The number of barotropic timesteps per baroclinic !! time step the last time btstep was called. real :: bebt !< A nondimensional number, from 0 to 1, that @@ -212,9 +212,9 @@ module MOM_barotropic !! of the dynamic surface pressure for stability [m]. real :: ice_strength_length !< The length scale at which the damping rate !! due to the ice strength should be the same as if - !! a Laplacian were applied [m]. + !! a Laplacian were applied [L ~> m]. real :: const_dyn_psurf !< The constant that scales the dynamic surface - !! pressure, nondim. Stable values are < ~1.0. + !! pressure [nondim]. Stable values are < ~1.0. !! The default is 0.9. logical :: tides !< If true, apply tidal momentum forcing. real :: G_extra !< A nondimensional factor by which gtot is enhanced. @@ -239,7 +239,7 @@ module MOM_barotropic logical :: debug !< If true, write verbose checksums for debugging purposes. logical :: debug_bt !< If true, write verbose checksums for debugging purposes. real :: vel_underflow !< Velocity components smaller than vel_underflow - !! are set to 0 [m s-1]. + !! are set to 0 [L T-1 ~> m s-1]. real :: maxvel !< Velocity components greater than maxvel are !! truncated to maxvel [m s-1]. real :: CFL_trunc !< If clip_velocity is true, velocity components will @@ -312,21 +312,21 @@ module MOM_barotropic !> A desciption of the functional dependence of transport at a u-point type, private :: local_BT_cont_u_type real :: FA_u_EE !< The effective open face area for zonal barotropic transport - !! drawing from locations far to the east [H m ~> m2 or kg m-1]. + !! drawing from locations far to the east [H L ~> m2 or kg m-1]. real :: FA_u_E0 !< The effective open face area for zonal barotropic transport - !! drawing from nearby to the east [H m ~> m2 or kg m-1]. + !! drawing from nearby to the east [H L ~> m2 or kg m-1]. real :: FA_u_W0 !< The effective open face area for zonal barotropic transport - !! drawing from nearby to the west [H m ~> m2 or kg m-1]. + !! drawing from nearby to the west [H L ~> m2 or kg m-1]. real :: FA_u_WW !< The effective open face area for zonal barotropic transport - !! drawing from locations far to the west [H m ~> m2 or kg m-1]. - real :: uBT_WW !< uBT_WW is the barotropic velocity [m s-1], beyond which the marginal + !! drawing from locations far to the west [H L ~> m2 or kg m-1]. + real :: uBT_WW !< uBT_WW is the barotropic velocity [L T-1 ~> m s-1], beyond which the marginal !! open face area is FA_u_WW. uBT_WW must be non-negative. - real :: uBT_EE !< uBT_EE is a barotropic velocity [m s-1], beyond which the marginal + real :: uBT_EE !< uBT_EE is a barotropic velocity [L T-1 ~> m s-1], beyond which the marginal !! open face area is FA_u_EE. uBT_EE must be non-positive. - real :: uh_crvW !< The curvature of face area with velocity for flow from the west [H s2 m-1 ~> s2 or kg s2 m-3]. - real :: uh_crvE !< The curvature of face area with velocity for flow from the east [H s2 m-1 ~> s2 or kg s2 m-3]. - real :: uh_WW !< The zonal transport when ubt=ubt_WW [H m2 s-1 ~> m3 s-1 or kg s-1]. - real :: uh_EE !< The zonal transport when ubt=ubt_EE [H m2 s-1 ~> m3 s-1 or kg s-1]. + real :: uh_crvW !< The curvature of face area with velocity for flow from the west [H T2 L-1 ~> s2 or kg s2 m-3]. + real :: uh_crvE !< The curvature of face area with velocity for flow from the east [H T2 L-1 ~> s2 or kg s2 m-3]. + real :: uh_WW !< The zonal transport when ubt=ubt_WW [H L2 T-1 ~> m3 s-1 or kg s-1]. + real :: uh_EE !< The zonal transport when ubt=ubt_EE [H L2 T-1 ~> m3 s-1 or kg s-1]. end type local_BT_cont_u_type !> A desciption of the functional dependence of transport at a v-point type, private :: local_BT_cont_v_type @@ -338,14 +338,14 @@ module MOM_barotropic !! drawing from nearby to the south [H m ~> m2 or kg m-1]. real :: FA_v_SS !< The effective open face area for meridional barotropic transport !! drawing from locations far to the south [H m ~> m2 or kg m-1]. - real :: vBT_SS !< vBT_SS is the barotropic velocity [m s-1], beyond which the marginal + real :: vBT_SS !< vBT_SS is the barotropic velocity [L T-1 ~> m s-1], beyond which the marginal !! open face area is FA_v_SS. vBT_SS must be non-negative. - real :: vBT_NN !< vBT_NN is the barotropic velocity [m s-1], beyond which the marginal + real :: vBT_NN !< vBT_NN is the barotropic velocity [L T-1 ~> m s-1], beyond which the marginal !! open face area is FA_v_NN. vBT_NN must be non-positive. - real :: vh_crvS !< The curvature of face area with velocity for flow from the south [H s2 m-1 ~> s2 or kg s2 m-3]. - real :: vh_crvn !< The curvature of face area with velocity for flow from the north [H s2 m-1 ~> s2 or kg s2 m-3]. - real :: vh_SS !< The meridional transport when vbt=vbt_SS [H m2 s-1 ~> m3 s-1 or kg s-1]. - real :: vh_NN !< The meridional transport when vbt=vbt_NN [H m2 s-1 ~> m3 s-1 or kg s-1]. + real :: vh_crvS !< The curvature of face area with velocity for flow from the south [H T2 L-1 ~> s2 or kg s2 m-3]. + real :: vh_crvN !< The curvature of face area with velocity for flow from the north [H T2 L-1 ~> s2 or kg s2 m-3]. + real :: vh_SS !< The meridional transport when vbt=vbt_SS [H L2 T-1 ~> m3 s-1 or kg s-1]. + real :: vh_NN !< The meridional transport when vbt=vbt_NN [H L2 T-1 ~> m3 s-1 or kg s-1]. end type local_BT_cont_v_type !> A container for passing around active tracer point memory limits @@ -455,7 +455,7 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, ! Local variables real :: ubt_Cor(SZIB_(G),SZJ_(G)) ! The barotropic velocities that had been real :: vbt_Cor(SZI_(G),SZJB_(G)) ! used to calculate the input Coriolis - ! terms [m s-1]. + ! terms [L T-1 ~> m s-1]. real :: wt_u(SZIB_(G),SZJ_(G),SZK_(G)) ! wt_u and wt_v are the real :: wt_v(SZI_(G),SZJB_(G),SZK_(G)) ! normalized weights to ! be used in calculating barotropic velocities, possibly with @@ -472,71 +472,71 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, ! relative to eta_PF, with SAL effects included [H ~> m or kg m-2]. ! These are always allocated with symmetric memory and wide halos. - real :: q(SZIBW_(CS),SZJBW_(CS)) ! A pseudo potential vorticity [s-1 Z-1 ~> s-1 m-1]. + real :: q(SZIBW_(CS),SZJBW_(CS)) ! A pseudo potential vorticity [T-1 Z-1 ~> s-1 m-1]. real, dimension(SZIBW_(CS),SZJW_(CS)) :: & - ubt, & ! The zonal barotropic velocity [m s-1]. + ubt, & ! The zonal barotropic velocity [L T-1 ~> m s-1]. bt_rem_u, & ! The fraction of the barotropic zonal velocity that remains ! after a time step, the remainder being lost to bottom drag. ! bt_rem_u is a nondimensional number between 0 and 1. BT_force_u, & ! The vertical average of all of the u-accelerations that are - ! not explicitly included in the barotropic equation [m s-2]. + ! not explicitly included in the barotropic equation [L T-2 ~> m s-2]. u_accel_bt, & ! The difference between the zonal acceleration from the - ! barotropic calculation and BT_force_u [m s-2]. + ! barotropic calculation and BT_force_u [L T-2 ~> m s-2]. uhbt, & ! The zonal barotropic thickness fluxes [H m2 s-1 ~> m3 s-1 or kg s-1]. uhbt0, & ! The difference between the sum of the layer zonal thickness ! fluxes and the barotropic thickness flux using the same - ! velocity [H m2 s-1 ~> m3 s-1 or kg s-1]. - ubt_old, & ! The starting value of ubt in a barotropic step [m s-1]. - ubt_first, & ! The starting value of ubt in a series of barotropic steps [m s-1]. - ubt_sum, & ! The sum of ubt over the time steps [m s-1]. - uhbt_sum, & ! The sum of uhbt over the time steps [H m2 s-1 ~> m3 s-1 or kg s-1]. - ubt_wtd, & ! A weighted sum used to find the filtered final ubt [m s-1]. - ubt_trans, & ! The latest value of ubt used for a transport [m s-1]. + ! velocity [H L2 T-1 ~> m3 s-1 or kg s-1]. + ubt_old, & ! The starting value of ubt in a barotropic step [L T-1 ~> m s-1]. + ubt_first, & ! The starting value of ubt in a series of barotropic steps [L T-1 ~> m s-1]. + ubt_sum, & ! The sum of ubt over the time steps [L T-1 ~> m s-1]. + uhbt_sum, & ! The sum of uhbt over the time steps [H L2 T-1 ~> m3 s-1 or kg s-1]. + ubt_wtd, & ! A weighted sum used to find the filtered final ubt [L T-1 ~> m s-1]. + ubt_trans, & ! The latest value of ubt used for a transport [L T-1 ~> m s-1]. azon, bzon, & ! _zon & _mer are the values of the Coriolis force which czon, dzon, & ! are applied to the neighboring values of vbtav & ubtav, amer, bmer, & ! respectively to get the barotropic inertial rotation - cmer, dmer, & ! [s-1]. - Cor_u, & ! The zonal Coriolis acceleration [m s-2]. + cmer, dmer, & ! [T-1 ~> s-1]. + Cor_u, & ! The zonal Coriolis acceleration [L T-2 ~> m s-2]. Cor_ref_u, & ! The zonal barotropic Coriolis acceleration due - ! to the reference velocities [m s-2]. - PFu, & ! The zonal pressure force acceleration [m s-2]. - Rayleigh_u, & ! A Rayleigh drag timescale operating at u-points [s-1]. - PFu_bt_sum, & ! The summed zonal barotropic pressure gradient force [m s-2]. - Coru_bt_sum, & ! The summed zonal barotropic Coriolis acceleration [m s-2]. + ! to the reference velocities [L T-2 ~> m s-2]. + PFu, & ! The zonal pressure force acceleration [L T-2 ~> m s-2]. + Rayleigh_u, & ! A Rayleigh drag timescale operating at u-points [T-1 ~> s-1]. + PFu_bt_sum, & ! The summed zonal barotropic pressure gradient force [L T-2 ~> m s-2]. + Coru_bt_sum, & ! The summed zonal barotropic Coriolis acceleration [L T-2 ~> m s-2]. DCor_u, & ! A simply averaged depth at u points [Z ~> m]. Datu ! Basin depth at u-velocity grid points times the y-grid - ! spacing [H m ~> m2 or kg m-1]. + ! spacing [H L ~> m2 or kg m-1]. real, dimension(SZIW_(CS),SZJBW_(CS)) :: & - vbt, & ! The meridional barotropic velocity [m s-1]. + vbt, & ! The meridional barotropic velocity [L T-1 ~> m s-1]. bt_rem_v, & ! The fraction of the barotropic meridional velocity that ! remains after a time step, the rest being lost to bottom ! drag. bt_rem_v is a nondimensional number between 0 and 1. BT_force_v, & ! The vertical average of all of the v-accelerations that are - ! not explicitly included in the barotropic equation [m s-2]. + ! not explicitly included in the barotropic equation [L T-2 ~> m s-2]. v_accel_bt, & ! The difference between the meridional acceleration from the - ! barotropic calculation and BT_force_v [m s-2]. + ! barotropic calculation and BT_force_v [L T-2 ~> m s-2]. vhbt, & ! The meridional barotropic thickness fluxes [H m2 s-1 ~> m3 s-1 or kg s-1]. vhbt0, & ! The difference between the sum of the layer meridional ! thickness fluxes and the barotropic thickness flux using - ! the same velocities [H m2 s-1 ~> m3 s-1 or kg s-1]. - vbt_old, & ! The starting value of vbt in a barotropic step [m s-1]. - vbt_first, & ! The starting value of ubt in a series of barotropic steps [m s-1]. - vbt_sum, & ! The sum of vbt over the time steps [m s-1]. - vhbt_sum, & ! The sum of vhbt over the time steps [H m2 s-1 ~> m3 s-1 or kg s-1]. - vbt_wtd, & ! A weighted sum used to find the filtered final vbt [m s-1]. - vbt_trans, & ! The latest value of vbt used for a transport [m s-1]. - Cor_v, & ! The meridional Coriolis acceleration [m s-2]. + ! the same velocities [H L2 T-1 ~> m3 s-1 or kg s-1]. + vbt_old, & ! The starting value of vbt in a barotropic step [L T-1 ~> m s-1]. + vbt_first, & ! The starting value of ubt in a series of barotropic steps [L T-1 ~> m s-1]. + vbt_sum, & ! The sum of vbt over the time steps [L T-1 ~> m s-1]. + vhbt_sum, & ! The sum of vhbt over the time steps [H L2 T-1 ~> m3 s-1 or kg s-1]. + vbt_wtd, & ! A weighted sum used to find the filtered final vbt [L T-1 ~> m s-1]. + vbt_trans, & ! The latest value of vbt used for a transport [L T-1 ~> m s-1]. + Cor_v, & ! The meridional Coriolis acceleration [L T-2 ~> m s-2]. Cor_ref_v, & ! The meridional barotropic Coriolis acceleration due - ! to the reference velocities [m s-2]. - PFv, & ! The meridional pressure force acceleration [m s-2]. - Rayleigh_v, & ! A Rayleigh drag timescale operating at v-points [s-1]. + ! to the reference velocities [L T-2 ~> m s-2]. + PFv, & ! The meridional pressure force acceleration [L T-2 ~> m s-2]. + Rayleigh_v, & ! A Rayleigh drag timescale operating at v-points [T-1 ~> s-1]. PFv_bt_sum, & ! The summed meridional barotropic pressure gradient force, - ! [m s-2]. + ! [L T-2 ~> m s-2]. Corv_bt_sum, & ! The summed meridional barotropic Coriolis acceleration, - ! [m s-2]. + ! [L T-2 ~> m s-2]. DCor_v, & ! A simply averaged depth at v points [Z ~> m]. Datv ! Basin depth at v-velocity grid points times the x-grid - ! spacing [H m ~> m2 or kg m-1]. + ! spacing [H L ~> m2 or kg m-1]. real, target, dimension(SZIW_(CS),SZJW_(CS)) :: & eta, & ! The barotropic free surface height anomaly or column mass ! anomaly [H ~> m or kg m-2] @@ -558,13 +558,13 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, gtot_W, & ! free surface height deviations to pressure forces (including gtot_N, & ! GFS and baroclinic contributions) in the barotropic momentum gtot_S, & ! equations half a grid-point in the X-direction (X is N, S, E, or W) - ! from the thickness point [m2 H-1 s-2 ~> m s-2 or m4 kg-1 s-2]. + ! from the thickness point [L2 H-1 T-2 ~> m s-2 or m4 kg-1 s-2]. ! (See Hallberg, J Comp Phys 1997 for a discussion.) eta_src, & ! The source of eta per barotropic timestep [H ~> m or kg m-2]. dyn_coef_eta, & ! The coefficient relating the changes in eta to the ! dynamic surface pressure under rigid ice - ! [m2 s-2 H-1 ~> m s-2 or m4 s-2 kg-1]. - p_surf_dyn ! A dynamic surface pressure under rigid ice [m2 s-2]. + ! [L2 T-2 H-1 ~> m s-2 or m4 s-2 kg-1]. + p_surf_dyn ! A dynamic surface pressure under rigid ice [L2 T-2 ~> m2 s-2]. type(local_BT_cont_u_type), dimension(SZIBW_(CS),SZJW_(CS)) :: & BTCL_u ! A repackaged version of the u-point information in BT_cont. type(local_BT_cont_v_type), dimension(SZIW_(CS),SZJBW_(CS)) :: & @@ -576,15 +576,16 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, real, dimension(SZIW_(CS),SZJBW_(CS)) :: & vbt_prev, vhbt_prev, vbt_sum_prev, vhbt_sum_prev, vbt_wtd_prev ! for OBC - real :: mass_to_Z ! The depth unit converison divided by the mean density (Rho0) [m3 kg-1]. + real :: mass_to_Z ! The depth unit converison divided by the mean density (Rho0) [Z m2 kg-1 ~> m3 kg-1]. real :: visc_rem ! A work variable that may equal visc_rem_[uv]. Nondim. - real :: vel_prev ! The previous velocity [m s-1]. - real :: dtbt ! The barotropic time step [s]. - real :: bebt ! A copy of CS%bebt. + real :: vel_prev ! The previous velocity [L T-1 ~> m s-1]. + real :: dtbt ! The barotropic time step [T ~> s]. + real :: dt_in_T ! The baroclinic time step [T ~> s]. + real :: bebt ! A copy of CS%bebt [nondim]. real :: be_proj ! The fractional amount by which velocities are projected ! when project_velocity is true. For now be_proj is set ! to equal bebt, as they have similar roles and meanings. - real :: Idt ! The inverse of dt [s-1]. + real :: Idt ! The inverse of dt [T-1 ~> s-1]. real :: det_de ! The partial derivative due to self-attraction and loading ! of the reference geopotential with the sea surface height. ! This is typically ~0.09 or less. @@ -607,16 +608,16 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, logical :: project_velocity, add_uh0 real :: dyn_coef_max ! The maximum stable value of dyn_coef_eta - ! [m2 s-2 H-1 ~> m s-2 or m4 s-2 kg-1]. - real :: ice_strength = 0.0 ! The effective strength of the ice [m s-2]. + ! [L2 T-2 H-1 ~> m s-2 or m4 s-2 kg-1]. + real :: ice_strength = 0.0 ! The effective strength of the ice [L2 Z-1 T-2 ~> m s-2]. real :: Idt_max2 ! The squared inverse of the local maximum stable - ! barotropic time step [s-2]. + ! barotropic time step [T-2 ~> s-2]. real :: H_min_dyn ! The minimum depth to use in limiting the size of the ! dynamic surface pressure for stability [H ~> m or kg m-2]. real :: H_eff_dx2 ! The effective total thickness divided by the grid spacing - ! squared [H m-2 ~> m-1 or kg m-4]. + ! squared [H L-2 ~> m-1 or kg m-4]. real :: vel_tmp ! A temporary velocity [m s-1]. - real :: u_max_cor, v_max_cor ! The maximum corrective velocities [m s-1]. + real :: u_max_cor, v_max_cor ! The maximum corrective velocities [L T-1 ~> m s-1]. real :: Htot ! The total thickness [H ~> m or kg m-2]. real :: eta_cor_max ! The maximum fluid that can be added as a correction to eta [H ~> m or kg m-2]. real :: accel_underflow ! An acceleration that is so small it should be zeroed out. @@ -624,7 +625,7 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, real, allocatable, dimension(:) :: wt_vel, wt_eta, wt_accel, wt_trans, wt_accel2 real :: sum_wt_vel, sum_wt_eta, sum_wt_accel, sum_wt_trans real :: I_sum_wt_vel, I_sum_wt_eta, I_sum_wt_accel, I_sum_wt_trans - real :: dt_filt ! The half-width of the barotropic filter [s]. + real :: dt_filt ! The half-width of the barotropic filter [T ~> s]. real :: trans_wt1, trans_wt2 ! weight used to compute ubt_trans and vbt_trans integer :: nfilter @@ -647,8 +648,9 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed IsdB = G%IsdB ; IedB = G%IedB ; JsdB = G%JsdB ; JedB = G%JedB MS%isdw = CS%isdw ; MS%iedw = CS%iedw ; MS%jsdw = CS%jsdw ; MS%jedw = CS%jedw - Idt = 1.0 / dt - accel_underflow = CS%vel_underflow * Idt + dt_in_T = US%s_to_T*dt + Idt = 1.0 / dt_in_T + accel_underflow = US%L_T_to_m_s*CS%vel_underflow * US%s_to_T*Idt use_BT_cont = .false. if (present(BT_cont)) use_BT_cont = (associated(BT_cont)) @@ -714,10 +716,10 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, ! Set the actual barotropic time step. Instep = 1.0 / real(nstep) - dtbt = dt * Instep + dtbt = dt_in_T * Instep bebt = CS%bebt be_proj = CS%bebt - mass_to_Z = US%m_to_Z / GV%Rho0 + mass_to_Z = US%m_to_L*US%T_to_s**2 * US%m_to_Z / GV%Rho0 !--- setup the weight when computing vbt_trans and ubt_trans if (project_velocity) then @@ -821,7 +823,7 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, enddo ; enddo !$OMP parallel do default(shared) do J=js-1,je ; do I=is-1,ie - q(I,J) = 0.25 * US%s_to_T*G%CoriolisBu(I,J) * & + q(I,J) = 0.25 * G%CoriolisBu(I,J) * & ((G%areaT(i,j) + G%areaT(i+1,j+1)) + (G%areaT(i+1,j) + G%areaT(i,j+1))) / & ((G%areaT(i,j) * G%bathyT(i,j) + G%areaT(i+1,j+1) * G%bathyT(i+1,j+1)) + & (G%areaT(i+1,j) * G%bathyT(i+1,j) + G%areaT(i,j+1) * G%bathyT(i,j+1)) ) @@ -913,11 +915,11 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, do J=js-1,je ; do i=is-1,ie+1 ; vbt_Cor(i,J) = 0.0 ; enddo ; enddo !$OMP parallel do default(shared) do j=js,je ; do k=1,nz ; do I=is-1,ie - ubt_Cor(I,j) = ubt_Cor(I,j) + wt_u(I,j,k) * U_Cor(I,j,k) + ubt_Cor(I,j) = ubt_Cor(I,j) + wt_u(I,j,k) * US%m_s_to_L_T*U_Cor(I,j,k) enddo ; enddo ; enddo !$OMP parallel do default(shared) do J=js-1,je ; do k=1,nz ; do i=is,ie - vbt_Cor(i,J) = vbt_Cor(i,J) + wt_v(i,J,k) * V_Cor(i,J,k) + vbt_Cor(i,J) = vbt_Cor(i,J) + wt_v(i,J,k) * US%m_s_to_L_T*V_Cor(i,J,k) enddo ; enddo ; enddo ! The gtot arrays are the effective layer-weighted reduced gravities for @@ -927,15 +929,15 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, !$OMP parallel do default(shared) do j=js,je do k=1,nz ; do I=is-1,ie - gtot_E(i,j) = gtot_E(i,j) + US%L_T_to_m_s**2*pbce(i,j,k) * wt_u(I,j,k) - gtot_W(i+1,j) = gtot_W(i+1,j) + US%L_T_to_m_s**2*pbce(i+1,j,k) * wt_u(I,j,k) + gtot_E(i,j) = gtot_E(i,j) + pbce(i,j,k) * wt_u(I,j,k) + gtot_W(i+1,j) = gtot_W(i+1,j) + pbce(i+1,j,k) * wt_u(I,j,k) enddo ; enddo enddo !$OMP parallel do default(shared) do J=js-1,je do k=1,nz ; do i=is,ie - gtot_N(i,j) = gtot_N(i,j) + US%L_T_to_m_s**2*pbce(i,j,k) * wt_v(i,J,k) - gtot_S(i,j+1) = gtot_S(i,j+1) + US%L_T_to_m_s**2*pbce(i,j+1,k) * wt_v(i,J,k) + gtot_N(i,j) = gtot_N(i,j) + pbce(i,j,k) * wt_v(i,J,k) + gtot_S(i,j+1) = gtot_S(i,j+1) + pbce(i,j+1,k) * wt_v(i,J,k) enddo ; enddo enddo @@ -955,12 +957,12 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, ! Calculate the open areas at the velocity points. ! The halo updates are needed before Datu is first used, either in set_up_BT_OBC or ubt_Cor. if (use_BT_cont) then - call set_local_BT_cont_types(BT_cont, BTCL_u, BTCL_v, G, MS, CS%BT_Domain, 1+ievf-ie) + call set_local_BT_cont_types(BT_cont, BTCL_u, BTCL_v, G, US, MS, CS%BT_Domain, 1+ievf-ie) else if (CS%Nonlinear_continuity) then - call find_face_areas(Datu, Datv, G, GV, CS, MS, eta, 1) + call find_face_areas(Datu, Datv, G, GV, US, CS, MS, eta, 1) else - call find_face_areas(Datu, Datv, G, GV, CS, MS, halo=1) + call find_face_areas(Datu, Datv, G, GV, US, CS, MS, halo=1) endif endif @@ -981,14 +983,14 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, ! ### IDatu here should be replaced with 1/D+eta(Bous) or 1/eta(non-Bous). ! ### although with BT_cont_types IDatu should be replaced by ! ### CS%dy_Cu(I,j) / (d(uhbt)/du) (with appropriate bounds). - BT_force_u(I,j) = forces%taux(I,j) * mass_to_Z *CS%IDatu(I,j)*visc_rem_u(I,j,1) + BT_force_u(I,j) = forces%taux(I,j) * mass_to_Z * CS%IDatu(I,j)*visc_rem_u(I,j,1) enddo ; enddo !$OMP parallel do default(shared) do J=js-1,je ; do i=is,ie ! ### IDatv here should be replaced with 1/D+eta(Bous) or 1/eta(non-Bous). ! ### although with BT_cont_types IDatv should be replaced by ! ### CS%dx_Cv(I,j) / (d(vhbt)/dv) (with appropriate bounds). - BT_force_v(i,J) = forces%tauy(i,J) * mass_to_Z *CS%IDatv(i,J)*visc_rem_v(i,J,1) + BT_force_v(i,J) = forces%tauy(i,J) * mass_to_Z * CS%IDatv(i,J)*visc_rem_v(i,J,1) enddo ; enddo if (present(taux_bot) .and. present(tauy_bot)) then if (associated(taux_bot) .and. associated(tauy_bot)) then @@ -1007,11 +1009,11 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, ! non-symmetric computational domain. !$OMP parallel do default(shared) do j=js,je ; do k=1,nz ; do I=Isq,Ieq - BT_force_u(I,j) = BT_force_u(I,j) + wt_u(I,j,k) * bc_accel_u(I,j,k) + BT_force_u(I,j) = BT_force_u(I,j) + wt_u(I,j,k) * US%m_to_L*US%T_to_s**2*bc_accel_u(I,j,k) enddo ; enddo ; enddo !$OMP parallel do default(shared) do J=Jsq,Jeq ; do k=1,nz ; do i=is,ie - BT_force_v(i,J) = BT_force_v(i,J) + wt_v(i,J,k) * bc_accel_v(i,J,k) + BT_force_v(i,J) = BT_force_v(i,J) + wt_v(i,J,k) * US%m_to_L*US%T_to_s**2*bc_accel_v(i,J,k) enddo ; enddo ; enddo ! Determine the difference between the sum of the layer fluxes and the @@ -1024,24 +1026,24 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, if (CS%visc_rem_u_uh0) then !$OMP parallel do default(shared) do j=js,je ; do k=1,nz ; do I=is-1,ie - uhbt(I,j) = uhbt(I,j) + uh0(I,j,k) - ubt(I,j) = ubt(I,j) + wt_u(I,j,k) * u_uh0(I,j,k) + uhbt(I,j) = uhbt(I,j) + US%T_to_s*US%m_to_L**2*uh0(I,j,k) + ubt(I,j) = ubt(I,j) + wt_u(I,j,k) * US%m_s_to_L_T*u_uh0(I,j,k) enddo ; enddo ; enddo !$OMP parallel do default(shared) do J=js-1,je ; do k=1,nz ; do i=is,ie - vhbt(i,J) = vhbt(i,J) + vh0(i,J,k) - vbt(i,J) = vbt(i,J) + wt_v(i,J,k) * v_vh0(i,J,k) + vhbt(i,J) = vhbt(i,J) + US%T_to_s*US%m_to_L**2*vh0(i,J,k) + vbt(i,J) = vbt(i,J) + wt_v(i,J,k) * US%m_s_to_L_T*v_vh0(i,J,k) enddo ; enddo ; enddo else !$OMP parallel do default(shared) do j=js,je ; do k=1,nz ; do I=is-1,ie - uhbt(I,j) = uhbt(I,j) + uh0(I,j,k) - ubt(I,j) = ubt(I,j) + CS%frhatu(I,j,k) * u_uh0(I,j,k) + uhbt(I,j) = uhbt(I,j) + US%T_to_s*US%m_to_L**2*uh0(I,j,k) + ubt(I,j) = ubt(I,j) + CS%frhatu(I,j,k) * US%m_s_to_L_T*u_uh0(I,j,k) enddo ; enddo ; enddo !$OMP parallel do default(shared) do J=js-1,je ; do k=1,nz ; do i=is,ie - vhbt(i,J) = vhbt(i,J) + vh0(i,J,k) - vbt(i,J) = vbt(i,J) + CS%frhatv(i,J,k) * v_vh0(i,J,k) + vhbt(i,J) = vhbt(i,J) + US%T_to_s*US%m_to_L**2*vh0(i,J,k) + vbt(i,J) = vbt(i,J) + CS%frhatv(i,J,k) * US%m_s_to_L_T*v_vh0(i,J,k) enddo ; enddo ; enddo endif if (use_BT_cont) then @@ -1058,15 +1060,15 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, if (id_clock_calc_pre > 0) call cpu_clock_begin(id_clock_calc_pre) call adjust_local_BT_cont_types(ubt, uhbt, vbt, vhbt, BTCL_u, BTCL_v, & - G, MS, 1+ievf-ie) + G, US, MS, 1+ievf-ie) endif !$OMP parallel do default(shared) do j=js,je ; do I=is-1,ie - uhbt0(I,j) = uhbt(I,j) - find_uhbt(ubt(I,j),BTCL_u(I,j)) + uhbt0(I,j) = uhbt(I,j) - find_uhbt(ubt(I,j), BTCL_u(I,j), US) enddo ; enddo !$OMP parallel do default(shared) do J=js-1,je ; do i=is,ie - vhbt0(i,J) = vhbt(i,J) - find_vhbt(vbt(i,J),BTCL_v(i,J)) + vhbt0(i,J) = vhbt(i,J) - find_vhbt(vbt(i,J), BTCL_v(i,J), US) enddo ; enddo else !$OMP parallel do default(shared) @@ -1103,11 +1105,11 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, enddo ; enddo !$OMP parallel do default(shared) do j=js,je ; do k=1,nz ; do I=is-1,ie - ubt(I,j) = ubt(I,j) + wt_u(I,j,k) * U_in(I,j,k) + ubt(I,j) = ubt(I,j) + wt_u(I,j,k) * US%m_s_to_L_T*U_in(I,j,k) enddo ; enddo ; enddo !$OMP parallel do default(shared) do J=js-1,je ; do k=1,nz ; do i=is,ie - vbt(i,J) = vbt(i,J) + wt_v(i,J,k) * V_in(i,J,k) + vbt(i,J) = vbt(i,J) + wt_v(i,J,k) * US%m_s_to_L_T*V_in(i,J,k) enddo ; enddo ; enddo !$OMP parallel do default(shared) do j=js,je ; do I=is-1,ie @@ -1350,13 +1352,13 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, ! Limit the source (outward) correction to be a fraction the mass that ! can be transported out of the cell by velocities with a CFL number of ! CFL_cor. - u_max_cor = G%dxT(i,j) * (CS%maxCFL_BT_cont*Idt) - v_max_cor = G%dyT(i,j) * (CS%maxCFL_BT_cont*Idt) - eta_cor_max = dt * (CS%IareaT(i,j) * & - (((find_uhbt(u_max_cor,BTCL_u(I,j)) + uhbt0(I,j)) - & - (find_uhbt(-u_max_cor,BTCL_u(I-1,j)) + uhbt0(I-1,j))) + & - ((find_vhbt(v_max_cor,BTCL_v(i,J)) + vhbt0(i,J)) - & - (find_vhbt(-v_max_cor,BTCL_v(i,J-1)) + vhbt0(i,J-1))) )) + u_max_cor = US%m_to_L*G%dxT(i,j) * (CS%maxCFL_BT_cont*Idt) + v_max_cor = US%m_to_L*G%dyT(i,j) * (CS%maxCFL_BT_cont*Idt) + eta_cor_max = dt_in_T * (CS%IareaT(i,j) * & + (((find_uhbt(u_max_cor, BTCL_u(I,j), US) + uhbt0(I,j)) - & + (find_uhbt(-u_max_cor, BTCL_u(I-1,j), US) + uhbt0(I-1,j))) + & + ((find_vhbt(v_max_cor, BTCL_v(i,J), US) + vhbt0(i,J)) - & + (find_vhbt(-v_max_cor, BTCL_v(i,J-1), US) + vhbt0(i,J-1))) )) CS%eta_cor(i,j) = min(CS%eta_cor(i,j), max(0.0, eta_cor_max)) else ! Limit the sink (inward) correction to the amount of mass that is already @@ -1368,8 +1370,8 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, endif endif ; enddo ; enddo else ; do j=js,je ; do i=is,ie - if (abs(CS%eta_cor(i,j)) > dt*CS%eta_cor_bound(i,j)) & - CS%eta_cor(i,j) = sign(dt*CS%eta_cor_bound(i,j),CS%eta_cor(i,j)) + if (abs(CS%eta_cor(i,j)) > dt_in_T*CS%eta_cor_bound(i,j)) & + CS%eta_cor(i,j) = sign(dt_in_T*CS%eta_cor_bound(i,j), CS%eta_cor(i,j)) enddo ; enddo ; endif ; endif !$OMP do do j=js,je ; do i=is,ie @@ -1382,7 +1384,7 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, associated(forces%rigidity_ice_v)) H_min_dyn = GV%m_to_H * CS%Dmin_dyn_psurf if (ice_is_rigid .and. use_BT_cont) & - call BT_cont_to_face_areas(BT_cont, Datu, Datv, G, MS, 0, .true.) + call BT_cont_to_face_areas(BT_cont, Datu, Datv, G, US, MS, 0, .true.) if (ice_is_rigid) then !$OMP parallel do default(shared) private(Idt_max2,H_eff_dx2,dyn_coef_max,ice_strength) do j=js,je ; do i=is,ie @@ -1391,27 +1393,28 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, ! This estimate of the maximum stable time step is pretty accurate for ! gravity waves, but it is a conservative estimate since it ignores the ! stabilizing effect of the bottom drag. - Idt_max2 = 0.5 * (dgeo_de * (1.0 + 2.0*bebt)) * (G%IareaT(i,j) * & - ((gtot_E(i,j) * (Datu(I,j)*G%IdxCu(I,j)) + & - gtot_W(i,j) * (Datu(I-1,j)*G%IdxCu(I-1,j))) + & - (gtot_N(i,j) * (Datv(i,J)*G%IdyCv(i,J)) + & - gtot_S(i,j) * (Datv(i,J-1)*G%IdyCv(i,J-1)))) + & - US%s_to_T**2*((G%CoriolisBu(I,J)**2 + G%CoriolisBu(I-1,J-1)**2) + & - (G%CoriolisBu(I-1,J)**2 + G%CoriolisBu(I,J-1)**2))) - H_eff_dx2 = max(H_min_dyn * (G%IdxT(i,j)**2 + G%IdyT(i,j)**2), & - G%IareaT(i,j) * & - ((Datu(I,j)*G%IdxCu(I,j) + Datu(I-1,j)*G%IdxCu(I-1,j)) + & - (Datv(i,J)*G%IdyCv(i,J) + Datv(i,J-1)*G%IdyCv(i,J-1)) ) ) + Idt_max2 = 0.5 * (dgeo_de * (1.0 + 2.0*bebt)) * (US%L_to_m**2*G%IareaT(i,j) * & + ((gtot_E(i,j) * (Datu(I,j)*US%L_to_m*G%IdxCu(I,j)) + & + gtot_W(i,j) * (Datu(I-1,j)*US%L_to_m*G%IdxCu(I-1,j))) + & + (gtot_N(i,j) * (Datv(i,J)*US%L_to_m*G%IdyCv(i,J)) + & + gtot_S(i,j) * (Datv(i,J-1)*US%L_to_m*G%IdyCv(i,J-1)))) + & + ((G%CoriolisBu(I,J)**2 + G%CoriolisBu(I-1,J-1)**2) + & + (G%CoriolisBu(I-1,J)**2 + G%CoriolisBu(I,J-1)**2))) + H_eff_dx2 = max(H_min_dyn * ((US%L_to_m*G%IdxT(i,j))**2 + (US%L_to_m*G%IdyT(i,j))**2), & + US%L_to_m**2*G%IareaT(i,j) * & + ((Datu(I,j)*US%L_to_m*G%IdxCu(I,j) + Datu(I-1,j)*US%L_to_m*G%IdxCu(I-1,j)) + & + (Datv(i,J)*US%L_to_m*G%IdyCv(i,J) + Datv(i,J-1)*US%L_to_m*G%IdyCv(i,J-1)) ) ) dyn_coef_max = CS%const_dyn_psurf * max(0.0, 1.0 - dtbt**2 * Idt_max2) / & (dtbt**2 * H_eff_dx2) - ! ice_strength has units of [m s-2]. rigidity_ice_[uv] has units of [m3 s-1]. - ice_strength = ((forces%rigidity_ice_u(I,j) + forces%rigidity_ice_u(I-1,j)) + & + ! ice_strength has units of [L2 Z-1 T-2 ~> m s-2]. rigidity_ice_[uv] has units of [m3 s-1]. + ice_strength = US%m_to_L**4*US%Z_to_m*US%T_to_s* & + ((forces%rigidity_ice_u(I,j) + forces%rigidity_ice_u(I-1,j)) + & (forces%rigidity_ice_v(i,J) + forces%rigidity_ice_v(i,J-1))) / & (CS%ice_strength_length**2 * dtbt) - ! Units of dyn_coef: [m2 s-2 H-1 ~> m s-2 or m4 s-2 kg-1] - dyn_coef_eta(i,j) = min(dyn_coef_max, ice_strength * GV%H_to_m) + ! Units of dyn_coef: [L2 T-2 H-1 ~> m s-2 or m4 s-2 kg-1] + dyn_coef_eta(i,j) = min(dyn_coef_max, ice_strength * GV%H_to_Z) enddo ; enddo ; endif endif @@ -1445,11 +1448,11 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, if (CS%debug) then call uvchksum("BT [uv]hbt", uhbt, vhbt, CS%debug_BT_HI, haloshift=0, & - scale=GV%H_to_m) - call uvchksum("BT Initial [uv]bt", ubt, vbt, CS%debug_BT_HI, haloshift=0) + scale=US%s_to_T*US%L_to_m**2*GV%H_to_m) + call uvchksum("BT Initial [uv]bt", ubt, vbt, CS%debug_BT_HI, haloshift=0, scale=US%L_T_to_m_s) call hchksum(eta, "BT Initial eta", CS%debug_BT_HI, haloshift=0, scale=GV%H_to_m) call uvchksum("BT BT_force_[uv]", BT_force_u, BT_force_v, & - CS%debug_BT_HI, haloshift=0) + CS%debug_BT_HI, haloshift=0, scale=US%L_T2_to_m_s2) if (interp_eta_PF) then call hchksum(eta_PF_1, "BT eta_PF_1",CS%debug_BT_HI,haloshift=0, scale=GV%H_to_m) call hchksum(d_eta_PF, "BT d_eta_PF",CS%debug_BT_HI,haloshift=0, scale=GV%H_to_m) @@ -1457,20 +1460,17 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, call hchksum(eta_PF, "BT eta_PF",CS%debug_BT_HI,haloshift=0, scale=GV%H_to_m) call hchksum(eta_PF_in, "BT eta_PF_in",G%HI,haloshift=0, scale=GV%H_to_m) endif - call uvchksum("BT Cor_ref_[uv]", Cor_ref_u, Cor_ref_v, CS%debug_BT_HI, haloshift=0) - call uvchksum("BT [uv]hbt0", uhbt0, vhbt0, CS%debug_BT_HI, & - haloshift=0, scale=GV%H_to_m) + call uvchksum("BT Cor_ref_[uv]", Cor_ref_u, Cor_ref_v, CS%debug_BT_HI, haloshift=0, scale=US%L_T2_to_m_s2) + call uvchksum("BT [uv]hbt0", uhbt0, vhbt0, CS%debug_BT_HI, haloshift=0, & + scale=US%L_to_m**2*US%s_to_T*GV%H_to_m) if (.not. use_BT_cont) then - call uvchksum("BT Dat[uv]", Datu, Datv, CS%debug_BT_HI, haloshift=1, & - scale=GV%H_to_m) + call uvchksum("BT Dat[uv]", Datu, Datv, CS%debug_BT_HI, haloshift=1, scale=US%L_to_m*GV%H_to_m) endif call uvchksum("BT wt_[uv]", wt_u, wt_v, G%HI, 0, .true., .true.) call uvchksum("BT frhat[uv]", CS%frhatu, CS%frhatv, G%HI, 0, .true., .true.) - call uvchksum("BT bc_accel_[uv]", bc_accel_u, bc_accel_v, & - G%HI, haloshift=0) + call uvchksum("BT bc_accel_[uv]", bc_accel_u, bc_accel_v, G%HI, haloshift=0) call uvchksum("BT IDat[uv]", CS%IDatu, CS%IDatv, G%HI, haloshift=0, scale=US%m_to_Z) - call uvchksum("BT visc_rem_[uv]", visc_rem_u, visc_rem_v, & - G%HI, haloshift=1) + call uvchksum("BT visc_rem_[uv]", visc_rem_u, visc_rem_v, G%HI, haloshift=1) endif if (query_averaging_enabled(CS%diag)) then @@ -1485,9 +1485,9 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, if (project_velocity) then ; eta_PF_BT => eta ; else ; eta_PF_BT => eta_pred ; endif if (CS%dt_bt_filter >= 0.0) then - dt_filt = 0.5 * max(0.0, min(CS%dt_bt_filter, 2.0*dt)) + dt_filt = 0.5 * max(0.0, min(CS%dt_bt_filter, 2.0*dt_in_T)) else - dt_filt = 0.5 * max(0.0, dt * min(-CS%dt_bt_filter, 2.0)) + dt_filt = 0.5 * max(0.0, dt_in_T * min(-CS%dt_bt_filter, 2.0)) endif nfilter = ceiling(dt_filt / dtbt) @@ -1545,21 +1545,21 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, if (CS%clip_velocity) then do j=jsv,jev ; do I=isv-1,iev - if ((ubt(I,j) * (dt * G%dy_Cu(I,j))) * G%IareaT(i+1,j) < -CS%CFL_trunc) then + if ((ubt(I,j) * (dt_in_T * US%m_to_L*G%dy_Cu(I,j))) * US%L_to_m**2*G%IareaT(i+1,j) < -CS%CFL_trunc) then ! Add some error reporting later. - ubt(I,j) = (-0.95*CS%CFL_trunc) * (G%areaT(i+1,j) / (dt * G%dy_Cu(I,j))) - elseif ((ubt(I,j) * (dt * G%dy_Cu(I,j))) * G%IareaT(i,j) > CS%CFL_trunc) then + ubt(I,j) = (-0.95*CS%CFL_trunc) * (US%m_to_L**2*G%areaT(i+1,j) / (dt_in_T * US%m_to_L*G%dy_Cu(I,j))) + elseif ((ubt(I,j) * (dt_in_T * US%m_to_L*G%dy_Cu(I,j))) * US%L_to_m**2*G%IareaT(i,j) > CS%CFL_trunc) then ! Add some error reporting later. - ubt(I,j) = (0.95*CS%CFL_trunc) * (G%areaT(i,j) / (dt * G%dy_Cu(I,j))) + ubt(I,j) = (0.95*CS%CFL_trunc) * (US%m_to_L**2*G%areaT(i,j) / (dt_in_T * US%m_to_L*G%dy_Cu(I,j))) endif enddo ; enddo do J=jsv-1,jev ; do i=isv,iev - if ((vbt(i,J) * (dt * G%dx_Cv(i,J))) * G%IareaT(i,j+1) < -CS%CFL_trunc) then + if ((vbt(i,J) * (dt_in_T * US%m_to_L*G%dx_Cv(i,J))) * US%L_to_m**2*G%IareaT(i,j+1) < -CS%CFL_trunc) then ! Add some error reporting later. - vbt(i,J) = (-0.9*CS%CFL_trunc) * (G%areaT(i,j+1) / (dt * G%dx_Cv(i,J))) - elseif ((vbt(i,J) * (dt * G%dx_Cv(i,J))) * G%IareaT(i,j) > CS%CFL_trunc) then + vbt(i,J) = (-0.9*CS%CFL_trunc) * (US%m_to_L**2*G%areaT(i,j+1) / (dt_in_T * US%m_to_L*G%dx_Cv(i,J))) + elseif ((vbt(i,J) * (dt_in_T * US%m_to_L*G%dx_Cv(i,J))) * US%L_to_m**2*G%IareaT(i,j) > CS%CFL_trunc) then ! Add some error reporting later. - vbt(i,J) = (0.9*CS%CFL_trunc) * (G%areaT(i,j) / (dt * G%dx_Cv(i,J))) + vbt(i,J) = (0.9*CS%CFL_trunc) * (US%m_to_L**2*G%areaT(i,j) / (dt_in_T * US%m_to_L*G%dx_Cv(i,J))) endif enddo ; enddo endif @@ -1577,33 +1577,27 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, if ((.not.use_BT_cont) .and. CS%Nonlinear_continuity .and. & (CS%Nonlin_cont_update_period > 0)) then if ((n>1) .and. (mod(n-1,CS%Nonlin_cont_update_period) == 0)) & - call find_face_areas(Datu, Datv, G, GV, CS, MS, eta, 1+iev-ie) + call find_face_areas(Datu, Datv, G, GV, US, CS, MS, eta, 1+iev-ie) endif -!GOMP parallel default(none) shared(CS,isv,iev,jsv,jev,project_velocity,use_BT_cont, & -!GOMP uhbt,vhbt,ubt,BTCL_u,uhbt0,vbt,BTCL_v,vhbt0, & -!GOMP eta_pred,eta,eta_src,dtbt,Datu,Datv,p_surf_dyn, & -!GOMP dyn_coef_eta,find_etaav,is,ie,js,je,eta_sum, & -!GOMP wt_accel2,n,eta_PF_BT,interp_eta_PF,wt_end, & -!GOMP Instep,eta_PF,eta_PF_1,d_eta_PF, & -!GOMP apply_OBC_flather,ubt_old,vbt_old ) + !GOMP parallel default(shared) if (CS%dynamic_psurf .or. .not.project_velocity) then if (use_BT_cont) then -!GOMP do + !GOMP do do j=jsv-1,jev+1 ; do I=isv-2,iev+1 - uhbt(I,j) = find_uhbt(ubt(I,j),BTCL_u(I,j)) + uhbt0(I,j) + uhbt(I,j) = find_uhbt(ubt(I,j), BTCL_u(I,j), US) + uhbt0(I,j) enddo ; enddo -!GOMP do + !GOMP do do J=jsv-2,jev+1 ; do i=isv-1,iev+1 - vhbt(i,J) = find_vhbt(vbt(i,J),BTCL_v(i,J)) + vhbt0(i,J) + vhbt(i,J) = find_vhbt(vbt(i,J), BTCL_v(i,J), US) + vhbt0(i,J) enddo ; enddo -!GOMP do + !GOMP do do j=jsv-1,jev+1 ; do i=isv-1,iev+1 eta_pred(i,j) = (eta(i,j) + eta_src(i,j)) + (dtbt * CS%IareaT(i,j)) * & ((uhbt(I-1,j) - uhbt(I,j)) + (vhbt(i,J-1) - vhbt(i,J))) enddo ; enddo else -!GOMP do + !GOMP do do j=jsv-1,jev+1 ; do i=isv-1,iev+1 eta_pred(i,j) = (eta(i,j) + eta_src(i,j)) + (dtbt * CS%IareaT(i,j)) * & (((Datu(I-1,j)*ubt(I-1,j) + uhbt0(I-1,j)) - & @@ -1614,7 +1608,7 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, endif if (CS%dynamic_psurf) then -!GOMP do + !GOMP do do j=jsv-1,jev+1 ; do i=isv-1,iev+1 p_surf_dyn(i,j) = dyn_coef_eta(i,j) * (eta_pred(i,j) - eta(i,j)) enddo ; enddo @@ -1625,7 +1619,7 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, ! eta_PF_BT => eta_pred ; if (project_velocity) eta_PF_BT => eta if (find_etaav) then -!GOMP do + !GOMP do do j=js,je ; do i=is,ie eta_sum(i,j) = eta_sum(i,j) + wt_accel2(n) * eta_PF_BT(i,j) enddo ; enddo @@ -1633,23 +1627,23 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, if (interp_eta_PF) then wt_end = n*Instep ! This could be (n-0.5)*Instep. -!GOMP do + !GOMP do do j=jsv-1,jev+1 ; do i=isv-1,iev+1 eta_PF(i,j) = eta_PF_1(i,j) + wt_end*d_eta_PF(i,j) enddo ; enddo endif if (apply_OBC_flather .or. apply_OBC_open) then -!GOMP do + !GOMP do do j=jsv,jev ; do I=isv-2,iev+1 ubt_old(I,j) = ubt(I,j) enddo ; enddo -!GOMP do + !GOMP do do J=jsv-2,jev+1 ; do i=isv,iev vbt_old(i,J) = vbt(i,J) enddo ; enddo endif -!GOMP end parallel + !GOMP end parallel if (apply_OBCs) then if (MOD(n+G%first_direction,2)==1) then @@ -1659,30 +1653,26 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, endif if (CS%BT_OBC%apply_u_OBCs) then ! save the old value of ubt and uhbt -!GOMP parallel do default(none) shared(isv,iev,jsv,jev,ioff,joff,ubt_prev,ubt,uhbt_prev, & -!GOMP uhbt,ubt_sum_prev,ubt_sum,uhbt_sum_prev, & -!GOMP uhbt_sum,ubt_wtd_prev,ubt_wtd) + !GOMP parallel do default(shared) do J=jsv-joff,jev+joff ; do i=isv-1,iev - ubt_prev(i,J) = ubt(i,J); uhbt_prev(i,J) = uhbt(i,J) - ubt_sum_prev(i,J)=ubt_sum(i,J); uhbt_sum_prev(i,J)=uhbt_sum(i,J) ; ubt_wtd_prev(i,J)=ubt_wtd(i,J) + ubt_prev(i,J) = ubt(i,J) ; uhbt_prev(i,J) = uhbt(i,J) + ubt_sum_prev(i,J) = ubt_sum(i,J) ; uhbt_sum_prev(i,J) = uhbt_sum(i,J) ; ubt_wtd_prev(i,J) = ubt_wtd(i,J) enddo ; enddo endif if (CS%BT_OBC%apply_v_OBCs) then ! save the old value of vbt and vhbt -!GOMP parallel do default(none) shared(isv,iev,jsv,jev,ioff,joff,vbt_prev,vbt,vhbt_prev, & -!GOMP vhbt,vbt_sum_prev,vbt_sum,vhbt_sum_prev, & -!GOMP vhbt_sum,vbt_wtd_prev,vbt_wtd) + !GOMP parallel do default(shared) do J=jsv-1,jev ; do i=isv-ioff,iev+ioff - vbt_prev(i,J) = vbt(i,J); vhbt_prev(i,J) = vhbt(i,J) - vbt_sum_prev(i,J)=vbt_sum(i,J); vhbt_sum_prev(i,J)=vhbt_sum(i,J) ; vbt_wtd_prev(i,J) = vbt_wtd(i,J) + vbt_prev(i,J) = vbt(i,J) ; vhbt_prev(i,J) = vhbt(i,J) + vbt_sum_prev(i,J) = vbt_sum(i,J) ; vhbt_sum_prev(i,J) = vhbt_sum(i,J) ; vbt_wtd_prev(i,J) = vbt_wtd(i,J) enddo ; enddo endif endif -!GOMP parallel default(shared) private(vel_prev) + !GOMP parallel default(shared) private(vel_prev) if (MOD(n+G%first_direction,2)==1) then ! On odd-steps, update v first. -!GOMP do + !GOMP do do J=jsv-1,jev ; do i=isv-1,iev+1 Cor_v(i,J) = -1.0*((amer(I-1,j) * ubt(I-1,j) + cmer(I,j+1) * ubt(I,j+1)) + & (bmer(I,j) * ubt(I,j) + dmer(I-1,j+1) * ubt(I-1,j+1))) - Cor_ref_v(i,J) @@ -1691,19 +1681,19 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, dgeo_de * CS%IdyCv(i,J) enddo ; enddo if (CS%dynamic_psurf) then -!GOMP do + !GOMP do do J=jsv-1,jev ; do i=isv-1,iev+1 PFv(i,J) = PFv(i,J) + (p_surf_dyn(i,j) - p_surf_dyn(i,j+1)) * CS%IdyCv(i,J) enddo ; enddo endif if (CS%BT_OBC%apply_v_OBCs) then ! zero out PF across boundary -!GOMP do + !GOMP do do J=jsv-1,jev ; do i=isv-1,iev+1 ; if (OBC%segnum_v(i,J) /= OBC_NONE) then PFv(i,J) = 0.0 endif ; enddo ; enddo endif -!GOMP do + !GOMP do do J=jsv-1,jev ; do i=isv-1,iev+1 vel_prev = vbt(i,J) vbt(i,J) = bt_rem_v(i,J) * (vbt(i,J) + & @@ -1719,24 +1709,24 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, enddo ; enddo if (use_BT_cont) then -!GOMP do + !GOMP do do J=jsv-1,jev ; do i=isv-1,iev+1 - vhbt(i,J) = find_vhbt(vbt_trans(i,J),BTCL_v(i,J)) + vhbt0(i,J) + vhbt(i,J) = find_vhbt(vbt_trans(i,J), BTCL_v(i,J), US) + vhbt0(i,J) enddo ; enddo else -!GOMP do + !GOMP do do J=jsv-1,jev ; do i=isv-1,iev+1 vhbt(i,J) = Datv(i,J)*vbt_trans(i,J) + vhbt0(i,J) enddo ; enddo endif if (CS%BT_OBC%apply_v_OBCs) then ! copy back the value for v-points on the boundary. -!GOMP do + !GOMP do do J=jsv-1,jev ; do i=isv-1,iev+1 ; if (OBC%segnum_v(i,J) /= OBC_NONE) then - vbt(i,J) = vbt_prev(i,J); vhbt(i,J) = vhbt_prev(i,J) + vbt(i,J) = vbt_prev(i,J) ; vhbt(i,J) = vhbt_prev(i,J) endif ; enddo ; enddo endif ! Now update the zonal velocity. -!GOMP do + !GOMP do do j=jsv,jev ; do I=isv-1,iev Cor_u(I,j) = ((azon(I,j) * vbt(i+1,J) + czon(I,j) * vbt(i,J-1)) + & (bzon(I,j) * vbt(i,J) + dzon(I,j) * vbt(i+1,J-1))) - & @@ -1747,19 +1737,19 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, enddo ; enddo if (CS%dynamic_psurf) then -!GOMP do + !GOMP do do j=jsv,jev ; do I=isv-1,iev PFu(I,j) = PFu(I,j) + (p_surf_dyn(i,j) - p_surf_dyn(i+1,j)) * CS%IdxCu(I,j) enddo ; enddo endif if (CS%BT_OBC%apply_u_OBCs) then ! zero out pressure force across boundary -!GOMP do + !GOMP do do j=jsv,jev ; do I=isv-1,iev ; if (OBC%segnum_u(I,j) /= OBC_NONE) then PFu(I,j) = 0.0 endif ; enddo ; enddo endif -!GOMP do + !GOMP do do j=jsv,jev ; do I=isv-1,iev vel_prev = ubt(I,j) ubt(I,j) = bt_rem_u(I,j) * (ubt(I,j) + & @@ -1776,25 +1766,25 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, enddo ; enddo if (use_BT_cont) then -!GOMP do + !GOMP do do j=jsv,jev ; do I=isv-1,iev - uhbt(I,j) = find_uhbt(ubt_trans(I,j), BTCL_u(I,j)) + uhbt0(I,j) + uhbt(I,j) = find_uhbt(ubt_trans(I,j), BTCL_u(I,j), US) + uhbt0(I,j) enddo ; enddo else -!GOMP do + !GOMP do do j=jsv,jev ; do I=isv-1,iev uhbt(I,j) = Datu(I,j)*ubt_trans(I,j) + uhbt0(I,j) enddo ; enddo endif if (CS%BT_OBC%apply_u_OBCs) then ! copy back the value for u-points on the boundary. -!GOMP do + !GOMP do do j=jsv,jev ; do I=isv-1,iev ; if (OBC%segnum_u(I,j) /= OBC_NONE) then ubt(I,j) = ubt_prev(I,j); uhbt(I,j) = uhbt_prev(I,j) endif ; enddo ; enddo endif else ! On even steps, update u first. -!GOMP do + !GOMP do do j=jsv-1,jev+1 ; do I=isv-1,iev Cor_u(I,j) = ((azon(I,j) * vbt(i+1,J) + czon(I,j) * vbt(i,J-1)) + & (bzon(I,j) * vbt(i,J) + dzon(I,j) * vbt(i+1,J-1))) - & @@ -1805,26 +1795,27 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, enddo ; enddo if (CS%dynamic_psurf) then -!GOMP do + !GOMP do do j=jsv-1,jev+1 ; do I=isv-1,iev PFu(I,j) = PFu(I,j) + (p_surf_dyn(i,j) - p_surf_dyn(i+1,j)) * CS%IdxCu(I,j) enddo ; enddo endif if (CS%BT_OBC%apply_u_OBCs) then ! zero out pressure force across boundary -!GOMP do + !GOMP do do j=jsv,jev ; do I=isv-1,iev ; if (OBC%segnum_u(I,j) /= OBC_NONE) then PFu(I,j) = 0.0 endif ; enddo ; enddo endif -!GOMP do + !GOMP do do j=jsv-1,jev+1 ; do I=isv-1,iev vel_prev = ubt(I,j) ubt(I,j) = bt_rem_u(I,j) * (ubt(I,j) + & dtbt * ((BT_force_u(I,j) + Cor_u(I,j)) + PFu(I,j))) if (abs(ubt(I,j)) < CS%vel_underflow) ubt(I,j) = 0.0 ubt_trans(I,j) = trans_wt1*ubt(I,j) + trans_wt2*vel_prev + if (CS%linear_wave_drag) then u_accel_bt(I,j) = u_accel_bt(I,j) + wt_accel(n) * & ((Cor_u(I,j) + PFu(I,j)) - ubt(I,j)*Rayleigh_u(I,j)) @@ -1834,18 +1825,18 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, enddo ; enddo if (use_BT_cont) then -!GOMP do + !GOMP do do j=jsv-1,jev+1 ; do I=isv-1,iev - uhbt(I,j) = find_uhbt(ubt_trans(I,j),BTCL_u(I,j)) + uhbt0(I,j) + uhbt(I,j) = find_uhbt(ubt_trans(I,j), BTCL_u(I,j), US) + uhbt0(I,j) enddo ; enddo else -!GOMP do + !GOMP do do j=jsv-1,jev+1 ; do I=isv-1,iev uhbt(I,j) = Datu(I,j)*ubt_trans(I,j) + uhbt0(I,j) enddo ; enddo endif if (CS%BT_OBC%apply_u_OBCs) then ! copy back the value for u-points on the boundary. -!GOMP do + !GOMP do do j=jsv-1,jev+1 ; do I=isv-1,iev ; if (OBC%segnum_u(I,j) /= OBC_NONE) then ubt(I,j) = ubt_prev(I,j); uhbt(I,j) = uhbt_prev(I,j) endif ; enddo ; enddo @@ -1853,7 +1844,7 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, ! Now update the meridional velocity. if (CS%use_old_coriolis_bracket_bug) then -!GOMP do + !GOMP do do J=jsv-1,jev ; do i=isv,iev Cor_v(i,J) = -1.0*((amer(I-1,j) * ubt(I-1,j) + bmer(I,j) * ubt(I,j)) + & (cmer(I,j+1) * ubt(I,j+1) + dmer(I-1,j+1) * ubt(I-1,j+1))) - Cor_ref_v(i,J) @@ -1862,7 +1853,7 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, dgeo_de * CS%IdyCv(i,J) enddo ; enddo else -!GOMP do + !GOMP do do J=jsv-1,jev ; do i=isv,iev Cor_v(i,J) = -1.0*((amer(I-1,j) * ubt(I-1,j) + cmer(I,j+1) * ubt(I,j+1)) + & (bmer(I,j) * ubt(I,j) + dmer(I-1,j+1) * ubt(I-1,j+1))) - Cor_ref_v(i,J) @@ -1873,20 +1864,20 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, endif if (CS%dynamic_psurf) then -!GOMP do + !GOMP do do J=jsv-1,jev ; do i=isv,iev PFv(i,J) = PFv(i,J) + (p_surf_dyn(i,j) - p_surf_dyn(i,j+1)) * CS%IdyCv(i,J) enddo ; enddo endif if (CS%BT_OBC%apply_v_OBCs) then ! zero out PF across boundary -!GOMP do + !GOMP do do J=jsv-1,jev ; do i=isv-1,iev+1 ; if (OBC%segnum_v(i,J) /= OBC_NONE) then PFv(i,J) = 0.0 endif ; enddo ; enddo endif -!GOMP do + !GOMP do do J=jsv-1,jev ; do i=isv,iev vel_prev = vbt(i,J) vbt(i,J) = bt_rem_v(i,J) * (vbt(i,J) + & @@ -1902,90 +1893,85 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, endif enddo ; enddo if (use_BT_cont) then -!GOMP do + !GOMP do do J=jsv-1,jev ; do i=isv,iev - vhbt(i,J) = find_vhbt(vbt_trans(i,J),BTCL_v(i,J)) + vhbt0(i,J) + vhbt(i,J) = find_vhbt(vbt_trans(i,J), BTCL_v(i,J), US) + vhbt0(i,J) enddo ; enddo else -!GOMP do + !GOMP do do J=jsv-1,jev ; do i=isv,iev vhbt(i,J) = Datv(i,J)*vbt_trans(i,J) + vhbt0(i,J) enddo ; enddo endif if (CS%BT_OBC%apply_v_OBCs) then ! copy back the value for v-points on the boundary. -!GOMP do + !GOMP do do J=jsv-1,jev ; do i=isv,iev ; if (OBC%segnum_v(i,J) /= OBC_NONE) then vbt(i,J) = vbt_prev(i,J); vhbt(i,J) = vhbt_prev(i,J) endif ; enddo ; enddo endif endif -!GOMP end parallel - -!GOMP parallel default(none) shared(is,ie,js,je,find_PF,PFu_bt_sum,wt_accel2, & -!GOMP PFu,PFv_bt_sum,PFv,find_Cor,Coru_bt_sum, & -!GOMP Cor_u,Corv_bt_sum,Cor_v,ubt_sum,wt_trans, & -!GOMP ubt_trans,uhbt_sum,uhbt,ubt_wtd,wt_vel, & -!GOMP ubt,vbt_sum,vbt_trans,vhbt_sum,vhbt, & -!GOMP vbt_wtd,vbt,n ) + !GOMP end parallel + + !GOMP parallel default(shared) if (find_PF) then -!GOMP do + !GOMP do do j=js,je ; do I=is-1,ie PFu_bt_sum(I,j) = PFu_bt_sum(I,j) + wt_accel2(n) * PFu(I,j) enddo ; enddo -!GOMP do + !GOMP do do J=js-1,je ; do i=is,ie PFv_bt_sum(i,J) = PFv_bt_sum(i,J) + wt_accel2(n) * PFv(i,J) enddo ; enddo endif if (find_Cor) then -!GOMP do + !GOMP do do j=js,je ; do I=is-1,ie Coru_bt_sum(I,j) = Coru_bt_sum(I,j) + wt_accel2(n) * Cor_u(I,j) enddo ; enddo -!GOMP do + !GOMP do do J=js-1,je ; do i=is,ie Corv_bt_sum(i,J) = Corv_bt_sum(i,J) + wt_accel2(n) * Cor_v(i,J) enddo ; enddo endif -!GOMP do + !GOMP do do j=js,je ; do I=is-1,ie ubt_sum(I,j) = ubt_sum(I,j) + wt_trans(n) * ubt_trans(I,j) uhbt_sum(I,j) = uhbt_sum(I,j) + wt_trans(n) * uhbt(I,j) ubt_wtd(I,j) = ubt_wtd(I,j) + wt_vel(n) * ubt(I,j) enddo ; enddo -!GOMP do + !GOMP do do J=js-1,je ; do i=is,ie vbt_sum(i,J) = vbt_sum(i,J) + wt_trans(n) * vbt_trans(i,J) vhbt_sum(i,J) = vhbt_sum(i,J) + wt_trans(n) * vhbt(i,J) vbt_wtd(i,J) = vbt_wtd(i,J) + wt_vel(n) * vbt(i,J) enddo ; enddo -!GOMP end parallel + !GOMP end parallel if (apply_OBCs) then if (CS%BT_OBC%apply_u_OBCs) then ! copy back the value for u-points on the boundary. -!GOMP parallel do default(none) shared(is,ie,js,je,ubt_sum_prev,ubt_sum,uhbt_sum_prev,& -!GOMP uhbt_sum,ubt_wtd_prev,ubt_wtd) + !GOMP parallel do default(shared) do j=js,je ; do I=is-1,ie if (OBC%segnum_u(I,j) /= OBC_NONE) then - ubt_sum(I,j)=ubt_sum_prev(I,j); uhbt_sum(I,j)=uhbt_sum_prev(I,j) ; ubt_wtd(I,j)=ubt_wtd_prev(I,j) + ubt_sum(I,j) = ubt_sum_prev(I,j) ; uhbt_sum(I,j) = uhbt_sum_prev(I,j) + ubt_wtd(I,j) = ubt_wtd_prev(I,j) endif enddo ; enddo endif if (CS%BT_OBC%apply_v_OBCs) then ! copy back the value for v-points on the boundary. -!GOMP parallel do default(none) shared(is,ie,js,je,vbt_sum_prev,vbt_sum,vhbt_sum_prev, & -!GOMP vhbt_sum,vbt_wtd_prev,vbt_wtd) + !GOMP parallel do default(shared) do J=js-1,je ; do I=is,ie if (OBC%segnum_v(i,J) /= OBC_NONE) then - vbt_sum(i,J)=vbt_sum_prev(i,J); vhbt_sum(i,J)=vhbt_sum_prev(i,J) ; vbt_wtd(i,J)=vbt_wtd_prev(i,J) + vbt_sum(i,J) = vbt_sum_prev(i,J) ; vhbt_sum(i,J) = vhbt_sum_prev(i,J) + vbt_wtd(i,J) = vbt_wtd_prev(i,J) endif enddo ; enddo endif call apply_velocity_OBCs(OBC, ubt, vbt, uhbt, vhbt, & ubt_trans, vbt_trans, eta, ubt_old, vbt_old, CS%BT_OBC, & - G, MS, iev-ie, dtbt, bebt, use_BT_cont, Datu, Datv, BTCL_u, BTCL_v, & + G, MS, US, iev-ie, dtbt, bebt, use_BT_cont, Datu, Datv, BTCL_u, BTCL_v, & uhbt0, vhbt0) if (CS%BT_OBC%apply_u_OBCs) then ; do j=js,je ; do I=is-1,ie if (OBC%segnum_u(I,j) /= OBC_NONE) then @@ -2004,11 +1990,11 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, endif if (CS%debug_bt) then - call uvchksum("BT [uv]hbt just after OBC", uhbt, vhbt, & - CS%debug_BT_HI, haloshift=iev-ie, scale=GV%H_to_m) + call uvchksum("BT [uv]hbt just after OBC", uhbt, vhbt, CS%debug_BT_HI, haloshift=iev-ie, & + scale=US%s_to_T*US%L_to_m**2*GV%H_to_m) endif -!$OMP parallel do default(none) shared(isv,iev,jsv,jev,n,eta,eta_src,dtbt,CS,uhbt,vhbt,eta_wtd,wt_eta) + !$OMP parallel do default(shared) do j=jsv,jev ; do i=isv,iev eta(i,j) = (eta(i,j) + eta_src(i,j)) + (dtbt * CS%IareaT(i,j)) * & ((uhbt(I-1,j) - uhbt(I,j)) + (vhbt(i,J-1) - vhbt(i,J))) @@ -2017,8 +2003,8 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, enddo ; enddo if (do_hifreq_output) then - time_step_end = time_bt_start + real_to_time(n*dtbt) - call enable_averaging(dtbt, time_step_end, CS%diag) + time_step_end = time_bt_start + real_to_time(n*US%T_to_s*dtbt) + call enable_averaging(US%T_to_s*dtbt, time_step_end, CS%diag) if (CS%id_ubt_hifreq > 0) call post_data(CS%id_ubt_hifreq, ubt(IsdB:IedB,jsd:jed), CS%diag) if (CS%id_vbt_hifreq > 0) call post_data(CS%id_vbt_hifreq, vbt(isd:ied,JsdB:JedB), CS%diag) if (CS%id_eta_hifreq > 0) call post_data(CS%id_eta_hifreq, eta(isd:ied,jsd:jed), CS%diag) @@ -2029,9 +2015,9 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, if (CS%debug_bt) then write(mesg,'("BT step ",I4)') n - call uvchksum(trim(mesg)//" [uv]bt", ubt, vbt, & - CS%debug_BT_HI, haloshift=iev-ie) - call hchksum(eta, trim(mesg)//" eta",CS%debug_BT_HI,haloshift=iev-ie, scale=GV%H_to_m) + call uvchksum(trim(mesg)//" [uv]bt", ubt, vbt, CS%debug_BT_HI, haloshift=iev-ie, & + scale=US%L_T_to_m_s) + call hchksum(eta, trim(mesg)//" eta", CS%debug_BT_HI, haloshift=iev-ie, scale=GV%H_to_m) endif enddo ! end of do n=1,ntimestep @@ -2100,16 +2086,16 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, if (id_clock_calc_post > 0) call cpu_clock_begin(id_clock_calc_post) do j=js,je ; do I=is-1,ie - CS%ubtav(I,j) = ubt_sum(I,j) * I_sum_wt_trans - uhbtav(I,j) = uhbt_sum(I,j) * I_sum_wt_trans + CS%ubtav(I,j) = US%L_T_to_m_s*ubt_sum(I,j) * I_sum_wt_trans + uhbtav(I,j) = US%s_to_T*US%L_to_m**2*uhbt_sum(I,j) * I_sum_wt_trans ! The following line would do approximately nothing, as I_sum_wt_accel ~= 1. !### u_accel_bt(I,j) = u_accel_bt(I,j) * I_sum_wt_accel ubt_wtd(I,j) = ubt_wtd(I,j) * I_sum_wt_vel enddo ; enddo do J=js-1,je ; do i=is,ie - CS%vbtav(i,J) = vbt_sum(i,J) * I_sum_wt_trans - vhbtav(i,J) = vhbt_sum(i,J) * I_sum_wt_trans + CS%vbtav(i,J) = US%L_T_to_m_s*vbt_sum(i,J) * I_sum_wt_trans + vhbtav(i,J) = US%s_to_T*US%L_to_m**2*vhbt_sum(i,J) * I_sum_wt_trans ! The following line would do approximately nothing, as I_sum_wt_accel ~= 1. !### v_accel_bt(i,J) = v_accel_bt(i,J) * I_sum_wt_accel vbt_wtd(i,J) = vbt_wtd(i,J) * I_sum_wt_vel @@ -2120,7 +2106,7 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, if (G%nonblocking_updates) then call complete_group_pass(CS%pass_e_anom, G%Domain) if (find_etaav) call start_group_pass(CS%pass_etaav, G%Domain) - call start_group_pass(CS%pass_ubta_uhbta, G%Domain) + call start_group_pass(CS%pass_ubta_uhbta, G%DoMain) else call do_group_pass(CS%pass_ubta_uhbta, G%Domain) endif @@ -2131,15 +2117,15 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, !$OMP parallel do default(shared) do k=1,nz do j=js,je ; do I=is-1,ie - accel_layer_u(I,j,k) = u_accel_bt(I,j) - & - ((US%L_T_to_m_s**2*pbce(i+1,j,k) - gtot_W(i+1,j)) * e_anom(i+1,j) - & - (US%L_T_to_m_s**2*pbce(i,j,k) - gtot_E(i,j)) * e_anom(i,j)) * CS%IdxCu(I,j) + accel_layer_u(I,j,k) = US%L_T2_to_m_s2 * (u_accel_bt(I,j) - & + ((pbce(i+1,j,k) - gtot_W(i+1,j)) * e_anom(i+1,j) - & + (pbce(i,j,k) - gtot_E(i,j)) * e_anom(i,j)) * CS%IdxCu(I,j) ) if (abs(accel_layer_u(I,j,k)) < accel_underflow) accel_layer_u(I,j,k) = 0.0 enddo ; enddo do J=js-1,je ; do i=is,ie - accel_layer_v(i,J,k) = v_accel_bt(i,J) - & - ((US%L_T_to_m_s**2*pbce(i,j+1,k) - gtot_S(i,j+1))*e_anom(i,j+1) - & - (US%L_T_to_m_s**2*pbce(i,j,k) - gtot_N(i,j))*e_anom(i,j)) * CS%IdyCv(i,J) + accel_layer_v(i,J,k) = US%L_T2_to_m_s2 * (v_accel_bt(i,J) - & + ((pbce(i,j+1,k) - gtot_S(i,j+1)) * e_anom(i,j+1) - & + (pbce(i,j,k) - gtot_N(i,j)) * e_anom(i,j)) * CS%IdyCv(i,J) ) if (abs(accel_layer_v(i,J,k)) < accel_underflow) accel_layer_v(i,J,k) = 0.0 enddo ; enddo enddo @@ -2149,14 +2135,14 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, ! symmetric-memory computational domain, not in the wide halo regions. if (CS%BT_OBC%apply_u_OBCs) then ; do j=js,je ; do I=is-1,ie if (OBC%segnum_u(I,j) /= OBC_NONE) then - u_accel_bt(I,j) = (ubt_wtd(I,j) - ubt_first(I,j)) / dt - do k=1,nz ; accel_layer_u(I,j,k) = u_accel_bt(I,j) ; enddo + u_accel_bt(I,j) = (ubt_wtd(I,j) - ubt_first(I,j)) / dt_in_T + do k=1,nz ; accel_layer_u(I,j,k) = US%L_T2_to_m_s2*u_accel_bt(I,j) ; enddo endif enddo ; enddo ; endif if (CS%BT_OBC%apply_v_OBCs) then ; do J=js-1,je ; do i=is,ie if (OBC%segnum_v(i,J) /= OBC_NONE) then - v_accel_bt(i,J) = (vbt_wtd(i,J) - vbt_first(i,J)) / dt - do k=1,nz ; accel_layer_v(i,J,k) = v_accel_bt(i,J) ; enddo + v_accel_bt(i,J) = (vbt_wtd(i,J) - vbt_first(i,J)) / dt_in_T + do k=1,nz ; accel_layer_v(i,J,k) = US%L_T2_to_m_s2*v_accel_bt(i,J) ; enddo endif enddo ; enddo ; endif endif @@ -2170,10 +2156,10 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, do J=js-1,je ; do i=is,ie ; CS%vbt_IC(i,J) = vbt_wtd(i,J) ; enddo ; enddo if (use_BT_cont) then do j=js,je ; do I=is-1,ie - CS%uhbt_IC(I,j) = find_uhbt(ubt_wtd(I,j), BTCL_u(I,j)) + uhbt0(I,j) + CS%uhbt_IC(I,j) = find_uhbt(ubt_wtd(I,j), BTCL_u(I,j), US) + uhbt0(I,j) enddo ; enddo do J=js-1,je ; do i=is,ie - CS%vhbt_IC(i,J) = find_vhbt(vbt_wtd(i,J), BTCL_v(i,J)) + vhbt0(i,J) + CS%vhbt_IC(i,J) = find_vhbt(vbt_wtd(i,J), BTCL_v(i,J), US) + vhbt0(i,J) enddo ; enddo else do j=js,je ; do I=is-1,ie @@ -2290,24 +2276,28 @@ subroutine set_dtbt(G, GV, US, CS, eta, pbce, BT_cont, gtot_est, SSH_add) gtot_W, & ! free surface height deviations to pressure forces (including gtot_N, & ! GFS and baroclinic contributions) in the barotropic momentum gtot_S ! equations half a grid-point in the X-direction (X is N, S, E, or W) - ! from the thickness point [m2 H-1 s-2 ~> m s-2 or m4 kg-1 s-2]. + ! from the thickness point [L2 H-1 T-2 ~> m s-2 or m4 kg-1 s-2]. ! (See Hallberg, J Comp Phys 1997 for a discussion.) real, dimension(SZIBS_(G),SZJ_(G)) :: & Datu ! Basin depth at u-velocity grid points times the y-grid - ! spacing [H m ~> m2 or kg m-1]. + ! spacing [H L ~> m2 or kg m-1]. real, dimension(SZI_(G),SZJBS_(G)) :: & Datv ! Basin depth at v-velocity grid points times the x-grid - ! spacing [H m ~> m2 or kg m-1]. + ! spacing [H L ~> m2 or kg m-1]. real :: det_de ! The partial derivative due to self-attraction and loading - ! of the reference geopotential with the sea surface height. + ! of the reference geopotential with the sea surface height [nondim]. ! This is typically ~0.09 or less. real :: dgeo_de ! The constant of proportionality between geopotential and - ! sea surface height. It is a nondimensional number of + ! sea surface height [nondim]. It is a nondimensional number of ! order 1. For stability, this may be made larger ! than physical problem would suggest. real :: add_SSH ! An additional contribution to SSH to provide a margin of error ! when calculating the external wave speed [Z ~> m]. - real :: min_max_dt2, Idt_max2, dtbt_max + real :: min_max_dt2 ! The square of the minimum value of the largest stable barotropic + ! timesteps [T2 ~> s2] + real :: dtbt_max ! The maximum barotropic timestep [T ~> s] + real :: Idt_max2 ! The squared inverse of the local maximum stable + ! barotropic time step [T-2 ~> s-2]. logical :: use_BT_cont type(memory_size_type) :: MS @@ -2329,11 +2319,11 @@ subroutine set_dtbt(G, GV, US, CS, eta, pbce, BT_cont, gtot_est, SSH_add) if (present(BT_cont)) use_BT_cont = (associated(BT_cont)) if (use_BT_cont) then - call BT_cont_to_face_areas(BT_cont, Datu, Datv, G, MS, 0, .true.) + call BT_cont_to_face_areas(BT_cont, Datu, Datv, G, US, MS, 0, .true.) elseif (CS%Nonlinear_continuity .and. present(eta)) then - call find_face_areas(Datu, Datv, G, GV, CS, MS, eta=eta, halo=0) + call find_face_areas(Datu, Datv, G, GV, US, CS, MS, eta=eta, halo=0) else - call find_face_areas(Datu, Datv, G, GV, CS, MS, halo=0, add_max=add_SSH) + call find_face_areas(Datu, Datv, G, GV, US, CS, MS, halo=0, add_max=add_SSH) endif det_de = 0.0 @@ -2345,27 +2335,27 @@ subroutine set_dtbt(G, GV, US, CS, eta, pbce, BT_cont, gtot_est, SSH_add) gtot_N(i,j) = 0.0 ; gtot_S(i,j) = 0.0 enddo ; enddo do k=1,nz ; do j=js,je ; do i=is,ie - gtot_E(i,j) = gtot_E(i,j) + US%L_T_to_m_s**2*pbce(i,j,k) * CS%frhatu(I,j,k) - gtot_W(i,j) = gtot_W(i,j) + US%L_T_to_m_s**2*pbce(i,j,k) * CS%frhatu(I-1,j,k) - gtot_N(i,j) = gtot_N(i,j) + US%L_T_to_m_s**2*pbce(i,j,k) * CS%frhatv(i,J,k) - gtot_S(i,j) = gtot_S(i,j) + US%L_T_to_m_s**2*pbce(i,j,k) * CS%frhatv(i,J-1,k) + gtot_E(i,j) = gtot_E(i,j) + pbce(i,j,k) * CS%frhatu(I,j,k) + gtot_W(i,j) = gtot_W(i,j) + pbce(i,j,k) * CS%frhatu(I-1,j,k) + gtot_N(i,j) = gtot_N(i,j) + pbce(i,j,k) * CS%frhatv(i,J,k) + gtot_S(i,j) = gtot_S(i,j) + pbce(i,j,k) * CS%frhatv(i,J-1,k) enddo ; enddo ; enddo else do j=js,je ; do i=is,ie - gtot_E(i,j) = US%L_T_to_m_s**2*gtot_est * GV%H_to_Z ; gtot_W(i,j) = US%L_T_to_m_s**2*gtot_est * GV%H_to_Z - gtot_N(i,j) = US%L_T_to_m_s**2*gtot_est * GV%H_to_Z ; gtot_S(i,j) = US%L_T_to_m_s**2*gtot_est * GV%H_to_Z + gtot_E(i,j) = gtot_est * GV%H_to_Z ; gtot_W(i,j) = gtot_est * GV%H_to_Z + gtot_N(i,j) = gtot_est * GV%H_to_Z ; gtot_S(i,j) = gtot_est * GV%H_to_Z enddo ; enddo endif - min_max_dt2 = 1.0e38 ! A huge number. + min_max_dt2 = 1.0e38*US%s_to_T**2 ! A huge value for the permissible timestep squared. do j=js,je ; do i=is,ie ! This is pretty accurate for gravity waves, but it is a conservative ! estimate since it ignores the stabilizing effect of the bottom drag. - Idt_max2 = 0.5 * (1.0 + 2.0*CS%bebt) * (G%IareaT(i,j) * & - ((gtot_E(i,j)*Datu(I,j)*G%IdxCu(I,j) + gtot_W(i,j)*Datu(I-1,j)*G%IdxCu(I-1,j)) + & - (gtot_N(i,j)*Datv(i,J)*G%IdyCv(i,J) + gtot_S(i,j)*Datv(i,J-1)*G%IdyCv(i,J-1))) + & - US%s_to_T**2*((G%CoriolisBu(I,J)**2 + G%CoriolisBu(I-1,J-1)**2) + & - (G%CoriolisBu(I-1,J)**2 + G%CoriolisBu(I,J-1)**2))) + Idt_max2 = 0.5 * (1.0 + 2.0*CS%bebt) * (US%L_to_m**2*G%IareaT(i,j) * & + ((gtot_E(i,j)*Datu(I,j)*US%L_to_m*G%IdxCu(I,j) + gtot_W(i,j)*Datu(I-1,j)*US%L_to_m*G%IdxCu(I-1,j)) + & + (gtot_N(i,j)*Datv(i,J)*US%L_to_m*G%IdyCv(i,J) + gtot_S(i,j)*Datv(i,J-1)*US%L_to_m*G%IdyCv(i,J-1))) + & + ((G%CoriolisBu(I,J)**2 + G%CoriolisBu(I-1,J-1)**2) + & + (G%CoriolisBu(I-1,J)**2 + G%CoriolisBu(I,J-1)**2))) if (Idt_max2 * min_max_dt2 > 1.0) min_max_dt2 = 1.0 / Idt_max2 enddo ; enddo dtbt_max = sqrt(min_max_dt2 / dgeo_de) @@ -2373,8 +2363,8 @@ subroutine set_dtbt(G, GV, US, CS, eta, pbce, BT_cont, gtot_est, SSH_add) call min_across_PEs(dtbt_max) if (id_clock_sync > 0) call cpu_clock_end(id_clock_sync) - CS%dtbt = CS%dtbt_fraction * dtbt_max - CS%dtbt_max = dtbt_max + CS%dtbt = CS%dtbt_fraction * US%T_to_s * dtbt_max + CS%dtbt_max = US%T_to_s * dtbt_max end subroutine set_dtbt !> The following 4 subroutines apply the open boundary conditions. @@ -2382,7 +2372,7 @@ end subroutine set_dtbt !! velocities and mass transports, as developed by Mehmet Ilicak. subroutine apply_velocity_OBCs(OBC, ubt, vbt, uhbt, vhbt, ubt_trans, vbt_trans, & eta, ubt_old, vbt_old, BT_OBC, & - G, MS, halo, dtbt, bebt, use_BT_cont, Datu, Datv, & + G, MS, US, halo, dtbt, bebt, use_BT_cont, Datu, Datv, & BTCL_u, BTCL_v, uhbt0, vhbt0) type(ocean_OBC_type), pointer :: OBC !< An associated pointer to an OBC type. type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. @@ -2392,7 +2382,7 @@ subroutine apply_velocity_OBCs(OBC, ubt, vbt, uhbt, vhbt, ubt_trans, vbt_trans, real, dimension(SZIBW_(MS),SZJW_(MS)), intent(inout) :: uhbt !< the zonal barotropic transport !! [H m2 s-1 ~> m3 s-1 or kg s-1]. real, dimension(SZIBW_(MS),SZJW_(MS)), intent(inout) :: ubt_trans !< the zonal barotropic velocity used in - !! transport [m s-1]. + !! transport [L T-1 ~> m s-1]. real, dimension(SZIW_(MS),SZJBW_(MS)), intent(inout) :: vbt !< the meridional barotropic velocity [m s-1]. real, dimension(SZIW_(MS),SZJBW_(MS)), intent(inout) :: vhbt !< the meridional barotropic transport !! [H m2 s-1 ~> m3 s-1 or kg s-1]. @@ -2401,22 +2391,23 @@ subroutine apply_velocity_OBCs(OBC, ubt, vbt, uhbt, vhbt, ubt_trans, vbt_trans, real, dimension(SZIW_(MS),SZJW_(MS)), intent(in) :: eta !< The barotropic free surface height anomaly or !! column mass anomaly [H ~> m or kg m-2]. real, dimension(SZIBW_(MS),SZJW_(MS)), intent(in) :: ubt_old !< The starting value of ubt in a barotropic - !! step [m s-1]. + !! step [L T-1 ~> m s-1]. real, dimension(SZIW_(MS),SZJBW_(MS)), intent(in) :: vbt_old !< The starting value of vbt in a barotropic - !! step [m s-1]. + !! step [L T-1 ~> m s-1]. type(BT_OBC_type), intent(in) :: BT_OBC !< A structure with the private barotropic arrays !! related to the open boundary conditions, !! set by set_up_BT_OBC. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type integer, intent(in) :: halo !< The extra halo size to use here. - real, intent(in) :: dtbt !< The time step [s]. + real, intent(in) :: dtbt !< The time step [T ~> s]. real, intent(in) :: bebt !< The fractional weighting of the future velocity !! in determining the transport. logical, intent(in) :: use_BT_cont !< If true, use the BT_cont_types to calculate !! transports. real, dimension(SZIBW_(MS),SZJW_(MS)), intent(in) :: Datu !< A fixed estimate of the face areas at u points - !! [H m ~> m2 or kg m-1]. + !! [H L ~> m2 or kg m-1]. real, dimension(SZIW_(MS),SZJBW_(MS)), intent(in) :: Datv !< A fixed estimate of the face areas at v points - !! [H m ~> m2 or kg m-1]. + !! [H L ~> m2 or kg m-1]. type(local_BT_cont_u_type), dimension(SZIBW_(MS),SZJW_(MS)), intent(in) :: BTCL_u !< Structure of information used !! for a dynamic estimate of the face areas at !! u-points. @@ -2426,21 +2417,21 @@ subroutine apply_velocity_OBCs(OBC, ubt, vbt, uhbt, vhbt, ubt_trans, vbt_trans, real, dimension(SZIBW_(MS),SZJW_(MS)), intent(in) :: uhbt0 !< A correction to the zonal transport so that !! the barotropic functions agree with the sum !! of the layer transports - !! [H m2 s-1 ~> m3 s-1 or kg s-1]. + !! [H L2 T-1 ~> m3 s-1 or kg s-1]. real, dimension(SZIW_(MS),SZJBW_(MS)), intent(in) :: vhbt0 !< A correction to the meridional transport so that !! the barotropic functions agree with the sum !! of the layer transports - !! [H m2 s-1 ~> m3 s-1 or kg s-1]. + !! [H L2 T-1 ~> m3 s-1 or kg s-1]. ! Local variables - real :: vel_prev ! The previous velocity [m s-1]. + real :: vel_prev ! The previous velocity [L T-1 ~> m s-1]. real :: vel_trans ! The combination of the previous and current velocity - ! that does the mass transport [m s-1]. + ! that does the mass transport [L T-1 ~> m s-1]. real :: H_u ! The total thickness at the u-point [H ~> m or kg m-2]. real :: H_v ! The total thickness at the v-point [H ~> m or kg m-2]. real :: cfl ! The CFL number at the point in question [nondim] - real :: u_inlet - real :: v_inlet + real :: u_inlet ! The zonal inflow velocity [L T-1 ~> m s-1] + real :: v_inlet ! The meridional inflow velocity [L T-1 ~> m s-1] real :: h_in real :: cff, Cx, Cy, tau real :: dhdt, dhdx, dhdy @@ -2459,7 +2450,7 @@ subroutine apply_velocity_OBCs(OBC, ubt, vbt, uhbt, vhbt, ubt_trans, vbt_trans, vel_trans = ubt(I,j) elseif (OBC%segment(OBC%segnum_u(I,j))%direction == OBC_DIRECTION_E) then if (OBC%segment(OBC%segnum_u(I,j))%Flather) then - cfl = dtbt * BT_OBC%Cg_u(I,j) * G%IdxCu(I,j) ! CFL + cfl = dtbt * BT_OBC%Cg_u(I,j) * US%L_to_m*G%IdxCu(I,j) ! CFL u_inlet = cfl*ubt_old(I-1,j) + (1.0-cfl)*ubt_old(I,j) ! Valid for cfl<1 h_in = eta(i,j) + (0.5-cfl)*(eta(i,j)-eta(i-1,j)) ! internal H_u = BT_OBC%H_u(I,j) @@ -2473,13 +2464,13 @@ subroutine apply_velocity_OBCs(OBC, ubt, vbt, uhbt, vhbt, ubt_trans, vbt_trans, endif elseif (OBC%segment(OBC%segnum_u(I,j))%direction == OBC_DIRECTION_W) then if (OBC%segment(OBC%segnum_u(I,j))%Flather) then - cfl = dtbt * BT_OBC%Cg_u(I,j) * G%IdxCu(I,j) ! CFL + cfl = dtbt * BT_OBC%Cg_u(I,j) * US%L_to_m*G%IdxCu(I,j) ! CFL u_inlet = cfl*ubt_old(I+1,j) + (1.0-cfl)*ubt_old(I,j) ! Valid for cfl<1 h_in = eta(i+1,j) + (0.5-cfl)*(eta(i+1,j)-eta(i+2,j)) ! external H_u = BT_OBC%H_u(I,j) vel_prev = ubt(I,j) - ubt(I,j) = 0.5*((u_inlet+BT_OBC%ubt_outer(I,j)) + & + ubt(I,j) = 0.5*((u_inlet + BT_OBC%ubt_outer(I,j)) + & (BT_OBC%Cg_u(I,j)/H_u) * (BT_OBC%eta_outer_u(I,j)-h_in)) vel_trans = (1.0-bebt)*vel_prev + bebt*ubt(I,j) @@ -2491,7 +2482,7 @@ subroutine apply_velocity_OBCs(OBC, ubt, vbt, uhbt, vhbt, ubt_trans, vbt_trans, if (.not. OBC%segment(OBC%segnum_u(I,j))%specified) then if (use_BT_cont) then - uhbt(I,j) = find_uhbt(vel_trans,BTCL_u(I,j)) + uhbt0(I,j) + uhbt(I,j) = find_uhbt(vel_trans, BTCL_u(I,j), US) + uhbt0(I,j) else uhbt(I,j) = Datu(I,j)*vel_trans + uhbt0(I,j) endif @@ -2509,13 +2500,13 @@ subroutine apply_velocity_OBCs(OBC, ubt, vbt, uhbt, vhbt, ubt_trans, vbt_trans, vel_trans = vbt(i,J) elseif (OBC%segment(OBC%segnum_v(i,J))%direction == OBC_DIRECTION_N) then if (OBC%segment(OBC%segnum_v(i,J))%Flather) then - cfl = dtbt * BT_OBC%Cg_v(i,J) * G%IdyCv(I,j) ! CFL + cfl = dtbt * BT_OBC%Cg_v(i,J) * US%L_to_m*G%IdyCv(I,j) ! CFL v_inlet = cfl*vbt_old(i,J-1) + (1.0-cfl)*vbt_old(i,J) ! Valid for cfl<1 h_in = eta(i,j) + (0.5-cfl)*(eta(i,j)-eta(i,j-1)) ! internal H_v = BT_OBC%H_v(i,J) vel_prev = vbt(i,J) - vbt(i,J) = 0.5*((v_inlet+BT_OBC%vbt_outer(i,J)) + & + vbt(i,J) = 0.5*((v_inlet + BT_OBC%vbt_outer(i,J)) + & (BT_OBC%Cg_v(i,J)/H_v) * (h_in-BT_OBC%eta_outer_v(i,J))) vel_trans = (1.0-bebt)*vel_prev + bebt*vbt(i,J) @@ -2525,13 +2516,13 @@ subroutine apply_velocity_OBCs(OBC, ubt, vbt, uhbt, vhbt, ubt_trans, vbt_trans, endif elseif (OBC%segment(OBC%segnum_v(i,J))%direction == OBC_DIRECTION_S) then if (OBC%segment(OBC%segnum_v(i,J))%Flather) then - cfl = dtbt * BT_OBC%Cg_v(i,J) * G%IdyCv(I,j) ! CFL + cfl = dtbt * BT_OBC%Cg_v(i,J) * US%L_to_m*G%IdyCv(I,j) ! CFL v_inlet = cfl*vbt_old(i,J+1) + (1.0-cfl)*vbt_old(i,J) ! Valid for cfl <1 h_in = eta(i,j+1) + (0.5-cfl)*(eta(i,j+1)-eta(i,j+2)) ! internal H_v = BT_OBC%H_v(i,J) vel_prev = vbt(i,J) - vbt(i,J) = 0.5*((v_inlet+BT_OBC%vbt_outer(i,J)) + & + vbt(i,J) = 0.5*((v_inlet + BT_OBC%vbt_outer(i,J)) + & (BT_OBC%Cg_v(i,J)/H_v) * (BT_OBC%eta_outer_v(i,J)-h_in)) vel_trans = (1.0-bebt)*vel_prev + bebt*vbt(i,J) @@ -2543,7 +2534,7 @@ subroutine apply_velocity_OBCs(OBC, ubt, vbt, uhbt, vhbt, ubt_trans, vbt_trans, if (.not. OBC%segment(OBC%segnum_v(i,J))%specified) then if (use_BT_cont) then - vhbt(i,J) = find_vhbt(vel_trans,BTCL_v(i,J)) + vhbt0(i,J) + vhbt(i,J) = find_vhbt(vel_trans, BTCL_v(i,J), US) + vhbt0(i,J) else vhbt(i,J) = vel_trans*Datv(i,J) + vhbt0(i,J) endif @@ -2574,9 +2565,9 @@ subroutine set_up_BT_OBC(OBC, eta, BT_OBC, BT_Domain, G, GV, US, MS, halo, use_B logical, intent(in) :: use_BT_cont !< If true, use the BT_cont_types to calculate !! transports. real, dimension(SZIBW_(MS),SZJW_(MS)), intent(in) :: Datu !< A fixed estimate of the face areas at u points - !! [H m ~> m2 or kg m-1]. + !! [L m ~> m2 or kg m-1]. real, dimension(SZIW_(MS),SZJBW_(MS)), intent(in) :: Datv !< A fixed estimate of the face areas at v points - !! [H m ~> m2 or kg m-1]. + !! [L m ~> m2 or kg m-1]. type(local_BT_cont_u_type), dimension(SZIBW_(MS),SZJW_(MS)), intent(in) :: BTCL_u !< Structure of information used !! for a dynamic estimate of the face areas at !! u-points. @@ -2632,7 +2623,7 @@ subroutine set_up_BT_OBC(OBC, eta, BT_OBC, BT_Domain, G, GV, US, MS, halo, use_B BT_OBC%uhbt(I,j) = 0. enddo ; enddo do k=1,nz ; do j=segment%HI%jsd,segment%HI%jed ; do I=segment%HI%IsdB,segment%HI%IedB - BT_OBC%uhbt(I,j) = BT_OBC%uhbt(I,j) + segment%normal_trans(I,j,k) + BT_OBC%uhbt(I,j) = BT_OBC%uhbt(I,j) + US%T_to_s*US%m_to_L**2*segment%normal_trans(I,j,k) enddo ; enddo ; enddo endif enddo @@ -2641,7 +2632,7 @@ subroutine set_up_BT_OBC(OBC, eta, BT_OBC, BT_Domain, G, GV, US, MS, halo, use_B ! Can this go in segment loop above? Is loop above wrong for wide halos?? if (OBC%segment(OBC%segnum_u(I,j))%specified) then if (use_BT_cont) then - BT_OBC%ubt_outer(I,j) = uhbt_to_ubt(BT_OBC%uhbt(I,j),BTCL_u(I,j)) + BT_OBC%ubt_outer(I,j) = uhbt_to_ubt(BT_OBC%uhbt(I,j), BTCL_u(I,j), US) else if (Datu(I,j) > 0.0) BT_OBC%ubt_outer(I,j) = BT_OBC%uhbt(I,j) / Datu(I,j) endif @@ -2659,7 +2650,7 @@ subroutine set_up_BT_OBC(OBC, eta, BT_OBC, BT_Domain, G, GV, US, MS, halo, use_B BT_OBC%H_u(I,j) = eta(i+1,j) endif endif - BT_OBC%Cg_u(I,j) = US%L_T_to_m_s*SQRT(GV%g_prime(1) * GV%H_to_Z*BT_OBC%H_u(i,j)) + BT_OBC%Cg_u(I,j) = SQRT(GV%g_prime(1) * GV%H_to_Z*BT_OBC%H_u(i,j)) endif endif ; enddo ; enddo if (OBC%Flather_u_BCs_exist_globally) then @@ -2667,7 +2658,7 @@ subroutine set_up_BT_OBC(OBC, eta, BT_OBC, BT_Domain, G, GV, US, MS, halo, use_B segment => OBC%segment(n) if (segment%is_E_or_W .and. segment%Flather) then do j=segment%HI%jsd,segment%HI%jed ; do I=segment%HI%IsdB,segment%HI%IedB - BT_OBC%ubt_outer(I,j) = segment%normal_vel_bt(I,j) + BT_OBC%ubt_outer(I,j) = US%m_s_to_L_T*segment%normal_vel_bt(I,j) BT_OBC%eta_outer_u(I,j) = segment%eta(I,j) enddo ; enddo endif @@ -2684,7 +2675,7 @@ subroutine set_up_BT_OBC(OBC, eta, BT_OBC, BT_Domain, G, GV, US, MS, halo, use_B BT_OBC%vhbt(i,J) = 0. enddo ; enddo do k=1,nz ; do J=segment%HI%JsdB,segment%HI%JedB ; do i=segment%HI%isd,segment%HI%ied - BT_OBC%vhbt(i,J) = BT_OBC%vhbt(i,J) + segment%normal_trans(i,J,k) + BT_OBC%vhbt(i,J) = BT_OBC%vhbt(i,J) + US%T_to_s*US%m_to_L**2*segment%normal_trans(i,J,k) enddo ; enddo ; enddo endif enddo @@ -2693,7 +2684,7 @@ subroutine set_up_BT_OBC(OBC, eta, BT_OBC, BT_Domain, G, GV, US, MS, halo, use_B ! Can this go in segment loop above? Is loop above wrong for wide halos?? if (OBC%segment(OBC%segnum_v(i,J))%specified) then if (use_BT_cont) then - BT_OBC%vbt_outer(i,J) = vhbt_to_vbt(BT_OBC%vhbt(i,J),BTCL_v(i,J)) + BT_OBC%vbt_outer(i,J) = vhbt_to_vbt(BT_OBC%vhbt(i,J), BTCL_v(i,J), US) else if (Datv(i,J) > 0.0) BT_OBC%vbt_outer(i,J) = BT_OBC%vhbt(i,J) / Datv(i,J) endif @@ -2711,7 +2702,7 @@ subroutine set_up_BT_OBC(OBC, eta, BT_OBC, BT_Domain, G, GV, US, MS, halo, use_B BT_OBC%H_v(i,J) = eta(i,j+1) endif endif - BT_OBC%Cg_v(i,J) = US%L_T_to_m_s*SQRT(GV%g_prime(1) * GV%H_to_Z*BT_OBC%H_v(i,J)) + BT_OBC%Cg_v(i,J) = SQRT(GV%g_prime(1) * GV%H_to_Z*BT_OBC%H_v(i,J)) endif endif ; enddo ; enddo if (OBC%Flather_v_BCs_exist_globally) then @@ -2719,7 +2710,7 @@ subroutine set_up_BT_OBC(OBC, eta, BT_OBC, BT_Domain, G, GV, US, MS, halo, use_B segment => OBC%segment(n) if (segment%is_N_or_S .and. segment%Flather) then do J=segment%HI%JsdB,segment%HI%JedB ; do i=segment%HI%isd,segment%HI%ied - BT_OBC%vbt_outer(i,J) = segment%normal_vel_bt(i,J) + BT_OBC%vbt_outer(i,J) = US%m_s_to_L_T*segment%normal_vel_bt(i,J) BT_OBC%eta_outer_v(i,J) = segment%eta(i,J) enddo ; enddo endif @@ -3031,13 +3022,14 @@ subroutine btcalc(h, G, GV, CS, h_u, h_v, may_use_default, OBC) end subroutine btcalc !> The function find_uhbt determines the zonal transport for a given velocity. -function find_uhbt(u, BTC) result(uhbt) - real, intent(in) :: u !< The local zonal velocity [m s-1] +function find_uhbt(u, BTC, US) result(uhbt) + real, intent(in) :: u !< The local zonal velocity [L T-1 ~> m s-1] type(local_BT_cont_u_type), intent(in) :: BTC !< A structure containing various fields that !! allow the barotropic transports to be calculated consistently !! with the layers' continuity equations. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - real :: uhbt !< The result + real :: uhbt !< The zonal barotropic transport [L2 H T-1 ~> m3 s-1] if (u == 0.0) then uhbt = 0.0 @@ -3050,25 +3042,28 @@ function find_uhbt(u, BTC) result(uhbt) else ! (u > BTC%uBT_WW) uhbt = (u - BTC%uBT_WW) * BTC%FA_u_WW + BTC%uh_WW endif + end function find_uhbt !> This function inverts the transport function to determine the barotopic !! velocity that is consistent with a given transport. -function uhbt_to_ubt(uhbt, BTC, guess) result(ubt) +function uhbt_to_ubt(uhbt, BTC, US, guess) result(ubt) real, intent(in) :: uhbt !< The barotropic zonal transport that should be inverted for, - !! [H m2 s-1 ~> m3 s-1 or kg s-1]. + !! [H L2 T-1 ~> m3 s-1 or kg s-1]. type(local_BT_cont_u_type), intent(in) :: BTC !< A structure containing various fields that allow the !! barotropic transports to be calculated consistently with the !! layers' continuity equations. - real, optional, intent(in) :: guess !< A guess at what ubt will be. The result is not allowed - !! to be dramatically larger than guess. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + real, optional, intent(in) :: guess !< A guess at what ubt will be [L T-1 ~> m s-1]. The result + !! is not allowed to be dramatically larger than guess. real :: ubt !< The result - The velocity that gives uhbt transport [m s-1]. ! Local variables real :: ubt_min, ubt_max, uhbt_err, derr_du real :: uherr_min, uherr_max - real, parameter :: tol = 1.0e-10 - real :: dvel, vsr ! Temporary variables used in the limiting the velocity. + real, parameter :: tol = 1.0e-10 ! A fractional match tolerance [nondim] + real :: dvel ! Temporary variable used in the limiting the velocity [L T-1 ~> m s-1]. + real :: vsr ! Temporary variable used in the limiting the velocity [nondim]. real, parameter :: vs1 = 1.25 ! Nondimensional parameters used in limiting real, parameter :: vs2 = 2.0 ! the velocity, starting at vs1, with the ! maximum increase of vs2, both nondim. @@ -3145,12 +3140,13 @@ function uhbt_to_ubt(uhbt, BTC, guess) result(ubt) end function uhbt_to_ubt !> The function find_vhbt determines the meridional transport for a given velocity. -function find_vhbt(v, BTC) result(vhbt) - real, intent(in) :: v !< The local meridional velocity [m s-1] +function find_vhbt(v, BTC, US) result(vhbt) + real, intent(in) :: v !< The local meridional velocity [L T-1 ~> m s-1] type(local_BT_cont_v_type), intent(in) :: BTC !< A structure containing various fields that !! allow the barotropic transports to be calculated consistently !! with the layers' continuity equations. - real :: vhbt !< The result + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + real :: vhbt !< The meridional barotropic transport [L2 H T-1 ~> m3 s-1] if (v == 0.0) then vhbt = 0.0 @@ -3163,25 +3159,28 @@ function find_vhbt(v, BTC) result(vhbt) else ! (v > BTC%vBT_SS) vhbt = (v - BTC%vBT_SS) * BTC%FA_v_SS + BTC%vh_SS endif + end function find_vhbt !> This function inverts the transport function to determine the barotopic !! velocity that is consistent with a given transport. -function vhbt_to_vbt(vhbt, BTC, guess) result(vbt) +function vhbt_to_vbt(vhbt, BTC, US, guess) result(vbt) real, intent(in) :: vhbt !< The barotropic meridional transport that should be - !! inverted for [H m2 s-1 ~> m3 s-1 or kg s-1]. + !! inverted for [H L2 T-1 ~> m3 s-1 or kg s-1]. type(local_BT_cont_v_type), intent(in) :: BTC !< A structure containing various fields that allow the !! barotropic transports to be calculated consistently !! with the layers' continuity equations. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, optional, intent(in) :: guess !< A guess at what vbt will be. The result is not allowed - !! to be dramatically larger than guess. - real :: vbt !< The result - The velocity that gives vhbt transport [m s-1]. + !! to be dramatically larger than guess [L T-1 ~> m s-1]. + real :: vbt !< The result - The velocity that gives vhbt transport [L T-1 ~> m s-1]. ! Local variables real :: vbt_min, vbt_max, vhbt_err, derr_dv real :: vherr_min, vherr_max - real, parameter :: tol = 1.0e-10 - real :: dvel, vsr ! Temporary variables used in the limiting the velocity. + real, parameter :: tol = 1.0e-10 ! A fractional match tolerance [nondim] + real :: dvel ! Temporary variable used in the limiting the velocity [L T-1 ~> m s-1]. + real :: vsr ! Temporary variable used in the limiting the velocity [nondim]. real, parameter :: vs1 = 1.25 ! Nondimensional parameters used in limiting real, parameter :: vs2 = 2.0 ! the velocity, starting at vs1, with the ! maximum increase of vs2, both nondim. @@ -3259,7 +3258,7 @@ end function vhbt_to_vbt !> This subroutine sets up reordered versions of the BT_cont type in the !! local_BT_cont types, which have wide halos properly filled in. -subroutine set_local_BT_cont_types(BT_cont, BTCL_u, BTCL_v, G, MS, BT_Domain, halo) +subroutine set_local_BT_cont_types(BT_cont, BTCL_u, BTCL_v, G, US, MS, BT_Domain, halo) type(BT_cont_type), intent(inout) :: BT_cont !< The BT_cont_type input to the !! barotropic solver. type(memory_size_type), intent(in) :: MS !< A type that describes the @@ -3270,6 +3269,7 @@ subroutine set_local_BT_cont_types(BT_cont, BTCL_u, BTCL_v, G, MS, BT_Domain, ha type(local_BT_cont_v_type), dimension(SZIW_(MS),SZJBW_(MS)), intent(out) :: BTCL_v !< A structure with the v !! information from BT_cont. type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(MOM_domain_type), intent(inout) :: BT_Domain !< The domain to use for updating !! the halos of wide arrays. integer, optional, intent(in) :: halo !< The extra halo size to use here. @@ -3302,15 +3302,15 @@ subroutine set_local_BT_cont_types(BT_cont, BTCL_u, BTCL_v, G, MS, BT_Domain, ha enddo ; enddo !$OMP do do j=js,je; do I=is-1,ie - uBT_EE(I,j) = BT_cont%uBT_EE(I,j) ; uBT_WW(I,j) = BT_cont%uBT_WW(I,j) - FA_u_EE(I,j) = BT_cont%FA_u_EE(I,j) ; FA_u_E0(I,j) = BT_cont%FA_u_E0(I,j) - FA_u_W0(I,j) = BT_cont%FA_u_W0(I,j) ; FA_u_WW(I,j) = BT_cont%FA_u_WW(I,j) + uBT_EE(I,j) = US%m_s_to_L_T*BT_cont%uBT_EE(I,j) ; uBT_WW(I,j) = US%m_s_to_L_T*BT_cont%uBT_WW(I,j) + FA_u_EE(I,j) = US%m_to_L*BT_cont%FA_u_EE(I,j) ; FA_u_E0(I,j) = US%m_to_L*BT_cont%FA_u_E0(I,j) + FA_u_W0(I,j) = US%m_to_L*BT_cont%FA_u_W0(I,j) ; FA_u_WW(I,j) = US%m_to_L*BT_cont%FA_u_WW(I,j) enddo ; enddo !$OMP do do J=js-1,je; do i=is,ie - vBT_NN(i,J) = BT_cont%vBT_NN(i,J) ; vBT_SS(i,J) = BT_cont%vBT_SS(i,J) - FA_v_NN(i,J) = BT_cont%FA_v_NN(i,J) ; FA_v_N0(i,J) = BT_cont%FA_v_N0(i,J) - FA_v_S0(i,J) = BT_cont%FA_v_S0(i,J) ; FA_v_SS(i,J) = BT_cont%FA_v_SS(i,J) + vBT_NN(i,J) = US%m_s_to_L_T*BT_cont%vBT_NN(i,J) ; vBT_SS(i,J) = US%m_s_to_L_T*BT_cont%vBT_SS(i,J) + FA_v_NN(i,J) = US%m_to_L*BT_cont%FA_v_NN(i,J) ; FA_v_N0(i,J) = US%m_to_L*BT_cont%FA_v_N0(i,J) + FA_v_S0(i,J) = US%m_to_L*BT_cont%FA_v_S0(i,J) ; FA_v_SS(i,J) = US%m_to_L*BT_cont%FA_v_SS(i,J) enddo ; enddo !$OMP end parallel @@ -3389,7 +3389,7 @@ end subroutine set_local_BT_cont_types !> Adjust_local_BT_cont_types sets up reordered versions of the BT_cont type !! in the local_BT_cont types, which have wide halos properly filled in. subroutine adjust_local_BT_cont_types(ubt, uhbt, vbt, vhbt, BTCL_u, BTCL_v, & - G, MS, halo) + G, US, MS, halo) type(memory_size_type), intent(in) :: MS !< A type that describes the memory sizes of the argument arrays. real, dimension(SZIBW_(MS),SZJW_(MS)), & intent(in) :: ubt !< The linearization zonal barotropic velocity [m s-1]. @@ -3406,6 +3406,7 @@ subroutine adjust_local_BT_cont_types(ubt, uhbt, vbt, vhbt, BTCL_u, BTCL_v, & type(local_BT_cont_v_type), dimension(SZIW_(MS),SZJBW_(MS)), & intent(out) :: BTCL_v !< A structure with the v information from BT_cont. type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type integer, optional, intent(in) :: halo !< The extra halo size to use here. ! Local variables @@ -3451,26 +3452,26 @@ subroutine adjust_local_BT_cont_types(ubt, uhbt, vbt, vhbt, BTCL_u, BTCL_v, & !$OMP parallel do default(shared) do J=js-hs-1,je+hs ; do i=is-hs,ie+hs if ((vbt(i,J) > BTCL_v(i,J)%vBT_SS) .and. (vhbt(i,J) > BTCL_v(i,J)%vh_SS)) then - ! Nxpand the cubic fit to use this new point. vbt is negative. + ! Expand the cubic fit to use this new point. vbt is negative. BTCL_v(i,J)%vbt_SS = vbt(i,J) if (3.0*vhbt(i,J) < 2.0*vbt(i,J) * BTCL_v(i,J)%FA_v_S0) then - ! No fvrther bovnding is needed. + ! No further bounding is needed. BTCL_v(i,J)%vh_crvS = (vhbt(i,J) - vbt(i,J) * BTCL_v(i,J)%FA_v_S0) / vbt(i,J)**3 - else ! This shovld not happen often! - BTCL_v(i,J)%FA_v_S0 = 1.5*vhbt(i,J) / vbt(i,J) + else ! This should not happen often! + BTCL_v(i,J)%FA_v_S0 = 1.5*vhbt(i,J) / (vbt(i,J)) BTCL_v(i,J)%vh_crvS = -0.5*vhbt(i,J) / vbt(i,J)**3 endif BTCL_v(i,J)%vh_SS = vhbt(i,J) ! I don't know whether this is helpful. ! BTCL_v(i,J)%FA_v_SS = min(BTCL_v(i,J)%FA_v_SS, vhbt(i,J) / vbt(i,J)) elseif ((vbt(i,J) < BTCL_v(i,J)%vBT_NN) .and. (vhbt(i,J) < BTCL_v(i,J)%vh_NN)) then - ! Nxpand the cubic fit to use this new point. vbt is negative. + ! Expand the cubic fit to use this new point. vbt is negative. BTCL_v(i,J)%vbt_NN = vbt(i,J) if (3.0*vhbt(i,J) < 2.0*vbt(i,J) * BTCL_v(i,J)%FA_v_N0) then - ! No fvrther bovnding is needed. + ! No further bounding is needed. BTCL_v(i,J)%vh_crvN = (vhbt(i,J) - vbt(i,J) * BTCL_v(i,J)%FA_v_N0) / vbt(i,J)**3 - else ! This shovld not happen often! - BTCL_v(i,J)%FA_v_N0 = 1.5*vhbt(i,J) / vbt(i,J) + else ! This should not happen often! + BTCL_v(i,J)%FA_v_N0 = 1.5*vhbt(i,J) / (vbt(i,J)) BTCL_v(i,J)%vh_crvN = -0.5*vhbt(i,J) / vbt(i,J)**3 endif BTCL_v(i,J)%vh_NN = vhbt(i,J) @@ -3483,16 +3484,17 @@ end subroutine adjust_local_BT_cont_types !> This subroutine uses the BTCL types to find typical or maximum face !! areas, which can then be used for finding wave speeds, etc. -subroutine BT_cont_to_face_areas(BT_cont, Datu, Datv, G, MS, halo, maximize) +subroutine BT_cont_to_face_areas(BT_cont, Datu, Datv, G, US, MS, halo, maximize) type(BT_cont_type), intent(inout) :: BT_cont !< The BT_cont_type input to the !! barotropic solver. type(memory_size_type), intent(in) :: MS !< A type that describes the memory !! sizes of the argument arrays. real, dimension(MS%isdw-1:MS%iedw,MS%jsdw:MS%jedw), & - intent(out) :: Datu !< The effective zonal face area [H m ~> m2 or kg m-1]. + intent(out) :: Datu !< The effective zonal face area [H L ~> m2 or kg m-1]. real, dimension(MS%isdw:MS%iedw,MS%jsdw-1:MS%jedw), & - intent(out) :: Datv !< The effective meridional face area [H m ~> m2 or kg m-1]. + intent(out) :: Datv !< The effective meridional face area [H L ~> m2 or kg m-1]. type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type integer, optional, intent(in) :: halo !< The extra halo size to use here. logical, optional, intent(in) :: maximize !< If present and true, find the !! maximum face area for any velocity. @@ -3534,14 +3536,15 @@ end subroutine swap !> This subroutine determines the open face areas of cells for calculating !! the barotropic transport. -subroutine find_face_areas(Datu, Datv, G, GV, CS, MS, eta, halo, add_max) +subroutine find_face_areas(Datu, Datv, G, GV, US, CS, MS, eta, halo, add_max) type(memory_size_type), intent(in) :: MS !< A type that describes the memory sizes of the argument arrays. real, dimension(MS%isdw-1:MS%iedw,MS%jsdw:MS%jedw), & - intent(out) :: Datu !< The open zonal face area [H m ~> m2 or kg m-1]. + intent(out) :: Datu !< The open zonal face area [H L ~> m2 or kg m-1]. real, dimension(MS%isdw:MS%iedw,MS%jsdw-1:MS%jedw), & - intent(out) :: Datv !< The open meridional face area [H m ~> m2 or kg m-1]. + intent(out) :: Datv !< The open meridional face area [H L ~> m2 or kg m-1]. 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 type(barotropic_CS), pointer :: CS !< The control structure returned by a previous !! call to barotropic_init. real, dimension(MS%isdw:MS%iedw,MS%jsdw:MS%jedw), & @@ -3728,8 +3731,8 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, US, param_file, diag, CS, #include "version_variable.h" ! Local variables character(len=40) :: mdl = "MOM_barotropic" ! This module's name. - real :: Datu(SZIBS_(G),SZJ_(G)) ! Zonal open face area [H m ~> m2 or kg m-1]. - real :: Datv(SZI_(G),SZJBS_(G)) ! Meridional open face area [H m ~> m2 or kg m-1]. + real :: Datu(SZIBS_(G),SZJ_(G)) ! Zonal open face area [H L ~> m2 or kg m-1]. + real :: Datv(SZI_(G),SZJBS_(G)) ! Meridional open face area [H L ~> m2 or kg m-1]. real :: gtot_estimate ! Summed GV%g_prime [L2 Z-1 T-2 ~> m s-2], to give an upper-bound estimate for pbce. real :: SSH_extra ! An estimate of how much higher SSH might get, for use ! in calculating the safe external wave speed [Z ~> m]. @@ -3741,8 +3744,10 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, US, param_file, diag, CS, ! drag piston velocity. character(len=80) :: wave_drag_var ! The wave drag piston velocity variable ! name in wave_drag_file. - real :: uH_rescale ! A rescaling factor for thickness transports from the representation in - ! a restart file to the internal representation in this run. + real :: vel_rescale ! A rescaling factor for horizontal velocity from the representation in + ! a restart file to the internal representation in this run. + real :: uH_rescale ! A rescaling factor for thickness transports from the representation in + ! a restart file to the internal representation in this run. real, allocatable, dimension(:,:) :: lin_drag_h type(memory_size_type) :: MS type(group_pass_type) :: pass_static_data, pass_q_D_Cor @@ -3862,7 +3867,7 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, US, param_file, diag, CS, "The length scale at which the Rayleigh damping rate due "//& "to the ice strength should be the same as if a Laplacian "//& "were applied, if DYNAMIC_SURFACE_PRESSURE is true.", & - units="m", default=1.0e4) + units="m", default=1.0e4, scale=US%m_to_L) call get_param(param_file, mdl, "DEPTH_MIN_DYN_PSURF", CS%Dmin_dyn_psurf, & "The minimum depth to use in limiting the size of the "//& "dynamic surface pressure for stability, if "//& @@ -3943,7 +3948,7 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, US, param_file, diag, CS, units="nondim", default=0.5, do_not_log=.not.CS%clip_velocity) call get_param(param_file, mdl, "MAXVEL", CS%maxvel, & "The maximum velocity allowed before the velocity "//& - "components are truncated.", units="m s-1", default=3.0e8, & + "components are truncated.", units="m s-1", default=3.0e8, scale=US%m_s_to_L_T, & do_not_log=.not.CS%clip_velocity) call get_param(param_file, mdl, "MAXCFL_BT_CONT", CS%maxCFL_BT_cont, & "The maximum permitted CFL number associated with the "//& @@ -3954,7 +3959,7 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, US, param_file, diag, CS, "A negligibly small velocity magnitude below which velocity "//& "components are set to 0. A reasonable value might be "//& "1e-30 m/s, which is less than an Angstrom divided by "//& - "the age of the universe.", units="m s-1", default=0.0) + "the age of the universe.", units="m s-1", default=0.0, scale=US%m_s_to_L_T) call get_param(param_file, mdl, "DT_BT_FILTER", CS%dt_bt_filter, & "A time-scale over which the barotropic mode solutions "//& @@ -3962,6 +3967,7 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, US, param_file, diag, CS, "of DT if negative. When used this can never be taken to "//& "be longer than 2*dt. Set this to 0 to apply no filtering.", & units="sec or nondim", default=-0.25) + if (CS%dt_bt_filter > 0.0) CS%dt_bt_filter = US%s_to_T*CS%dt_bt_filter call get_param(param_file, mdl, "G_BT_EXTRA", CS%G_extra, & "A nondimensional factor by which gtot is enhanced.", & units="nondim", default=0.0) @@ -4073,24 +4079,22 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, US, param_file, diag, CS, ALLOC_(CS%dy_Cu(CS%isdw-1:CS%iedw,CS%jsdw:CS%jedw)) ; CS%dy_Cu(:,:) = 0.0 ALLOC_(CS%dx_Cv(CS%isdw:CS%iedw,CS%jsdw-1:CS%jedw)) ; CS%dx_Cv(:,:) = 0.0 do j=G%jsd,G%jed ; do i=G%isd,G%ied - CS%IareaT(i,j) = G%IareaT(i,j) + CS%IareaT(i,j) = US%L_to_m**2*G%IareaT(i,j) CS%bathyT(i,j) = G%bathyT(i,j) enddo ; enddo - ! Note: G%IdxCu & G%IdyCv may be smaller than CS%IdxCu & CS%IdyCv, even without + ! Note: G%IdxCu & G%IdyCv may be valid for a smaller extent than CS%IdxCu & CS%IdyCv, even without ! wide halos. do j=G%jsd,G%jed ; do I=G%IsdB,G%IedB - CS%IdxCu(I,j) = G%IdxCu(I,j) ; CS%dy_Cu(I,j) = G%dy_Cu(I,j) + CS%IdxCu(I,j) = US%L_to_m*G%IdxCu(I,j) ; CS%dy_Cu(I,j) = US%m_to_L*G%dy_Cu(I,j) enddo ; enddo do J=G%JsdB,G%JedB ; do i=G%isd,G%ied - CS%IdyCv(I,j) = G%IdyCv(I,j) ; CS%dx_Cv(i,J) = G%dx_Cv(i,J) + CS%IdyCv(I,j) = US%L_to_m*G%IdyCv(I,j) ; CS%dx_Cv(i,J) = US%m_to_L*G%dx_Cv(i,J) enddo ; enddo call create_group_pass(pass_static_data, CS%IareaT, CS%BT_domain, To_All) call create_group_pass(pass_static_data, CS%bathyT, CS%BT_domain, To_All) - call create_group_pass(pass_static_data, CS%IdxCu, CS%IdyCv, CS%BT_domain, & - To_All+Scalar_Pair) - call create_group_pass(pass_static_data, CS%dy_Cu, CS%dx_Cv, CS%BT_domain, & - To_All+Scalar_Pair) + call create_group_pass(pass_static_data, CS%IdxCu, CS%IdyCv, CS%BT_domain, To_All+Scalar_Pair) + call create_group_pass(pass_static_data, CS%dy_Cu, CS%dx_Cv, CS%BT_domain, To_All+Scalar_Pair) call do_group_pass(pass_static_data, CS%BT_domain) if (CS%linearized_BT_PV) then @@ -4106,7 +4110,7 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, US, param_file, diag, CS, enddo ; enddo do J=js-1,je ; do I=is-1,ie if (G%mask2dT(i,j)+G%mask2dT(i,j+1)+G%mask2dT(i+1,j)+G%mask2dT(i+1,j+1)>0.) then - CS%q_D(I,J) = 0.25 * US%s_to_T*G%CoriolisBu(I,J) * & + CS%q_D(I,J) = 0.25 * G%CoriolisBu(I,J) * & ((G%areaT(i,j) + G%areaT(i+1,j+1)) + (G%areaT(i+1,j) + G%areaT(i,j+1))) / & ((G%areaT(i,j) * G%bathyT(i,j) + G%areaT(i+1,j+1) * G%bathyT(i+1,j+1)) + & (G%areaT(i+1,j) * G%bathyT(i+1,j) + G%areaT(i,j+1) * G%bathyT(i,j+1)) ) @@ -4131,16 +4135,16 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, US, param_file, diag, CS, wave_drag_file = trim(slasher(inputdir))//trim(wave_drag_file) call log_param(param_file, mdl, "INPUTDIR/BT_WAVE_DRAG_FILE", wave_drag_file) - allocate(lin_drag_h(isd:ied,jsd:jed)) ; CS%lin_drag_u(:,:) = 0.0 + allocate(lin_drag_h(isd:ied,jsd:jed)) ; lin_drag_h(:,:) = 0.0 - call MOM_read_data(wave_drag_file, wave_drag_var, lin_drag_h, G%Domain) + call MOM_read_data(wave_drag_file, wave_drag_var, lin_drag_h, G%Domain, scale=US%m_to_Z*US%T_to_s) call pass_var(lin_drag_h, G%Domain) do j=js,je ; do I=is-1,ie - CS%lin_drag_u(I,j) = (GV%m_to_H * wave_drag_scale) * & + CS%lin_drag_u(I,j) = (GV%Z_to_H * wave_drag_scale) * & 0.5 * (lin_drag_h(i,j) + lin_drag_h(i+1,j)) enddo ; enddo do J=js-1,je ; do i=is,ie - CS%lin_drag_v(i,J) = (GV%m_to_H * wave_drag_scale) * & + CS%lin_drag_v(i,J) = (GV%Z_to_H * wave_drag_scale) * & 0.5 * (lin_drag_h(i,j) + lin_drag_h(i,j+1)) enddo ; enddo deallocate(lin_drag_h) @@ -4177,38 +4181,38 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, US, param_file, diag, CS, endif CS%id_PFu_bt = register_diag_field('ocean_model', 'PFuBT', diag%axesCu1, Time, & - 'Zonal Anomalous Barotropic Pressure Force Force Acceleration', 'm s-2') + 'Zonal Anomalous Barotropic Pressure Force Force Acceleration', 'm s-2', conversion=US%L_T2_to_m_s2) CS%id_PFv_bt = register_diag_field('ocean_model', 'PFvBT', diag%axesCv1, Time, & - 'Meridional Anomalous Barotropic Pressure Force Acceleration', 'm s-2') + 'Meridional Anomalous Barotropic Pressure Force Acceleration', 'm s-2', conversion=US%L_T2_to_m_s2) CS%id_Coru_bt = register_diag_field('ocean_model', 'CoruBT', diag%axesCu1, Time, & - 'Zonal Barotropic Coriolis Acceleration', 'm s-2') + 'Zonal Barotropic Coriolis Acceleration', 'm s-2', conversion=US%L_T2_to_m_s2) CS%id_Corv_bt = register_diag_field('ocean_model', 'CorvBT', diag%axesCv1, Time, & - 'Meridional Barotropic Coriolis Acceleration', 'm s-2') + 'Meridional Barotropic Coriolis Acceleration', 'm s-2', conversion=US%L_T2_to_m_s2) CS%id_uaccel = register_diag_field('ocean_model', 'u_accel_bt', diag%axesCu1, Time, & - 'Barotropic zonal acceleration', 'm s-2') + 'Barotropic zonal acceleration', 'm s-2', conversion=US%L_T2_to_m_s2) CS%id_vaccel = register_diag_field('ocean_model', 'v_accel_bt', diag%axesCv1, Time, & - 'Barotropic meridional acceleration', 'm s-2') + 'Barotropic meridional acceleration', 'm s-2', conversion=US%L_T2_to_m_s2) CS%id_ubtforce = register_diag_field('ocean_model', 'ubtforce', diag%axesCu1, Time, & - 'Barotropic zonal acceleration from baroclinic terms', 'm s-2') + 'Barotropic zonal acceleration from baroclinic terms', 'm s-2', conversion=US%L_T2_to_m_s2) CS%id_vbtforce = register_diag_field('ocean_model', 'vbtforce', diag%axesCv1, Time, & - 'Barotropic meridional acceleration from baroclinic terms', 'm s-2') + 'Barotropic meridional acceleration from baroclinic terms', 'm s-2', conversion=US%L_T2_to_m_s2) CS%id_eta_bt = register_diag_field('ocean_model', 'eta_bt', diag%axesT1, Time, & 'Barotropic end SSH', thickness_units) CS%id_ubt = register_diag_field('ocean_model', 'ubt', diag%axesCu1, Time, & - 'Barotropic end zonal velocity', 'm s-1') + 'Barotropic end zonal velocity', 'm s-1', conversion=US%L_T_to_m_s) CS%id_vbt = register_diag_field('ocean_model', 'vbt', diag%axesCv1, Time, & - 'Barotropic end meridional velocity', 'm s-1') + 'Barotropic end meridional velocity', 'm s-1', conversion=US%L_T_to_m_s) CS%id_eta_st = register_diag_field('ocean_model', 'eta_st', diag%axesT1, Time, & 'Barotropic start SSH', thickness_units) CS%id_ubt_st = register_diag_field('ocean_model', 'ubt_st', diag%axesCu1, Time, & - 'Barotropic start zonal velocity', 'm s-1') + 'Barotropic start zonal velocity', 'm s-1', conversion=US%L_T_to_m_s) CS%id_vbt_st = register_diag_field('ocean_model', 'vbt_st', diag%axesCv1, Time, & - 'Barotropic start meridional velocity', 'm s-1') + 'Barotropic start meridional velocity', 'm s-1', conversion=US%L_T_to_m_s) CS%id_ubtav = register_diag_field('ocean_model', 'ubtav', diag%axesCu1, Time, & - 'Barotropic time-average zonal velocity', 'm s-1') + 'Barotropic time-average zonal velocity', 'm s-1') !(, conversion=US%L_T_to_m_s) CS%id_vbtav = register_diag_field('ocean_model', 'vbtav', diag%axesCv1, Time, & - 'Barotropic time-average meridional velocity', 'm s-1') + 'Barotropic time-average meridional velocity', 'm s-1') !(, conversion=US%L_T_to_m_s) CS%id_eta_cor = register_diag_field('ocean_model', 'eta_cor', diag%axesT1, Time, & 'Corrective mass flux', 'm s-1') CS%id_visc_rem_u = register_diag_field('ocean_model', 'visc_rem_u', diag%axesCuL, Time, & @@ -4216,19 +4220,19 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, US, param_file, diag, CS, CS%id_visc_rem_v = register_diag_field('ocean_model', 'visc_rem_v', diag%axesCvL, Time, & 'Viscous remnant at v', 'nondim') CS%id_gtotn = register_diag_field('ocean_model', 'gtot_n', diag%axesT1, Time, & - 'gtot to North', 'm s-2') + 'gtot to North', 'm s-2', conversion=US%L_T_to_m_s**2) CS%id_gtots = register_diag_field('ocean_model', 'gtot_s', diag%axesT1, Time, & - 'gtot to South', 'm s-2') + 'gtot to South', 'm s-2', conversion=US%L_T_to_m_s**2) CS%id_gtote = register_diag_field('ocean_model', 'gtot_e', diag%axesT1, Time, & - 'gtot to East', 'm s-2') + 'gtot to East', 'm s-2', conversion=US%L_T_to_m_s**2) CS%id_gtotw = register_diag_field('ocean_model', 'gtot_w', diag%axesT1, Time, & - 'gtot to West', 'm s-2') + 'gtot to West', 'm s-2', conversion=US%L_T_to_m_s**2) CS%id_eta_hifreq = register_diag_field('ocean_model', 'eta_hifreq', diag%axesT1, Time, & 'High Frequency Barotropic SSH', thickness_units) CS%id_ubt_hifreq = register_diag_field('ocean_model', 'ubt_hifreq', diag%axesCu1, Time, & - 'High Frequency Barotropic zonal velocity', 'm s-1') + 'High Frequency Barotropic zonal velocity', 'm s-1', conversion=US%L_T_to_m_s) CS%id_vbt_hifreq = register_diag_field('ocean_model', 'vbt_hifreq', diag%axesCv1, Time, & - 'High Frequency Barotropic meridional velocity', 'm s-1') + 'High Frequency Barotropic meridional velocity', 'm s-1', conversion=US%L_T_to_m_s) CS%id_eta_pred_hifreq = register_diag_field('ocean_model', 'eta_pred_hifreq', diag%axesT1, Time, & 'High Frequency Predictor Barotropic SSH', thickness_units) CS%id_uhbt_hifreq = register_diag_field('ocean_model', 'uhbt_hifreq', diag%axesCu1, Time, & @@ -4250,34 +4254,34 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, US, param_file, diag, CS, if (use_BT_cont_type) then CS%id_BTC_FA_u_EE = register_diag_field('ocean_model', 'BTC_FA_u_EE', diag%axesCu1, Time, & - 'BTCont type far east face area', 'm2') + 'BTCont type far east face area', 'm2') !(, conversion=US%L_to_m*GV%H_to_m) CS%id_BTC_FA_u_E0 = register_diag_field('ocean_model', 'BTC_FA_u_E0', diag%axesCu1, Time, & - 'BTCont type near east face area', 'm2') + 'BTCont type near east face area', 'm2') !(, conversion=US%L_to_m*GV%H_to_m) CS%id_BTC_FA_u_WW = register_diag_field('ocean_model', 'BTC_FA_u_WW', diag%axesCu1, Time, & - 'BTCont type far west face area', 'm2') + 'BTCont type far west face area', 'm2') !(, conversion=US%L_to_m*GV%H_to_m) CS%id_BTC_FA_u_W0 = register_diag_field('ocean_model', 'BTC_FA_u_W0', diag%axesCu1, Time, & - 'BTCont type near west face area', 'm2') + 'BTCont type near west face area', 'm2') !(, conversion=US%L_to_m*GV%H_to_m) CS%id_BTC_ubt_EE = register_diag_field('ocean_model', 'BTC_ubt_EE', diag%axesCu1, Time, & 'BTCont type far east velocity', 'm s-1') CS%id_BTC_ubt_WW = register_diag_field('ocean_model', 'BTC_ubt_WW', diag%axesCu1, Time, & 'BTCont type far west velocity', 'm s-1') CS%id_BTC_FA_v_NN = register_diag_field('ocean_model', 'BTC_FA_v_NN', diag%axesCv1, Time, & - 'BTCont type far north face area', 'm2') + 'BTCont type far north face area', 'm2') !(, conversion=US%L_to_m*GV%H_to_m) CS%id_BTC_FA_v_N0 = register_diag_field('ocean_model', 'BTC_FA_v_N0', diag%axesCv1, Time, & - 'BTCont type near north face area', 'm2') + 'BTCont type near north face area', 'm2') !(, conversion=US%L_to_m*GV%H_to_m) CS%id_BTC_FA_v_SS = register_diag_field('ocean_model', 'BTC_FA_v_SS', diag%axesCv1, Time, & - 'BTCont type far south face area', 'm2') + 'BTCont type far south face area', 'm2') !(, conversion=US%L_to_m*GV%H_to_m) CS%id_BTC_FA_v_S0 = register_diag_field('ocean_model', 'BTC_FA_v_S0', diag%axesCv1, Time, & - 'BTCont type near south face area', 'm2') + 'BTCont type near south face area', 'm2') !(, conversion=US%L_to_m*GV%H_to_m) CS%id_BTC_vbt_NN = register_diag_field('ocean_model', 'BTC_vbt_NN', diag%axesCv1, Time, & 'BTCont type far north velocity', 'm s-1') CS%id_BTC_vbt_SS = register_diag_field('ocean_model', 'BTC_vbt_SS', diag%axesCv1, Time, & 'BTCont type far south velocity', 'm s-1') endif CS%id_uhbt0 = register_diag_field('ocean_model', 'uhbt0', diag%axesCu1, Time, & - 'Barotropic zonal transport difference', 'm3 s-1') + 'Barotropic zonal transport difference', 'm3 s-1', conversion=GV%H_to_m*US%L_to_m**2*US%s_to_T) CS%id_vhbt0 = register_diag_field('ocean_model', 'vhbt0', diag%axesCv1, Time, & - 'Barotropic meridional transport difference', 'm3 s-1') + 'Barotropic meridional transport difference', 'm3 s-1', conversion=GV%H_to_m*US%L_to_m**2*US%s_to_T) if (CS%id_frhatu1 > 0) call safe_alloc_ptr(CS%frhatu1, IsdB,IedB,jsd,jed,nz) if (CS%id_frhatv1 > 0) call safe_alloc_ptr(CS%frhatv1, isd,ied,JsdB,JedB,nz) @@ -4296,8 +4300,13 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, US, param_file, diag, CS, if (.NOT.query_initialized(CS%ubt_IC,"ubt_IC",restart_CS) .or. & .NOT.query_initialized(CS%vbt_IC,"vbt_IC",restart_CS)) then - do j=js,je ; do I=is-1,ie ; CS%ubt_IC(I,j) = CS%ubtav(I,j) ; enddo ; enddo - do J=js-1,je ; do i=is,ie ; CS%vbt_IC(i,J) = CS%vbtav(i,J) ; enddo ; enddo + do j=js,je ; do I=is-1,ie ; CS%ubt_IC(I,j) = US%m_s_to_L_T*CS%ubtav(I,j) ; enddo ; enddo + do J=js-1,je ; do i=is,ie ; CS%vbt_IC(i,J) = US%m_s_to_L_T*CS%vbtav(i,J) ; enddo ; enddo + elseif ((US%s_to_T_restart*US%m_to_L_restart /= 0.0) .and. & + (US%m_to_L*US%s_to_T_restart) /= (US%m_to_L_restart*US%s_to_T)) then + vel_rescale = (US%m_to_L*US%s_to_T_restart) / (US%m_to_L_restart*US%s_to_T) + do j=js,je ; do I=is-1,ie ; CS%ubt_IC(I,j) = vel_rescale * CS%ubt_IC(I,j) ; enddo ; enddo + do J=js-1,je ; do i=is,ie ; CS%vbt_IC(i,J) = vel_rescale * CS%vbt_IC(I,j) ; enddo ; enddo endif ! Calculate other constants which are used for btstep. @@ -4327,22 +4336,25 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, US, param_file, diag, CS, ! enddo ; enddo ! endif - call find_face_areas(Datu, Datv, G, GV, CS, MS, halo=1) + call find_face_areas(Datu, Datv, G, GV, US, CS, MS, halo=1) if (CS%bound_BT_corr) then ! ### Consider replacing maxvel with G%dxT(i,j) * (CS%maxCFL_BT_cont*Idt) ! ### and G%dyT(i,j) * (CS%maxCFL_BT_cont*Idt) do j=js,je ; do i=is,ie - CS%eta_cor_bound(i,j) = GV%m_to_H * G%IareaT(i,j) * 0.1 * CS%maxvel * & + CS%eta_cor_bound(i,j) = GV%m_to_H * US%L_to_m**2*G%IareaT(i,j) * 0.1 * CS%maxvel * & ((Datu(I-1,j) + Datu(I,j)) + (Datv(i,J) + Datv(i,J-1))) enddo ; enddo endif if (.NOT.query_initialized(CS%uhbt_IC,"uhbt_IC",restart_CS) .or. & .NOT.query_initialized(CS%vhbt_IC,"vhbt_IC",restart_CS)) then - do j=js,je ; do I=is-1,ie ; CS%uhbt_IC(I,j) = CS%ubtav(I,j) * Datu(I,j) ; enddo ; enddo - do J=js-1,je ; do i=is,ie ; CS%vhbt_IC(i,J) = CS%vbtav(i,J) * Datv(i,J) ; enddo ; enddo - elseif ((GV%m_to_H_restart /= 0.0) .and. (GV%m_to_H_restart /= GV%m_to_H)) then - uH_rescale = GV%m_to_H / GV%m_to_H_restart + do j=js,je ; do I=is-1,ie ; CS%uhbt_IC(I,j) = US%m_s_to_L_T*CS%ubtav(I,j) * Datu(I,j) ; enddo ; enddo + do J=js-1,je ; do i=is,ie ; CS%vhbt_IC(i,J) = US%m_s_to_L_T*CS%vbtav(i,J) * Datv(i,J) ; enddo ; enddo + elseif ((US%s_to_T_restart * US%m_to_L_restart * GV%m_to_H_restart /= 0.0) .and. & + ((US%s_to_T_restart * US%m_to_L**2 * GV%m_to_H) /= & + (US%s_to_T * US%m_to_L_restart**2 * GV%m_to_H_restart))) then + uH_rescale = (US%s_to_T_restart * US%m_to_L**2 * GV%m_to_H) / & + (US%s_to_T * US%m_to_L_restart**2 * GV%m_to_H_restart) do j=js,je ; do I=is-1,ie ; CS%uhbt_IC(I,j) = uH_rescale * CS%uhbt_IC(I,j) ; enddo ; enddo do J=js-1,je ; do i=is,ie ; CS%vhbt_IC(i,J) = uH_rescale * CS%vhbt_IC(I,j) ; enddo ; enddo endif @@ -4366,21 +4378,20 @@ end subroutine barotropic_init !> Copies ubtav and vbtav from private type into arrays subroutine barotropic_get_tav(CS, ubtav, vbtav, G) - type(barotropic_CS), pointer :: CS !< Control structure for - !! this module - type(ocean_grid_type), intent(in) :: G !< Grid structure - real, dimension(SZIB_(G),SZJ_(G)), intent(inout) :: ubtav!< zonal barotropic vel. - !! ave. over baroclinic time-step (m s-1) - real, dimension(SZI_(G),SZJB_(G)), intent(inout) :: vbtav!< meridional barotropic vel. - !! ave. over baroclinic time-step (m s-1) + type(barotropic_CS), pointer :: CS !< Control structure for this module + type(ocean_grid_type), intent(in) :: G !< Grid structure + real, dimension(SZIB_(G),SZJ_(G)), intent(inout) :: ubtav !< Zonal barotropic velocity averaged + !! over a baroclinic timestep [m s-1] + real, dimension(SZI_(G),SZJB_(G)), intent(inout) :: vbtav !< Meridional barotropic velocity averaged + !! over a baroclinic timestep [m s-1] ! Local variables integer :: i,j - do j = G%jsc, G%jec ; do I = G%isc-1, G%iec + do j=G%jsc,G%jec ; do I=G%isc-1,G%iec ubtav(I,j) = CS%ubtav(I,j) enddo ; enddo - do J = G%jsc-1, G%jec ; do i = G%isc, G%iec + do J=G%jsc-1,G%jec ; do i=G%isc,G%iec vbtav(i,J) = CS%vbtav(i,J) enddo ; enddo From f33626dc880535717ac7f2bdf3190be2283364fa Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 30 Jul 2019 08:28:34 -0400 Subject: [PATCH 138/150] +Rescaled barotropic_CS%ubtav and vbtav Rescaled the units of barotropic_CS%ubtav and vbtav for dimensional consistency testing. This required the addition of a new unit_scale_type argument to barotropic_get_tav. All answers are bitwise identical, but there is a change to a public interface. --- src/core/MOM_barotropic.F90 | 43 +++++++++++-------- .../lateral/MOM_hor_visc.F90 | 2 +- 2 files changed, 25 insertions(+), 20 deletions(-) diff --git a/src/core/MOM_barotropic.F90 b/src/core/MOM_barotropic.F90 index 25bcaa9d5b..26df178163 100644 --- a/src/core/MOM_barotropic.F90 +++ b/src/core/MOM_barotropic.F90 @@ -114,7 +114,7 @@ module MOM_barotropic !< The barotropic solvers estimate of the zonal velocity that will be the initial !! condition for the next call to btstep [L T-1 ~> m s-1]. real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_) :: ubtav - !< The barotropic zonal velocity averaged over the baroclinic time step [m s-1]. + !< The barotropic zonal velocity averaged over the baroclinic time step [L T-1 ~> m s-1]. real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_) :: IDatv !< Inverse of the basin depth at v grid points [Z-1 ~> m-1]. real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_) :: lin_drag_v @@ -127,7 +127,7 @@ module MOM_barotropic !< The barotropic solvers estimate of the zonal velocity that will be the initial !! condition for the next call to btstep [L T-1 ~> m s-1]. real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_) :: vbtav - !< The barotropic meridional velocity averaged over the baroclinic time step [m s-1]. + !< The barotropic meridional velocity averaged over the baroclinic time step [L T-1 ~> m s-1]. real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: eta_cor !< The difference between the free surface height from the barotropic calculation and the sum !! of the layer thicknesses. This difference is imposed as a forcing term in the barotropic @@ -209,7 +209,7 @@ module MOM_barotropic logical :: dynamic_psurf !< If true, add a dynamic pressure due to a viscous !! ice shelf, for instance. real :: Dmin_dyn_psurf !< The minimum depth to use in limiting the size - !! of the dynamic surface pressure for stability [m]. + !! of the dynamic surface pressure for stability [Z ~> m]. real :: ice_strength_length !< The length scale at which the damping rate !! due to the ice strength should be the same as if !! a Laplacian were applied [L ~> m]. @@ -1382,7 +1382,7 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, if (CS%dynamic_psurf) then ice_is_rigid = (associated(forces%rigidity_ice_u) .and. & associated(forces%rigidity_ice_v)) - H_min_dyn = GV%m_to_H * CS%Dmin_dyn_psurf + H_min_dyn = GV%Z_to_H * CS%Dmin_dyn_psurf if (ice_is_rigid .and. use_BT_cont) & call BT_cont_to_face_areas(BT_cont, Datu, Datv, G, US, MS, 0, .true.) if (ice_is_rigid) then @@ -2086,7 +2086,7 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, if (id_clock_calc_post > 0) call cpu_clock_begin(id_clock_calc_post) do j=js,je ; do I=is-1,ie - CS%ubtav(I,j) = US%L_T_to_m_s*ubt_sum(I,j) * I_sum_wt_trans + CS%ubtav(I,j) = ubt_sum(I,j) * I_sum_wt_trans uhbtav(I,j) = US%s_to_T*US%L_to_m**2*uhbt_sum(I,j) * I_sum_wt_trans ! The following line would do approximately nothing, as I_sum_wt_accel ~= 1. !### u_accel_bt(I,j) = u_accel_bt(I,j) * I_sum_wt_accel @@ -2094,7 +2094,7 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, enddo ; enddo do J=js-1,je ; do i=is,ie - CS%vbtav(i,J) = US%L_T_to_m_s*vbt_sum(i,J) * I_sum_wt_trans + CS%vbtav(i,J) = vbt_sum(i,J) * I_sum_wt_trans vhbtav(i,J) = US%s_to_T*US%L_to_m**2*vhbt_sum(i,J) * I_sum_wt_trans ! The following line would do approximately nothing, as I_sum_wt_accel ~= 1. !### v_accel_bt(i,J) = v_accel_bt(i,J) * I_sum_wt_accel @@ -3871,8 +3871,8 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, US, param_file, diag, CS, call get_param(param_file, mdl, "DEPTH_MIN_DYN_PSURF", CS%Dmin_dyn_psurf, & "The minimum depth to use in limiting the size of the "//& "dynamic surface pressure for stability, if "//& - "DYNAMIC_SURFACE_PRESSURE is true..", units="m", & - default=1.0e-6) + "DYNAMIC_SURFACE_PRESSURE is true..", & + units="m", default=1.0e-6, scale=US%m_to_Z) call get_param(param_file, mdl, "CONST_DYN_PSURF", CS%const_dyn_psurf, & "The constant that scales the dynamic surface pressure, "//& "if DYNAMIC_SURFACE_PRESSURE is true. Stable values "//& @@ -4210,9 +4210,9 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, US, param_file, diag, CS, CS%id_vbt_st = register_diag_field('ocean_model', 'vbt_st', diag%axesCv1, Time, & 'Barotropic start meridional velocity', 'm s-1', conversion=US%L_T_to_m_s) CS%id_ubtav = register_diag_field('ocean_model', 'ubtav', diag%axesCu1, Time, & - 'Barotropic time-average zonal velocity', 'm s-1') !(, conversion=US%L_T_to_m_s) + 'Barotropic time-average zonal velocity', 'm s-1', conversion=US%L_T_to_m_s) CS%id_vbtav = register_diag_field('ocean_model', 'vbtav', diag%axesCv1, Time, & - 'Barotropic time-average meridional velocity', 'm s-1') !(, conversion=US%L_T_to_m_s) + 'Barotropic time-average meridional velocity', 'm s-1', conversion=US%L_T_to_m_s) CS%id_eta_cor = register_diag_field('ocean_model', 'eta_cor', diag%axesT1, Time, & 'Corrective mass flux', 'm s-1') CS%id_visc_rem_u = register_diag_field('ocean_model', 'visc_rem_u', diag%axesCuL, Time, & @@ -4291,17 +4291,21 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, US, param_file, diag, CS, call btcalc(h, G, GV, CS, may_use_default=.true.) CS%ubtav(:,:) = 0.0 ; CS%vbtav(:,:) = 0.0 do k=1,nz ; do j=js,je ; do I=is-1,ie - CS%ubtav(I,j) = CS%ubtav(I,j) + CS%frhatu(I,j,k) * u(I,j,k) + CS%ubtav(I,j) = CS%ubtav(I,j) + CS%frhatu(I,j,k) * US%m_s_to_L_T*u(I,j,k) enddo ; enddo ; enddo do k=1,nz ; do J=js-1,je ; do i=is,ie - CS%vbtav(i,J) = CS%vbtav(i,J) + CS%frhatv(i,J,k) * v(i,J,k) + CS%vbtav(i,J) = CS%vbtav(i,J) + CS%frhatv(i,J,k) * US%m_s_to_L_T*v(i,J,k) enddo ; enddo ; enddo + elseif ((US%s_to_T_restart*US%m_to_L_restart /= 0.0) .and. & + (US%m_to_L*US%s_to_T_restart) /= (US%m_to_L_restart*US%s_to_T)) then + do j=js,je ; do I=is-1,ie ; CS%ubtav(I,j) = vel_rescale * CS%ubtav(I,j) ; enddo ; enddo + do J=js-1,je ; do i=is,ie ; CS%vbtav(i,J) = vel_rescale * CS%vbtav(I,j) ; enddo ; enddo endif if (.NOT.query_initialized(CS%ubt_IC,"ubt_IC",restart_CS) .or. & .NOT.query_initialized(CS%vbt_IC,"vbt_IC",restart_CS)) then - do j=js,je ; do I=is-1,ie ; CS%ubt_IC(I,j) = US%m_s_to_L_T*CS%ubtav(I,j) ; enddo ; enddo - do J=js-1,je ; do i=is,ie ; CS%vbt_IC(i,J) = US%m_s_to_L_T*CS%vbtav(i,J) ; enddo ; enddo + do j=js,je ; do I=is-1,ie ; CS%ubt_IC(I,j) = CS%ubtav(I,j) ; enddo ; enddo + do J=js-1,je ; do i=is,ie ; CS%vbt_IC(i,J) = CS%vbtav(i,J) ; enddo ; enddo elseif ((US%s_to_T_restart*US%m_to_L_restart /= 0.0) .and. & (US%m_to_L*US%s_to_T_restart) /= (US%m_to_L_restart*US%s_to_T)) then vel_rescale = (US%m_to_L*US%s_to_T_restart) / (US%m_to_L_restart*US%s_to_T) @@ -4348,8 +4352,8 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, US, param_file, diag, CS, if (.NOT.query_initialized(CS%uhbt_IC,"uhbt_IC",restart_CS) .or. & .NOT.query_initialized(CS%vhbt_IC,"vhbt_IC",restart_CS)) then - do j=js,je ; do I=is-1,ie ; CS%uhbt_IC(I,j) = US%m_s_to_L_T*CS%ubtav(I,j) * Datu(I,j) ; enddo ; enddo - do J=js-1,je ; do i=is,ie ; CS%vhbt_IC(i,J) = US%m_s_to_L_T*CS%vbtav(i,J) * Datv(i,J) ; enddo ; enddo + do j=js,je ; do I=is-1,ie ; CS%uhbt_IC(I,j) = CS%ubtav(I,j) * Datu(I,j) ; enddo ; enddo + do J=js-1,je ; do i=is,ie ; CS%vhbt_IC(i,J) = CS%vbtav(i,J) * Datv(i,J) ; enddo ; enddo elseif ((US%s_to_T_restart * US%m_to_L_restart * GV%m_to_H_restart /= 0.0) .and. & ((US%s_to_T_restart * US%m_to_L**2 * GV%m_to_H) /= & (US%s_to_T * US%m_to_L_restart**2 * GV%m_to_H_restart))) then @@ -4377,22 +4381,23 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, US, param_file, diag, CS, end subroutine barotropic_init !> Copies ubtav and vbtav from private type into arrays -subroutine barotropic_get_tav(CS, ubtav, vbtav, G) +subroutine barotropic_get_tav(CS, ubtav, vbtav, G, US) type(barotropic_CS), pointer :: CS !< Control structure for this module type(ocean_grid_type), intent(in) :: G !< Grid structure real, dimension(SZIB_(G),SZJ_(G)), intent(inout) :: ubtav !< Zonal barotropic velocity averaged !! over a baroclinic timestep [m s-1] real, dimension(SZI_(G),SZJB_(G)), intent(inout) :: vbtav !< Meridional barotropic velocity averaged !! over a baroclinic timestep [m s-1] + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type ! Local variables integer :: i,j do j=G%jsc,G%jec ; do I=G%isc-1,G%iec - ubtav(I,j) = CS%ubtav(I,j) + ubtav(I,j) = US%L_T_to_m_s*CS%ubtav(I,j) enddo ; enddo do J=G%jsc-1,G%jec ; do i=G%isc,G%iec - vbtav(i,J) = CS%vbtav(i,J) + vbtav(i,J) = US%L_T_to_m_s*CS%vbtav(i,J) enddo ; enddo end subroutine barotropic_get_tav diff --git a/src/parameterizations/lateral/MOM_hor_visc.F90 b/src/parameterizations/lateral/MOM_hor_visc.F90 index 607bac9f00..5d871921a9 100644 --- a/src/parameterizations/lateral/MOM_hor_visc.F90 +++ b/src/parameterizations/lateral/MOM_hor_visc.F90 @@ -418,7 +418,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, ! call pass_var(boundary_mask, G%Domain, complete=.true.) ! Get barotropic velocities and their gradients - call barotropic_get_tav(BT, ubtav, vbtav, G) + call barotropic_get_tav(BT, ubtav, vbtav, G, US) call pass_vector(ubtav, vbtav, G%Domain) !#GME# The following loop range should be: do j=js-1,je+1 ; do i=is-1,ie+1 From eacb4b768bc789e19225b9c9f661e3a23eaee7a3 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 30 Jul 2019 11:11:23 -0400 Subject: [PATCH 139/150] +Rescaled elements of the BT_cont_type Added dimensional rescaling of the face-area and velocity elements of the BT_cont_type for dimensional consistency testing. This required the addition of unit_scale_type arguments to several of the continuity-related subroutines. All answers are bitwise identical, but there were changes to the units of elements of a public type and there are new required arguments to several public subroutines. --- src/core/MOM_barotropic.F90 | 32 +++++------ src/core/MOM_continuity.F90 | 6 ++- src/core/MOM_continuity_PPM.F90 | 76 +++++++++++++++------------ src/core/MOM_dynamics_split_RK2.F90 | 8 +-- src/core/MOM_dynamics_unsplit.F90 | 6 +-- src/core/MOM_dynamics_unsplit_RK2.F90 | 6 +-- src/core/MOM_variables.F90 | 24 ++++----- 7 files changed, 83 insertions(+), 75 deletions(-) diff --git a/src/core/MOM_barotropic.F90 b/src/core/MOM_barotropic.F90 index 26df178163..6377dd2d1f 100644 --- a/src/core/MOM_barotropic.F90 +++ b/src/core/MOM_barotropic.F90 @@ -3302,15 +3302,15 @@ subroutine set_local_BT_cont_types(BT_cont, BTCL_u, BTCL_v, G, US, MS, BT_Domain enddo ; enddo !$OMP do do j=js,je; do I=is-1,ie - uBT_EE(I,j) = US%m_s_to_L_T*BT_cont%uBT_EE(I,j) ; uBT_WW(I,j) = US%m_s_to_L_T*BT_cont%uBT_WW(I,j) - FA_u_EE(I,j) = US%m_to_L*BT_cont%FA_u_EE(I,j) ; FA_u_E0(I,j) = US%m_to_L*BT_cont%FA_u_E0(I,j) - FA_u_W0(I,j) = US%m_to_L*BT_cont%FA_u_W0(I,j) ; FA_u_WW(I,j) = US%m_to_L*BT_cont%FA_u_WW(I,j) + uBT_EE(I,j) = BT_cont%uBT_EE(I,j) ; uBT_WW(I,j) = BT_cont%uBT_WW(I,j) + FA_u_EE(I,j) = BT_cont%FA_u_EE(I,j) ; FA_u_E0(I,j) = BT_cont%FA_u_E0(I,j) + FA_u_W0(I,j) = BT_cont%FA_u_W0(I,j) ; FA_u_WW(I,j) = BT_cont%FA_u_WW(I,j) enddo ; enddo !$OMP do do J=js-1,je; do i=is,ie - vBT_NN(i,J) = US%m_s_to_L_T*BT_cont%vBT_NN(i,J) ; vBT_SS(i,J) = US%m_s_to_L_T*BT_cont%vBT_SS(i,J) - FA_v_NN(i,J) = US%m_to_L*BT_cont%FA_v_NN(i,J) ; FA_v_N0(i,J) = US%m_to_L*BT_cont%FA_v_N0(i,J) - FA_v_S0(i,J) = US%m_to_L*BT_cont%FA_v_S0(i,J) ; FA_v_SS(i,J) = US%m_to_L*BT_cont%FA_v_SS(i,J) + vBT_NN(i,J) = BT_cont%vBT_NN(i,J) ; vBT_SS(i,J) = BT_cont%vBT_SS(i,J) + FA_v_NN(i,J) = BT_cont%FA_v_NN(i,J) ; FA_v_N0(i,J) = BT_cont%FA_v_N0(i,J) + FA_v_S0(i,J) = BT_cont%FA_v_S0(i,J) ; FA_v_SS(i,J) = BT_cont%FA_v_SS(i,J) enddo ; enddo !$OMP end parallel @@ -4254,29 +4254,29 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, US, param_file, diag, CS, if (use_BT_cont_type) then CS%id_BTC_FA_u_EE = register_diag_field('ocean_model', 'BTC_FA_u_EE', diag%axesCu1, Time, & - 'BTCont type far east face area', 'm2') !(, conversion=US%L_to_m*GV%H_to_m) + 'BTCont type far east face area', 'm2', conversion=US%L_to_m*GV%H_to_m) CS%id_BTC_FA_u_E0 = register_diag_field('ocean_model', 'BTC_FA_u_E0', diag%axesCu1, Time, & - 'BTCont type near east face area', 'm2') !(, conversion=US%L_to_m*GV%H_to_m) + 'BTCont type near east face area', 'm2', conversion=US%L_to_m*GV%H_to_m) CS%id_BTC_FA_u_WW = register_diag_field('ocean_model', 'BTC_FA_u_WW', diag%axesCu1, Time, & - 'BTCont type far west face area', 'm2') !(, conversion=US%L_to_m*GV%H_to_m) + 'BTCont type far west face area', 'm2', conversion=US%L_to_m*GV%H_to_m) CS%id_BTC_FA_u_W0 = register_diag_field('ocean_model', 'BTC_FA_u_W0', diag%axesCu1, Time, & - 'BTCont type near west face area', 'm2') !(, conversion=US%L_to_m*GV%H_to_m) + 'BTCont type near west face area', 'm2', conversion=US%L_to_m*GV%H_to_m) CS%id_BTC_ubt_EE = register_diag_field('ocean_model', 'BTC_ubt_EE', diag%axesCu1, Time, & 'BTCont type far east velocity', 'm s-1') CS%id_BTC_ubt_WW = register_diag_field('ocean_model', 'BTC_ubt_WW', diag%axesCu1, Time, & 'BTCont type far west velocity', 'm s-1') CS%id_BTC_FA_v_NN = register_diag_field('ocean_model', 'BTC_FA_v_NN', diag%axesCv1, Time, & - 'BTCont type far north face area', 'm2') !(, conversion=US%L_to_m*GV%H_to_m) + 'BTCont type far north face area', 'm2', conversion=US%L_to_m*GV%H_to_m) CS%id_BTC_FA_v_N0 = register_diag_field('ocean_model', 'BTC_FA_v_N0', diag%axesCv1, Time, & - 'BTCont type near north face area', 'm2') !(, conversion=US%L_to_m*GV%H_to_m) + 'BTCont type near north face area', 'm2', conversion=US%L_to_m*GV%H_to_m) CS%id_BTC_FA_v_SS = register_diag_field('ocean_model', 'BTC_FA_v_SS', diag%axesCv1, Time, & - 'BTCont type far south face area', 'm2') !(, conversion=US%L_to_m*GV%H_to_m) + 'BTCont type far south face area', 'm2', conversion=US%L_to_m*GV%H_to_m) CS%id_BTC_FA_v_S0 = register_diag_field('ocean_model', 'BTC_FA_v_S0', diag%axesCv1, Time, & - 'BTCont type near south face area', 'm2') !(, conversion=US%L_to_m*GV%H_to_m) + 'BTCont type near south face area', 'm2', conversion=US%L_to_m*GV%H_to_m) CS%id_BTC_vbt_NN = register_diag_field('ocean_model', 'BTC_vbt_NN', diag%axesCv1, Time, & - 'BTCont type far north velocity', 'm s-1') + 'BTCont type far north velocity', 'm s-1', conversion=US%L_T_to_m_s) CS%id_BTC_vbt_SS = register_diag_field('ocean_model', 'BTC_vbt_SS', diag%axesCv1, Time, & - 'BTCont type far south velocity', 'm s-1') + 'BTCont type far south velocity', 'm s-1', conversion=US%L_T_to_m_s) endif CS%id_uhbt0 = register_diag_field('ocean_model', 'uhbt0', diag%axesCu1, Time, & 'Barotropic zonal transport difference', 'm3 s-1', conversion=GV%H_to_m*US%L_to_m**2*US%s_to_T) diff --git a/src/core/MOM_continuity.F90 b/src/core/MOM_continuity.F90 index ce69c9816c..5bca916ab5 100644 --- a/src/core/MOM_continuity.F90 +++ b/src/core/MOM_continuity.F90 @@ -12,6 +12,7 @@ module MOM_continuity use MOM_string_functions, only : uppercase use MOM_grid, only : ocean_grid_type use MOM_open_boundary, only : ocean_OBC_type +use MOM_unit_scaling, only : unit_scale_type use MOM_variables, only : BT_cont_type use MOM_verticalGrid, only : verticalGrid_type @@ -38,7 +39,7 @@ module MOM_continuity !> Time steps the layer thicknesses, using a monotonically limited, directionally split PPM scheme, !! based on Lin (1994). -subroutine continuity(u, v, hin, h, uh, vh, dt, G, GV, CS, uhbt, vhbt, OBC, & +subroutine continuity(u, v, hin, h, uh, vh, dt, G, GV, US, CS, uhbt, vhbt, OBC, & visc_rem_u, visc_rem_v, u_cor, v_cor, & uhbt_aux, vhbt_aux, u_cor_aux, v_cor_aux, BT_cont) type(ocean_grid_type), intent(inout) :: G !< Ocean grid structure. @@ -58,6 +59,7 @@ subroutine continuity(u, v, hin, h, uh, vh, dt, G, GV, CS, uhbt, vhbt, OBC, & intent(out) :: vh !< Volume flux through meridional faces = !! v*h*dx [H m2 s-1 ~> m3 s-1 or kg s-1]. real, intent(in) :: dt !< Time increment [s]. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(continuity_CS), pointer :: CS !< Control structure for mom_continuity. real, dimension(SZIB_(G),SZJ_(G)), & optional, intent(in) :: uhbt !< The vertically summed volume @@ -117,7 +119,7 @@ subroutine continuity(u, v, hin, h, uh, vh, dt, G, GV, CS, uhbt, vhbt, OBC, & " or neither.") if (CS%continuity_scheme == PPM_SCHEME) then - call continuity_PPM(u, v, hin, h, uh, vh, dt, G, GV, CS%PPM_CSp, uhbt, vhbt, OBC, & + call continuity_PPM(u, v, hin, h, uh, vh, dt, G, GV, US, CS%PPM_CSp, uhbt, vhbt, OBC, & visc_rem_u, visc_rem_v, u_cor, v_cor, & uhbt_aux, vhbt_aux, u_cor_aux, v_cor_aux, BT_cont) else diff --git a/src/core/MOM_continuity_PPM.F90 b/src/core/MOM_continuity_PPM.F90 index 4cf410160b..a55166e7ff 100644 --- a/src/core/MOM_continuity_PPM.F90 +++ b/src/core/MOM_continuity_PPM.F90 @@ -10,6 +10,7 @@ module MOM_continuity_PPM use MOM_grid, only : ocean_grid_type use MOM_open_boundary, only : ocean_OBC_type, OBC_segment_type, OBC_NONE use MOM_open_boundary, only : OBC_DIRECTION_E, OBC_DIRECTION_W, OBC_DIRECTION_N, OBC_DIRECTION_S +use MOM_unit_scaling, only : unit_scale_type use MOM_variables, only : BT_cont_type use MOM_verticalGrid, only : verticalGrid_type @@ -72,7 +73,7 @@ module MOM_continuity_PPM !> Time steps the layer thicknesses, using a monotonically limit, directionally split PPM scheme, !! based on Lin (1994). -subroutine continuity_PPM(u, v, hin, h, uh, vh, dt, G, GV, CS, uhbt, vhbt, OBC, & +subroutine continuity_PPM(u, v, hin, h, uh, vh, dt, G, GV, US, CS, uhbt, vhbt, OBC, & visc_rem_u, visc_rem_v, u_cor, v_cor, & uhbt_aux, vhbt_aux, u_cor_aux, v_cor_aux, BT_cont) type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. @@ -91,6 +92,7 @@ subroutine continuity_PPM(u, v, hin, h, uh, vh, dt, G, GV, CS, uhbt, vhbt, OBC, intent(out) :: vh !< Meridional volume flux, v*h*dx [H m2 s-1 ~> m3 s-1 or kg s-1]. real, intent(in) :: dt !< Time increment [s]. type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZIB_(G),SZJ_(G)), & optional, intent(in) :: uhbt !< The summed volume flux through zonal faces !! [H m2 s-1 ~> m3 s-1 or kg s-1]. @@ -163,7 +165,7 @@ subroutine continuity_PPM(u, v, hin, h, uh, vh, dt, G, GV, CS, uhbt, vhbt, OBC, ! First, advect zonally. LB%ish = G%isc ; LB%ieh = G%iec LB%jsh = G%jsc-stencil ; LB%jeh = G%jec+stencil - call zonal_mass_flux(u, hin, uh, dt, G, GV, CS, LB, uhbt, OBC, visc_rem_u, & + call zonal_mass_flux(u, hin, uh, dt, G, GV, US, CS, LB, uhbt, OBC, visc_rem_u, & u_cor, uhbt_aux, u_cor_aux, BT_cont) call cpu_clock_begin(id_clock_update) @@ -179,7 +181,7 @@ subroutine continuity_PPM(u, v, hin, h, uh, vh, dt, G, GV, CS, uhbt, vhbt, OBC, ! Now advect meridionally, using the updated thicknesses to determine ! the fluxes. - call meridional_mass_flux(v, h, vh, dt, G, GV, CS, LB, vhbt, OBC, visc_rem_v, & + call meridional_mass_flux(v, h, vh, dt, G, GV, US, CS, LB, vhbt, OBC, visc_rem_v, & v_cor, vhbt_aux, v_cor_aux, BT_cont) call cpu_clock_begin(id_clock_update) @@ -196,7 +198,7 @@ subroutine continuity_PPM(u, v, hin, h, uh, vh, dt, G, GV, CS, uhbt, vhbt, OBC, LB%ish = G%isc-stencil ; LB%ieh = G%iec+stencil LB%jsh = G%jsc ; LB%jeh = G%jec - call meridional_mass_flux(v, hin, vh, dt, G, GV, CS, LB, vhbt, OBC, visc_rem_v, & + call meridional_mass_flux(v, hin, vh, dt, G, GV, US, CS, LB, vhbt, OBC, visc_rem_v, & v_cor, vhbt_aux, v_cor_aux, BT_cont) call cpu_clock_begin(id_clock_update) @@ -209,7 +211,7 @@ subroutine continuity_PPM(u, v, hin, h, uh, vh, dt, G, GV, CS, uhbt, vhbt, OBC, ! Now advect zonally, using the updated thicknesses to determine ! the fluxes. LB%ish = G%isc ; LB%ieh = G%iec ; LB%jsh = G%jsc ; LB%jeh = G%jec - call zonal_mass_flux(u, h, uh, dt, G, GV, CS, LB, uhbt, OBC, visc_rem_u, & + call zonal_mass_flux(u, h, uh, dt, G, GV, US, CS, LB, uhbt, OBC, visc_rem_u, & u_cor, uhbt_aux, u_cor_aux, BT_cont) call cpu_clock_begin(id_clock_update) @@ -226,7 +228,7 @@ subroutine continuity_PPM(u, v, hin, h, uh, vh, dt, G, GV, CS, uhbt, vhbt, OBC, end subroutine continuity_PPM !> Calculates the mass or volume fluxes through the zonal faces, and other related quantities. -subroutine zonal_mass_flux(u, h_in, uh, dt, G, GV, CS, LB, uhbt, OBC, & +subroutine zonal_mass_flux(u, h_in, uh, dt, G, GV, US, CS, LB, uhbt, OBC, & visc_rem_u, u_cor, uhbt_aux, u_cor_aux, BT_cont) type(ocean_grid_type), intent(inout) :: G !< Ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< Ocean's vertical grid structure. @@ -238,6 +240,7 @@ subroutine zonal_mass_flux(u, h_in, uh, dt, G, GV, CS, LB, uhbt, OBC, & intent(out) :: uh !< Volume flux through zonal faces = u*h*dy !! [H m2 s-1 ~> m3 s-1 or kg s-1]. real, intent(in) :: dt !< Time increment [s]. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(continuity_PPM_CS), pointer :: CS !< This module's control structure. type(loop_bounds_type), intent(in) :: LB !< Loop bounds structure. type(ocean_OBC_type), & @@ -475,7 +478,7 @@ subroutine zonal_mass_flux(u, h_in, uh, dt, G, GV, CS, LB, uhbt, OBC, & if (set_BT_cont) then call set_zonal_BT_cont(u, h_in, h_L, h_R, BT_cont, uh_tot_0, duhdu_tot_0,& - du_max_CFL, du_min_CFL, dt, G, CS, visc_rem, & + du_max_CFL, du_min_CFL, dt, G, US, CS, visc_rem, & visc_rem_max, j, ish, ieh, do_I) if (any_simple_OBC) then do I=ish-1,ieh @@ -489,8 +492,8 @@ subroutine zonal_mass_flux(u, h_in, uh, dt, G, GV, CS, LB, uhbt, OBC, & OBC%segment(OBC%segnum_u(I,j))%normal_vel(I,j,k) endif ; enddo ; enddo do I=ish-1,ieh ; if (do_I(I)) then - BT_cont%Fa_u_W0(I,j) = FAuI(I) ; BT_cont%Fa_u_E0(I,j) = FAuI(I) - BT_cont%Fa_u_WW(I,j) = FAuI(I) ; BT_cont%Fa_u_EE(I,j) = FAuI(I) + BT_cont%FA_u_W0(I,j) = US%m_to_L*FAuI(I) ; BT_cont%FA_u_E0(I,j) = US%m_to_L*FAuI(I) + BT_cont%FA_u_WW(I,j) = US%m_to_L*FAuI(I) ; BT_cont%FA_u_EE(I,j) = US%m_to_L*FAuI(I) BT_cont%uBT_WW(I,j) = 0.0 ; BT_cont%uBT_EE(I,j) = 0.0 endif ; enddo endif @@ -505,17 +508,17 @@ subroutine zonal_mass_flux(u, h_in, uh, dt, G, GV, CS, LB, uhbt, OBC, & if (OBC%segment(n)%direction == OBC_DIRECTION_E) then do J = OBC%segment(n)%HI%Jsd, OBC%segment(n)%HI%Jed FA_u = 0.0 - do k=1,nz ; FA_u = FA_u + h_in(i,j,k)*G%dy_Cu(I,j) ; enddo - BT_cont%Fa_u_W0(I,j) = FA_u ; BT_cont%Fa_u_E0(I,j) = FA_u - BT_cont%Fa_u_WW(I,j) = FA_u ; BT_cont%Fa_u_EE(I,j) = FA_u + do k=1,nz ; FA_u = FA_u + h_in(i,j,k)*US%m_to_L*G%dy_Cu(I,j) ; enddo + BT_cont%FA_u_W0(I,j) = FA_u ; BT_cont%FA_u_E0(I,j) = FA_u + BT_cont%FA_u_WW(I,j) = FA_u ; BT_cont%FA_u_EE(I,j) = FA_u BT_cont%uBT_WW(I,j) = 0.0 ; BT_cont%uBT_EE(I,j) = 0.0 enddo else do J = OBC%segment(n)%HI%Jsd, OBC%segment(n)%HI%Jed FA_u = 0.0 - do k=1,nz ; FA_u = FA_u + h_in(i+1,j,k)*G%dy_Cu(I,j) ; enddo - BT_cont%Fa_u_W0(I,j) = FA_u ; BT_cont%Fa_u_E0(I,j) = FA_u - BT_cont%Fa_u_WW(I,j) = FA_u ; BT_cont%Fa_u_EE(I,j) = FA_u + do k=1,nz ; FA_u = FA_u + h_in(i+1,j,k)*US%m_to_L*G%dy_Cu(I,j) ; enddo + BT_cont%FA_u_W0(I,j) = FA_u ; BT_cont%FA_u_E0(I,j) = FA_u + BT_cont%FA_u_WW(I,j) = FA_u ; BT_cont%FA_u_EE(I,j) = FA_u BT_cont%uBT_WW(I,j) = 0.0 ; BT_cont%uBT_EE(I,j) = 0.0 enddo endif @@ -883,7 +886,7 @@ end subroutine zonal_flux_adjust !> Sets a structure that describes the zonal barotropic volume or mass fluxes as a !! function of barotropic flow to agree closely with the sum of the layer's transports. subroutine set_zonal_BT_cont(u, h_in, h_L, h_R, BT_cont, uh_tot_0, duhdu_tot_0, & - du_max_CFL, du_min_CFL, dt, G, CS, visc_rem, & + du_max_CFL, du_min_CFL, dt, G, US, CS, visc_rem, & visc_rem_max, j, ish, ieh, do_I) type(ocean_grid_type), intent(inout) :: G !< Ocean's grid structure. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: u !< Zonal velocity [m s-1]. @@ -904,6 +907,7 @@ subroutine set_zonal_BT_cont(u, h_in, h_L, h_R, BT_cont, uh_tot_0, duhdu_tot_0, real, dimension(SZIB_(G)), intent(in) :: du_min_CFL !< Minimum acceptable !! value of du [m s-1]. real, intent(in) :: dt !< Time increment [s]. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(continuity_PPM_CS), pointer :: CS !< This module's control structure. real, dimension(SZIB_(G),SZK_(G)), intent(in) :: visc_rem !< Both the fraction of the !! momentum originally in a layer that remains after a time-step of viscosity, and @@ -1021,9 +1025,9 @@ subroutine set_zonal_BT_cont(u, h_in, h_L, h_R, BT_cont, uh_tot_0, duhdu_tot_0, if (FA_avg > max(FA_0, FAmt_L(I))) then ; FA_avg = max(FA_0, FAmt_L(I)) elseif (FA_avg < min(FA_0, FAmt_L(I))) then ; FA_0 = FA_avg ; endif - BT_cont%FA_u_W0(I,j) = FA_0 ; BT_cont%FA_u_WW(I,j) = FAmt_L(I) + BT_cont%FA_u_W0(I,j) = US%m_to_L*FA_0 ; BT_cont%FA_u_WW(I,j) = US%m_to_L*FAmt_L(I) if (abs(FA_0-FAmt_L(I)) <= 1e-12*FA_0) then ; BT_cont%uBT_WW(I,j) = 0.0 ; else - BT_cont%uBT_WW(I,j) = (1.5 * (duL(I) - du0(I))) * & + BT_cont%uBT_WW(I,j) = US%m_s_to_L_T*(1.5 * (duL(I) - du0(I))) * & ((FAmt_L(I) - FA_avg) / (FAmt_L(I) - FA_0)) endif @@ -1033,9 +1037,9 @@ subroutine set_zonal_BT_cont(u, h_in, h_L, h_R, BT_cont, uh_tot_0, duhdu_tot_0, if (FA_avg > max(FA_0, FAmt_R(I))) then ; FA_avg = max(FA_0, FAmt_R(I)) elseif (FA_avg < min(FA_0, FAmt_R(I))) then ; FA_0 = FA_avg ; endif - BT_cont%FA_u_E0(I,j) = FA_0 ; BT_cont%FA_u_EE(I,j) = FAmt_R(I) + BT_cont%FA_u_E0(I,j) = US%m_to_L*FA_0 ; BT_cont%FA_u_EE(I,j) = US%m_to_L*FAmt_R(I) if (abs(FAmt_R(I) - FA_0) <= 1e-12*FA_0) then ; BT_cont%uBT_EE(I,j) = 0.0 ; else - BT_cont%uBT_EE(I,j) = (1.5 * (duR(I) - du0(I))) * & + BT_cont%uBT_EE(I,j) = US%m_s_to_L_T*(1.5 * (duR(I) - du0(I))) * & ((FAmt_R(I) - FA_avg) / (FAmt_R(I) - FA_0)) endif else @@ -1047,7 +1051,7 @@ subroutine set_zonal_BT_cont(u, h_in, h_L, h_R, BT_cont, uh_tot_0, duhdu_tot_0, end subroutine set_zonal_BT_cont !> Calculates the mass or volume fluxes through the meridional faces, and other related quantities. -subroutine meridional_mass_flux(v, h_in, vh, dt, G, GV, CS, LB, vhbt, OBC, & +subroutine meridional_mass_flux(v, h_in, vh, dt, G, GV, US, CS, LB, vhbt, OBC, & visc_rem_v, v_cor, vhbt_aux, v_cor_aux, BT_cont) type(ocean_grid_type), intent(inout) :: G !< Ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< Ocean's vertical grid structure. @@ -1057,6 +1061,7 @@ subroutine meridional_mass_flux(v, h_in, vh, dt, G, GV, CS, LB, vhbt, OBC, & real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(out) :: vh !< Volume flux through meridional !! faces = v*h*dx [H m2 s-1 ~> m3 s-1 or kg s-1]. real, intent(in) :: dt !< Time increment [s]. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(continuity_PPM_CS), pointer :: CS !< This module's control structure. type(loop_bounds_type), intent(in) :: LB !< Loop bounds structure. type(ocean_OBC_type), optional, pointer :: OBC !< Open boundary condition type @@ -1290,7 +1295,7 @@ subroutine meridional_mass_flux(v, h_in, vh, dt, G, GV, CS, LB, vhbt, OBC, & if (set_BT_cont) then call set_merid_BT_cont(v, h_in, h_L, h_R, BT_cont, vh_tot_0, dvhdv_tot_0,& - dv_max_CFL, dv_min_CFL, dt, G, CS, visc_rem, & + dv_max_CFL, dv_min_CFL, dt, G, US, CS, visc_rem, & visc_rem_max, J, ish, ieh, do_I) if (any_simple_OBC) then do i=ish,ieh @@ -1305,8 +1310,8 @@ subroutine meridional_mass_flux(v, h_in, vh, dt, G, GV, CS, LB, vhbt, OBC, & OBC%segment(OBC%segnum_v(i,J))%normal_vel(i,J,k) endif ; enddo ; enddo do i=ish,ieh ; if (do_I(i)) then - BT_cont%FA_v_S0(i,J) = FAvi(i) ; BT_cont%FA_v_N0(i,J) = FAvi(i) - BT_cont%FA_v_SS(i,J) = FAvi(i) ; BT_cont%FA_v_NN(i,J) = FAvi(i) + BT_cont%FA_v_S0(i,J) = US%m_to_L*FAvi(i) ; BT_cont%FA_v_N0(i,J) = US%m_to_L*FAvi(i) + BT_cont%FA_v_SS(i,J) = US%m_to_L*FAvi(i) ; BT_cont%FA_v_NN(i,J) = US%m_to_L*FAvi(i) BT_cont%vBT_SS(i,J) = 0.0 ; BT_cont%vBT_NN(i,J) = 0.0 endif ; enddo endif @@ -1322,17 +1327,17 @@ subroutine meridional_mass_flux(v, h_in, vh, dt, G, GV, CS, LB, vhbt, OBC, & if (OBC%segment(n)%direction == OBC_DIRECTION_N) then do i = OBC%segment(n)%HI%Isd, OBC%segment(n)%HI%Ied FA_v = 0.0 - do k=1,nz ; FA_v = FA_v + h_in(i,j,k)*G%dx_Cv(i,J) ; enddo - BT_cont%Fa_v_S0(i,J) = FA_v ; BT_cont%Fa_v_N0(i,J) = FA_v - BT_cont%Fa_v_SS(i,J) = FA_v ; BT_cont%Fa_v_NN(i,J) = FA_v + do k=1,nz ; FA_v = FA_v + h_in(i,j,k)*US%m_to_L*G%dx_Cv(i,J) ; enddo + BT_cont%FA_v_S0(i,J) = FA_v ; BT_cont%FA_v_N0(i,J) = FA_v + BT_cont%FA_v_SS(i,J) = FA_v ; BT_cont%FA_v_NN(i,J) = FA_v BT_cont%vBT_SS(i,J) = 0.0 ; BT_cont%vBT_NN(i,J) = 0.0 enddo else do i = OBC%segment(n)%HI%Isd, OBC%segment(n)%HI%Ied FA_v = 0.0 - do k=1,nz ; FA_v = FA_v + h_in(i,j+1,k)*G%dx_Cv(i,J) ; enddo - BT_cont%Fa_v_S0(i,J) = FA_v ; BT_cont%Fa_v_N0(i,J) = FA_v - BT_cont%Fa_v_SS(i,J) = FA_v ; BT_cont%Fa_v_NN(i,J) = FA_v + do k=1,nz ; FA_v = FA_v + h_in(i,j+1,k)*US%m_to_L*G%dx_Cv(i,J) ; enddo + BT_cont%FA_v_S0(i,J) = FA_v ; BT_cont%FA_v_N0(i,J) = FA_v + BT_cont%FA_v_SS(i,J) = FA_v ; BT_cont%FA_v_NN(i,J) = FA_v BT_cont%vBT_SS(i,J) = 0.0 ; BT_cont%vBT_NN(i,J) = 0.0 enddo endif @@ -1704,7 +1709,7 @@ end subroutine meridional_flux_adjust !> Sets of a structure that describes the meridional barotropic volume or mass fluxes as a !! function of barotropic flow to agree closely with the sum of the layer's transports. subroutine set_merid_BT_cont(v, h_in, h_L, h_R, BT_cont, vh_tot_0, dvhdv_tot_0, & - dv_max_CFL, dv_min_CFL, dt, G, CS, visc_rem, & + dv_max_CFL, dv_min_CFL, dt, G, US, CS, visc_rem, & visc_rem_max, j, ish, ieh, do_I) type(ocean_grid_type), intent(inout) :: G !< Ocean's grid structure. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: v !< Meridional velocity [m s-1]. @@ -1723,6 +1728,7 @@ subroutine set_merid_BT_cont(v, h_in, h_L, h_R, BT_cont, vh_tot_0, dvhdv_tot_0, real, dimension(SZI_(G)), intent(in) :: dv_max_CFL !< Maximum acceptable value of dv [m s-1]. real, dimension(SZI_(G)), intent(in) :: dv_min_CFL !< Minimum acceptable value of dv [m s-1]. real, intent(in) :: dt !< Time increment [s]. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(continuity_PPM_CS), pointer :: CS !< This module's control structure. real, dimension(SZI_(G),SZK_(G)), intent(in) :: visc_rem !< Both the fraction of the !! momentum originally in a layer that remains after a time-step @@ -1839,9 +1845,9 @@ subroutine set_merid_BT_cont(v, h_in, h_L, h_R, BT_cont, vh_tot_0, dvhdv_tot_0, FA_avg = vhtot_L(i) / (dvL(i) - dv0(i)) if (FA_avg > max(FA_0, FAmt_L(i))) then ; FA_avg = max(FA_0, FAmt_L(i)) elseif (FA_avg < min(FA_0, FAmt_L(i))) then ; FA_0 = FA_avg ; endif - BT_cont%FA_v_S0(i,J) = FA_0 ; BT_cont%FA_v_SS(i,J) = FAmt_L(i) + BT_cont%FA_v_S0(i,J) = US%m_to_L*FA_0 ; BT_cont%FA_v_SS(i,J) = US%m_to_L*FAmt_L(i) if (abs(FA_0-FAmt_L(i)) <= 1e-12*FA_0) then ; BT_cont%vBT_SS(i,J) = 0.0 ; else - BT_cont%vBT_SS(i,J) = (1.5 * (dvL(i) - dv0(i))) * & + BT_cont%vBT_SS(i,J) = US%m_s_to_L_T*(1.5 * (dvL(i) - dv0(i))) * & ((FAmt_L(i) - FA_avg) / (FAmt_L(i) - FA_0)) endif @@ -1850,9 +1856,9 @@ subroutine set_merid_BT_cont(v, h_in, h_L, h_R, BT_cont, vh_tot_0, dvhdv_tot_0, FA_avg = vhtot_R(i) / (dvR(i) - dv0(i)) if (FA_avg > max(FA_0, FAmt_R(i))) then ; FA_avg = max(FA_0, FAmt_R(i)) elseif (FA_avg < min(FA_0, FAmt_R(i))) then ; FA_0 = FA_avg ; endif - BT_cont%FA_v_N0(i,J) = FA_0 ; BT_cont%FA_v_NN(i,J) = FAmt_R(i) + BT_cont%FA_v_N0(i,J) = US%m_to_L*FA_0 ; BT_cont%FA_v_NN(i,J) = US%m_to_L*FAmt_R(i) if (abs(FAmt_R(i) - FA_0) <= 1e-12*FA_0) then ; BT_cont%vBT_NN(i,J) = 0.0 ; else - BT_cont%vBT_NN(i,J) = (1.5 * (dvR(i) - dv0(i))) * & + BT_cont%vBT_NN(i,J) = US%m_s_to_L_T*(1.5 * (dvR(i) - dv0(i))) * & ((FAmt_R(i) - FA_avg) / (FAmt_R(i) - FA_0)) endif else diff --git a/src/core/MOM_dynamics_split_RK2.F90 b/src/core/MOM_dynamics_split_RK2.F90 index 45c6a26cdb..f256df6508 100644 --- a/src/core/MOM_dynamics_split_RK2.F90 +++ b/src/core/MOM_dynamics_split_RK2.F90 @@ -518,7 +518,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & ! u_accel_bt = layer accelerations due to barotropic solver if (associated(CS%BT_cont) .or. CS%BT_use_layer_fluxes) then call cpu_clock_begin(id_clock_continuity) - call continuity(u, v, h, hp, uh_in, vh_in, dt, G, GV, & + call continuity(u, v, h, hp, uh_in, vh_in, dt, G, GV, US, & CS%continuity_CSp, OBC=CS%OBC, visc_rem_u=CS%visc_rem_u, & visc_rem_v=CS%visc_rem_v, BT_cont=CS%BT_cont) call cpu_clock_end(id_clock_continuity) @@ -607,7 +607,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & ! uh = u_av * h ! hp = h + dt * div . uh call cpu_clock_begin(id_clock_continuity) - call continuity(up, vp, h, hp, uh, vh, dt, G, GV, CS%continuity_CSp, & + call continuity(up, vp, h, hp, uh, vh, dt, G, GV, US, CS%continuity_CSp, & CS%uhbt, CS%vhbt, CS%OBC, CS%visc_rem_u, CS%visc_rem_v, & u_av, v_av, BT_cont=CS%BT_cont) call cpu_clock_end(id_clock_continuity) @@ -811,7 +811,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & ! h = h + dt * div . uh ! u_av and v_av adjusted so their mass transports match uhbt and vhbt. call cpu_clock_begin(id_clock_continuity) - call continuity(u, v, h, h, uh, vh, dt, G, GV, & + call continuity(u, v, h, h, uh, vh, dt, G, GV, US, & CS%continuity_CSp, CS%uhbt, CS%vhbt, CS%OBC, & CS%visc_rem_u, CS%visc_rem_v, u_av, v_av) call cpu_clock_end(id_clock_continuity) @@ -1162,7 +1162,7 @@ subroutine initialize_dyn_split_RK2(u, v, h, uh, vh, eta, Time, G, GV, US, param if (.not. query_initialized(uh,"uh",restart_CS) .or. & .not. query_initialized(vh,"vh",restart_CS)) then h_tmp(:,:,:) = h(:,:,:) - call continuity(u, v, h, h_tmp, uh, vh, dt, G, GV, CS%continuity_CSp, OBC=CS%OBC) + call continuity(u, v, h, h_tmp, uh, vh, dt, G, GV, US, CS%continuity_CSp, OBC=CS%OBC) call pass_var(h_tmp, G%Domain, clock=id_clock_pass_init) CS%h_av(:,:,:) = 0.5*(h(:,:,:) + h_tmp(:,:,:)) else diff --git a/src/core/MOM_dynamics_unsplit.F90 b/src/core/MOM_dynamics_unsplit.F90 index cd09e7a11e..07c4648b87 100644 --- a/src/core/MOM_dynamics_unsplit.F90 +++ b/src/core/MOM_dynamics_unsplit.F90 @@ -263,7 +263,7 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & ! uh = u*h ! hp = h + dt/2 div . uh call cpu_clock_begin(id_clock_continuity) - call continuity(u, v, h, hp, uh, vh, dt*0.5, G, GV, CS%continuity_CSp, & + call continuity(u, v, h, hp, uh, vh, dt*0.5, G, GV, US, CS%continuity_CSp, & OBC=CS%OBC) call cpu_clock_end(id_clock_continuity) call pass_var(hp, G%Domain, clock=id_clock_pass) @@ -356,7 +356,7 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & ! h_av = hp + dt/2 div . uh call cpu_clock_begin(id_clock_continuity) call continuity(up, vp, hp, h_av, uh, vh, & - (0.5*dt), G, GV, CS%continuity_CSp, OBC=CS%OBC) + (0.5*dt), G, GV, US, CS%continuity_CSp, OBC=CS%OBC) call cpu_clock_end(id_clock_continuity) call pass_var(h_av, G%Domain, clock=id_clock_pass) call pass_vector(uh, vh, G%Domain, clock=id_clock_pass) @@ -420,7 +420,7 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & ! h = hp + dt/2 div . uh call cpu_clock_begin(id_clock_continuity) call continuity(upp, vpp, hp, h, uh, vh, & - (dt*0.5), G, GV, CS%continuity_CSp, OBC=CS%OBC) + (dt*0.5), G, GV, US, CS%continuity_CSp, OBC=CS%OBC) call cpu_clock_end(id_clock_continuity) call pass_var(h, G%Domain, clock=id_clock_pass) call pass_vector(uh, vh, G%Domain, clock=id_clock_pass) diff --git a/src/core/MOM_dynamics_unsplit_RK2.F90 b/src/core/MOM_dynamics_unsplit_RK2.F90 index 210cd5ec08..2ad0c50624 100644 --- a/src/core/MOM_dynamics_unsplit_RK2.F90 +++ b/src/core/MOM_dynamics_unsplit_RK2.F90 @@ -279,7 +279,7 @@ subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt, call cpu_clock_begin(id_clock_continuity) ! This is a duplicate calculation of the last continuity from the previous step ! and could/should be optimized out. -AJA - call continuity(u_in, v_in, h_in, hp, uh, vh, dt_pred, G, GV, CS%continuity_CSp, & + call continuity(u_in, v_in, h_in, hp, uh, vh, dt_pred, G, GV, US, CS%continuity_CSp, & OBC=CS%OBC) call cpu_clock_end(id_clock_continuity) call pass_var(hp, G%Domain, clock=id_clock_pass) @@ -352,7 +352,7 @@ subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt, ! h_av = h + dt div . uh call cpu_clock_begin(id_clock_continuity) call continuity(up, vp, h_in, hp, uh, vh, & - dt, G, GV, CS%continuity_CSp, OBC=CS%OBC) + dt, G, GV, US, CS%continuity_CSp, OBC=CS%OBC) call cpu_clock_end(id_clock_continuity) call pass_var(hp, G%Domain, clock=id_clock_pass) call pass_vector(uh, vh, G%Domain, clock=id_clock_pass) @@ -410,7 +410,7 @@ subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt, ! h[n+1] = h[n] + dt div . uh call cpu_clock_begin(id_clock_continuity) call continuity(up, vp, h_in, h_in, uh, vh, & - dt, G, GV, CS%continuity_CSp, OBC=CS%OBC) + dt, G, GV, US, CS%continuity_CSp, OBC=CS%OBC) call cpu_clock_end(id_clock_continuity) call pass_var(h_in, G%Domain, clock=id_clock_pass) call pass_vector(uh, vh, G%Domain, clock=id_clock_pass) diff --git a/src/core/MOM_variables.F90 b/src/core/MOM_variables.F90 index 071d63246f..2dd459ba91 100644 --- a/src/core/MOM_variables.F90 +++ b/src/core/MOM_variables.F90 @@ -265,28 +265,28 @@ module MOM_variables !! and how they will vary as the barotropic velocity is changed. type, public :: BT_cont_type real, allocatable :: FA_u_EE(:,:) !< The effective open face area for zonal barotropic transport - !! drawing from locations far to the east [H m ~> m2 or kg m-1]. + !! drawing from locations far to the east [H L ~> m2 or kg m-1]. real, allocatable :: FA_u_E0(:,:) !< The effective open face area for zonal barotropic transport - !! drawing from nearby to the east [H m ~> m2 or kg m-1]. + !! drawing from nearby to the east [H L ~> m2 or kg m-1]. real, allocatable :: FA_u_W0(:,:) !< The effective open face area for zonal barotropic transport - !! drawing from nearby to the west [H m ~> m2 or kg m-1]. + !! drawing from nearby to the west [H L ~> m2 or kg m-1]. real, allocatable :: FA_u_WW(:,:) !< The effective open face area for zonal barotropic transport - !! drawing from locations far to the west [H m ~> m2 or kg m-1]. - real, allocatable :: uBT_WW(:,:) !< uBT_WW is the barotropic velocity [m s-1], beyond which the marginal + !! drawing from locations far to the west [H L ~> m2 or kg m-1]. + real, allocatable :: uBT_WW(:,:) !< uBT_WW is the barotropic velocity [L T-1 ~> m s-1], beyond which the marginal !! open face area is FA_u_WW. uBT_WW must be non-negative. - real, allocatable :: uBT_EE(:,:) !< uBT_EE is a barotropic velocity [m s-1], beyond which the marginal + real, allocatable :: uBT_EE(:,:) !< uBT_EE is a barotropic velocity [L T-1 ~> m s-1], beyond which the marginal !! open face area is FA_u_EE. uBT_EE must be non-positive. real, allocatable :: FA_v_NN(:,:) !< The effective open face area for meridional barotropic transport - !! drawing from locations far to the north [H m ~> m2 or kg m-1]. + !! drawing from locations far to the north [H L ~> m2 or kg m-1]. real, allocatable :: FA_v_N0(:,:) !< The effective open face area for meridional barotropic transport - !! drawing from nearby to the north [H m ~> m2 or kg m-1]. + !! drawing from nearby to the north [H L ~> m2 or kg m-1]. real, allocatable :: FA_v_S0(:,:) !< The effective open face area for meridional barotropic transport - !! drawing from nearby to the south [H m ~> m2 or kg m-1]. + !! drawing from nearby to the south [H L ~> m2 or kg m-1]. real, allocatable :: FA_v_SS(:,:) !< The effective open face area for meridional barotropic transport - !! drawing from locations far to the south [H m ~> m2 or kg m-1]. - real, allocatable :: vBT_SS(:,:) !< vBT_SS is the barotropic velocity, [m s-1], beyond which the marginal + !! drawing from locations far to the south [H L ~> m2 or kg m-1]. + real, allocatable :: vBT_SS(:,:) !< vBT_SS is the barotropic velocity, [L T-1 ~> m s-1], beyond which the marginal !! open face area is FA_v_SS. vBT_SS must be non-negative. - real, allocatable :: vBT_NN(:,:) !< vBT_NN is the barotropic velocity, [m s-1], beyond which the marginal + real, allocatable :: vBT_NN(:,:) !< vBT_NN is the barotropic velocity, [L T-1 ~> m s-1], beyond which the marginal !! open face area is FA_v_NN. vBT_NN must be non-positive. real, allocatable :: h_u(:,:,:) !< An effective thickness at zonal faces [H ~> m or kg m-2]. real, allocatable :: h_v(:,:,:) !< An effective thickness at meridional faces [H ~> m or kg m-2]. From 8a04b999f153b504fb9f560f5329b36e2639727a Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Tue, 30 Jul 2019 14:16:30 -0600 Subject: [PATCH 140/150] Rename modules for MCT --- ...T_ocean_model.F90 => mom_ocean_model_mct.F90} | 16 ++++++++-------- ...e_forcing.F90 => mom_surface_forcing_mct.F90} | 6 +++--- config_src/mct_driver/ocn_cap_methods.F90 | 4 ++-- config_src/mct_driver/ocn_comp_mct.F90 | 8 ++++---- 4 files changed, 17 insertions(+), 17 deletions(-) rename config_src/mct_driver/{MOM_MCT_ocean_model.F90 => mom_ocean_model_mct.F90} (99%) rename config_src/mct_driver/{MOM_MCT_surface_forcing.F90 => mom_surface_forcing_mct.F90} (99%) diff --git a/config_src/mct_driver/MOM_MCT_ocean_model.F90 b/config_src/mct_driver/mom_ocean_model_mct.F90 similarity index 99% rename from config_src/mct_driver/MOM_MCT_ocean_model.F90 rename to config_src/mct_driver/mom_ocean_model_mct.F90 index f341f39ddc..01c0b05cfc 100644 --- a/config_src/mct_driver/MOM_MCT_ocean_model.F90 +++ b/config_src/mct_driver/mom_ocean_model_mct.F90 @@ -1,5 +1,5 @@ !> Top-level module for the MOM6 ocean model in coupled mode. -module MOM_MCT_ocean_model +module mom_ocean_model_mct ! This file is part of MOM6. See LICENSE.md for the license. @@ -35,10 +35,10 @@ module MOM_MCT_ocean_model use MOM_marine_ice, only : iceberg_forces, iceberg_fluxes, marine_ice_init, marine_ice_CS use MOM_restart, only : MOM_restart_CS, save_restart use MOM_string_functions, only : uppercase -use MOM_MCT_surface_forcing, only : surface_forcing_init, convert_IOB_to_fluxes -use MOM_MCT_surface_forcing, only : convert_IOB_to_forces, ice_ocn_bnd_type_chksum -use MOM_MCT_surface_forcing, only : ice_ocean_boundary_type, surface_forcing_CS -use MOM_MCT_surface_forcing, only : forcing_save_restart +use mom_surface_forcing_mct, only : surface_forcing_init, convert_IOB_to_fluxes +use mom_surface_forcing_mct, only : convert_IOB_to_forces, ice_ocn_bnd_type_chksum +use mom_surface_forcing_mct, only : ice_ocean_boundary_type, surface_forcing_CS +use mom_surface_forcing_mct, only : forcing_save_restart use MOM_time_manager, only : time_type, get_time, set_time, operator(>) use MOM_time_manager, only : operator(+), operator(-), operator(*), operator(/) use MOM_time_manager, only : operator(/=), operator(<=), operator(>=) @@ -263,7 +263,7 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, gas_fields_ocn, i type(param_file_type) :: param_file !< A structure to parse for run-time parameters logical :: use_temperature - call callTree_enter("ocean_model_init(), MOM_MCT_ocean_model.F90") + call callTree_enter("ocean_model_init(), mom_ocean_model_mct.F90") if (associated(OS)) then call MOM_error(WARNING, "ocean_model_init called with an associated "// & "ocean_state_type structure. Model is already initialized.") @@ -477,7 +477,7 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & integer :: secs, days integer :: is, ie, js, je - call callTree_enter("update_ocean_model(), MOM_MCT_ocean_model.F90") + call callTree_enter("update_ocean_model(), mom_ocean_model_mct.F90") call get_time(Ocean_coupling_time_step, secs, days) dt_coupling = 86400.0*real(days) + real(secs) @@ -1187,4 +1187,4 @@ subroutine get_ocean_grid(OS, Gridp) return end subroutine get_ocean_grid -end module MOM_MCT_ocean_model +end module mom_ocean_model_mct diff --git a/config_src/mct_driver/MOM_MCT_surface_forcing.F90 b/config_src/mct_driver/mom_surface_forcing_mct.F90 similarity index 99% rename from config_src/mct_driver/MOM_MCT_surface_forcing.F90 rename to config_src/mct_driver/mom_surface_forcing_mct.F90 index d022dfba12..aa13a80a34 100644 --- a/config_src/mct_driver/MOM_MCT_surface_forcing.F90 +++ b/config_src/mct_driver/mom_surface_forcing_mct.F90 @@ -1,4 +1,4 @@ -module MOM_MCT_surface_forcing +module mom_surface_forcing_mct ! This file is part of MOM6. See LICENSE.md for the license. @@ -1006,7 +1006,7 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, restore_salt, 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" - character(len=40) :: mdl = "MOM_MCT_surface_forcing" ! This module's name. + character(len=40) :: mdl = "mom_surface_forcing_mct" ! This module's name. character(len=48) :: stagger character(len=48) :: flnam character(len=240) :: basin_file @@ -1378,4 +1378,4 @@ subroutine ice_ocn_bnd_type_chksum(id, timestep, iobt) end subroutine ice_ocn_bnd_type_chksum -end module MOM_MCT_surface_forcing +end module mom_surface_forcing_mct diff --git a/config_src/mct_driver/ocn_cap_methods.F90 b/config_src/mct_driver/ocn_cap_methods.F90 index daee81b1e8..c2a8183a7f 100644 --- a/config_src/mct_driver/ocn_cap_methods.F90 +++ b/config_src/mct_driver/ocn_cap_methods.F90 @@ -1,8 +1,8 @@ module ocn_cap_methods use ESMF, only: ESMF_clock, ESMF_time, ESMF_ClockGet, ESMF_TimeGet - use MOM_MCT_ocean_model, only: ocean_public_type, ocean_state_type - use MOM_MCT_surface_forcing, only: ice_ocean_boundary_type + use mom_ocean_model_mct, only: ocean_public_type, ocean_state_type + use mom_surface_forcing_mct, only: ice_ocean_boundary_type use MOM_grid, only: ocean_grid_type use MOM_domains, only: pass_var use MOM_error_handler, only: is_root_pe diff --git a/config_src/mct_driver/ocn_comp_mct.F90 b/config_src/mct_driver/ocn_comp_mct.F90 index d06e9ce26a..4cd3bac706 100644 --- a/config_src/mct_driver/ocn_comp_mct.F90 +++ b/config_src/mct_driver/ocn_comp_mct.F90 @@ -44,10 +44,10 @@ module ocn_comp_mct use mpp_domains_mod, only: mpp_get_compute_domain ! Previously inlined - now in separate modules -use MOM_MCT_ocean_model, only: ocean_public_type, ocean_state_type -use MOM_MCT_ocean_model, only: ocean_model_init , update_ocean_model, ocean_model_end -use MOM_MCT_ocean_model, only: convert_state_to_ocean_type -use MOM_MCT_surface_forcing, only: surface_forcing_CS, forcing_save_restart, ice_ocean_boundary_type +use mom_ocean_model_mct, only: ocean_public_type, ocean_state_type +use mom_ocean_model_mct, only: ocean_model_init , update_ocean_model, ocean_model_end +use mom_ocean_model_mct, only: convert_state_to_ocean_type +use mom_surface_forcing_mct, only: surface_forcing_CS, forcing_save_restart, ice_ocean_boundary_type use ocn_cap_methods, only: ocn_import, ocn_export ! FMS modules From fc55c3641badbb6d781c4e065b26e823cb5dae21 Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Tue, 30 Jul 2019 14:24:06 -0600 Subject: [PATCH 141/150] Rename modules for NUOPC --- .../nuopc_driver/{MOM_cap.F90 => mom_cap.F90} | 12 ++++++------ .../{MOM_cap_methods.F90 => mom_cap_methods.F90} | 4 ++-- .../{MOM_cap_time.F90 => mom_cap_time.F90} | 0 ...C_ocean_model.F90 => mom_ocean_model_nuopc.F90} | 14 +++++++------- ...e_forcing.F90 => mom_surface_forcing_nuopc.F90} | 6 +++--- 5 files changed, 18 insertions(+), 18 deletions(-) rename config_src/nuopc_driver/{MOM_cap.F90 => mom_cap.F90} (99%) rename config_src/nuopc_driver/{MOM_cap_methods.F90 => mom_cap_methods.F90} (99%) rename config_src/nuopc_driver/{MOM_cap_time.F90 => mom_cap_time.F90} (100%) rename config_src/nuopc_driver/{MOM_NUOPC_ocean_model.F90 => mom_ocean_model_nuopc.F90} (99%) rename config_src/nuopc_driver/{MOM_NUOPC_surface_forcing.F90 => mom_surface_forcing_nuopc.F90} (99%) diff --git a/config_src/nuopc_driver/MOM_cap.F90 b/config_src/nuopc_driver/mom_cap.F90 similarity index 99% rename from config_src/nuopc_driver/MOM_cap.F90 rename to config_src/nuopc_driver/mom_cap.F90 index cf182eb0d7..d6a7837c83 100644 --- a/config_src/nuopc_driver/MOM_cap.F90 +++ b/config_src/nuopc_driver/mom_cap.F90 @@ -37,9 +37,9 @@ !! !! The MOM cap package includes the cap code itself (MOM_cap.F90, MOM_cap_methods.F90 !! and MOM_cap_time.F90), a set of time utilities (time_utils.F90) for converting between ESMF and FMS -!! time type and two modules MOM_NUOPC_ocean_model.F90 and MOM_NUOPC_surface_forcing.F90. MOM_NUOPC_surface_forcing.F90 +!! time type and two modules MOM_ocean_model_nuopc.F90 and MOM_surface_forcing_nuopc.F90. MOM_surface_forcing_nuopc.F90 !! converts the input ESMF data (import data) to a MOM-specific data type (surface_forcing_CS). -!! MOM_NUOPC_ocean_model.F90 contains routines for initialization, update and finalization of the ocean model state. +!! MOM_ocean_model_nuopc.F90 contains routines for initialization, update and finalization of the ocean model state. !! !! @subsection CapSubroutines Cap Subroutines !! @@ -340,11 +340,11 @@ module MOM_cap_mod use MOM_get_input, only: Get_MOM_Input, directories use MOM_domains, only: pass_var use MOM_error_handler, only: is_root_pe -use MOM_NUOPC_ocean_model, only: ice_ocean_boundary_type +use MOM_ocean_model_nuopc, only: ice_ocean_boundary_type use MOM_grid, only: ocean_grid_type, get_global_grid_size -use MOM_NUOPC_ocean_model, only: ocean_model_restart, ocean_public_type, ocean_state_type -use MOM_NUOPC_ocean_model, only: ocean_model_init_sfc -use MOM_NUOPC_ocean_model, only: ocean_model_init, update_ocean_model, ocean_model_end, get_ocean_grid +use MOM_ocean_model_nuopc, only: ocean_model_restart, ocean_public_type, ocean_state_type +use MOM_ocean_model_nuopc, only: ocean_model_init_sfc +use MOM_ocean_model_nuopc, only: ocean_model_init, update_ocean_model, ocean_model_end, get_ocean_grid use MOM_cap_time, only: AlarmInit use MOM_cap_methods, only: mom_import, mom_export, mom_set_geomtype #ifdef CESMCOUPLED diff --git a/config_src/nuopc_driver/MOM_cap_methods.F90 b/config_src/nuopc_driver/mom_cap_methods.F90 similarity index 99% rename from config_src/nuopc_driver/MOM_cap_methods.F90 rename to config_src/nuopc_driver/mom_cap_methods.F90 index 36b8ea97bc..8cb1a2ca4c 100644 --- a/config_src/nuopc_driver/MOM_cap_methods.F90 +++ b/config_src/nuopc_driver/mom_cap_methods.F90 @@ -15,8 +15,8 @@ module MOM_cap_methods use ESMF, only: ESMF_RC_VAL_OUTOFRANGE, ESMF_INDEX_DELOCAL, ESMF_MESHLOC_ELEMENT use ESMF, only: ESMF_TYPEKIND_R8 use ESMF, only: operator(/=), operator(==) -use MOM_NUOPC_ocean_model, only: ocean_public_type, ocean_state_type -use MOM_NUOPC_surface_forcing, only: ice_ocean_boundary_type +use MOM_ocean_model_nuopc, only: ocean_public_type, ocean_state_type +use MOM_surface_forcing_nuopc, only: ice_ocean_boundary_type use MOM_grid, only: ocean_grid_type use MOM_domains, only: pass_var use mpp_domains_mod, only: mpp_get_compute_domain diff --git a/config_src/nuopc_driver/MOM_cap_time.F90 b/config_src/nuopc_driver/mom_cap_time.F90 similarity index 100% rename from config_src/nuopc_driver/MOM_cap_time.F90 rename to config_src/nuopc_driver/mom_cap_time.F90 diff --git a/config_src/nuopc_driver/MOM_NUOPC_ocean_model.F90 b/config_src/nuopc_driver/mom_ocean_model_nuopc.F90 similarity index 99% rename from config_src/nuopc_driver/MOM_NUOPC_ocean_model.F90 rename to config_src/nuopc_driver/mom_ocean_model_nuopc.F90 index 441674020c..95b1bcc6e3 100644 --- a/config_src/nuopc_driver/MOM_NUOPC_ocean_model.F90 +++ b/config_src/nuopc_driver/mom_ocean_model_nuopc.F90 @@ -1,5 +1,5 @@ !> Top-level module for the MOM6 ocean model in coupled mode. -module MOM_NUOPC_ocean_model +module MOM_ocean_model_nuopc ! This file is part of MOM6. See LICENSE.md for the license. @@ -58,10 +58,10 @@ module MOM_NUOPC_ocean_model use MOM_EOS, only : gsw_sp_from_sr, gsw_pt_from_ct use MOM_wave_interface, only: wave_parameters_CS, MOM_wave_interface_init use MOM_wave_interface, only: MOM_wave_interface_init_lite, Update_Surface_Waves -use MOM_NUOPC_surface_forcing, only : surface_forcing_init, convert_IOB_to_fluxes -use MOM_NUOPC_surface_forcing, only : convert_IOB_to_forces, ice_ocn_bnd_type_chksum -use MOM_NUOPC_surface_forcing, only : ice_ocean_boundary_type, surface_forcing_CS -use MOM_NUOPC_surface_forcing, only : forcing_save_restart +use MOM_surface_forcing_nuopc, only : surface_forcing_init, convert_IOB_to_fluxes +use MOM_surface_forcing_nuopc, only : convert_IOB_to_forces, ice_ocn_bnd_type_chksum +use MOM_surface_forcing_nuopc, only : ice_ocean_boundary_type, surface_forcing_CS +use MOM_surface_forcing_nuopc, only : forcing_save_restart #include @@ -475,7 +475,7 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & integer :: secs, days integer :: is, ie, js, je - call callTree_enter("update_ocean_model(), MOM_NUOPC_ocean_model.F90") + call callTree_enter("update_ocean_model(), MOM_ocean_model_nuopc.F90") call get_time(Ocean_coupling_time_step, secs, days) dt_coupling = 86400.0*real(days) + real(secs) @@ -1174,4 +1174,4 @@ subroutine get_ocean_grid(OS, Gridp) return end subroutine get_ocean_grid -end module MOM_NUOPC_ocean_model +end module MOM_ocean_model_nuopc diff --git a/config_src/nuopc_driver/MOM_NUOPC_surface_forcing.F90 b/config_src/nuopc_driver/mom_surface_forcing_nuopc.F90 similarity index 99% rename from config_src/nuopc_driver/MOM_NUOPC_surface_forcing.F90 rename to config_src/nuopc_driver/mom_surface_forcing_nuopc.F90 index b8e6adf11b..b6517de9e4 100644 --- a/config_src/nuopc_driver/MOM_NUOPC_surface_forcing.F90 +++ b/config_src/nuopc_driver/mom_surface_forcing_nuopc.F90 @@ -1,5 +1,5 @@ !> Converts the input ESMF data (import data) to a MOM-specific data type (surface_forcing_CS). -module MOM_NUOPC_surface_forcing +module MOM_surface_forcing_nuopc ! This file is part of MOM6. See LICENSE.md for the license. @@ -1011,7 +1011,7 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, restore_salt, 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" - character(len=40) :: mdl = "MOM_NUOPC_surface_forcing" ! This module's name. + character(len=40) :: mdl = "MOM_surface_forcing_nuopc" ! This module's name. character(len=48) :: stagger character(len=48) :: flnam character(len=240) :: basin_file @@ -1383,4 +1383,4 @@ subroutine ice_ocn_bnd_type_chksum(id, timestep, iobt) end subroutine ice_ocn_bnd_type_chksum -end module MOM_NUOPC_surface_forcing +end module MOM_surface_forcing_nuopc From a34bdf42b99307d4b11d9b56c937262cff2632f5 Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Tue, 30 Jul 2019 14:27:53 -0600 Subject: [PATCH 142/150] Capitalize MOM inside MCT modules --- config_src/mct_driver/mom_ocean_model_mct.F90 | 16 ++++++++-------- .../mct_driver/mom_surface_forcing_mct.F90 | 6 +++--- config_src/mct_driver/ocn_cap_methods.F90 | 4 ++-- config_src/mct_driver/ocn_comp_mct.F90 | 8 ++++---- 4 files changed, 17 insertions(+), 17 deletions(-) diff --git a/config_src/mct_driver/mom_ocean_model_mct.F90 b/config_src/mct_driver/mom_ocean_model_mct.F90 index 01c0b05cfc..ec894f1ebb 100644 --- a/config_src/mct_driver/mom_ocean_model_mct.F90 +++ b/config_src/mct_driver/mom_ocean_model_mct.F90 @@ -1,5 +1,5 @@ !> Top-level module for the MOM6 ocean model in coupled mode. -module mom_ocean_model_mct +module MOM_ocean_model_mct ! This file is part of MOM6. See LICENSE.md for the license. @@ -35,10 +35,10 @@ module mom_ocean_model_mct use MOM_marine_ice, only : iceberg_forces, iceberg_fluxes, marine_ice_init, marine_ice_CS use MOM_restart, only : MOM_restart_CS, save_restart use MOM_string_functions, only : uppercase -use mom_surface_forcing_mct, only : surface_forcing_init, convert_IOB_to_fluxes -use mom_surface_forcing_mct, only : convert_IOB_to_forces, ice_ocn_bnd_type_chksum -use mom_surface_forcing_mct, only : ice_ocean_boundary_type, surface_forcing_CS -use mom_surface_forcing_mct, only : forcing_save_restart +use MOM_surface_forcing_mct, only : surface_forcing_init, convert_IOB_to_fluxes +use MOM_surface_forcing_mct, only : convert_IOB_to_forces, ice_ocn_bnd_type_chksum +use MOM_surface_forcing_mct, only : ice_ocean_boundary_type, surface_forcing_CS +use MOM_surface_forcing_mct, only : forcing_save_restart use MOM_time_manager, only : time_type, get_time, set_time, operator(>) use MOM_time_manager, only : operator(+), operator(-), operator(*), operator(/) use MOM_time_manager, only : operator(/=), operator(<=), operator(>=) @@ -263,7 +263,7 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, gas_fields_ocn, i type(param_file_type) :: param_file !< A structure to parse for run-time parameters logical :: use_temperature - call callTree_enter("ocean_model_init(), mom_ocean_model_mct.F90") + call callTree_enter("ocean_model_init(), MOM_ocean_model_mct.F90") if (associated(OS)) then call MOM_error(WARNING, "ocean_model_init called with an associated "// & "ocean_state_type structure. Model is already initialized.") @@ -477,7 +477,7 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & integer :: secs, days integer :: is, ie, js, je - call callTree_enter("update_ocean_model(), mom_ocean_model_mct.F90") + call callTree_enter("update_ocean_model(), MOM_ocean_model_mct.F90") call get_time(Ocean_coupling_time_step, secs, days) dt_coupling = 86400.0*real(days) + real(secs) @@ -1187,4 +1187,4 @@ subroutine get_ocean_grid(OS, Gridp) return end subroutine get_ocean_grid -end module mom_ocean_model_mct +end module MOM_ocean_model_mct diff --git a/config_src/mct_driver/mom_surface_forcing_mct.F90 b/config_src/mct_driver/mom_surface_forcing_mct.F90 index aa13a80a34..dd26205866 100644 --- a/config_src/mct_driver/mom_surface_forcing_mct.F90 +++ b/config_src/mct_driver/mom_surface_forcing_mct.F90 @@ -1,4 +1,4 @@ -module mom_surface_forcing_mct +module MOM_surface_forcing_mct ! This file is part of MOM6. See LICENSE.md for the license. @@ -1006,7 +1006,7 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, restore_salt, 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" - character(len=40) :: mdl = "mom_surface_forcing_mct" ! This module's name. + character(len=40) :: mdl = "MOM_surface_forcing_mct" ! This module's name. character(len=48) :: stagger character(len=48) :: flnam character(len=240) :: basin_file @@ -1378,4 +1378,4 @@ subroutine ice_ocn_bnd_type_chksum(id, timestep, iobt) end subroutine ice_ocn_bnd_type_chksum -end module mom_surface_forcing_mct +end module MOM_surface_forcing_mct diff --git a/config_src/mct_driver/ocn_cap_methods.F90 b/config_src/mct_driver/ocn_cap_methods.F90 index c2a8183a7f..b42fa8ca7e 100644 --- a/config_src/mct_driver/ocn_cap_methods.F90 +++ b/config_src/mct_driver/ocn_cap_methods.F90 @@ -1,8 +1,8 @@ module ocn_cap_methods use ESMF, only: ESMF_clock, ESMF_time, ESMF_ClockGet, ESMF_TimeGet - use mom_ocean_model_mct, only: ocean_public_type, ocean_state_type - use mom_surface_forcing_mct, only: ice_ocean_boundary_type + use MOM_ocean_model_mct, only: ocean_public_type, ocean_state_type + use MOM_surface_forcing_mct, only: ice_ocean_boundary_type use MOM_grid, only: ocean_grid_type use MOM_domains, only: pass_var use MOM_error_handler, only: is_root_pe diff --git a/config_src/mct_driver/ocn_comp_mct.F90 b/config_src/mct_driver/ocn_comp_mct.F90 index 4cd3bac706..5b581e0427 100644 --- a/config_src/mct_driver/ocn_comp_mct.F90 +++ b/config_src/mct_driver/ocn_comp_mct.F90 @@ -44,10 +44,10 @@ module ocn_comp_mct use mpp_domains_mod, only: mpp_get_compute_domain ! Previously inlined - now in separate modules -use mom_ocean_model_mct, only: ocean_public_type, ocean_state_type -use mom_ocean_model_mct, only: ocean_model_init , update_ocean_model, ocean_model_end -use mom_ocean_model_mct, only: convert_state_to_ocean_type -use mom_surface_forcing_mct, only: surface_forcing_CS, forcing_save_restart, ice_ocean_boundary_type +use MOM_ocean_model_mct, only: ocean_public_type, ocean_state_type +use MOM_ocean_model_mct, only: ocean_model_init , update_ocean_model, ocean_model_end +use MOM_ocean_model_mct, only: convert_state_to_ocean_type +use MOM_surface_forcing_mct, only: surface_forcing_CS, forcing_save_restart, ice_ocean_boundary_type use ocn_cap_methods, only: ocn_import, ocn_export ! FMS modules From d292a5759f22e1ccb7ed7669c8bc77f34c294416 Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Tue, 30 Jul 2019 14:58:20 -0600 Subject: [PATCH 143/150] Deletes contribution from kv%slow when computing a_cpl --- .../vertical/MOM_vert_friction.F90 | 39 ------------------- 1 file changed, 39 deletions(-) diff --git a/src/parameterizations/vertical/MOM_vert_friction.F90 b/src/parameterizations/vertical/MOM_vert_friction.F90 index 31294778b4..14939dd823 100644 --- a/src/parameterizations/vertical/MOM_vert_friction.F90 +++ b/src/parameterizations/vertical/MOM_vert_friction.F90 @@ -1190,45 +1190,6 @@ subroutine find_coupling_coef(a_cpl, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, endif endif - ! add "slow" varying vertical viscosity (e.g., from background, tidal etc) - 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 - 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)) - 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 - 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 - 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) - endif ; enddo ; enddo - else - 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)) - endif ; enddo ; enddo - !### I am pretty sure that this is double counting here! - 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 - 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 - 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) - endif ; enddo ; enddo - endif - endif - do K=nz,2,-1 ; do i=is,ie ; if (do_i(i)) then ! botfn determines when a point is within the influence of the bottom ! boundary layer, going from 1 at the bottom to 0 in the interior. From 21fd4277c3da0f98848cb7238ecdb39f3e176f51 Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Tue, 30 Jul 2019 15:49:50 -0600 Subject: [PATCH 144/150] Make sure that MEKE%GME_snk is only used when the array is allocated --- src/parameterizations/lateral/MOM_hor_visc.F90 | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/src/parameterizations/lateral/MOM_hor_visc.F90 b/src/parameterizations/lateral/MOM_hor_visc.F90 index efba8e8e8d..3e7b027ae3 100644 --- a/src/parameterizations/lateral/MOM_hor_visc.F90 +++ b/src/parameterizations/lateral/MOM_hor_visc.F90 @@ -1288,8 +1288,12 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, if (k==1) then do j=js,je ; do i=is,ie MEKE%mom_src(i,j) = 0. - MEKE%GME_snk(i,j) = 0. enddo ; enddo + if (associated(MEKE%GME_snk)) then + do j=js,je ; do i=is,ie + MEKE%GME_snk(i,j) = 0. + enddo ; enddo + endif endif if (MEKE%backscatter_Ro_c /= 0.) then do j=js,je ; do i=is,ie From c56450a1675b4ddc531a7550d6ba4b1c54ea3eff Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Tue, 30 Jul 2019 15:52:41 -0600 Subject: [PATCH 145/150] Deletes all code related to Jansen15_drag --- src/parameterizations/lateral/MOM_MEKE.F90 | 75 +++++++--------------- 1 file changed, 24 insertions(+), 51 deletions(-) diff --git a/src/parameterizations/lateral/MOM_MEKE.F90 b/src/parameterizations/lateral/MOM_MEKE.F90 index a17bfc6aa9..8f947c4f68 100644 --- a/src/parameterizations/lateral/MOM_MEKE.F90 +++ b/src/parameterizations/lateral/MOM_MEKE.F90 @@ -43,7 +43,6 @@ module MOM_MEKE real :: MEKE_min_gamma!< Minimum value of gamma_b^2 allowed [nondim] real :: MEKE_Ct !< Coefficient in the \f$\gamma_{bt}\f$ expression [nondim] logical :: visc_drag !< If true use the vertvisc_type to calculate bottom drag. - logical :: Jansen15_drag !< If true use the bottom drag formulation from Jansen et al. (2015) logical :: MEKE_GEOMETRIC !< If true, uses the GM coefficient formulation from the GEOMETRIC !! framework (Marshall et al., 2012) logical :: GM_src_alt !< If true, use the GM energy conversion form S^2*N^2*kappa rather @@ -326,37 +325,22 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h if (use_drag_rate) then ! Calculate a viscous drag rate (includes BBL contributions from mean flow and eddies) !$OMP do - if (CS%Jansen15_drag) then - do j=js,je ; do i=is,ie - drag_rate(i,j) = (cdrag2/MAX(1.0,G%bathyT(i,j))) * sqrt(CS%MEKE_Uscale**2 + drag_rate_visc(i,j)**2 + & - 2.0*bottomFac2(i,j)*MEKE%MEKE(i,j)) * 2.0 * bottomFac2(i,j)*MEKE%MEKE(i,j) - enddo ; enddo - else - do j=js,je ; do i=is,ie - drag_rate(i,j) = (Rho0 * I_mass(i,j)) * sqrt( drag_rate_visc(i,j)**2 & - + cdrag2 * ( max(0.0, 2.0*bottomFac2(i,j)*MEKE%MEKE(i,j)) + CS%MEKE_Uscale**2 ) ) - enddo ; enddo - endif + do j=js,je ; do i=is,ie + drag_rate(i,j) = (Rho0 * I_mass(i,j)) * sqrt( drag_rate_visc(i,j)**2 & + + cdrag2 * ( max(0.0, 2.0*bottomFac2(i,j)*MEKE%MEKE(i,j)) + CS%MEKE_Uscale**2 ) ) + enddo ; enddo endif ! First stage of Strang splitting !$OMP do - if (CS%Jansen15_drag) then - do j=js,je ; do i=is,ie - ldamping = CS%MEKE_damping + drag_rate(i,j) - MEKE%MEKE(i,j) = MEKE%MEKE(i,j) - MIN(MEKE%MEKE(i,j),sdt_damp*drag_rate(i,j)) - MEKE_decay(i,j) = ldamping*G%mask2dT(i,j) - enddo ; enddo - else - do j=js,je ; do i=is,ie - ldamping = CS%MEKE_damping + drag_rate(i,j) * bottomFac2(i,j) - if (MEKE%MEKE(i,j)<0.) ldamping = 0. - ! notice that the above line ensures a damping only if MEKE is positive, - ! while leaving MEKE unchanged if it is negative - MEKE%MEKE(i,j) = MEKE%MEKE(i,j) / (1.0 + sdt_damp*ldamping) - MEKE_decay(i,j) = ldamping*G%mask2dT(i,j) - enddo ; enddo - endif + do j=js,je ; do i=is,ie + ldamping = CS%MEKE_damping + drag_rate(i,j) * bottomFac2(i,j) + if (MEKE%MEKE(i,j)<0.) ldamping = 0. + ! notice that the above line ensures a damping only if MEKE is positive, + ! while leaving MEKE unchanged if it is negative + MEKE%MEKE(i,j) = MEKE%MEKE(i,j) / (1.0 + sdt_damp*ldamping) + MEKE_decay(i,j) = ldamping*G%mask2dT(i,j) + enddo ; enddo !$OMP end parallel if (CS%MEKE_KH >= 0.0 .or. CS%KhMEKE_FAC > 0.0 .or. CS%MEKE_K4 >= 0.0) then ! Update halos for lateral or bi-harmonic diffusion @@ -502,26 +486,18 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h ! Recalculate the drag rate, since MEKE has changed. if (use_drag_rate) then !$OMP do - if (CS%Jansen15_drag) then - do j=js,je ; do i=is,ie - ldamping = CS%MEKE_damping + drag_rate(i,j) - MEKE%MEKE(i,j) = MEKE%MEKE(i,j) -sdt_damp*drag_rate(i,j) - MEKE_decay(i,j) = ldamping*G%mask2dT(i,j) - enddo ; enddo - else - do j=js,je ; do i=is,ie - drag_rate(i,j) = (Rho0 * I_mass(i,j)) * sqrt( drag_rate_visc(i,j)**2 & - + cdrag2 * ( max(0.0, 2.0*bottomFac2(i,j)*MEKE%MEKE(i,j)) + CS%MEKE_Uscale**2 ) ) - enddo ; enddo - do j=js,je ; do i=is,ie - ldamping = CS%MEKE_damping + drag_rate(i,j) * bottomFac2(i,j) - if (MEKE%MEKE(i,j)<0.) ldamping = 0. - ! notice that the above line ensures a damping only if MEKE is positive, - ! while leaving MEKE unchanged if it is negative - MEKE%MEKE(i,j) = MEKE%MEKE(i,j) / (1.0 + sdt_damp*ldamping) - MEKE_decay(i,j) = ldamping*G%mask2dT(i,j) - enddo ; enddo - endif + do j=js,je ; do i=is,ie + drag_rate(i,j) = (Rho0 * I_mass(i,j)) * sqrt( drag_rate_visc(i,j)**2 & + + cdrag2 * ( max(0.0, 2.0*bottomFac2(i,j)*MEKE%MEKE(i,j)) + CS%MEKE_Uscale**2 ) ) + enddo ; enddo + do j=js,je ; do i=is,ie + ldamping = CS%MEKE_damping + drag_rate(i,j) * bottomFac2(i,j) + if (MEKE%MEKE(i,j)<0.) ldamping = 0. + ! notice that the above line ensures a damping only if MEKE is positive, + ! while leaving MEKE unchanged if it is negative + MEKE%MEKE(i,j) = MEKE%MEKE(i,j) / (1.0 + sdt_damp*ldamping) + MEKE_decay(i,j) = ldamping*G%mask2dT(i,j) + enddo ; enddo endif !$OMP do endif @@ -1029,9 +1005,6 @@ logical function MEKE_init(Time, G, param_file, diag, CS, MEKE, restart_CS) call get_param(param_file, mdl, "MEKE_USCALE", CS%MEKE_Uscale, & "The background velocity that is combined with MEKE to "//& "calculate the bottom drag.", units="m s-1", default=0.0) - call get_param(param_file, mdl, "MEKE_JANSEN15_DRAG", CS%Jansen15_drag, & - "If true, use the bottom drag formulation from Jansen et al. (2015) "//& - "to calculate the drag acting on MEKE.", default=.false.) call get_param(param_file, mdl, "MEKE_GM_SRC_ALT", CS%GM_src_alt, & "If true, use the GM energy conversion form S^2*N^2*kappa rather "//& "than the streamfunction for the MEKE GM source term.", default=.false.) From 815db631e26a8ff2a5101059138ac02fac68379f Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Thu, 1 Aug 2019 15:43:30 -0600 Subject: [PATCH 146/150] Change default way to computing FrictWork in MEKE In the calculation of MEKE%mom_src, made the old method (using FrictWork) the default and made the new calculation of FrictWork only available when using GME. --- src/parameterizations/lateral/MOM_hor_visc.F90 | 10 ++++++++-- 1 file changed, 8 insertions(+), 2 deletions(-) diff --git a/src/parameterizations/lateral/MOM_hor_visc.F90 b/src/parameterizations/lateral/MOM_hor_visc.F90 index 3e7b027ae3..5a31405268 100644 --- a/src/parameterizations/lateral/MOM_hor_visc.F90 +++ b/src/parameterizations/lateral/MOM_hor_visc.F90 @@ -1325,12 +1325,18 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, (u(I,j,k)-u(I,j-1,k))*G%IdyBu(I,J-1) & +(v(i+1,J-1,k)-v(i,J-1,k))*G%IdxBu(I,J-1) )) ) ) enddo ; enddo - else + endif ! MEKE%backscatter + + if (CS%use_GME) then do j=js,je ; do i=is,ie ! MEKE%mom_src now is sign definite because it only uses the dissipation MEKE%mom_src(i,j) = MEKE%mom_src(i,j) + MAX(FrictWork_diss(i,j,k), FrictWorkMax(i,j,k)) enddo ; enddo - endif ! MEKE%backscatter + else + do j=js,je ; do i=is,ie + MEKE%mom_src(i,j) = MEKE%mom_src(i,j) + FrictWork(i,j,k) + enddo ; enddo + endif ! CS%use_GME if (CS%use_GME .and. associated(MEKE)) then if (associated(MEKE%GME_snk)) then From 954e6a954c148831f64aa0c2eedc23ed63b03523 Mon Sep 17 00:00:00 2001 From: Marshall Ward Date: Fri, 2 Aug 2019 13:45:42 -0400 Subject: [PATCH 147/150] Bugfix: diabatic_salt_tendency diagnostics in ALE The diabatic_salt_tendency and diabatic_salt_tendency_2d diagnostics relied on a scratch array (work_3d) which is only computed if diabatic_diff_saln_tendency is also enabled. If it is not set, then the array is filled with values from an older diagnostic (e.g. temperature tendency). We resolve this by computing the scratch array when any of the three diagnostics are enabled. Internal logic is used to determine whether or not to post the data. This resolves GitHub issue #968. Thanks to Graeme MacGilchrist (@gmacgilchrist) for reporting. --- .../vertical/MOM_diabatic_driver.F90 | 47 +++++++++++-------- 1 file changed, 27 insertions(+), 20 deletions(-) diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index e0df2f3c3f..989bb19ed2 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -2928,6 +2928,7 @@ subroutine diagnose_diabatic_diff_tendency(tv, h, temp_old, saln_old, dt, G, GV, real :: Idt ! The inverse of the timestep [s-1] real :: ppt2mks = 0.001 ! Conversion factor from g/kg to kg/kg. integer :: i, j, k, is, ie, js, je, nz + logical :: do_saln_tend ! Calculate salinity-based tendency diagnosics is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke Idt = 0.0 ; if (dt > 0.0) Idt = 1. / dt @@ -2963,29 +2964,35 @@ subroutine diagnose_diabatic_diff_tendency(tv, h, temp_old, saln_old, dt, G, GV, endif ! salinity tendency - if (CS%id_diabatic_diff_saln_tend > 0) then - do k=1,nz ; do j=js,je ; do i=is,ie - work_3d(i,j,k) = (tv%S(i,j,k)-saln_old(i,j,k))*Idt - enddo ; enddo ; enddo - call post_data(CS%id_diabatic_diff_saln_tend, work_3d, CS%diag, alt_h = h) - endif + do_saln_tend = CS%id_diabatic_diff_saln_tend > 0 & + .or. CS%id_diabatic_diff_salt_tend > 0 & + .or. CS%id_diabatic_diff_salt_tend_2d > 0 - ! salt tendency - if (CS%id_diabatic_diff_salt_tend > 0 .or. CS%id_diabatic_diff_salt_tend_2d > 0) then + if (do_saln_tend) then do k=1,nz ; do j=js,je ; do i=is,ie - work_3d(i,j,k) = h(i,j,k) * GV%H_to_kg_m2 * ppt2mks * work_3d(i,j,k) + work_3d(i,j,k) = (tv%S(i,j,k) - saln_old(i,j,k)) * Idt enddo ; enddo ; enddo - if (CS%id_diabatic_diff_salt_tend > 0) then - call post_data(CS%id_diabatic_diff_salt_tend, work_3d, CS%diag, alt_h = h) - endif - if (CS%id_diabatic_diff_salt_tend_2d > 0) then - do j=js,je ; do i=is,ie - work_2d(i,j) = 0.0 - do k=1,nz - work_2d(i,j) = work_2d(i,j) + work_3d(i,j,k) - enddo - enddo ; enddo - call post_data(CS%id_diabatic_diff_salt_tend_2d, work_2d, CS%diag) + + if (CS%id_diabatic_diff_saln_tend > 0) & + call post_data(CS%id_diabatic_diff_saln_tend, work_3d, CS%diag, alt_h=h) + + ! salt tendency + if (CS%id_diabatic_diff_salt_tend > 0 .or. CS%id_diabatic_diff_salt_tend_2d > 0) then + do k=1,nz ; do j=js,je ; do i=is,ie + work_3d(i,j,k) = h(i,j,k) * GV%H_to_kg_m2 * ppt2mks * work_3d(i,j,k) + enddo ; enddo ; enddo + if (CS%id_diabatic_diff_salt_tend > 0) then + call post_data(CS%id_diabatic_diff_salt_tend, work_3d, CS%diag, alt_h=h) + endif + if (CS%id_diabatic_diff_salt_tend_2d > 0) then + do j=js,je ; do i=is,ie + work_2d(i,j) = 0.0 + do k=1,nz + work_2d(i,j) = work_2d(i,j) + work_3d(i,j,k) + enddo + enddo ; enddo + call post_data(CS%id_diabatic_diff_salt_tend_2d, work_2d, CS%diag) + endif endif endif From 93794195538ec86547f62cb72498bde0f3677869 Mon Sep 17 00:00:00 2001 From: Kate Hedstrom Date: Thu, 15 Aug 2019 09:32:06 -0800 Subject: [PATCH 148/150] *Get rid of uninitialized cff variable in OBC. - Changes answers for oblique OBCs. --- src/core/MOM_open_boundary.F90 | 11 +++++------ 1 file changed, 5 insertions(+), 6 deletions(-) diff --git a/src/core/MOM_open_boundary.F90 b/src/core/MOM_open_boundary.F90 index 0ee1549a7a..be63881657 100644 --- a/src/core/MOM_open_boundary.F90 +++ b/src/core/MOM_open_boundary.F90 @@ -1533,7 +1533,7 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) real, intent(in) :: dt !< Appropriate timestep ! Local variables real :: dhdt, dhdx, dhdy, gamma_u, gamma_v, gamma_2 - real :: cff, Cx, Cy, tau + real :: Cx, Cy, tau real :: rx_max, ry_max ! coefficients for radiation real :: rx_new, rx_avg ! coefficients for radiation real :: ry_new, ry_avg ! coefficients for radiation @@ -1632,7 +1632,7 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) if (dhdt*dhdx < 0.0) dhdt = 0.0 rx_new = dhdt*dhdx cff_new = max(dhdx*dhdx + dhdy*dhdy, eps) - ry_new = min(cff,max(dhdt*dhdy,-cff)) + ry_new = min(cff_new,max(dhdt*dhdy,-cff_new)) rx_avg = (1.0-gamma_u)*segment%rx_normal(I,j,k) + gamma_u*rx_new ry_avg = (1.0-gamma_u)*segment%ry_normal(i,J,k) + gamma_u*ry_new cff_avg = (1.0-gamma_u)*segment%cff_normal(i,J,k) + gamma_u*cff_new @@ -1828,7 +1828,7 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) if (dhdt*dhdx < 0.0) dhdt = 0.0 rx_new = dhdt*dhdx cff_new = max(dhdx*dhdx + dhdy*dhdy, eps) - ry_new = min(cff,max(dhdt*dhdy,-cff)) + ry_new = min(cff_new,max(dhdt*dhdy,-cff_new)) rx_avg = (1.0-gamma_u)*segment%rx_normal(I,j,k) + gamma_u*rx_new ry_avg = (1.0-gamma_u)*segment%ry_normal(i,J,k) + gamma_u*ry_new cff_avg = (1.0-gamma_u)*segment%cff_normal(I,j,k) + gamma_u*cff_new @@ -2014,7 +2014,6 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) elseif (segment%oblique) then dhdt = v_old(i,J-1,k)-v_new(i,J-1,k) !old-new dhdy = v_new(i,J-1,k)-v_new(i,J-2,k) !in new time backward sasha for J-1 - segment%ry_normal(i,J,k) = ry_avg if (dhdt*(segment%grad_normal(I,1,k) + segment%grad_normal(I-1,1,k)) > 0.0) then dhdx = segment%grad_normal(I-1,1,k) elseif (dhdt*(segment%grad_normal(I,1,k) + segment%grad_normal(I-1,1,k)) == 0.0) then @@ -2025,7 +2024,7 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) if (dhdt*dhdy < 0.0) dhdt = 0.0 ry_new = dhdt*dhdy cff_new = max(dhdx*dhdx + dhdy*dhdy, eps) - rx_new = min(cff,max(dhdt*dhdx,-cff)) + rx_new = min(cff_new,max(dhdt*dhdx,-cff_new)) rx_avg = (1.0-gamma_u)*segment%rx_normal(I,j,k) + gamma_u*rx_new ry_avg = (1.0-gamma_u)*segment%ry_normal(i,J,k) + gamma_u*ry_new cff_avg = (1.0-gamma_u)*segment%cff_normal(i,J,k) + gamma_u*cff_new @@ -2221,7 +2220,7 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) if (dhdt*dhdy < 0.0) dhdt = 0.0 ry_new = dhdt*dhdy cff_new = max(dhdx*dhdx + dhdy*dhdy, eps) - rx_new = min(cff,max(dhdt*dhdx,-cff)) + rx_new = min(cff_new,max(dhdt*dhdx,-cff_new)) rx_avg = (1.0-gamma_u)*segment%rx_normal(I,j,k) + gamma_u*rx_new ry_avg = (1.0-gamma_u)*segment%ry_normal(i,J,k) + gamma_u*ry_new cff_avg = (1.0-gamma_u)*segment%cff_normal(i,J,k) + gamma_u*cff_new From 7c4cfa72899656f1924bc9467f7ef6aa5ad09b52 Mon Sep 17 00:00:00 2001 From: Kate Hedstrom Date: Fri, 16 Aug 2019 13:22:40 -0800 Subject: [PATCH 149/150] Allow dyed_obcs to be used with other OBC data inputs. --- src/core/MOM_open_boundary.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/core/MOM_open_boundary.F90 b/src/core/MOM_open_boundary.F90 index be63881657..74be948c8a 100644 --- a/src/core/MOM_open_boundary.F90 +++ b/src/core/MOM_open_boundary.F90 @@ -320,7 +320,7 @@ subroutine open_boundary_config(G, US, param_file, OBC) call get_param(param_file, mdl, "NK", OBC%ke, & "The number of model layers", default=0, do_not_log=.true.) - if (config1 /= "none") OBC%user_BCs_set_globally = .true. + if (config1 /= "none" .and. config1 /= "dyed_obcs") OBC%user_BCs_set_globally = .true. if (OBC%number_of_segments > 0) then call get_param(param_file, mdl, "OBC_ZERO_VORTICITY", OBC%zero_vorticity, & From 8cfac0f9a3be31c2fdd2f9d0846dc22fb9848e42 Mon Sep 17 00:00:00 2001 From: Kate Hedstrom Date: Sat, 17 Aug 2019 14:27:36 -0800 Subject: [PATCH 150/150] Trying to check to see that OBC data is there if needed. Not providing any at all will fail with: At line 1462 of file //import/c1/AKWATERS/kate/ESMG/ESMG-configs/src/MOM6/src/framework/MOM_file_parser.F90 Fortran runtime error: End of record --- src/core/MOM_open_boundary.F90 | 120 +++++++++++++++--- .../MOM_state_initialization.F90 | 5 + 2 files changed, 110 insertions(+), 15 deletions(-) diff --git a/src/core/MOM_open_boundary.F90 b/src/core/MOM_open_boundary.F90 index 74be948c8a..8310e22eee 100644 --- a/src/core/MOM_open_boundary.F90 +++ b/src/core/MOM_open_boundary.F90 @@ -124,7 +124,13 @@ module MOM_open_boundary logical :: specified_tan !< Boundary tangential velocity fixed to external value. logical :: open !< Boundary is open for continuity solver. logical :: gradient !< Zero gradient at boundary. - logical :: values_needed !< Whether or not external OBC fields are needed. + logical :: values_needed !< Whether or not any external OBC fields are needed. + logical :: u_values_needed!< Whether or not external u OBC fields are needed. + logical :: v_values_needed!< Whether or not external v OBC fields are needed. + logical :: t_values_needed!< Whether or not external T OBC fields are needed. + logical :: s_values_needed!< Whether or not external S OBC fields are needed. + logical :: z_values_needed!< Whether or not external zeta OBC fields are needed. + logical :: g_values_needed!< Whether or not external gradient OBC fields are needed. integer :: direction !< Boundary faces one of the four directions. logical :: is_N_or_S !< True is the OB is facing North or South and exists on this PE. logical :: is_E_or_W !< True is the OB is facing East or West and exists on this PE. @@ -418,12 +424,18 @@ subroutine open_boundary_config(G, US, param_file, OBC) OBC%segment(l)%open = .false. OBC%segment(l)%gradient = .false. OBC%segment(l)%values_needed = .false. + OBC%segment(l)%u_values_needed = .false. + OBC%segment(l)%v_values_needed = .false. + OBC%segment(l)%t_values_needed = .false. + OBC%segment(l)%s_values_needed = .false. + OBC%segment(l)%z_values_needed = .false. + OBC%segment(l)%g_values_needed = .false. OBC%segment(l)%direction = OBC_NONE OBC%segment(l)%is_N_or_S = .false. OBC%segment(l)%is_E_or_W = .false. OBC%segment(l)%Velocity_nudging_timescale_in = 0.0 OBC%segment(l)%Velocity_nudging_timescale_out = 0.0 - OBC%segment(l)%num_fields = 0.0 + OBC%segment(l)%num_fields = 0 enddo allocate(OBC%segnum_u(G%IsdB:G%IedB,G%jsd:G%jed)) ; OBC%segnum_u(:,:) = OBC_NONE allocate(OBC%segnum_v(G%isd:G%ied,G%JsdB:G%JedB)) ; OBC%segnum_v(:,:) = OBC_NONE @@ -526,6 +538,7 @@ subroutine initialize_segment_data(G, OBC, PF) character(len=128) :: inputdir type(OBC_segment_type), pointer :: segment => NULL() ! pointer to segment type list character(len=32) :: remappingScheme + character(len=256) :: mesg ! Message for error messages. logical :: check_reconstruction, check_remapping, force_bounds_in_subcell integer, dimension(4) :: siz,siz2 integer :: is, ie, js, je @@ -591,6 +604,7 @@ subroutine initialize_segment_data(G, OBC, PF) do n=1, OBC%number_of_segments segment => OBC%segment(n) + if (.not. segment%values_needed) cycle write(segnam,"('OBC_SEGMENT_',i3.3,'_DATA')") n write(suffix,"('_segment_',i3.3)") n @@ -607,12 +621,13 @@ subroutine initialize_segment_data(G, OBC, PF) allocate(segment%field(num_fields)) - if (segment%Flather) then - if (num_fields < 3) call MOM_error(FATAL, & - "MOM_open_boundary, initialize_segment_data: "//& - "Need at least three inputs for Flather") - endif - segment%num_fields = num_fields ! these are at least three input fields required for the Flather option +! This should be happening with the x_values_needed. +! if (segment%Flather) then +! if (num_fields < 3) call MOM_error(FATAL, & +! "MOM_open_boundary, initialize_segment_data: "//& +! "Need at least three inputs for Flather") +! endif + segment%num_fields = num_fields segment%temp_segment_data_exists=.false. segment%salt_segment_data_exists=.false. @@ -630,16 +645,20 @@ subroutine initialize_segment_data(G, OBC, PF) if (trim(filename) /= 'none') then OBC%update_OBC = .true. ! Data is assumed to be time-dependent if we are reading from file OBC%needs_IO_for_data = .true. ! At least one segment is using I/O for OBC data - segment%values_needed = .true. ! Indicates that i/o will be needed for this segment +! segment%values_needed = .true. ! Indicates that i/o will be needed for this segment segment%field(m)%name = trim(fields(m)) - if (segment%field(m)%name == 'TEMP') & + if (segment%field(m)%name == 'TEMP') then segment%temp_segment_data_exists=.true. - if (segment%field(m)%name == 'SALT') & + segment%t_values_needed = .false. + endif + if (segment%field(m)%name == 'SALT') then segment%salt_segment_data_exists=.true. + segment%s_values_needed = .false. + endif filename = trim(inputdir)//trim(filename) fieldname = trim(fieldname)//trim(suffix) call field_size(filename,fieldname,siz,no_domain=.true.) - if (siz(4) == 1) segment%values_needed = .false. +! if (siz(4) == 1) segment%values_needed = .false. if (segment%on_pe) then if (OBC%brushcutter_mode .and. (modulo(siz(1),2) == 0 .or. modulo(siz(2),2) == 0)) then call MOM_error(FATAL,'segment data are not on the supergrid') @@ -664,16 +683,42 @@ subroutine initialize_segment_data(G, OBC, PF) siz2(3)=siz(3) if (segment%is_E_or_W) then - if (segment%field(m)%name == 'V' .or. segment%field(m)%name == 'DVDX') then + if (segment%field(m)%name == 'V') then allocate(segment%field(m)%buffer_src(IsdB:IedB,JsdB:JedB,siz2(3))) + segment%v_values_needed = .false. + else if (segment%field(m)%name == 'DVDX') then + allocate(segment%field(m)%buffer_src(IsdB:IedB,JsdB:JedB,siz2(3))) + segment%g_values_needed = .false. else allocate(segment%field(m)%buffer_src(IsdB:IedB,jsd:jed,siz2(3))) + if (segment%field(m)%name == 'U') then + segment%u_values_needed = .false. + else if (segment%field(m)%name == 'SSH') then + segment%z_values_needed = .false. + else if (segment%field(m)%name == 'TEMP') then + segment%t_values_needed = .false. + else if (segment%field(m)%name == 'SALT') then + segment%s_values_needed = .false. + endif endif else - if (segment%field(m)%name == 'U' .or. segment%field(m)%name == 'DUDY') then + if (segment%field(m)%name == 'U') then allocate(segment%field(m)%buffer_src(IsdB:IedB,JsdB:JedB,siz2(3))) + segment%u_values_needed = .false. + else if (segment%field(m)%name == 'DUDY') then + allocate(segment%field(m)%buffer_src(IsdB:IedB,JsdB:JedB,siz2(3))) + segment%g_values_needed = .false. else allocate(segment%field(m)%buffer_src(isd:ied,JsdB:JedB,siz2(3))) + if (segment%field(m)%name == 'V') then + segment%v_values_needed = .false. + else if (segment%field(m)%name == 'SSH') then + segment%z_values_needed = .false. + else if (segment%field(m)%name == 'TEMP') then + segment%t_values_needed = .false. + else if (segment%field(m)%name == 'SALT') then + segment%s_values_needed = .false. + endif endif endif segment%field(m)%buffer_src(:,:,:)=0.0 @@ -706,8 +751,29 @@ subroutine initialize_segment_data(G, OBC, PF) else segment%field(m)%fid = -1 segment%field(m)%value = value + segment%field(m)%name = trim(fields(m)) + if (segment%field(m)%name == 'U') then + segment%u_values_needed = .false. + elseif (segment%field(m)%name == 'V') then + segment%v_values_needed = .false. + elseif (segment%field(m)%name == 'SSH') then + segment%z_values_needed = .false. + elseif (segment%field(m)%name == 'TEMP') then + segment%t_values_needed = .false. + elseif (segment%field(m)%name == 'SALT') then + segment%s_values_needed = .false. + elseif (segment%field(m)%name == 'DVDX' .or. segment%field(m)%name == 'DUDY') then + segment%g_values_needed = .false. + endif endif enddo + if (segment%u_values_needed .or. segment%v_values_needed .or. & + segment%t_values_needed .or. segment%s_values_needed .or. & + segment%z_values_needed .or. segment%g_values_needed) then + write(mesg,'("Values needed for OBC segment ",I3)') n +! call MOM_error(FATAL, mesg) + call MOM_error(WARNING, mesg) + endif enddo call mpp_set_current_pelist(saved_pelist) @@ -814,6 +880,8 @@ subroutine setup_u_point_obc(OBC, G, segment_str, l_seg, PF, reentrant_y) OBC%segment(l_seg)%open = .true. OBC%Flather_u_BCs_exist_globally = .true. OBC%open_u_BCs_exist_globally = .true. + OBC%segment%z_values_needed = .true. + OBC%segment%u_values_needed = .true. elseif (trim(action_str(a_loop)) == 'ORLANSKI') then OBC%segment(l_seg)%radiation = .true. OBC%segment(l_seg)%open = .true. @@ -841,11 +909,14 @@ subroutine setup_u_point_obc(OBC, G, segment_str, l_seg, PF, reentrant_y) elseif (trim(action_str(a_loop)) == 'NUDGED') then OBC%segment(l_seg)%nudged = .true. OBC%nudged_u_BCs_exist_globally = .true. + OBC%segment%u_values_needed = .true. elseif (trim(action_str(a_loop)) == 'NUDGED_TAN') then OBC%segment(l_seg)%nudged_tan = .true. OBC%nudged_u_BCs_exist_globally = .true. + OBC%segment%v_values_needed = .true. elseif (trim(action_str(a_loop)) == 'NUDGED_GRAD') then OBC%segment(l_seg)%nudged_grad = .true. + OBC%segment%g_values_needed = .true. elseif (trim(action_str(a_loop)) == 'GRADIENT') then OBC%segment(l_seg)%gradient = .true. OBC%segment(l_seg)%open = .true. @@ -853,6 +924,7 @@ subroutine setup_u_point_obc(OBC, G, segment_str, l_seg, PF, reentrant_y) elseif (trim(action_str(a_loop)) == 'SIMPLE') then OBC%segment(l_seg)%specified = .true. OBC%specified_u_BCs_exist_globally = .true. ! This avoids deallocation + OBC%segment%u_values_needed = .true. elseif (trim(action_str(a_loop)) == 'SIMPLE_TAN') then OBC%segment(l_seg)%specified_tan = .true. else @@ -895,6 +967,10 @@ subroutine setup_u_point_obc(OBC, G, segment_str, l_seg, PF, reentrant_y) call MOM_error(FATAL, "MOM_open_boundary.F90, setup_u_point_obc: \n"//& "Orlanski and Oblique OBC options cannot be used together on one segment.") + if (OBC%segment(l_seg)%u_values_needed .or. OBC%segment(l_seg)%v_values_needed .or. & + OBC%segment(l_seg)%t_values_needed .or. OBC%segment(l_seg)%s_values_needed .or. & + OBC%segment(l_seg)%z_values_needed .or. OBC%segment(l_seg)%g_values_needed) & + OBC%segment(l_seg)%values_needed = .true. end subroutine setup_u_point_obc !> Parse an OBC_SEGMENT_%%% string starting with "J=" and configure placement and type of OBC accordingly @@ -938,6 +1014,8 @@ subroutine setup_v_point_obc(OBC, G, segment_str, l_seg, PF, reentrant_x) OBC%segment(l_seg)%open = .true. OBC%Flather_v_BCs_exist_globally = .true. OBC%open_v_BCs_exist_globally = .true. + OBC%segment%z_values_needed = .true. + OBC%segment%v_values_needed = .true. elseif (trim(action_str(a_loop)) == 'ORLANSKI') then OBC%segment(l_seg)%radiation = .true. OBC%segment(l_seg)%open = .true. @@ -965,11 +1043,14 @@ subroutine setup_v_point_obc(OBC, G, segment_str, l_seg, PF, reentrant_x) elseif (trim(action_str(a_loop)) == 'NUDGED') then OBC%segment(l_seg)%nudged = .true. OBC%nudged_v_BCs_exist_globally = .true. + OBC%segment%v_values_needed = .true. elseif (trim(action_str(a_loop)) == 'NUDGED_TAN') then OBC%segment(l_seg)%nudged_tan = .true. OBC%nudged_v_BCs_exist_globally = .true. + OBC%segment%u_values_needed = .true. elseif (trim(action_str(a_loop)) == 'NUDGED_GRAD') then OBC%segment(l_seg)%nudged_grad = .true. + OBC%segment%g_values_needed = .true. elseif (trim(action_str(a_loop)) == 'GRADIENT') then OBC%segment(l_seg)%gradient = .true. OBC%segment(l_seg)%open = .true. @@ -977,6 +1058,7 @@ subroutine setup_v_point_obc(OBC, G, segment_str, l_seg, PF, reentrant_x) elseif (trim(action_str(a_loop)) == 'SIMPLE') then OBC%segment(l_seg)%specified = .true. OBC%specified_v_BCs_exist_globally = .true. ! This avoids deallocation + OBC%segment%v_values_needed = .true. elseif (trim(action_str(a_loop)) == 'SIMPLE_TAN') then OBC%segment(l_seg)%specified_tan = .true. else @@ -1019,6 +1101,10 @@ subroutine setup_v_point_obc(OBC, G, segment_str, l_seg, PF, reentrant_x) call MOM_error(FATAL, "MOM_open_boundary.F90, setup_v_point_obc: \n"//& "Orlanski and Oblique OBC options cannot be used together on one segment.") + if (OBC%segment(l_seg)%u_values_needed .or. OBC%segment(l_seg)%v_values_needed .or. & + OBC%segment(l_seg)%t_values_needed .or. OBC%segment(l_seg)%s_values_needed .or. & + OBC%segment(l_seg)%z_values_needed .or. OBC%segment(l_seg)%g_values_needed) & + OBC%segment(l_seg)%values_needed = .true. end subroutine setup_v_point_obc !> Parse an OBC_SEGMENT_%%% string @@ -2919,7 +3005,7 @@ end subroutine open_boundary_test_extern_h subroutine update_OBC_segment_data(G, GV, US, OBC, tv, h, Time) type(ocean_grid_type), intent(in) :: 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 + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(ocean_OBC_type), pointer :: OBC !< Open boundary structure type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamics structure real, dimension(SZI_(G),SZJ_(G), SZK_(G)), intent(inout) :: h !< Thickness [m] @@ -3251,6 +3337,8 @@ subroutine update_OBC_segment_data(G, GV, US, OBC, tv, h, Time) allocate(segment%field(m)%bt_vel(is_obc:ie_obc,js_obc+1:je_obc)) elseif (segment%field(m)%name == 'DVDX') then allocate(segment%field(m)%buffer_dst(is_obc:ie_obc,js_obc:je_obc,G%ke)) + elseif (segment%field(m)%name == 'SSH') then + allocate(segment%field(m)%buffer_dst(is_obc:ie_obc,js_obc:je_obc,1)) else allocate(segment%field(m)%buffer_dst(is_obc:ie_obc,js_obc+1:je_obc,G%ke)) endif @@ -3263,6 +3351,8 @@ subroutine update_OBC_segment_data(G, GV, US, OBC, tv, h, Time) allocate(segment%field(m)%bt_vel(is_obc+1:ie_obc,js_obc:je_obc)) elseif (segment%field(m)%name == 'DUDY') then allocate(segment%field(m)%buffer_dst(is_obc:ie_obc,js_obc:je_obc,G%ke)) + elseif (segment%field(m)%name == 'SSH') then + allocate(segment%field(m)%buffer_dst(is_obc:ie_obc,js_obc:je_obc,1)) else allocate(segment%field(m)%buffer_dst(is_obc+1:ie_obc,js_obc:je_obc,G%ke)) endif diff --git a/src/initialization/MOM_state_initialization.F90 b/src/initialization/MOM_state_initialization.F90 index 60d8c4b0d0..bb89b8b41b 100644 --- a/src/initialization/MOM_state_initialization.F90 +++ b/src/initialization/MOM_state_initialization.F90 @@ -26,6 +26,7 @@ module MOM_state_initialization use MOM_open_boundary, only : set_tracer_data use MOM_open_boundary, only : open_boundary_test_extern_h use MOM_open_boundary, only : fill_temp_salt_segments +use MOM_open_boundary, only : update_OBC_segment_data !use MOM_open_boundary, only : set_3D_OBC_data use MOM_grid_initialize, only : initialize_masks, set_grid_metrics use MOM_restart, only : restore_state, determine_is_new_run, MOM_restart_CS @@ -557,6 +558,10 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, US, PF, dirs, & ! This controls user code for setting open boundary data if (associated(OBC)) then + ! Call this once to fill boundary arrays from fixed values + if (.not. OBC%needs_IO_for_data) & + call update_OBC_segment_data(G, GV, US, OBC, tv, h, Time) + call get_param(PF, mdl, "OBC_USER_CONFIG", config, & "A string that sets how the user code is invoked to set open boundary data: \n"//& " DOME - specified inflow on northern boundary\n"//&