From ea57802abffc16fb444196d4f6f6c4630a17a590 Mon Sep 17 00:00:00 2001 From: Brandon Reichl Date: Fri, 24 May 2019 10:15:10 -0400 Subject: [PATCH 001/297] 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/297] 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/297] 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/297] +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/297] 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/297] 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/297] 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/297] 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/297] 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/297] 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/297] 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/297] +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/297] +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/297] 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/297] +(*)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/297] +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/297] 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/297] +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/297] 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/297] 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/297] +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/297] +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/297] +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/297] +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/297] * 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/297] +Added ML_RAD_BUG and SET_DIFF_2018_ANSWERS Added a two new runtime parameters, ML_RAD_BUG and SET_DIFF_2018_ANSWERS, to correct a bug in the calculation of the TKE available to drive mixing with the ML_RADIATION scheme, and to avoid the redundant calculation mathematically equivalent expressions via direct division or multiplication by a reciprocal in find_TKE_to_Kd. Also corrected a vertical loop extent in legacy_diabatic, with no apparent consequences. Answers change slightly in some test cases when SET_DIFF_2018_ANSWERS is set to false, and more substantially when ML_RADIATION is true and ML_RAD_BUG is false. By default all answers are bitwise identical, but the MOM_parameter_doc.all files have a new entry. --- .../vertical/MOM_diabatic_driver.F90 | 10 ++-- .../vertical/MOM_set_diffusivity.F90 | 54 ++++++++++++++----- 2 files changed, 43 insertions(+), 21 deletions(-) diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index e21192bfae..f09f8745c7 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -1561,14 +1561,10 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en if (CS%use_CVMix_conv) then call calculate_CVMix_conv(h, tv, G, GV, US, CS%CVMix_conv_csp, Hml) - !!!!!!!! GMM, the following needs to be checked !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - !### The vertical extent here is more limited that Kv_slow or Kd_int; it might be k=1,nz+1. - do k=1,nz ; do j=js,je ; do i=is,ie - Kd_int(i,j,K) = Kd_int(i,j,K) + US%T_to_s * CS%CVMix_conv_csp%kd_conv(i,j,k) - visc%Kv_slow(i,j,k) = visc%Kv_slow(i,j,k) + CS%CVMix_conv_csp%kv_conv(i,j,k) + do K=1,nz+1 ; do j=js,je ; do i=is,ie + Kd_int(i,j,K) = Kd_int(i,j,K) + US%T_to_s * CS%CVMix_conv_csp%kd_conv(i,j,K) + visc%Kv_slow(i,j,K) = visc%Kv_slow(i,j,K) + CS%CVMix_conv_csp%kv_conv(i,j,K) enddo ; enddo ; enddo - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - endif if (CS%useKPP) then diff --git a/src/parameterizations/vertical/MOM_set_diffusivity.F90 b/src/parameterizations/vertical/MOM_set_diffusivity.F90 index aa843e3ad5..6dd01eaa93 100644 --- a/src/parameterizations/vertical/MOM_set_diffusivity.F90 +++ b/src/parameterizations/vertical/MOM_set_diffusivity.F90 @@ -113,6 +113,9 @@ module MOM_set_diffusivity real :: ML_rad_coeff !< coefficient, which scales MSTAR*USTAR^3 to !! obtain energy available for mixing below !! mixed layer base [nondim] + logical :: ML_rad_bug !< If true use code with a bug that reduces the energy available + !! in the transition layer by a factor of the inverse of the energy + !! deposition lenthscale (in m). logical :: ML_rad_TKE_decay !< If true, apply same exponential decay !! to ML_rad as applied to the other surface !! sources of TKE in the mixed layer code. @@ -143,6 +146,10 @@ module MOM_set_diffusivity real :: Max_salt_diff_salt_fingers !< max salt diffusivity for salt fingers [Z2 T-1 ~> m2 s-1] real :: Kv_molecular !< molecular visc for double diff convect [Z2 T-1 ~> m2 s-1] + logical :: answers_2018 !< If true, use the order of arithmetic and expressions that recover the + !! answers from the end of 2018. Otherwise, use updated and more robust + !! forms of the same expressions. + character(len=200) :: inputdir !< The directory in which input files are found type(user_change_diff_CS), pointer :: user_change_diff_CSp => NULL() !< Control structure for a child module type(Kappa_shear_CS), pointer :: kappaShear_CSp => NULL() !< Control structure for a child module @@ -667,8 +674,8 @@ subroutine find_TKE_to_Kd(h, tv, dRho_int, N2_lay, j, dt, G, GV, US, CS, & ! above or below [Z ~> m]. real :: dRho_lay ! density change across a layer [kg m-3] real :: Omega2 ! rotation rate squared [T-2 ~> s-2] - real :: G_Rho0 ! gravitation accel divided by Bouss ref density [m4 T-2 kg-1 -> m4 s-2 kg-1] - real :: G_IRho0 ! ### Alternate calculation of G_Rho0 for reproducibility + real :: G_Rho0 ! gravitation accel divided by Bouss ref density [Z m3 T-2 kg-1 -> m4 s-2 kg-1] + real :: G_IRho0 ! Alternate calculation of G_Rho0 for reproducibility [Z m3 T-2 kg-1 -> m4 s-2 kg-1] real :: I_Rho0 ! inverse of Boussinesq reference density [m3 kg-1] real :: I_dt ! 1/dt [T-1] real :: H_neglect ! negligibly small thickness [H ~> m or kg m-2] @@ -681,12 +688,13 @@ subroutine find_TKE_to_Kd(h, tv, dRho_int, N2_lay, j, dt, G, GV, US, CS, & I_dt = 1.0 / dt Omega2 = CS%omega**2 H_neglect = GV%H_subroundoff - ! ### G_Rho0 and G_IRho0 are mathematically identical but give different - ! numerical values. We compute both values for now, but they should be - ! consolidated at some point. G_Rho0 = (GV%g_Earth * US%m_to_Z**2 * US%T_to_s**2) / GV%Rho0 - I_Rho0 = 1.0 / GV%Rho0 - G_IRho0 = (GV%g_Earth * US%m_to_Z**2 * US%T_to_s**2) * I_Rho0 + if (CS%answers_2018) then + I_Rho0 = 1.0 / GV%Rho0 + G_IRho0 = (GV%g_Earth * US%m_to_Z**2 * US%T_to_s**2) * I_Rho0 + else + G_IRho0 = G_Rho0 + endif ! Simple but coordinate-independent estimate of Kd/TKE if (CS%simple_TKE_to_Kd) then @@ -1584,14 +1592,23 @@ subroutine add_MLrad_diffusivity(h, fluxes, j, G, GV, US, CS, Kd_lay, TKE_to_Kd, do_any = .false. do i=is,ie ; if (do_i(i)) then dzL = GV%H_to_Z*h(i,j,k) ; z1 = dzL*I_decay(i) - if (z1 > 1e-5) then - !### I think that this might be dimensionally inconsistent, but untested. -RWH - Kd_mlr = (TKE_ml_flux(i) * TKE_to_Kd(i,k)) * & ! Units of Z2 T-1 ? - US%m_to_Z * ((1.0 - exp(-z1)) / dzL) ! Units of m-1 ? + if (CS%ML_Rad_bug) then + !### These expresssions are dimensionally inconsistent. -RWH + ! This is supposed to be the integrated energy deposited in the layer, + ! not the average over the layer as in these expressions. + if (z1 > 1e-5) then + Kd_mlr = (TKE_ml_flux(i) * TKE_to_Kd(i,k)) * & ! Units of Z2 T-1 + US%m_to_Z * ((1.0 - exp(-z1)) / dzL) ! Units of m-1 + else + Kd_mlr = (TKE_ml_flux(i) * TKE_to_Kd(i,k)) * & ! Units of Z2 T-1 + US%m_to_Z * (I_decay(i) * (1.0 - z1 * (0.5 - C1_6*z1))) ! Units of m-1 + endif else - !### I think that this might be dimensionally inconsistent, but untested. -RWH - Kd_mlr = (TKE_ml_flux(i) * TKE_to_Kd(i,k)) * & ! Units of Z2 T-1 ? - US%m_to_Z * (I_decay(i) * (1.0 - z1 * (0.5 - C1_6*z1))) ! Units of m-1 ? + if (z1 > 1e-5) then + Kd_mlr = (TKE_ml_flux(i) * TKE_to_Kd(i,k)) * (1.0 - exp(-z1)) + else + Kd_mlr = (TKE_ml_flux(i) * TKE_to_Kd(i,k)) * (z1 * (1.0 - z1 * (0.5 - C1_6*z1))) + endif endif Kd_mlr = min(Kd_mlr, CS%ML_rad_kd_max) Kd_lay(i,j,k) = Kd_lay(i,j,k) + Kd_mlr @@ -1916,6 +1933,11 @@ subroutine set_diffusivity_init(Time, G, GV, US, param_file, diag, CS, int_tide_ "The rotation rate of the earth.", units="s-1", & default=7.2921e-5, scale=US%T_to_s) + call get_param(param_file, mdl, "SET_DIFF_2018_ANSWERS", CS%answers_2018, & + "If true, use the order of arithmetic and expressions that recover the "//& + "answers from the end of 2018. Otherwise, use updated and more robust "//& + "forms of the same expressions.", default=.true.) + call get_param(param_file, mdl, "ML_RADIATION", CS%ML_radiation, & "If true, allow a fraction of TKE available from wind "//& "work to penetrate below the base of the mixed layer "//& @@ -1931,6 +1953,10 @@ subroutine set_diffusivity_init(Time, G, GV, US, param_file, diag, CS, int_tide_ "depth for turbulence below the base of the mixed layer. "//& "This is only used if ML_RADIATION is true.", units="nondim", & default=0.2) + call get_param(param_file, mdl, "ML_RAD_BUG", CS%ML_rad_bug, & + "If true use code with a bug that reduces the energy available "//& + "in the transition layer by a factor of the inverse of the energy "//& + "deposition lenthscale (in m).", default=.true.) call get_param(param_file, mdl, "ML_RAD_KD_MAX", CS%ML_rad_kd_max, & "The maximum diapycnal diffusivity due to turbulence "//& "radiated from the base of the mixed layer. "//& From eb5f06c20f7a1d36ab35aa07d733937c8bfe7f09 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Fri, 21 Jun 2019 11:51:34 -0400 Subject: [PATCH 027/297] +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 028/297] +Added dimensional testing for diffusivities Added rescaling of time units for dimensional consistency testing of diffusivities for heat and salt, including the values returned from CVMix_KPP. All answers are bitwise identical. --- .../vertical/MOM_CVMix_KPP.F90 | 26 ++--- .../vertical/MOM_diabatic_driver.F90 | 102 +++++++++--------- 2 files changed, 64 insertions(+), 64 deletions(-) diff --git a/src/parameterizations/vertical/MOM_CVMix_KPP.F90 b/src/parameterizations/vertical/MOM_CVMix_KPP.F90 index 06494528e1..10ff57f528 100644 --- a/src/parameterizations/vertical/MOM_CVMix_KPP.F90 +++ b/src/parameterizations/vertical/MOM_CVMix_KPP.F90 @@ -499,7 +499,7 @@ logical function KPP_init(paramFile, G, GV, US, diag, Time, CS, passive, Waves) CS%id_Kt_KPP = register_diag_field('ocean_model', 'KPP_Kheat', diag%axesTi, Time, & 'Heat diffusivity due to KPP, as calculated by [CVMix] KPP', 'm2/s') CS%id_Kd_in = register_diag_field('ocean_model', 'KPP_Kd_in', diag%axesTi, Time, & - 'Diffusivity passed to KPP', 'm2/s', conversion=US%Z_to_m**2) + 'Diffusivity passed to KPP', 'm2/s', conversion=US%Z2_T_to_m2_s) CS%id_Ks_KPP = register_diag_field('ocean_model', 'KPP_Ksalt', diag%axesTi, Time, & 'Salt diffusivity due to KPP, as calculated by [CVMix] KPP', 'm2/s') CS%id_Kv_KPP = register_diag_field('ocean_model', 'KPP_Kv', diag%axesTi, Time, & @@ -594,10 +594,10 @@ subroutine KPP_calculate(CS, G, GV, US, h, uStar, & real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(in) :: buoyFlux !< Surface buoyancy flux [m2 s-3] real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(inout) :: Kt !< (in) Vertical diffusivity of heat w/o KPP !! (out) Vertical diffusivity including KPP - !! [Z2 s-1 ~> m2 s-1] + !! [Z2 T-1 ~> m2 s-1] real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(inout) :: Ks !< (in) Vertical diffusivity of salt w/o KPP !! (out) Vertical diffusivity including KPP - !! [Z2 s-1 ~> m2 s-1] + !! [Z2 T-1 ~> m2 s-1] real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(inout) :: Kv !< (in) Vertical viscosity w/o KPP !! (out) Vertical viscosity including KPP !! [Z2 s-1 ~> m2 s-1] @@ -626,8 +626,8 @@ subroutine KPP_calculate(CS, G, GV, US, h, uStar, & call hchksum(h, "KPP in: h",G%HI,haloshift=0, scale=GV%H_to_m) call hchksum(uStar, "KPP in: uStar",G%HI,haloshift=0, scale=US%Z_to_m) call hchksum(buoyFlux, "KPP in: buoyFlux",G%HI,haloshift=0) - call hchksum(Kt, "KPP in: Kt",G%HI,haloshift=0, scale=US%Z_to_m**2) - call hchksum(Ks, "KPP in: Ks",G%HI,haloshift=0, scale=US%Z_to_m**2) + call hchksum(Kt, "KPP in: Kt",G%HI,haloshift=0, scale=US%Z2_T_to_m2_s) + call hchksum(Ks, "KPP in: Ks",G%HI,haloshift=0, scale=US%Z2_T_to_m2_s) endif #endif @@ -683,8 +683,8 @@ subroutine KPP_calculate(CS, G, GV, US, h, uStar, & Kdiffusivity(:,:) = 0. ! Diffusivities for heat and salt [m2 s-1] Kviscosity(:) = 0. ! Viscosity [m2 s-1] else - Kdiffusivity(:,1) = US%Z_to_m**2 * Kt(i,j,:) - Kdiffusivity(:,2) = US%Z_to_m**2 * Ks(i,j,:) + Kdiffusivity(:,1) = US%Z_to_m**2*US%T_to_s * Kt(i,j,:) + Kdiffusivity(:,2) = US%Z_to_m**2*US%T_to_s * Ks(i,j,:) Kviscosity(:) = US%Z_to_m**2 * Kv(i,j,:) endif @@ -828,15 +828,15 @@ subroutine KPP_calculate(CS, G, GV, US, h, uStar, & if (.not. CS%passiveMode) then if (CS%KPPisAdditive) then do k=1, G%ke+1 - Kt(i,j,k) = Kt(i,j,k) + US%m_to_Z**2 * Kdiffusivity(k,1) - Ks(i,j,k) = Ks(i,j,k) + US%m_to_Z**2 * Kdiffusivity(k,2) + Kt(i,j,k) = Kt(i,j,k) + US%m2_s_to_Z2_T * Kdiffusivity(k,1) + Ks(i,j,k) = Ks(i,j,k) + US%m2_s_to_Z2_T * Kdiffusivity(k,2) Kv(i,j,k) = Kv(i,j,k) + US%m_to_Z**2 * Kviscosity(k) if (CS%Stokes_Mixing) Waves%KvS(i,j,k) = US%Z_to_m**2 * Kv(i,j,k) enddo else ! KPP replaces prior diffusivity when former is non-zero do k=1, G%ke+1 - if (Kdiffusivity(k,1) /= 0.) Kt(i,j,k) = US%m_to_Z**2 * Kdiffusivity(k,1) - if (Kdiffusivity(k,2) /= 0.) Ks(i,j,k) = US%m_to_Z**2 * Kdiffusivity(k,2) + if (Kdiffusivity(k,1) /= 0.) Kt(i,j,k) = US%m2_s_to_Z2_T * Kdiffusivity(k,1) + if (Kdiffusivity(k,2) /= 0.) Ks(i,j,k) = US%m2_s_to_Z2_T * Kdiffusivity(k,2) if (Kviscosity(k) /= 0.) Kv(i,j,k) = US%m_to_Z**2 * Kviscosity(k) if (CS%Stokes_Mixing) Waves%KvS(i,j,k) = US%Z_to_m**2 * Kv(i,j,k) enddo @@ -851,8 +851,8 @@ subroutine KPP_calculate(CS, G, GV, US, h, uStar, & #ifdef __DO_SAFETY_CHECKS__ if (CS%debug) then - call hchksum(Kt, "KPP out: Kt", G%HI, haloshift=0, scale=US%Z_to_m**2) - call hchksum(Ks, "KPP out: Ks", G%HI, haloshift=0, scale=US%Z_to_m**2) + call hchksum(Kt, "KPP out: Kt", G%HI, haloshift=0, scale=US%Z2_T_to_m2_s) + call hchksum(Ks, "KPP out: Ks", G%HI, haloshift=0, scale=US%Z2_T_to_m2_s) endif #endif diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index 9884e3a51f..d77b3d5311 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -151,11 +151,11 @@ module MOM_diabatic_driver !! operating. real :: Kd_BBL_tr !< A bottom boundary layer tracer diffusivity that !! will allow for explicitly specified bottom fluxes - !! [Z2 s-1 ~> m2 s-1]. The entrainment at the bottom is at + !! [Z2 T-1 ~> m2 s-1]. The entrainment at the bottom is at !! least sqrt(Kd_BBL_tr*dt) over the same distance. real :: Kd_min_tr !< A minimal diffusivity that should always be !! applied to tracers, especially in massless layers - !! near the bottom [Z2 s-1 ~> m2 s-1]. + !! near the bottom [Z2 T-1 ~> m2 s-1]. real :: minimum_forcing_depth = 0.001 !< The smallest depth over which heat and freshwater !! fluxes are applied [m]. real :: evap_CFL_limit = 0.8 !< The largest fraction of a layer that can be @@ -328,8 +328,8 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), target :: & Kd_int, & ! diapycnal diffusivity of interfaces [Z2 T-1 ~> m2 s-1] - Kd_heat, & ! diapycnal diffusivity of heat [Z2 s-1 ~> m2 s-1] - Kd_salt, & ! diapycnal diffusivity of salt and passive tracers [Z2 s-1 ~> m2 s-1] + Kd_heat, & ! diapycnal diffusivity of heat [Z2 T-1 ~> m2 s-1] + Kd_salt, & ! diapycnal diffusivity of salt and passive tracers [Z2 T-1 ~> m2 s-1] Kd_ePBL, & ! test array of diapycnal diffusivities at interfaces [Z2 T-1 ~> m2 s-1] eta, & ! Interface heights before diapycnal mixing [m]. Tdif_flx, & ! diffusive diapycnal heat flux across interfaces [degC m s-1] @@ -385,7 +385,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & integer :: ig, jg ! global indices for testing testing itide point source (BDM) logical :: avg_enabled ! for testing internal tides (BDM) - real :: Kd_add_here ! An added diffusivity [Z2 s-1 ~> m2 s-1]. + real :: Kd_add_here ! An added diffusivity [Z2 T-1 ~> m2 s-1]. is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB @@ -571,20 +571,20 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & !$OMP parallel do default(shared) do k=1,nz+1 ; do j=js,je ; do i=is,ie - Kd_salt(i,j,k) = US%s_to_T * Kd_int(i,j,K) - Kd_heat(i,j,k) = US%s_to_T * Kd_int(i,j,K) + Kd_salt(i,j,k) = Kd_int(i,j,K) + Kd_heat(i,j,k) = Kd_int(i,j,K) enddo ; enddo ; enddo ! Add contribution from double diffusion if (associated(visc%Kd_extra_S)) then !$OMP parallel do default(shared) do k=1,nz+1 ; do j=js,je ; do i=is,ie - Kd_salt(i,j,k) = Kd_salt(i,j,k) + visc%Kd_extra_S(i,j,k) + Kd_salt(i,j,k) = Kd_salt(i,j,k) + US%T_to_s*visc%Kd_extra_S(i,j,k) enddo ; enddo ; enddo endif if (associated(visc%Kd_extra_T)) then !$OMP parallel do default(shared) do k=1,nz+1 ; do j=js,je ; do i=is,ie - Kd_heat(i,j,k) = Kd_heat(i,j,k) + visc%Kd_extra_T(i,j,k) + Kd_heat(i,j,k) = Kd_heat(i,j,k) + US%T_to_s*visc%Kd_extra_T(i,j,k) enddo ; enddo ; enddo endif @@ -592,8 +592,8 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & call MOM_state_chksum("after set_diffusivity ", u, v, h, G, GV, haloshift=0) call MOM_forcing_chksum("after set_diffusivity ", fluxes, G, US, haloshift=0) call MOM_thermovar_chksum("after set_diffusivity ", tv, G) - call hchksum(Kd_heat, "after set_diffusivity Kd_heat", G%HI, haloshift=0, scale=US%Z_to_m**2) - call hchksum(Kd_salt, "after set_diffusivity Kd_salt", G%HI, haloshift=0, scale=US%Z_to_m**2) + call hchksum(Kd_heat, "after set_diffusivity Kd_heat", G%HI, haloshift=0, scale=US%Z2_T_to_m2_s) + call hchksum(Kd_salt, "after set_diffusivity Kd_salt", G%HI, haloshift=0, scale=US%Z2_T_to_m2_s) endif if (CS%useKPP) then @@ -616,7 +616,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & fluxes%ustar, CS%KPP_buoy_flux, Waves=Waves) call KPP_calculate(CS%KPP_CSp, G, GV, US, h, fluxes%ustar, CS%KPP_buoy_flux, Kd_heat, & - Kd_salt, visc%Kv_shear, CS%KPP_NLTheat, CS%KPP_NLTscalar, Waves=Waves) + Kd_salt, visc%Kv_shear, CS%KPP_NLTheat, CS%KPP_NLTscalar, Waves=Waves) if (associated(Hml)) then !$OMP parallel default(shared) @@ -633,8 +633,8 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & call MOM_state_chksum("after KPP", u, v, h, G, GV, haloshift=0) call MOM_forcing_chksum("after KPP", fluxes, G, US, haloshift=0) call MOM_thermovar_chksum("after KPP", tv, G) - call hchksum(Kd_heat, "after KPP Kd_heat", G%HI, haloshift=0, scale=US%Z_to_m**2) - call hchksum(Kd_salt, "after KPP Kd_salt", G%HI, haloshift=0, scale=US%Z_to_m**2) + call hchksum(Kd_heat, "after KPP Kd_heat", G%HI, haloshift=0, scale=US%Z2_T_to_m2_s) + call hchksum(Kd_salt, "after KPP Kd_salt", G%HI, haloshift=0, scale=US%Z2_T_to_m2_s) endif endif ! endif for KPP @@ -680,8 +680,8 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & if (.not. CS%useKPP) then !$OMP parallel do default(shared) do K=2,nz ; do j=js,je ; do i=is,ie - Kd_heat(i,j,K) = Kd_heat(i,j,K) + visc%Kd_extra_T(i,j,K) - Kd_salt(i,j,K) = Kd_salt(i,j,K) + visc%Kd_extra_S(i,j,K) + Kd_heat(i,j,K) = Kd_heat(i,j,K) + US%T_to_s*visc%Kd_extra_T(i,j,K) + Kd_salt(i,j,K) = Kd_salt(i,j,K) + US%T_to_s*visc%Kd_extra_S(i,j,K) enddo ; enddo ; enddo endif @@ -693,8 +693,8 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & ! Increment vertical diffusion and viscosity due to convection !$OMP parallel do default(shared) do k=1,nz+1 ; do j=js,je ; do i=is,ie - Kd_heat(i,j,k) = Kd_heat(i,j,k) + CS%CVMix_conv_csp%kd_conv(i,j,k) - Kd_salt(i,j,k) = Kd_salt(i,j,k) + CS%CVMix_conv_csp%kd_conv(i,j,k) + Kd_heat(i,j,k) = Kd_heat(i,j,k) + US%T_to_s*CS%CVMix_conv_csp%kd_conv(i,j,k) + Kd_salt(i,j,k) = Kd_salt(i,j,k) + US%T_to_s*CS%CVMix_conv_csp%kd_conv(i,j,k) if (CS%useKPP) then visc%Kv_shear(i,j,k) = visc%Kv_shear(i,j,k) + CS%CVMix_conv_csp%kv_conv(i,j,k) else @@ -754,10 +754,10 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & do K=2,nz ; do j=js,je ; do i=is,ie !### These expressesions assume a Prandtl number of 1. if (CS%ePBL_is_additive) then - Kd_add_here = US%s_to_T*Kd_ePBL(i,j,K) + Kd_add_here = Kd_ePBL(i,j,K) visc%Kv_shear(i,j,K) = visc%Kv_shear(i,j,K) + US%s_to_T*Kd_ePBL(i,j,K) else - Kd_add_here = max(US%s_to_T*Kd_ePBL(i,j,K) - visc%Kd_shear(i,j,K), 0.0) + Kd_add_here = max(Kd_ePBL(i,j,K) - US%T_to_s*visc%Kd_shear(i,j,K), 0.0) visc%Kv_shear(i,j,K) = max(visc%Kv_shear(i,j,K), US%s_to_T*Kd_ePBL(i,j,K)) endif @@ -771,7 +771,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & call hchksum(eb_t, "after ePBL eb_t",G%HI,haloshift=0, scale=GV%H_to_m) call hchksum(ea_s, "after ePBL ea_s",G%HI,haloshift=0, scale=GV%H_to_m) call hchksum(eb_s, "after ePBL eb_s",G%HI,haloshift=0, scale=GV%H_to_m) - call hchksum(Kd_ePBL, "after ePBL Kd_ePBL", G%HI, haloshift=0, scale=US%s_to_T*US%Z_to_m**2) + call hchksum(Kd_ePBL, "after ePBL Kd_ePBL", G%HI, haloshift=0, scale=US%Z2_T_to_m2_s) endif else @@ -839,9 +839,9 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & !$OMP parallel do default(shared) private(hval) do k=2,nz ; do j=js,je ; do i=is,ie hval = 1.0 / (h_neglect + 0.5*(h(i,j,k-1) + h(i,j,k))) - ea_t(i,j,k) = (GV%Z_to_H**2) * dt * hval * Kd_heat(i,j,k) + ea_t(i,j,k) = (GV%Z_to_H**2) * US%s_to_T*dt * hval * Kd_heat(i,j,k) eb_t(i,j,k-1) = ea_t(i,j,k) - ea_s(i,j,k) = (GV%Z_to_H**2) * dt * hval * Kd_salt(i,j,k) + ea_s(i,j,k) = (GV%Z_to_H**2) * US%s_to_T*dt * hval * Kd_salt(i,j,k) eb_s(i,j,k-1) = ea_s(i,j,k) enddo ; enddo ; enddo do j=js,je ; do i=is,ie @@ -925,7 +925,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & call cpu_clock_begin(id_clock_tracers) if (CS%mix_boundary_tracers) then - Tr_ea_BBL = GV%Z_to_H * sqrt(dt*CS%Kd_BBL_tr) + Tr_ea_BBL = GV%Z_to_H * sqrt(dt*US%s_to_T*CS%Kd_BBL_tr) !$OMP parallel do default(shared) private(htot,in_boundary,add_ent) do j=js,je do i=is,ie @@ -944,7 +944,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & ! in the calculation of the fluxes in the first place. Kd_min_tr ! should be much less than the values that have been set in Kd_lay, ! perhaps a molecular diffusivity. - add_ent = ((dt * CS%Kd_min_tr) * GV%Z_to_H**2) * & + add_ent = ((dt*US%s_to_T * CS%Kd_min_tr) * GV%Z_to_H**2) * & ((h(i,j,k-1)+h(i,j,k)+h_neglect) / & (h(i,j,k-1)*h(i,j,k)+h_neglect2)) - & 0.5*(ea_s(i,j,k) + eb_s(i,j,k-1)) @@ -1184,8 +1184,8 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), target :: & Kd_int, & ! diapycnal diffusivity of interfaces [Z2 T-1 ~> m2 s-1] - Kd_heat, & ! diapycnal diffusivity of heat [Z2 s-1 ~> m2 s-1] - Kd_salt, & ! diapycnal diffusivity of salt and passive tracers [Z2 s-1 ~> m2 s-1] + Kd_heat, & ! diapycnal diffusivity of heat [Z2 s-T ~> m2 s-1] + Kd_salt, & ! diapycnal diffusivity of salt and passive tracers [Z2 T-1 ~> m2 s-1] Kd_ePBL, & ! test array of diapycnal diffusivities at interfaces [Z2 T-1 ~> m2 s-1] eta, & ! Interface heights before diapycnal mixing [m]. Tdif_flx, & ! diffusive diapycnal heat flux across interfaces [degC m s-1] @@ -1241,7 +1241,7 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en integer :: ig, jg ! global indices for testing testing itide point source (BDM) logical :: avg_enabled ! for testing internal tides (BDM) - real :: Kd_add_here ! An added diffusivity [Z2 s-1 ~> m2 s-1]. + real :: Kd_add_here ! An added diffusivity [Z2 T-1 ~> m2 s-1]. is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB @@ -1495,19 +1495,19 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en !$OMP parallel do default(shared) do k=1,nz+1 ; do j=js,je ; do i=is,ie - Kd_salt(i,j,k) = US%s_to_T * Kd_int(i,j,K) - Kd_heat(i,j,k) = US%s_to_T * Kd_int(i,j,K) + Kd_salt(i,j,k) = Kd_int(i,j,K) + Kd_heat(i,j,k) = Kd_int(i,j,K) enddo ; enddo ; enddo if (associated(visc%Kd_extra_S)) then !$OMP parallel do default(shared) do k=1,nz+1 ; do j=js,je ; do i=is,ie - Kd_salt(i,j,k) = Kd_salt(i,j,k) + visc%Kd_extra_S(i,j,k) + Kd_salt(i,j,k) = Kd_salt(i,j,k) + US%T_to_s*visc%Kd_extra_S(i,j,k) enddo ; enddo ; enddo endif if (associated(visc%Kd_extra_T)) then !$OMP parallel do default(shared) do k=1,nz+1 ; do j=js,je ; do i=is,ie - Kd_heat(i,j,k) = Kd_heat(i,j,k) + visc%Kd_extra_T(i,j,k) + Kd_heat(i,j,k) = Kd_heat(i,j,k) + US%T_to_s*visc%Kd_extra_T(i,j,k) enddo ; enddo ; enddo endif @@ -1527,18 +1527,18 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en if (.not. CS%KPPisPassive) then !$OMP parallel do default(shared) do k=1,nz+1 ; do j=js,je ; do i=is,ie - Kd_int(i,j,K) = US%T_to_s * min( Kd_salt(i,j,k), Kd_heat(i,j,k) ) + Kd_int(i,j,K) = min( Kd_salt(i,j,k), Kd_heat(i,j,k) ) enddo ; enddo ; enddo if (associated(visc%Kd_extra_S)) then !$OMP parallel do default(shared) do k=1,nz+1 ; do j=js,je ; do i=is,ie - visc%Kd_extra_S(i,j,k) = (Kd_salt(i,j,k) - US%s_to_T * Kd_int(i,j,K)) + visc%Kd_extra_S(i,j,k) = US%s_to_T*(Kd_salt(i,j,k) - Kd_int(i,j,K)) enddo ; enddo ; enddo endif if (associated(visc%Kd_extra_T)) then !$OMP parallel do default(shared) do k=1,nz+1 ; do j=js,je ; do i=is,ie - visc%Kd_extra_T(i,j,k) = (Kd_heat(i,j,k) - US%s_to_T * Kd_int(i,j,K)) + visc%Kd_extra_T(i,j,k) = US%s_to_T*(Kd_heat(i,j,k) - Kd_int(i,j,K)) enddo ; enddo ; enddo endif endif ! not passive @@ -1606,8 +1606,8 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en ! CS%useKPP==.true. already has extra_T and extra_S included if (.not. CS%useKPP) then do K=2,nz ; do j=js,je ; do i=is,ie - Kd_heat(i,j,K) = Kd_heat(i,j,K) + visc%Kd_extra_T(i,j,K) - Kd_salt(i,j,K) = Kd_salt(i,j,K) + visc%Kd_extra_S(i,j,K) + Kd_heat(i,j,K) = Kd_heat(i,j,K) + US%T_to_s*visc%Kd_extra_T(i,j,K) + Kd_salt(i,j,K) = Kd_salt(i,j,K) + US%T_to_s*visc%Kd_extra_S(i,j,K) enddo ; enddo ; enddo endif @@ -1704,28 +1704,28 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en do K=2,nz ; do j=js,je ; do i=is,ie if (CS%ePBL_is_additive) then - Kd_add_here = US%s_to_T*Kd_ePBL(i,j,K) + Kd_add_here = Kd_ePBL(i,j,K) visc%Kv_shear(i,j,K) = visc%Kv_shear(i,j,K) + US%s_to_T*Kd_ePBL(i,j,K) else - Kd_add_here = max(US%s_to_T*Kd_ePBL(i,j,K) - visc%Kd_shear(i,j,K), 0.0) + Kd_add_here = max(Kd_ePBL(i,j,K) - US%T_to_s*visc%Kd_shear(i,j,K), 0.0) visc%Kv_shear(i,j,K) = max(visc%Kv_shear(i,j,K), US%s_to_T*Kd_ePBL(i,j,K)) endif - Ent_int = Kd_add_here * (GV%Z_to_H**2 * dt) / & + Ent_int = Kd_add_here * (GV%Z_to_H**2 * US%s_to_T*dt) / & (0.5*(h(i,j,k-1) + h(i,j,k)) + h_neglect) eb(i,j,k-1) = eb(i,j,k-1) + Ent_int ea(i,j,k) = ea(i,j,k) + Ent_int - Kd_int(i,j,K) = Kd_int(i,j,K) + US%T_to_s * Kd_add_here + Kd_int(i,j,K) = Kd_int(i,j,K) + Kd_add_here ! for diagnostics - Kd_heat(i,j,K) = Kd_heat(i,j,K) + US%T_to_s * Kd_int(i,j,K) - Kd_salt(i,j,K) = Kd_salt(i,j,K) + US%T_to_s * Kd_int(i,j,K) + Kd_heat(i,j,K) = Kd_heat(i,j,K) + Kd_int(i,j,K) + Kd_salt(i,j,K) = Kd_salt(i,j,K) + Kd_int(i,j,K) enddo ; enddo ; enddo if (CS%debug) then call hchksum(ea, "after ePBL ea",G%HI,haloshift=0, scale=GV%H_to_m) call hchksum(eb, "after ePBL eb",G%HI,haloshift=0, scale=GV%H_to_m) - call hchksum(Kd_ePBL, "after ePBL Kd_ePBL", G%HI, haloshift=0, scale=US%Z_to_m**2*US%s_to_T) + call hchksum(Kd_ePBL, "after ePBL Kd_ePBL", G%HI, haloshift=0, scale=US%Z2_T_to_m2_s) endif else @@ -2047,7 +2047,7 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en ! mixing of passive tracers from massless boundary layers to interior call cpu_clock_begin(id_clock_tracers) if (CS%mix_boundary_tracers) then - Tr_ea_BBL = sqrt(dt*CS%Kd_BBL_tr) !### I think this needs GV%Z_to_H + Tr_ea_BBL = sqrt(dt*US%s_to_T*CS%Kd_BBL_tr) !### I think this needs GV%Z_to_H !$OMP parallel do default(shared) private(htot,in_boundary,add_ent) do j=js,je do i=is,ie @@ -2066,7 +2066,7 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en ! in the calculation of the fluxes in the first place. Kd_min_tr ! should be much less than the values that have been set in Kd_lay, ! perhaps a molecular diffusivity. - add_ent = ((dt * CS%Kd_min_tr) * GV%Z_to_H**2) * & + add_ent = ((dt*US%s_to_T * CS%Kd_min_tr) * GV%Z_to_H**2) * & ((h(i,j,k-1)+h(i,j,k)+h_neglect) / & (h(i,j,k-1)*h(i,j,k)+h_neglect2)) - & 0.5*(ea(i,j,k) + eb(i,j,k-1)) @@ -2870,12 +2870,12 @@ subroutine diabatic_driver_init(Time, G, GV, US, param_file, useALEalgorithm, di call get_param(param_file, mdl, "KD_MIN_TR", CS%Kd_min_tr, & "A minimal diffusivity that should always be applied to "//& "tracers, especially in massless layers near the bottom. "//& - "The default is 0.1*KD.", units="m2 s-1", default=0.1*Kd, scale=US%m_to_Z**2) + "The default is 0.1*KD.", units="m2 s-1", default=0.1*Kd, scale=US%m2_s_to_Z2_T) call get_param(param_file, mdl, "KD_BBL_TR", CS%Kd_BBL_tr, & "A bottom boundary layer tracer diffusivity that will "//& "allow for explicitly specified bottom fluxes. The "//& "entrainment at the bottom is at least sqrt(Kd_BBL_tr*dt) "//& - "over the same distance.", units="m2 s-1", default=0., scale=US%m_to_Z**2) + "over the same distance.", units="m2 s-1", default=0., scale=US%m2_s_to_Z2_T) endif call get_param(param_file, mdl, "TRACER_TRIDIAG", CS%tracer_tridiag, & @@ -2995,16 +2995,16 @@ subroutine diabatic_driver_init(Time, G, GV, US, param_file, useALEalgorithm, di 'Total diapycnal diffusivity at interfaces', 'm2 s-1', conversion=US%Z2_T_to_m2_s) if (CS%use_energetic_PBL) then CS%id_Kd_ePBL = register_diag_field('ocean_model', 'Kd_ePBL', diag%axesTi, Time, & - 'ePBL diapycnal diffusivity at interfaces', 'm2 s-1', conversion=US%Z_to_m**2*US%s_to_T) + 'ePBL diapycnal diffusivity at interfaces', 'm2 s-1', conversion=US%Z2_T_to_m2_s) endif CS%id_Kd_heat = register_diag_field('ocean_model', 'Kd_heat', diag%axesTi, Time, & - 'Total diapycnal diffusivity for heat at interfaces', 'm2 s-1', conversion=US%Z_to_m**2, & + 'Total diapycnal diffusivity for heat at interfaces', 'm2 s-1', conversion=US%Z2_T_to_m2_s, & cmor_field_name='difvho', & cmor_standard_name='ocean_vertical_heat_diffusivity', & cmor_long_name='Ocean vertical heat diffusivity') CS%id_Kd_salt = register_diag_field('ocean_model', 'Kd_salt', diag%axesTi, Time, & - 'Total diapycnal diffusivity for salt at interfaces', 'm2 s-1', conversion=US%Z_to_m**2, & + 'Total diapycnal diffusivity for salt at interfaces', 'm2 s-1', conversion=US%Z2_T_to_m2_s, & cmor_field_name='difvso', & cmor_standard_name='ocean_vertical_salt_diffusivity', & cmor_long_name='Ocean vertical salt diffusivity') From e9cf2cd6288afc8bc97227047f107210fcfc7c7b Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Mon, 24 Jun 2019 13:29:53 -0400 Subject: [PATCH 029/297] +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 030/297] +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 031/297] +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 032/297] +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 033/297] +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 034/297] (*)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 035/297] +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 036/297] +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 037/297] 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 038/297] +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 039/297] 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 040/297] 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 041/297] 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 042/297] 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 043/297] 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 044/297] +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 045/297] (*)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 046/297] (*)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 047/297] (*)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 048/297] +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 049/297] +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 050/297] 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 051/297] 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 052/297] +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 053/297] +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 054/297] +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 055/297] +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 056/297] +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 057/297] +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 058/297] 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 059/297] +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 060/297] 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 061/297] +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 062/297] 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 063/297] +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 064/297] +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 065/297] +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 066/297] +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 067/297] +Combined MOM_shortwave_abs and MOM_opacity Combined the MOM_shortwave_abs and MOM_opacity modules. All answers are bitwise identical, but one type and two subroutines are now found in a different module. --- src/core/MOM_forcing_type.F90 | 2 +- .../vertical/MOM_bulk_mixed_layer.F90 | 2 +- .../vertical/MOM_diabatic_aux.F90 | 2 +- .../vertical/MOM_diabatic_driver.F90 | 2 +- .../vertical/MOM_opacity.F90 | 419 ++++++++++++++++- .../vertical/MOM_shortwave_abs.F90 | 424 ------------------ src/tracer/MOM_offline_aux.F90 | 2 +- src/tracer/MOM_offline_main.F90 | 3 +- 8 files changed, 420 insertions(+), 436 deletions(-) delete mode 100644 src/parameterizations/vertical/MOM_shortwave_abs.F90 diff --git a/src/core/MOM_forcing_type.F90 b/src/core/MOM_forcing_type.F90 index 57ef79cc24..29140b8b4b 100644 --- a/src/core/MOM_forcing_type.F90 +++ b/src/core/MOM_forcing_type.F90 @@ -11,7 +11,7 @@ module MOM_forcing_type use MOM_EOS, only : calculate_density_derivs use MOM_file_parser, only : get_param, log_param, log_version, param_file_type use MOM_grid, only : ocean_grid_type -use MOM_shortwave_abs, only : sumSWoverBands, optics_type +use MOM_opacity, only : sumSWoverBands, optics_type use MOM_spatial_means, only : global_area_integral, global_area_mean use MOM_unit_scaling, only : unit_scale_type use MOM_variables, only : surface, thermo_var_ptrs diff --git a/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 b/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 index 56a9d5b618..47154717e2 100644 --- a/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 +++ b/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 @@ -11,7 +11,7 @@ module MOM_bulk_mixed_layer use MOM_file_parser, only : get_param, log_param, log_version, param_file_type use MOM_forcing_type, only : extractFluxes1d, forcing use MOM_grid, only : ocean_grid_type -use MOM_shortwave_abs, only : absorbRemainingSW, optics_type +use MOM_opacity, only : absorbRemainingSW, optics_type use MOM_unit_scaling, only : unit_scale_type use MOM_variables, only : thermo_var_ptrs use MOM_verticalGrid, only : verticalGrid_type diff --git a/src/parameterizations/vertical/MOM_diabatic_aux.F90 b/src/parameterizations/vertical/MOM_diabatic_aux.F90 index 972e050b82..0840ab203f 100644 --- a/src/parameterizations/vertical/MOM_diabatic_aux.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_aux.F90 @@ -17,7 +17,7 @@ module MOM_diabatic_aux use MOM_grid, only : ocean_grid_type use MOM_io, only : slasher use MOM_opacity, only : set_opacity, opacity_CS -use MOM_shortwave_abs, only : absorbRemainingSW, optics_type, sumSWoverBands +use MOM_opacity, only : absorbRemainingSW, optics_type, sumSWoverBands use MOM_tracer_flow_control, only : get_chl_from_model, tracer_flow_control_CS use MOM_unit_scaling, only : unit_scale_type use MOM_variables, only : thermo_var_ptrs, vertvisc_type! , accel_diag_ptrs diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index 714bea2926..f5fe2b4f1e 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -53,11 +53,11 @@ module MOM_diabatic_driver use MOM_CVMix_KPP, only : KPP_end, KPP_get_BLD use MOM_CVMix_KPP, only : KPP_NonLocalTransport_temp, KPP_NonLocalTransport_saln use MOM_opacity, only : opacity_init, opacity_end, opacity_CS +use MOM_opacity, only : absorbRemainingSW, optics_type use MOM_regularize_layers, only : regularize_layers, regularize_layers_init, regularize_layers_CS use MOM_set_diffusivity, only : set_diffusivity, set_BBL_TKE use MOM_set_diffusivity, only : set_diffusivity_init, set_diffusivity_end use MOM_set_diffusivity, only : set_diffusivity_CS -use MOM_shortwave_abs, only : absorbRemainingSW, optics_type use MOM_sponge, only : apply_sponge, sponge_CS use MOM_ALE_sponge, only : apply_ALE_sponge, ALE_sponge_CS use MOM_time_manager, only : time_type, real_to_time, operator(-), operator(<=) diff --git a/src/parameterizations/vertical/MOM_opacity.F90 b/src/parameterizations/vertical/MOM_opacity.F90 index 4b674c988f..ad9f8c53bd 100644 --- a/src/parameterizations/vertical/MOM_opacity.F90 +++ b/src/parameterizations/vertical/MOM_opacity.F90 @@ -6,18 +6,38 @@ module MOM_opacity use MOM_diag_mediator, only : time_type, diag_ctrl, safe_alloc_ptr, post_data use MOM_diag_mediator, only : query_averaging_enabled, register_diag_field use MOM_error_handler, only : MOM_error, MOM_mesg, FATAL, WARNING -use MOM_file_parser, only : get_param, log_param, log_version, param_file_type +use MOM_file_parser, only : get_param, log_param, log_version, param_file_type use MOM_string_functions, only : uppercase -use MOM_shortwave_abs, only : optics_type -use MOM_grid, only : ocean_grid_type -use MOM_variables, only : thermo_var_ptrs -use MOM_verticalGrid, only : verticalGrid_type +use MOM_grid, only : ocean_grid_type +use MOM_unit_scaling, only : unit_scale_type +use MOM_variables, only : thermo_var_ptrs +use MOM_verticalGrid, only : verticalGrid_type implicit none ; private #include public set_opacity, opacity_init, opacity_end, opacity_manizza, opacity_morel +public absorbRemainingSW, sumSWoverBands + +!> This type is used to exchange information about ocean optical properties +type, public :: optics_type + ! ocean optical properties + + integer :: nbands !< number of penetrating bands of SW radiation + + real, pointer, dimension(:,:,:,:) :: opacity_band => NULL() !< SW optical depth per unit thickness [m-1] + !! The number of radiation bands is most rapidly varying (first) index. + + real, pointer, dimension(:,:,:) :: SW_pen_band => NULL() !< shortwave radiation [W m-2] at the surface + !! in each of the nbands bands that penetrates beyond the surface. + !! The most rapidly varying dimension is the band. + + real, pointer, dimension(:) :: & + min_wavelength_band => NULL(), & !< The minimum wavelength in each band of penetrating shortwave radiation [nm] + max_wavelength_band => NULL() !< The maximum wavelength in each band of penetrating shortwave radiation [nm] + +end type optics_type !> The control structure with paramters for the MOM_opacity module type, public :: opacity_CS ; private @@ -408,6 +428,395 @@ function opacity_manizza(chl_data) opacity_manizza = 0.0232 + 0.074*chl_data**0.674 end function + +!> Apply shortwave heating below the boundary layer (when running with the bulk mixed layer inhereted +!! from GOLD) or throughout the water column. +!! +!! In addition, it causes all of the remaining SW radiation to be absorbed, provided that the total +!! water column thickness is greater than H_limit_fluxes. +!! For thinner water columns, the heating is scaled down proportionately, the assumption being that the +!! remaining heating (which is left in Pen_SW) should go into an (absent for now) ocean bottom sediment layer. +subroutine absorbRemainingSW(G, GV, US, h, opacity_band, nsw, j, dt, H_limit_fluxes, & + adjustAbsorptionProfile, absorbAllSW, T, Pen_SW_bnd, & + eps, ksort, htot, Ttot, TKE, dSV_dT) + + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + real, dimension(SZI_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]. + real, dimension(:,:,:), intent(in) :: opacity_band !< Opacity in each band of penetrating + !! shortwave radiation [H-1 ~> m-1 or m2 kg-1]. + !! The indicies are band, i, k. + integer, intent(in) :: nsw !< Number of bands of penetrating + !! shortwave radiation. + integer, intent(in) :: j !< j-index to work on. + real, intent(in) :: dt !< Time step [T ~> s]. + real, intent(in) :: H_limit_fluxes !< If the total ocean depth is + !! less than this, they are scaled away + !! to avoid numerical instabilities + !! [H ~> m or kg m-2]. This would + !! not be necessary if a finite heat + !! capacity mud-layer were added. + logical, intent(in) :: adjustAbsorptionProfile !< If true, apply + !! heating above the layers in which it + !! should have occurred to get the + !! correct mean depth (and potential + !! energy change) of the shortwave that + !! should be absorbed by each layer. + logical, intent(in) :: absorbAllSW !< If true, apply heating above the + !! layers in which it should have occurred + !! to get the correct mean depth (and + !! potential energy change) of the + !! shortwave that should be absorbed by + !! each layer. + real, dimension(SZI_(G),SZK_(G)), intent(inout) :: T !< Layer potential/conservative + !! temperatures [degC] + real, dimension(:,:), intent(inout) :: Pen_SW_bnd !< Penetrating shortwave heating in + !! each band that hits the bottom and will + !! will be redistributed through the water + !! column [degC H ~> degC m or degC kg m-2], + !! size nsw x SZI_(G). + real, dimension(SZI_(G),SZK_(G)), optional, intent(in) :: eps !< Small thickness that must remain in + !! each layer, and which will not be + !! subject to heating [H ~> m or kg m-2] + integer, dimension(SZI_(G),SZK_(G)), optional, intent(in) :: ksort !< Density-sorted k-indicies. + real, dimension(SZI_(G)), optional, intent(in) :: htot !< Total mixed layer thickness [H ~> m or kg m-2]. + real, dimension(SZI_(G)), optional, intent(inout) :: Ttot !< Depth integrated mixed layer + !! temperature [degC H ~> degC m or degC kg m-2] + real, dimension(SZI_(G),SZK_(G)), optional, intent(in) :: dSV_dT !< The partial derivative of specific + !! volume with temperature [m3 kg-1 degC-1]. + real, dimension(SZI_(G),SZK_(G)), optional, intent(inout) :: TKE !< The TKE sink from mixing the heating + !! throughout a layer [kg m-3 Z3 T-2 ~> J m-2]. + ! Local variables + real, dimension(SZI_(G),SZK_(G)) :: & + T_chg_above ! A temperature change that will be applied to all the thick + ! layers above a given layer [degC]. This is only nonzero if + ! adjustAbsorptionProfile is true, in which case the net + ! change in the temperature of a layer is the sum of the + ! direct heating of that layer plus T_chg_above from all of + ! the layers below, plus any contribution from absorbing + ! radiation that hits the bottom. + real, dimension(SZI_(G)) :: & + h_heat, & ! The thickness of the water column that will be heated by + ! any remaining shortwave radiation [H ~> m or kg m-2]. + T_chg, & ! The temperature change of thick layers due to the remaining + ! shortwave radiation and contributions from T_chg_above [degC]. + Pen_SW_rem ! The sum across all wavelength bands of the penetrating shortwave + ! heating that hits the bottom and will be redistributed through + ! the water column [degC H ~> degC m or degC kg m-2] + real :: SW_trans ! fraction of shortwave radiation that is not + ! absorbed in a layer [nondim] + real :: unabsorbed ! fraction of the shortwave radiation that + ! is not absorbed because the layers are too thin + real :: Ih_limit ! inverse of the total depth at which the + ! surface fluxes start to be limited [H-1 ~> m-1 or m2 kg-1] + real :: h_min_heat ! minimum thickness layer that should get heated [H ~> m or kg m-2] + real :: opt_depth ! optical depth of a layer [nondim] + real :: exp_OD ! exp(-opt_depth) [nondim] + real :: heat_bnd ! heating due to absorption in the current + ! layer by the current band, including any piece that + ! is moved upward [degC H ~> degC m or degC kg m-2] + real :: SWa ! fraction of the absorbed shortwave that is + ! moved to layers above with adjustAbsorptionProfile [nondim] + real :: coSWa_frac ! The fraction of SWa that is actually moved upward. + real :: min_SW_heating ! A minimum remaining shortwave heating rate that will be simply + ! absorbed in the next layer for computational efficiency, instead of + ! continuing to penetrate [degC H T-1 ~> degC m s-1 or degC kg m-2 s-1]. + ! The default, 2.5e-11, is about 0.08 degC m / century. + real :: epsilon ! A small thickness that must remain in each + ! layer, and which will not be subject to heating [H ~> m or kg m-2] + real :: g_Hconv2 ! A conversion factor for use in the TKE calculation + ! in units of [Z3 kg2 m-6 T-2 H-2 ~> kg2 m-5 s-2 or m s-2]. + logical :: SW_Remains ! If true, some column has shortwave radiation that + ! was not entirely absorbed. + logical :: TKE_calc ! If true, calculate the implications to the + ! TKE budget of the shortwave heating. + real :: C1_6, C1_60 + integer :: is, ie, nz, i, k, ks, n + SW_Remains = .false. + + min_SW_heating = 2.5e-11*US%T_to_s !### This needs *GV%m_to_H for dimensional consistency? + + h_min_heat = 2.0*GV%Angstrom_H + GV%H_subroundoff + is = G%isc ; ie = G%iec ; nz = G%ke + C1_6 = 1.0 / 6.0 ; C1_60 = 1.0 / 60.0 + + TKE_calc = (present(TKE) .and. present(dSV_dT)) + ! g_Hconv2 = (US%m_to_Z**3 * US%T_to_s**2) * GV%H_to_Pa * GV%H_to_kg_m2 + g_Hconv2 = (US%m_to_Z**4 * US%T_to_s**2 * GV%g_Earth * GV%H_to_kg_m2) * GV%H_to_kg_m2 + ! g_Hconv2 = US%m_to_Z**4 * US%T_to_s**2 * GV%g_Earth * GV%H_to_kg_m2**2 + + h_heat(:) = 0.0 + if (present(htot)) then ; do i=is,ie ; h_heat(i) = htot(i) ; enddo ; endif + + ! Apply penetrating SW radiation to remaining parts of layers. + ! Excessively thin layers are not heated to avoid runaway temps. + do ks=1,nz ; do i=is,ie + k = ks + if (present(ksort)) then + if (ksort(i,ks) <= 0) cycle + k = ksort(i,ks) + endif + epsilon = 0.0 ; if (present(eps)) epsilon = eps(i,k) + + T_chg_above(i,k) = 0.0 + + if (h(i,k) > 1.5*epsilon) then + do n=1,nsw ; if (Pen_SW_bnd(n,i) > 0.0) then + ! SW_trans is the SW that is transmitted THROUGH the layer + opt_depth = h(i,k) * opacity_band(n,i,k) + exp_OD = exp(-opt_depth) + SW_trans = exp_OD + + ! Heating at a rate of less than 10-4 W m-2 = 10-3 K m / Century, + ! and of the layer in question less than 1 K / Century, can be + ! absorbed without further penetration. + ! ###Make these numbers into parameters! + if (nsw*Pen_SW_bnd(n,i)*SW_trans < & + dt*min_SW_heating*min(1.0*GV%m_to_H, 1e3*h(i,k)) ) SW_trans = 0.0 + + Heat_bnd = Pen_SW_bnd(n,i) * (1.0 - SW_trans) + if (adjustAbsorptionProfile .and. (h_heat(i) > 0.0)) then + ! In this case, a fraction of the heating is applied to the + ! overlying water so that the mean pressure at which the shortwave + ! heating occurs is exactly what it would have been with a careful + ! pressure-weighted averaging of the exponential heating profile, + ! hence there should be no TKE budget requirements due to this + ! layer. Very clever, but this is also limited so that the + ! water above is not heated at a faster rate than the layer + ! actually being heated, i.e., SWA <= h_heat / (h_heat + h(i,k)) + ! and takes the energetics of the rest of the heating into account. + ! (-RWH, ~7 years later.) + if (opt_depth > 1e-5) then + SWa = ((opt_depth + (opt_depth + 2.0)*exp_OD) - 2.0) / & + ((opt_depth + opacity_band(n,i,k) * h_heat(i)) * & + (1.0 - exp_OD)) + else + ! Use Taylor series expansion of the expression above for a + ! more accurate form with very small layer optical depths. + SWa = h(i,k) * (opt_depth * (1.0 - opt_depth)) / & + ((h_heat(i) + h(i,k)) * (6.0 - 3.0*opt_depth)) + endif + coSWa_frac = 0.0 + if (SWa*(h_heat(i) + h(i,k)) > h_heat(i)) then + coSWa_frac = (SWa*(h_heat(i) + h(i,k)) - h_heat(i) ) / & + (SWa*(h_heat(i) + h(i,k))) + SWa = h_heat(i) / (h_heat(i) + h(i,k)) + endif + + T_chg_above(i,k) = T_chg_above(i,k) + (SWa * Heat_bnd) / h_heat(i) + T(i,k) = T(i,k) + ((1.0 - SWa) * Heat_bnd) / h(i,k) + else + coSWa_frac = 1.0 + T(i,k) = T(i,k) + Pen_SW_bnd(n,i) * (1.0 - SW_trans) / h(i,k) + endif + + if (TKE_calc) then + if (opt_depth > 1e-2) then + TKE(i,k) = TKE(i,k) - coSWa_frac*Heat_bnd*dSV_dT(i,k)* & + (0.5*h(i,k)*g_Hconv2) * & + (opt_depth*(1.0+exp_OD) - 2.0*(1.0-exp_OD)) / (opt_depth*(1.0-exp_OD)) + else + ! Use Taylor series-derived approximation to the above expression + ! that is well behaved and more accurate when opt_depth is small. + TKE(i,k) = TKE(i,k) - coSWa_frac*Heat_bnd*dSV_dT(i,k)* & + (0.5*h(i,k)*g_Hconv2) * & + (C1_6*opt_depth * (1.0 - C1_60*opt_depth**2)) + endif + endif + + Pen_SW_bnd(n,i) = Pen_SW_bnd(n,i) * SW_trans + endif ; enddo + endif + + ! Add to the accumulated thickness above that could be heated. + ! Only layers greater than h_min_heat thick should get heated. + if (h(i,k) >= 2.0*h_min_heat) then + h_heat(i) = h_heat(i) + h(i,k) + elseif (h(i,k) > h_min_heat) then + h_heat(i) = h_heat(i) + (2.0*h(i,k) - 2.0*h_min_heat) + endif + enddo ; enddo ! i & k loops + + +! if (.not.absorbAllSW .and. .not.adjustAbsorptionProfile) return + + ! Unless modified, there is no temperature change due to fluxes from the bottom. + do i=is,ie ; T_chg(i) = 0.0 ; enddo + + if (absorbAllSW) then + ! If there is still shortwave radiation at this point, it could go into + ! the bottom (with a bottom mud model), or it could be redistributed back + ! through the water column. + do i=is,ie + Pen_SW_rem(i) = Pen_SW_bnd(1,i) + do n=2,nsw ; Pen_SW_rem(i) = Pen_SW_rem(i) + Pen_SW_bnd(n,i) ; enddo + enddo + do i=is,ie ; if (Pen_SW_rem(i) > 0.0) SW_Remains = .true. ; enddo + + Ih_limit = 1.0 / H_limit_fluxes + do i=is,ie ; if ((Pen_SW_rem(i) > 0.0) .and. (h_heat(i) > 0.0)) then + if (h_heat(i)*Ih_limit >= 1.0) then + T_chg(i) = Pen_SW_rem(i) / h_heat(i) ; unabsorbed = 0.0 + else + T_chg(i) = Pen_SW_rem(i) * Ih_limit + unabsorbed = 1.0 - h_heat(i)*Ih_limit + endif + do n=1,nsw ; Pen_SW_bnd(n,i) = unabsorbed * Pen_SW_bnd(n,i) ; enddo + endif ; enddo + endif ! absorbAllSW + + if (absorbAllSW .or. adjustAbsorptionProfile) then + do ks=nz,1,-1 ; do i=is,ie + k = ks + if (present(ksort)) then + if (ksort(i,ks) <= 0) cycle + k = ksort(i,ks) + endif + + if (T_chg(i) > 0.0) then + ! Only layers greater than h_min_heat thick should get heated. + if (h(i,k) >= 2.0*h_min_heat) then ; T(i,k) = T(i,k) + T_chg(i) + elseif (h(i,k) > h_min_heat) then + T(i,k) = T(i,k) + T_chg(i) * (2.0 - 2.0*h_min_heat/h(i,k)) + endif + endif + ! Increase the heating for layers above. + T_chg(i) = T_chg(i) + T_chg_above(i,k) + enddo ; enddo + if (present(htot) .and. present(Ttot)) then + do i=is,ie ; Ttot(i) = Ttot(i) + T_chg(i) * htot(i) ; enddo + endif + endif ! absorbAllSW .or. adjustAbsorptionProfile + +end subroutine absorbRemainingSW + + +subroutine sumSWoverBands(G, GV, US, h, opacity_band, nsw, j, dt, & + H_limit_fluxes, absorbAllSW, iPen_SW_bnd, netPen) +!< This subroutine calculates the total shortwave heat flux integrated over +!! bands as a function of depth. This routine is only called for computing +!! buoyancy fluxes for use in KPP. This routine does not updat e the state. + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + real, dimension(SZI_(G),SZK_(G)), & + intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]. + real, dimension(:,:,:), intent(in) :: opacity_band !< opacity in each band of + !! penetrating shortwave radiation [m-1]. + !! The indicies are band, i, k. + integer, intent(in) :: nsw !< number of bands of penetrating + !! shortwave radiation. + integer, intent(in) :: j !< j-index to work on. + real, intent(in) :: dt !< Time step [T ~> s]. + real, intent(in) :: H_limit_fluxes !< the total depth at which the + !! surface fluxes start to be limited to avoid + !! excessive heating of a thin ocean [H ~> m or kg m-2] + logical, intent(in) :: absorbAllSW !< If true, ensure that all shortwave + !! radiation is absorbed in the ocean water column. + real, dimension(:,:), intent(in) :: iPen_SW_bnd !< The incident penetrating shortwave + !! heating in each band that hits the bottom and + !! will be redistributed through the water column + !! [degC H ~> degC m or degC kg m-2]; size nsw x SZI_(G). + real, dimension(SZI_(G),SZK_(G)+1), & + intent(inout) :: netPen !< Net penetrating shortwave heat flux at each + !! interface, summed across all bands + !! [degC H ~> degC m or degC kg m-2]. + ! Local variables + real :: h_heat(SZI_(G)) ! thickness of the water column that receives + ! remaining shortwave radiation [H ~> m or kg m-2]. + real :: Pen_SW_rem(SZI_(G)) ! sum across all wavelength bands of the + ! penetrating shortwave heating that hits the bottom + ! and will be redistributed through the water column + ! [degC H ~> degC m or degC kg m-2] + + real, dimension(size(iPen_SW_bnd,1),size(iPen_SW_bnd,2)) :: Pen_SW_bnd + real :: SW_trans ! fraction of shortwave radiation not + ! absorbed in a layer [nondim] + real :: unabsorbed ! fraction of the shortwave radiation + ! not absorbed because the layers are too thin. + real :: Ih_limit ! inverse of the total depth at which the + ! surface fluxes start to be limited [H-1 ~> m-1 or m2 kg-1] + real :: h_min_heat ! minimum thickness layer that should get heated [H ~> m or kg m-2] + real :: opt_depth ! optical depth of a layer [nondim] + real :: exp_OD ! exp(-opt_depth) [nondim] + logical :: SW_Remains ! If true, some column has shortwave radiation that + ! was not entirely absorbed. + + integer :: is, ie, nz, i, k, ks, n + SW_Remains = .false. + + h_min_heat = 2.0*GV%Angstrom_H + GV%H_subroundoff + is = G%isc ; ie = G%iec ; nz = G%ke + + pen_SW_bnd(:,:) = iPen_SW_bnd(:,:) + do i=is,ie ; h_heat(i) = 0.0 ; enddo + netPen(:,1) = sum( pen_SW_bnd(:,:), dim=1 ) ! Surface interface + + ! Apply penetrating SW radiation to remaining parts of layers. + ! Excessively thin layers are not heated to avoid runaway temps. + do k=1,nz + + do i=is,ie + netPen(i,k+1) = 0. + + if (h(i,k) > 0.0) then + do n=1,nsw ; if (Pen_SW_bnd(n,i) > 0.0) then + ! SW_trans is the SW that is transmitted THROUGH the layer + opt_depth = h(i,k)*GV%H_to_m * opacity_band(n,i,k) + exp_OD = exp(-opt_depth) + SW_trans = exp_OD + + ! Heating at a rate of less than 10-4 W m-2 = 10-3 K m / Century, + ! and of the layer in question less than 1 K / Century, can be + ! absorbed without further penetration. + if ((nsw*Pen_SW_bnd(n,i)*SW_trans < GV%m_to_H*2.5e-11*US%T_to_s*dt) .and. & + (nsw*Pen_SW_bnd(n,i)*SW_trans < h(i,k)*dt*US%T_to_s*2.5e-8)) & + SW_trans = 0.0 + + Pen_SW_bnd(n,i) = Pen_SW_bnd(n,i) * SW_trans + netPen(i,k+1) = netPen(i,k+1) + Pen_SW_bnd(n,i) + endif ; enddo + endif ! h(i,k) > 0.0 + + ! Add to the accumulated thickness above that could be heated. + ! Only layers greater than h_min_heat thick should get heated. + if (h(i,k) >= 2.0*h_min_heat) then + h_heat(i) = h_heat(i) + h(i,k) + elseif (h(i,k) > h_min_heat) then + h_heat(i) = h_heat(i) + (2.0*h(i,k) - 2.0*h_min_heat) + endif + enddo ! i loop + enddo ! k loop + + if (absorbAllSW) then + + ! If there is still shortwave radiation at this point, it could go into + ! the bottom (with a bottom mud model), or it could be redistributed back + ! through the water column. + do i=is,ie + Pen_SW_rem(i) = Pen_SW_bnd(1,i) + do n=2,nsw ; Pen_SW_rem(i) = Pen_SW_rem(i) + Pen_SW_bnd(n,i) ; enddo + enddo + do i=is,ie ; if (Pen_SW_rem(i) > 0.0) SW_Remains = .true. ; enddo + + Ih_limit = 1.0 / H_limit_fluxes + do i=is,ie ; if ((Pen_SW_rem(i) > 0.0) .and. (h_heat(i) > 0.0)) then + if (h_heat(i)*Ih_limit < 1.0) then + unabsorbed = 1.0 - h_heat(i)*Ih_limit + else + unabsorbed = 0.0 + endif + do n=1,nsw ; Pen_SW_bnd(n,i) = unabsorbed * Pen_SW_bnd(n,i) ; enddo + endif ; enddo + + endif ! absorbAllSW + +end subroutine sumSWoverBands + + + + subroutine opacity_init(Time, G, param_file, diag, CS, optics) type(time_type), target, intent(in) :: Time !< The current model time. type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. diff --git a/src/parameterizations/vertical/MOM_shortwave_abs.F90 b/src/parameterizations/vertical/MOM_shortwave_abs.F90 deleted file mode 100644 index d24e5ed55e..0000000000 --- a/src/parameterizations/vertical/MOM_shortwave_abs.F90 +++ /dev/null @@ -1,424 +0,0 @@ -!> Absorption of downwelling shortwave radiation -module MOM_shortwave_abs - -! This file is part of MOM6. See LICENSE.md for the license. - -use MOM_error_handler, only : MOM_error, FATAL, WARNING -use MOM_file_parser, only : get_param, log_param, log_version, param_file_type -use MOM_grid, only : ocean_grid_type -use MOM_unit_scaling, only : unit_scale_type -use MOM_verticalGrid, only : verticalGrid_type - -implicit none ; private - -#include - -public absorbRemainingSW, sumSWoverBands - -!> This type is used to exchange information about ocean optical properties -type, public :: optics_type - ! ocean optical properties - - integer :: nbands !< number of penetrating bands of SW radiation - - real, pointer, dimension(:,:,:,:) :: opacity_band => NULL() !< SW optical depth per unit thickness [m-1] - !! The number of radiation bands is most rapidly varying (first) index. - - real, pointer, dimension(:,:,:) :: SW_pen_band => NULL() !< shortwave radiation [W m-2] at the surface - !! in each of the nbands bands that penetrates beyond the surface. - !! The most rapidly varying dimension is the band. - - real, pointer, dimension(:) :: & - min_wavelength_band => NULL(), & !< The minimum wavelength in each band of penetrating shortwave radiation [nm] - max_wavelength_band => NULL() !< The maximum wavelength in each band of penetrating shortwave radiation [nm] - -end type optics_type - -contains - -!> Apply shortwave heating below the boundary layer (when running with the bulk mixed layer inhereted -!! from GOLD) or throughout the water column. -!! -!! In addition, it causes all of the remaining SW radiation to be absorbed, provided that the total -!! water column thickness is greater than H_limit_fluxes. -!! For thinner water columns, the heating is scaled down proportionately, the assumption being that the -!! remaining heating (which is left in Pen_SW) should go into an (absent for now) ocean bottom sediment layer. -subroutine absorbRemainingSW(G, GV, US, h, opacity_band, nsw, j, dt, H_limit_fluxes, & - adjustAbsorptionProfile, absorbAllSW, T, Pen_SW_bnd, & - eps, ksort, htot, Ttot, TKE, dSV_dT) - - type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. - type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. - type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - real, dimension(SZI_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]. - real, dimension(:,:,:), intent(in) :: opacity_band !< Opacity in each band of penetrating - !! shortwave radiation [H-1 ~> m-1 or m2 kg-1]. - !! The indicies are band, i, k. - integer, intent(in) :: nsw !< Number of bands of penetrating - !! shortwave radiation. - integer, intent(in) :: j !< j-index to work on. - real, intent(in) :: dt !< Time step [T ~> s]. - real, intent(in) :: H_limit_fluxes !< If the total ocean depth is - !! less than this, they are scaled away - !! to avoid numerical instabilities - !! [H ~> m or kg m-2]. This would - !! not be necessary if a finite heat - !! capacity mud-layer were added. - logical, intent(in) :: adjustAbsorptionProfile !< If true, apply - !! heating above the layers in which it - !! should have occurred to get the - !! correct mean depth (and potential - !! energy change) of the shortwave that - !! should be absorbed by each layer. - logical, intent(in) :: absorbAllSW !< If true, apply heating above the - !! layers in which it should have occurred - !! to get the correct mean depth (and - !! potential energy change) of the - !! shortwave that should be absorbed by - !! each layer. - real, dimension(SZI_(G),SZK_(G)), intent(inout) :: T !< Layer potential/conservative - !! temperatures [degC] - real, dimension(:,:), intent(inout) :: Pen_SW_bnd !< Penetrating shortwave heating in - !! each band that hits the bottom and will - !! will be redistributed through the water - !! column [degC H ~> degC m or degC kg m-2], - !! size nsw x SZI_(G). - real, dimension(SZI_(G),SZK_(G)), optional, intent(in) :: eps !< Small thickness that must remain in - !! each layer, and which will not be - !! subject to heating [H ~> m or kg m-2] - integer, dimension(SZI_(G),SZK_(G)), optional, intent(in) :: ksort !< Density-sorted k-indicies. - real, dimension(SZI_(G)), optional, intent(in) :: htot !< Total mixed layer thickness [H ~> m or kg m-2]. - real, dimension(SZI_(G)), optional, intent(inout) :: Ttot !< Depth integrated mixed layer - !! temperature [degC H ~> degC m or degC kg m-2] - real, dimension(SZI_(G),SZK_(G)), optional, intent(in) :: dSV_dT !< The partial derivative of specific - !! volume with temperature [m3 kg-1 degC-1]. - real, dimension(SZI_(G),SZK_(G)), optional, intent(inout) :: TKE !< The TKE sink from mixing the heating - !! throughout a layer [kg m-3 Z3 T-2 ~> J m-2]. - ! Local variables - real, dimension(SZI_(G),SZK_(G)) :: & - T_chg_above ! A temperature change that will be applied to all the thick - ! layers above a given layer [degC]. This is only nonzero if - ! adjustAbsorptionProfile is true, in which case the net - ! change in the temperature of a layer is the sum of the - ! direct heating of that layer plus T_chg_above from all of - ! the layers below, plus any contribution from absorbing - ! radiation that hits the bottom. - real, dimension(SZI_(G)) :: & - h_heat, & ! The thickness of the water column that will be heated by - ! any remaining shortwave radiation [H ~> m or kg m-2]. - T_chg, & ! The temperature change of thick layers due to the remaining - ! shortwave radiation and contributions from T_chg_above [degC]. - Pen_SW_rem ! The sum across all wavelength bands of the penetrating shortwave - ! heating that hits the bottom and will be redistributed through - ! the water column [degC H ~> degC m or degC kg m-2] - real :: SW_trans ! fraction of shortwave radiation that is not - ! absorbed in a layer [nondim] - real :: unabsorbed ! fraction of the shortwave radiation that - ! is not absorbed because the layers are too thin - real :: Ih_limit ! inverse of the total depth at which the - ! surface fluxes start to be limited [H-1 ~> m-1 or m2 kg-1] - real :: h_min_heat ! minimum thickness layer that should get heated [H ~> m or kg m-2] - real :: opt_depth ! optical depth of a layer [nondim] - real :: exp_OD ! exp(-opt_depth) [nondim] - real :: heat_bnd ! heating due to absorption in the current - ! layer by the current band, including any piece that - ! is moved upward [degC H ~> degC m or degC kg m-2] - real :: SWa ! fraction of the absorbed shortwave that is - ! moved to layers above with adjustAbsorptionProfile [nondim] - real :: coSWa_frac ! The fraction of SWa that is actually moved upward. - real :: min_SW_heating ! A minimum remaining shortwave heating rate that will be simply - ! absorbed in the next layer for computational efficiency, instead of - ! continuing to penetrate [degC H T-1 ~> degC m s-1 or degC kg m-2 s-1]. - ! The default, 2.5e-11, is about 0.08 degC m / century. - real :: epsilon ! A small thickness that must remain in each - ! layer, and which will not be subject to heating [H ~> m or kg m-2] - real :: g_Hconv2 ! A conversion factor for use in the TKE calculation - ! in units of [Z3 kg2 m-6 T-2 H-2 ~> kg2 m-5 s-2 or m s-2]. - logical :: SW_Remains ! If true, some column has shortwave radiation that - ! was not entirely absorbed. - logical :: TKE_calc ! If true, calculate the implications to the - ! TKE budget of the shortwave heating. - real :: C1_6, C1_60 - integer :: is, ie, nz, i, k, ks, n - SW_Remains = .false. - - min_SW_heating = 2.5e-11*US%T_to_s !### This needs *GV%m_to_H for dimensional consistency? - - h_min_heat = 2.0*GV%Angstrom_H + GV%H_subroundoff - is = G%isc ; ie = G%iec ; nz = G%ke - C1_6 = 1.0 / 6.0 ; C1_60 = 1.0 / 60.0 - - TKE_calc = (present(TKE) .and. present(dSV_dT)) - ! g_Hconv2 = (US%m_to_Z**3 * US%T_to_s**2) * GV%H_to_Pa * GV%H_to_kg_m2 - g_Hconv2 = (US%m_to_Z**4 * US%T_to_s**2 * GV%g_Earth * GV%H_to_kg_m2) * GV%H_to_kg_m2 - ! g_Hconv2 = US%m_to_Z**4 * US%T_to_s**2 * GV%g_Earth * GV%H_to_kg_m2**2 - - h_heat(:) = 0.0 - if (present(htot)) then ; do i=is,ie ; h_heat(i) = htot(i) ; enddo ; endif - - ! Apply penetrating SW radiation to remaining parts of layers. - ! Excessively thin layers are not heated to avoid runaway temps. - do ks=1,nz ; do i=is,ie - k = ks - if (present(ksort)) then - if (ksort(i,ks) <= 0) cycle - k = ksort(i,ks) - endif - epsilon = 0.0 ; if (present(eps)) epsilon = eps(i,k) - - T_chg_above(i,k) = 0.0 - - if (h(i,k) > 1.5*epsilon) then - do n=1,nsw ; if (Pen_SW_bnd(n,i) > 0.0) then - ! SW_trans is the SW that is transmitted THROUGH the layer - opt_depth = h(i,k) * opacity_band(n,i,k) - exp_OD = exp(-opt_depth) - SW_trans = exp_OD - - ! Heating at a rate of less than 10-4 W m-2 = 10-3 K m / Century, - ! and of the layer in question less than 1 K / Century, can be - ! absorbed without further penetration. - ! ###Make these numbers into parameters! - if (nsw*Pen_SW_bnd(n,i)*SW_trans < & - dt*min_SW_heating*min(1.0*GV%m_to_H, 1e3*h(i,k)) ) SW_trans = 0.0 - - Heat_bnd = Pen_SW_bnd(n,i) * (1.0 - SW_trans) - if (adjustAbsorptionProfile .and. (h_heat(i) > 0.0)) then - ! In this case, a fraction of the heating is applied to the - ! overlying water so that the mean pressure at which the shortwave - ! heating occurs is exactly what it would have been with a careful - ! pressure-weighted averaging of the exponential heating profile, - ! hence there should be no TKE budget requirements due to this - ! layer. Very clever, but this is also limited so that the - ! water above is not heated at a faster rate than the layer - ! actually being heated, i.e., SWA <= h_heat / (h_heat + h(i,k)) - ! and takes the energetics of the rest of the heating into account. - ! (-RWH, ~7 years later.) - if (opt_depth > 1e-5) then - SWa = ((opt_depth + (opt_depth + 2.0)*exp_OD) - 2.0) / & - ((opt_depth + opacity_band(n,i,k) * h_heat(i)) * & - (1.0 - exp_OD)) - else - ! Use Taylor series expansion of the expression above for a - ! more accurate form with very small layer optical depths. - SWa = h(i,k) * (opt_depth * (1.0 - opt_depth)) / & - ((h_heat(i) + h(i,k)) * (6.0 - 3.0*opt_depth)) - endif - coSWa_frac = 0.0 - if (SWa*(h_heat(i) + h(i,k)) > h_heat(i)) then - coSWa_frac = (SWa*(h_heat(i) + h(i,k)) - h_heat(i) ) / & - (SWa*(h_heat(i) + h(i,k))) - SWa = h_heat(i) / (h_heat(i) + h(i,k)) - endif - - T_chg_above(i,k) = T_chg_above(i,k) + (SWa * Heat_bnd) / h_heat(i) - T(i,k) = T(i,k) + ((1.0 - SWa) * Heat_bnd) / h(i,k) - else - coSWa_frac = 1.0 - T(i,k) = T(i,k) + Pen_SW_bnd(n,i) * (1.0 - SW_trans) / h(i,k) - endif - - if (TKE_calc) then - if (opt_depth > 1e-2) then - TKE(i,k) = TKE(i,k) - coSWa_frac*Heat_bnd*dSV_dT(i,k)* & - (0.5*h(i,k)*g_Hconv2) * & - (opt_depth*(1.0+exp_OD) - 2.0*(1.0-exp_OD)) / (opt_depth*(1.0-exp_OD)) - else - ! Use Taylor series-derived approximation to the above expression - ! that is well behaved and more accurate when opt_depth is small. - TKE(i,k) = TKE(i,k) - coSWa_frac*Heat_bnd*dSV_dT(i,k)* & - (0.5*h(i,k)*g_Hconv2) * & - (C1_6*opt_depth * (1.0 - C1_60*opt_depth**2)) - endif - endif - - Pen_SW_bnd(n,i) = Pen_SW_bnd(n,i) * SW_trans - endif ; enddo - endif - - ! Add to the accumulated thickness above that could be heated. - ! Only layers greater than h_min_heat thick should get heated. - if (h(i,k) >= 2.0*h_min_heat) then - h_heat(i) = h_heat(i) + h(i,k) - elseif (h(i,k) > h_min_heat) then - h_heat(i) = h_heat(i) + (2.0*h(i,k) - 2.0*h_min_heat) - endif - enddo ; enddo ! i & k loops - - -! if (.not.absorbAllSW .and. .not.adjustAbsorptionProfile) return - - ! Unless modified, there is no temperature change due to fluxes from the bottom. - do i=is,ie ; T_chg(i) = 0.0 ; enddo - - if (absorbAllSW) then - ! If there is still shortwave radiation at this point, it could go into - ! the bottom (with a bottom mud model), or it could be redistributed back - ! through the water column. - do i=is,ie - Pen_SW_rem(i) = Pen_SW_bnd(1,i) - do n=2,nsw ; Pen_SW_rem(i) = Pen_SW_rem(i) + Pen_SW_bnd(n,i) ; enddo - enddo - do i=is,ie ; if (Pen_SW_rem(i) > 0.0) SW_Remains = .true. ; enddo - - Ih_limit = 1.0 / H_limit_fluxes - do i=is,ie ; if ((Pen_SW_rem(i) > 0.0) .and. (h_heat(i) > 0.0)) then - if (h_heat(i)*Ih_limit >= 1.0) then - T_chg(i) = Pen_SW_rem(i) / h_heat(i) ; unabsorbed = 0.0 - else - T_chg(i) = Pen_SW_rem(i) * Ih_limit - unabsorbed = 1.0 - h_heat(i)*Ih_limit - endif - do n=1,nsw ; Pen_SW_bnd(n,i) = unabsorbed * Pen_SW_bnd(n,i) ; enddo - endif ; enddo - endif ! absorbAllSW - - if (absorbAllSW .or. adjustAbsorptionProfile) then - do ks=nz,1,-1 ; do i=is,ie - k = ks - if (present(ksort)) then - if (ksort(i,ks) <= 0) cycle - k = ksort(i,ks) - endif - - if (T_chg(i) > 0.0) then - ! Only layers greater than h_min_heat thick should get heated. - if (h(i,k) >= 2.0*h_min_heat) then ; T(i,k) = T(i,k) + T_chg(i) - elseif (h(i,k) > h_min_heat) then - T(i,k) = T(i,k) + T_chg(i) * (2.0 - 2.0*h_min_heat/h(i,k)) - endif - endif - ! Increase the heating for layers above. - T_chg(i) = T_chg(i) + T_chg_above(i,k) - enddo ; enddo - if (present(htot) .and. present(Ttot)) then - do i=is,ie ; Ttot(i) = Ttot(i) + T_chg(i) * htot(i) ; enddo - endif - endif ! absorbAllSW .or. adjustAbsorptionProfile - -end subroutine absorbRemainingSW - - -subroutine sumSWoverBands(G, GV, US, h, opacity_band, nsw, j, dt, & - H_limit_fluxes, absorbAllSW, iPen_SW_bnd, netPen) -!< This subroutine calculates the total shortwave heat flux integrated over -!! bands as a function of depth. This routine is only called for computing -!! buoyancy fluxes for use in KPP. This routine does not updat e the state. - type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. - type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. - type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - real, dimension(SZI_(G),SZK_(G)), & - intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]. - real, dimension(:,:,:), intent(in) :: opacity_band !< opacity in each band of - !! penetrating shortwave radiation [m-1]. - !! The indicies are band, i, k. - integer, intent(in) :: nsw !< number of bands of penetrating - !! shortwave radiation. - integer, intent(in) :: j !< j-index to work on. - real, intent(in) :: dt !< Time step [T ~> s]. - real, intent(in) :: H_limit_fluxes !< the total depth at which the - !! surface fluxes start to be limited to avoid - !! excessive heating of a thin ocean [H ~> m or kg m-2] - logical, intent(in) :: absorbAllSW !< If true, ensure that all shortwave - !! radiation is absorbed in the ocean water column. - real, dimension(:,:), intent(in) :: iPen_SW_bnd !< The incident penetrating shortwave - !! heating in each band that hits the bottom and - !! will be redistributed through the water column - !! [degC H ~> degC m or degC kg m-2]; size nsw x SZI_(G). - real, dimension(SZI_(G),SZK_(G)+1), & - intent(inout) :: netPen !< Net penetrating shortwave heat flux at each - !! interface, summed across all bands - !! [degC H ~> degC m or degC kg m-2]. - ! Local variables - real :: h_heat(SZI_(G)) ! thickness of the water column that receives - ! remaining shortwave radiation [H ~> m or kg m-2]. - real :: Pen_SW_rem(SZI_(G)) ! sum across all wavelength bands of the - ! penetrating shortwave heating that hits the bottom - ! and will be redistributed through the water column - ! [degC H ~> degC m or degC kg m-2] - - real, dimension(size(iPen_SW_bnd,1),size(iPen_SW_bnd,2)) :: Pen_SW_bnd - real :: SW_trans ! fraction of shortwave radiation not - ! absorbed in a layer [nondim] - real :: unabsorbed ! fraction of the shortwave radiation - ! not absorbed because the layers are too thin. - real :: Ih_limit ! inverse of the total depth at which the - ! surface fluxes start to be limited [H-1 ~> m-1 or m2 kg-1] - real :: h_min_heat ! minimum thickness layer that should get heated [H ~> m or kg m-2] - real :: opt_depth ! optical depth of a layer [nondim] - real :: exp_OD ! exp(-opt_depth) [nondim] - logical :: SW_Remains ! If true, some column has shortwave radiation that - ! was not entirely absorbed. - - integer :: is, ie, nz, i, k, ks, n - SW_Remains = .false. - - h_min_heat = 2.0*GV%Angstrom_H + GV%H_subroundoff - is = G%isc ; ie = G%iec ; nz = G%ke - - pen_SW_bnd(:,:) = iPen_SW_bnd(:,:) - do i=is,ie ; h_heat(i) = 0.0 ; enddo - netPen(:,1) = sum( pen_SW_bnd(:,:), dim=1 ) ! Surface interface - - ! Apply penetrating SW radiation to remaining parts of layers. - ! Excessively thin layers are not heated to avoid runaway temps. - do k=1,nz - - do i=is,ie - netPen(i,k+1) = 0. - - if (h(i,k) > 0.0) then - do n=1,nsw ; if (Pen_SW_bnd(n,i) > 0.0) then - ! SW_trans is the SW that is transmitted THROUGH the layer - opt_depth = h(i,k)*GV%H_to_m * opacity_band(n,i,k) - exp_OD = exp(-opt_depth) - SW_trans = exp_OD - - ! Heating at a rate of less than 10-4 W m-2 = 10-3 K m / Century, - ! and of the layer in question less than 1 K / Century, can be - ! absorbed without further penetration. - if ((nsw*Pen_SW_bnd(n,i)*SW_trans < GV%m_to_H*2.5e-11*US%T_to_s*dt) .and. & - (nsw*Pen_SW_bnd(n,i)*SW_trans < h(i,k)*dt*US%T_to_s*2.5e-8)) & - SW_trans = 0.0 - - Pen_SW_bnd(n,i) = Pen_SW_bnd(n,i) * SW_trans - netPen(i,k+1) = netPen(i,k+1) + Pen_SW_bnd(n,i) - endif ; enddo - endif ! h(i,k) > 0.0 - - ! Add to the accumulated thickness above that could be heated. - ! Only layers greater than h_min_heat thick should get heated. - if (h(i,k) >= 2.0*h_min_heat) then - h_heat(i) = h_heat(i) + h(i,k) - elseif (h(i,k) > h_min_heat) then - h_heat(i) = h_heat(i) + (2.0*h(i,k) - 2.0*h_min_heat) - endif - enddo ! i loop - enddo ! k loop - - if (absorbAllSW) then - - ! If there is still shortwave radiation at this point, it could go into - ! the bottom (with a bottom mud model), or it could be redistributed back - ! through the water column. - do i=is,ie - Pen_SW_rem(i) = Pen_SW_bnd(1,i) - do n=2,nsw ; Pen_SW_rem(i) = Pen_SW_rem(i) + Pen_SW_bnd(n,i) ; enddo - enddo - do i=is,ie ; if (Pen_SW_rem(i) > 0.0) SW_Remains = .true. ; enddo - - Ih_limit = 1.0 / H_limit_fluxes - do i=is,ie ; if ((Pen_SW_rem(i) > 0.0) .and. (h_heat(i) > 0.0)) then - if (h_heat(i)*Ih_limit < 1.0) then - unabsorbed = 1.0 - h_heat(i)*Ih_limit - else - unabsorbed = 0.0 - endif - do n=1,nsw ; Pen_SW_bnd(n,i) = unabsorbed * Pen_SW_bnd(n,i) ; enddo - endif ; enddo - - endif ! absorbAllSW - -end subroutine sumSWoverBands - -end module MOM_shortwave_abs diff --git a/src/tracer/MOM_offline_aux.F90 b/src/tracer/MOM_offline_aux.F90 index 89f4a6eef4..37f66987c0 100644 --- a/src/tracer/MOM_offline_aux.F90 +++ b/src/tracer/MOM_offline_aux.F90 @@ -18,7 +18,7 @@ module MOM_offline_aux use astronomy_mod, only : orbital_time, diurnal_solar, daily_mean_solar use MOM_variables, only : vertvisc_type use MOM_forcing_type, only : forcing -use MOM_shortwave_abs, only : optics_type +use MOM_opacity, only : optics_type use MOM_diag_mediator, only : post_data use MOM_forcing_type, only : forcing diff --git a/src/tracer/MOM_offline_main.F90 b/src/tracer/MOM_offline_main.F90 index cb14df2c6a..8278e57264 100644 --- a/src/tracer/MOM_offline_main.F90 +++ b/src/tracer/MOM_offline_main.F90 @@ -26,9 +26,8 @@ module MOM_offline_main use MOM_offline_aux, only : update_h_horizontal_flux, update_h_vertical_flux, limit_mass_flux_3d use MOM_offline_aux, only : distribute_residual_uh_barotropic, distribute_residual_vh_barotropic use MOM_offline_aux, only : distribute_residual_uh_upwards, distribute_residual_vh_upwards -use MOM_opacity, only : opacity_CS +use MOM_opacity, only : opacity_CS, optics_type use MOM_open_boundary, only : ocean_OBC_type -use MOM_shortwave_abs, only : optics_type use MOM_time_manager, only : time_type use MOM_tracer_advect, only : tracer_advect_CS, advect_tracer use MOM_tracer_diabatic, only : applyTracerBoundaryFluxesInOut From d4b476e702853d7fd8df7c3fbf60292c865854ed Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Fri, 5 Jul 2019 18:05:16 -0400 Subject: [PATCH 068/297] 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 069/297] +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 070/297] +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 071/297] +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 072/297] +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 073/297] +(*)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 074/297] (*)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 075/297] 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 076/297] (*)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 077/297] 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 078/297] Add g_Earth to all versions of surface_forcing_CS Use an unscaled g_Earth from the control structures for the various MOM_surface_forcing modules when USE_RIGID_SEA_ICE is True, rather than assuming that the version of g_Earth in the lateral grid has not been scaled. All answers are bitwise identical, and the MOM_parameter_doc files are unchanged because other modules read G_EARTH before MOM_surface forcing. --- .../coupled_driver/MOM_surface_forcing.F90 | 14 ++++++----- config_src/mct_driver/MOM_surface_forcing.F90 | 24 +++++++++++-------- .../nuopc_driver/MOM_surface_forcing.F90 | 12 ++++++---- 3 files changed, 30 insertions(+), 20 deletions(-) diff --git a/config_src/coupled_driver/MOM_surface_forcing.F90 b/config_src/coupled_driver/MOM_surface_forcing.F90 index af7af37985..f48b755d67 100644 --- a/config_src/coupled_driver/MOM_surface_forcing.F90 +++ b/config_src/coupled_driver/MOM_surface_forcing.F90 @@ -101,8 +101,9 @@ module MOM_surface_forcing logical :: rigid_sea_ice !< If true, sea-ice exerts a rigidity that acts to damp surface !! deflections (especially surface gravity waves). The default is false. + real :: G_Earth !< Gravitational acceleration [m s-2] real :: Kv_sea_ice !< Viscosity in sea-ice that resists sheared vertical motions [m2 s-1] - real :: density_sea_ice !< Typical density of sea-ice (kg/m^3). The value is only used to convert + real :: density_sea_ice !< Typical density of sea-ice [kg m-3]. The value is only used to convert !! the ice pressure into appropriate units for use with Kv_sea_ice. real :: rigid_sea_ice_mass !< A mass per unit area of sea-ice beyond which sea-ice viscosity !! becomes effective [kg m-2], typically of order 1000 kg m-2. @@ -588,7 +589,7 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, US, CS, dt_ net_mass_src, & ! A temporary of net mass sources [kg m-2 s-1]. ustar_tmp ! A temporary array of ustar values [Z T-1 ~> m s-1]. - real :: I_GEarth ! 1.0 / G%G_Earth [s2 m-1] + real :: I_GEarth ! 1.0 / G_Earth [s2 m-1] real :: Kv_rho_ice ! (CS%kv_sea_ice / CS%density_sea_ice) [m5 s-1 kg-1] real :: mass_ice ! mass of sea ice at a face [kg m-2] real :: mass_eff ! effective mass of sea ice for rigidity [kg m-2] @@ -752,7 +753,7 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, US, CS, dt_ if (CS%rigid_sea_ice) then call pass_var(forces%p_surf_full, G%Domain, halo=1) - I_GEarth = 1.0 / G%G_Earth + I_GEarth = 1.0 / CS%G_Earth Kv_rho_ice = (CS%kv_sea_ice / CS%density_sea_ice) do I=is-1,ie ; do j=js,je mass_ice = min(forces%p_surf_full(i,j), forces%p_surf_full(i+1,j)) * I_GEarth @@ -1375,9 +1376,7 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS) call time_interp_external_init -! Optionally read a x-y gustiness field in place of a global -! constant. - + ! Optionally read a x-y gustiness field in place of a global constant. call get_param(param_file, mdl, "READ_GUST_2D", CS%read_gust_2d, & "If true, use a 2-dimensional gustiness supplied from "//& "an input file", default=.false.) @@ -1400,6 +1399,9 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS) "nonhydrostatic pressure that resist vertical motion.", & default=.false.) if (CS%rigid_sea_ice) then + call get_param(param_file, mdl, "G_EARTH", CS%g_Earth, & + "The gravitational acceleration of the Earth.", & + units="m s-2", default = 9.80) call get_param(param_file, mdl, "SEA_ICE_MEAN_DENSITY", CS%density_sea_ice, & "A typical density of sea ice, used with the kinematic "//& "viscosity, when USE_RIGID_SEA_ICE is true.", units="kg m-3", & diff --git a/config_src/mct_driver/MOM_surface_forcing.F90 b/config_src/mct_driver/MOM_surface_forcing.F90 index 6176b83602..252477b2b5 100644 --- a/config_src/mct_driver/MOM_surface_forcing.F90 +++ b/config_src/mct_driver/MOM_surface_forcing.F90 @@ -70,13 +70,13 @@ module MOM_surface_forcing real :: wind_stress_multiplier!< A multiplier applied to incoming wind stress (nondim). ! smg: remove when have A=B code reconciled logical :: bulkmixedlayer !< If true, model based on bulk mixed layer code - real :: Rho0 !< Boussinesq reference density (kg/m^3) - real :: area_surf = -1.0 !< total ocean surface area (m^2) - real :: latent_heat_fusion ! latent heat of fusion (J/kg) - real :: latent_heat_vapor ! latent heat of vaporization (J/kg) + real :: Rho0 !< Boussinesq reference density [kg m-3] + real :: area_surf = -1.0 !< Total ocean surface area [m2] + real :: latent_heat_fusion !< Latent heat of fusion [J kg-1] + real :: latent_heat_vapor !< Latent heat of vaporization [J kg-1] real :: max_p_surf !< maximum surface pressure that can be !! exerted by the atmosphere and floating sea-ice, - !! in Pa. This is needed because the FMS coupling + !! [Pa]. This is needed because the FMS coupling !! structure does not limit the water that can be !! frozen out of the ocean and the ice-ocean heat !! fluxes are treated explicitly. @@ -84,7 +84,7 @@ module MOM_surface_forcing !! the correction for the atmospheric (and sea-ice) !! pressure limited by max_p_surf instead of the !! full atmospheric pressure. The default is true. - real :: gust_const !< constant unresolved background gustiness for ustar (Pa) + real :: gust_const !< constant unresolved background gustiness for ustar [Pa] logical :: read_gust_2d !< If true, use a 2-dimensional gustiness supplied !! from an input file. real, pointer, dimension(:,:) :: & @@ -102,8 +102,9 @@ module MOM_surface_forcing logical :: rigid_sea_ice !< If true, sea-ice exerts a rigidity that acts !! to damp surface deflections (especially surface !! gravity waves). The default is false. - real :: Kv_sea_ice !< viscosity in sea-ice that resists sheared vertical motions (m^2/s) - real :: density_sea_ice !< typical density of sea-ice (kg/m^3). The value is + real :: G_Earth !< Gravitational acceleration [m s-2] + real :: Kv_sea_ice !< viscosity in sea-ice that resists sheared vertical motions [m2 s-1] + real :: density_sea_ice !< typical density of sea-ice [kg m-3]. The value is !! only used to convert the ice pressure into !! appropriate units for use with Kv_sea_ice. real :: rigid_sea_ice_mass !< A mass per unit area of sea-ice beyond which @@ -576,7 +577,7 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, US, CS) real :: Irho0 ! inverse of the mean density in (m^3/kg) real :: taux2, tauy2 ! squared wind stresses (Pa^2) real :: tau_mag ! magnitude of the wind stress (Pa) - real :: I_GEarth ! 1.0 / G%G_Earth (s^2/m) + real :: I_GEarth ! 1.0 / G_Earth [s2 m-1] real :: Kv_rho_ice ! (CS%kv_sea_ice / CS%density_sea_ice) ( m^5/(s*kg) ) real :: mass_ice ! mass of sea ice at a face (kg/m^2) real :: mass_eff ! effective mass of sea ice for rigidity (kg/m^2) @@ -762,7 +763,7 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, US, CS) ! sea ice related dynamic fields if (CS%rigid_sea_ice) then call pass_var(forces%p_surf_full, G%Domain, halo=1) - I_GEarth = 1.0 / G%G_Earth + I_GEarth = 1.0 / CS%G_Earth Kv_rho_ice = (CS%kv_sea_ice / CS%density_sea_ice) do I=is-1,ie ; do j=js,je mass_ice = min(forces%p_surf_full(i,j), forces%p_surf_full(i+1,j)) * I_GEarth @@ -1260,6 +1261,9 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, restore_salt, "nonhydrostatic pressure that resist vertical motion.", & default=.false.) if (CS%rigid_sea_ice) then + call get_param(param_file, mdl, "G_EARTH", CS%g_Earth, & + "The gravitational acceleration of the Earth.", & + units="m s-2", default = 9.80) call get_param(param_file, mdl, "SEA_ICE_MEAN_DENSITY", CS%density_sea_ice, & "A typical density of sea ice, used with the kinematic "//& "viscosity, when USE_RIGID_SEA_ICE is true.", units="kg m-3", & diff --git a/config_src/nuopc_driver/MOM_surface_forcing.F90 b/config_src/nuopc_driver/MOM_surface_forcing.F90 index e96399e2d8..5990aec2e0 100644 --- a/config_src/nuopc_driver/MOM_surface_forcing.F90 +++ b/config_src/nuopc_driver/MOM_surface_forcing.F90 @@ -101,8 +101,9 @@ module MOM_surface_forcing logical :: rigid_sea_ice !< If true, sea-ice exerts a rigidity that acts !! to damp surface deflections (especially surface !! gravity waves). The default is false. - real :: Kv_sea_ice !! viscosity in sea-ice that resists sheared vertical motions [m^2/s] - real :: density_sea_ice !< typical density of sea-ice [kg/m^3]. The value is + real :: G_Earth !< Gravitational acceleration [m s-2] + real :: Kv_sea_ice !! viscosity in sea-ice that resists sheared vertical motions [m2 s-1] + real :: density_sea_ice !< typical density of sea-ice [kg m-3]. The value is !! only used to convert the ice pressure into !! appropriate units for use with Kv_sea_ice. real :: rigid_sea_ice_mass !< A mass per unit area of sea-ice beyond which @@ -618,7 +619,7 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, US, CS) real :: Irho0 !< inverse of the mean density in (m^3/kg) real :: taux2, tauy2 !< squared wind stresses (Pa^2) real :: tau_mag !< magnitude of the wind stress [Pa] - real :: I_GEarth !< 1.0 / G%G_Earth (s^2/m) + real :: I_GEarth !< 1.0 / G_Earth [s2 m-1] real :: Kv_rho_ice !< (CS%kv_sea_ice / CS%density_sea_ice) ( m^5/(s*kg) ) real :: mass_ice !< mass of sea ice at a face (kg/m^2) real :: mass_eff !< effective mass of sea ice for rigidity (kg/m^2) @@ -840,7 +841,7 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, US, CS) if (CS%rigid_sea_ice) then call pass_var(forces%p_surf_full, G%Domain, halo=1) - I_GEarth = 1.0 / G%G_Earth + I_GEarth = 1.0 / CS%g_Earth Kv_rho_ice = (CS%kv_sea_ice / CS%density_sea_ice) do I=is-1,ie ; do j=js,je mass_ice = min(forces%p_surf_full(i,j), forces%p_surf_full(i+1,j)) * I_GEarth @@ -1258,6 +1259,9 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, restore_salt, "nonhydrostatic pressure that resist vertical motion.", & default=.false.) if (CS%rigid_sea_ice) then + call get_param(param_file, mdl, "G_EARTH", CS%g_Earth, & + "The gravitational acceleration of the Earth.", & + units="m s-2", default = 9.80) call get_param(param_file, mdl, "SEA_ICE_MEAN_DENSITY", CS%density_sea_ice, & "A typical density of sea ice, used with the kinematic "//& "viscosity, when USE_RIGID_SEA_ICE is true.", units="kg m-3", & From f258630a549031595e2357e88cde7ae221ce76c2 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 9 Jul 2019 11:48:33 -0400 Subject: [PATCH 079/297] +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 080/297] 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 081/297] +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 082/297] +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 083/297] +Added SURFACE_FORCING_2018_ANSWERS Added the new runtime parameter SURFACE_FORCING_2018_ANSWERS to enable the transition to newer and simpler expressions for gustless_ustar in the coupled_driver version of MOM_surface_forcing. Also replaced the markers in the comments around the controlled-forcing code with #CTRL# to distinguish them from other comments. By default all answers are bitwise identical, but there is a new entry in some MOM_parameter_doc files. --- .../coupled_driver/MOM_surface_forcing.F90 | 88 ++++++++++++------- 1 file changed, 54 insertions(+), 34 deletions(-) diff --git a/config_src/coupled_driver/MOM_surface_forcing.F90 b/config_src/coupled_driver/MOM_surface_forcing.F90 index f48b755d67..bb6270c177 100644 --- a/config_src/coupled_driver/MOM_surface_forcing.F90 +++ b/config_src/coupled_driver/MOM_surface_forcing.F90 @@ -2,9 +2,9 @@ module MOM_surface_forcing ! This file is part of MOM6. See LICENSE.md for the license. -!### use MOM_controlled_forcing, only : apply_ctrl_forcing, register_ctrl_forcing_restarts -!### use MOM_controlled_forcing, only : controlled_forcing_init, controlled_forcing_end -!### use MOM_controlled_forcing, only : ctrl_forcing_CS +!#CTRL# use MOM_controlled_forcing, only : apply_ctrl_forcing, register_ctrl_forcing_restarts +!#CTRL# use MOM_controlled_forcing, only : controlled_forcing_init, controlled_forcing_end +!#CTRL# use MOM_controlled_forcing, only : ctrl_forcing_CS use MOM_coms, only : reproducing_sum use MOM_constants, only : hlv, hlf use MOM_cpu_clock, only : cpu_clock_id, cpu_clock_begin, cpu_clock_end @@ -127,6 +127,9 @@ module MOM_surface_forcing real :: max_delta_srestore !< Maximum delta salinity used for restoring real :: max_delta_trestore !< Maximum delta sst used for restoring real, pointer, dimension(:,:) :: basin_mask => NULL() !< Mask for surface salinity restoring by basin + logical :: answers_2018 !< If true, use the order of arithmetic and expressions that recover + !! the answers from the end of 2018. Otherwise, use a simpler + !! expression to calculate gustiness. type(diag_ctrl), pointer :: diag => NULL() !< Structure to regulate diagnostic output timing character(len=200) :: inputdir !< Directory where NetCDF input files are @@ -149,7 +152,7 @@ module MOM_surface_forcing type(forcing_diags), public :: handles !< Diagnostics handles -!### type(ctrl_forcing_CS), pointer :: ctrl_forcing_CSp => NULL() +!#CTRL# type(ctrl_forcing_CS), pointer :: ctrl_forcing_CSp => NULL() type(MOM_restart_CS), pointer :: restart_CSp => NULL() !< A pointer to the restart control structure type(user_revise_forcing_CS), pointer :: urf_CS => NULL() !< A control structure for user forcing revisions end type surface_forcing_CS @@ -492,15 +495,15 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, US, CS, sfc enddo ; enddo endif -!### if (associated(CS%ctrl_forcing_CSp)) then -!### do j=js,je ; do i=is,ie -!### SST_anom(i,j) = sfc_state%SST(i,j) - CS%T_Restore(i,j) -!### SSS_anom(i,j) = sfc_state%SSS(i,j) - CS%S_Restore(i,j) -!### SSS_mean(i,j) = 0.5*(sfc_state%SSS(i,j) + CS%S_Restore(i,j)) -!### enddo ; enddo -!### call apply_ctrl_forcing(SST_anom, SSS_anom, SSS_mean, fluxes%heat_restore, & -!### fluxes%vprec, day, dt, G, CS%ctrl_forcing_CSp) -!### endif +!#CTRL# if (associated(CS%ctrl_forcing_CSp)) then +!#CTRL# do j=js,je ; do i=is,ie +!#CTRL# SST_anom(i,j) = sfc_state%SST(i,j) - CS%T_Restore(i,j) +!#CTRL# SSS_anom(i,j) = sfc_state%SSS(i,j) - CS%S_Restore(i,j) +!#CTRL# SSS_mean(i,j) = 0.5*(sfc_state%SSS(i,j) + CS%S_Restore(i,j)) +!#CTRL# enddo ; enddo +!#CTRL# call apply_ctrl_forcing(SST_anom, SSS_anom, SSS_mean, fluxes%heat_restore, & +!#CTRL# fluxes%vprec, day, dt, G, CS%ctrl_forcing_CSp) +!#CTRL# endif ! adjust the NET fresh-water flux to zero, if flagged if (CS%adjust_net_fresh_water_to_zero) then @@ -939,7 +942,6 @@ subroutine extract_IOB_stresses(IOB, index_bounds, Time, G, US, CS, taux, tauy, if (associated(IOB%stress_mag)) then if (do_ustar) then ; do j=js,je ; do i=is,ie gustiness = CS%gust_const - !### SIMPLIFY THE TREATMENT OF GUSTINESS! if (CS%read_gust_2d) then if ((wind_stagger == CGRID_NE) .or. & ((wind_stagger == AGRID) .and. (G%mask2dT(i,j) > 0)) .or. & @@ -950,11 +952,15 @@ subroutine extract_IOB_stresses(IOB, index_bounds, Time, G, US, CS, taux, tauy, endif ustar(i,j) = sqrt(gustiness*Irho0 + Irho0*IOB%stress_mag(i-i0,j-j0)) enddo ; enddo ; endif - if (do_gustless) then ; do j=js,je ; do i=is,ie - gustless_ustar(i,j) = US%m_to_Z*US%T_to_s * sqrt(IOB%stress_mag(i-i0,j-j0) / CS%Rho0) -!### Change to: -! gustless_ustar(i,j) = sqrt(Irho0 * IOB%stress_mag(i-i0,j-j0)) - enddo ; enddo ; endif + if (CS%answers_2018) then + if (do_gustless) then ; do j=js,je ; do i=is,ie + gustless_ustar(i,j) = US%m_to_Z*US%T_to_s * sqrt(IOB%stress_mag(i-i0,j-j0) / CS%Rho0) + enddo ; enddo ; endif + else + if (do_gustless) then ; do j=js,je ; do i=is,ie + gustless_ustar(i,j) = sqrt(Irho0 * IOB%stress_mag(i-i0,j-j0)) + enddo ; enddo ; endif + endif elseif (wind_stagger == BGRID_NE) then do j=js,je ; do i=is,ie tau_mag = 0.0 ; gustiness = CS%gust_const @@ -968,9 +974,11 @@ subroutine extract_IOB_stresses(IOB, index_bounds, Time, G, US, CS, taux, tauy, if (CS%read_gust_2d) gustiness = CS%gust(i,j) endif if (do_ustar) ustar(i,j) = sqrt(gustiness*Irho0 + Irho0 * tau_mag) - if (do_gustless) gustless_ustar(i,j) = US%m_to_Z*US%T_to_s * sqrt(tau_mag / CS%Rho0) -!### Change to: -! if (do_gustless) gustless_ustar(i,j) = sqrt(Irho0 * tau_mag) + if (CS%answers_2018) then + if (do_gustless) gustless_ustar(i,j) = US%m_to_Z*US%T_to_s * sqrt(tau_mag / CS%Rho0) + else + if (do_gustless) gustless_ustar(i,j) = sqrt(Irho0 * tau_mag) + endif enddo ; enddo elseif (wind_stagger == AGRID) then do j=js,je ; do i=is,ie @@ -978,9 +986,11 @@ subroutine extract_IOB_stresses(IOB, index_bounds, Time, G, US, CS, taux, tauy, gustiness = CS%gust_const if (CS%read_gust_2d .and. (G%mask2dT(i,j) > 0)) gustiness = CS%gust(i,j) if (do_ustar) ustar(i,j) = sqrt(gustiness*Irho0 + Irho0 * tau_mag) - if (do_gustless) gustless_ustar(i,j) = US%m_to_Z*US%T_to_s * sqrt(tau_mag / CS%Rho0) -!### Change to: -! if (do_gustless) gustless_ustar(i,j) = sqrt(Irho0 * tau_mag) + if (CS%answers_2018) then + if (do_gustless) gustless_ustar(i,j) = US%m_to_Z*US%T_to_s * sqrt(tau_mag / CS%Rho0) + else + if (do_gustless) gustless_ustar(i,j) = sqrt(Irho0 * tau_mag) + endif enddo ; enddo else ! C-grid wind stresses. do j=js,je ; do i=is,ie @@ -997,9 +1007,11 @@ subroutine extract_IOB_stresses(IOB, index_bounds, Time, G, US, CS, taux, tauy, if (CS%read_gust_2d) gustiness = CS%gust(i,j) if (do_ustar) ustar(i,j) = sqrt(gustiness*Irho0 + Irho0 * tau_mag) - if (do_gustless) gustless_ustar(i,j) = US%m_to_Z*US%T_to_s * sqrt(tau_mag / CS%Rho0) -!### Change to: -! if (do_gustless) gustless_ustar(i,j) = sqrt(Irho0 * tau_mag) + if (CS%answers_2018) then + if (do_gustless) gustless_ustar(i,j) = US%m_to_Z*US%T_to_s * sqrt(tau_mag / CS%Rho0) + else + if (do_gustless) gustless_ustar(i,j) = sqrt(Irho0 * tau_mag) + endif enddo ; enddo endif ! endif for wind friction velocity fields endif @@ -1145,10 +1157,11 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS) real :: utide ! The RMS tidal velocity [m s-1]. type(directories) :: dirs logical :: new_sim, iceberg_flux_diags + logical :: default_2018_answers type(time_type) :: Time_frc character(len=200) :: TideAmp_file, gust_file, salt_file, temp_file ! Input file names. -! This include declares and sets the variable "version". -#include "version_variable.h" + ! This include declares and sets the variable "version". +# include "version_variable.h" character(len=40) :: mdl = "MOM_surface_forcing" ! This module's name. character(len=48) :: stagger character(len=48) :: flnam @@ -1392,6 +1405,13 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS) gust_file = trim(CS%inputdir) // trim(gust_file) call MOM_read_data(gust_file,'gustiness',CS%gust,G%domain, timelevel=1) ! units should be Pa endif + call get_param(param_file, mdl, "DEFAULT_2018_ANSWERS", default_2018_answers, & + "This sets the default value for the various _2018_ANSWERS parameters.", & + default=.true.) + call get_param(param_file, mdl, "SURFACE_FORCING_2018_ANSWERS", CS%answers_2018, & + "If true, use the order of arithmetic and expressions that recover the answers "//& + "from the end of 2018. Otherwise, use a simpler expression to calculate gustiness.", & + default=default_2018_answers) ! See whether sufficiently thick sea ice should be treated as rigid. call get_param(param_file, mdl, "USE_RIGID_SEA_ICE", CS%rigid_sea_ice, & @@ -1449,8 +1469,8 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS) ! Set up any restart fields associated with the forcing. call restart_init(param_file, CS%restart_CSp, "MOM_forcing.res") -!### call register_ctrl_forcing_restarts(G, param_file, CS%ctrl_forcing_CSp, & -!### CS%restart_CSp) +!#CTRL# call register_ctrl_forcing_restarts(G, param_file, CS%ctrl_forcing_CSp, & +!#CTRL# CS%restart_CSp) call restart_init_end(CS%restart_CSp) if (associated(CS%restart_CSp)) then @@ -1465,7 +1485,7 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS) endif endif -!### call controlled_forcing_init(Time, G, param_file, diag, CS%ctrl_forcing_CSp) +!#CTRL# call controlled_forcing_init(Time, G, param_file, diag, CS%ctrl_forcing_CSp) call user_revise_forcing_init(param_file, CS%urf_CS) @@ -1483,7 +1503,7 @@ subroutine surface_forcing_end(CS, fluxes) if (present(fluxes)) call deallocate_forcing_type(fluxes) -!### call controlled_forcing_end(CS%ctrl_forcing_CSp) +!#CTRL# call controlled_forcing_end(CS%ctrl_forcing_CSp) if (associated(CS)) deallocate(CS) CS => NULL() From 5645cc0d35ff2de14e15b17989eec5c4a5faf5d5 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Wed, 10 Jul 2019 10:33:01 -0400 Subject: [PATCH 084/297] 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 085/297] (*)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 086/297] +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 087/297] +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 088/297] 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 089/297] 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 090/297] +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 091/297] +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 092/297] +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 093/297] 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 094/297] 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 095/297] 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 096/297] +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 891b8366d164f43812990acece1bf41aa3051d0b Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Mon, 15 Jul 2019 04:31:03 -0400 Subject: [PATCH 097/297] (+*)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 098/297] 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 099/297] +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 100/297] 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 101/297] (*)+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 102/297] +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 ebd503022a763f1b34268def4054257051008320 Mon Sep 17 00:00:00 2001 From: Marshall Ward Date: Tue, 16 Jul 2019 16:01:00 -0400 Subject: [PATCH 103/297] 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 104/297] +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 105/297] +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 106/297] 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 9320b6a31f7626f149f4f5494c5371720b094b59 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Wed, 17 Jul 2019 04:47:07 -0400 Subject: [PATCH 107/297] 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 108/297] 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 109/297] 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 110/297] +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 111/297] 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 112/297] 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 113/297] +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 114/297] (*) 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 115/297] 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 116/297] 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 117/297] 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 118/297] 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 119/297] 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 120/297] 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 121/297] 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 122/297] 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 21a5e37d6989a12a5833cd9a08d0ad30a5af15a0 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 30 Jul 2019 07:33:23 -0400 Subject: [PATCH 123/297] 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 124/297] +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 125/297] +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 eb9cbc20a46942267f1052e13aecd568a538e62d Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 30 Jul 2019 15:12:38 -0400 Subject: [PATCH 126/297] +Rescaled uhtr and vhtr Rescaled the units for the mass fluxes that do tracer transport to [L2 H] for expanded dimensional consistency testing. This required the addition of unit_scale_type arguments to several routines. In addition some commments were added or corrected. All answers are bitwise identical, but there are some minor changes to public interfaces. The offline tracer capability is not being tested in the MOM6-examples test suite, so there is not guarantee that it will pass the dimensional consistency tests, but the cases in the test suite all pass. --- src/core/MOM.F90 | 27 ++++++++++--------- src/core/MOM_dynamics_split_RK2.F90 | 8 +++--- src/core/MOM_dynamics_unsplit.F90 | 12 ++++----- src/core/MOM_dynamics_unsplit_RK2.F90 | 8 +++--- src/diagnostics/MOM_diagnostics.F90 | 18 +++++++------ src/parameterizations/lateral/MOM_MEKE.F90 | 15 ++++++----- .../lateral/MOM_mixed_layer_restrat.F90 | 20 +++++++------- .../lateral/MOM_thickness_diffuse.F90 | 10 +++---- src/tracer/MOM_offline_main.F90 | 19 ++++++++----- src/tracer/MOM_tracer_advect.F90 | 12 +++++---- 10 files changed, 81 insertions(+), 68 deletions(-) diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index 901b15fd4a..b46c0ff7e4 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -157,11 +157,11 @@ module MOM real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_,NKMEM_) :: & u, & !< zonal velocity component [m s-1] uh, & !< uh = u * h * dy at u grid points [H m2 s-1 ~> m3 s-1 or kg s-1] - uhtr !< accumulated zonal thickness fluxes to advect tracers [H m2 ~> m3 or kg] + uhtr !< accumulated zonal thickness fluxes to advect tracers [H L2 ~> m3 or kg] real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_,NKMEM_) :: & v, & !< meridional velocity [m s-1] vh, & !< vh = v * h * dx at v grid points [H m2 s-1 ~> m3 s-1 or kg s-1] - vhtr !< accumulated meridional thickness fluxes to advect tracers [H m2 ~> m3 or kg] + vhtr !< accumulated meridional thickness fluxes to advect tracers [H L2 ~> m3 or kg] real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: ssh_rint !< A running time integral of the sea surface height [s m]. real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: ave_ssh_ibc @@ -716,7 +716,7 @@ subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, CS, & endif if (do_advection) then ! Do advective transport and lateral tracer mixing. - call step_MOM_tracer_dyn(CS, G, GV, h, Time_local) + call step_MOM_tracer_dyn(CS, G, GV, US, h, Time_local) CS%ndyn_per_adv = 0 if (CS%diabatic_first .and. abs(CS%t_dyn_rel_thermo) > 1e-6*dt) call MOM_error(FATAL, & "step_MOM: Mismatch between the dynamics and diabatic times "//& @@ -1008,7 +1008,7 @@ subroutine step_MOM_dynamics(forces, p_surf_begin, p_surf_end, dt, dt_thermo, & if (CS%debug) then call hchksum(h,"Pre-mixedlayer_restrat h", G%HI, haloshift=1, scale=GV%H_to_m) call uvchksum("Pre-mixedlayer_restrat uhtr", & - CS%uhtr, CS%vhtr, G%HI, haloshift=0, scale=GV%H_to_m) + CS%uhtr, CS%vhtr, G%HI, haloshift=0, scale=GV%H_to_m*US%L_to_m**2) endif call cpu_clock_begin(id_clock_ml_restrat) call mixedlayer_restrat(h, CS%uhtr, CS%vhtr, CS%tv, forces, dt, CS%visc%MLD, & @@ -1018,7 +1018,7 @@ subroutine step_MOM_dynamics(forces, p_surf_begin, p_surf_end, dt, dt_thermo, & if (CS%debug) then call hchksum(h,"Post-mixedlayer_restrat h", G%HI, haloshift=1, scale=GV%H_to_m) call uvchksum("Post-mixedlayer_restrat [uv]htr", & - CS%uhtr, CS%vhtr, G%HI, haloshift=0, scale=GV%H_to_m) + CS%uhtr, CS%vhtr, G%HI, haloshift=0, scale=GV%H_to_m*US%L_to_m**2) endif endif @@ -1052,10 +1052,11 @@ end subroutine step_MOM_dynamics !> step_MOM_tracer_dyn does tracer advection and lateral diffusion, bringing the !! tracers up to date with the changes in state due to the dynamics. Surface !! sources and sinks and remapping are handled via step_MOM_thermo. -subroutine step_MOM_tracer_dyn(CS, G, GV, h, Time_local) +subroutine step_MOM_tracer_dyn(CS, G, GV, US, h, Time_local) type(MOM_control_struct), intent(inout) :: CS !< control structure 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(SZI_(G),SZJ_(G),SZK_(G)), & intent(in) :: h !< layer thicknesses after the transports [H ~> m or kg m-2] type(time_type), intent(in) :: Time_local !< The model time at the end @@ -1068,7 +1069,7 @@ subroutine step_MOM_tracer_dyn(CS, G, GV, h, Time_local) call cpu_clock_begin(id_clock_other) call hchksum(h,"Pre-advection h", G%HI, haloshift=1, scale=GV%H_to_m) call uvchksum("Pre-advection uhtr", CS%uhtr, CS%vhtr, G%HI, & - haloshift=0, scale=GV%H_to_m) + haloshift=0, scale=GV%H_to_m*US%L_to_m**2) if (associated(CS%tv%T)) call hchksum(CS%tv%T, "Pre-advection T", G%HI, haloshift=1) if (associated(CS%tv%S)) call hchksum(CS%tv%S, "Pre-advection S", G%HI, haloshift=1) if (associated(CS%tv%frazil)) call hchksum(CS%tv%frazil, & @@ -1082,7 +1083,7 @@ subroutine step_MOM_tracer_dyn(CS, G, GV, h, Time_local) call cpu_clock_begin(id_clock_thermo) ; call cpu_clock_begin(id_clock_tracer) call enable_averaging(CS%t_dyn_rel_adv, Time_local, CS%diag) - call advect_tracer(h, CS%uhtr, CS%vhtr, CS%OBC, CS%t_dyn_rel_adv, G, GV, & + call advect_tracer(h, CS%uhtr, CS%vhtr, CS%OBC, CS%t_dyn_rel_adv, G, GV, US, & CS%tracer_adv_CSp, CS%tracer_Reg) call tracer_hordiff(h, CS%t_dyn_rel_adv, CS%MEKE, CS%VarMix, G, GV, & CS%tracer_diff_CSp, CS%tracer_Reg, CS%tv) @@ -1090,7 +1091,7 @@ subroutine step_MOM_tracer_dyn(CS, G, GV, h, Time_local) call cpu_clock_end(id_clock_tracer) ; call cpu_clock_end(id_clock_thermo) call cpu_clock_begin(id_clock_other) ; call cpu_clock_begin(id_clock_diagnostics) - call post_transport_diagnostics(G, GV, CS%uhtr, CS%vhtr, h, CS%transport_IDs, & + call post_transport_diagnostics(G, GV, US, CS%uhtr, CS%vhtr, h, CS%transport_IDs, & CS%diag_pre_dyn, CS%diag, CS%t_dyn_rel_adv, CS%tracer_reg) ! Rebuild the remap grids now that we've posted the fields which rely on thicknesses ! from before the dynamics calls @@ -1177,7 +1178,7 @@ subroutine step_MOM_thermo(CS, G, GV, US, u, v, h, tv, fluxes, dtdia, & call uvchksum("Pre-diabatic [uv]", u, v, G%HI, haloshift=2) call hchksum(h,"Pre-diabatic h", G%HI, haloshift=1, scale=GV%H_to_m) call uvchksum("Pre-diabatic [uv]h", CS%uhtr, CS%vhtr, G%HI, & - haloshift=0, scale=GV%H_to_m) + haloshift=0, scale=GV%H_to_m*US%L_to_m**2) ! call MOM_state_chksum("Pre-diabatic ",u, v, h, CS%uhtr, CS%vhtr, G, GV) call MOM_thermo_chksum("Pre-diabatic ", tv, G,haloshift=0) call check_redundant("Pre-diabatic ", u, v, G) @@ -1253,7 +1254,7 @@ subroutine step_MOM_thermo(CS, G, GV, US, u, v, h, tv, fluxes, dtdia, & call uvchksum("Post-diabatic u", u, v, G%HI, haloshift=2) call hchksum(h, "Post-diabatic h", G%HI, haloshift=1, scale=GV%H_to_m) call uvchksum("Post-diabatic [uv]h", CS%uhtr, CS%vhtr, G%HI, & - haloshift=0, scale=GV%H_to_m) + haloshift=0, scale=GV%H_to_m*US%L_to_m**2) ! call MOM_state_chksum("Post-diabatic ", u, v, & ! h, CS%uhtr, CS%vhtr, G, GV, haloshift=1) if (associated(tv%T)) call hchksum(tv%T, "Post-diabatic T", G%HI, haloshift=1) @@ -2360,7 +2361,7 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & ! now register some diagnostics since the tracer registry is now locked call register_surface_diags(Time, G, CS%sfc_IDs, CS%diag, CS%tv) call register_diags(Time, G, GV, CS%IDs, CS%diag) - call register_transport_diags(Time, G, GV, CS%transport_IDs, CS%diag) + call register_transport_diags(Time, G, GV, US, CS%transport_IDs, CS%diag) call register_tracer_diagnostics(CS%tracer_Reg, CS%h, Time, diag, G, GV, & CS%use_ALE_algorithm) if (CS%use_ALE_algorithm) then @@ -2380,7 +2381,7 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & if (CS%offline_tracer_mode) then ! Setup some initial parameterizations and also assign some of the subtypes - call offline_transport_init(param_file, CS%offline_CSp, CS%diabatic_CSp, G, GV) + call offline_transport_init(param_file, CS%offline_CSp, CS%diabatic_CSp, G, GV, US) call insert_offline_main( CS=CS%offline_CSp, ALE_CSp=CS%ALE_CSp, diabatic_CSp=CS%diabatic_CSp, & diag=CS%diag, OBC=CS%OBC, tracer_adv_CSp=CS%tracer_adv_CSp, & tracer_flow_CSp=CS%tracer_flow_CSp, tracer_Reg=CS%tracer_Reg, & diff --git a/src/core/MOM_dynamics_split_RK2.F90 b/src/core/MOM_dynamics_split_RK2.F90 index f256df6508..4c9a9de747 100644 --- a/src/core/MOM_dynamics_split_RK2.F90 +++ b/src/core/MOM_dynamics_split_RK2.F90 @@ -260,10 +260,10 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & !! [H m2 s-1 ~> m3 s-1 or kg s-1] real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & intent(inout) :: uhtr !< accumulatated zonal volume/mass transport - !! since last tracer advection [H m2 ~> m3 or kg] + !! since last tracer advection [H L2 ~> m3 or kg] real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & intent(inout) :: vhtr !< accumulatated merid volume/mass transport - !! since last tracer advection [H m2 ~> m3 or kg] + !! since last tracer advection [H L2 ~> m3 or kg] real, dimension(SZI_(G),SZJ_(G)), intent(out) :: eta_av !< free surface height or column mass time !! averaged over time step [H ~> m or kg m-2] type(MOM_dyn_split_RK2_CS), pointer :: CS !< module control structure @@ -843,10 +843,10 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & !$OMP parallel do default(shared) do k=1,nz do j=js-2,je+2 ; do I=Isq-2,Ieq+2 - uhtr(I,j,k) = uhtr(I,j,k) + uh(I,j,k)*dt + uhtr(I,j,k) = uhtr(I,j,k) + US%m_to_L**2*uh(I,j,k)*dt enddo ; enddo do J=Jsq-2,Jeq+2 ; do i=is-2,ie+2 - vhtr(i,J,k) = vhtr(i,J,k) + vh(i,J,k)*dt + vhtr(i,J,k) = vhtr(i,J,k) + US%m_to_L**2*vh(i,J,k)*dt enddo ; enddo enddo diff --git a/src/core/MOM_dynamics_unsplit.F90 b/src/core/MOM_dynamics_unsplit.F90 index 07c4648b87..13cca76616 100644 --- a/src/core/MOM_dynamics_unsplit.F90 +++ b/src/core/MOM_dynamics_unsplit.F90 @@ -207,9 +207,9 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: vh !< The meridional volume or mass !! transport [H m2 s-1 ~> m3 or kg s-1]. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: uhtr !< The accumulated zonal volume or mass - !! transport since the last tracer advection [H m2 ~> m3 or kg]. + !! transport since the last tracer advection [H L2 ~> m3 or kg]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: vhtr !< The accumulated meridional volume or mass - !! transport since the last tracer advection [H m2 ~> m3 or kg]. + !! transport since the last tracer advection [H L2 ~> m3 or kg]. real, dimension(SZI_(G),SZJ_(G)), intent(out) :: eta_av !< The time-mean free surface height or !! column mass [H ~> m or kg m-2]. type(MOM_dyn_unsplit_CS), pointer :: CS !< The control structure set up by @@ -289,10 +289,10 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & 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) + uhtr(i,j,k) = uhtr(i,j,k) + 0.5*dt*US%m_to_L**2*uh(i,j,k) enddo ; enddo do J=Jsq-2,Jeq+2 ; do i=is-2,ie+2 - vhtr(i,j,k) = vhtr(i,j,k) + 0.5*dt*vh(i,j,k) + vhtr(i,j,k) = vhtr(i,j,k) + 0.5*dt*US%m_to_L**2*vh(i,j,k) enddo ; enddo enddo call cpu_clock_end(id_clock_mom_update) @@ -441,10 +441,10 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & h_av(i,j,k) = 0.5*(h(i,j,k) + hp(i,j,k)) 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) + uhtr(i,j,k) = uhtr(i,j,k) + 0.5*dt*US%m_to_L**2*uh(i,j,k) enddo ; enddo do J=Jsq-2,Jeq+2 ; do i=is-2,ie+2 - vhtr(i,j,k) = vhtr(i,j,k) + 0.5*dt*vh(i,j,k) + vhtr(i,j,k) = vhtr(i,j,k) + 0.5*dt*US%m_to_L**2*vh(i,j,k) enddo ; enddo enddo diff --git a/src/core/MOM_dynamics_unsplit_RK2.F90 b/src/core/MOM_dynamics_unsplit_RK2.F90 index 2ad0c50624..bae771a6c2 100644 --- a/src/core/MOM_dynamics_unsplit_RK2.F90 +++ b/src/core/MOM_dynamics_unsplit_RK2.F90 @@ -218,10 +218,10 @@ subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt, !! transport [H m2 s-1 ~> m3 or kg s-1]. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: uhtr !< The accumulated zonal volume or !! mass transport since the last - !! tracer advection [H m2 ~> m3 or kg]. + !! tracer advection [H L2 ~> m3 or kg]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: vhtr !< The accumulated meridional volume !! or mass transport since the last - !! tracer advection [H m2 ~> m3 or kg]. + !! tracer advection [H L2 ~> m3 or kg]. real, dimension(SZI_(G),SZJ_(G)), intent(out) :: eta_av !< The time-mean free surface height !! or column mass [H ~> m or kg m-2]. type(MOM_dyn_unsplit_RK2_CS), pointer :: CS !< The control structure set up by @@ -418,10 +418,10 @@ subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt, ! Accumulate mass flux for tracer transport do k=1,nz do j=js-2,je+2 ; do I=Isq-2,Ieq+2 - uhtr(I,j,k) = uhtr(I,j,k) + dt*uh(I,j,k) + uhtr(I,j,k) = uhtr(I,j,k) + dt*US%m_to_L**2*uh(I,j,k) enddo ; enddo do J=Jsq-2,Jeq+2 ; do i=is-2,ie+2 - vhtr(i,J,k) = vhtr(i,J,k) + dt*vh(i,J,k) + vhtr(i,J,k) = vhtr(i,J,k) + dt*US%m_to_L**2*vh(i,J,k) enddo ; enddo enddo diff --git a/src/diagnostics/MOM_diagnostics.F90 b/src/diagnostics/MOM_diagnostics.F90 index a35d4edd7a..ed9e805b5b 100644 --- a/src/diagnostics/MOM_diagnostics.F90 +++ b/src/diagnostics/MOM_diagnostics.F90 @@ -1335,14 +1335,15 @@ end subroutine post_surface_thermo_diags !> This routine posts diagnostics of the transports, including the subgridscale !! contributions. -subroutine post_transport_diagnostics(G, GV, uhtr, vhtr, h, IDs, diag_pre_dyn, & +subroutine post_transport_diagnostics(G, GV, US, uhtr, vhtr, h, IDs, diag_pre_dyn, & diag, dt_trans, Reg) 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(in) :: uhtr !< Accumulated zonal thickness fluxes - !! used to advect tracers [H m2 ~> m3 or kg] + !! used to advect tracers [H L2 ~> m3 or kg] real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: vhtr !< Accumulated meridional thickness fluxes - !! used to advect tracers [H m2 ~> m3 or kg] + !! used to advect tracers [H L2 ~> m3 or kg] real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(in) :: h !< The updated layer thicknesses [H ~> m or kg m-2] type(transport_diag_IDs), intent(in) :: IDs !< A structure with the diagnostic IDs. @@ -1360,12 +1361,12 @@ subroutine post_transport_diagnostics(G, GV, uhtr, vhtr, h, IDs, diag_pre_dyn, & ! [H s-1 ~> m s-1 or kg m-2 s-1]. real :: Idt ! The inverse of the time interval [s-1] real :: H_to_kg_m2_dt ! A conversion factor from accumulated transports to fluxes - ! [kg m-2 H-1 s-1 ~> kg m-3 s-1 or s-1]. + ! [kg L-2 H-1 s-1 ~> kg m-3 s-1 or 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 Idt = 1. / dt_trans - H_to_kg_m2_dt = GV%H_to_kg_m2 * Idt + H_to_kg_m2_dt = GV%H_to_kg_m2 * US%L_to_m**2 * Idt call diag_save_grids(diag) call diag_copy_storage_to_diag(diag, diag_pre_dyn) @@ -1792,10 +1793,11 @@ subroutine register_surface_diags(Time, G, IDs, diag, tv) end subroutine register_surface_diags !> Register certain diagnostics related to transports -subroutine register_transport_diags(Time, G, GV, IDs, diag) +subroutine register_transport_diags(Time, G, GV, US, IDs, diag) type(time_type), intent(in) :: Time !< current model 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(transport_diag_IDs), intent(inout) :: IDs !< A structure with the diagnostic IDs. type(diag_ctrl), intent(inout) :: diag !< regulates diagnostic output @@ -1812,10 +1814,10 @@ subroutine register_transport_diags(Time, G, GV, IDs, diag) ! Diagnostics related to tracer and mass transport IDs%id_uhtr = register_diag_field('ocean_model', 'uhtr', diag%axesCuL, Time, & 'Accumulated zonal thickness fluxes to advect tracers', 'kg', & - y_cell_method='sum', v_extensive=.true., conversion=H_convert) + y_cell_method='sum', v_extensive=.true., conversion=H_convert*US%L_to_m**2) IDs%id_vhtr = register_diag_field('ocean_model', 'vhtr', diag%axesCvL, Time, & 'Accumulated meridional thickness fluxes to advect tracers', 'kg', & - x_cell_method='sum', v_extensive=.true., conversion=H_convert) + x_cell_method='sum', v_extensive=.true., conversion=H_convert*US%L_to_m**2) IDs%id_umo = register_diag_field('ocean_model', 'umo', & diag%axesCuL, Time, 'Ocean Mass X Transport', 'kg s-1', & standard_name='ocean_mass_x_transport', y_cell_method='sum', v_extensive=.true.) diff --git a/src/parameterizations/lateral/MOM_MEKE.F90 b/src/parameterizations/lateral/MOM_MEKE.F90 index 54726fe9fb..0923c33c59 100644 --- a/src/parameterizations/lateral/MOM_MEKE.F90 +++ b/src/parameterizations/lateral/MOM_MEKE.F90 @@ -109,8 +109,8 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h type(vertvisc_type), intent(in) :: visc !< The vertical viscosity type. real, intent(in) :: dt !< Model(baroclinic) time-step [s]. type(MEKE_CS), pointer :: CS !< MEKE control structure. - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: hu !< Zonal mass flux [H m2 s-1 ~> m3 s-1 or kg s-1]. - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: hv !< Meridional mass flux [H m2 s-1 ~> m3 s-1 or kg s-1] + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: hu !< Accumlated zonal mass flux [H L2 ~> m3 or kg]. + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: hv !< Accumlated meridional mass flux [H L2 ~> m3 or kg] ! Local variables real, dimension(SZI_(G),SZJ_(G)) :: & @@ -132,18 +132,19 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h real, dimension(SZIB_(G),SZJ_(G)) :: & MEKE_uflux, & ! The zonal diffusive flux of MEKE [kg m2 s-3]. Kh_u, & ! The zonal diffusivity that is actually used [m2 s-1]. - baroHu, & ! Depth integrated zonal mass flux [H m2 s-1 ~> m3 s-1 or kg s-1]. + baroHu, & ! Depth integrated accumulated zonal mass flux [H m2 ~> m3 or kg]. drag_vel_u ! A (vertical) viscosity associated with bottom drag at ! u-points [m s-1]. real, dimension(SZI_(G),SZJB_(G)) :: & MEKE_vflux, & ! The meridional diffusive flux of MEKE [kg m2 s-3]. Kh_v, & ! The meridional diffusivity that is actually used [m2 s-1]. - baroHv, & ! Depth integrated meridional mass flux [H m2 s-1 ~> m3 s-1 or kg s-1]. + baroHv, & ! Depth integrated accumulated meridional mass flux [H m2 ~> m3 or kg]. drag_vel_v ! A (vertical) viscosity associated with bottom drag at ! v-points [m s-1]. real :: Kh_here, Inv_Kh_max, K4_here real :: cdrag2 - real :: advFac + real :: advFac ! The product of the advection scaling factor and some unit conversion + ! factors divided by the timestep [m H-1 s-1 ~> s-1 or m3 kg-1 s-1] real :: mass_neglect ! A negligible mass [kg m-2]. real :: ldamping ! The MEKE damping rate [s-1]. real :: Rho0 ! A density used to convert mass to distance [kg m-3]. @@ -199,7 +200,7 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h enddo ; enddo do k=1,nz do j=js,je ; do I=is-1,ie - baroHu(I,j) = hu(I,j,k) + baroHu(I,j) = US%L_to_m**2*hu(I,j,k) enddo ; enddo enddo do J=js-1,je ; do i=is,ie @@ -207,7 +208,7 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h enddo ; enddo do k=1,nz do J=js-1,je ; do i=is,ie - baroHv(i,J) = hv(i,J,k) + baroHv(i,J) = US%L_to_m**2*hv(i,J,k) enddo ; enddo enddo endif diff --git a/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 b/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 index 546f320136..3f1164fc77 100644 --- a/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 +++ b/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 @@ -94,9 +94,9 @@ subroutine mixedlayer_restrat(h, uhtr, vhtr, tv, forces, dt, MLD, VarMix, G, GV, type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: h !< Layer thickness [H ~> m or kg m-2] real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: uhtr !< Accumulated zonal mass flux - !! [H m2 ~> m3 or kg] + !! [H L2 ~> m3 or kg] real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: vhtr !< Accumulated meridional mass flux - !! [H m2 ~> m3 or kg] + !! [H L2 ~> m3 or kg] type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamic variables structure type(mech_forcing), intent(in) :: forces !< A structure with the driving mechanical forces real, intent(in) :: dt !< Time increment [s] @@ -124,9 +124,9 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: h !< Layer thickness [H ~> m or kg m-2] real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: uhtr !< Accumulated zonal mass flux - !! [H m2 ~> m3 or kg] + !! [H L2 ~> m3 or kg] real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: vhtr !< Accumulated meridional mass flux - !! [H m2 ~> m3 or kg] + !! [H L2 ~> m3 or kg] type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamic variables structure type(mech_forcing), intent(in) :: forces !< A structure with the driving mechanical forces real, intent(in) :: dt !< Time increment [s] @@ -421,7 +421,7 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var enddo do k=1,nz uhml(I,j,k) = a(k)*uDml(I) + b(k)*uDml_slow(I) - uhtr(I,j,k) = uhtr(I,j,k) + uhml(I,j,k)*dt + uhtr(I,j,k) = uhtr(I,j,k) + US%m_to_L**2*uhml(I,j,k)*dt enddo endif @@ -497,7 +497,7 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var enddo do k=1,nz vhml(i,J,k) = a(k)*vDml(i) + b(k)*vDml_slow(i) - vhtr(i,J,k) = vhtr(i,J,k) + vhml(i,J,k)*dt + vhtr(i,J,k) = vhtr(i,J,k) + US%m_to_L**2*vhml(i,J,k)*dt enddo endif @@ -553,9 +553,9 @@ subroutine mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, dt, G, GV, US, CS) type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: h !< Layer thickness [H ~> m or kg m-2] real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: uhtr !< Accumulated zonal mass flux - !! [H m2 ~> m3 or kg] + !! [H L2 ~> m3 or kg] real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: vhtr !< Accumulated meridional mass flux - !! [H m2 ~> m3 or kg] + !! [H L2 ~> m3 or kg] type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamic variables structure type(mech_forcing), intent(in) :: forces !< A structure with the driving mechanical forces real, intent(in) :: dt !< Time increment [s] @@ -687,7 +687,7 @@ subroutine mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, dt, G, GV, US, CS) enddo do k=1,nkml uhml(I,j,k) = a(k)*uDml(I) - uhtr(I,j,k) = uhtr(I,j,k) + uhml(I,j,k)*dt + uhtr(I,j,k) = uhtr(I,j,k) + US%m_to_L**2*uhml(I,j,k)*dt enddo endif @@ -733,7 +733,7 @@ subroutine mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, dt, G, GV, US, CS) enddo do k=1,nkml vhml(i,J,k) = a(k)*vDml(i) - vhtr(i,J,k) = vhtr(i,J,k) + vhml(i,J,k)*dt + vhtr(i,J,k) = vhtr(i,J,k) + US%m_to_L**2*vhml(i,J,k)*dt enddo endif diff --git a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 index 04d3847e88..2b62a388fb 100644 --- a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 +++ b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 @@ -102,9 +102,9 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: h !< Layer thickness [H ~> m or kg m-2] real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: uhtr !< Accumulated zonal mass flux - !! [m2 H ~> m3 or kg] + !! [L2 H ~> m3 or kg] real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: vhtr !< Accumulated meridional mass flux - !! [m2 H ~> m3 or kg] + !! [L2 H ~> m3 or kg] type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamics structure real, intent(in) :: dt !< Time increment [s] type(MEKE_type), pointer :: MEKE !< MEKE control structure @@ -476,11 +476,11 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp !$OMP parallel do default(none) shared(is,ie,js,je,nz,uhtr,uhD,dt,vhtr,CDp,vhD,h,G,GV) do k=1,nz do j=js,je ; do I=is-1,ie - uhtr(I,j,k) = uhtr(I,j,k) + uhD(I,j,k)*dt + uhtr(I,j,k) = uhtr(I,j,k) + US%m_to_L**2*uhD(I,j,k)*dt if (associated(CDp%uhGM)) CDp%uhGM(I,j,k) = uhD(I,j,k) enddo ; enddo do J=js-1,je ; do i=is,ie - vhtr(i,J,k) = vhtr(i,J,k) + vhD(i,J,k)*dt + vhtr(i,J,k) = vhtr(i,J,k) + US%m_to_L**2*vhD(i,J,k)*dt if (associated(CDp%vhGM)) CDp%vhGM(i,J,k) = vhD(i,J,k) enddo ; enddo do j=js,je ; do i=is,ie @@ -499,7 +499,7 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp call uvchksum("thickness_diffuse [uv]hD", uhD, vhD, & G%HI, haloshift=0, scale=GV%H_to_m) call uvchksum("thickness_diffuse [uv]htr", uhtr, vhtr, & - G%HI, haloshift=0, scale=GV%H_to_m) + G%HI, haloshift=0, scale=US%L_to_m**2*GV%H_to_m) call hchksum(h, "thickness_diffuse h", G%HI, haloshift=0, scale=GV%H_to_m) endif diff --git a/src/tracer/MOM_offline_main.F90 b/src/tracer/MOM_offline_main.F90 index 8278e57264..0624f98337 100644 --- a/src/tracer/MOM_offline_main.F90 +++ b/src/tracer/MOM_offline_main.F90 @@ -33,6 +33,7 @@ module MOM_offline_main use MOM_tracer_diabatic, only : applyTracerBoundaryFluxesInOut use MOM_tracer_flow_control, only : tracer_flow_control_CS, call_tracer_column_fns, call_tracer_stocks use MOM_tracer_registry, only : tracer_registry_type, MOM_tracer_chksum, MOM_tracer_chkinv +use MOM_unit_scaling, only : unit_scale_type use MOM_variables, only : thermo_var_ptrs use MOM_verticalGrid, only : verticalGrid_type @@ -67,6 +68,8 @@ module MOM_offline_main !< Pointer to a structure containing metrics and related information type(verticalGrid_type), pointer :: GV => NULL() !< Pointer to structure containing information about the vertical grid + type(unit_scale_type), pointer :: US => NULL() + !< structure containing various unit conversion factors type(optics_type), pointer :: optics => NULL() !< Pointer to the optical properties type type(diabatic_aux_CS), pointer :: diabatic_aux_CSp => NULL() @@ -330,7 +333,7 @@ subroutine offline_advection_ale(fluxes, Time_start, time_interval, CS, id_clock call MOM_tracer_chkinv(debug_msg, G, h_pre, CS%tracer_reg%Tr, CS%tracer_reg%ntr) endif - call advect_tracer(h_pre, uhtr_sub, vhtr_sub, CS%OBC, CS%dt_offline, G, GV, & + call advect_tracer(h_pre, uhtr_sub, vhtr_sub, CS%OBC, CS%dt_offline, G, GV, CS%US, & CS%tracer_adv_CSp, CS%tracer_Reg, h_vol, max_iter_in=1, & uhr_out=uhtr, vhr_out=vhtr, h_out=h_new, x_first_in=x_before_y) @@ -501,7 +504,7 @@ subroutine offline_redistribute_residual(CS, h_pre, uhtr, vhtr, converged) call distribute_residual_uh_upwards(G, GV, h_vol, uhtr) endif - call advect_tracer(h_pre, uhtr, vhtr, CS%OBC, CS%dt_offline, G, GV, & + call advect_tracer(h_pre, uhtr, vhtr, CS%OBC, CS%dt_offline, G, GV, CS%US, & CS%tracer_adv_CSp, CS%tracer_Reg, h_prev_opt = h_pre, max_iter_in=1, & h_out=h_new, uhr_out=uhr, vhr_out=vhr, x_first_in=x_before_y) @@ -546,7 +549,7 @@ subroutine offline_redistribute_residual(CS, h_pre, uhtr, vhtr, converged) call distribute_residual_uh_barotropic(G, GV, h_vol, uhtr) endif - call advect_tracer(h_pre, uhtr, vhtr, CS%OBC, CS%dt_offline, G, GV, & + call advect_tracer(h_pre, uhtr, vhtr, CS%OBC, CS%dt_offline, G, GV, CS%US, & CS%tracer_adv_CSp, CS%tracer_Reg, h_prev_opt = h_pre, max_iter_in=1, & h_out=h_new, uhr_out=uhr, vhr_out=vhr, x_first_in=x_before_y) @@ -916,7 +919,7 @@ subroutine offline_advection_layer(fluxes, Time_start, time_interval, CS, h_pre, do k = 1, nz ; do i = is-1, ie+1 ; do j=js-1, je+1 h_vol(i,j,k) = h_pre(i,j,k)*G%areaT(i,j) enddo ; enddo ; enddo - call advect_tracer(h_pre, uhtr_sub, vhtr_sub, CS%OBC, dt_iter, G, GV, & + call advect_tracer(h_pre, uhtr_sub, vhtr_sub, CS%OBC, dt_iter, G, GV, CS%US, & CS%tracer_adv_CSp, CS%tracer_Reg, h_vol, max_iter_in=30, x_first_in=x_before_y) ! Done with horizontal so now h_pre should be h_new @@ -933,7 +936,7 @@ subroutine offline_advection_layer(fluxes, Time_start, time_interval, CS, h_pre, do k = 1, nz ; do i = is-1, ie+1 ; do j=js-1, je+1 h_vol(i,j,k) = h_pre(i,j,k)*G%areaT(i,j) enddo ; enddo ; enddo - call advect_tracer(h_pre, uhtr_sub, vhtr_sub, CS%OBC, dt_iter, G, GV, & + call advect_tracer(h_pre, uhtr_sub, vhtr_sub, CS%OBC, dt_iter, G, GV, CS%US, & CS%tracer_adv_CSp, CS%tracer_Reg, h_vol, max_iter_in=30, x_first_in=x_before_y) ! Done with horizontal so now h_pre should be h_new @@ -1268,13 +1271,14 @@ end subroutine insert_offline_main !> Initializes the control structure for offline transport and reads in some of the ! run time parameters from MOM_input -subroutine offline_transport_init(param_file, CS, diabatic_CSp, G, GV) +subroutine offline_transport_init(param_file, CS, diabatic_CSp, G, GV, US) type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters type(offline_transport_CS), pointer :: CS !< Offline control structure type(diabatic_CS), intent(in) :: diabatic_CSp !< The diabatic control structure type(ocean_grid_type), target, intent(in) :: G !< ocean grid structure type(verticalGrid_type), target, intent(in) :: GV !< ocean vertical grid structure + type(unit_scale_type), target, intent(in) :: US !< A dimensional unit scaling type character(len=40) :: mdl = "offline_transport" character(len=20) :: redistribute_method @@ -1296,6 +1300,9 @@ subroutine offline_transport_init(param_file, CS, diabatic_CSp, G, GV) allocate(CS) call log_version(param_file, mdl,version, "This module allows for tracers to be run offline") + ! Determining the internal unit scaling factors for this run. + CS%US => US + ! Parse MOM_input for offline control call get_param(param_file, mdl, "OFFLINEDIR", CS%offlinedir, & "Input directory where the offline fields can be found", fail_if_missing = .true.) diff --git a/src/tracer/MOM_tracer_advect.F90 b/src/tracer/MOM_tracer_advect.F90 index 201f8aeb6f..1958b60cc8 100644 --- a/src/tracer/MOM_tracer_advect.F90 +++ b/src/tracer/MOM_tracer_advect.F90 @@ -17,6 +17,7 @@ module MOM_tracer_advect use MOM_open_boundary, only : OBC_DIRECTION_W, OBC_DIRECTION_N, OBC_DIRECTION_S use MOM_open_boundary, only : OBC_segment_type use MOM_tracer_registry, only : tracer_registry_type, tracer_type +use MOM_unit_scaling, only : unit_scale_type use MOM_verticalGrid, only : verticalGrid_type implicit none ; private @@ -47,18 +48,19 @@ module MOM_tracer_advect !> This routine time steps the tracer concentration using a !! monotonic, conservative, weakly diffusive scheme. -subroutine advect_tracer(h_end, uhtr, vhtr, OBC, dt, G, GV, CS, Reg, & +subroutine advect_tracer(h_end, uhtr, vhtr, OBC, dt, G, GV, US, CS, Reg, & h_prev_opt, max_iter_in, x_first_in, uhr_out, vhr_out, h_out) type(ocean_grid_type), intent(inout) :: G !< ocean grid structure type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(in) :: h_end !< layer thickness after advection [H ~> m or kg m-2] real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & - intent(in) :: uhtr !< accumulated volume/mass flux through zonal face [H m2 ~> m3 or kg] + intent(in) :: uhtr !< accumulated volume/mass flux through zonal face [H L2 ~> m3 or kg] real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - intent(in) :: vhtr !< accumulated volume/mass flux through merid face [H m2 ~> m3 or kg] + intent(in) :: vhtr !< accumulated volume/mass flux through merid face [H L2 ~> m3 or kg] type(ocean_OBC_type), pointer :: OBC !< specifies whether, where, and what OBCs are used real, intent(in) :: dt !< time increment [s] + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(tracer_advect_CS), pointer :: CS !< control structure for module type(tracer_registry_type), pointer :: Reg !< pointer to tracer registry real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & @@ -149,8 +151,8 @@ subroutine advect_tracer(h_end, uhtr, vhtr, OBC, dt, G, GV, CS, Reg, & do j = jsd, jed; do i = Isd, Ied; hprev(i,j,k) = 0.0; enddo ; enddo domore_k(k)=1 ! Put the remaining (total) thickness fluxes into uhr and vhr. - do j=js,je ; do I=is-1,ie ; uhr(I,j,k) = uhtr(I,j,k) ; enddo ; enddo - do J=js-1,je ; do i=is,ie ; vhr(i,J,k) = vhtr(i,J,k) ; enddo ; enddo + do j=js,je ; do I=is-1,ie ; uhr(I,j,k) = US%L_to_m**2*uhtr(I,j,k) ; enddo ; enddo + do J=js-1,je ; do i=is,ie ; vhr(i,J,k) = US%L_to_m**2*vhtr(i,J,k) ; enddo ; enddo if (.not. present(h_prev_opt)) then ! This loop reconstructs the thickness field the last time that the ! tracers were updated, probably just after the diabatic forcing. A useful From 40335f4d0586ce508ee7a9e7925e6c3591b24fb1 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 30 Jul 2019 17:35:04 -0400 Subject: [PATCH 127/297] +Rescaled uh and vh to [H L2 T-1] Rescaled the units for the mass or volume fluxes in the dynamics to [H L2 T-1] for expanded dimensional consistency testing. This required the addition of unit_scale_type arguments to several routines. All answers are bitwise identical and the cases in the MOM6-examples test suite all pass the dimensional consistency tests, but there are some minor changes to public interfaces. --- src/core/MOM.F90 | 12 +-- src/core/MOM_CoriolisAdv.F90 | 134 +++++++++++++------------- src/core/MOM_barotropic.F90 | 12 +-- src/core/MOM_checksum_packages.F90 | 9 +- src/core/MOM_continuity.F90 | 4 +- src/core/MOM_continuity_PPM.F90 | 26 +++-- src/core/MOM_dynamics_split_RK2.F90 | 49 +++++----- src/core/MOM_dynamics_unsplit.F90 | 24 ++--- src/core/MOM_dynamics_unsplit_RK2.F90 | 18 ++-- src/diagnostics/MOM_diagnostics.F90 | 52 +++++----- 10 files changed, 178 insertions(+), 162 deletions(-) diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index b46c0ff7e4..91ec256248 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -156,11 +156,11 @@ module MOM S !< salinity [ppt] real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_,NKMEM_) :: & u, & !< zonal velocity component [m s-1] - uh, & !< uh = u * h * dy at u grid points [H m2 s-1 ~> m3 s-1 or kg s-1] + uh, & !< uh = u * h * dy at u grid points [H L2 T-1 ~> m3 s-1 or kg s-1] uhtr !< accumulated zonal thickness fluxes to advect tracers [H L2 ~> m3 or kg] real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_,NKMEM_) :: & v, & !< meridional velocity [m s-1] - vh, & !< vh = v * h * dx at v grid points [H m2 s-1 ~> m3 s-1 or kg s-1] + vh, & !< vh = v * h * dx at v grid points [H L2 T-1 ~> m3 s-1 or kg s-1] vhtr !< accumulated meridional thickness fluxes to advect tracers [H L2 ~> m3 or kg] real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: ssh_rint !< A running time integral of the sea surface height [s m]. @@ -492,7 +492,7 @@ subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, CS, & call cpu_clock_begin(id_clock_other) if (CS%debug) then - call MOM_state_chksum("Beginning of step_MOM ", u, v, h, CS%uh, CS%vh, G, GV) + call MOM_state_chksum("Beginning of step_MOM ", u, v, h, CS%uh, CS%vh, G, GV, US) endif showCallTree = callTree_showQuery() @@ -598,7 +598,7 @@ subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, CS, & if (CS%debug) then if (cycle_start) & - call MOM_state_chksum("Before steps ", u, v, h, CS%uh, CS%vh, G, GV) + call MOM_state_chksum("Before steps ", u, v, h, CS%uh, CS%vh, G, GV, US) if (cycle_start) call check_redundant("Before steps ", u, v, G) if (do_dyn) call MOM_mech_forcing_chksum("Before steps", forces, G, US, haloshift=0) if (do_dyn) call check_redundant("Before steps ", forces%taux, forces%tauy, G) @@ -1209,7 +1209,7 @@ subroutine step_MOM_thermo(CS, G, GV, US, u, v, h, tv, fluxes, dtdia, & call preAle_tracer_diagnostics(CS%tracer_Reg, G, GV) if (CS%debug) then - call MOM_state_chksum("Pre-ALE ", u, v, h, CS%uh, CS%vh, G, GV) + call MOM_state_chksum("Pre-ALE ", u, v, h, CS%uh, CS%vh, G, GV, US) call hchksum(tv%T,"Pre-ALE T", G%HI, haloshift=1) call hchksum(tv%S,"Pre-ALE S", G%HI, haloshift=1) call check_redundant("Pre-ALE ", u, v, G) @@ -1236,7 +1236,7 @@ subroutine step_MOM_thermo(CS, G, GV, US, u, v, h, tv, fluxes, dtdia, & call do_group_pass(pass_uv_T_S_h, G%Domain, clock=id_clock_pass) if (CS%debug .and. CS%use_ALE_algorithm) then - call MOM_state_chksum("Post-ALE ", u, v, h, CS%uh, CS%vh, G, GV) + call MOM_state_chksum("Post-ALE ", u, v, h, CS%uh, CS%vh, G, GV, US) call hchksum(tv%T, "Post-ALE T", G%HI, haloshift=1) call hchksum(tv%S, "Post-ALE S", G%HI, haloshift=1) call check_redundant("Post-ALE ", u, v, G) diff --git a/src/core/MOM_CoriolisAdv.F90 b/src/core/MOM_CoriolisAdv.F90 index a897e2af13..9baaa42009 100644 --- a/src/core/MOM_CoriolisAdv.F90 +++ b/src/core/MOM_CoriolisAdv.F90 @@ -115,9 +115,9 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS) real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: v !< Meridional velocity [m s-1] real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness [H ~> m or kg m-2] real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: uh !< Zonal transport u*h*dy - !! [H m2 s-1 ~> m3 s-1 or kg s-1] + !! [H L2 T-1 ~> m3 s-1 or kg s-1] real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: vh !< Meridional transport v*h*dx - !! [H m2 s-1 ~> m3 s-1 or kg s-1] + !! [H L2 T-1 ~> m3 s-1 or kg s-1] real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(out) :: CAu !< Zonal acceleration due to Coriolis !! and momentum advection [m s-2]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(out) :: CAv !< Meridional acceleration due to Coriolis @@ -148,17 +148,17 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS) ! times the effective areas [H m2 ~> m3 or kg]. KEx, & ! The zonal gradient of Kinetic energy per unit mass [m s-2], ! KEx = d/dx KE. - uh_center ! Transport based on arithmetic mean h at u-points [H m2 s-1 ~> m3 s-1 or kg s-1] + uh_center ! Transport based on arithmetic mean h at u-points [H L2 T-1 ~> m3 s-1 or kg s-1] real, dimension(SZI_(G),SZJB_(G)) :: & hArea_v, & ! The cell area weighted thickness interpolated to v points ! times the effective areas [H m2 ~> m3 or kg]. KEy, & ! The meridonal gradient of Kinetic energy per unit mass [m s-2], ! KEy = d/dy KE. - vh_center ! Transport based on arithmetic mean h at v-points [H m2 s-1 ~> m3 s-1 or kg s-1] + vh_center ! Transport based on arithmetic mean h at v-points [H L2 T-1 ~> m3 s-1 or kg s-1] real, dimension(SZI_(G),SZJ_(G)) :: & uh_min, uh_max, & ! The smallest and largest estimates of the volume vh_min, vh_max, & ! fluxes through the faces (i.e. u*h*dy & v*h*dx) - ! [H m2 s-1 ~> m3 s-1 or kg s-1]. + ! [H L2 T-1 ~> m3 s-1 or kg s-1]. ep_u, ep_v ! Additional pseudo-Coriolis terms in the Arakawa and Lamb ! discretization [H-1 s-1 ~> m-1 s-1 or m2 kg-1 s-1]. real, dimension(SZIB_(G),SZJB_(G)) :: & @@ -189,8 +189,8 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS) real :: temp1, temp2 ! Temporary variables [m2 s-2]. real, parameter :: eps_vel=1.0e-10 ! A tiny, positive velocity [m s-1]. - real :: uhc, vhc ! Centered estimates of uh and vh [H m2 s-1 ~> m3 s-1 or kg s-1]. - real :: uhm, vhm ! The input estimates of uh and vh [H m2 s-1 ~> m3 s-1 or kg s-1]. + real :: uhc, vhc ! Centered estimates of uh and vh [H L2 T-1 ~> m3 s-1 or kg s-1]. + real :: uhm, vhm ! The input estimates of uh and vh [H L2 T-1 ~> m3 s-1 or kg s-1]. real :: c1, c2, c3, slope ! Nondimensional parameters for the Coriolis limiter scheme. real :: Fe_m2 ! Nondimensional temporary variables asssociated with @@ -206,8 +206,8 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS) real :: Heff1, Heff2 ! Temporary effective H at U or V points [H ~> m or kg m-2]. real :: Heff3, Heff4 ! Temporary effective H at U or V points [H ~> m or kg m-2]. real :: h_tiny ! A very small thickness [H ~> m or kg m-2]. - real :: UHeff, VHeff ! More temporary variables [H m2 s-1 ~> m3 s-1 or kg s-1]. - real :: QUHeff,QVHeff ! More temporary variables [H m2 s-1 ~> m3 s-1 or kg s-1]. + real :: UHeff, VHeff ! More temporary variables [H L2 T-1 ~> m3 s-1 or kg s-1]. + real :: QUHeff,QVHeff ! More temporary variables [H L2 T-1 s-1 ~> m3 s-2 or kg s-2]. integer :: i, j, k, n, is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz ! To work, the following fields must be set outside of the usual @@ -273,10 +273,10 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS) enddo ; enddo if (CS%Coriolis_En_Dis) then do j=Jsq,Jeq+1 ; do I=is-1,ie - uh_center(I,j) = 0.5 * (G%dy_Cu(I,j) * u(I,j,k)) * (h(i,j,k) + h(i+1,j,k)) + uh_center(I,j) = 0.5 * (US%m_to_L*G%dy_Cu(I,j) * US%m_s_to_L_T*u(I,j,k)) * (h(i,j,k) + h(i+1,j,k)) enddo ; enddo do J=js-1,je ; do i=Isq,Ieq+1 - vh_center(i,J) = 0.5 * (G%dx_Cv(i,J) * v(i,J,k)) * (h(i,j,k) + h(i,j+1,k)) + vh_center(i,J) = 0.5 * (US%m_to_L*G%dx_Cv(i,J) * US%m_s_to_L_T*v(i,J,k)) * (h(i,j,k) + h(i,j+1,k)) enddo ; enddo endif @@ -319,9 +319,9 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS) if (CS%Coriolis_En_Dis) then do i = max(Isq-1,OBC%segment(n)%HI%isd), min(Ieq+2,OBC%segment(n)%HI%ied) if (OBC%segment(n)%direction == OBC_DIRECTION_N) then - vh_center(i,J) = G%dx_Cv(i,J) * v(i,J,k) * h(i,j,k) + vh_center(i,J) = US%m_to_L*G%dx_Cv(i,J) * US%m_s_to_L_T*v(i,J,k) * h(i,j,k) else ! (OBC%segment(n)%direction == OBC_DIRECTION_S) - vh_center(i,J) = G%dx_Cv(i,J) * v(i,J,k) * h(i,j+1,k) + vh_center(i,J) = US%m_to_L*G%dx_Cv(i,J) * US%m_s_to_L_T*v(i,J,k) * h(i,j+1,k) endif enddo endif @@ -358,9 +358,9 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS) if (CS%Coriolis_En_Dis) then do j = max(Jsq-1,OBC%segment(n)%HI%jsd), min(Jeq+2,OBC%segment(n)%HI%jed) if (OBC%segment(n)%direction == OBC_DIRECTION_E) then - uh_center(I,j) = G%dy_Cu(I,j) * u(I,j,k) * h(i,j,k) + uh_center(I,j) = US%m_to_L*G%dy_Cu(I,j) * US%m_s_to_L_T*u(I,j,k) * h(i,j,k) else ! (OBC%segment(n)%direction == OBC_DIRECTION_W) - uh_center(I,j) = G%dy_Cu(I,j) * u(I,j,k) * h(i+1,j,k) + uh_center(I,j) = US%m_to_L*G%dy_Cu(I,j) * US%m_s_to_L_T*u(I,j,k) * h(i+1,j,k) endif enddo endif @@ -590,19 +590,19 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS) else temp2 = q(I,J-1) * (vh_min(i,j-1)+vh_min(i+1,j-1)) endif - CAu(I,j,k) = 0.25 * G%IdxCu(I,j) * (temp1 + temp2) + CAu(I,j,k) = US%L_T_to_m_s*0.25 * US%L_to_m*G%IdxCu(I,j) * (temp1 + temp2) enddo ; enddo else ! Energy conserving scheme, Sadourny 1975 do j=js,je ; do I=Isq,Ieq - CAu(I,j,k) = 0.25 * & + CAu(I,j,k) = 0.25 * US%L_T_to_m_s * & (q(I,J) * (vh(i+1,J,k) + vh(i,J,k)) + & - q(I,J-1) * (vh(i,J-1,k) + vh(i+1,J-1,k))) * G%IdxCu(I,j) + q(I,J-1) * (vh(i,J-1,k) + vh(i+1,J-1,k))) * US%L_to_m*G%IdxCu(I,j) enddo ; enddo endif elseif (CS%Coriolis_Scheme == SADOURNY75_ENSTRO) then do j=js,je ; do I=Isq,Ieq - CAu(I,j,k) = 0.125 * (G%IdxCu(I,j) * (q(I,J) + q(I,J-1))) * & + CAu(I,j,k) = 0.125 * US%L_T_to_m_s * (US%L_to_m*G%IdxCu(I,j) * (q(I,J) + q(I,J-1))) * & ((vh(i+1,J,k) + vh(i,J,k)) + (vh(i,J-1,k) + vh(i+1,J-1,k))) enddo ; enddo elseif ((CS%Coriolis_Scheme == ARAKAWA_HSU90) .or. & @@ -610,48 +610,48 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS) (CS%Coriolis_Scheme == AL_BLEND)) then ! (Global) Energy and (Local) Enstrophy conserving, Arakawa & Hsu 1990 do j=js,je ; do I=Isq,Ieq - CAu(I,j,k) = ((a(I,j) * vh(i+1,J,k) + & + CAu(I,j,k) = US%L_T_to_m_s*((a(I,j) * vh(i+1,J,k) + & c(I,j) * vh(i,J-1,k)) & + (b(I,j) * vh(i,J,k) + & - d(I,j) * vh(i+1,J-1,k))) * G%IdxCu(I,j) + d(I,j) * vh(i+1,J-1,k))) * US%L_to_m*G%IdxCu(I,j) enddo ; enddo elseif (CS%Coriolis_Scheme == ROBUST_ENSTRO) then ! An enstrophy conserving scheme robust to vanishing layers ! Note: Heffs are in lieu of h_at_v that should be returned by the ! continuity solver. AJA do j=js,je ; do I=Isq,Ieq - Heff1 = abs(vh(i,J,k)*G%IdxCv(i,J))/(eps_vel+abs(v(i,J,k))) - Heff1 = max(Heff1,min(h(i,j,k),h(i,j+1,k))) - Heff1 = min(Heff1,max(h(i,j,k),h(i,j+1,k))) - Heff2 = abs(vh(i,J-1,k)*G%IdxCv(i,J-1))/(eps_vel+abs(v(i,J-1,k))) - Heff2 = max(Heff2,min(h(i,j-1,k),h(i,j,k))) - Heff2 = min(Heff2,max(h(i,j-1,k),h(i,j,k))) - Heff3 = abs(vh(i+1,J,k)*G%IdxCv(i+1,J))/(eps_vel+abs(v(i+1,J,k))) - Heff3 = max(Heff3,min(h(i+1,j,k),h(i+1,j+1,k))) - Heff3 = min(Heff3,max(h(i+1,j,k),h(i+1,j+1,k))) - Heff4 = abs(vh(i+1,J-1,k)*G%IdxCv(i+1,J-1))/(eps_vel+abs(v(i+1,J-1,k))) - Heff4 = max(Heff4,min(h(i+1,j-1,k),h(i+1,j,k))) - Heff4 = min(Heff4,max(h(i+1,j-1,k),h(i+1,j,k))) + Heff1 = abs(vh(i,J,k) * US%L_to_m*G%IdxCv(i,J)) / (US%m_s_to_L_T*(eps_vel+abs(v(i,J,k)))) + Heff1 = max(Heff1, min(h(i,j,k),h(i,j+1,k))) + Heff1 = min(Heff1, max(h(i,j,k),h(i,j+1,k))) + Heff2 = abs(vh(i,J-1,k) * US%L_to_m*G%IdxCv(i,J-1)) / (US%m_s_to_L_T*(eps_vel+abs(v(i,J-1,k)))) + Heff2 = max(Heff2, min(h(i,j-1,k),h(i,j,k))) + Heff2 = min(Heff2, max(h(i,j-1,k),h(i,j,k))) + Heff3 = abs(vh(i+1,J,k) * US%L_to_m*G%IdxCv(i+1,J)) / (US%m_s_to_L_T*(eps_vel+abs(v(i+1,J,k)))) + Heff3 = max(Heff3, min(h(i+1,j,k),h(i+1,j+1,k))) + Heff3 = min(Heff3, max(h(i+1,j,k),h(i+1,j+1,k))) + Heff4 = abs(vh(i+1,J-1,k) * US%L_to_m*G%IdxCv(i+1,J-1)) / (US%m_s_to_L_T*(eps_vel+abs(v(i+1,J-1,k)))) + Heff4 = max(Heff4, min(h(i+1,j-1,k),h(i+1,j,k))) + Heff4 = min(Heff4, max(h(i+1,j-1,k),h(i+1,j,k))) if (CS%PV_Adv_Scheme == PV_ADV_CENTERED) then - CAu(I,j,k) = 0.5*(abs_vort(I,J)+abs_vort(I,J-1)) * & + CAu(I,j,k) = US%L_T_to_m_s*0.5*(abs_vort(I,J)+abs_vort(I,J-1)) * & ((vh(i ,J ,k)+vh(i+1,J-1,k)) + & (vh(i ,J-1,k)+vh(i+1,J ,k)) ) / & - (h_tiny +((Heff1+Heff4) +(Heff2+Heff3)) ) * G%IdxCu(I,j) + (h_tiny +((Heff1+Heff4) +(Heff2+Heff3)) ) * US%L_to_m*G%IdxCu(I,j) elseif (CS%PV_Adv_Scheme == PV_ADV_UPWIND1) then VHeff = ((vh(i ,J ,k)+vh(i+1,J-1,k)) + & (vh(i ,J-1,k)+vh(i+1,J ,k)) ) QVHeff = 0.5*( (abs_vort(I,J)+abs_vort(I,J-1))*VHeff & -(abs_vort(I,J)-abs_vort(I,J-1))*abs(VHeff) ) - CAu(I,j,k) = QVHeff / & - (h_tiny +((Heff1+Heff4) +(Heff2+Heff3)) ) * G%IdxCu(I,j) + CAu(I,j,k) = US%L_T_to_m_s*QVHeff / & + (h_tiny +((Heff1+Heff4) +(Heff2+Heff3)) ) * US%L_to_m*G%IdxCu(I,j) endif enddo ; enddo endif ! Add in the additonal terms with Arakawa & Lamb. if ((CS%Coriolis_Scheme == ARAKAWA_LAMB81) .or. & (CS%Coriolis_Scheme == AL_BLEND)) then ; do j=js,je ; do I=Isq,Ieq - CAu(I,j,k) = CAu(I,j,k) + & - (ep_u(i,j)*uh(I-1,j,k) - ep_u(i+1,j)*uh(I+1,j,k)) * G%IdxCu(I,j) + CAu(I,j,k) = CAu(I,j,k) + US%L_T_to_m_s * & + (ep_u(i,j)*uh(I-1,j,k) - ep_u(i+1,j)*uh(I+1,j,k)) * US%L_to_m*G%IdxCu(I,j) enddo ; enddo ; endif @@ -699,19 +699,19 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS) else temp2 = q(I,J) * (uh_min(i,j)+uh_min(i,j+1)) endif - CAv(i,J,k) = - 0.25 * G%IdyCv(i,J) * (temp1 + temp2) + CAv(i,J,k) = -0.25 * US%L_T_to_m_s*US%L_to_m*G%IdyCv(i,J) * (temp1 + temp2) enddo ; enddo else ! Energy conserving scheme, Sadourny 1975 do J=Jsq,Jeq ; do i=is,ie - CAv(i,J,k) = - 0.25* & + CAv(i,J,k) = - 0.25* US%L_T_to_m_s*& (q(I-1,J)*(uh(I-1,j,k) + uh(I-1,j+1,k)) + & - q(I,J)*(uh(I,j,k) + uh(I,j+1,k))) * G%IdyCv(i,J) + q(I,J)*(uh(I,j,k) + uh(I,j+1,k))) * US%L_to_m*G%IdyCv(i,J) enddo ; enddo endif elseif (CS%Coriolis_Scheme == SADOURNY75_ENSTRO) then do J=Jsq,Jeq ; do i=is,ie - CAv(i,J,k) = -0.125 * (G%IdyCv(i,J) * (q(I-1,J) + q(I,J))) * & + CAv(i,J,k) = -0.125 * US%L_T_to_m_s*(US%L_to_m*G%IdyCv(i,J) * (q(I-1,J) + q(I,J))) * & ((uh(I-1,j,k) + uh(I-1,j+1,k)) + (uh(I,j,k) + uh(I,j+1,k))) enddo ; enddo elseif ((CS%Coriolis_Scheme == ARAKAWA_HSU90) .or. & @@ -719,48 +719,48 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS) (CS%Coriolis_Scheme == AL_BLEND)) then ! (Global) Energy and (Local) Enstrophy conserving, Arakawa & Hsu 1990 do J=Jsq,Jeq ; do i=is,ie - CAv(i,J,k) = - ((a(I-1,j) * uh(I-1,j,k) + & + CAv(i,J,k) = - US%L_T_to_m_s*((a(I-1,j) * uh(I-1,j,k) + & c(I,j+1) * uh(I,j+1,k)) & + (b(I,j) * uh(I,j,k) + & - d(I-1,j+1) * uh(I-1,j+1,k))) * G%IdyCv(i,J) + d(I-1,j+1) * uh(I-1,j+1,k))) * US%L_to_m*G%IdyCv(i,J) enddo ; enddo elseif (CS%Coriolis_Scheme == ROBUST_ENSTRO) then ! An enstrophy conserving scheme robust to vanishing layers ! Note: Heffs are in lieu of h_at_u that should be returned by the ! continuity solver. AJA do J=Jsq,Jeq ; do i=is,ie - Heff1 = abs(uh(I,j,k)*G%IdyCu(I,j))/(eps_vel+abs(u(I,j,k))) - Heff1 = max(Heff1,min(h(i,j,k),h(i+1,j,k))) - Heff1 = min(Heff1,max(h(i,j,k),h(i+1,j,k))) - Heff2 = abs(uh(I-1,j,k)*G%IdyCu(I-1,j))/(eps_vel+abs(u(I-1,j,k))) - Heff2 = max(Heff2,min(h(i-1,j,k),h(i,j,k))) - Heff2 = min(Heff2,max(h(i-1,j,k),h(i,j,k))) - Heff3 = abs(uh(I,j+1,k)*G%IdyCu(I,j+1))/(eps_vel+abs(u(I,j+1,k))) - Heff3 = max(Heff3,min(h(i,j+1,k),h(i+1,j+1,k))) - Heff3 = min(Heff3,max(h(i,j+1,k),h(i+1,j+1,k))) - Heff4 = abs(uh(I-1,j+1,k)*G%IdyCu(I-1,j+1))/(eps_vel+abs(u(I-1,j+1,k))) - Heff4 = max(Heff4,min(h(i-1,j+1,k),h(i,j+1,k))) - Heff4 = min(Heff4,max(h(i-1,j+1,k),h(i,j+1,k))) + Heff1 = abs(uh(I,j,k) * US%L_to_m*G%IdyCu(I,j)) / (US%m_s_to_L_T*(eps_vel+abs(u(I,j,k)))) + Heff1 = max(Heff1, min(h(i,j,k),h(i+1,j,k))) + Heff1 = min(Heff1, max(h(i,j,k),h(i+1,j,k))) + Heff2 = abs(uh(I-1,j,k) * US%L_to_m*G%IdyCu(I-1,j)) / (US%m_s_to_L_T*(eps_vel+abs(u(I-1,j,k)))) + Heff2 = max(Heff2, min(h(i-1,j,k),h(i,j,k))) + Heff2 = min(Heff2, max(h(i-1,j,k),h(i,j,k))) + Heff3 = abs(uh(I,j+1,k) * US%L_to_m*G%IdyCu(I,j+1)) / (US%m_s_to_L_T*(eps_vel+abs(u(I,j+1,k)))) + Heff3 = max(Heff3, min(h(i,j+1,k),h(i+1,j+1,k))) + Heff3 = min(Heff3, max(h(i,j+1,k),h(i+1,j+1,k))) + Heff4 = abs(uh(I-1,j+1,k) * US%L_to_m*G%IdyCu(I-1,j+1)) / (US%m_s_to_L_T*(eps_vel+abs(u(I-1,j+1,k)))) + Heff4 = max(Heff4, min(h(i-1,j+1,k),h(i,j+1,k))) + Heff4 = min(Heff4, max(h(i-1,j+1,k),h(i,j+1,k))) if (CS%PV_Adv_Scheme == PV_ADV_CENTERED) then - CAv(i,J,k) = - 0.5*(abs_vort(I,J)+abs_vort(I-1,J)) * & + CAv(i,J,k) = - 0.5*US%L_T_to_m_s*(abs_vort(I,J)+abs_vort(I-1,J)) * & ((uh(I ,j ,k)+uh(I-1,j+1,k)) + & (uh(I-1,j ,k)+uh(I ,j+1,k)) ) / & - (h_tiny + ((Heff1+Heff4) +(Heff2+Heff3)) ) * G%IdyCv(i,J) + (h_tiny + ((Heff1+Heff4) +(Heff2+Heff3)) ) * US%L_to_m*G%IdyCv(i,J) elseif (CS%PV_Adv_Scheme == PV_ADV_UPWIND1) then UHeff = ((uh(I ,j ,k)+uh(I-1,j+1,k)) + & (uh(I-1,j ,k)+uh(I ,j+1,k)) ) QUHeff = 0.5*( (abs_vort(I,J)+abs_vort(I-1,J))*UHeff & -(abs_vort(I,J)-abs_vort(I-1,J))*abs(UHeff) ) - CAv(i,J,k) = - QUHeff / & - (h_tiny + ((Heff1+Heff4) +(Heff2+Heff3)) ) * G%IdyCv(i,J) + CAv(i,J,k) = - US%L_T_to_m_s*QUHeff / & + (h_tiny + ((Heff1+Heff4) +(Heff2+Heff3)) ) * US%L_to_m*G%IdyCv(i,J) endif enddo ; enddo endif ! Add in the additonal terms with Arakawa & Lamb. if ((CS%Coriolis_Scheme == ARAKAWA_LAMB81) .or. & (CS%Coriolis_Scheme == AL_BLEND)) then ; do J=Jsq,Jeq ; do i=is,ie - CAv(i,J,k) = CAv(i,J,k) + & - (ep_v(i,j)*vh(i,J-1,k) - ep_v(i,j+1)*vh(i,J+1,k)) * G%IdyCv(i,J) + CAv(i,J,k) = CAv(i,J,k) + US%L_T_to_m_s * & + (ep_v(i,j)*vh(i,J-1,k) - ep_v(i,j+1)*vh(i,J+1,k)) * US%L_to_m*G%IdyCv(i,J) enddo ; enddo ; endif if (CS%bound_Coriolis) then @@ -788,7 +788,7 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS) do J=Jsq,Jeq ; do i=is,ie AD%rv_x_u(i,J,k) = - 0.25* & (q2(I-1,j)*(uh(I-1,j,k) + uh(I-1,j+1,k)) + & - q2(I,j)*(uh(I,j,k) + uh(I,j+1,k))) * G%IdyCv(i,J) + q2(I,j)*(uh(I,j,k) + uh(I,j+1,k))) * US%L_to_m*G%IdyCv(i,J) enddo ; enddo endif @@ -796,13 +796,13 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS) do j=js,je ; do I=Isq,Ieq AD%rv_x_v(I,j,k) = 0.25 * & (q2(I,j) * (vh(i+1,J,k) + vh(i,J,k)) + & - q2(I,j-1) * (vh(i,J-1,k) + vh(i+1,J-1,k))) * G%IdxCu(I,j) + q2(I,j-1) * (vh(i,J-1,k) + vh(i+1,J-1,k))) * US%L_to_m*G%IdxCu(I,j) enddo ; enddo endif else if (associated(AD%rv_x_u)) then do J=Jsq,Jeq ; do i=is,ie - AD%rv_x_u(i,J,k) = -G%IdyCv(i,J) * C1_12 * & + AD%rv_x_u(i,J,k) = -US%L_to_m*G%IdyCv(i,J) * C1_12 * & ((q2(I,J) + q2(I-1,J) + q2(I-1,J-1)) * uh(I-1,j,k) + & (q2(I-1,J) + q2(I,J) + q2(I,J-1)) * uh(I,j,k) + & (q2(I-1,J) + q2(I,J+1) + q2(I,J)) * uh(I,j+1,k) + & @@ -812,7 +812,7 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS) if (associated(AD%rv_x_v)) then do j=js,je ; do I=Isq,Ieq - AD%rv_x_v(I,j,k) = G%IdxCu(I,j) * C1_12 * & + AD%rv_x_v(I,j,k) = US%L_to_m*G%IdxCu(I,j) * C1_12 * & ((q2(I+1,J) + q2(I,J) + q2(I,J-1)) * vh(i+1,J,k) + & (q2(I-1,J) + q2(I,J) + q2(I,J-1)) * vh(i,J,k) + & (q2(I-1,J-1) + q2(I,J) + q2(I,J-1)) * vh(i,J-1,k) + & diff --git a/src/core/MOM_barotropic.F90 b/src/core/MOM_barotropic.F90 index 6377dd2d1f..5e08e2ccc2 100644 --- a/src/core/MOM_barotropic.F90 +++ b/src/core/MOM_barotropic.F90 @@ -446,10 +446,10 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, real, dimension(:,:), optional, pointer :: tauy_bot !< The meridional bottom frictional stress !! from ocean to the seafloor [Pa]. real, dimension(:,:,:), optional, pointer :: uh0 !< The zonal layer transports at reference - !! velocities [H m s-1 ~> m2 s-1 or kg m-1 s-1]. + !! velocities [H L2 T-1 ~> m3 s-1 or kg s-1]. real, dimension(:,:,:), optional, pointer :: u_uh0 !< The velocities used to calculate uh0 [m s-1] real, dimension(:,:,:), optional, pointer :: vh0 !< The zonal layer transports at reference - !! velocities [H m s-1 ~> m2 s-1 or kg m-1 s-1]. + !! velocities [H L2 T-1 ~> m3 s-1 or kg s-1]. real, dimension(:,:,:), optional, pointer :: v_vh0 !< The velocities used to calculate vh0 [m s-1] ! Local variables @@ -1026,23 +1026,23 @@ 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) + US%T_to_s*US%m_to_L**2*uh0(I,j,k) + uhbt(I,j) = uhbt(I,j) + 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) + US%T_to_s*US%m_to_L**2*vh0(i,J,k) + vhbt(i,J) = vhbt(i,J) + 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) + US%T_to_s*US%m_to_L**2*uh0(I,j,k) + uhbt(I,j) = uhbt(I,j) + 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) + US%T_to_s*US%m_to_L**2*vh0(i,J,k) + vhbt(i,J) = vhbt(i,J) + 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 diff --git a/src/core/MOM_checksum_packages.F90 b/src/core/MOM_checksum_packages.F90 index 755cdac2b9..a2731f9a0e 100644 --- a/src/core/MOM_checksum_packages.F90 +++ b/src/core/MOM_checksum_packages.F90 @@ -39,7 +39,7 @@ module MOM_checksum_packages ! ============================================================================= !> Write out chksums for the model's basic state variables, including transports. -subroutine MOM_state_chksum_5arg(mesg, u, v, h, uh, vh, G, GV, haloshift, symmetric) +subroutine MOM_state_chksum_5arg(mesg, u, v, h, uh, vh, G, GV, US, haloshift, 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. @@ -52,10 +52,11 @@ subroutine MOM_state_chksum_5arg(mesg, u, v, h, uh, vh, G, GV, haloshift, symmet intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & intent(in) :: uh !< Volume flux through zonal faces = u*h*dy - !! [H m2 s-1 ~> m3 s-1 or kg s-1]. + !! [H L2 T-1 ~> m3 s-1 or kg s-1]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & intent(in) :: vh !< Volume flux through meridional faces = v*h*dx - !! [H m2 s-1 ~> m3 s-1 or kg s-1]. + !! [H L2 T-1 ~> m3 s-1 or kg s-1]. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type integer, optional, intent(in) :: haloshift !< The width of halos to check (default 0). logical, optional, intent(in) :: symmetric !< If true, do checksums on the fully symmetric !! computationoal domain. @@ -72,7 +73,7 @@ subroutine MOM_state_chksum_5arg(mesg, u, v, h, uh, vh, G, GV, haloshift, symmet call uvchksum(mesg//" [uv]", u, v, G%HI, haloshift=hs, symmetric=sym) call hchksum(h, mesg//" h", G%HI, haloshift=hs, scale=GV%H_to_m) call uvchksum(mesg//" [uv]h", uh, vh, G%HI, haloshift=hs, & - symmetric=sym, scale=GV%H_to_m) + symmetric=sym, scale=GV%H_to_m*US%L_to_m**2*US%s_to_T) end subroutine MOM_state_chksum_5arg ! ============================================================================= diff --git a/src/core/MOM_continuity.F90 b/src/core/MOM_continuity.F90 index 5bca916ab5..ebb958f6dc 100644 --- a/src/core/MOM_continuity.F90 +++ b/src/core/MOM_continuity.F90 @@ -54,10 +54,10 @@ subroutine continuity(u, v, hin, h, uh, vh, dt, G, GV, US, CS, uhbt, vhbt, OBC, intent(inout) :: h !< Final layer thickness [H ~> m or kg m-2]. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & intent(out) :: uh !< Volume flux through zonal faces = - !! u*h*dy [H m2 s-1 ~> m3 s-1 or kg s-1]. + !! u*h*dy [H L2 T-1 ~> m3 s-1 or kg s-1]. 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]. + !! v*h*dx [H L2 T-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. diff --git a/src/core/MOM_continuity_PPM.F90 b/src/core/MOM_continuity_PPM.F90 index a55166e7ff..0df954a4f5 100644 --- a/src/core/MOM_continuity_PPM.F90 +++ b/src/core/MOM_continuity_PPM.F90 @@ -87,9 +87,9 @@ subroutine continuity_PPM(u, v, hin, h, uh, vh, dt, G, GV, US, CS, uhbt, vhbt, O real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(inout) :: h !< Final layer thickness [H ~> m or kg m-2]. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & - intent(out) :: uh !< Zonal volume flux, u*h*dy [H m2 s-1 ~> m3 s-1 or kg s-1]. + intent(out) :: uh !< Zonal volume flux, u*h*dy [H L2 T-1 ~> m3 s-1 or kg s-1]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - intent(out) :: vh !< Meridional volume flux, v*h*dx [H m2 s-1 ~> m3 s-1 or kg s-1]. + intent(out) :: vh !< Meridional volume flux, v*h*dx [H L2 T-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 @@ -171,7 +171,7 @@ subroutine continuity_PPM(u, v, hin, h, uh, vh, dt, G, GV, US, CS, uhbt, vhbt, O call cpu_clock_begin(id_clock_update) !$OMP parallel do default(shared) do k=1,nz ; do j=LB%jsh,LB%jeh ; do i=LB%ish,LB%ieh - h(i,j,k) = hin(i,j,k) - dt* G%IareaT(i,j) * (uh(I,j,k) - uh(I-1,j,k)) + h(i,j,k) = hin(i,j,k) - US%s_to_T*dt* US%L_to_m**2*G%IareaT(i,j) * (uh(I,j,k) - uh(I-1,j,k)) ! Uncomment this line to prevent underflow. ! if (h(i,j,k) < h_min) h(i,j,k) = h_min enddo ; enddo ; enddo @@ -187,7 +187,7 @@ subroutine continuity_PPM(u, v, hin, h, uh, vh, dt, G, GV, US, CS, uhbt, vhbt, O call cpu_clock_begin(id_clock_update) !$OMP parallel do default(shared) do k=1,nz ; do j=LB%jsh,LB%jeh ; do i=LB%ish,LB%ieh - h(i,j,k) = h(i,j,k) - dt*G%IareaT(i,j) * (vh(i,J,k) - vh(i,J-1,k)) + h(i,j,k) = h(i,j,k) - US%s_to_T*dt * US%L_to_m**2*G%IareaT(i,j) * (vh(i,J,k) - vh(i,J-1,k)) ! This line prevents underflow. if (h(i,j,k) < h_min) h(i,j,k) = h_min enddo ; enddo ; enddo @@ -204,7 +204,7 @@ subroutine continuity_PPM(u, v, hin, h, uh, vh, dt, G, GV, US, CS, uhbt, vhbt, O call cpu_clock_begin(id_clock_update) !$OMP parallel do default(shared) do k=1,nz ; do j=LB%jsh,LB%jeh ; do i=LB%ish,LB%ieh - h(i,j,k) = hin(i,j,k) - dt*G%IareaT(i,j) * (vh(i,J,k) - vh(i,J-1,k)) + h(i,j,k) = hin(i,j,k) - US%s_to_T*dt * US%L_to_m**2*G%IareaT(i,j) * (vh(i,J,k) - vh(i,J-1,k)) enddo ; enddo ; enddo call cpu_clock_end(id_clock_update) @@ -217,7 +217,7 @@ subroutine continuity_PPM(u, v, hin, h, uh, vh, dt, G, GV, US, CS, uhbt, vhbt, O call cpu_clock_begin(id_clock_update) !$OMP parallel do default(shared) do k=1,nz ; do j=LB%jsh,LB%jeh ; do i=LB%ish,LB%ieh - h(i,j,k) = h(i,j,k) - dt* G%IareaT(i,j) * (uh(I,j,k) - uh(I-1,j,k)) + h(i,j,k) = h(i,j,k) - US%s_to_T*dt* US%L_to_m**2*G%IareaT(i,j) * (uh(I,j,k) - uh(I-1,j,k)) ! This line prevents underflow. if (h(i,j,k) < h_min) h(i,j,k) = h_min enddo ; enddo ; enddo @@ -238,7 +238,7 @@ subroutine zonal_mass_flux(u, h_in, uh, dt, G, GV, US, CS, LB, uhbt, OBC, & intent(in) :: h_in !< Layer thickness used to calculate fluxes [H ~> m or kg m-2]. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & intent(out) :: uh !< Volume flux through zonal faces = u*h*dy - !! [H m2 s-1 ~> m3 s-1 or kg s-1]. + !! [H L2 T-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. @@ -348,6 +348,7 @@ subroutine zonal_mass_flux(u, h_in, uh, dt, G, GV, US, CS, LB, uhbt, OBC, & do I=ish-1,ieh if (OBC%segment(OBC%segnum_u(I,j))%specified) & uh(I,j,k) = OBC%segment(OBC%segnum_u(I,j))%normal_trans(I,j,k) + ! uh(I,j,k) = US%m_to_L**2*US%T_to_s*OBC%segment(OBC%segnum_u(I,j))%normal_trans(I,j,k) enddo endif enddo @@ -537,6 +538,12 @@ subroutine zonal_mass_flux(u, h_in, uh, dt, G, GV, US, CS, LB, uhbt, OBC, & endif endif ; endif + !### Work this into the code above. + do k=1,nz ; do j=jsh,jeh ; do I=ish-1,ieh + uh(I,j,k) = US%m_to_L**2*US%T_to_s*uh(I,j,k) + enddo ; enddo ; enddo + + end subroutine zonal_mass_flux !> Evaluates the zonal mass or volume fluxes in a layer. @@ -1356,6 +1363,11 @@ subroutine meridional_mass_flux(v, h_in, vh, dt, G, GV, US, CS, LB, vhbt, OBC, & endif endif ; endif + !### Work this into the code above. + do k=1,nz ; do J=jsh-1,jeh ; do i=ish,ieh + vh(i,J,k) = US%m_to_L**2*US%T_to_s*vh(i,J,k) + enddo ; enddo ; enddo + end subroutine meridional_mass_flux !> Evaluates the meridional mass or volume fluxes in a layer. diff --git a/src/core/MOM_dynamics_split_RK2.F90 b/src/core/MOM_dynamics_split_RK2.F90 index 4c9a9de747..478a560f52 100644 --- a/src/core/MOM_dynamics_split_RK2.F90 +++ b/src/core/MOM_dynamics_split_RK2.F90 @@ -254,10 +254,10 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & !! time step [Pa] real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & target, intent(inout) :: uh !< zonal volume/mass transport - !! [H m2 s-1 ~> m3 s-1 or kg s-1] + !! [H L2 T-1 ~> m3 s-1 or kg s-1] real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & target, intent(inout) :: vh !< merid volume/mass transport - !! [H m2 s-1 ~> m3 s-1 or kg s-1] + !! [H L2 T-1 ~> m3 s-1 or kg s-1] real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & intent(inout) :: uhtr !< accumulatated zonal volume/mass transport !! since last tracer advection [H L2 ~> m3 or kg] @@ -290,7 +290,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), target :: uh_in real, dimension(SZI_(G),SZJB_(G),SZK_(G)), target :: vh_in ! uh_in and vh_in are the zonal or meridional mass transports that would be - ! obtained using the initial velocities [H m2 s-1 ~> m3 s-1 or kg s-1]. + ! obtained using the initial velocities [H L2 T-1 ~> m3 s-1 or kg s-1]. real, dimension(SZIB_(G),SZJ_(G)) :: uhbt_out real, dimension(SZI_(G),SZJB_(G)) :: vhbt_out @@ -355,7 +355,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & call updateCFLtruncationValue(Time_local, CS%vertvisc_CSp) if (CS%debug) then - call MOM_state_chksum("Start predictor ", u, v, h, uh, vh, G, GV, symmetric=sym) + call MOM_state_chksum("Start predictor ", u, v, h, uh, vh, G, GV, US, symmetric=sym) call check_redundant("Start predictor u ", u, v, G) call check_redundant("Start predictor uh ", uh, vh, G) endif @@ -568,11 +568,11 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & call uvchksum("Predictor 1 [uv]", up, vp, G%HI, haloshift=0, symmetric=sym) call hchksum(h, "Predictor 1 h", G%HI, haloshift=1, scale=GV%H_to_m) call uvchksum("Predictor 1 [uv]h", uh, vh, G%HI,haloshift=2, & - symmetric=sym, scale=GV%H_to_m) -! call MOM_state_chksum("Predictor 1", up, vp, h, uh, vh, G, GV, haloshift=1) + symmetric=sym, scale=GV%H_to_m*US%L_to_m**2*US%s_to_T) +! call MOM_state_chksum("Predictor 1", up, vp, h, uh, vh, G, GV, US, haloshift=1) call MOM_accel_chksum("Predictor accel", CS%CAu, CS%CAv, CS%PFu, CS%PFv, & 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, & + call MOM_state_chksum("Predictor 1 init", u_init, v_init, h, uh, vh, G, GV, US, haloshift=2, & symmetric=sym) call check_redundant("Predictor 1 up", up, vp, G) call check_redundant("Predictor 1 uh", uh, vh, G) @@ -678,10 +678,10 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & endif if (CS%debug) then - call MOM_state_chksum("Predictor ", up, vp, hp, uh, vh, G, GV, symmetric=sym) + call MOM_state_chksum("Predictor ", up, vp, hp, uh, vh, G, GV, US, symmetric=sym) call uvchksum("Predictor avg [uv]", u_av, v_av, G%HI, haloshift=1, symmetric=sym) call hchksum(h_av, "Predictor avg h", G%HI, haloshift=0, scale=GV%H_to_m) - ! call MOM_state_chksum("Predictor avg ", u_av, v_av, h_av, uh, vh, G, GV) + ! call MOM_state_chksum("Predictor avg ", u_av, v_av, h_av, uh, vh, G, GV, US) call check_redundant("Predictor up ", up, vp, G) call check_redundant("Predictor uh ", uh, vh, G) endif @@ -772,8 +772,8 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & call uvchksum("Corrector 1 [uv]", u, v, G%HI,haloshift=0, symmetric=sym) call hchksum(h, "Corrector 1 h", G%HI, haloshift=2, scale=GV%H_to_m) call uvchksum("Corrector 1 [uv]h", uh, vh, G%HI, haloshift=2, & - symmetric=sym, scale=GV%H_to_m) - ! call MOM_state_chksum("Corrector 1", u, v, h, uh, vh, G, GV, haloshift=1) + symmetric=sym, scale=GV%H_to_m*US%L_to_m**2*US%s_to_T) + ! call MOM_state_chksum("Corrector 1", u, v, h, uh, vh, G, GV, US, haloshift=1) call MOM_accel_chksum("Corrector accel", CS%CAu, CS%CAv, CS%PFu, CS%PFv, & CS%diffu, CS%diffv, G, GV, US, CS%pbce, CS%u_accel_bt, CS%v_accel_bt, & symmetric=sym) @@ -843,10 +843,10 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & !$OMP parallel do default(shared) do k=1,nz do j=js-2,je+2 ; do I=Isq-2,Ieq+2 - uhtr(I,j,k) = uhtr(I,j,k) + US%m_to_L**2*uh(I,j,k)*dt + uhtr(I,j,k) = uhtr(I,j,k) + uh(I,j,k)*US%s_to_T*dt enddo ; enddo do J=Jsq-2,Jeq+2 ; do i=is-2,ie+2 - vhtr(i,J,k) = vhtr(i,J,k) + US%m_to_L**2*vh(i,J,k)*dt + vhtr(i,J,k) = vhtr(i,J,k) + vh(i,J,k)*US%s_to_T*dt enddo ; enddo enddo @@ -869,10 +869,10 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & if (CS%id_v_BT_accel > 0) call post_data(CS%id_v_BT_accel, CS%v_accel_bt, CS%diag) if (CS%debug) then - call MOM_state_chksum("Corrector ", u, v, h, uh, vh, G, GV, symmetric=sym) + call MOM_state_chksum("Corrector ", u, v, h, uh, vh, G, GV, US, symmetric=sym) call uvchksum("Corrector avg [uv]", u_av, v_av, G%HI,haloshift=1, symmetric=sym) call hchksum(h_av, "Corrector avg h", G%HI, haloshift=1, scale=GV%H_to_m) - ! call MOM_state_chksum("Corrector avg ", u_av, v_av, h_av, uh, vh, G, GV) + ! call MOM_state_chksum("Corrector avg ", u_av, v_av, h_av, uh, vh, G, GV, US) endif if (showCallTree) call callTree_leave("step_MOM_dyn_split_RK2()") @@ -889,9 +889,9 @@ subroutine register_restarts_dyn_split_RK2(HI, GV, param_file, CS, restart_CS, u type(MOM_dyn_split_RK2_CS), pointer :: CS !< module control structure type(MOM_restart_CS), pointer :: restart_CS !< restart control structure real, dimension(SZIB_(HI),SZJ_(HI),SZK_(GV)), & - target, intent(inout) :: uh !< zonal volume/mass transport [H m2 s-1 ~> m3 s-1 or kg s-1] + target, intent(inout) :: uh !< zonal volume/mass transport [H L2 T-1 ~> m3 s-1 or kg s-1] real, dimension(SZI_(HI),SZJB_(HI),SZK_(GV)), & - target, intent(inout) :: vh !< merid volume/mass transport [H m2 s-1 ~> m3 s-1 or kg s-1] + target, intent(inout) :: vh !< merid volume/mass transport [H L2 T-1 ~> m3 s-1 or kg s-1] type(vardesc) :: vd character(len=40) :: mdl = "MOM_dynamics_split_RK2" ! This module's name. @@ -973,9 +973,9 @@ subroutine initialize_dyn_split_RK2(u, v, h, uh, vh, eta, Time, G, GV, US, param intent(inout) :: v !< merid velocity [m s-1] real, dimension(SZI_(G),SZJ_(G),SZK_(G)) , intent(inout) :: h !< layer thickness [H ~> m or kg m-2] real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & - target, intent(inout) :: uh !< zonal volume/mass transport [H m2 s-1 ~> m3 s-1 or kg s-1] + target, intent(inout) :: uh !< zonal volume/mass transport [H L2 T-1 ~> m3 s-1 or kg s-1] real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - target, intent(inout) :: vh !< merid volume/mass transport [H m2 s-1 ~> m3 s-1 or kg s-1] + target, intent(inout) :: vh !< merid volume/mass transport [H L2 T-1 ~> m3 s-1 or kg s-1] real, dimension(SZI_(G),SZJ_(G)), intent(inout) :: eta !< free surface height or column mass [H ~> m or kg m-2] type(time_type), target, intent(in) :: Time !< current model time type(param_file_type), intent(in) :: param_file !< parameter file for parsing @@ -1172,8 +1172,11 @@ subroutine initialize_dyn_split_RK2(u, v, h, uh, vh, eta, Time, G, GV, US, param H_rescale = GV%m_to_H / GV%m_to_H_restart do k=1,nz ; do j=js,je ; do i=is,ie ; CS%h_av(i,j,k) = H_rescale * CS%h_av(i,j,k) ; enddo ; enddo ; enddo endif - if ((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 + if ( (GV%m_to_H_restart * US%s_to_T_restart * US%m_to_L_restart /= 0.0) .and. & + ((GV%m_to_H * US%m_to_L**2 * US%s_to_T_restart) /= & + (GV%m_to_H_restart * US%m_to_L_restart**2 * US%s_to_T)) ) then + uH_rescale = (GV%m_to_H * US%m_to_L**2 * US%s_to_T_restart) / & + (GV%m_to_H_restart * US%m_to_L_restart**2 * US%s_to_T) do k=1,nz ; do j=js,je ; do I=G%IscB,G%IecB ; uh(I,j,k) = uH_rescale * uh(I,j,k) ; enddo ; enddo ; enddo do k=1,nz ; do J=G%JscB,G%JecB ; do i=is,ie ; vh(i,J,k) = uH_rescale * vh(i,J,k) ; enddo ; enddo ; enddo endif @@ -1190,10 +1193,10 @@ subroutine initialize_dyn_split_RK2(u, v, h, uh, vh, eta, Time, G, GV, US, param H_convert = GV%H_to_m ; if (.not.GV%Boussinesq) H_convert = GV%H_to_kg_m2 CS%id_uh = register_diag_field('ocean_model', 'uh', diag%axesCuL, Time, & 'Zonal Thickness Flux', flux_units, y_cell_method='sum', v_extensive=.true., & - conversion=H_convert) + conversion=H_convert*US%L_to_m**2*US%s_to_T) CS%id_vh = register_diag_field('ocean_model', 'vh', diag%axesCvL, Time, & 'Meridional Thickness Flux', flux_units, x_cell_method='sum', v_extensive=.true., & - conversion=H_convert) + conversion=H_convert*US%L_to_m**2*US%s_to_T) CS%id_CAu = register_diag_field('ocean_model', 'CAu', diag%axesCuL, Time, & 'Zonal Coriolis and Advective Acceleration', 'm s-2') diff --git a/src/core/MOM_dynamics_unsplit.F90 b/src/core/MOM_dynamics_unsplit.F90 index 13cca76616..39841e8ab2 100644 --- a/src/core/MOM_dynamics_unsplit.F90 +++ b/src/core/MOM_dynamics_unsplit.F90 @@ -203,9 +203,9 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & real, dimension(:,:), pointer :: p_surf_end !< A pointer (perhaps NULL) to the surface !! pressure at the end of this dynamic step [Pa]. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: uh !< The zonal volume or mass transport - !! [H m2 s-1 ~> m3 or kg s-1]. + !! [H L2 T-1 ~> m3 s-1 or kg s-1]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: vh !< The meridional volume or mass - !! transport [H m2 s-1 ~> m3 or kg s-1]. + !! transport [H L2 T-1 ~> m3 s-1 or kg s-1]. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: uhtr !< The accumulated zonal volume or mass !! transport since the last tracer advection [H L2 ~> m3 or kg]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: vhtr !< The accumulated meridional volume or mass @@ -249,7 +249,7 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & ! all of the fields except h. h is stepped separately. if (CS%debug) then - call MOM_state_chksum("Start First Predictor ", u, v, h, uh, vh, G, GV) + call MOM_state_chksum("Start First Predictor ", u, v, h, uh, vh, G, GV, US) endif ! diffu = horizontal viscosity terms (u,h) @@ -289,10 +289,10 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & 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*US%m_to_L**2*uh(i,j,k) + uhtr(i,j,k) = uhtr(i,j,k) + 0.5*US%s_to_T*dt*uh(i,j,k) enddo ; enddo do J=Jsq-2,Jeq+2 ; do i=is-2,ie+2 - vhtr(i,j,k) = vhtr(i,j,k) + 0.5*dt*US%m_to_L**2*vh(i,j,k) + vhtr(i,j,k) = vhtr(i,j,k) + 0.5*US%s_to_T*dt*vh(i,j,k) enddo ; enddo enddo call cpu_clock_end(id_clock_mom_update) @@ -334,7 +334,7 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & call cpu_clock_end(id_clock_mom_update) if (CS%debug) then - call MOM_state_chksum("Predictor 1", up, vp, h_av, uh, vh, G, GV) + call MOM_state_chksum("Predictor 1", up, vp, h_av, uh, vh, G, GV, US) call MOM_accel_chksum("Predictor 1 accel", CS%CAu, CS%CAv, CS%PFu, CS%PFv,& CS%diffu, CS%diffv, G, GV, US) endif @@ -402,7 +402,7 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & call cpu_clock_end(id_clock_mom_update) if (CS%debug) then - call MOM_state_chksum("Predictor 2", upp, vpp, h_av, uh, vh, G, GV) + call MOM_state_chksum("Predictor 2", upp, vpp, h_av, uh, vh, G, GV, US) call MOM_accel_chksum("Predictor 2 accel", CS%CAu, CS%CAv, CS%PFu, CS%PFv,& CS%diffu, CS%diffv, G, GV, US) endif @@ -441,10 +441,10 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & h_av(i,j,k) = 0.5*(h(i,j,k) + hp(i,j,k)) 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*US%m_to_L**2*uh(i,j,k) + uhtr(i,j,k) = uhtr(i,j,k) + 0.5*US%s_to_T*dt*uh(i,j,k) enddo ; enddo do J=Jsq-2,Jeq+2 ; do i=is-2,ie+2 - vhtr(i,j,k) = vhtr(i,j,k) + 0.5*dt*US%m_to_L**2*vh(i,j,k) + vhtr(i,j,k) = vhtr(i,j,k) + 0.5*US%s_to_T*dt*vh(i,j,k) enddo ; enddo enddo @@ -487,7 +487,7 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & call pass_vector(u, v, G%Domain, clock=id_clock_pass) if (CS%debug) then - call MOM_state_chksum("Corrector", u, v, h, uh, vh, G, GV) + call MOM_state_chksum("Corrector", u, v, h, uh, vh, G, GV, US) call MOM_accel_chksum("Corrector accel", CS%CAu, CS%CAv, CS%PFu, CS%PFv, & CS%diffu, CS%diffv, G, GV, US) endif @@ -670,10 +670,10 @@ subroutine initialize_dyn_unsplit(u, v, h, Time, G, GV, US, param_file, diag, CS H_convert = GV%H_to_m ; if (.not.GV%Boussinesq) H_convert = GV%H_to_kg_m2 CS%id_uh = register_diag_field('ocean_model', 'uh', diag%axesCuL, Time, & 'Zonal Thickness Flux', flux_units, y_cell_method='sum', v_extensive=.true., & - conversion=H_convert) + conversion=H_convert*US%L_to_m**2*US%s_to_T) CS%id_vh = register_diag_field('ocean_model', 'vh', diag%axesCvL, Time, & 'Meridional Thickness Flux', flux_units, x_cell_method='sum', v_extensive=.true., & - conversion=H_convert) + conversion=H_convert*US%L_to_m**2*US%s_to_T) CS%id_CAu = register_diag_field('ocean_model', 'CAu', diag%axesCuL, Time, & 'Zonal Coriolis and Advective Acceleration', 'meter second-2') CS%id_CAv = register_diag_field('ocean_model', 'CAv', diag%axesCvL, Time, & diff --git a/src/core/MOM_dynamics_unsplit_RK2.F90 b/src/core/MOM_dynamics_unsplit_RK2.F90 index bae771a6c2..6a0ba7e3dd 100644 --- a/src/core/MOM_dynamics_unsplit_RK2.F90 +++ b/src/core/MOM_dynamics_unsplit_RK2.F90 @@ -213,9 +213,9 @@ subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt, !! the surface pressure at the end of !! this dynamic step [Pa]. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: uh !< The zonal volume or mass transport - !! [H m2 s-1 ~> m3 or kg s-1]. + !! [H L2 T-1 ~> m3 s-1 or kg s-1]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: vh !< The meridional volume or mass - !! transport [H m2 s-1 ~> m3 or kg s-1]. + !! transport [H L2 T-1 ~> m3 s-1 or kg s-1]. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: uhtr !< The accumulated zonal volume or !! mass transport since the last !! tracer advection [H L2 ~> m3 or kg]. @@ -260,7 +260,7 @@ subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt, ! all of the fields except h. h is stepped separately. if (CS%debug) then - call MOM_state_chksum("Start Predictor ", u_in, v_in, h_in, uh, vh, G, GV) + call MOM_state_chksum("Start Predictor ", u_in, v_in, h_in, uh, vh, G, GV, US) endif ! diffu = horizontal viscosity terms (u,h) @@ -363,7 +363,7 @@ subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt, enddo ; enddo ; enddo if (CS%debug) & - call MOM_state_chksum("Predictor 1", up, vp, h_av, uh, vh, G, GV) + call MOM_state_chksum("Predictor 1", up, vp, h_av, uh, vh, G, GV, US) ! CAu = -(f+zeta(up))/h_av vh + d/dx KE(up) (function of up[n-1/2], h[n-1/2]) call cpu_clock_begin(id_clock_Cor) @@ -418,15 +418,15 @@ subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt, ! Accumulate mass flux for tracer transport do k=1,nz do j=js-2,je+2 ; do I=Isq-2,Ieq+2 - uhtr(I,j,k) = uhtr(I,j,k) + dt*US%m_to_L**2*uh(I,j,k) + uhtr(I,j,k) = uhtr(I,j,k) + US%s_to_T*dt*uh(I,j,k) enddo ; enddo do J=Jsq-2,Jeq+2 ; do i=is-2,ie+2 - vhtr(i,J,k) = vhtr(i,J,k) + dt*US%m_to_L**2*vh(i,J,k) + vhtr(i,J,k) = vhtr(i,J,k) + US%s_to_T*dt*vh(i,J,k) enddo ; enddo enddo if (CS%debug) then - call MOM_state_chksum("Corrector", u_in, v_in, h_in, uh, vh, G, GV) + call MOM_state_chksum("Corrector", u_in, v_in, h_in, uh, vh, G, GV, US) call MOM_accel_chksum("Corrector accel", CS%CAu, CS%CAv, CS%PFu, CS%PFv, & CS%diffu, CS%diffv, G, GV, US) endif @@ -629,10 +629,10 @@ subroutine initialize_dyn_unsplit_RK2(u, v, h, Time, G, GV, US, param_file, diag H_convert = GV%H_to_m ; if (.not.GV%Boussinesq) H_convert = GV%H_to_kg_m2 CS%id_uh = register_diag_field('ocean_model', 'uh', diag%axesCuL, Time, & 'Zonal Thickness Flux', flux_units, y_cell_method='sum', v_extensive=.true., & - conversion=H_convert) + conversion=H_convert*US%L_to_m**2*US%s_to_T) CS%id_vh = register_diag_field('ocean_model', 'vh', diag%axesCvL, Time, & 'Meridional Thickness Flux', flux_units, x_cell_method='sum', v_extensive=.true., & - conversion=H_convert) + conversion=H_convert*US%L_to_m**2*US%s_to_T) CS%id_CAu = register_diag_field('ocean_model', 'CAu', diag%axesCuL, Time, & 'Zonal Coriolis and Advective Acceleration', 'meter second-2') CS%id_CAv = register_diag_field('ocean_model', 'CAv', diag%axesCvL, Time, & diff --git a/src/diagnostics/MOM_diagnostics.F90 b/src/diagnostics/MOM_diagnostics.F90 index ed9e805b5b..d5ae88aeb3 100644 --- a/src/diagnostics/MOM_diagnostics.F90 +++ b/src/diagnostics/MOM_diagnostics.F90 @@ -195,10 +195,10 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & intent(in) :: uh !< Transport through zonal faces = u*h*dy, - !! [H m2 s-1 ~> m3 s-1 or kg s-1]. + !! [H L2 T-1 ~> m3 s-1 or kg s-1]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & intent(in) :: vh !< Transport through meridional faces = v*h*dx, - !! [H m2 s-1 ~> m3 s-1 or kg s-1]. + !! [H L2 T-1 ~> m3 s-1 or kg s-1]. type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various !! thermodynamic variables. type(accel_diag_ptrs), intent(in) :: ADp !< structure with pointers to @@ -506,13 +506,13 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & CS%uh_Rlay(I,j,k) = 0.0 enddo ; enddo do k=nkmb+1,nz ; do I=Isq,Ieq - CS%uh_Rlay(I,j,k) = uh(I,j,k) + CS%uh_Rlay(I,j,k) = US%L_to_m**2*US%s_to_T*uh(I,j,k) enddo ; enddo k_list = nz/2 do k=1,nkmb ; do I=Isq,Ieq call find_weights(GV%Rlay, 0.5*(Rcv(i,j,k)+Rcv(i+1,j,k)), k_list, nz, wt, wt_p) - CS%uh_Rlay(I,j,k_list) = CS%uh_Rlay(I,j,k_list) + uh(I,j,k)*wt - CS%uh_Rlay(I,j,k_list+1) = CS%uh_Rlay(I,j,k_list+1) + uh(I,j,k)*wt_p + CS%uh_Rlay(I,j,k_list) = CS%uh_Rlay(I,j,k_list) + US%L_to_m**2*US%s_to_T*uh(I,j,k)*wt + CS%uh_Rlay(I,j,k_list+1) = CS%uh_Rlay(I,j,k_list+1) + US%L_to_m**2*US%s_to_T*uh(I,j,k)*wt_p enddo ; enddo enddo @@ -528,12 +528,12 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & CS%vh_Rlay(i,J,k) = 0.0 enddo ; enddo do k=nkmb+1,nz ; do i=is,ie - CS%vh_Rlay(i,J,k) = vh(i,J,k) + CS%vh_Rlay(i,J,k) = US%L_to_m**2*US%s_to_T*vh(i,J,k) enddo ; enddo do k=1,nkmb ; do i=is,ie call find_weights(GV%Rlay, 0.5*(Rcv(i,j,k)+Rcv(i,j+1,k)), k_list, nz, wt, wt_p) - CS%vh_Rlay(i,J,k_list) = CS%vh_Rlay(i,J,k_list) + vh(i,J,k)*wt - CS%vh_Rlay(i,J,k_list+1) = CS%vh_Rlay(i,J,k_list+1) + vh(i,J,k)*wt_p + CS%vh_Rlay(i,J,k_list) = CS%vh_Rlay(i,J,k_list) + US%L_to_m**2*US%s_to_T*vh(i,J,k)*wt + CS%vh_Rlay(i,J,k_list+1) = CS%vh_Rlay(i,J,k_list+1) + US%L_to_m**2*US%s_to_T*vh(i,J,k)*wt_p enddo ; enddo enddo @@ -889,10 +889,10 @@ subroutine calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, GV, US, CS intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & intent(in) :: uh !< Transport through zonal faces=u*h*dy, - !! [H m2 s-1 ~> m3 s-1 or kg s-1]. + !! [H L2 T-1 ~> m3 s-1 or kg s-1]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & intent(in) :: vh !< Transport through merid faces=v*h*dx, - !! [H m2 s-1 ~> m3 s-1 or kg s-1]. + !! [H L2 T-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 @@ -936,10 +936,10 @@ subroutine calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, GV, US, CS if (associated(CS%dKE_dt)) 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)*CS%du_dt(I,j,k) + KE_u(I,j) = US%L_to_m**2*US%s_to_T*uh(I,j,k)*G%dxCu(I,j)*CS%du_dt(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)*CS%dv_dt(i,J,k) + KE_v(i,J) = US%L_to_m**2*US%s_to_T*vh(i,J,k)*G%dyCv(i,J)*CS%dv_dt(i,J,k) enddo ; enddo do j=js,je ; do i=is,ie KE_h(i,j) = CS%KE(i,j,k)*CS%dh_dt(i,j,k) @@ -957,10 +957,10 @@ subroutine calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, GV, US, CS if (associated(CS%PE_to_KE)) 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%PFu(I,j,k) + KE_u(I,j) = US%L_to_m**2*US%s_to_T*uh(I,j,k)*G%dxCu(I,j)*ADp%PFu(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%PFv(i,J,k) + KE_v(i,J) = US%L_to_m**2*US%s_to_T*vh(i,J,k)*G%dyCv(i,J)*ADp%PFv(i,J,k) enddo ; enddo if (.not.G%symmetric) & call do_group_pass(CS%pass_KE_uv, G%domain) @@ -975,14 +975,14 @@ subroutine calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, GV, US, CS if (associated(CS%KE_CorAdv)) 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%CAu(I,j,k) + KE_u(I,j) = US%L_to_m**2*US%s_to_T*uh(I,j,k)*G%dxCu(I,j)*ADp%CAu(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%CAv(i,J,k) + KE_v(i,J) = US%L_to_m**2*US%s_to_T*vh(i,J,k)*G%dyCv(i,J)*ADp%CAv(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) * & - (uh(I,j,k) - uh(I-1,j,k) + vh(i,J,k) - vh(i,J-1,k)) + US%L_to_m**2*US%s_to_T*(uh(I,j,k) - uh(I-1,j,k) + vh(i,J,k) - vh(i,J-1,k)) enddo ; enddo if (.not.G%symmetric) & call do_group_pass(CS%pass_KE_uv, G%domain) @@ -1002,15 +1002,15 @@ subroutine calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, GV, US, CS do k=1,nz do j=js,je ; do I=Isq,Ieq if (G%mask2dCu(i,j) /= 0.) & - KE_u(I,j) = uh(I,j,k)*G%dxCu(I,j)*ADp%gradKEu(I,j,k) + KE_u(I,j) = US%L_to_m**2*US%s_to_T*uh(I,j,k)*G%dxCu(I,j)*ADp%gradKEu(I,j,k) enddo ; enddo do J=Jsq,Jeq ; do i=is,ie if (G%mask2dCv(i,j) /= 0.) & - KE_v(i,J) = vh(i,J,k)*G%dyCv(i,J)*ADp%gradKEv(i,J,k) + KE_v(i,J) = US%L_to_m**2*US%s_to_T*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) * & - (uh(I,j,k) - uh(I-1,j,k) + vh(i,J,k) - vh(i,J-1,k)) + US%L_to_m**2*US%s_to_T*(uh(I,j,k) - uh(I-1,j,k) + vh(i,J,k) - vh(i,J-1,k)) enddo ; enddo if (.not.G%symmetric) & call do_group_pass(CS%pass_KE_uv, G%domain) @@ -1025,10 +1025,10 @@ subroutine calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, GV, US, CS if (associated(CS%KE_visc)) 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%du_dt_visc(I,j,k) + KE_u(I,j) = US%L_to_m**2*US%s_to_T*uh(I,j,k)*G%dxCu(I,j)*ADp%du_dt_visc(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%dv_dt_visc(i,J,k) + KE_v(i,J) = US%L_to_m**2*US%s_to_T*vh(i,J,k)*G%dyCv(i,J)*ADp%dv_dt_visc(i,J,k) enddo ; enddo if (.not.G%symmetric) & call do_group_pass(CS%pass_KE_uv, G%domain) @@ -1043,10 +1043,10 @@ subroutine calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, GV, US, 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)*US%s_to_T*ADp%diffu(I,j,k) + KE_u(I,j) = US%L_to_m**2*US%s_to_T*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)*US%s_to_T*ADp%diffv(i,J,k) + KE_v(i,J) = US%L_to_m**2*US%s_to_T*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) @@ -1061,10 +1061,10 @@ subroutine calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, GV, US, CS if (associated(CS%KE_dia)) 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%du_dt_dia(I,j,k) + KE_u(I,j) = US%L_to_m**2*US%s_to_T*uh(I,j,k)*G%dxCu(I,j)*ADp%du_dt_dia(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%dv_dt_dia(i,J,k) + KE_v(i,J) = US%L_to_m**2*US%s_to_T*vh(i,J,k)*G%dyCv(i,J)*ADp%dv_dt_dia(i,J,k) enddo ; enddo do j=js,je ; do i=is,ie KE_h(i,j) = CS%KE(i,j,k) * & From 139c562a886f2b16f88c538dd62b721706507312 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 30 Jul 2019 18:11:04 -0400 Subject: [PATCH 128/297] Cleanup of rescaling factors in energy diagnostics Rearranged some of the dimensional scaling factors in the kinetic energy budget to clean up the code and facilitate later cancellations. All answers are bitwise identical. --- src/diagnostics/MOM_diagnostics.F90 | 50 ++++++++++++++--------------- 1 file changed, 25 insertions(+), 25 deletions(-) diff --git a/src/diagnostics/MOM_diagnostics.F90 b/src/diagnostics/MOM_diagnostics.F90 index d5ae88aeb3..ee5a4976ac 100644 --- a/src/diagnostics/MOM_diagnostics.F90 +++ b/src/diagnostics/MOM_diagnostics.F90 @@ -936,10 +936,10 @@ subroutine calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, GV, US, CS if (associated(CS%dKE_dt)) then do k=1,nz do j=js,je ; do I=Isq,Ieq - KE_u(I,j) = US%L_to_m**2*US%s_to_T*uh(I,j,k)*G%dxCu(I,j)*CS%du_dt(I,j,k) + KE_u(I,j) = US%s_to_T*uh(I,j,k)*G%dxCu(I,j)*CS%du_dt(I,j,k) enddo ; enddo do J=Jsq,Jeq ; do i=is,ie - KE_v(i,J) = US%L_to_m**2*US%s_to_T*vh(i,J,k)*G%dyCv(i,J)*CS%dv_dt(i,J,k) + KE_v(i,J) = US%s_to_T*vh(i,J,k)*G%dyCv(i,J)*CS%dv_dt(i,J,k) enddo ; enddo do j=js,je ; do i=is,ie KE_h(i,j) = CS%KE(i,j,k)*CS%dh_dt(i,j,k) @@ -947,7 +947,7 @@ subroutine calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, GV, US, CS if (.not.G%symmetric) & call do_group_pass(CS%pass_KE_uv, G%domain) do j=js,je ; do i=is,ie - CS%dKE_dt(i,j,k) = GV%H_to_m * (KE_h(i,j) + 0.5 * G%IareaT(i,j) * & + CS%dKE_dt(i,j,k) = GV%H_to_m * (KE_h(i,j) + 0.5 * US%L_to_m**2*G%IareaT(i,j) * & (KE_u(I,j) + KE_u(I-1,j) + KE_v(i,J) + KE_v(i,J-1))) enddo ; enddo enddo @@ -957,15 +957,15 @@ subroutine calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, GV, US, CS if (associated(CS%PE_to_KE)) then do k=1,nz do j=js,je ; do I=Isq,Ieq - KE_u(I,j) = US%L_to_m**2*US%s_to_T*uh(I,j,k)*G%dxCu(I,j)*ADp%PFu(I,j,k) + KE_u(I,j) = US%s_to_T*uh(I,j,k)*G%dxCu(I,j)*ADp%PFu(I,j,k) enddo ; enddo do J=Jsq,Jeq ; do i=is,ie - KE_v(i,J) = US%L_to_m**2*US%s_to_T*vh(i,J,k)*G%dyCv(i,J)*ADp%PFv(i,J,k) + KE_v(i,J) = US%s_to_T*vh(i,J,k)*G%dyCv(i,J)*ADp%PFv(i,J,k) enddo ; enddo if (.not.G%symmetric) & call do_group_pass(CS%pass_KE_uv, G%domain) do j=js,je ; do i=is,ie - CS%PE_to_KE(i,j,k) = GV%H_to_m * 0.5 * G%IareaT(i,j) * & + CS%PE_to_KE(i,j,k) = GV%H_to_m * 0.5 * US%L_to_m**2*G%IareaT(i,j) * & (KE_u(I,j) + KE_u(I-1,j) + KE_v(i,J) + KE_v(i,J-1)) enddo ; enddo enddo @@ -975,19 +975,19 @@ subroutine calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, GV, US, CS if (associated(CS%KE_CorAdv)) then do k=1,nz do j=js,je ; do I=Isq,Ieq - KE_u(I,j) = US%L_to_m**2*US%s_to_T*uh(I,j,k)*G%dxCu(I,j)*ADp%CAu(I,j,k) + KE_u(I,j) = US%s_to_T*uh(I,j,k)*G%dxCu(I,j)*ADp%CAu(I,j,k) enddo ; enddo do J=Jsq,Jeq ; do i=is,ie - KE_v(i,J) = US%L_to_m**2*US%s_to_T*vh(i,J,k)*G%dyCv(i,J)*ADp%CAv(i,J,k) + KE_v(i,J) = US%s_to_T*vh(i,J,k)*G%dyCv(i,J)*ADp%CAv(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) * & - US%L_to_m**2*US%s_to_T*(uh(I,j,k) - uh(I-1,j,k) + vh(i,J,k) - vh(i,J-1,k)) + KE_h(i,j) = -CS%KE(i,j,k) * US%L_to_m**2*G%IareaT(i,j) * & + US%s_to_T*(uh(I,j,k) - uh(I-1,j,k) + vh(i,J,k) - vh(i,J-1,k)) enddo ; enddo if (.not.G%symmetric) & call do_group_pass(CS%pass_KE_uv, G%domain) do j=js,je ; do i=is,ie - CS%KE_CorAdv(i,j,k) = GV%H_to_m * (KE_h(i,j) + 0.5 * G%IareaT(i,j) * & + CS%KE_CorAdv(i,j,k) = GV%H_to_m * (KE_h(i,j) + 0.5 * US%L_to_m**2*G%IareaT(i,j) * & (KE_u(I,j) + KE_u(I-1,j) + KE_v(i,J) + KE_v(i,J-1))) enddo ; enddo enddo @@ -1002,20 +1002,20 @@ subroutine calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, GV, US, CS do k=1,nz do j=js,je ; do I=Isq,Ieq if (G%mask2dCu(i,j) /= 0.) & - KE_u(I,j) = US%L_to_m**2*US%s_to_T*uh(I,j,k)*G%dxCu(I,j)*ADp%gradKEu(I,j,k) + KE_u(I,j) = US%s_to_T*uh(I,j,k)*G%dxCu(I,j)*ADp%gradKEu(I,j,k) enddo ; enddo do J=Jsq,Jeq ; do i=is,ie if (G%mask2dCv(i,j) /= 0.) & - KE_v(i,J) = US%L_to_m**2*US%s_to_T*vh(i,J,k)*G%dyCv(i,J)*ADp%gradKEv(i,J,k) + KE_v(i,J) = US%s_to_T*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) * & - US%L_to_m**2*US%s_to_T*(uh(I,j,k) - uh(I-1,j,k) + vh(i,J,k) - vh(i,J-1,k)) + KE_h(i,j) = -CS%KE(i,j,k) * US%L_to_m**2*G%IareaT(i,j) * & + US%s_to_T*(uh(I,j,k) - uh(I-1,j,k) + vh(i,J,k) - vh(i,J-1,k)) enddo ; enddo if (.not.G%symmetric) & call do_group_pass(CS%pass_KE_uv, G%domain) do j=js,je ; do i=is,ie - CS%KE_adv(i,j,k) = GV%H_to_m * (KE_h(i,j) + 0.5 * G%IareaT(i,j) * & + CS%KE_adv(i,j,k) = GV%H_to_m * (KE_h(i,j) + 0.5 * US%L_to_m**2*G%IareaT(i,j) * & (KE_u(I,j) + KE_u(I-1,j) + KE_v(i,J) + KE_v(i,J-1))) enddo ; enddo enddo @@ -1025,15 +1025,15 @@ subroutine calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, GV, US, CS if (associated(CS%KE_visc)) then do k=1,nz do j=js,je ; do I=Isq,Ieq - KE_u(I,j) = US%L_to_m**2*US%s_to_T*uh(I,j,k)*G%dxCu(I,j)*ADp%du_dt_visc(I,j,k) + KE_u(I,j) = US%s_to_T*uh(I,j,k)*G%dxCu(I,j)*ADp%du_dt_visc(I,j,k) enddo ; enddo do J=Jsq,Jeq ; do i=is,ie - KE_v(i,J) = US%L_to_m**2*US%s_to_T*vh(i,J,k)*G%dyCv(i,J)*ADp%dv_dt_visc(i,J,k) + KE_v(i,J) = US%s_to_T*vh(i,J,k)*G%dyCv(i,J)*ADp%dv_dt_visc(i,J,k) enddo ; enddo if (.not.G%symmetric) & call do_group_pass(CS%pass_KE_uv, G%domain) do j=js,je ; do i=is,ie - CS%KE_visc(i,j,k) = GV%H_to_m * (0.5 * G%IareaT(i,j) * & + CS%KE_visc(i,j,k) = GV%H_to_m * (0.5 * US%L_to_m**2*G%IareaT(i,j) * & (KE_u(I,j) + KE_u(I-1,j) + KE_v(i,J) + KE_v(i,J-1))) enddo ; enddo enddo @@ -1043,15 +1043,15 @@ subroutine calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, GV, US, CS if (associated(CS%KE_horvisc)) then do k=1,nz do j=js,je ; do I=Isq,Ieq - KE_u(I,j) = US%L_to_m**2*US%s_to_T*uh(I,j,k)*G%dxCu(I,j)*US%s_to_T*ADp%diffu(I,j,k) + KE_u(I,j) = US%s_to_T*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) = US%L_to_m**2*US%s_to_T*vh(i,J,k)*G%dyCv(i,J)*US%s_to_T*ADp%diffv(i,J,k) + KE_v(i,J) = US%s_to_T*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) do j=js,je ; do i=is,ie - CS%KE_horvisc(i,j,k) = GV%H_to_m * 0.5 * G%IareaT(i,j) * & + CS%KE_horvisc(i,j,k) = GV%H_to_m * 0.5 * US%L_to_m**2*G%IareaT(i,j) * & (KE_u(I,j) + KE_u(I-1,j) + KE_v(i,J) + KE_v(i,J-1)) enddo ; enddo enddo @@ -1061,10 +1061,10 @@ subroutine calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, GV, US, CS if (associated(CS%KE_dia)) then do k=1,nz do j=js,je ; do I=Isq,Ieq - KE_u(I,j) = US%L_to_m**2*US%s_to_T*uh(I,j,k)*G%dxCu(I,j)*ADp%du_dt_dia(I,j,k) + KE_u(I,j) = US%s_to_T*uh(I,j,k)*G%dxCu(I,j)*ADp%du_dt_dia(I,j,k) enddo ; enddo do J=Jsq,Jeq ; do i=is,ie - KE_v(i,J) = US%L_to_m**2*US%s_to_T*vh(i,J,k)*G%dyCv(i,J)*ADp%dv_dt_dia(i,J,k) + KE_v(i,J) = US%s_to_T*vh(i,J,k)*G%dyCv(i,J)*ADp%dv_dt_dia(i,J,k) enddo ; enddo do j=js,je ; do i=is,ie KE_h(i,j) = CS%KE(i,j,k) * & @@ -1073,7 +1073,7 @@ subroutine calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, GV, US, CS if (.not.G%symmetric) & call do_group_pass(CS%pass_KE_uv, G%domain) do j=js,je ; do i=is,ie - CS%KE_dia(i,j,k) = KE_h(i,j) + GV%H_to_m * 0.5 * G%IareaT(i,j) * & + CS%KE_dia(i,j,k) = KE_h(i,j) + GV%H_to_m * 0.5 * US%L_to_m**2*G%IareaT(i,j) * & (KE_u(I,j) + KE_u(I-1,j) + KE_v(i,J) + KE_v(i,J-1)) enddo ; enddo enddo From 0efc11895cab1561a836ed0531801c29fa45ce45 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 30 Jul 2019 18:11:40 -0400 Subject: [PATCH 129/297] Corrected chksum scaling for vertvisc_CS%h_u Corrected the dimensional scaling in the chksum call for vertvisc_CS%h_u and vertvisc_CS%h_v. All answers are bitwise identical. --- src/parameterizations/vertical/MOM_vert_friction.F90 | 9 +++------ 1 file changed, 3 insertions(+), 6 deletions(-) diff --git a/src/parameterizations/vertical/MOM_vert_friction.F90 b/src/parameterizations/vertical/MOM_vert_friction.F90 index 82456b0e58..4c1de70024 100644 --- a/src/parameterizations/vertical/MOM_vert_friction.F90 +++ b/src/parameterizations/vertical/MOM_vert_friction.F90 @@ -1004,13 +1004,10 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, US, CS, OBC) enddo ! end of v-point j loop 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*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*US%s_to_T) + call uvchksum("vertvisc_coef h_[uv]", CS%h_u, CS%h_v, G%HI, haloshift=0, scale=GV%H_to_m) + call uvchksum("vertvisc_coef a_[uv]", CS%a_u, 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) + call uvchksum("vertvisc_coef hML_[uv]", hML_u, hML_v, G%HI, haloshift=0, scale=GV%H_to_m) endif ! Offer diagnostic fields for averaging. From 6c0f9f72165ce76fe702c535032921564aa7bb9c Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Wed, 31 Jul 2019 06:20:59 -0400 Subject: [PATCH 130/297] +Changed the units of uhbt and vhbt to [H L2 T-1] Changed the units of uhbt and vhbt as shared between the barotropic solver and the continuity solver from [H m2 s-1] to [H L2 T-1] for greater dimensional consistency testing. Also commented out 4 unused optional "_aux" arguments to continuity that were left over from an older split time stepping argument that was dropped four years ago in preparation for their elimination from continuity_ppm. All answers are bitwise identical. --- src/core/MOM_barotropic.F90 | 19 +++++---- src/core/MOM_continuity.F90 | 56 +++++++++++++-------------- src/core/MOM_continuity_PPM.F90 | 36 +++++++++-------- src/core/MOM_dynamics_split_RK2.F90 | 14 +++---- src/core/MOM_dynamics_unsplit.F90 | 9 ++--- src/core/MOM_dynamics_unsplit_RK2.F90 | 9 ++--- 6 files changed, 68 insertions(+), 75 deletions(-) diff --git a/src/core/MOM_barotropic.F90 b/src/core/MOM_barotropic.F90 index 5e08e2ccc2..c753fe2f9d 100644 --- a/src/core/MOM_barotropic.F90 +++ b/src/core/MOM_barotropic.F90 @@ -331,13 +331,13 @@ module MOM_barotropic !> A desciption of the functional dependence of transport at a v-point type, private :: local_BT_cont_v_type real :: 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 :: 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 :: 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 :: 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]. + !! drawing from locations far to the south [H L ~> m2 or kg m-1]. 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 [L T-1 ~> m s-1], beyond which the marginal @@ -384,8 +384,7 @@ module MOM_barotropic subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, & eta_PF_in, U_Cor, V_Cor, accel_layer_u, accel_layer_v, & eta_out, uhbtav, vhbtav, G, GV, US, CS, & - visc_rem_u, visc_rem_v, etaav, OBC, & - BT_cont, eta_PF_start, & + visc_rem_u, visc_rem_v, etaav, OBC, BT_cont, eta_PF_start, & taux_bot, tauy_bot, uh0, vh0, u_uh0, v_vh0) type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. @@ -419,10 +418,10 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, !! height anomaly or column mass anomaly [H ~> m or kg m-2]. real, dimension(SZIB_(G),SZJ_(G)), intent(out) :: uhbtav !< the barotropic zonal volume or mass !! fluxes averaged through the barotropic steps - !! [H m2 s-1 ~> m3 or kg s-1]. + !! [H L2 T-1 ~> m3 or kg s-1]. real, dimension(SZI_(G),SZJB_(G)), intent(out) :: vhbtav !< the barotropic meridional volume or mass !! fluxes averaged through the barotropic steps - !! [H m2 s-1 ~> m3 or kg s-1]. + !! [H L2 T-1 ~> m3 or kg s-1]. type(barotropic_CS), pointer :: CS !< The control structure returned by a !! previous call to barotropic_init. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: visc_rem_u !< Both the fraction of the momentum @@ -2087,7 +2086,7 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, do j=js,je ; do I=is-1,ie 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 + uhbtav(I,j) = 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 @@ -2095,7 +2094,7 @@ 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%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 + vhbtav(i,J) = 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 diff --git a/src/core/MOM_continuity.F90 b/src/core/MOM_continuity.F90 index ebb958f6dc..a8c90d6668 100644 --- a/src/core/MOM_continuity.F90 +++ b/src/core/MOM_continuity.F90 @@ -40,8 +40,8 @@ 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, 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) + visc_rem_u, visc_rem_v, u_cor, v_cor, BT_cont) +! uhbt_aux, vhbt_aux, u_cor_aux, v_cor_aux, BT_cont) type(ocean_grid_type), intent(inout) :: G !< Ocean grid structure. type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & @@ -63,10 +63,10 @@ subroutine continuity(u, v, hin, h, uh, vh, dt, G, GV, US, CS, uhbt, vhbt, OBC, type(continuity_CS), pointer :: CS !< Control structure for mom_continuity. real, dimension(SZIB_(G),SZJ_(G)), & optional, intent(in) :: uhbt !< The vertically summed volume - !! flux through zonal faces [H m2 s-1 ~> m3 s-1 or kg s-1]. + !! flux through zonal faces [H L2 T-1 ~> m3 s-1 or kg s-1]. real, dimension(SZI_(G),SZJB_(G)), & optional, intent(in) :: vhbt !< The vertically summed volume - !! flux through meridional faces [H m2 s-1 ~> m3 s-1 or kg s-1]. + !! flux through meridional faces [H L2 T-1 ~> m3 s-1 or kg s-1]. type(ocean_OBC_type), & optional, pointer :: OBC !< Open boundaries control structure. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & @@ -85,18 +85,18 @@ subroutine continuity(u, v, hin, h, uh, vh, dt, G, GV, US, CS, uhbt, vhbt, OBC, real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & optional, intent(out) :: v_cor !< The meridional velocities that !! give vhbt as the depth-integrated transport [m s-1]. - real, dimension(SZIB_(G),SZJ_(G)), & - optional, intent(in) :: uhbt_aux !< A second summed zonal - !! volume flux [H m2 s-1 ~> m3 s-1 or kg s-1]. - real, dimension(SZI_(G),SZJB_(G)), & - optional, intent(in) :: vhbt_aux !< A second summed meridional - !! volume flux [H m2 s-1 ~> m3 s-1 or kg s-1]. - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & - optional, intent(inout) :: u_cor_aux !< The zonal velocities - !! that give uhbt_aux as the depth-integrated transport [m s-1]. - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - optional, intent(inout) :: v_cor_aux !< The meridional velocities - !! that give vhbt_aux as the depth-integrated transport [m s-1]. +! real, dimension(SZIB_(G),SZJ_(G)), & +! optional, intent(in) :: uhbt_aux !< A second summed zonal +! !! volume flux [H m2 s-1 ~> m3 s-1 or kg s-1]. +! real, dimension(SZI_(G),SZJB_(G)), & +! optional, intent(in) :: vhbt_aux !< A second summed meridional +! !! volume flux [H m2 s-1 ~> m3 s-1 or kg s-1]. +! real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & +! optional, intent(inout) :: u_cor_aux !< The zonal velocities +! !! that give uhbt_aux as the depth-integrated transport [m s-1]. +! real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & +! optional, intent(inout) :: v_cor_aux !< The meridional velocities +! !! that give vhbt_aux as the depth-integrated transport [m s-1]. 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. @@ -107,21 +107,21 @@ subroutine continuity(u, v, hin, h, uh, vh, dt, G, GV, US, CS, uhbt, vhbt, OBC, if (present(u_cor) .neqv. present(v_cor)) call MOM_error(FATAL, & "MOM_continuity: Either both u_cor and v_cor or neither"// & " one must be present in call to continuity.") - if (present(uhbt_aux) .neqv. present(vhbt_aux)) call MOM_error(FATAL, & - "MOM_continuity: Either both uhbt_aux and uhbt_aux or neither"// & - " one must be present in call to continuity.") - if (present(u_cor_aux) .neqv. present(v_cor_aux)) call MOM_error(FATAL, & - "MOM_continuity: Either both u_cor_aux and v_cor_aux or neither"// & - " one must be present in call to continuity.") - if (present(u_cor_aux) .neqv. present(uhbt_aux)) call MOM_error(FATAL, & - "MOM_continuity: u_cor_aux can only be calculated if uhbt_aux is"// & - " provided, and uhbt_aux has no other purpose. Include both arguments"//& - " or neither.") +! if (present(uhbt_aux) .neqv. present(vhbt_aux)) call MOM_error(FATAL, & +! "MOM_continuity: Either both uhbt_aux and uhbt_aux or neither"// & +! " one must be present in call to continuity.") +! if (present(u_cor_aux) .neqv. present(v_cor_aux)) call MOM_error(FATAL, & +! "MOM_continuity: Either both u_cor_aux and v_cor_aux or neither"// & +! " one must be present in call to continuity.") +! if (present(u_cor_aux) .neqv. present(uhbt_aux)) call MOM_error(FATAL, & +! "MOM_continuity: u_cor_aux can only be calculated if uhbt_aux is"// & +! " provided, and uhbt_aux has no other purpose. Include both arguments"//& +! " or neither.") if (CS%continuity_scheme == PPM_SCHEME) then 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) + visc_rem_u, visc_rem_v, u_cor, v_cor, BT_cont=BT_cont) +! Eliminate 4 unused optional arguments: ( uhbt_aux, vhbt_aux, u_cor_aux, v_cor_aux, BT_cont) else call MOM_error(FATAL, "continuity: Unrecognized value of continuity_scheme") endif diff --git a/src/core/MOM_continuity_PPM.F90 b/src/core/MOM_continuity_PPM.F90 index 0df954a4f5..b5c62dad62 100644 --- a/src/core/MOM_continuity_PPM.F90 +++ b/src/core/MOM_continuity_PPM.F90 @@ -95,10 +95,10 @@ subroutine continuity_PPM(u, v, hin, h, uh, vh, dt, G, GV, US, CS, uhbt, vhbt, O 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]. + !! [H L2 T-1 ~> m3 s-1 or kg s-1]. real, dimension(SZI_(G),SZJB_(G)), & optional, intent(in) :: vhbt !< The summed volume flux through meridional faces - !! [H m2 s-1 ~> m3 s-1 or kg s-1]. + !! [H L2 T-1 ~> m3 s-1 or kg s-1]. type(ocean_OBC_type), & optional, pointer :: OBC !< Open boundaries control structure. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & @@ -253,7 +253,7 @@ subroutine zonal_mass_flux(u, h_in, uh, dt, G, GV, US, CS, LB, uhbt, OBC, & !! Non-dimensional between 0 (at the bottom) and 1 (far above the bottom). 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]. + !! [H L2 T-1 ~> m3 s-1 or kg s-1]. real, dimension(SZIB_(G),SZJ_(G)), & optional, intent(in) :: uhbt_aux !< A second set of summed volume fluxes through zonal faces [H m2 s-1 ~> m3 s-1 or kg s-1]. @@ -449,7 +449,7 @@ subroutine zonal_mass_flux(u, h_in, uh, dt, G, GV, US, CS, LB, uhbt, OBC, & endif if (present(uhbt)) then - call zonal_flux_adjust(u, h_in, h_L, h_R, uhbt(:,j), uh_tot_0, & + call zonal_flux_adjust(u, h_in, h_L, h_R, US%s_to_T*US%L_to_m**2*uhbt(:,j), uh_tot_0, & duhdu_tot_0, du, du_max_CFL, du_min_CFL, dt, G, & CS, visc_rem, j, ish, ieh, do_I, .true., uh, OBC=OBC) @@ -501,7 +501,14 @@ subroutine zonal_mass_flux(u, h_in, uh, dt, G, GV, US, CS, LB, uhbt, OBC, & endif ! set_BT_cont endif ! present(uhbt) or do_aux or set_BT_cont + + !### Work this into the code above. + do k=1,nz ; do I=ish-1,ieh + uh(I,j,k) = US%m_to_L**2*US%T_to_s*uh(I,j,k) + enddo ; enddo + enddo ! j-loop + if (local_open_BC .and. set_BT_cont) then do n = 1, OBC%number_of_segments if (OBC%segment(n)%open .and. OBC%segment(n)%is_E_or_W) then @@ -538,12 +545,6 @@ subroutine zonal_mass_flux(u, h_in, uh, dt, G, GV, US, CS, LB, uhbt, OBC, & endif endif ; endif - !### Work this into the code above. - do k=1,nz ; do j=jsh,jeh ; do I=ish-1,ieh - uh(I,j,k) = US%m_to_L**2*US%T_to_s*uh(I,j,k) - enddo ; enddo ; enddo - - end subroutine zonal_mass_flux !> Evaluates the zonal mass or volume fluxes in a layer. @@ -1080,7 +1081,7 @@ subroutine meridional_mass_flux(v, h_in, vh, dt, G, GV, US, CS, LB, vhbt, OBC, & !! that a layer experiences after viscosity is applied. Nondimensional between !! 0 (at the bottom) and 1 (far above the bottom). real, dimension(SZI_(G),SZJB_(G)), optional, intent(in) :: vhbt !< The summed volume flux through - !< meridional faces [H m2 s-1 ~> m3 s-1 or kg s-1]. + !< meridional faces [H L2 T-1 ~> m3 s-1 or kg s-1]. real, dimension(SZI_(G),SZJB_(G)), optional, intent(in) :: vhbt_aux !< A second set of summed volume fluxes !! through meridional faces [H m2 s-1 ~> m3 s-1 or kg s-1]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & @@ -1273,7 +1274,7 @@ subroutine meridional_mass_flux(v, h_in, vh, dt, G, GV, US, CS, LB, vhbt, OBC, & endif if (present(vhbt)) then - call meridional_flux_adjust(v, h_in, h_L, h_R, vhbt(:,J), vh_tot_0, & + call meridional_flux_adjust(v, h_in, h_L, h_R, US%s_to_T*US%L_to_m**2*vhbt(:,J), vh_tot_0, & dvhdv_tot_0, dv, dv_max_CFL, dv_min_CFL, dt, G, & CS, visc_rem, j, ish, ieh, do_I, .true., vh, OBC=OBC) @@ -1325,6 +1326,12 @@ subroutine meridional_mass_flux(v, h_in, vh, dt, G, GV, US, CS, LB, vhbt, OBC, & endif ! set_BT_cont endif ! present(vhbt) or do_aux or set_BT_cont + + !### Work this into the code above. + do k=1,nz ; do i=ish,ieh + vh(i,J,k) = US%m_to_L**2*US%T_to_s*vh(i,J,k) + enddo ; enddo + enddo ! j-loop if (local_open_BC .and. set_BT_cont) then @@ -1363,11 +1370,6 @@ subroutine meridional_mass_flux(v, h_in, vh, dt, G, GV, US, CS, LB, vhbt, OBC, & endif endif ; endif - !### Work this into the code above. - do k=1,nz ; do J=jsh-1,jeh ; do i=ish,ieh - vh(i,J,k) = US%m_to_L**2*US%T_to_s*vh(i,J,k) - enddo ; enddo ; enddo - end subroutine meridional_mass_flux !> Evaluates the meridional mass or volume fluxes in a layer. diff --git a/src/core/MOM_dynamics_split_RK2.F90 b/src/core/MOM_dynamics_split_RK2.F90 index 478a560f52..d2004d8d90 100644 --- a/src/core/MOM_dynamics_split_RK2.F90 +++ b/src/core/MOM_dynamics_split_RK2.F90 @@ -114,10 +114,10 @@ module MOM_dynamics_split_RK2 real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: eta_PF !< instantaneous SSH used in calculating PFu and !! PFv [H ~> m or kg m-2] real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_) :: uhbt !< average x-volume or mass flux determined by the - !! barotropic solver [H m2 s-1 ~> m3 s-1 or kg s-1]. + !! barotropic solver [H L2 T-1 ~> m3 s-1 or kg s-1]. !! uhbt is roughly equal to the vertical sum of uh. real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_) :: vhbt !< average y-volume or mass flux determined by the - !! barotropic solver [H m2 s-1 ~> m3 s-1 or kg s-1]. + !! barotropic solver [H L2 T-1 ~> m3 s-1 or kg s-1]. !! 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 @@ -518,9 +518,8 @@ 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, 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 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) if (BT_cont_BT_thick) then call btcalc(h, G, GV, CS%barotropic_CSp, CS%BT_cont%h_u, CS%BT_cont%h_v, & @@ -811,9 +810,8 @@ 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, US, & - CS%continuity_CSp, CS%uhbt, CS%vhbt, CS%OBC, & - CS%visc_rem_u, CS%visc_rem_v, u_av, v_av) + 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) call do_group_pass(CS%pass_h, G%Domain, clock=id_clock_pass) ! Whenever thickness changes let the diag manager know, target grids diff --git a/src/core/MOM_dynamics_unsplit.F90 b/src/core/MOM_dynamics_unsplit.F90 index 39841e8ab2..2ea32a5495 100644 --- a/src/core/MOM_dynamics_unsplit.F90 +++ b/src/core/MOM_dynamics_unsplit.F90 @@ -263,8 +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, US, CS%continuity_CSp, & - OBC=CS%OBC) + 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) call pass_vector(uh, vh, G%Domain, clock=id_clock_pass) @@ -355,8 +354,7 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & ! uh = up * hp ! 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, US, CS%continuity_CSp, OBC=CS%OBC) + call continuity(up, vp, hp, h_av, uh, vh, (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) @@ -419,8 +417,7 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & ! uh = upp * hp ! 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, US, CS%continuity_CSp, OBC=CS%OBC) + call continuity(upp, vpp, hp, h, uh, vh, (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 6a0ba7e3dd..85f1145ecb 100644 --- a/src/core/MOM_dynamics_unsplit_RK2.F90 +++ b/src/core/MOM_dynamics_unsplit_RK2.F90 @@ -279,8 +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, US, CS%continuity_CSp, & - OBC=CS%OBC) + 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) call pass_vector(uh, vh, G%Domain, clock=id_clock_pass) @@ -351,8 +350,7 @@ subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt, ! uh = up[n-1/2] * h[n-1/2] ! 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, US, CS%continuity_CSp, OBC=CS%OBC) + call continuity(up, vp, h_in, hp, uh, vh, 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) @@ -409,8 +407,7 @@ subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt, ! uh = up[n] * h[n] (up[n] might be extrapolated to damp GWs) ! 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, US, CS%continuity_CSp, OBC=CS%OBC) + call continuity(up, vp, h_in, h_in, uh, vh,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) From 15438e8c6419e8160e6dfdffe93dcfd0000889a2 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Wed, 31 Jul 2019 06:55:33 -0400 Subject: [PATCH 131/297] +Eliminated uhbt_aux args from continuity_PPM Eliminated the unused optional arguments uhbt_aux, vhbt_aux, v_cor_aux and u_cor_aux from continuity_PPM. All answers are bitwise identical, but there are public interface changes in the form of eliminated optional arguments. --- src/core/MOM_continuity.F90 | 24 -------- src/core/MOM_continuity_PPM.F90 | 104 ++++++-------------------------- 2 files changed, 20 insertions(+), 108 deletions(-) diff --git a/src/core/MOM_continuity.F90 b/src/core/MOM_continuity.F90 index a8c90d6668..2a0c844932 100644 --- a/src/core/MOM_continuity.F90 +++ b/src/core/MOM_continuity.F90 @@ -41,7 +41,6 @@ module MOM_continuity !! based on Lin (1994). 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, BT_cont) -! uhbt_aux, vhbt_aux, u_cor_aux, v_cor_aux, BT_cont) type(ocean_grid_type), intent(inout) :: G !< Ocean grid structure. type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & @@ -85,18 +84,6 @@ subroutine continuity(u, v, hin, h, uh, vh, dt, G, GV, US, CS, uhbt, vhbt, OBC, real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & optional, intent(out) :: v_cor !< The meridional velocities that !! give vhbt as the depth-integrated transport [m s-1]. -! real, dimension(SZIB_(G),SZJ_(G)), & -! optional, intent(in) :: uhbt_aux !< A second summed zonal -! !! volume flux [H m2 s-1 ~> m3 s-1 or kg s-1]. -! real, dimension(SZI_(G),SZJB_(G)), & -! optional, intent(in) :: vhbt_aux !< A second summed meridional -! !! volume flux [H m2 s-1 ~> m3 s-1 or kg s-1]. -! real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & -! optional, intent(inout) :: u_cor_aux !< The zonal velocities -! !! that give uhbt_aux as the depth-integrated transport [m s-1]. -! real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & -! optional, intent(inout) :: v_cor_aux !< The meridional velocities -! !! that give vhbt_aux as the depth-integrated transport [m s-1]. 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. @@ -107,21 +94,10 @@ subroutine continuity(u, v, hin, h, uh, vh, dt, G, GV, US, CS, uhbt, vhbt, OBC, if (present(u_cor) .neqv. present(v_cor)) call MOM_error(FATAL, & "MOM_continuity: Either both u_cor and v_cor or neither"// & " one must be present in call to continuity.") -! if (present(uhbt_aux) .neqv. present(vhbt_aux)) call MOM_error(FATAL, & -! "MOM_continuity: Either both uhbt_aux and uhbt_aux or neither"// & -! " one must be present in call to continuity.") -! if (present(u_cor_aux) .neqv. present(v_cor_aux)) call MOM_error(FATAL, & -! "MOM_continuity: Either both u_cor_aux and v_cor_aux or neither"// & -! " one must be present in call to continuity.") -! if (present(u_cor_aux) .neqv. present(uhbt_aux)) call MOM_error(FATAL, & -! "MOM_continuity: u_cor_aux can only be calculated if uhbt_aux is"// & -! " provided, and uhbt_aux has no other purpose. Include both arguments"//& -! " or neither.") if (CS%continuity_scheme == PPM_SCHEME) then 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, BT_cont=BT_cont) -! Eliminate 4 unused optional arguments: ( uhbt_aux, vhbt_aux, u_cor_aux, v_cor_aux, BT_cont) else call MOM_error(FATAL, "continuity: Unrecognized value of continuity_scheme") endif diff --git a/src/core/MOM_continuity_PPM.F90 b/src/core/MOM_continuity_PPM.F90 index b5c62dad62..d876b624a4 100644 --- a/src/core/MOM_continuity_PPM.F90 +++ b/src/core/MOM_continuity_PPM.F90 @@ -74,8 +74,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, 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) + visc_rem_u, visc_rem_v, u_cor, v_cor, BT_cont) type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. type(continuity_PPM_CS), pointer :: CS !< Module's control structure. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & @@ -121,22 +120,6 @@ subroutine continuity_PPM(u, v, hin, h, uh, vh, dt, G, GV, US, CS, uhbt, vhbt, O real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & optional, intent(out) :: v_cor !< The meridional velocities that give vhbt as the depth-integrated transport [m s-1]. - real, dimension(SZIB_(G),SZJ_(G)), & - optional, intent(in) :: uhbt_aux - !< A second set of summed volume fluxes through zonal faces - !! [H m2 s-1 ~> m3 s-1 or kg s-1]. - real, dimension(SZI_(G),SZJB_(G)), & - optional, intent(in) :: vhbt_aux - !< A second set of summed volume fluxes through meridional faces - !! [H m2 s-1 ~> m3 s-1 or kg s-1]. - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & - optional, intent(out) :: u_cor_aux - !< The zonal velocities that give uhbt_aux as the depth-integrated - !! transports [m s-1]. - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - optional, intent(out) :: v_cor_aux - !< The meridional velocities that give vhbt_aux as the depth-integrated - !! transports [m s-1]. 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. @@ -165,8 +148,7 @@ subroutine continuity_PPM(u, v, hin, h, uh, vh, dt, G, GV, US, CS, uhbt, vhbt, O ! 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, US, CS, LB, uhbt, OBC, visc_rem_u, & - u_cor, uhbt_aux, u_cor_aux, BT_cont) + call zonal_mass_flux(u, hin, uh, dt, G, GV, US, CS, LB, uhbt, OBC, visc_rem_u, u_cor, BT_cont) call cpu_clock_begin(id_clock_update) !$OMP parallel do default(shared) @@ -181,8 +163,7 @@ subroutine continuity_PPM(u, v, hin, h, uh, vh, dt, G, GV, US, CS, uhbt, vhbt, O ! Now advect meridionally, using the updated thicknesses to determine ! the fluxes. - 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 meridional_mass_flux(v, h, vh, dt, G, GV, US, CS, LB, vhbt, OBC, visc_rem_v, v_cor, BT_cont) call cpu_clock_begin(id_clock_update) !$OMP parallel do default(shared) @@ -198,8 +179,7 @@ subroutine continuity_PPM(u, v, hin, h, uh, vh, dt, G, GV, US, CS, uhbt, vhbt, O 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, US, CS, LB, vhbt, OBC, visc_rem_v, & - v_cor, vhbt_aux, v_cor_aux, BT_cont) + call meridional_mass_flux(v, hin, vh, dt, G, GV, US, CS, LB, vhbt, OBC, visc_rem_v, v_cor, BT_cont) call cpu_clock_begin(id_clock_update) !$OMP parallel do default(shared) @@ -211,8 +191,7 @@ subroutine continuity_PPM(u, v, hin, h, uh, vh, dt, G, GV, US, CS, uhbt, vhbt, O ! 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, US, CS, LB, uhbt, OBC, visc_rem_u, & - u_cor, uhbt_aux, u_cor_aux, BT_cont) + call zonal_mass_flux(u, h, uh, dt, G, GV, US, CS, LB, uhbt, OBC, visc_rem_u, u_cor, BT_cont) call cpu_clock_begin(id_clock_update) !$OMP parallel do default(shared) @@ -229,7 +208,7 @@ 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, US, CS, LB, uhbt, OBC, & - visc_rem_u, u_cor, uhbt_aux, u_cor_aux, BT_cont) + visc_rem_u, u_cor, BT_cont) type(ocean_grid_type), intent(inout) :: G !< Ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< Ocean's vertical grid structure. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & @@ -254,17 +233,10 @@ subroutine zonal_mass_flux(u, h_in, uh, dt, G, GV, US, CS, LB, uhbt, OBC, & real, dimension(SZIB_(G),SZJ_(G)), & optional, intent(in) :: uhbt !< The summed volume flux through zonal faces !! [H L2 T-1 ~> m3 s-1 or kg s-1]. - real, dimension(SZIB_(G),SZJ_(G)), & - optional, intent(in) :: uhbt_aux - !< A second set of summed volume fluxes through zonal faces [H m2 s-1 ~> m3 s-1 or kg s-1]. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & optional, intent(out) :: u_cor !< The zonal velocitiess (u with a barotropic correction) !! that give uhbt as the depth-integrated transport, m s-1. - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & - optional, intent(out) :: u_cor_aux - !< The zonal velocities (u with a barotropic correction) - !! that give uhbt_aux as the depth-integrated transports [m s-1]. 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. @@ -290,11 +262,10 @@ subroutine zonal_mass_flux(u, h_in, uh, dt, G, GV, US, CS, LB, uhbt, OBC, & real :: du_lim ! The velocity change that give a relative CFL of 1 [m s-1]. real :: dx_E, dx_W ! Effective x-grid spacings to the east and west [m]. integer :: i, j, k, ish, ieh, jsh, jeh, n, nz - logical :: do_aux, local_specified_BC, use_visc_rem, set_BT_cont, any_simple_OBC + logical :: local_specified_BC, use_visc_rem, set_BT_cont, any_simple_OBC logical :: local_Flather_OBC, local_open_BC, is_simple type(OBC_segment_type), pointer :: segment => NULL() - do_aux = (present(uhbt_aux) .and. present(u_cor_aux)) use_visc_rem = present(visc_rem_u) local_specified_BC = .false. ; set_BT_cont = .false. ; local_Flather_OBC = .false. local_open_BC = .false. @@ -328,8 +299,8 @@ subroutine zonal_mass_flux(u, h_in, uh, dt, G, GV, US, CS, LB, uhbt, OBC, & call cpu_clock_begin(id_clock_correct) !$OMP parallel do default(none) shared(ish,ieh,jsh,jeh,nz,u,h_in,h_L,h_R,use_visc_rem,visc_rem_u, & -!$OMP uh,dt,G,GV,CS,local_specified_BC,OBC,uhbt,do_aux,set_BT_cont, & -!$OMP CFL_dt,I_dt,u_cor,uhbt_aux,u_cor_aux,BT_cont, local_Flather_OBC) & +!$OMP uh,dt,G,GV,CS,local_specified_BC,OBC,uhbt,set_BT_cont, & +!$OMP CFL_dt,I_dt,u_cor,BT_cont, local_Flather_OBC) & !$OMP private(do_I,duhdu,du,du_max_CFL,du_min_CFL,uh_tot_0,duhdu_tot_0, & !$OMP is_simple,FAuI,visc_rem_max,I_vrm,du_lim,dx_E,dx_W,any_simple_OBC ) & !$OMP firstprivate(visc_rem) @@ -357,7 +328,7 @@ subroutine zonal_mass_flux(u, h_in, uh, dt, G, GV, US, CS, LB, uhbt, OBC, & visc_rem_max(I) = 1.0 enddo ; endif - if (present(uhbt) .or. do_aux .or. set_BT_cont) then + if (present(uhbt) .or. set_BT_cont) then ! Set limits on du that will keep the CFL number between -1 and 1. ! This should be adequate to keep the root bracketed in all cases. do I=ish-1,ieh @@ -437,7 +408,7 @@ subroutine zonal_mass_flux(u, h_in, uh, dt, G, GV, US, CS, LB, uhbt, OBC, & ! Up to this point, everything is shared between uhbt and uhbt_aux. any_simple_OBC = .false. - if (present(uhbt) .or. do_aux .or. set_BT_cont) then + if (present(uhbt) .or. set_BT_cont) then if (local_specified_BC .or. local_Flather_OBC) then ; do I=ish-1,ieh ! Avoid reconciling barotropic/baroclinic transports if transport is specified is_simple = OBC%segment(OBC%segnum_u(I,j))%specified @@ -463,20 +434,6 @@ subroutine zonal_mass_flux(u, h_in, uh, dt, G, GV, US, CS, LB, uhbt, OBC, & endif - if (do_aux) then - call zonal_flux_adjust(u, h_in, h_L, h_R, uhbt_aux(:,j), uh_tot_0, & - duhdu_tot_0, du, du_max_CFL, du_min_CFL, dt, G, & - CS, visc_rem, j, ish, ieh, do_I, .false., OBC=OBC) - - do k=1,nz - do I=ish-1,ieh ; u_cor_aux(I,j,k) = u(I,j,k) + du(I) * visc_rem(I,k) ; enddo - if (local_specified_BC) then ; do I=ish-1,ieh - if (OBC%segment(OBC%segnum_u(I,j))%specified) & - u_cor_aux(I,j,k) = OBC%segment(OBC%segnum_u(I,j))%normal_vel(I,j,k) - enddo ; endif - enddo - endif ! do_aux - 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, US, CS, visc_rem, & @@ -500,7 +457,7 @@ subroutine zonal_mass_flux(u, h_in, uh, dt, G, GV, US, CS, LB, uhbt, OBC, & endif endif ! set_BT_cont - endif ! present(uhbt) or do_aux or set_BT_cont + endif ! present(uhbt) or set_BT_cont !### Work this into the code above. do k=1,nz ; do I=ish-1,ieh @@ -1060,7 +1017,7 @@ 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, US, CS, LB, vhbt, OBC, & - visc_rem_v, v_cor, vhbt_aux, v_cor_aux, BT_cont) + visc_rem_v, v_cor, BT_cont) type(ocean_grid_type), intent(inout) :: G !< Ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< Ocean's vertical grid structure. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: v !< Meridional velocity [m s-1]. @@ -1082,16 +1039,10 @@ subroutine meridional_mass_flux(v, h_in, vh, dt, G, GV, US, CS, LB, vhbt, OBC, & !! 0 (at the bottom) and 1 (far above the bottom). real, dimension(SZI_(G),SZJB_(G)), optional, intent(in) :: vhbt !< The summed volume flux through !< meridional faces [H L2 T-1 ~> m3 s-1 or kg s-1]. - real, dimension(SZI_(G),SZJB_(G)), optional, intent(in) :: vhbt_aux !< A second set of summed volume fluxes - !! through meridional faces [H m2 s-1 ~> m3 s-1 or kg s-1]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & optional, intent(out) :: v_cor !< The meridional velocitiess (v with a barotropic correction) !! that give vhbt as the depth-integrated transport [m s-1]. - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - optional, intent(out) :: v_cor_aux - !< The meridional velocities (v with a barotropic correction) - !! that give vhbt_aux as the depth-integrated transports [m s-1]. 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. ! Local variables @@ -1118,11 +1069,10 @@ subroutine meridional_mass_flux(v, h_in, vh, dt, G, GV, US, CS, LB, vhbt, OBC, & real :: dv_lim ! The velocity change that give a relative CFL of 1 [m s-1]. real :: dy_N, dy_S ! Effective y-grid spacings to the north and south [m]. integer :: i, j, k, ish, ieh, jsh, jeh, n, nz - logical :: do_aux, local_specified_BC, use_visc_rem, set_BT_cont, any_simple_OBC + logical :: local_specified_BC, use_visc_rem, set_BT_cont, any_simple_OBC logical :: local_Flather_OBC, is_simple, local_open_BC type(OBC_segment_type), pointer :: segment => NULL() - do_aux = (present(vhbt_aux) .and. present(v_cor_aux)) use_visc_rem = present(visc_rem_v) local_specified_BC = .false. ; set_BT_cont = .false. ; local_Flather_OBC = .false. local_open_BC = .false. @@ -1156,9 +1106,8 @@ subroutine meridional_mass_flux(v, h_in, vh, dt, G, GV, US, CS, LB, vhbt, OBC, & call cpu_clock_begin(id_clock_correct) !$OMP parallel do default(none) shared(ish,ieh,jsh,jeh,nz,v,h_in,h_L,h_R,vh,use_visc_rem, & -!$OMP visc_rem_v,dt,G,GV,CS,local_specified_BC,OBC,vhbt,do_aux, & -!$OMP set_BT_cont,CFL_dt,I_dt,v_cor,vhbt_aux, & -!$OMP v_cor_aux,BT_cont, local_Flather_OBC ) & +!$OMP visc_rem_v,dt,G,GV,CS,local_specified_BC,OBC,vhbt, & +!$OMP set_BT_cont,CFL_dt,I_dt,v_cor,BT_cont, local_Flather_OBC ) & !$OMP private(do_I,dvhdv,dv,dv_max_CFL,dv_min_CFL,vh_tot_0, & !$OMP dvhdv_tot_0,visc_rem_max,I_vrm,dv_lim,dy_N, & !$OMP is_simple,FAvi,dy_S,any_simple_OBC ) & @@ -1185,7 +1134,7 @@ subroutine meridional_mass_flux(v, h_in, vh, dt, G, GV, US, CS, LB, vhbt, OBC, & visc_rem_max(i) = 1.0 enddo ; endif - if (present(vhbt) .or. do_aux .or. set_BT_cont) then + if (present(vhbt) .or. set_BT_cont) then ! Set limits on dv that will keep the CFL number between -1 and 1. ! This should be adequate to keep the root bracketed in all cases. do i=ish,ieh @@ -1262,7 +1211,7 @@ subroutine meridional_mass_flux(v, h_in, vh, dt, G, GV, US, CS, LB, vhbt, OBC, & ! Up to this point, everything is shared between vhbt and vhbt_aux. any_simple_OBC = .false. - if (present(vhbt) .or. do_aux .or. set_BT_cont) then + if (present(vhbt) .or. set_BT_cont) then if (local_specified_BC .or. local_Flather_OBC) then ; do i=ish,ieh ! Avoid reconciling barotropic/baroclinic transports if transport is specified is_simple = OBC%segment(OBC%segnum_v(i,J))%specified @@ -1287,20 +1236,6 @@ subroutine meridional_mass_flux(v, h_in, vh, dt, G, GV, US, CS, LB, vhbt, OBC, & enddo ; endif ! v-corrected endif - if (do_aux) then - call meridional_flux_adjust(v, h_in, h_L, h_R, vhbt_aux(:,J), vh_tot_0, & - dvhdv_tot_0, dv, dv_max_CFL, dv_min_CFL, dt, G, & - CS, visc_rem, j, ish, ieh, do_I, .false., OBC=OBC) - - do k=1,nz - do i=ish,ieh ; v_cor_aux(i,J,k) = v(i,J,k) + dv(i) * visc_rem(i,k) ; enddo - if (local_specified_BC) then ; do i=ish,ieh - if (OBC%segment(OBC%segnum_v(i,J))%specified) & - v_cor_aux(i,J,k) = OBC%segment(OBC%segnum_v(i,J))%normal_vel(i,J,k) - enddo ; endif - enddo - endif ! do_aux - 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, US, CS, visc_rem, & @@ -1325,7 +1260,7 @@ subroutine meridional_mass_flux(v, h_in, vh, dt, G, GV, US, CS, LB, vhbt, OBC, & endif endif ! set_BT_cont - endif ! present(vhbt) or do_aux or set_BT_cont + endif ! present(vhbt) or set_BT_cont !### Work this into the code above. do k=1,nz ; do i=ish,ieh @@ -2303,6 +2238,7 @@ subroutine continuity_PPM_init(Time, G, GV, param_file, diag, CS) "than about 10^-15*MAXIMUM_DEPTH.", units="m", scale=GV%m_to_H, & default=0.5*G%ke*GV%Angstrom_m, unscaled=tol_eta_m) + !### ETA_TOLERANCE_AUX can be obsoleted. call get_param(param_file, mdl, "ETA_TOLERANCE_AUX", CS%tol_eta_aux, & "The tolerance for free-surface height discrepancies "//& "between the barotropic solution and the sum of the "//& From 89c9522531d47fbec26a5dca654298719919b99e Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Wed, 31 Jul 2019 11:22:44 -0400 Subject: [PATCH 132/297] Dimensional rescaling inside continuity_PPM.F90 Applied dimensional rescaling to numerous internal variables and minor code restructuring in MOM_continuity_PPM.F90. All answers are bitwise identical. --- src/core/MOM_continuity_PPM.F90 | 273 +++++++++++++++----------------- 1 file changed, 128 insertions(+), 145 deletions(-) diff --git a/src/core/MOM_continuity_PPM.F90 b/src/core/MOM_continuity_PPM.F90 index d876b624a4..1a2733bbea 100644 --- a/src/core/MOM_continuity_PPM.F90 +++ b/src/core/MOM_continuity_PPM.F90 @@ -153,7 +153,7 @@ subroutine continuity_PPM(u, v, hin, h, uh, vh, dt, G, GV, US, CS, uhbt, vhbt, O call cpu_clock_begin(id_clock_update) !$OMP parallel do default(shared) do k=1,nz ; do j=LB%jsh,LB%jeh ; do i=LB%ish,LB%ieh - h(i,j,k) = hin(i,j,k) - US%s_to_T*dt* US%L_to_m**2*G%IareaT(i,j) * (uh(I,j,k) - uh(I-1,j,k)) + h(i,j,k) = hin(i,j,k) - US%s_to_T*dt * US%L_to_m**2*G%IareaT(i,j) * (uh(I,j,k) - uh(I-1,j,k)) ! Uncomment this line to prevent underflow. ! if (h(i,j,k) < h_min) h(i,j,k) = h_min enddo ; enddo ; enddo @@ -196,7 +196,7 @@ subroutine continuity_PPM(u, v, hin, h, uh, vh, dt, G, GV, US, CS, uhbt, vhbt, O call cpu_clock_begin(id_clock_update) !$OMP parallel do default(shared) do k=1,nz ; do j=LB%jsh,LB%jeh ; do i=LB%ish,LB%ieh - h(i,j,k) = h(i,j,k) - US%s_to_T*dt* US%L_to_m**2*G%IareaT(i,j) * (uh(I,j,k) - uh(I-1,j,k)) + h(i,j,k) = h(i,j,k) - US%s_to_T*dt * US%L_to_m**2*G%IareaT(i,j) * (uh(I,j,k) - uh(I-1,j,k)) ! This line prevents underflow. if (h(i,j,k) < h_min) h(i,j,k) = h_min enddo ; enddo ; enddo @@ -241,19 +241,19 @@ subroutine zonal_mass_flux(u, h_in, uh, dt, G, GV, US, CS, LB, uhbt, OBC, & !! effective open face areas as a function of barotropic flow. ! Local variables - real, dimension(SZIB_(G),SZK_(G)) :: duhdu ! Partial derivative of uh with u [H m ~> m2 or kg m-1]. + real, dimension(SZIB_(G),SZK_(G)) :: duhdu ! Partial derivative of uh with u [H L2 s T-1 m-1 ~> m2 or kg m-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: h_L, h_R ! Left and right face thicknesses [H ~> m or kg m-2]. real, dimension(SZIB_(G)) :: & du, & ! Corrective barotropic change in the velocity [m s-1]. du_min_CFL, & ! Min/max limits on du correction du_max_CFL, & ! to avoid CFL violations - duhdu_tot_0, & ! Summed partial derivative of uh with u [H m ~> m2 or kg m-1]. - uh_tot_0, & ! Summed transport with no barotropic correction [H m2 s-1 ~> m3 s-1 or kg s-1]. + duhdu_tot_0, & ! Summed partial derivative of uh with u [H L2 s T-1 m-1 ~> m2 or kg m-1]. + uh_tot_0, & ! Summed transport with no barotropic correction [H L2 T-1 ~> m3 s-1 or kg s-1]. visc_rem_max ! The column maximum of visc_rem. logical, dimension(SZIB_(G)) :: do_I real, dimension(SZIB_(G),SZK_(G)) :: & visc_rem ! A 2-D copy of visc_rem_u or an array of 1's. - real, dimension(SZIB_(G)) :: FAuI ! A list of sums of zonal face areas [H m ~> m2 or kg m-1]. + real, dimension(SZIB_(G)) :: FAuI ! A list of sums of zonal face areas [H L ~> m2 or kg m-1]. real :: FA_u ! A sum of zonal face areas [H m ~> m2 or kg m-1]. real :: I_vrm ! 1.0 / visc_rem_max, nondim. real :: CFL_dt ! The maximum CFL ratio of the adjusted velocities divided by @@ -314,12 +314,11 @@ subroutine zonal_mass_flux(u, h_in, uh, dt, G, GV, US, CS, LB, uhbt, OBC, & enddo ; endif call zonal_flux_layer(u(:,j,k), h_in(:,j,k), h_L(:,j,k), h_R(:,j,k), & uh(:,j,k), duhdu(:,k), visc_rem(:,k), & - dt, G, j, ish, ieh, do_I, CS%vol_CFL, OBC) + dt, G, US, j, ish, ieh, do_I, CS%vol_CFL, OBC) if (local_specified_BC) then do I=ish-1,ieh if (OBC%segment(OBC%segnum_u(I,j))%specified) & - uh(I,j,k) = OBC%segment(OBC%segnum_u(I,j))%normal_trans(I,j,k) - ! uh(I,j,k) = US%m_to_L**2*US%T_to_s*OBC%segment(OBC%segnum_u(I,j))%normal_trans(I,j,k) + uh(I,j,k) = US%m_to_L**2*US%T_to_s*OBC%segment(OBC%segnum_u(I,j))%normal_trans(I,j,k) enddo endif enddo @@ -405,8 +404,6 @@ subroutine zonal_mass_flux(u, h_in, uh, dt, G, GV, US, CS, LB, uhbt, OBC, & du_min_CFL(I) = min(du_min_CFL(I),0.0) enddo - ! Up to this point, everything is shared between uhbt and uhbt_aux. - any_simple_OBC = .false. if (present(uhbt) .or. set_BT_cont) then if (local_specified_BC .or. local_Flather_OBC) then ; do I=ish-1,ieh @@ -420,9 +417,9 @@ subroutine zonal_mass_flux(u, h_in, uh, dt, G, GV, US, CS, LB, uhbt, OBC, & endif if (present(uhbt)) then - call zonal_flux_adjust(u, h_in, h_L, h_R, US%s_to_T*US%L_to_m**2*uhbt(:,j), uh_tot_0, & - duhdu_tot_0, du, du_max_CFL, du_min_CFL, dt, G, & - CS, visc_rem, j, ish, ieh, do_I, .true., uh, OBC=OBC) + call zonal_flux_adjust(u, h_in, h_L, h_R, uhbt(:,j), uh_tot_0, duhdu_tot_0, du, & + du_max_CFL, du_min_CFL, dt, G, US, CS, visc_rem, & + j, ish, ieh, do_I, .true., uh, OBC=OBC) if (present(u_cor)) then ; do k=1,nz do I=ish-1,ieh ; u_cor(I,j,k) = u(I,j,k) + du(I) * visc_rem(I,k) ; enddo @@ -441,17 +438,17 @@ subroutine zonal_mass_flux(u, h_in, uh, dt, G, GV, US, CS, LB, uhbt, OBC, & if (any_simple_OBC) then do I=ish-1,ieh do_I(I) = OBC%segment(OBC%segnum_u(I,j))%specified - if (do_I(I)) FAuI(I) = GV%H_subroundoff*G%dy_Cu(I,j) + if (do_I(I)) FAuI(I) = GV%H_subroundoff*US%m_to_L*G%dy_Cu(I,j) enddo do k=1,nz ; do I=ish-1,ieh ; if (do_I(I)) then if ((abs(OBC%segment(OBC%segnum_u(I,j))%normal_vel(I,j,k)) > 0.0) .and. & (OBC%segment(OBC%segnum_u(I,j))%specified)) & - FAuI(I) = FAuI(I) + OBC%segment(OBC%segnum_u(I,j))%normal_trans(I,j,k) / & - OBC%segment(OBC%segnum_u(I,j))%normal_vel(I,j,k) + FAuI(I) = FAuI(I) + US%m_to_L*OBC%segment(OBC%segnum_u(I,j))%normal_trans(I,j,k) / & + 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) = 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%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%uBT_WW(I,j) = 0.0 ; BT_cont%uBT_EE(I,j) = 0.0 endif ; enddo endif @@ -459,11 +456,6 @@ subroutine zonal_mass_flux(u, h_in, uh, dt, G, GV, US, CS, LB, uhbt, OBC, & endif ! present(uhbt) or set_BT_cont - !### Work this into the code above. - do k=1,nz ; do I=ish-1,ieh - uh(I,j,k) = US%m_to_L**2*US%T_to_s*uh(I,j,k) - enddo ; enddo - enddo ! j-loop if (local_open_BC .and. set_BT_cont) then @@ -505,7 +497,7 @@ subroutine zonal_mass_flux(u, h_in, uh, dt, G, GV, US, CS, LB, uhbt, OBC, & end subroutine zonal_mass_flux !> Evaluates the zonal mass or volume fluxes in a layer. -subroutine zonal_flux_layer(u, h, h_L, h_R, uh, duhdu, visc_rem, dt, G, j, & +subroutine zonal_flux_layer(u, h, h_L, h_R, uh, duhdu, visc_rem, dt, G, US, j, & ish, ieh, do_I, vol_CFL, OBC) type(ocean_grid_type), intent(inout) :: G !< Ocean's grid structure. real, dimension(SZIB_(G)), intent(in) :: u !< Zonal velocity [m s-1]. @@ -518,10 +510,11 @@ subroutine zonal_flux_layer(u, h, h_L, h_R, uh, duhdu, visc_rem, dt, G, j, & real, dimension(SZI_(G)), intent(in) :: h_L !< Left thickness [H ~> m or kg m-2]. real, dimension(SZI_(G)), intent(in) :: h_R !< Right thickness [H ~> m or kg m-2]. real, dimension(SZIB_(G)), intent(inout) :: uh !< Zonal mass or volume - !! transport [H m2 s-1 ~> m3 s-1 or kg s-1]. + !! transport [H L2 T-1 ~> m3 s-1 or kg s-1]. real, dimension(SZIB_(G)), intent(inout) :: duhdu !< Partial derivative of uh - !! with u [H m ~> m2 or kg m-1]. + !! with u [H L2 s T-1 m-1 ~> m2 or kg m-1]. real, intent(in) :: dt !< Time increment [s]. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type integer, intent(in) :: j !< Spatial index. integer, intent(in) :: ish !< Start of index range. integer, intent(in) :: ieh !< End of index range. @@ -548,32 +541,32 @@ subroutine zonal_flux_layer(u, h, h_L, h_R, uh, duhdu, visc_rem, dt, G, j, & if (vol_CFL) then ; CFL = (u(I) * dt) * (G%dy_Cu(I,j) * G%IareaT(i,j)) else ; CFL = u(I) * dt * G%IdxT(i,j) ; endif curv_3 = h_L(i) + h_R(i) - 2.0*h(i) - uh(I) = G%dy_Cu(I,j) * u(I) * & + uh(I) = US%m_to_L*G%dy_Cu(I,j) * US%m_s_to_L_T*u(I) * & (h_R(i) + CFL * (0.5*(h_L(i) - h_R(i)) + curv_3*(CFL - 1.5))) h_marg = h_R(i) + CFL * ((h_L(i) - h_R(i)) + 3.0*curv_3*(CFL - 1.0)) elseif (u(I) < 0.0) then if (vol_CFL) then ; CFL = (-u(I) * dt) * (G%dy_Cu(I,j) * G%IareaT(i+1,j)) else ; CFL = -u(I) * dt * G%IdxT(i+1,j) ; endif curv_3 = h_L(i+1) + h_R(i+1) - 2.0*h(i+1) - uh(I) = G%dy_Cu(I,j) * u(I) * & + uh(I) = US%m_to_L*G%dy_Cu(I,j) * US%m_s_to_L_T*u(I) * & (h_L(i+1) + CFL * (0.5*(h_R(i+1)-h_L(i+1)) + curv_3*(CFL - 1.5))) h_marg = h_L(i+1) + CFL * ((h_R(i+1)-h_L(i+1)) + 3.0*curv_3*(CFL - 1.0)) else uh(I) = 0.0 h_marg = 0.5 * (h_L(i+1) + h_R(i)) endif - duhdu(I) = G%dy_Cu(I,j) * h_marg * visc_rem(I) + duhdu(I) = US%m_s_to_L_T * US%m_to_L*G%dy_Cu(I,j) * h_marg * visc_rem(I) endif ; enddo if (local_open_BC) then do I=ish-1,ieh ; if (do_I(I)) then if (OBC%segment(OBC%segnum_u(I,j))%open) then if (OBC%segment(OBC%segnum_u(I,j))%direction == OBC_DIRECTION_E) then - uh(I) = G%dy_Cu(I,j) * u(I) * h(i) - duhdu(I) = G%dy_Cu(I,j) * h(i) * visc_rem(I) + uh(I) = US%m_to_L*G%dy_Cu(I,j) * US%m_s_to_L_T*u(I) * h(i) + duhdu(I) = US%m_s_to_L_T * US%m_to_L*G%dy_Cu(I,j) * h(i) * visc_rem(I) else - uh(I) = G%dy_Cu(I,j) * u(I) * h(i+1) - duhdu(I) = G%dy_Cu(I,j) * h(i+1) * visc_rem(I) + uh(I) = US%m_to_L*G%dy_Cu(I,j) * US%m_s_to_L_T*u(I) * h(i+1) + duhdu(I) = US%m_s_to_L_T * US%m_to_L*G%dy_Cu(I,j) * h(i+1) * visc_rem(I) endif endif endif ; enddo @@ -688,7 +681,7 @@ end subroutine zonal_face_thickness !> Returns the barotropic velocity adjustment that gives the !! desired barotropic (layer-summed) transport. subroutine zonal_flux_adjust(u, h_in, h_L, h_R, uhbt, uh_tot_0, duhdu_tot_0, & - du, du_max_CFL, du_min_CFL, dt, G, CS, visc_rem, & + du, du_max_CFL, du_min_CFL, dt, G, US, CS, visc_rem, & j, ish, ieh, do_I_in, full_precision, uh_3d, OBC) 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]. @@ -704,19 +697,20 @@ subroutine zonal_flux_adjust(u, h_in, h_L, h_R, uhbt, uh_tot_0, duhdu_tot_0, & !! experiences after viscosity is applied. !! Non-dimensional between 0 (at the bottom) and 1 (far above the bottom). real, dimension(SZIB_(G)), optional, intent(in) :: uhbt !< The summed volume flux - !! through zonal faces [H m2 s-1 ~> m3 s-1 or kg s-1]. + !! through zonal faces [H L2 T-1 ~> m3 s-1 or kg s-1]. real, dimension(SZIB_(G)), intent(in) :: du_max_CFL !< Maximum acceptable !! value of du [m s-1]. real, dimension(SZIB_(G)), intent(in) :: du_min_CFL !< Minimum acceptable !! value of du [m s-1]. real, dimension(SZIB_(G)), intent(in) :: uh_tot_0 !< The summed transport - !! with 0 adjustment [H m2 s-1 ~> m3 s-1 or kg s-1]. + !! with 0 adjustment [H L2 T-1 ~> m3 s-1 or kg s-1]. real, dimension(SZIB_(G)), intent(in) :: duhdu_tot_0 !< The partial derivative - !! of du_err with du at 0 adjustment [H m ~> m2 or kg m-1]. + !! of du_err with du at 0 adjustment [H L2 s T-1 m-1 ~> m2 or kg m-1]. real, dimension(SZIB_(G)), intent(out) :: du !< !! The barotropic velocity adjustment [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. integer, intent(in) :: j !< Spatial index. integer, intent(in) :: ish !< Start of index range. @@ -727,17 +721,17 @@ subroutine zonal_flux_adjust(u, h_in, h_L, h_R, uhbt, uh_tot_0, duhdu_tot_0, & !! A flag indicating how carefully to iterate. The !! default is .true. (more accurate). real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), optional, intent(inout) :: uh_3d !< - !! Volume flux through zonal faces = u*h*dy [H m2 s-1 ~> m3 s-1 or kg s-1]. + !! Volume flux through zonal faces = u*h*dy [H L2 T-1 ~> m3 s-1 or kg s-1]. type(ocean_OBC_type), optional, pointer :: OBC !< Open boundaries control structure. ! Local variables real, dimension(SZIB_(G),SZK_(G)) :: & - uh_aux, & ! An auxiliary zonal volume flux [H m s-1 ~> m2 s-1 or kg m-1 s-1]. - duhdu ! Partial derivative of uh with u [H m ~> m2 or kg m-1]. + uh_aux, & ! An auxiliary zonal volume flux [H L2 s-1 ~> m3 s-1 or kg s-1]. + duhdu ! Partial derivative of uh with u [H L2 s T-1 m-1 ~> m2 or kg m-1]. real, dimension(SZIB_(G)) :: & - uh_err, & ! Difference between uhbt and the summed uh [H m2 s-1 ~> m3 s-1 or kg s-1]. - uh_err_best, & ! The smallest value of uh_err found so far [H m2 s-1 ~> m3 s-1 or kg s-1]. + uh_err, & ! Difference between uhbt and the summed uh [H L2 T-1 ~> m3 s-1 or kg s-1]. + uh_err_best, & ! The smallest value of uh_err found so far [H L2 T-1 ~> m3 s-1 or kg s-1]. u_new, & ! The velocity with the correction added [m s-1]. - duhdu_tot,&! Summed partial derivative of uh with u [H m ~> m2 or kg m-1]. + duhdu_tot,&! Summed partial derivative of uh with u [H L2 s T-1 m-1 ~> m2 or kg m-1]. du_min, & ! Min/max limits on du correction based on CFL limits du_max ! and previous iterations [m s-1]. real :: du_prev ! The previous value of du [m s-1]. @@ -783,8 +777,8 @@ subroutine zonal_flux_adjust(u, h_in, h_L, h_R, uhbt, uh_tot_0, duhdu_tot_0, & enddo domore = .false. do I=ish-1,ieh ; if (do_I(I)) then - if ((dt*min(G%IareaT(i,j),G%IareaT(i+1,j))*abs(uh_err(I)) > tol_eta) .or.& - (CS%better_iter .and. ((abs(uh_err(I)) > tol_vel * duhdu_tot(I)) .or.& + if ((US%s_to_T*dt * min(US%L_to_m**2*G%IareaT(i,j),US%L_to_m**2*G%IareaT(i+1,j))*abs(uh_err(I)) > tol_eta) .or. & + (CS%better_iter .and. ((abs(uh_err(I)) > tol_vel * duhdu_tot(I)) .or. & (abs(uh_err(I)) > uh_err_best(I))) )) then ! Use Newton's method, provided it stays bounded. Otherwise bisect ! the value with the appropriate bound. @@ -822,7 +816,7 @@ subroutine zonal_flux_adjust(u, h_in, h_L, h_R, uhbt, uh_tot_0, duhdu_tot_0, & do I=ish-1,ieh ; u_new(I) = u(I,j,k) + du(I) * visc_rem(I,k) ; enddo call zonal_flux_layer(u_new, h_in(:,j,k), h_L(:,j,k), h_R(:,j,k), & uh_aux(:,k), duhdu(:,k), visc_rem(:,k), & - dt, G, j, ish, ieh, do_I, CS%vol_CFL, OBC) + dt, G, US, j, ish, ieh, do_I, CS%vol_CFL, OBC) enddo ; endif if (itt < max_itts) then @@ -864,9 +858,9 @@ subroutine set_zonal_BT_cont(u, h_in, h_L, h_R, BT_cont, uh_tot_0, duhdu_tot_0, type(BT_cont_type), intent(inout) :: BT_cont !< A structure with elements !! that describe the effective open face areas as a function of barotropic flow. real, dimension(SZIB_(G)), intent(in) :: uh_tot_0 !< The summed transport - !! with 0 adjustment [H m2 s-1 ~> m3 s-1 or kg s-1]. + !! with 0 adjustment [H L2 T-1 ~> m3 s-1 or kg s-1]. real, dimension(SZIB_(G)), intent(in) :: duhdu_tot_0 !< The partial derivative - !! of du_err with du at 0 adjustment [H m ~> m2 or kg m-1]. + !! of du_err with du at 0 adjustment [H L2 s T-1 m-1 ~> m2 or kg m-1]. real, dimension(SZIB_(G)), intent(in) :: du_max_CFL !< Maximum acceptable !! value of du [m s-1]. real, dimension(SZIB_(G)), intent(in) :: du_min_CFL !< Minimum acceptable @@ -894,17 +888,17 @@ subroutine set_zonal_BT_cont(u, h_in, h_L, h_R, BT_cont, uh_tot_0, duhdu_tot_0, du_CFL, & ! The velocity increment that corresponds to CFL_min [m s-1]. u_L, u_R, & ! The westerly (u_L), easterly (u_R), and zero-barotropic u_0, & ! transport (u_0) layer test velocities [m s-1]. - FA_marg_L, & ! The effective layer marginal face areas with the westerly - FA_marg_R, & ! (_L), easterly (_R), and zero-barotropic (_0) test - FA_marg_0, & ! velocities [H m ~> m2 or kg m-1]. + duhdu_L, & ! The effective layer marginal face areas with the westerly + duhdu_R, & ! (_L), easterly (_R), and zero-barotropic (_0) test + duhdu_0, & ! velocities [H L2 s T-1 m-1 ~> m2 or kg m-1]. uh_L, uh_R, & ! The layer transports with the westerly (_L), easterly (_R), - uh_0, & ! and zero-barotropic (_0) test velocities [H m2 s-1 ~> m3 s-1 or kg s-1]. + uh_0, & ! and zero-barotropic (_0) test velocities [H L2 T-1 ~> m3 s-1 or kg s-1]. FAmt_L, FAmt_R, & ! The summed effective marginal face areas for the 3 - FAmt_0, & ! test velocities [H m ~> m2 or kg m-1]. + FAmt_0, & ! test velocities [H L ~> m2 or kg m-1]. uhtot_L, & ! The summed transport with the westerly (uhtot_L) and - uhtot_R ! and easterly (uhtot_R) test velocities [H m2 s-1 ~> m3 s-1 or kg s-1]. - real :: FA_0 ! The effective face area with 0 barotropic transport [m H ~> m2 or kg m]. - real :: FA_avg ! The average effective face area [m H ~> m2 or kg m], nominally given by + uhtot_R ! and easterly (uhtot_R) test velocities [H L2 T-1 ~> m3 s-1 or kg s-1]. + real :: FA_0 ! The effective face area with 0 barotropic transport [L H ~> m2 or kg m]. + real :: FA_avg ! The average effective face area [L H ~> m2 or kg m], nominally given by ! the realized transport divided by the barotropic velocity. real :: visc_rem_lim ! The larger of visc_rem and min_visc_rem [nondim] This ! limiting is necessary to keep the inverse of visc_rem @@ -924,9 +918,9 @@ subroutine set_zonal_BT_cont(u, h_in, h_L, h_R, BT_cont, uh_tot_0, duhdu_tot_0, ! Diagnose the zero-transport correction, du0. do I=ish-1,ieh ; zeros(I) = 0.0 ; enddo - call zonal_flux_adjust(u, h_in, h_L, h_R, zeros, uh_tot_0, & - duhdu_tot_0, du0, du_max_CFL, du_min_CFL, dt, G, & - CS, visc_rem, j, ish, ieh, do_I, .true.) + call zonal_flux_adjust(u, h_in, h_L, h_R, zeros, uh_tot_0, duhdu_tot_0, du0, & + du_max_CFL, du_min_CFL, dt, G, US, CS, visc_rem, & + j, ish, ieh, do_I, .true.) ! Determine the westerly- and easterly- fluxes. Choose a sufficiently ! negative velocity correction for the easterly-flux, and a sufficiently @@ -966,19 +960,16 @@ subroutine set_zonal_BT_cont(u, h_in, h_L, h_R, BT_cont, uh_tot_0, duhdu_tot_0, u_R(I) = u(I,j,k) + duR(I) * visc_rem(I,k) u_0(I) = u(I,j,k) + du0(I) * visc_rem(I,k) endif ; enddo - call zonal_flux_layer(u_0, h_in(:,j,k), h_L(:,j,k), h_R(:,j,k), uh_0, & - FA_marg_0, visc_rem(:,k), dt, G, j, ish, ieh, do_I, & - CS%vol_CFL) - call zonal_flux_layer(u_L, h_in(:,j,k), h_L(:,j,k), h_R(:,j,k), uh_L, & - FA_marg_L, visc_rem(:,k), dt, G, j, ish, ieh, do_I, & - CS%vol_CFL) - call zonal_flux_layer(u_R, h_in(:,j,k), h_L(:,j,k), h_R(:,j,k), uh_R, & - FA_marg_R, visc_rem(:,k), dt, G, j, ish, ieh, do_I, & - CS%vol_CFL) + call zonal_flux_layer(u_0, h_in(:,j,k), h_L(:,j,k), h_R(:,j,k), uh_0, duhdu_0, & + visc_rem(:,k), dt, G, US, j, ish, ieh, do_I, CS%vol_CFL) + call zonal_flux_layer(u_L, h_in(:,j,k), h_L(:,j,k), h_R(:,j,k), uh_L, duhdu_L, & + visc_rem(:,k), dt, G, US, j, ish, ieh, do_I, CS%vol_CFL) + call zonal_flux_layer(u_R, h_in(:,j,k), h_L(:,j,k), h_R(:,j,k), uh_R, duhdu_R, & + visc_rem(:,k), dt, G, US, j, ish, ieh, do_I, CS%vol_CFL) do I=ish-1,ieh ; if (do_I(I)) then - FAmt_0(I) = FAmt_0(I) + FA_marg_0(I) - FAmt_L(I) = FAmt_L(I) + FA_marg_L(I) - FAmt_R(I) = FAmt_R(I) + FA_marg_R(I) + FAmt_0(I) = FAmt_0(I) + US%L_T_to_m_s*duhdu_0(I) + FAmt_L(I) = FAmt_L(I) + US%L_T_to_m_s*duhdu_L(I) + FAmt_R(I) = FAmt_R(I) + US%L_T_to_m_s*duhdu_R(I) uhtot_L(I) = uhtot_L(I) + uh_L(I) uhtot_R(I) = uhtot_R(I) + uh_R(I) endif ; enddo @@ -986,11 +977,11 @@ subroutine set_zonal_BT_cont(u, h_in, h_L, h_R, BT_cont, uh_tot_0, duhdu_tot_0, do I=ish-1,ieh ; if (do_I(I)) then FA_0 = FAmt_0(I) ; FA_avg = FAmt_0(I) if ((duL(I) - du0(I)) /= 0.0) & - FA_avg = uhtot_L(I) / (duL(I) - du0(I)) + FA_avg = US%L_T_to_m_s*uhtot_L(I) / (duL(I) - du0(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_u_W0(I,j) = US%m_to_L*FA_0 ; BT_cont%FA_u_WW(I,j) = US%m_to_L*FAmt_L(I) + BT_cont%FA_u_W0(I,j) = FA_0 ; BT_cont%FA_u_WW(I,j) = 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) = US%m_s_to_L_T*(1.5 * (duL(I) - du0(I))) * & ((FAmt_L(I) - FA_avg) / (FAmt_L(I) - FA_0)) @@ -998,11 +989,11 @@ subroutine set_zonal_BT_cont(u, h_in, h_L, h_R, BT_cont, uh_tot_0, duhdu_tot_0, FA_0 = FAmt_0(I) ; FA_avg = FAmt_0(I) if ((duR(I) - du0(I)) /= 0.0) & - FA_avg = uhtot_R(I) / (duR(I) - du0(I)) + FA_avg = US%L_T_to_m_s*uhtot_R(I) / (duR(I) - du0(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_u_E0(I,j) = US%m_to_L*FA_0 ; BT_cont%FA_u_EE(I,j) = US%m_to_L*FAmt_R(I) + BT_cont%FA_u_E0(I,j) = FA_0 ; BT_cont%FA_u_EE(I,j) = 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) = US%m_s_to_L_T*(1.5 * (duR(I) - du0(I))) * & ((FAmt_R(I) - FA_avg) / (FAmt_R(I) - FA_0)) @@ -1047,18 +1038,18 @@ subroutine meridional_mass_flux(v, h_in, vh, dt, G, GV, US, CS, LB, vhbt, OBC, & !! the effective open face areas as a function of barotropic flow. ! Local variables real, dimension(SZI_(G),SZK_(G)) :: & - dvhdv ! Partial derivative of vh with v [H m ~> m2 or kg m-1]. + dvhdv ! Partial derivative of vh with v [H L2 s T-1 m-1 ~> m2 or kg m-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: & h_L, h_R ! Left and right face thicknesses [H ~> m or kg m-2]. real, dimension(SZI_(G)) :: & dv, & ! Corrective barotropic change in the velocity [m s-1]. dv_min_CFL, & ! Min/max limits on dv correction dv_max_CFL, & ! to avoid CFL violations - dvhdv_tot_0, & ! Summed partial derivative of vh with v [H m ~> m2 or kg m-1]. - vh_tot_0, & ! Summed transport with no barotropic correction [H m2 s-1 ~> m3 s-1 or kg s-1]. + dvhdv_tot_0, & ! Summed partial derivative of vh with v [H L2 s T-1 m-1 ~> m2 or kg m-1]. + vh_tot_0, & ! Summed transport with no barotropic correction [H L2 T-1 ~> m3 s-1 or kg s-1]. visc_rem_max ! The column maximum of visc_rem. logical, dimension(SZI_(G)) :: do_I - real, dimension(SZI_(G)) :: FAvi ! A list of sums of meridional face areas [H m ~> m2 or kg m-1]. + real, dimension(SZI_(G)) :: FAvi ! A list of sums of meridional face areas [H L ~> m2 or kg m-1]. real :: FA_v ! A sum of meridional face areas [H m ~> m2 or kg m-1]. real, dimension(SZI_(G),SZK_(G)) :: & visc_rem ! A 2-D copy of visc_rem_v or an array of 1's. @@ -1122,11 +1113,11 @@ subroutine meridional_mass_flux(v, h_in, vh, dt, G, GV, US, CS, LB, vhbt, OBC, & enddo ; endif call merid_flux_layer(v(:,J,k), h_in(:,:,k), h_L(:,:,k), h_R(:,:,k), & vh(:,J,k), dvhdv(:,k), visc_rem(:,k), & - dt, G, J, ish, ieh, do_I, CS%vol_CFL, OBC) + dt, G, US, J, ish, ieh, do_I, CS%vol_CFL, OBC) if (local_specified_BC) then do i=ish,ieh if (OBC%segment(OBC%segnum_v(i,J))%specified) & - vh(i,J,k) = OBC%segment(OBC%segnum_v(i,J))%normal_trans(i,J,k) + vh(i,J,k) = US%m_to_L**2*US%T_to_s*OBC%segment(OBC%segnum_v(i,J))%normal_trans(i,J,k) enddo endif enddo ! k-loop @@ -1208,8 +1199,6 @@ subroutine meridional_mass_flux(v, h_in, vh, dt, G, GV, US, CS, LB, vhbt, OBC, & dv_min_CFL(i) = min(dv_min_CFL(i),0.0) enddo - ! Up to this point, everything is shared between vhbt and vhbt_aux. - any_simple_OBC = .false. if (present(vhbt) .or. set_BT_cont) then if (local_specified_BC .or. local_Flather_OBC) then ; do i=ish,ieh @@ -1223,9 +1212,9 @@ subroutine meridional_mass_flux(v, h_in, vh, dt, G, GV, US, CS, LB, vhbt, OBC, & endif if (present(vhbt)) then - call meridional_flux_adjust(v, h_in, h_L, h_R, US%s_to_T*US%L_to_m**2*vhbt(:,J), vh_tot_0, & - dvhdv_tot_0, dv, dv_max_CFL, dv_min_CFL, dt, G, & - CS, visc_rem, j, ish, ieh, do_I, .true., vh, OBC=OBC) + call meridional_flux_adjust(v, h_in, h_L, h_R, vhbt(:,J), vh_tot_0, dvhdv_tot_0, dv, & + dv_max_CFL, dv_min_CFL, dt, G, US, CS, visc_rem, & + j, ish, ieh, do_I, .true., vh, OBC=OBC) if (present(v_cor)) then ; do k=1,nz do i=ish,ieh ; v_cor(i,J,k) = v(i,J,k) + dv(i) * visc_rem(i,k) ; enddo @@ -1243,18 +1232,18 @@ subroutine meridional_mass_flux(v, h_in, vh, dt, G, GV, US, CS, LB, vhbt, OBC, & if (any_simple_OBC) then do i=ish,ieh do_I(i) = (OBC%segment(OBC%segnum_v(i,J))%specified) - if (do_I(i)) FAvi(i) = GV%H_subroundoff*G%dx_Cv(i,J) + if (do_I(i)) FAvi(i) = GV%H_subroundoff*US%m_to_L*G%dx_Cv(i,J) enddo do k=1,nz ; do i=ish,ieh ; if (do_I(i)) then if ((abs(OBC%segment(OBC%segnum_v(i,J))%normal_vel(i,J,k)) > 0.0) .and. & (OBC%segment(OBC%segnum_v(i,J))%specified)) & - FAvi(i) = FAvi(i) + & + FAvi(i) = FAvi(i) + US%m_to_L * & OBC%segment(OBC%segnum_v(i,J))%normal_trans(i,J,k) / & 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) = 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%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%vBT_SS(i,J) = 0.0 ; BT_cont%vBT_NN(i,J) = 0.0 endif ; enddo endif @@ -1262,11 +1251,6 @@ subroutine meridional_mass_flux(v, h_in, vh, dt, G, GV, US, CS, LB, vhbt, OBC, & endif ! present(vhbt) or set_BT_cont - !### Work this into the code above. - do k=1,nz ; do i=ish,ieh - vh(i,J,k) = US%m_to_L**2*US%T_to_s*vh(i,J,k) - enddo ; enddo - enddo ! j-loop if (local_open_BC .and. set_BT_cont) then @@ -1308,7 +1292,7 @@ subroutine meridional_mass_flux(v, h_in, vh, dt, G, GV, US, CS, LB, vhbt, OBC, & end subroutine meridional_mass_flux !> Evaluates the meridional mass or volume fluxes in a layer. -subroutine merid_flux_layer(v, h, h_L, h_R, vh, dvhdv, visc_rem, dt, G, J, & +subroutine merid_flux_layer(v, h, h_L, h_R, vh, dvhdv, visc_rem, dt, G, US, J, & ish, ieh, do_I, vol_CFL, OBC) type(ocean_grid_type), intent(inout) :: G !< Ocean's grid structure. real, dimension(SZI_(G)), intent(in) :: v !< Meridional velocity [m s-1]. @@ -1324,10 +1308,11 @@ subroutine merid_flux_layer(v, h, h_L, h_R, vh, dvhdv, visc_rem, dt, G, J, & real, dimension(SZI_(G),SZJ_(G)), intent(in) :: h_R !< Right thickness in the reconstruction !! [H ~> m or kg m-2]. real, dimension(SZI_(G)), intent(inout) :: vh !< Meridional mass or volume transport - !! [H m2 s-1 ~> m3 s-1 or kg s-1]. + !! [H L2 T-1 ~> m3 s-1 or kg s-1]. real, dimension(SZI_(G)), intent(inout) :: dvhdv !< Partial derivative of vh with v - !! [H m ~> m2 or kg m-1]. + !! [H L2 s T-1 m-1 ~> m2 or kg m-1]. real, intent(in) :: dt !< Time increment [s]. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type integer, intent(in) :: j !< Spatial index. integer, intent(in) :: ish !< Start of index range. integer, intent(in) :: ieh !< End of index range. @@ -1353,7 +1338,7 @@ subroutine merid_flux_layer(v, h, h_L, h_R, vh, dvhdv, visc_rem, dt, G, J, & if (vol_CFL) then ; CFL = (v(i) * dt) * (G%dx_Cv(i,J) * G%IareaT(i,j)) else ; CFL = v(i) * dt * G%IdyT(i,j) ; endif curv_3 = h_L(i,j) + h_R(i,j) - 2.0*h(i,j) - vh(i) = G%dx_Cv(i,J) * v(i) * ( h_R(i,j) + CFL * & + vh(i) = US%m_to_L*G%dx_Cv(i,J) * US%m_s_to_L_T*v(i) * ( h_R(i,j) + CFL * & (0.5*(h_L(i,j) - h_R(i,j)) + curv_3*(CFL - 1.5)) ) h_marg = h_R(i,j) + CFL * ((h_L(i,j) - h_R(i,j)) + & 3.0*curv_3*(CFL - 1.0)) @@ -1361,7 +1346,7 @@ subroutine merid_flux_layer(v, h, h_L, h_R, vh, dvhdv, visc_rem, dt, G, J, & if (vol_CFL) then ; CFL = (-v(i) * dt) * (G%dx_Cv(i,J) * G%IareaT(i,j+1)) else ; CFL = -v(i) * dt * G%IdyT(i,j+1) ; endif curv_3 = h_L(i,j+1) + h_R(i,j+1) - 2.0*h(i,j+1) - vh(i) = G%dx_Cv(i,J) * v(i) * ( h_L(i,j+1) + CFL * & + vh(i) = US%m_to_L*G%dx_Cv(i,J) * US%m_s_to_L_T*v(i) * ( h_L(i,j+1) + CFL * & (0.5*(h_R(i,j+1)-h_L(i,j+1)) + curv_3*(CFL - 1.5)) ) h_marg = h_L(i,j+1) + CFL * ((h_R(i,j+1)-h_L(i,j+1)) + & 3.0*curv_3*(CFL - 1.0)) @@ -1369,18 +1354,18 @@ subroutine merid_flux_layer(v, h, h_L, h_R, vh, dvhdv, visc_rem, dt, G, J, & vh(i) = 0.0 h_marg = 0.5 * (h_L(i,j+1) + h_R(i,j)) endif - dvhdv(i) = G%dx_Cv(i,J) * h_marg * visc_rem(i) + dvhdv(i) = US%m_s_to_L_T * US%m_to_L*G%dx_Cv(i,J) * h_marg * visc_rem(i) endif ; enddo if (local_open_BC) then do i=ish,ieh ; if (do_I(i)) then if (OBC%segment(OBC%segnum_v(i,J))%open) then if (OBC%segment(OBC%segnum_v(i,J))%direction == OBC_DIRECTION_N) then - vh(i) = G%dx_Cv(i,J) * v(i) * h(i,j) - dvhdv(i) = G%dx_Cv(i,J) * h(i,j) * visc_rem(i) + vh(i) = US%m_to_L*G%dx_Cv(i,J) * US%m_s_to_L_T*v(i) * h(i,j) + dvhdv(i) = US%m_s_to_L_T * US%m_to_L*G%dx_Cv(i,J) * h(i,j) * visc_rem(i) else - vh(i) = G%dx_Cv(i,J) * v(i) * h(i,j+1) - dvhdv(i) = G%dx_Cv(i,J) * h(i,j+1) * visc_rem(i) + vh(i) = US%m_to_L*G%dx_Cv(i,J) * US%m_s_to_L_T*v(i) * h(i,j+1) + dvhdv(i) = US%m_s_to_L_T * US%m_to_L*G%dx_Cv(i,J) * h(i,j+1) * visc_rem(i) endif endif endif ; enddo @@ -1496,7 +1481,7 @@ end subroutine merid_face_thickness !> Returns the barotropic velocity adjustment that gives the desired barotropic (layer-summed) transport. subroutine meridional_flux_adjust(v, h_in, h_L, h_R, vhbt, vh_tot_0, dvhdv_tot_0, & - dv, dv_max_CFL, dv_min_CFL, dt, G, CS, visc_rem, & + dv, dv_max_CFL, dv_min_CFL, dt, G, US, CS, visc_rem, & j, ish, ieh, do_I_in, full_precision, vh_3d, OBC) type(ocean_grid_type), intent(inout) :: G !< Ocean's grid structure. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & @@ -1515,15 +1500,16 @@ subroutine meridional_flux_adjust(v, h_in, h_L, h_R, vhbt, vh_tot_0, dvhdv_tot_0 !! between 0 (at the bottom) and 1 (far above the bottom). real, dimension(SZI_(G)), & optional, intent(in) :: vhbt !< The summed volume flux through meridional faces - !! [H m2 s-1 ~> m3 s-1 or kg s-1]. + !! [H L2 T-1 ~> m3 s-1 or kg s-1]. 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, dimension(SZI_(G)), intent(in) :: vh_tot_0 !< The summed transport with 0 adjustment - !! [H m2 s-1 ~> m3 s-1 or kg s-1]. + !! [H L2 T-1 ~> m3 s-1 or kg s-1]. real, dimension(SZI_(G)), intent(in) :: dvhdv_tot_0 !< The partial derivative of dv_err with - !! dv at 0 adjustment [H m ~> m2 or kg m-1]. + !! dv at 0 adjustment [H L2 s T-1 m-1 ~> m2 or kg m-1]. real, dimension(SZI_(G)), intent(out) :: dv !< The barotropic velocity adjustment [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. integer, intent(in) :: j !< Spatial index. integer, intent(in) :: ish !< Start of index range. @@ -1534,17 +1520,17 @@ subroutine meridional_flux_adjust(v, h_in, h_L, h_R, vhbt, vh_tot_0, dvhdv_tot_0 !! iterate. The default is .true. (more accurate). real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & optional, intent(inout) :: vh_3d !< Volume flux through meridional - !! faces = v*h*dx [H m2 s-1 ~> m3 s-1 or kg s-1]. + !! faces = v*h*dx [H L2 T-1 ~> m3 s-1 or kg s-1]. type(ocean_OBC_type), optional, pointer :: OBC !< Open boundaries control structure. ! Local variables real, dimension(SZI_(G),SZK_(G)) :: & - vh_aux, & ! An auxiliary meridional volume flux [H m s-1 ~> m2 s-1 or kg m-1 s-1]. + vh_aux, & ! An auxiliary meridional volume flux [H L2 s-1 ~> m3 s-1 or kg s-1]. dvhdv ! Partial derivative of vh with v [H m ~> m2 or kg m-1]. real, dimension(SZI_(G)) :: & - vh_err, & ! Difference between vhbt and the summed vh [H m2 s-1 ~> m3 s-1 or kg s-1]. - vh_err_best, & ! The smallest value of vh_err found so far [H m2 s-1 ~> m3 s-1 or kg s-1]. + vh_err, & ! Difference between vhbt and the summed vh [H L2 T-1 ~> m3 s-1 or kg s-1]. + vh_err_best, & ! The smallest value of vh_err found so far [H L2 T-1 ~> m3 s-1 or kg s-1]. v_new, & ! The velocity with the correction added [m s-1]. - dvhdv_tot,&! Summed partial derivative of vh with u [H m ~> m2 or kg m-1]. + dvhdv_tot,&! Summed partial derivative of vh with u [H L2 s T-1 m-1 ~> m2 or kg m-1]. dv_min, & ! Min/max limits on dv correction based on CFL limits dv_max ! and previous iterations [m s-1]. real :: dv_prev ! The previous value of dv [m s-1]. @@ -1590,8 +1576,8 @@ subroutine meridional_flux_adjust(v, h_in, h_L, h_R, vhbt, vh_tot_0, dvhdv_tot_0 enddo domore = .false. do i=ish,ieh ; if (do_I(i)) then - if ((dt*min(G%IareaT(i,j),G%IareaT(i,j+1))*abs(vh_err(i)) > tol_eta) .or.& - (CS%better_iter .and. ((abs(vh_err(i)) > tol_vel * dvhdv_tot(i)) .or.& + if ((US%s_to_T*dt * min(US%L_to_m**2*G%IareaT(i,j),US%L_to_m**2*G%IareaT(i,j+1))*abs(vh_err(i)) > tol_eta) .or. & + (CS%better_iter .and. ((abs(vh_err(i)) > tol_vel * dvhdv_tot(i)) .or. & (abs(vh_err(i)) > vh_err_best(i))) )) then ! Use Newton's method, provided it stays bounded. Otherwise bisect ! the value with the appropriate bound. @@ -1629,7 +1615,7 @@ subroutine meridional_flux_adjust(v, h_in, h_L, h_R, vhbt, vh_tot_0, dvhdv_tot_0 do i=ish,ieh ; v_new(i) = v(i,J,k) + dv(i) * visc_rem(i,k) ; enddo call merid_flux_layer(v_new, h_in(:,:,k), h_L(:,:,k), h_R(:,:,k), & vh_aux(:,k), dvhdv(:,k), visc_rem(:,k), & - dt, G, J, ish, ieh, do_I, CS%vol_CFL, OBC) + dt, G, US, J, ish, ieh, do_I, CS%vol_CFL, OBC) enddo ; endif if (itt < max_itts) then @@ -1671,9 +1657,9 @@ subroutine set_merid_BT_cont(v, h_in, h_L, h_R, BT_cont, vh_tot_0, dvhdv_tot_0, type(BT_cont_type), intent(inout) :: BT_cont !< A structure with elements !! that describe the effective open face areas as a function of barotropic flow. real, dimension(SZI_(G)), intent(in) :: vh_tot_0 !< The summed transport - !! with 0 adjustment [H m2 s-1 ~> m3 s-1 or kg s-1]. + !! with 0 adjustment [H L2 T-1 ~> m3 s-1 or kg s-1]. real, dimension(SZI_(G)), intent(in) :: dvhdv_tot_0 !< The partial derivative - !! of du_err with dv at 0 adjustment [H m ~> m2 or kg m-1]. + !! of du_err with dv at 0 adjustment [H L2 s T-1 m-1 ~> m2 or kg m-1]. 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]. @@ -1699,17 +1685,17 @@ subroutine set_merid_BT_cont(v, h_in, h_L, h_R, BT_cont, vh_tot_0, dvhdv_tot_0, dv_CFL, & ! The velocity increment that corresponds to CFL_min [m s-1]. v_L, v_R, & ! The southerly (v_L), northerly (v_R), and zero-barotropic v_0, & ! transport (v_0) layer test velocities [m s-1]. - FA_marg_L, & ! The effective layer marginal face areas with the southerly - FA_marg_R, & ! (_L), northerly (_R), and zero-barotropic (_0) test - FA_marg_0, & ! velocities [H m ~> m2 or kg m-1]. + dvhdv_L, & ! The effective layer marginal face areas with the southerly + dvhdv_R, & ! (_L), northerly (_R), and zero-barotropic (_0) test + dvhdv_0, & ! velocities [H L2 s T-1 m-1 ~> m2 or kg m-1]. vh_L, vh_R, & ! The layer transports with the southerly (_L), northerly (_R) vh_0, & ! and zero-barotropic (_0) test velocities [H m2 s-1 ~> m3 s-1 or kg s-1]. FAmt_L, FAmt_R, & ! The summed effective marginal face areas for the 3 FAmt_0, & ! test velocities [H m ~> m2 or kg m-1]. vhtot_L, & ! The summed transport with the southerly (vhtot_L) and - vhtot_R ! and northerly (vhtot_R) test velocities [H m2 s-1 ~> m3 s-1 or kg s-1]. - real :: FA_0 ! The effective face area with 0 barotropic transport [H m ~> m2 or kg m-1]. - real :: FA_avg ! The average effective face area [H m ~> m2 or kg m-1], nominally given by + vhtot_R ! and northerly (vhtot_R) test velocities [H L2 T-1 ~> m3 s-1 or kg s-1]. + real :: FA_0 ! The effective face area with 0 barotropic transport [H L ~> m2 or kg m-1]. + real :: FA_avg ! The average effective face area [H L ~> m2 or kg m-1], nominally given by ! the realized transport divided by the barotropic velocity. real :: visc_rem_lim ! The larger of visc_rem and min_visc_rem [nondim] This ! limiting is necessary to keep the inverse of visc_rem @@ -1729,9 +1715,9 @@ subroutine set_merid_BT_cont(v, h_in, h_L, h_R, BT_cont, vh_tot_0, dvhdv_tot_0, ! Diagnose the zero-transport correction, dv0. do i=ish,ieh ; zeros(i) = 0.0 ; enddo - call meridional_flux_adjust(v, h_in, h_L, h_R, zeros, vh_tot_0, & - dvhdv_tot_0, dv0, dv_max_CFL, dv_min_CFL, dt, G, & - CS, visc_rem, j, ish, ieh, do_I, .true.) + call meridional_flux_adjust(v, h_in, h_L, h_R, zeros, vh_tot_0, dvhdv_tot_0, dv0, & + dv_max_CFL, dv_min_CFL, dt, G, US, CS, visc_rem, & + j, ish, ieh, do_I, .true.) ! Determine the southerly- and northerly- fluxes. Choose a sufficiently ! negative velocity correction for the northerly-flux, and a sufficiently @@ -1771,19 +1757,16 @@ subroutine set_merid_BT_cont(v, h_in, h_L, h_R, BT_cont, vh_tot_0, dvhdv_tot_0, v_R(i) = v(I,j,k) + dvR(i) * visc_rem(i,k) v_0(i) = v(I,j,k) + dv0(i) * visc_rem(i,k) endif ; enddo - call merid_flux_layer(v_0, h_in(:,:,k), h_L(:,:,k), h_R(:,:,k), vh_0, & - FA_marg_0, visc_rem(:,k), dt, G, J, ish, ieh, do_I, & - CS%vol_CFL) - call merid_flux_layer(v_L, h_in(:,:,k), h_L(:,:,k), h_R(:,:,k), vh_L, & - FA_marg_L, visc_rem(:,k), dt, G, J, ish, ieh, do_I, & - CS%vol_CFL) - call merid_flux_layer(v_R, h_in(:,:,k), h_L(:,:,k), h_R(:,:,k), vh_R, & - FA_marg_R, visc_rem(:,k), dt, G, J, ish, ieh, do_I, & - CS%vol_CFL) + call merid_flux_layer(v_0, h_in(:,:,k), h_L(:,:,k), h_R(:,:,k), vh_0, dvhdv_0, & + visc_rem(:,k), dt, G, US, J, ish, ieh, do_I, CS%vol_CFL) + call merid_flux_layer(v_L, h_in(:,:,k), h_L(:,:,k), h_R(:,:,k), vh_L, dvhdv_L, & + visc_rem(:,k), dt, G, US, J, ish, ieh, do_I, CS%vol_CFL) + call merid_flux_layer(v_R, h_in(:,:,k), h_L(:,:,k), h_R(:,:,k), vh_R, dvhdv_R, & + visc_rem(:,k), dt, G, US, J, ish, ieh, do_I, CS%vol_CFL) do i=ish,ieh ; if (do_I(i)) then - FAmt_0(i) = FAmt_0(i) + FA_marg_0(i) - FAmt_L(i) = FAmt_L(i) + FA_marg_L(i) - FAmt_R(i) = FAmt_R(i) + FA_marg_R(i) + FAmt_0(i) = FAmt_0(i) + US%L_T_to_m_s*dvhdv_0(i) + FAmt_L(i) = FAmt_L(i) + US%L_T_to_m_s*dvhdv_L(i) + FAmt_R(i) = FAmt_R(i) + US%L_T_to_m_s*dvhdv_R(i) vhtot_L(i) = vhtot_L(i) + vh_L(i) vhtot_R(i) = vhtot_R(i) + vh_R(i) endif ; enddo @@ -1791,10 +1774,10 @@ subroutine set_merid_BT_cont(v, h_in, h_L, h_R, BT_cont, vh_tot_0, dvhdv_tot_0, do i=ish,ieh ; if (do_I(i)) then FA_0 = FAmt_0(i) ; FA_avg = FAmt_0(i) if ((dvL(i) - dv0(i)) /= 0.0) & - FA_avg = vhtot_L(i) / (dvL(i) - dv0(i)) + FA_avg = US%L_T_to_m_s*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) = US%m_to_L*FA_0 ; BT_cont%FA_v_SS(i,J) = US%m_to_L*FAmt_L(i) + BT_cont%FA_v_S0(i,J) = FA_0 ; BT_cont%FA_v_SS(i,J) = 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) = US%m_s_to_L_T*(1.5 * (dvL(i) - dv0(i))) * & ((FAmt_L(i) - FA_avg) / (FAmt_L(i) - FA_0)) @@ -1802,10 +1785,10 @@ subroutine set_merid_BT_cont(v, h_in, h_L, h_R, BT_cont, vh_tot_0, dvhdv_tot_0, FA_0 = FAmt_0(i) ; FA_avg = FAmt_0(i) if ((dvR(i) - dv0(i)) /= 0.0) & - FA_avg = vhtot_R(i) / (dvR(i) - dv0(i)) + FA_avg = US%L_T_to_m_s*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) = US%m_to_L*FA_0 ; BT_cont%FA_v_NN(i,J) = US%m_to_L*FAmt_R(i) + BT_cont%FA_v_N0(i,J) = FA_0 ; BT_cont%FA_v_NN(i,J) = 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) = US%m_s_to_L_T*(1.5 * (dvR(i) - dv0(i))) * & ((FAmt_R(i) - FA_avg) / (FAmt_R(i) - FA_0)) From 20108b58c70452e5e6774ec1b758328df3b5c3f7 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Wed, 31 Jul 2019 14:48:48 -0400 Subject: [PATCH 133/297] +Rescaled accelerations returned from btstep Applied dimensional rescaling of the accelerations, accel_layer_u and accel_layer_v, that are returned by btstep, into [L T-2]. All answers are bitwise identical, but the units of the arguments to a public routine have changed. --- src/core/MOM_barotropic.F90 | 32 ++++++++++++++--------------- src/core/MOM_checksum_packages.F90 | 9 ++++---- src/core/MOM_dynamics_split_RK2.F90 | 12 +++++------ src/core/MOM_variables.F90 | 10 ++++----- src/diagnostics/MOM_PointAccel.F90 | 12 +++++------ 5 files changed, 38 insertions(+), 37 deletions(-) diff --git a/src/core/MOM_barotropic.F90 b/src/core/MOM_barotropic.F90 index c753fe2f9d..6f27206645 100644 --- a/src/core/MOM_barotropic.F90 +++ b/src/core/MOM_barotropic.F90 @@ -411,9 +411,9 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, !! calculate the Coriolis terms in bc_accel_u [m s-1]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: V_Cor !< Ditto for meridonal bc_accel_v. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(out) :: accel_layer_u !< The zonal acceleration of each layer due - !! to the barotropic calculation [m s-2]. + !! to the barotropic calculation [L T-2 ~> m s-2]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(out) :: accel_layer_v !< The meridional acceleration of each layer - !! due to the barotropic calculation [m s-2]. + !! due to the barotropic calculation [L T-2 ~> m s-2]. real, dimension(SZI_(G),SZJ_(G)), intent(out) :: eta_out !< The final barotropic free surface !! height anomaly or column mass anomaly [H ~> m or kg m-2]. real, dimension(SZIB_(G),SZJ_(G)), intent(out) :: uhbtav !< the barotropic zonal volume or mass @@ -481,7 +481,7 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, ! 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 [L T-2 ~> m s-2]. - uhbt, & ! The zonal barotropic thickness fluxes [H m2 s-1 ~> m3 s-1 or kg s-1]. + uhbt, & ! The zonal barotropic thickness fluxes [H L2 T-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 L2 T-1 ~> m3 s-1 or kg s-1]. @@ -514,7 +514,7 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, ! 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 [L T-2 ~> m s-2]. - vhbt, & ! The meridional barotropic thickness fluxes [H m2 s-1 ~> m3 s-1 or kg s-1]. + vhbt, & ! The meridional barotropic thickness fluxes [H L2 T-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 L2 T-1 ~> m3 s-1 or kg s-1]. @@ -619,7 +619,7 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, 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. + real :: accel_underflow ! An acceleration that is so small it should be zeroed out [L T-2 ~> m s-2]. 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 @@ -649,7 +649,7 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, MS%isdw = CS%isdw ; MS%iedw = CS%iedw ; MS%jsdw = CS%jsdw ; MS%jedw = CS%jedw 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 + accel_underflow = CS%vel_underflow * Idt use_BT_cont = .false. if (present(BT_cont)) use_BT_cont = (associated(BT_cont)) @@ -2116,13 +2116,13 @@ 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) = US%L_T2_to_m_s2 * (u_accel_bt(I,j) - & + 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) ) 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) = US%L_T2_to_m_s2 * (v_accel_bt(i,J) - & + 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) ) if (abs(accel_layer_v(i,J,k)) < accel_underflow) accel_layer_v(i,J,k) = 0.0 @@ -2135,13 +2135,13 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, 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_in_T - do k=1,nz ; accel_layer_u(I,j,k) = US%L_T2_to_m_s2*u_accel_bt(I,j) ; enddo + do k=1,nz ; accel_layer_u(I,j,k) = 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_in_T - do k=1,nz ; accel_layer_v(i,J,k) = US%L_T2_to_m_s2*v_accel_bt(i,J) ; enddo + do k=1,nz ; accel_layer_v(i,J,k) = v_accel_bt(i,J) ; enddo endif enddo ; enddo ; endif endif @@ -2379,12 +2379,12 @@ subroutine apply_velocity_OBCs(OBC, ubt, vbt, uhbt, vhbt, ubt_trans, vbt_trans, !! the argument arrays. real, dimension(SZIBW_(MS),SZJW_(MS)), intent(inout) :: ubt !< the zonal barotropic velocity [m s-1]. real, dimension(SZIBW_(MS),SZJW_(MS)), intent(inout) :: uhbt !< the zonal barotropic transport - !! [H m2 s-1 ~> m3 s-1 or kg s-1]. + !! [H L2 T-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 [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]. + !! [H L2 T-1 ~> m3 s-1 or kg s-1]. real, dimension(SZIW_(MS),SZJBW_(MS)), intent(inout) :: vbt_trans !< the meridional BT velocity used in !! transports [m s-1]. real, dimension(SZIW_(MS),SZJW_(MS)), intent(in) :: eta !< The barotropic free surface height anomaly or @@ -2564,9 +2564,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 - !! [L 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 - !! [L 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. @@ -3394,12 +3394,12 @@ subroutine adjust_local_BT_cont_types(ubt, uhbt, vbt, vhbt, BTCL_u, BTCL_v, & intent(in) :: ubt !< The linearization zonal barotropic velocity [m s-1]. real, dimension(SZIBW_(MS),SZJW_(MS)), & intent(in) :: uhbt !< The linearization zonal barotropic transport - !! [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) :: vbt !< The linearization meridional barotropic velocity [m s-1]. real, dimension(SZIW_(MS),SZJBW_(MS)), & intent(in) :: vhbt !< The linearization meridional barotropic transport - !! [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), dimension(SZIBW_(MS),SZJW_(MS)), & intent(out) :: BTCL_u !< A structure with the u information from BT_cont. type(local_BT_cont_v_type), dimension(SZIW_(MS),SZJBW_(MS)), & diff --git a/src/core/MOM_checksum_packages.F90 b/src/core/MOM_checksum_packages.F90 index a2731f9a0e..c43bd45501 100644 --- a/src/core/MOM_checksum_packages.F90 +++ b/src/core/MOM_checksum_packages.F90 @@ -187,13 +187,13 @@ subroutine MOM_accel_chksum(mesg, CAu, CAv, PFu, PFv, diffu, diffv, G, GV, US, p 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 s-2 H-1 ~> m s-2 or m4 s-2 kg-1]. + !! [L2 T-2 H-1 ~> m s-2 or m4 s-2 kg-1]. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & optional, intent(in) :: u_accel_bt !< The zonal acceleration from terms in the - !! barotropic solver [m s-2]. + !! barotropic solver [L T-2 ~> m s-2]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & optional, intent(in) :: v_accel_bt !< The meridional acceleration from terms in - !! the barotropic solver [m s-2]. + !! the barotropic solver [L T-2 ~> m s-2]. logical, optional, intent(in) :: symmetric !< If true, do checksums on the fully symmetric !! computationoal domain. @@ -212,7 +212,8 @@ subroutine MOM_accel_chksum(mesg, CAu, CAv, PFu, PFv, diffu, diffv, G, GV, US, p 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)) & - call uvchksum(mesg//" [uv]_accel_bt", u_accel_bt, v_accel_bt, G%HI,haloshift=0, symmetric=sym) + call uvchksum(mesg//" [uv]_accel_bt", u_accel_bt, v_accel_bt, G%HI,haloshift=0, symmetric=sym, & + scale=US%L_T2_to_m_s2) end subroutine MOM_accel_chksum ! ============================================================================= diff --git a/src/core/MOM_dynamics_split_RK2.F90 b/src/core/MOM_dynamics_split_RK2.F90 index d2004d8d90..6d95f9999e 100644 --- a/src/core/MOM_dynamics_split_RK2.F90 +++ b/src/core/MOM_dynamics_split_RK2.F90 @@ -554,11 +554,11 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & do k=1,nz do J=Jsq,Jeq ; do i=is,ie vp(i,J,k) = G%mask2dCv(i,J) * (v_init(i,J,k) + dt_pred * & - (v_bc_accel(i,J,k) + CS%v_accel_bt(i,J,k))) + (v_bc_accel(i,J,k) + US%L_T2_to_m_s2*CS%v_accel_bt(i,J,k))) enddo ; enddo do j=js,je ; do I=Isq,Ieq up(I,j,k) = G%mask2dCu(I,j) * (u_init(I,j,k) + dt_pred * & - (u_bc_accel(I,j,k) + CS%u_accel_bt(I,j,k))) + (u_bc_accel(I,j,k) + US%L_T2_to_m_s2*CS%u_accel_bt(I,j,k))) enddo ; enddo enddo call cpu_clock_end(id_clock_mom_update) @@ -758,11 +758,11 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & do k=1,nz do j=js,je ; do I=Isq,Ieq u(I,j,k) = G%mask2dCu(I,j) * (u_init(I,j,k) + dt * & - (u_bc_accel(I,j,k) + CS%u_accel_bt(I,j,k))) + (u_bc_accel(I,j,k) + US%L_T2_to_m_s2*CS%u_accel_bt(I,j,k))) enddo ; enddo do J=Jsq,Jeq ; do i=is,ie v(i,J,k) = G%mask2dCv(i,J) * (v_init(i,J,k) + dt * & - (v_bc_accel(i,J,k) + CS%v_accel_bt(i,J,k))) + (v_bc_accel(i,J,k) + US%L_T2_to_m_s2*CS%v_accel_bt(i,J,k))) enddo ; enddo enddo call cpu_clock_end(id_clock_mom_update) @@ -1211,9 +1211,9 @@ subroutine initialize_dyn_split_RK2(u, v, h, uh, vh, eta, Time, G, GV, US, param 'Barotropic-step Averaged Meridional Velocity', 'm s-1') CS%id_u_BT_accel = register_diag_field('ocean_model', 'u_BT_accel', diag%axesCuL, Time, & - 'Barotropic Anomaly Zonal Acceleration', 'm s-1') + 'Barotropic Anomaly Zonal Acceleration', 'm s-2', conversion=US%L_T2_to_m_s2) CS%id_v_BT_accel = register_diag_field('ocean_model', 'v_BT_accel', diag%axesCvL, Time, & - 'Barotropic Anomaly Meridional Acceleration', 'm s-1') + 'Barotropic Anomaly Meridional Acceleration', 'm s-2', conversion=US%L_T2_to_m_s2) id_clock_Cor = cpu_clock_id('(Ocean Coriolis & mom advection)', grain=CLOCK_MODULE) id_clock_continuity = cpu_clock_id('(Ocean continuity equation)', grain=CLOCK_MODULE) diff --git a/src/core/MOM_variables.F90 b/src/core/MOM_variables.F90 index 2dd459ba91..cef3c41a52 100644 --- a/src/core/MOM_variables.F90 +++ b/src/core/MOM_variables.F90 @@ -131,8 +131,8 @@ module MOM_variables v => NULL(), & !< Pointer to the meridional velocity [m s-1] h => NULL() !< Pointer to the layer thicknesses [H ~> m or kg m-2] real, pointer, dimension(:,:,:) :: & - uh => NULL(), & !< Pointer to zonal transports [H m2 s-1 ~> m3 s-1 or kg s-1] - vh => NULL() !< Pointer to meridional transports [H m2 s-1 ~> m3 s-1 or kg s-1] + uh => NULL(), & !< Pointer to zonal transports [H L2 T-1 ~> m3 s-1 or kg s-1] + vh => NULL() !< Pointer to meridional transports [H L2 T-1 ~> m3 s-1 or kg s-1] real, pointer, dimension(:,:,:) :: & CAu => NULL(), & !< Pointer to the zonal Coriolis and Advective acceleration [m s-2] CAv => NULL(), & !< Pointer to the meridional Coriolis and Advective acceleration [m s-2] @@ -141,9 +141,9 @@ module MOM_variables 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] - v_accel_bt => NULL() !< Pointer to the meridional barotropic-solver acceleration [m s-2] + !! [L2 T-2 H-1 ~> m s-2 or m4 kg-1 s-2] + u_accel_bt => NULL(), & !< Pointer to the zonal barotropic-solver acceleration [L T-2 ~> m s-2] + v_accel_bt => NULL() !< Pointer to the meridional barotropic-solver acceleration [L T-2 ~> m s-2] real, pointer, dimension(:,:,:) :: & u_av => NULL(), & !< Pointer to zonal velocity averaged over the timestep [m s-1] v_av => NULL(), & !< Pointer to meridional velocity averaged over the timestep [m s-1] diff --git a/src/diagnostics/MOM_PointAccel.F90 b/src/diagnostics/MOM_PointAccel.F90 index d488171fc5..471dcc3cef 100644 --- a/src/diagnostics/MOM_PointAccel.F90 +++ b/src/diagnostics/MOM_PointAccel.F90 @@ -53,8 +53,8 @@ module MOM_PointAccel v_prev => NULL(), & !< Previous v-velocity [m s-1]. T => NULL(), & !< Temperature [degC]. S => NULL(), & !< Salinity [ppt]. - u_accel_bt => NULL(), & !< Barotropic u-acclerations [m s-2] - v_accel_bt => NULL() !< Barotropic v-acclerations [m s-2] + u_accel_bt => NULL(), & !< Barotropic u-acclerations [L T-2 ~> m s-2] + v_accel_bt => NULL() !< Barotropic v-acclerations [L T-2 ~> m s-2] real, pointer, dimension(:,:,:) :: pbce => NULL() !< pbce times eta gives the baroclinic !! pressure anomaly in each layer due to free surface height anomalies !! [m2 s-2 H-1 ~> m s-2 or m4 kg-1 s-2]. @@ -230,7 +230,7 @@ subroutine write_u_accel(I, j, um, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st if (associated(CS%u_accel_bt)) then write(file,'("dubt: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - (dt*CS%u_accel_bt(I,j,k)) ; enddo + (dt*US%L_T2_to_m_s2*CS%u_accel_bt(I,j,k)) ; enddo write(file,'(/)') endif @@ -383,7 +383,7 @@ subroutine write_u_accel(I, j, um, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st if (associated(CS%u_accel_bt)) then write(file,'(/,"dubt: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(F10.6," ",$)') & - (dt*CS%u_accel_bt(I,j,k)*Inorm(k)) ; enddo + (dt*US%L_T2_to_m_s2*CS%u_accel_bt(I,j,k)*Inorm(k)) ; enddo endif endif @@ -565,7 +565,7 @@ subroutine write_v_accel(i, J, vm, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st if (associated(CS%v_accel_bt)) then write(file,'("dvbt: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - (dt*CS%v_accel_bt(i,J,k)) ; enddo + (dt*US%L_T2_to_m_s2*CS%v_accel_bt(i,J,k)) ; enddo write(file,'(/)') endif @@ -713,7 +713,7 @@ subroutine write_v_accel(i, J, vm, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st if (associated(CS%v_accel_bt)) then write(file,'(/,"dvbt: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(F10.6," ",$)') & - (dt*CS%v_accel_bt(i,J,k)*Inorm(k)) ; enddo + (dt*US%L_T2_to_m_s2*CS%v_accel_bt(i,J,k)*Inorm(k)) ; enddo endif endif From 767c09df3f827dd6134ae5d479783715799fb9ec Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Wed, 31 Jul 2019 16:36:55 -0400 Subject: [PATCH 134/297] +Rescaled accelerations passed to btstep Applied dimensional rescaling of the accelerations, u_accel_bc and v_accel_bc, that are passed into btstep, into [L T-2]. All answers are bitwise identical, but the units of the arguments to a public routine have changed. --- src/core/MOM_barotropic.F90 | 8 ++++---- src/core/MOM_dynamics_split_RK2.F90 | 30 ++++++++++++++--------------- 2 files changed, 19 insertions(+), 19 deletions(-) diff --git a/src/core/MOM_barotropic.F90 b/src/core/MOM_barotropic.F90 index 6f27206645..230a5439ef 100644 --- a/src/core/MOM_barotropic.F90 +++ b/src/core/MOM_barotropic.F90 @@ -396,7 +396,7 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, real, intent(in) :: dt !< The time increment to integrate over. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: bc_accel_u !< The zonal baroclinic accelerations [m s-2]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: bc_accel_v !< The meridional baroclinic accelerations, - !! [m s-2]. + !! [L T-2 ~> m s-2]. 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 @@ -1008,11 +1008,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) * US%m_to_L*US%T_to_s**2*bc_accel_u(I,j,k) + BT_force_u(I,j) = BT_force_u(I,j) + wt_u(I,j,k) * 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) * US%m_to_L*US%T_to_s**2*bc_accel_v(i,J,k) + BT_force_v(i,J) = BT_force_v(i,J) + wt_v(i,J,k) * bc_accel_v(i,J,k) enddo ; enddo ; enddo ! Determine the difference between the sum of the layer fluxes and the @@ -1467,7 +1467,7 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, 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, scale=US%L_T2_to_m_s2) 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) endif diff --git a/src/core/MOM_dynamics_split_RK2.F90 b/src/core/MOM_dynamics_split_RK2.F90 index 6d95f9999e..51fb21eb2f 100644 --- a/src/core/MOM_dynamics_split_RK2.F90 +++ b/src/core/MOM_dynamics_split_RK2.F90 @@ -285,7 +285,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & real, dimension(SZIB_(G),SZJ_(G),SZK_(G)) :: u_bc_accel real, dimension(SZI_(G),SZJB_(G),SZK_(G)) :: v_bc_accel ! u_bc_accel and v_bc_accel are the summed baroclinic accelerations of each - ! layer calculated by the non-barotropic part of the model [m s-2]. + ! layer calculated by the non-barotropic part of the model [L T-2 ~> m s-2]. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), target :: uh_in real, dimension(SZI_(G),SZJB_(G),SZK_(G)), target :: vh_in @@ -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)) + US%s_to_T*CS%diffu(I,j,k) + u_bc_accel(I,j,k) = US%m_s_to_L_T*US%T_to_s*((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)) + US%s_to_T*CS%diffv(i,J,k) + v_bc_accel(i,J,k) = US%m_s_to_L_T*US%T_to_s*((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 @@ -474,10 +474,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 - up(I,j,k) = G%mask2dCu(I,j) * (u(I,j,k) + dt * u_bc_accel(I,j,k)) + up(I,j,k) = G%mask2dCu(I,j) * (u(I,j,k) + dt * US%L_T_to_m_s*US%s_to_T*u_bc_accel(I,j,k)) enddo ; enddo do J=Jsq,Jeq ; do i=is,ie - vp(i,J,k) = G%mask2dCv(i,J) * (v(i,J,k) + dt * v_bc_accel(i,J,k)) + vp(i,J,k) = G%mask2dCv(i,J) * (v(i,J,k) + dt * US%L_T_to_m_s*US%s_to_T*v_bc_accel(i,J,k)) enddo ; enddo enddo @@ -553,12 +553,12 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & !$OMP parallel do default(shared) do k=1,nz do J=Jsq,Jeq ; do i=is,ie - vp(i,J,k) = G%mask2dCv(i,J) * (v_init(i,J,k) + dt_pred * & - (v_bc_accel(i,J,k) + US%L_T2_to_m_s2*CS%v_accel_bt(i,J,k))) + vp(i,J,k) = G%mask2dCv(i,J) * (v_init(i,J,k) + US%s_to_T*dt_pred * US%L_T_to_m_s* & + (v_bc_accel(i,J,k) + CS%v_accel_bt(i,J,k))) enddo ; enddo do j=js,je ; do I=Isq,Ieq - up(I,j,k) = G%mask2dCu(I,j) * (u_init(I,j,k) + dt_pred * & - (u_bc_accel(I,j,k) + US%L_T2_to_m_s2*CS%u_accel_bt(I,j,k))) + up(I,j,k) = G%mask2dCu(I,j) * (u_init(I,j,k) + US%s_to_T*dt_pred * US%L_T_to_m_s* & + (u_bc_accel(I,j,k) + CS%u_accel_bt(I,j,k))) enddo ; enddo enddo call cpu_clock_end(id_clock_mom_update) @@ -707,10 +707,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)) + US%s_to_T*CS%diffu(I,j,k) + u_bc_accel(I,j,k) = US%m_s_to_L_T*US%T_to_s*((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)) + US%s_to_T*CS%diffv(i,J,k) + v_bc_accel(i,J,k) = US%m_s_to_L_T*US%T_to_s*((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 @@ -757,12 +757,12 @@ 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(I,j,k) = G%mask2dCu(I,j) * (u_init(I,j,k) + dt * & - (u_bc_accel(I,j,k) + US%L_T2_to_m_s2*CS%u_accel_bt(I,j,k))) + u(I,j,k) = G%mask2dCu(I,j) * (u_init(I,j,k) + US%s_to_T*dt * US%L_T_to_m_s* & + (u_bc_accel(I,j,k) + CS%u_accel_bt(I,j,k))) enddo ; enddo do J=Jsq,Jeq ; do i=is,ie - v(i,J,k) = G%mask2dCv(i,J) * (v_init(i,J,k) + dt * & - (v_bc_accel(i,J,k) + US%L_T2_to_m_s2*CS%v_accel_bt(i,J,k))) + v(i,J,k) = G%mask2dCv(i,J) * (v_init(i,J,k) + US%s_to_T*dt * US%L_T_to_m_s* & + (v_bc_accel(i,J,k) + CS%v_accel_bt(i,J,k))) enddo ; enddo enddo call cpu_clock_end(id_clock_mom_update) From e49b1fd76e8427e23f1ec570cca369b510228d99 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Wed, 31 Jul 2019 18:04:19 -0400 Subject: [PATCH 135/297] +Rescaled Coriolis accelerations Applied dimensional rescaling to the Coriolis accelerations, CAu and CAv, that are returned from CorAdCalc, into [L T-2]. This change also includes rescaling of several related diagnostics. All answers are bitwise identical, but the units of the arguments to a public routine have changed. --- src/core/MOM_CoriolisAdv.F90 | 132 +++++++++++++------------- src/core/MOM_checksum_packages.F90 | 6 +- src/core/MOM_dynamics_split_RK2.F90 | 22 +++-- src/core/MOM_dynamics_unsplit.F90 | 22 ++--- src/core/MOM_dynamics_unsplit_RK2.F90 | 24 ++--- src/core/MOM_variables.F90 | 12 +-- src/diagnostics/MOM_PointAccel.F90 | 24 ++--- src/diagnostics/MOM_diagnostics.F90 | 8 +- 8 files changed, 126 insertions(+), 124 deletions(-) diff --git a/src/core/MOM_CoriolisAdv.F90 b/src/core/MOM_CoriolisAdv.F90 index 9baaa42009..a5be221f63 100644 --- a/src/core/MOM_CoriolisAdv.F90 +++ b/src/core/MOM_CoriolisAdv.F90 @@ -119,9 +119,9 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS) real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: vh !< Meridional transport v*h*dx !! [H L2 T-1 ~> m3 s-1 or kg s-1] real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(out) :: CAu !< Zonal acceleration due to Coriolis - !! and momentum advection [m s-2]. + !! and momentum advection [L T-2 ~> m s-2]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(out) :: CAv !< Meridional acceleration due to Coriolis - !! and momentum advection [m s-2]. + !! and momentum advection [L T-2 ~> m s-2]. type(ocean_OBC_type), pointer :: OBC !< Open boundary control structure type(accel_diag_ptrs), intent(inout) :: AD !< Storage for acceleration diagnostics type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type @@ -129,14 +129,14 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS) ! Local variables real, dimension(SZIB_(G),SZJB_(G)) :: & - q, & ! Layer potential vorticity [m-1 s-1]. + q, & ! Layer potential vorticity [H-1 T-1 ~> m-1 s-1 or m2 kg-1 s-1]. Ih_q, & ! The inverse of thickness interpolated to q points [H-1 ~> m-1 or m2 kg-1]. Area_q ! The sum of the ocean areas at the 4 adjacent thickness points [m2]. real, dimension(SZIB_(G),SZJ_(G)) :: & a, b, c, d ! a, b, c, & d are combinations of the potential vorticities ! surrounding an h grid point. At small scales, a = q/4, - ! b = q/4, etc. All are in [H-1 s-1 ~> m-1 s-1 or m2 kg-1 s-1], + ! b = q/4, etc. All are in [H-1 T-1 ~> m-1 s-1 or m2 kg-1 s-1], ! and use the indexing of the corresponding u point. real, dimension(SZI_(G),SZJ_(G)) :: & @@ -146,13 +146,13 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS) real, dimension(SZIB_(G),SZJ_(G)) :: & hArea_u, & ! The cell area weighted thickness interpolated to u points ! times the effective areas [H m2 ~> m3 or kg]. - KEx, & ! The zonal gradient of Kinetic energy per unit mass [m s-2], + KEx, & ! The zonal gradient of Kinetic energy per unit mass [L T-2 ~> m s-2], ! KEx = d/dx KE. uh_center ! Transport based on arithmetic mean h at u-points [H L2 T-1 ~> m3 s-1 or kg s-1] real, dimension(SZI_(G),SZJB_(G)) :: & hArea_v, & ! The cell area weighted thickness interpolated to v points ! times the effective areas [H m2 ~> m3 or kg]. - KEy, & ! The meridonal gradient of Kinetic energy per unit mass [m s-2], + KEy, & ! The meridonal gradient of Kinetic energy per unit mass [L T-2 ~> m s-2], ! KEy = d/dy KE. vh_center ! Transport based on arithmetic mean h at v-points [H L2 T-1 ~> m3 s-1 or kg s-1] real, dimension(SZI_(G),SZJ_(G)) :: & @@ -163,30 +163,30 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS) ! discretization [H-1 s-1 ~> m-1 s-1 or m2 kg-1 s-1]. real, dimension(SZIB_(G),SZJB_(G)) :: & dvdx,dudy, &! Contributions to the circulation around q-points [m2 s-1] - abs_vort, & ! Absolute vorticity at q-points [s-1]. - q2, & ! Relative vorticity over thickness [H-1 s-1 ~> m-1 s-1 or m2 kg-1 s-1]. - max_fvq, & ! The maximum or minimum of the - min_fvq, & ! adjacent values of (-u) or v times - max_fuq, & ! the absolute vorticity [m s-2]. - min_fuq ! All are defined at q points. + abs_vort, & ! Absolute vorticity at q-points [T-1 ~> s-1]. + q2, & ! Relative vorticity over thickness [H-1 T-1 ~> m-1 s-1 or m2 kg-1 s-1]. + max_fvq, & ! The maximum of the adjacent values of (-u) times absolute vorticity [L T-2 ~> m s-2]. + min_fvq, & ! The minimum of the adjacent values of (-u) times absolute vorticity [L T-2 ~> m s-2]. + max_fuq, & ! The maximum of the adjacent values of u times absolute vorticity [L T-2 ~> m s-2]. + min_fuq ! The minimum of the adjacent values of u times absolute vorticity [L T-2 ~> m s-2]. real, dimension(SZIB_(G),SZJB_(G),SZK_(G)) :: & - PV, & ! A diagnostic array of the potential vorticities [m-1 s-1]. - RV ! A diagnostic array of the relative vorticities [s-1]. - real :: fv1, fv2, fu1, fu2 ! (f+rv)*v or (f+rv)*u [m s-2]. + PV, & ! A diagnostic array of the potential vorticities [H-1 T-1 ~> m-1 s-1 or m2 kg-1 s-1]. + RV ! A diagnostic array of the relative vorticities [T-1 ~> s-1]. + real :: fv1, fv2, fu1, fu2 ! (f+rv)*v or (f+rv)*u [L T-2 ~> m s-2]. real :: max_fv, max_fu ! The maximum or minimum of the neighboring Coriolis - real :: min_fv, min_fu ! accelerations [m s-2], i.e. max(min)_fu(v)q. + real :: min_fv, min_fu ! accelerations [L T-2 ~> m s-2], i.e. max(min)_fu(v)q. real, parameter :: C1_12=1.0/12.0 ! C1_12 = 1/12 real, parameter :: C1_24=1.0/24.0 ! C1_24 = 1/24 - real :: absolute_vorticity ! Absolute vorticity [s-1]. - real :: relative_vorticity ! Relative vorticity [s-1]. + real :: absolute_vorticity ! Absolute vorticity [T-1 ~> s-1]. + real :: relative_vorticity ! Relative vorticity [T-1 ~> s-1]. real :: Ih ! Inverse of thickness [H-1 ~> m-1 or m2 kg-1]. real :: max_Ihq, min_Ihq ! The maximum and minimum of the nearby Ihq [H-1 ~> m-1 or m2 kg-1]. real :: hArea_q ! The sum of area times thickness of the cells ! surrounding a q point [H m2 ~> m3 or kg]. 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 :: temp1, temp2 ! Temporary variables [m2 s-2]. + real :: temp1, temp2 ! Temporary variables [L2 T-2 ~> m2 s-2]. real, parameter :: eps_vel=1.0e-10 ! A tiny, positive velocity [m s-1]. real :: uhc, vhc ! Centered estimates of uh and vh [H L2 T-1 ~> m3 s-1 or kg s-1]. @@ -406,13 +406,13 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS) do J=Jsq-1,Jeq+1 ; do I=Isq-1,Ieq+1 if (CS%no_slip ) then - relative_vorticity = (2.0-G%mask2dBu(I,J)) * (dvdx(I,J) - dudy(I,J)) * & + relative_vorticity = (2.0-G%mask2dBu(I,J)) * US%T_to_s*(dvdx(I,J) - dudy(I,J)) * & G%IareaBu(I,J) else - relative_vorticity = G%mask2dBu(I,J) * (dvdx(I,J) - dudy(I,J)) * & + relative_vorticity = G%mask2dBu(I,J) * US%T_to_s*(dvdx(I,J) - dudy(I,J)) * & G%IareaBu(I,J) endif - absolute_vorticity = US%s_to_T*G%CoriolisBu(I,J) + relative_vorticity + absolute_vorticity = G%CoriolisBu(I,J) + relative_vorticity Ih = 0.0 if (Area_q(i,j) > 0.0) then hArea_q = (hArea_u(I,j) + hArea_u(I,j+1)) + (hArea_v(i,J) + hArea_v(i+1,J)) @@ -423,10 +423,10 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS) Ih_q(I,J) = Ih if (CS%bound_Coriolis) then - fv1 = absolute_vorticity*v(i+1,J,k) - fv2 = absolute_vorticity*v(i,J,k) - fu1 = -absolute_vorticity*u(I,j+1,k) - fu2 = -absolute_vorticity*u(I,j,k) + fv1 = absolute_vorticity * US%m_s_to_L_T*v(i+1,J,k) + fv2 = absolute_vorticity * US%m_s_to_L_T*v(i,J,k) + fu1 = -absolute_vorticity * US%m_s_to_L_T*u(I,j+1,k) + fu2 = -absolute_vorticity * US%m_s_to_L_T*u(I,j,k) if (fv1 > fv2) then max_fvq(I,J) = fv1 ; min_fvq(I,J) = fv2 else @@ -565,7 +565,7 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS) endif ! Calculate KE and the gradient of KE - call gradKE(u, v, h, KE, KEx, KEy, k, OBC, G, CS) + call gradKE(u, v, h, KE, KEx, KEy, k, OBC, G, US, CS) ! Calculate the tendencies of zonal velocity due to the Coriolis ! force and momentum advection. On a Cartesian grid, this is @@ -590,19 +590,19 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS) else temp2 = q(I,J-1) * (vh_min(i,j-1)+vh_min(i+1,j-1)) endif - CAu(I,j,k) = US%L_T_to_m_s*0.25 * US%L_to_m*G%IdxCu(I,j) * (temp1 + temp2) + CAu(I,j,k) = 0.25 * US%L_to_m*G%IdxCu(I,j) * (temp1 + temp2) enddo ; enddo else ! Energy conserving scheme, Sadourny 1975 do j=js,je ; do I=Isq,Ieq - CAu(I,j,k) = 0.25 * US%L_T_to_m_s * & + CAu(I,j,k) = 0.25 * & (q(I,J) * (vh(i+1,J,k) + vh(i,J,k)) + & q(I,J-1) * (vh(i,J-1,k) + vh(i+1,J-1,k))) * US%L_to_m*G%IdxCu(I,j) enddo ; enddo endif elseif (CS%Coriolis_Scheme == SADOURNY75_ENSTRO) then do j=js,je ; do I=Isq,Ieq - CAu(I,j,k) = 0.125 * US%L_T_to_m_s * (US%L_to_m*G%IdxCu(I,j) * (q(I,J) + q(I,J-1))) * & + CAu(I,j,k) = 0.125 * (US%L_to_m*G%IdxCu(I,j) * (q(I,J) + q(I,J-1))) * & ((vh(i+1,J,k) + vh(i,J,k)) + (vh(i,J-1,k) + vh(i+1,J-1,k))) enddo ; enddo elseif ((CS%Coriolis_Scheme == ARAKAWA_HSU90) .or. & @@ -610,10 +610,8 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS) (CS%Coriolis_Scheme == AL_BLEND)) then ! (Global) Energy and (Local) Enstrophy conserving, Arakawa & Hsu 1990 do j=js,je ; do I=Isq,Ieq - CAu(I,j,k) = US%L_T_to_m_s*((a(I,j) * vh(i+1,J,k) + & - c(I,j) * vh(i,J-1,k)) & - + (b(I,j) * vh(i,J,k) + & - d(I,j) * vh(i+1,J-1,k))) * US%L_to_m*G%IdxCu(I,j) + CAu(I,j,k) = ((a(I,j) * vh(i+1,J,k) + c(I,j) * vh(i,J-1,k)) + & + (b(I,j) * vh(i,J,k) + d(I,j) * vh(i+1,J-1,k))) * US%L_to_m*G%IdxCu(I,j) enddo ; enddo elseif (CS%Coriolis_Scheme == ROBUST_ENSTRO) then ! An enstrophy conserving scheme robust to vanishing layers @@ -633,32 +631,29 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS) Heff4 = max(Heff4, min(h(i+1,j-1,k),h(i+1,j,k))) Heff4 = min(Heff4, max(h(i+1,j-1,k),h(i+1,j,k))) if (CS%PV_Adv_Scheme == PV_ADV_CENTERED) then - CAu(I,j,k) = US%L_T_to_m_s*0.5*(abs_vort(I,J)+abs_vort(I,J-1)) * & - ((vh(i ,J ,k)+vh(i+1,J-1,k)) + & - (vh(i ,J-1,k)+vh(i+1,J ,k)) ) / & - (h_tiny +((Heff1+Heff4) +(Heff2+Heff3)) ) * US%L_to_m*G%IdxCu(I,j) + CAu(I,j,k) = 0.5*(abs_vort(I,J)+abs_vort(I,J-1)) * & + ((vh(i,J,k) + vh(i+1,J-1,k)) + (vh(i,J-1,k) + vh(i+1,J,k)) ) / & + (h_tiny + ((Heff1+Heff4) + (Heff2+Heff3)) ) * US%L_to_m*G%IdxCu(I,j) elseif (CS%PV_Adv_Scheme == PV_ADV_UPWIND1) then - VHeff = ((vh(i ,J ,k)+vh(i+1,J-1,k)) + & - (vh(i ,J-1,k)+vh(i+1,J ,k)) ) + VHeff = ((vh(i,J,k) + vh(i+1,J-1,k)) + (vh(i,J-1,k) + vh(i+1,J,k)) ) QVHeff = 0.5*( (abs_vort(I,J)+abs_vort(I,J-1))*VHeff & -(abs_vort(I,J)-abs_vort(I,J-1))*abs(VHeff) ) - CAu(I,j,k) = US%L_T_to_m_s*QVHeff / & - (h_tiny +((Heff1+Heff4) +(Heff2+Heff3)) ) * US%L_to_m*G%IdxCu(I,j) + CAu(I,j,k) = (QVHeff / ( h_tiny + ((Heff1+Heff4) + (Heff2+Heff3)) ) ) * US%L_to_m*G%IdxCu(I,j) endif enddo ; enddo endif ! Add in the additonal terms with Arakawa & Lamb. if ((CS%Coriolis_Scheme == ARAKAWA_LAMB81) .or. & (CS%Coriolis_Scheme == AL_BLEND)) then ; do j=js,je ; do I=Isq,Ieq - CAu(I,j,k) = CAu(I,j,k) + US%L_T_to_m_s * & + CAu(I,j,k) = CAu(I,j,k) + & (ep_u(i,j)*uh(I-1,j,k) - ep_u(i+1,j)*uh(I+1,j,k)) * US%L_to_m*G%IdxCu(I,j) enddo ; enddo ; endif if (CS%bound_Coriolis) then do j=js,je ; do I=Isq,Ieq - max_fv = MAX(max_fvq(I,J),max_fvq(I,J-1)) - min_fv = MIN(min_fvq(I,J),min_fvq(I,J-1)) + max_fv = MAX(max_fvq(I,J), max_fvq(I,J-1)) + min_fv = MIN(min_fvq(I,J), min_fvq(I,J-1)) ! CAu(I,j,k) = min( CAu(I,j,k), max_fv ) ! CAu(I,j,k) = max( CAu(I,j,k), min_fv ) if (CAu(I,j,k) > max_fv) then @@ -699,19 +694,19 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS) else temp2 = q(I,J) * (uh_min(i,j)+uh_min(i,j+1)) endif - CAv(i,J,k) = -0.25 * US%L_T_to_m_s*US%L_to_m*G%IdyCv(i,J) * (temp1 + temp2) + CAv(i,J,k) = -0.25 * US%L_to_m*G%IdyCv(i,J) * (temp1 + temp2) enddo ; enddo else ! Energy conserving scheme, Sadourny 1975 do J=Jsq,Jeq ; do i=is,ie - CAv(i,J,k) = - 0.25* US%L_T_to_m_s*& + CAv(i,J,k) = - 0.25* & (q(I-1,J)*(uh(I-1,j,k) + uh(I-1,j+1,k)) + & q(I,J)*(uh(I,j,k) + uh(I,j+1,k))) * US%L_to_m*G%IdyCv(i,J) enddo ; enddo endif elseif (CS%Coriolis_Scheme == SADOURNY75_ENSTRO) then do J=Jsq,Jeq ; do i=is,ie - CAv(i,J,k) = -0.125 * US%L_T_to_m_s*(US%L_to_m*G%IdyCv(i,J) * (q(I-1,J) + q(I,J))) * & + CAv(i,J,k) = -0.125 * (US%L_to_m*G%IdyCv(i,J) * (q(I-1,J) + q(I,J))) * & ((uh(I-1,j,k) + uh(I-1,j+1,k)) + (uh(I,j,k) + uh(I,j+1,k))) enddo ; enddo elseif ((CS%Coriolis_Scheme == ARAKAWA_HSU90) .or. & @@ -719,7 +714,7 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS) (CS%Coriolis_Scheme == AL_BLEND)) then ! (Global) Energy and (Local) Enstrophy conserving, Arakawa & Hsu 1990 do J=Jsq,Jeq ; do i=is,ie - CAv(i,J,k) = - US%L_T_to_m_s*((a(I-1,j) * uh(I-1,j,k) + & + CAv(i,J,k) = - ((a(I-1,j) * uh(I-1,j,k) + & c(I,j+1) * uh(I,j+1,k)) & + (b(I,j) * uh(I,j,k) + & d(I-1,j+1) * uh(I-1,j+1,k))) * US%L_to_m*G%IdyCv(i,J) @@ -742,7 +737,7 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS) Heff4 = max(Heff4, min(h(i-1,j+1,k),h(i,j+1,k))) Heff4 = min(Heff4, max(h(i-1,j+1,k),h(i,j+1,k))) if (CS%PV_Adv_Scheme == PV_ADV_CENTERED) then - CAv(i,J,k) = - 0.5*US%L_T_to_m_s*(abs_vort(I,J)+abs_vort(I-1,J)) * & + CAv(i,J,k) = - 0.5*(abs_vort(I,J)+abs_vort(I-1,J)) * & ((uh(I ,j ,k)+uh(I-1,j+1,k)) + & (uh(I-1,j ,k)+uh(I ,j+1,k)) ) / & (h_tiny + ((Heff1+Heff4) +(Heff2+Heff3)) ) * US%L_to_m*G%IdyCv(i,J) @@ -751,7 +746,7 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS) (uh(I-1,j ,k)+uh(I ,j+1,k)) ) QUHeff = 0.5*( (abs_vort(I,J)+abs_vort(I-1,J))*UHeff & -(abs_vort(I,J)-abs_vort(I-1,J))*abs(UHeff) ) - CAv(i,J,k) = - US%L_T_to_m_s*QUHeff / & + CAv(i,J,k) = - QUHeff / & (h_tiny + ((Heff1+Heff4) +(Heff2+Heff3)) ) * US%L_to_m*G%IdyCv(i,J) endif enddo ; enddo @@ -759,7 +754,7 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS) ! Add in the additonal terms with Arakawa & Lamb. if ((CS%Coriolis_Scheme == ARAKAWA_LAMB81) .or. & (CS%Coriolis_Scheme == AL_BLEND)) then ; do J=Jsq,Jeq ; do i=is,ie - CAv(i,J,k) = CAv(i,J,k) + US%L_T_to_m_s * & + CAv(i,J,k) = CAv(i,J,k) + & (ep_v(i,j)*vh(i,J-1,k) - ep_v(i,j+1)*vh(i,J+1,k)) * US%L_to_m*G%IdyCv(i,J) enddo ; enddo ; endif @@ -838,18 +833,19 @@ end subroutine CorAdCalc !> Calculates the acceleration due to the gradient of kinetic energy. -subroutine gradKE(u, v, h, KE, KEx, KEy, k, OBC, G, CS) +subroutine gradKE(u, v, h, KE, KEx, KEy, k, OBC, G, US, CS) type(ocean_grid_type), intent(in) :: G !< Ocen grid structure real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: u !< Zonal velocity [m s-1] real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: v !< Meridional velocity [m s-1] 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) ), intent(out) :: KE !< Kinetic energy [m2 s-2] + real, dimension(SZI_(G) ,SZJ_(G) ), intent(out) :: KE !< Kinetic energy per unit mass [m2 s-2] real, dimension(SZIB_(G),SZJ_(G) ), intent(out) :: KEx !< Zonal acceleration due to kinetic - !! energy gradient [m s-2] + !! energy gradient [L T-2 ~> m s-2] real, dimension(SZI_(G) ,SZJB_(G)), intent(out) :: KEy !< Meridional acceleration due to kinetic - !! energy gradient [m s-2] + !! energy gradient [L T-2 ~> m s-2] integer, intent(in) :: k !< Layer number to calculate for type(ocean_OBC_type), pointer :: OBC !< Open boundary control structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(CoriolisAdv_CS), pointer :: CS !< Control structure for MOM_CoriolisAdv ! Local variables real :: um, up, vm, vp ! Temporary variables [m s-1]. @@ -897,12 +893,12 @@ subroutine gradKE(u, v, h, KE, KEx, KEy, k, OBC, G, CS) ! Term - d(KE)/dx. do j=js,je ; do I=Isq,Ieq - KEx(I,j) = (KE(i+1,j) - KE(i,j)) * G%IdxCu(I,j) + KEx(I,j) = US%m_s_to_L_T**2*(KE(i+1,j) - KE(i,j)) * US%L_to_m*G%IdxCu(I,j) enddo ; enddo ! Term - d(KE)/dy. do J=Jsq,Jeq ; do i=is,ie - KEy(i,J) = (KE(i,j+1) - KE(i,j)) * G%IdyCv(i,J) + KEy(i,J) = US%m_s_to_L_T**2*(KE(i,j+1) - KE(i,j)) * US%L_to_m*G%IdyCv(i,J) enddo ; enddo if (associated(OBC)) then @@ -922,9 +918,11 @@ subroutine gradKE(u, v, h, KE, KEx, KEy, k, OBC, G, CS) end subroutine gradKE !> Initializes the control structure for coriolisadv_cs -subroutine CoriolisAdv_init(Time, G, param_file, diag, AD, CS) +subroutine CoriolisAdv_init(Time, G, GV, US, param_file, diag, AD, CS) type(time_type), target, intent(in) :: Time !< Current model time - 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 !< Vertical grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(param_file_type), intent(in) :: param_file !< Runtime parameter handles type(diag_ctrl), target, intent(inout) :: diag !< Diagnostics control structure type(accel_diag_ptrs), target, intent(inout) :: AD !< Strorage for acceleration diagnostics @@ -937,7 +935,7 @@ subroutine CoriolisAdv_init(Time, G, param_file, diag, AD, CS) character(len=400) :: mesg integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB, nz - isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed ; nz = G%ke + isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed ; nz = GV%ke IsdB = G%IsdB ; IedB = G%IedB ; JsdB = G%JsdB ; JedB = G%JedB if (associated(CS)) then @@ -1068,25 +1066,25 @@ subroutine CoriolisAdv_init(Time, G, param_file, diag, AD, CS) end select CS%id_rv = register_diag_field('ocean_model', 'RV', diag%axesBL, Time, & - 'Relative Vorticity', 's-1') + 'Relative Vorticity', 's-1', conversion=US%s_to_T) CS%id_PV = register_diag_field('ocean_model', 'PV', diag%axesBL, Time, & - 'Potential Vorticity', 'm-1 s-1') + 'Potential Vorticity', 'm-1 s-1', conversion=GV%m_to_H*US%s_to_T) CS%id_gKEu = register_diag_field('ocean_model', 'gKEu', diag%axesCuL, Time, & - 'Zonal Acceleration from Grad. Kinetic Energy', 'm-1 s-2') + 'Zonal Acceleration from Grad. Kinetic Energy', 'm-1 s-2', conversion=US%L_T2_to_m_s2) if (CS%id_gKEu > 0) call safe_alloc_ptr(AD%gradKEu,IsdB,IedB,jsd,jed,nz) CS%id_gKEv = register_diag_field('ocean_model', 'gKEv', diag%axesCvL, Time, & - 'Meridional Acceleration from Grad. Kinetic Energy', 'm-1 s-2') + 'Meridional Acceleration from Grad. Kinetic Energy', 'm-1 s-2', conversion=US%L_T2_to_m_s2) if (CS%id_gKEv > 0) call safe_alloc_ptr(AD%gradKEv,isd,ied,JsdB,JedB,nz) CS%id_rvxu = register_diag_field('ocean_model', 'rvxu', diag%axesCvL, Time, & - 'Meridional Acceleration from Relative Vorticity', 'm-1 s-2') + 'Meridional Acceleration from Relative Vorticity', 'm-1 s-2', conversion=US%L_T2_to_m_s2) if (CS%id_rvxu > 0) call safe_alloc_ptr(AD%rv_x_u,isd,ied,JsdB,JedB,nz) CS%id_rvxv = register_diag_field('ocean_model', 'rvxv', diag%axesCuL, Time, & - 'Zonal Acceleration from Relative Vorticity', 'm-1 s-2') + 'Zonal Acceleration from Relative Vorticity', 'm-1 s-2', conversion=US%L_T2_to_m_s2) if (CS%id_rvxv > 0) call safe_alloc_ptr(AD%rv_x_v,IsdB,IedB,jsd,jed,nz) end subroutine CoriolisAdv_init diff --git a/src/core/MOM_checksum_packages.F90 b/src/core/MOM_checksum_packages.F90 index c43bd45501..662ac963c0 100644 --- a/src/core/MOM_checksum_packages.F90 +++ b/src/core/MOM_checksum_packages.F90 @@ -167,10 +167,10 @@ subroutine MOM_accel_chksum(mesg, CAu, CAv, PFu, PFv, diffu, diffv, G, GV, US, p type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & intent(in) :: CAu !< Zonal acceleration due to Coriolis - !! and momentum advection terms [m s-2]. + !! and momentum advection terms [L T-2 ~> m s-2]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & intent(in) :: CAv !< Meridional acceleration due to Coriolis - !! and momentum advection terms [m s-2]. + !! and momentum advection terms [L T-2 ~> m s-2]. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & intent(in) :: PFu !< Zonal acceleration due to pressure gradients !! (equal to -dM/dx) [m s-2]. @@ -206,7 +206,7 @@ subroutine MOM_accel_chksum(mesg, CAu, CAv, PFu, PFv, diffu, diffv, G, GV, US, p ! Note that for the chksum calls to be useful for reproducing across PE ! counts, there must be no redundant points, so all variables use is..ie ! and js...je as their extent. - call uvchksum(mesg//" CA[uv]", CAu, CAv, G%HI, haloshift=0, symmetric=sym) + call uvchksum(mesg//" CA[uv]", CAu, CAv, G%HI, haloshift=0, symmetric=sym, scale=US%L_T2_to_m_s2) 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, scale=US%s_to_T) if (present(pbce)) & diff --git a/src/core/MOM_dynamics_split_RK2.F90 b/src/core/MOM_dynamics_split_RK2.F90 index 51fb21eb2f..b4f064ed41 100644 --- a/src/core/MOM_dynamics_split_RK2.F90 +++ b/src/core/MOM_dynamics_split_RK2.F90 @@ -69,12 +69,12 @@ module MOM_dynamics_split_RK2 !> MOM_dynamics_split_RK2 module control structure type, public :: MOM_dyn_split_RK2_CS ; private real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_,NKMEM_) :: & - CAu, & !< CAu = f*v - u.grad(u) [m s-2] + CAu, & !< CAu = f*v - u.grad(u) [L T-2 ~> m s-2] PFu, & !< PFu = -dM/dx [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] + CAv, & !< CAv = -f*u - u.grad(v) [L T-2 ~> m s-2] PFv, & !< PFv = -dM/dy [m s-2] diffv !< Meridional acceleration due to convergence of the along-isopycnal stress tensor [m s-1 T-1 ~> m s-2] @@ -449,10 +449,12 @@ 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) = US%m_s_to_L_T*US%T_to_s*((CS%Cau(I,j,k) + CS%PFu(I,j,k)) + US%s_to_T*CS%diffu(I,j,k)) + u_bc_accel(I,j,k) = US%m_s_to_L_T*US%T_to_s*((US%L_T2_to_m_s2*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) = US%m_s_to_L_T*US%T_to_s*((CS%Cav(i,J,k) + CS%PFv(i,J,k)) + US%s_to_T*CS%diffv(i,J,k)) + v_bc_accel(i,J,k) = US%m_s_to_L_T*US%T_to_s*((US%L_T2_to_m_s2*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 @@ -707,10 +709,12 @@ 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) = US%m_s_to_L_T*US%T_to_s*((CS%Cau(I,j,k) + CS%PFu(I,j,k)) + US%s_to_T*CS%diffu(I,j,k)) + u_bc_accel(I,j,k) = US%m_s_to_L_T*US%T_to_s*((US%L_T2_to_m_s2*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) = US%m_s_to_L_T*US%T_to_s*((CS%Cav(i,J,k) + CS%PFv(i,J,k)) + US%s_to_T*CS%diffv(i,J,k)) + v_bc_accel(i,J,k) = US%m_s_to_L_T*US%T_to_s*((US%L_T2_to_m_s2*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 @@ -1104,7 +1108,7 @@ subroutine initialize_dyn_split_RK2(u, v, h, uh, vh, eta, Time, G, GV, US, param ! Accel_diag%u_av => CS%u_av ; Accel_diag%v_av => CS%v_av call continuity_init(Time, G, GV, param_file, diag, CS%continuity_CSp) - call CoriolisAdv_init(Time, G, param_file, diag, CS%ADp, CS%CoriolisAdv_CSp) + call CoriolisAdv_init(Time, G, GV, US, param_file, diag, CS%ADp, CS%CoriolisAdv_CSp) 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) @@ -1197,9 +1201,9 @@ subroutine initialize_dyn_split_RK2(u, v, h, uh, vh, eta, Time, G, GV, US, param conversion=H_convert*US%L_to_m**2*US%s_to_T) CS%id_CAu = register_diag_field('ocean_model', 'CAu', diag%axesCuL, Time, & - 'Zonal Coriolis and Advective Acceleration', 'm s-2') + 'Zonal Coriolis and Advective Acceleration', 'm s-2', conversion=US%L_T2_to_m_s2) CS%id_CAv = register_diag_field('ocean_model', 'CAv', diag%axesCvL, Time, & - 'Meridional Coriolis and Advective Acceleration', 'm s-2') + 'Meridional Coriolis and Advective Acceleration', 'm s-2', conversion=US%L_T2_to_m_s2) CS%id_PFu = register_diag_field('ocean_model', 'PFu', diag%axesCuL, Time, & 'Zonal Pressure Force Acceleration', 'm s-2') CS%id_PFv = register_diag_field('ocean_model', 'PFv', diag%axesCvL, Time, & diff --git a/src/core/MOM_dynamics_unsplit.F90 b/src/core/MOM_dynamics_unsplit.F90 index 2ea32a5495..3c146b7b62 100644 --- a/src/core/MOM_dynamics_unsplit.F90 +++ b/src/core/MOM_dynamics_unsplit.F90 @@ -107,12 +107,12 @@ module MOM_dynamics_unsplit !> MOM_dynamics_unsplit module control structure type, public :: MOM_dyn_unsplit_CS ; private real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_,NKMEM_) :: & - CAu, & !< CAu = f*v - u.grad(u) [m s-2]. + CAu, & !< CAu = f*v - u.grad(u) [L T-2 ~> m s-2]. PFu, & !< PFu = -dM/dx [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]. + CAv, & !< CAv = -f*u - u.grad(v) [L T-2 ~> m s-2]. PFv, & !< PFv = -dM/dy [m s-2]. diffv !< Meridional acceleration due to convergence of the along-isopycnal stress tensor [m s-1 T-1 ~> m s-2]. @@ -324,11 +324,11 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & 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(I,j,k) + dt_pred * & - (CS%PFu(I,j,k) + CS%CAu(I,j,k))) + (CS%PFu(I,j,k) + US%L_T2_to_m_s2*CS%CAu(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(i,J,k) + dt_pred * & - (CS%PFv(i,J,k) + CS%CAv(i,J,k))) + (CS%PFv(i,J,k) + US%L_T2_to_m_s2*CS%CAv(i,J,k))) enddo ; enddo ; enddo call cpu_clock_end(id_clock_mom_update) @@ -391,11 +391,11 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & call cpu_clock_begin(id_clock_mom_update) do k=1,nz ; do j=js,je ; do I=Isq,Ieq upp(I,j,k) = G%mask2dCu(I,j) * (u(I,j,k) + dt * 0.5 * & - (CS%PFu(I,j,k) + CS%CAu(I,j,k))) + (CS%PFu(I,j,k) + US%L_T2_to_m_s2*CS%CAu(I,j,k))) enddo ; enddo ; enddo do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie vpp(i,J,k) = G%mask2dCv(i,J) * (v(i,J,k) + dt * 0.5 * & - (CS%PFv(i,J,k) + CS%CAv(i,J,k))) + (CS%PFv(i,J,k) + US%L_T2_to_m_s2*CS%CAv(i,J,k))) enddo ; enddo ; enddo call cpu_clock_end(id_clock_mom_update) @@ -468,11 +468,11 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & endif do k=1,nz ; do j=js,je ; do I=Isq,Ieq u(I,j,k) = G%mask2dCu(I,j) * (u(I,j,k) + dt * & - (CS%PFu(I,j,k) + CS%CAu(I,j,k))) + (CS%PFu(I,j,k) + US%L_T2_to_m_s2*CS%CAu(I,j,k))) enddo ; enddo ; enddo do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie v(i,J,k) = G%mask2dCv(i,J) * (v(i,J,k) + dt * & - (CS%PFv(i,J,k) + CS%CAv(i,J,k))) + (CS%PFv(i,J,k) + US%L_T2_to_m_s2*CS%CAv(i,J,k))) enddo ; enddo ; enddo ! u <- u + dt d/dz visc d/dz u @@ -648,7 +648,7 @@ subroutine initialize_dyn_unsplit(u, v, h, Time, G, GV, US, param_file, diag, CS Accel_diag%CAu => CS%CAu ; Accel_diag%CAv => CS%CAv call continuity_init(Time, G, GV, param_file, diag, CS%continuity_CSp) - call CoriolisAdv_init(Time, G, param_file, diag, CS%ADp, CS%CoriolisAdv_CSp) + call CoriolisAdv_init(Time, G, GV, US, param_file, diag, CS%ADp, CS%CoriolisAdv_CSp) 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) @@ -672,9 +672,9 @@ subroutine initialize_dyn_unsplit(u, v, h, Time, G, GV, US, param_file, diag, CS 'Meridional Thickness Flux', flux_units, x_cell_method='sum', v_extensive=.true., & conversion=H_convert*US%L_to_m**2*US%s_to_T) CS%id_CAu = register_diag_field('ocean_model', 'CAu', diag%axesCuL, Time, & - 'Zonal Coriolis and Advective Acceleration', 'meter second-2') + 'Zonal Coriolis and Advective Acceleration', 'meter second-2, conversion=US%L_T2_to_m_s2') CS%id_CAv = register_diag_field('ocean_model', 'CAv', diag%axesCvL, Time, & - 'Meridional Coriolis and Advective Acceleration', 'meter second-2') + 'Meridional Coriolis and Advective Acceleration', 'meter second-2', conversion=US%L_T2_to_m_s2) CS%id_PFu = register_diag_field('ocean_model', 'PFu', diag%axesCuL, Time, & 'Zonal Pressure Force Acceleration', 'meter second-2') CS%id_PFv = register_diag_field('ocean_model', 'PFv', diag%axesCvL, Time, & diff --git a/src/core/MOM_dynamics_unsplit_RK2.F90 b/src/core/MOM_dynamics_unsplit_RK2.F90 index 85f1145ecb..b3094d12b5 100644 --- a/src/core/MOM_dynamics_unsplit_RK2.F90 +++ b/src/core/MOM_dynamics_unsplit_RK2.F90 @@ -26,7 +26,7 @@ module MOM_dynamics_unsplit_RK2 !* The subroutine step_MOM_dyn_unsplit_RK2 actually does the time * !* stepping, while register_restarts_dyn_unsplit_RK2 sets the fields * !* that are found in a full restart file with this scheme, and * -!* initialize_dyn_unsplit_RK2 initializes the cpu clocks that are * * +!* initialize_dyn_unsplit_RK2 initializes the cpu clocks that are * !* used in this module. For largely historical reasons, this module * !* does not have its own control structure, but shares the same * !* control structure with MOM.F90 and the other MOM_dynamics_... * @@ -104,12 +104,12 @@ module MOM_dynamics_unsplit_RK2 !> MOM_dynamics_unsplit_RK2 module control structure type, public :: MOM_dyn_unsplit_RK2_CS ; private real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_,NKMEM_) :: & - CAu, & !< CAu = f*v - u.grad(u) [m s-2]. + CAu, & !< CAu = f*v - u.grad(u) [L T-2 ~> m s-2]. PFu, & !< PFu = -dM/dx [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]. + CAv, & !< CAv = -f*u - u.grad(v) [L T-2 ~> m s-2]. PFv, & !< PFv = -dM/dy [m s-2]. diffv !< Meridional acceleration due to convergence of the along-isopycnal stress tensor [m s-1 T-1 ~> m s-2]. @@ -322,11 +322,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)) + US%s_to_T*CS%diffu(I,j,k))) + ((CS%PFu(I,j,k) + US%L_T2_to_m_s2*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)) + US%s_to_T*CS%diffv(i,J,k))) + ((CS%PFv(i,J,k) + US%L_T2_to_m_s2*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) @@ -378,15 +378,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)) + US%s_to_T*CS%diffu(I,j,k))) + ((CS%PFu(I,j,k) + US%L_T2_to_m_s2*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)) + US%s_to_T*CS%diffu(I,j,k))) + ((CS%PFu(I,j,k) + US%L_T2_to_m_s2*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)) + US%s_to_T*CS%diffv(i,J,k))) + ((CS%PFv(i,J,k) + US%L_T2_to_m_s2*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)) + US%s_to_T*CS%diffv(i,J,k))) + ((CS%PFv(i,J,k) + US%L_T2_to_m_s2*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 @@ -608,7 +608,7 @@ subroutine initialize_dyn_unsplit_RK2(u, v, h, Time, G, GV, US, param_file, diag Accel_diag%CAu => CS%CAu ; Accel_diag%CAv => CS%CAv call continuity_init(Time, G, GV, param_file, diag, CS%continuity_CSp) - call CoriolisAdv_init(Time, G, param_file, diag, CS%ADp, CS%CoriolisAdv_CSp) + call CoriolisAdv_init(Time, G, GV, US, param_file, diag, CS%ADp, CS%CoriolisAdv_CSp) 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) @@ -631,9 +631,9 @@ subroutine initialize_dyn_unsplit_RK2(u, v, h, Time, G, GV, US, param_file, diag 'Meridional Thickness Flux', flux_units, x_cell_method='sum', v_extensive=.true., & conversion=H_convert*US%L_to_m**2*US%s_to_T) CS%id_CAu = register_diag_field('ocean_model', 'CAu', diag%axesCuL, Time, & - 'Zonal Coriolis and Advective Acceleration', 'meter second-2') + 'Zonal Coriolis and Advective Acceleration', 'meter second-2', conversion=US%L_T2_to_m_s2) CS%id_CAv = register_diag_field('ocean_model', 'CAv', diag%axesCvL, Time, & - 'Meridional Coriolis and Advective Acceleration', 'meter second-2') + 'Meridional Coriolis and Advective Acceleration', 'meter second-2', conversion=US%L_T2_to_m_s2) CS%id_PFu = register_diag_field('ocean_model', 'PFu', diag%axesCuL, Time, & 'Zonal Pressure Force Acceleration', 'meter second-2') CS%id_PFv = register_diag_field('ocean_model', 'PFv', diag%axesCvL, Time, & diff --git a/src/core/MOM_variables.F90 b/src/core/MOM_variables.F90 index cef3c41a52..477a68aa3f 100644 --- a/src/core/MOM_variables.F90 +++ b/src/core/MOM_variables.F90 @@ -158,8 +158,8 @@ module MOM_variables real, pointer, dimension(:,:,:) :: & 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] + CAu => NULL(), & !< Zonal Coriolis and momentum advection accelerations [L T-2 ~> m s-2] + CAv => NULL(), & !< Meridional Coriolis and momentum advection accelerations [L T-2 ~> m s-2] PFu => NULL(), & !< Zonal acceleration due to pressure forces [m s-2] PFv => NULL(), & !< Meridional acceleration due to pressure forces [m s-2] du_dt_visc => NULL(), &!< Zonal acceleration due to vertical viscosity [m s-2] @@ -174,10 +174,10 @@ module MOM_variables !! not due to any explicit accelerations [m s-1]. ! These accelerations are sub-terms included in the accelerations above. - real, pointer :: gradKEu(:,:,:) => NULL() !< gradKEu = - d/dx(u2) [m s-2] - real, pointer :: gradKEv(:,:,:) => NULL() !< gradKEv = - d/dy(u2) [m s-2] - real, pointer :: rv_x_v(:,:,:) => NULL() !< rv_x_v = rv * v at u [m s-2] - real, pointer :: rv_x_u(:,:,:) => NULL() !< rv_x_u = rv * u at v [m s-2] + real, pointer :: gradKEu(:,:,:) => NULL() !< gradKEu = - d/dx(u2) [L T-2 ~> m s-2] + real, pointer :: gradKEv(:,:,:) => NULL() !< gradKEv = - d/dy(u2) [L T-2 ~> m s-2] + real, pointer :: rv_x_v(:,:,:) => NULL() !< rv_x_v = rv * v at u [L T-2 ~> m s-2] + real, pointer :: rv_x_u(:,:,:) => NULL() !< rv_x_u = rv * u at v [L T-2 ~> m s-2] end type accel_diag_ptrs diff --git a/src/diagnostics/MOM_PointAccel.F90 b/src/diagnostics/MOM_PointAccel.F90 index 471dcc3cef..f21303e0a8 100644 --- a/src/diagnostics/MOM_PointAccel.F90 +++ b/src/diagnostics/MOM_PointAccel.F90 @@ -188,7 +188,7 @@ subroutine write_u_accel(I, j, um, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st ((um(I,j,k)-CS%u_prev(I,j,k))); enddo endif write(file,'(/,"CAu: ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (dt*ADp%CAu(I,j,k)); enddo + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (dt*US%L_T2_to_m_s2*ADp%CAu(I,j,k)); enddo 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: ",$)') @@ -197,12 +197,12 @@ subroutine write_u_accel(I, j, um, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st if (associated(ADp%gradKEu)) then write(file,'(/,"KEu: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - (dt*ADp%gradKEu(I,j,k)); enddo + (dt*US%L_T2_to_m_s2*ADp%gradKEu(I,j,k)); enddo endif if (associated(ADp%rv_x_v)) then write(file,'(/,"Coru: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - dt*(ADp%CAu(I,j,k)-ADp%rv_x_v(I,j,k)); enddo + dt*US%L_T2_to_m_s2*(ADp%CAu(I,j,k)-ADp%rv_x_v(I,j,k)); enddo endif if (associated(ADp%du_dt_visc)) then write(file,'(/,"ubv: ",$)') @@ -350,7 +350,7 @@ subroutine write_u_accel(I, j, um, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st write(file,'(/,"CAu: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(F10.6," ",$)') & - (dt*ADp%CAu(I,j,k)*Inorm(k)); enddo + (dt*US%L_T2_to_m_s2*ADp%CAu(I,j,k)*Inorm(k)); enddo write(file,'(/,"PFu: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(F10.6," ",$)') & @@ -363,12 +363,12 @@ subroutine write_u_accel(I, j, um, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st if (associated(ADp%gradKEu)) then write(file,'(/,"KEu: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(F10.6," ",$)') & - (dt*ADp%gradKEu(I,j,k)*Inorm(k)); enddo + (dt*US%L_T2_to_m_s2*ADp%gradKEu(I,j,k)*Inorm(k)); enddo endif if (associated(ADp%rv_x_v)) then write(file,'(/,"Coru: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(F10.6," ",$)') & - dt*(ADp%CAu(I,j,k)-ADp%rv_x_v(I,j,k))*Inorm(k); enddo + dt*US%L_T2_to_m_s2*(ADp%CAu(I,j,k)-ADp%rv_x_v(I,j,k))*Inorm(k); enddo endif if (associated(ADp%du_dt_visc)) then write(file,'(/,"duv: ",$)') @@ -520,7 +520,7 @@ subroutine write_v_accel(i, J, vm, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st endif write(file,'(/,"CAv: ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (dt*ADp%CAv(i,J,k)); enddo + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (dt*US%L_T2_to_m_s2*ADp%CAv(i,J,k)); enddo write(file,'(/,"PFv: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (dt*ADp%PFv(i,J,k)); enddo @@ -531,12 +531,12 @@ subroutine write_v_accel(i, J, vm, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st if (associated(ADp%gradKEv)) then write(file,'(/,"KEv: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - (dt*ADp%gradKEv(i,J,k)); enddo + (dt*US%L_T2_to_m_s2*ADp%gradKEv(i,J,k)); enddo endif if (associated(ADp%rv_x_u)) then write(file,'(/,"Corv: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - dt*(ADp%CAv(i,J,k)-ADp%rv_x_u(i,J,k)); enddo + dt*US%L_T2_to_m_s2*(ADp%CAv(i,J,k)-ADp%rv_x_u(i,J,k)); enddo endif if (associated(ADp%dv_dt_visc)) then write(file,'(/,"vbv: ",$)') @@ -682,7 +682,7 @@ subroutine write_v_accel(i, J, vm, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st ((vm(i,J,k)-CS%v_prev(i,J,k))*Inorm(k)); enddo write(file,'(/,"CAv: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(F10.6," ",$)') & - (dt*ADp%CAv(i,J,k)*Inorm(k)); enddo + (dt*US%L_T2_to_m_s2*ADp%CAv(i,J,k)*Inorm(k)); enddo write(file,'(/,"PFv: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(F10.6," ",$)') & (dt*ADp%PFv(i,J,k)*Inorm(k)); enddo @@ -693,12 +693,12 @@ subroutine write_v_accel(i, J, vm, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st if (associated(ADp%gradKEu)) then write(file,'(/,"KEv: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(F10.6," ",$)') & - (dt*ADp%gradKEv(i,J,k)*Inorm(k)); enddo + (dt*US%L_T2_to_m_s2*ADp%gradKEv(i,J,k)*Inorm(k)); enddo endif if (associated(ADp%rv_x_u)) then write(file,'(/,"Corv: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(F10.6," ",$)') & - dt*(ADp%CAv(i,J,k)-ADp%rv_x_u(i,J,k))*Inorm(k); enddo + dt*US%L_T2_to_m_s2*(ADp%CAv(i,J,k)-ADp%rv_x_u(i,J,k))*Inorm(k); enddo endif if (associated(ADp%dv_dt_visc)) then write(file,'(/,"dvv: ",$)') diff --git a/src/diagnostics/MOM_diagnostics.F90 b/src/diagnostics/MOM_diagnostics.F90 index ee5a4976ac..1505d3dc8f 100644 --- a/src/diagnostics/MOM_diagnostics.F90 +++ b/src/diagnostics/MOM_diagnostics.F90 @@ -975,10 +975,10 @@ subroutine calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, GV, US, CS if (associated(CS%KE_CorAdv)) then do k=1,nz do j=js,je ; do I=Isq,Ieq - KE_u(I,j) = US%s_to_T*uh(I,j,k)*G%dxCu(I,j)*ADp%CAu(I,j,k) + KE_u(I,j) = US%L_T_to_m_s**2*US%s_to_T*uh(I,j,k)*US%m_to_L*G%dxCu(I,j)*ADp%CAu(I,j,k) enddo ; enddo do J=Jsq,Jeq ; do i=is,ie - KE_v(i,J) = US%s_to_T*vh(i,J,k)*G%dyCv(i,J)*ADp%CAv(i,J,k) + KE_v(i,J) = US%L_T_to_m_s**2*US%s_to_T*vh(i,J,k)*US%m_to_L*G%dyCv(i,J)*ADp%CAv(i,J,k) enddo ; enddo do j=js,je ; do i=is,ie KE_h(i,j) = -CS%KE(i,j,k) * US%L_to_m**2*G%IareaT(i,j) * & @@ -1002,11 +1002,11 @@ subroutine calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, GV, US, CS do k=1,nz do j=js,je ; do I=Isq,Ieq if (G%mask2dCu(i,j) /= 0.) & - KE_u(I,j) = US%s_to_T*uh(I,j,k)*G%dxCu(I,j)*ADp%gradKEu(I,j,k) + KE_u(I,j) = US%L_T_to_m_s**2*US%s_to_T*uh(I,j,k)*US%m_to_L*G%dxCu(I,j)*ADp%gradKEu(I,j,k) enddo ; enddo do J=Jsq,Jeq ; do i=is,ie if (G%mask2dCv(i,j) /= 0.) & - KE_v(i,J) = US%s_to_T*vh(i,J,k)*G%dyCv(i,J)*ADp%gradKEv(i,J,k) + KE_v(i,J) = US%L_T_to_m_s**2*US%s_to_T*vh(i,J,k)*US%m_to_L*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) * US%L_to_m**2*G%IareaT(i,j) * & From 636a09d261ef43d29c5c10451679cf6b7c39ecb4 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Wed, 31 Jul 2019 18:35:43 -0400 Subject: [PATCH 136/297] Rescaled pressure gradient accelerations Applied dimensional rescaling to the pressure gradient accelerations, PFu and PFv, that are returned from PressureForce, into [L T-2]. For now the rescaling is done at the end of PressureForce, and not inside the various routines that it selects among. All answers are bitwise identical, but the units of the arguments to a public routine have changed. --- src/core/MOM_PressureForce.F90 | 17 +++++++++++++++-- src/core/MOM_checksum_packages.F90 | 6 +++--- src/core/MOM_dynamics_split_RK2.F90 | 18 +++++++----------- src/core/MOM_dynamics_unsplit.F90 | 18 +++++++++--------- src/core/MOM_dynamics_unsplit_RK2.F90 | 18 +++++++++--------- src/core/MOM_variables.F90 | 8 ++++---- src/diagnostics/MOM_PointAccel.F90 | 8 ++++---- src/diagnostics/MOM_diagnostics.F90 | 4 ++-- 8 files changed, 53 insertions(+), 44 deletions(-) diff --git a/src/core/MOM_PressureForce.F90 b/src/core/MOM_PressureForce.F90 index 183817bf42..6b223c8ca8 100644 --- a/src/core/MOM_PressureForce.F90 +++ b/src/core/MOM_PressureForce.F90 @@ -52,9 +52,9 @@ subroutine PressureForce(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_atm, pbce, e intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various thermodynamic variables real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & - intent(out) :: PFu !< Zonal pressure force acceleration [m s-2] + intent(out) :: PFu !< Zonal pressure force acceleration [L T-2 ~> m s-2] real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - intent(out) :: PFv !< Meridional pressure force acceleration [m s-2] + intent(out) :: PFv !< Meridional pressure force acceleration [L T-2 ~> m s-2] type(PressureForce_CS), pointer :: CS !< Pressure force control structure type(ALE_CS), pointer :: ALE_CSp !< ALE control structure real, dimension(:,:), & @@ -67,6 +67,11 @@ subroutine PressureForce(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_atm, pbce, e optional, intent(out) :: eta !< The bottom mass used to calculate PFu and PFv, !! [H ~> m or kg m-2], with any tidal contributions. + integer :: is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz + integer :: i, j, k + 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 + if (CS%Analytic_FV_PGF .and. CS%blocked_AFV) then if (GV%Boussinesq) then call PressureForce_blk_AFV_Bouss(h, tv, PFu, PFv, G, GV, US, & @@ -93,6 +98,14 @@ subroutine PressureForce(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_atm, pbce, e endif endif + !### Move this into the various routines above. + do k=1,nz ; do j=js,je ; do I=Isq,Ieq + PFu(I,j,k) = US%m_to_L*US%T_to_s**2 * PFu(I,j,k) + enddo ; enddo ; enddo + do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie + PFv(i,J,k) = US%m_to_L*US%T_to_s**2 * PFv(i,J,k) + enddo ; enddo ; enddo + end subroutine Pressureforce !> Initialize the pressure force control structure diff --git a/src/core/MOM_checksum_packages.F90 b/src/core/MOM_checksum_packages.F90 index 662ac963c0..195b4061d7 100644 --- a/src/core/MOM_checksum_packages.F90 +++ b/src/core/MOM_checksum_packages.F90 @@ -173,10 +173,10 @@ subroutine MOM_accel_chksum(mesg, CAu, CAv, PFu, PFv, diffu, diffv, G, GV, US, p !! and momentum advection terms [L T-2 ~> m s-2]. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & intent(in) :: PFu !< Zonal acceleration due to pressure gradients - !! (equal to -dM/dx) [m s-2]. + !! (equal to -dM/dx) [L T-2 ~> m s-2]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & intent(in) :: PFv !< Meridional acceleration due to pressure gradients - !! (equal to -dM/dy) [m s-2]. + !! (equal to -dM/dy) [L T-2 ~> 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-1 T-1 ~> m s-2]. @@ -207,7 +207,7 @@ subroutine MOM_accel_chksum(mesg, CAu, CAv, PFu, PFv, diffu, diffv, G, GV, US, p ! counts, there must be no redundant points, so all variables use is..ie ! and js...je as their extent. call uvchksum(mesg//" CA[uv]", CAu, CAv, G%HI, haloshift=0, symmetric=sym, scale=US%L_T2_to_m_s2) - call uvchksum(mesg//" PF[uv]", PFu, PFv, G%HI, haloshift=0, symmetric=sym) + call uvchksum(mesg//" PF[uv]", PFu, PFv, G%HI, haloshift=0, symmetric=sym, scale=US%L_T2_to_m_s2) 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) diff --git a/src/core/MOM_dynamics_split_RK2.F90 b/src/core/MOM_dynamics_split_RK2.F90 index b4f064ed41..d219433380 100644 --- a/src/core/MOM_dynamics_split_RK2.F90 +++ b/src/core/MOM_dynamics_split_RK2.F90 @@ -75,7 +75,7 @@ module MOM_dynamics_split_RK2 real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_,NKMEM_) :: & CAv, & !< CAv = -f*u - u.grad(v) [L T-2 ~> m s-2] - PFv, & !< PFv = -dM/dy [m s-2] + PFv, & !< PFv = -dM/dy [L T-2 ~> 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 @@ -449,12 +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) = US%m_s_to_L_T*US%T_to_s*((US%L_T2_to_m_s2*CS%CAu(I,j,k) + CS%PFu(I,j,k)) + & - US%s_to_T*CS%diffu(I,j,k)) + u_bc_accel(I,j,k) = (CS%CAu(I,j,k) + CS%PFu(I,j,k)) + US%m_s_to_L_T*CS%diffu(I,j,k) enddo ; enddo do J=Jsq,Jeq ; do i=is,ie - v_bc_accel(i,J,k) = US%m_s_to_L_T*US%T_to_s*((US%L_T2_to_m_s2*CS%CAv(i,J,k) + CS%PFv(i,J,k)) + & - US%s_to_T*CS%diffv(i,J,k)) + v_bc_accel(i,J,k) = (CS%CAv(i,J,k) + CS%PFv(i,J,k)) + US%m_s_to_L_T*CS%diffv(i,J,k) enddo ; enddo enddo if (associated(CS%OBC)) then @@ -709,12 +707,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) = US%m_s_to_L_T*US%T_to_s*((US%L_T2_to_m_s2*CS%Cau(I,j,k) + CS%PFu(I,j,k)) + & - US%s_to_T*CS%diffu(I,j,k)) + u_bc_accel(I,j,k) = (CS%Cau(I,j,k) + CS%PFu(I,j,k)) + US%m_s_to_L_T*CS%diffu(I,j,k) enddo ; enddo do J=Jsq,Jeq ; do i=is,ie - v_bc_accel(i,J,k) = US%m_s_to_L_T*US%T_to_s*((US%L_T2_to_m_s2*CS%Cav(i,J,k) + CS%PFv(i,J,k)) + & - US%s_to_T*CS%diffv(i,J,k)) + v_bc_accel(i,J,k) = (CS%Cav(i,J,k) + CS%PFv(i,J,k)) + US%m_s_to_L_T*CS%diffv(i,J,k) enddo ; enddo enddo if (associated(CS%OBC)) then @@ -1205,9 +1201,9 @@ subroutine initialize_dyn_split_RK2(u, v, h, uh, vh, eta, Time, G, GV, US, param CS%id_CAv = register_diag_field('ocean_model', 'CAv', diag%axesCvL, Time, & 'Meridional Coriolis and Advective Acceleration', 'm s-2', conversion=US%L_T2_to_m_s2) CS%id_PFu = register_diag_field('ocean_model', 'PFu', diag%axesCuL, Time, & - 'Zonal Pressure Force Acceleration', 'm s-2') + 'Zonal Pressure Force Acceleration', 'm s-2', conversion=US%L_T2_to_m_s2) CS%id_PFv = register_diag_field('ocean_model', 'PFv', diag%axesCvL, Time, & - 'Meridional Pressure Force Acceleration', 'm s-2') + 'Meridional Pressure Force Acceleration', 'm s-2', conversion=US%L_T2_to_m_s2) CS%id_uav = register_diag_field('ocean_model', 'uav', diag%axesCuL, Time, & 'Barotropic-step Averaged Zonal Velocity', 'm s-1') diff --git a/src/core/MOM_dynamics_unsplit.F90 b/src/core/MOM_dynamics_unsplit.F90 index 3c146b7b62..6588bd0154 100644 --- a/src/core/MOM_dynamics_unsplit.F90 +++ b/src/core/MOM_dynamics_unsplit.F90 @@ -113,7 +113,7 @@ module MOM_dynamics_unsplit real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_,NKMEM_) :: & CAv, & !< CAv = -f*u - u.grad(v) [L T-2 ~> m s-2]. - PFv, & !< PFv = -dM/dy [m s-2]. + PFv, & !< PFv = -dM/dy [L T-2 ~> 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) @@ -324,11 +324,11 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & 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(I,j,k) + dt_pred * & - (CS%PFu(I,j,k) + US%L_T2_to_m_s2*CS%CAu(I,j,k))) + US%L_T2_to_m_s2*(CS%PFu(I,j,k) + CS%CAu(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(i,J,k) + dt_pred * & - (CS%PFv(i,J,k) + US%L_T2_to_m_s2*CS%CAv(i,J,k))) + US%L_T2_to_m_s2*(CS%PFv(i,J,k) + CS%CAv(i,J,k))) enddo ; enddo ; enddo call cpu_clock_end(id_clock_mom_update) @@ -391,11 +391,11 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & call cpu_clock_begin(id_clock_mom_update) do k=1,nz ; do j=js,je ; do I=Isq,Ieq upp(I,j,k) = G%mask2dCu(I,j) * (u(I,j,k) + dt * 0.5 * & - (CS%PFu(I,j,k) + US%L_T2_to_m_s2*CS%CAu(I,j,k))) + US%L_T2_to_m_s2*(CS%PFu(I,j,k) + CS%CAu(I,j,k))) enddo ; enddo ; enddo do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie vpp(i,J,k) = G%mask2dCv(i,J) * (v(i,J,k) + dt * 0.5 * & - (CS%PFv(i,J,k) + US%L_T2_to_m_s2*CS%CAv(i,J,k))) + US%L_T2_to_m_s2*(CS%PFv(i,J,k) + CS%CAv(i,J,k))) enddo ; enddo ; enddo call cpu_clock_end(id_clock_mom_update) @@ -468,11 +468,11 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & endif do k=1,nz ; do j=js,je ; do I=Isq,Ieq u(I,j,k) = G%mask2dCu(I,j) * (u(I,j,k) + dt * & - (CS%PFu(I,j,k) + US%L_T2_to_m_s2*CS%CAu(I,j,k))) + US%L_T2_to_m_s2*(CS%PFu(I,j,k) + CS%CAu(I,j,k))) enddo ; enddo ; enddo do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie v(i,J,k) = G%mask2dCv(i,J) * (v(i,J,k) + dt * & - (CS%PFv(i,J,k) + US%L_T2_to_m_s2*CS%CAv(i,J,k))) + US%L_T2_to_m_s2*(CS%PFv(i,J,k) + CS%CAv(i,J,k))) enddo ; enddo ; enddo ! u <- u + dt d/dz visc d/dz u @@ -676,9 +676,9 @@ subroutine initialize_dyn_unsplit(u, v, h, Time, G, GV, US, param_file, diag, CS CS%id_CAv = register_diag_field('ocean_model', 'CAv', diag%axesCvL, Time, & 'Meridional Coriolis and Advective Acceleration', 'meter second-2', conversion=US%L_T2_to_m_s2) CS%id_PFu = register_diag_field('ocean_model', 'PFu', diag%axesCuL, Time, & - 'Zonal Pressure Force Acceleration', 'meter second-2') + 'Zonal Pressure Force Acceleration', 'meter second-2', conversion=US%L_T2_to_m_s2) CS%id_PFv = register_diag_field('ocean_model', 'PFv', diag%axesCvL, Time, & - 'Meridional Pressure Force Acceleration', 'meter second-2') + 'Meridional Pressure Force Acceleration', 'meter second-2', conversion=US%L_T2_to_m_s2) id_clock_Cor = cpu_clock_id('(Ocean Coriolis & mom advection)', grain=CLOCK_MODULE) id_clock_continuity = cpu_clock_id('(Ocean continuity equation)', grain=CLOCK_MODULE) diff --git a/src/core/MOM_dynamics_unsplit_RK2.F90 b/src/core/MOM_dynamics_unsplit_RK2.F90 index b3094d12b5..65413be92d 100644 --- a/src/core/MOM_dynamics_unsplit_RK2.F90 +++ b/src/core/MOM_dynamics_unsplit_RK2.F90 @@ -110,7 +110,7 @@ module MOM_dynamics_unsplit_RK2 real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_,NKMEM_) :: & CAv, & !< CAv = -f*u - u.grad(v) [L T-2 ~> m s-2]. - PFv, & !< PFv = -dM/dy [m s-2]. + PFv, & !< PFv = -dM/dy [L T-2 ~> 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) @@ -322,11 +322,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) + US%L_T2_to_m_s2*CS%CAu(I,j,k)) + US%s_to_T*CS%diffu(I,j,k))) + (US%L_T2_to_m_s2*(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) + US%L_T2_to_m_s2*CS%CAv(i,J,k)) + US%s_to_T*CS%diffv(i,J,k))) + (US%L_T2_to_m_s2*(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) @@ -378,15 +378,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) + US%L_T2_to_m_s2*CS%CAu(I,j,k)) + US%s_to_T*CS%diffu(I,j,k))) + (US%L_T2_to_m_s2*(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) + US%L_T2_to_m_s2*CS%CAu(I,j,k)) + US%s_to_T*CS%diffu(I,j,k))) + (US%L_T2_to_m_s2*(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) + US%L_T2_to_m_s2*CS%CAv(i,J,k)) + US%s_to_T*CS%diffv(i,J,k))) + (US%L_T2_to_m_s2*(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) + US%L_T2_to_m_s2*CS%CAv(i,J,k)) + US%s_to_T*CS%diffv(i,J,k))) + (US%L_T2_to_m_s2*(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 @@ -635,9 +635,9 @@ subroutine initialize_dyn_unsplit_RK2(u, v, h, Time, G, GV, US, param_file, diag CS%id_CAv = register_diag_field('ocean_model', 'CAv', diag%axesCvL, Time, & 'Meridional Coriolis and Advective Acceleration', 'meter second-2', conversion=US%L_T2_to_m_s2) CS%id_PFu = register_diag_field('ocean_model', 'PFu', diag%axesCuL, Time, & - 'Zonal Pressure Force Acceleration', 'meter second-2') + 'Zonal Pressure Force Acceleration', 'meter second-2', conversion=US%L_T2_to_m_s2) CS%id_PFv = register_diag_field('ocean_model', 'PFv', diag%axesCvL, Time, & - 'Meridional Pressure Force Acceleration', 'meter second-2') + 'Meridional Pressure Force Acceleration', 'meter second-2', conversion=US%L_T2_to_m_s2) id_clock_Cor = cpu_clock_id('(Ocean Coriolis & mom advection)', grain=CLOCK_MODULE) id_clock_continuity = cpu_clock_id('(Ocean continuity equation)', grain=CLOCK_MODULE) diff --git a/src/core/MOM_variables.F90 b/src/core/MOM_variables.F90 index 477a68aa3f..5ee7cd9056 100644 --- a/src/core/MOM_variables.F90 +++ b/src/core/MOM_variables.F90 @@ -136,8 +136,8 @@ module MOM_variables real, pointer, dimension(:,:,:) :: & CAu => NULL(), & !< Pointer to the zonal Coriolis and Advective acceleration [m s-2] 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] + PFu => NULL(), & !< Pointer to the zonal Pressure force acceleration [L T-2 ~> m s-2] + PFv => NULL(), & !< Pointer to the meridional Pressure force acceleration [L T-2 ~> 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 @@ -160,8 +160,8 @@ module MOM_variables 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 [L T-2 ~> m s-2] CAv => NULL(), & !< Meridional Coriolis and momentum advection accelerations [L T-2 ~> m s-2] - PFu => NULL(), & !< Zonal acceleration due to pressure forces [m s-2] - PFv => NULL(), & !< Meridional acceleration due to pressure forces [m s-2] + PFu => NULL(), & !< Zonal acceleration due to pressure forces [L T-2 ~> m s-2] + PFv => NULL(), & !< Meridional acceleration due to pressure forces [L T-2 ~> m s-2] du_dt_visc => NULL(), &!< Zonal acceleration due to vertical viscosity [m s-2] dv_dt_visc => NULL(), &!< Meridional acceleration due to vertical viscosity [m s-2] du_dt_dia => NULL(), & !< Zonal acceleration due to diapycnal mixing [m s-2] diff --git a/src/diagnostics/MOM_PointAccel.F90 b/src/diagnostics/MOM_PointAccel.F90 index f21303e0a8..6dce366ab5 100644 --- a/src/diagnostics/MOM_PointAccel.F90 +++ b/src/diagnostics/MOM_PointAccel.F90 @@ -190,7 +190,7 @@ subroutine write_u_accel(I, j, um, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st write(file,'(/,"CAu: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (dt*US%L_T2_to_m_s2*ADp%CAu(I,j,k)); enddo write(file,'(/,"PFu: ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (dt*ADp%PFu(I,j,k)); enddo + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (dt*US%L_T2_to_m_s2*ADp%PFu(I,j,k)); enddo write(file,'(/,"diffu: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (dt*US%s_to_T*ADp%diffu(I,j,k)); enddo @@ -354,7 +354,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,'(F10.6," ",$)') & - (dt*ADp%PFu(I,j,k)*Inorm(k)); enddo + (dt*US%L_T2_to_m_s2*ADp%PFu(I,j,k)*Inorm(k)); enddo write(file,'(/,"diffu: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(F10.6," ",$)') & @@ -523,7 +523,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*US%L_T2_to_m_s2*ADp%CAv(i,J,k)); enddo write(file,'(/,"PFv: ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (dt*ADp%PFv(i,J,k)); enddo + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (dt*US%L_T2_to_m_s2*ADp%PFv(i,J,k)); enddo write(file,'(/,"diffv: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (dt*US%s_to_T*ADp%diffv(i,J,k)); enddo @@ -685,7 +685,7 @@ subroutine write_v_accel(i, J, vm, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st (dt*US%L_T2_to_m_s2*ADp%CAv(i,J,k)*Inorm(k)); enddo write(file,'(/,"PFv: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(F10.6," ",$)') & - (dt*ADp%PFv(i,J,k)*Inorm(k)); enddo + (dt*US%L_T2_to_m_s2*ADp%PFv(i,J,k)*Inorm(k)); enddo write(file,'(/,"diffv: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(F10.6," ",$)') & (dt*US%s_to_T*ADp%diffv(i,J,k)*Inorm(k)); enddo diff --git a/src/diagnostics/MOM_diagnostics.F90 b/src/diagnostics/MOM_diagnostics.F90 index 1505d3dc8f..dd9e1b3bb4 100644 --- a/src/diagnostics/MOM_diagnostics.F90 +++ b/src/diagnostics/MOM_diagnostics.F90 @@ -957,10 +957,10 @@ subroutine calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, GV, US, CS if (associated(CS%PE_to_KE)) then do k=1,nz do j=js,je ; do I=Isq,Ieq - KE_u(I,j) = US%s_to_T*uh(I,j,k)*G%dxCu(I,j)*ADp%PFu(I,j,k) + KE_u(I,j) = US%L_T_to_m_s**2*US%s_to_T*uh(I,j,k)*US%m_to_L*G%dxCu(I,j)*ADp%PFu(I,j,k) enddo ; enddo do J=Jsq,Jeq ; do i=is,ie - KE_v(i,J) = US%s_to_T*vh(i,J,k)*G%dyCv(i,J)*ADp%PFv(i,J,k) + KE_v(i,J) = US%L_T_to_m_s**2*US%s_to_T*vh(i,J,k)*US%m_to_L*G%dyCv(i,J)*ADp%PFv(i,J,k) enddo ; enddo if (.not.G%symmetric) & call do_group_pass(CS%pass_KE_uv, G%domain) From 3db3085d8520e1b0382854451658bc809b6bd6b6 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Thu, 1 Aug 2019 07:19:21 -0400 Subject: [PATCH 137/297] +Relocated rescaling of pressure gradient terms Moved rescaling of pressure gradient accelerations into the 6 separate PressureForce subroutines, including rescaling of the Montgomery potential. All answers are bitwise identical, but the dimensions of the pressure gradient acceleration have been rescaled. --- src/core/MOM_PressureForce.F90 | 13 --- src/core/MOM_PressureForce_Montgomery.F90 | 93 +++++++++++----------- src/core/MOM_PressureForce_analytic_FV.F90 | 52 ++++++------ src/core/MOM_PressureForce_blocked_AFV.F90 | 44 +++++----- 4 files changed, 95 insertions(+), 107 deletions(-) diff --git a/src/core/MOM_PressureForce.F90 b/src/core/MOM_PressureForce.F90 index 6b223c8ca8..5579b2311f 100644 --- a/src/core/MOM_PressureForce.F90 +++ b/src/core/MOM_PressureForce.F90 @@ -67,11 +67,6 @@ subroutine PressureForce(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_atm, pbce, e optional, intent(out) :: eta !< The bottom mass used to calculate PFu and PFv, !! [H ~> m or kg m-2], with any tidal contributions. - integer :: is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz - integer :: i, j, k - 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 - if (CS%Analytic_FV_PGF .and. CS%blocked_AFV) then if (GV%Boussinesq) then call PressureForce_blk_AFV_Bouss(h, tv, PFu, PFv, G, GV, US, & @@ -98,14 +93,6 @@ subroutine PressureForce(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_atm, pbce, e endif endif - !### Move this into the various routines above. - do k=1,nz ; do j=js,je ; do I=Isq,Ieq - PFu(I,j,k) = US%m_to_L*US%T_to_s**2 * PFu(I,j,k) - enddo ; enddo ; enddo - do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie - PFv(i,J,k) = US%m_to_L*US%T_to_s**2 * PFv(i,J,k) - enddo ; enddo ; enddo - end subroutine Pressureforce !> Initialize the pressure force control structure diff --git a/src/core/MOM_PressureForce_Montgomery.F90 b/src/core/MOM_PressureForce_Montgomery.F90 index 2c143baab1..05ac089c34 100644 --- a/src/core/MOM_PressureForce_Montgomery.F90 +++ b/src/core/MOM_PressureForce_Montgomery.F90 @@ -40,9 +40,10 @@ module MOM_PressureForce_Mont 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. - real, pointer :: PFu_bc(:,:,:) => NULL() !< Accelerations due to pressure - real, pointer :: PFv_bc(:,:,:) => NULL() !< gradients deriving from density - !! gradients within layers [m s-2]. + real, pointer :: PFu_bc(:,:,:) => NULL() !< Zonal accelerations due to pressure gradients + !! deriving from density gradients within layers [L T-2 ~> m s-2]. + real, pointer :: PFv_bc(:,:,:) => NULL() !< Meridional accelerations due to pressure gradients + !! deriving from density gradients within layers [L T-2 ~> m s-2]. !>@{ Diagnostic IDs integer :: id_PFu_bc = -1, id_PFv_bc = -1, id_e_tidal = -1 !!@} @@ -67,9 +68,9 @@ subroutine PressureForce_Mont_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, pb real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness, [H ~> kg m-2]. type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamic variables. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(out) :: PFu !< Zonal acceleration due to pressure gradients - !! (equal to -dM/dx) [m s-2]. + !! (equal to -dM/dx) [L T-2 ~> m s-2]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(out) :: PFv !< Meridional acceleration due to pressure gradients - !! (equal to -dM/dy) [m s-2]. + !! (equal to -dM/dy) [L T-2 ~> m s-2]. type(PressureForce_Mont_CS), pointer :: CS !< Control structure for Montgomery potential PGF real, dimension(:,:), optional, pointer :: p_atm !< The pressure at the ice-ocean or !! atmosphere-ocean [Pa]. @@ -81,7 +82,7 @@ subroutine PressureForce_Mont_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, pb ! Local variables real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: & - M, & ! The Montgomery potential, M = (p/rho + gz) [m2 s-2]. + M, & ! The Montgomery potential, M = (p/rho + gz) [L2 T-2 ~> m2 s-2]. alpha_star, & ! Compression adjusted specific volume [m3 kg-1]. dz_geo ! The change in geopotential across a layer [m2 s-2]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1) :: p ! Interface pressure [Pa]. @@ -106,12 +107,12 @@ subroutine PressureForce_Mont_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, pb e_tidal, & ! Bottom geopotential anomaly due to tidal forces from ! astronomical sources and self-attraction and loading [Z ~> m]. geopot_bot ! Bottom geopotential relative to time-mean sea level, - ! including any tidal contributions [m2 s-2]. + ! including any tidal contributions [L2 T-2 ~> m2 s-2]. real :: p_ref(SZI_(G)) ! The pressure used to calculate the coordinate ! density [Pa] (usually 2e7 Pa = 2000 dbar). real :: rho_in_situ(SZI_(G)) !In-situ density of a layer [kg m-3]. real :: PFu_bc, PFv_bc ! The pressure gradient force due to along-layer - ! compensated density gradients [m s-2] + ! compensated density gradients [L T-2 ~> m s-2] real :: dp_neglect ! A thickness that is so small it is usually lost ! in roundoff and can be neglected [Pa]. logical :: use_p_atm ! If true, use the atmospheric pressure. @@ -206,12 +207,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%g_Earth*(e_tidal(i,j) + G%bathyT(i,j)) + geopot_bot(i,j) = -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%g_Earth*G%bathyT(i,j) + geopot_bot(i,j) = -GV%g_Earth*G%bathyT(i,j) enddo ; enddo endif @@ -258,20 +259,20 @@ subroutine PressureForce_Mont_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, pb !$OMP parallel do default(shared) do j=Jsq,Jeq+1 do i=Isq,Ieq+1 - M(i,j,nz) = geopot_bot(i,j) + p(i,j,nz+1) * alpha_star(i,j,nz) + M(i,j,nz) = geopot_bot(i,j) + US%m_s_to_L_T**2*p(i,j,nz+1) * alpha_star(i,j,nz) enddo do k=nz-1,1,-1 ; do i=Isq,Ieq+1 - M(i,j,k) = M(i,j,k+1) + p(i,j,K+1) * (alpha_star(i,j,k) - alpha_star(i,j,k+1)) + M(i,j,k) = M(i,j,k+1) + US%m_s_to_L_T**2*p(i,j,K+1) * (alpha_star(i,j,k) - alpha_star(i,j,k+1)) enddo ; enddo enddo else ! not use_EOS !$OMP parallel do default(shared) do j=Jsq,Jeq+1 do i=Isq,Ieq+1 - M(i,j,nz) = geopot_bot(i,j) + p(i,j,nz+1) * alpha_Lay(nz) + M(i,j,nz) = geopot_bot(i,j) + US%m_s_to_L_T**2*p(i,j,nz+1) * alpha_Lay(nz) enddo do k=nz-1,1,-1 ; do i=Isq,Ieq+1 - M(i,j,k) = M(i,j,k+1) + p(i,j,K+1) * dalpha_int(K+1) + M(i,j,k) = M(i,j,k+1) + US%m_s_to_L_T**2*p(i,j,K+1) * dalpha_int(K+1) enddo ; enddo enddo endif ! use_EOS @@ -294,11 +295,11 @@ subroutine PressureForce_Mont_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, pb ! enddo ; enddo ! if (use_EOS) then ! do k=2,nz ; do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 -! M(i,j,k) = M(i,j,k-1) - p(i,j,K) * (alpha_star(i,j,k-1) - alpha_star(i,j,k)) +! M(i,j,k) = M(i,j,k-1) - US%m_s_to_L_T**2*p(i,j,K) * (alpha_star(i,j,k-1) - alpha_star(i,j,k)) ! enddo ; enddo ; enddo ! else ! not use_EOS ! do k=2,nz ; do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 -! M(i,j,k) = M(i,j,k-1) - p(i,j,K) * dalpha_int(K) +! M(i,j,k) = M(i,j,k-1) - US%m_s_to_L_T**2*p(i,j,K) * dalpha_int(K) ! enddo ; enddo ; enddo ! endif ! use_EOS @@ -319,17 +320,17 @@ subroutine PressureForce_Mont_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, pb enddo ; enddo do j=js,je ; do I=Isq,Ieq ! PFu_bc = p* grad alpha* - PFu_bc = (alpha_star(i+1,j,k) - alpha_star(i,j,k)) * (G%IdxCu(I,j) * & + PFu_bc = US%m_s_to_L_T**2*(alpha_star(i+1,j,k) - alpha_star(i,j,k)) * (US%L_to_m*G%IdxCu(I,j) * & ((dp_star(i,j) * dp_star(i+1,j) + (p(i,j,K) * dp_star(i+1,j) + & p(i+1,j,K) * dp_star(i,j))) / (dp_star(i,j) + dp_star(i+1,j)))) - PFu(I,j,k) = -(M(i+1,j,k) - M(i,j,k)) * G%IdxCu(I,j) + PFu_bc + PFu(I,j,k) = -(M(i+1,j,k) - M(i,j,k)) * US%L_to_m*G%IdxCu(I,j) + PFu_bc if (associated(CS%PFu_bc)) CS%PFu_bc(i,j,k) = PFu_bc enddo ; enddo do J=Jsq,Jeq ; do i=is,ie - PFv_bc = (alpha_star(i,j+1,k) - alpha_star(i,j,k)) * (G%IdyCv(i,J) * & + PFv_bc = US%m_s_to_L_T**2*(alpha_star(i,j+1,k) - alpha_star(i,j,k)) * (US%L_to_m*G%IdyCv(i,J) * & ((dp_star(i,j) * dp_star(i,j+1) + (p(i,j,K) * dp_star(i,j+1) + & p(i,j+1,K) * dp_star(i,j))) / (dp_star(i,j) + dp_star(i,j+1)))) - PFv(i,J,k) = -(M(i,j+1,k) - M(i,j,k)) * G%IdyCv(i,J) + PFv_bc + PFv(i,J,k) = -(M(i,j+1,k) - M(i,j,k)) * US%L_to_m*G%IdyCv(i,J) + PFv_bc if (associated(CS%PFv_bc)) CS%PFv_bc(i,j,k) = PFv_bc enddo ; enddo enddo ! k-loop @@ -337,10 +338,10 @@ subroutine PressureForce_Mont_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, pb !$OMP parallel do default(shared) do k=1,nz do j=js,je ; do I=Isq,Ieq - PFu(I,j,k) = -(M(i+1,j,k) - M(i,j,k)) * G%IdxCu(I,j) + PFu(I,j,k) = -(M(i+1,j,k) - M(i,j,k)) * US%L_to_m*G%IdxCu(I,j) enddo ; enddo do J=Jsq,Jeq ; do i=is,ie - PFv(i,J,k) = -(M(i,j+1,k) - M(i,j,k)) * G%IdyCv(i,J) + PFv(i,J,k) = -(M(i,j+1,k) - M(i,j,k)) * US%L_to_m*G%IdyCv(i,J) enddo ; enddo enddo endif ! use_EOS @@ -365,9 +366,9 @@ subroutine PressureForce_Mont_Bouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, pbce, real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness [H ~> m]. type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamic variables. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(out) :: PFu !< Zonal acceleration due to pressure gradients - !! (equal to -dM/dx) [m s-2]. + !! (equal to -dM/dx) [L T-2 ~> m s-2]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(out) :: PFv !< Meridional acceleration due to pressure gradients - !! (equal to -dM/dy) [m s2]. + !! (equal to -dM/dy) [L T-2 ~> m s2]. type(PressureForce_Mont_CS), pointer :: CS !< Control structure for Montgomery potential PGF real, dimension(:,:), optional, pointer :: p_atm !< The pressure at the ice-ocean or !! atmosphere-ocean [Pa]. @@ -377,7 +378,7 @@ subroutine PressureForce_Mont_Bouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, pbce, real, dimension(SZI_(G),SZJ_(G)), optional, intent(out) :: eta !< Free surface height [H ~> m]. ! Local variables real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: & - M, & ! The Montgomery potential, M = (p/rho + gz) [m2 s-2]. + M, & ! The Montgomery potential, M = (p/rho + gz) [L2 T-2 ~> m2 s-2]. rho_star ! In-situ density divided by the derivative with depth of the ! corrected e times (G_Earth/Rho0) [m2 Z-1 s-2 ~> m s-2]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1) :: e ! Interface height in m. @@ -400,10 +401,9 @@ subroutine PressureForce_Mont_Bouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, pbce, real :: p_ref(SZI_(G)) ! The pressure used to calculate the coordinate ! density [Pa] (usually 2e7 Pa = 2000 dbar). real :: I_Rho0 ! 1/Rho0 [m3 kg-1]. - real :: G_Rho0 ! G_Earth / Rho0 [m5 Z-1 s-2 kg-1 ~> m4 s-2 kg-1]. + real :: G_Rho0 ! G_Earth / Rho0 [L2 m3 Z-1 T-2 kg-1 ~> m4 s-2 kg-1]. real :: PFu_bc, PFv_bc ! The pressure gradient force due to along-layer - ! compensated density gradients [m s-2] -! real :: dr ! Temporary variables. + ! compensated density gradients [L T-2 ~> m s-2] real :: h_neglect ! A thickness that is so small it is usually lost ! in roundoff and can be neglected [Z ~> m]. logical :: use_p_atm ! If true, use the atmospheric pressure. @@ -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%g_Earth/GV%Rho0 + G_Rho0 = GV%g_Earth/GV%Rho0 if (CS%tides) then ! Determine the surface height anomaly for calculating self attraction @@ -520,7 +520,7 @@ subroutine PressureForce_Mont_Bouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, pbce, do j=Jsq,Jeq+1 do i=Isq,Ieq+1 M(i,j,1) = CS%GFS_scale * (rho_star(i,j,1) * e(i,j,1)) - if (use_p_atm) M(i,j,1) = M(i,j,1) + p_atm(i,j) * I_Rho0 + if (use_p_atm) M(i,j,1) = M(i,j,1) + US%m_s_to_L_T**2*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) + (rho_star(i,j,k) - rho_star(i,j,k-1)) * e(i,j,K) @@ -530,11 +530,11 @@ 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) = 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 + M(i,j,1) = GV%g_prime(1) * e(i,j,1) + if (use_p_atm) M(i,j,1) = M(i,j,1) + US%m_s_to_L_T**2*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) + US%L_to_m**2*US%s_to_T**2*GV%g_prime(K) * e(i,j,K) + M(i,j,k) = M(i,j,k-1) + GV%g_prime(K) * e(i,j,K) enddo ; enddo enddo endif ! use_EOS @@ -552,17 +552,17 @@ subroutine PressureForce_Mont_Bouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, pbce, h_star(i,j) = (e(i,j,K) - e(i,j,K+1)) + h_neglect enddo ; enddo do j=js,je ; do I=Isq,Ieq - PFu_bc = -1.0*(rho_star(i+1,j,k) - rho_star(i,j,k)) * (G%IdxCu(I,j) * & + PFu_bc = -1.0*(rho_star(i+1,j,k) - rho_star(i,j,k)) * (US%L_to_m*G%IdxCu(I,j) * & ((h_star(i,j) * h_star(i+1,j) - (e(i,j,K) * h_star(i+1,j) + & e(i+1,j,K) * h_star(i,j))) / (h_star(i,j) + h_star(i+1,j)))) - PFu(I,j,k) = -(M(i+1,j,k) - M(i,j,k)) * G%IdxCu(I,j) + PFu_bc + PFu(I,j,k) = -(M(i+1,j,k) - M(i,j,k)) * US%L_to_m*G%IdxCu(I,j) + PFu_bc if (associated(CS%PFu_bc)) CS%PFu_bc(i,j,k) = PFu_bc enddo ; enddo do J=Jsq,Jeq ; do i=is,ie - PFv_bc = -1.0*(rho_star(i,j+1,k) - rho_star(i,j,k)) * (G%IdyCv(i,J) * & + PFv_bc = -1.0*(rho_star(i,j+1,k) - rho_star(i,j,k)) * (US%L_to_m*G%IdyCv(i,J) * & ((h_star(i,j) * h_star(i,j+1) - (e(i,j,K) * h_star(i,j+1) + & e(i,j+1,K) * h_star(i,j))) / (h_star(i,j) + h_star(i,j+1)))) - PFv(i,J,k) = -(M(i,j+1,k) - M(i,j,k)) * G%IdyCv(i,J) + PFv_bc + PFv(i,J,k) = -(M(i,j+1,k) - M(i,j,k)) * US%L_to_m*G%IdyCv(i,J) + PFv_bc if (associated(CS%PFv_bc)) CS%PFv_bc(i,j,k) = PFv_bc enddo ; enddo enddo ! k-loop @@ -570,10 +570,10 @@ subroutine PressureForce_Mont_Bouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, pbce, !$OMP parallel do default(shared) do k=1,nz do j=js,je ; do I=Isq,Ieq - PFu(I,j,k) = -(M(i+1,j,k) - M(i,j,k)) * G%IdxCu(I,j) + PFu(I,j,k) = -(M(i+1,j,k) - M(i,j,k)) * US%L_to_m*G%IdxCu(I,j) enddo ; enddo do J=Jsq,Jeq ; do i=is,ie - PFv(i,J,k) = -(M(i,j+1,k) - M(i,j,k)) * G%IdyCv(i,J) + PFv(i,J,k) = -(M(i,j+1,k) - M(i,j,k)) * US%L_to_m*G%IdyCv(i,J) enddo ; enddo enddo endif ! use_EOS @@ -619,7 +619,7 @@ subroutine Set_pbce_Bouss(e, tv, G, GV, US, Rho0, GFS_scale, pbce, rho_star) !! [m2 H-1 s-2 ~> m4 kg-2 s-2]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & optional, intent(in) :: rho_star !< The layer densities (maybe compressibility - !! compensated), times g/rho_0 [m2 Z-1 s-2 ~> m s-2]. + !! compensated), times g/rho_0 [L2 Z-1 T-2 ~> m s-2]. ! Local variables real :: Ihtot(SZI_(G)) ! The inverse of the sum of the layer thicknesses [H-1 ~> m-1 or m2 kg-1]. @@ -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 * US%m_s_to_L_T**2*rho_star(i,j,1) * GV%H_to_Z + pbce(i,j,1) = GFS_scale * 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) + US%m_s_to_L_T**2*(rho_star(i,j,k)-rho_star(i,j,k-1)) * & + pbce(i,j,k) = pbce(i,j,k-1) + (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 @@ -825,10 +825,11 @@ subroutine PressureForce_Mont_init(Time, G, GV, US, param_file, diag, CS, tides_ type(diag_ctrl), target, intent(inout) :: diag !< Diagnostics control structure type(PressureForce_Mont_CS), pointer :: CS !< Montgomery PGF control structure type(tidal_forcing_CS), optional, pointer :: tides_CSp !< Tides control structure + ! Local variables logical :: use_temperature, use_EOS -! 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 ! This module's name. if (associated(CS)) then @@ -857,9 +858,9 @@ subroutine PressureForce_Mont_init(Time, G, GV, US, param_file, diag, CS, tides_ if (use_EOS) then CS%id_PFu_bc = register_diag_field('ocean_model', 'PFu_bc', diag%axesCuL, Time, & - 'Density Gradient Zonal Pressure Force Accel.', "meter second-2") + 'Density Gradient Zonal Pressure Force Accel.', "meter second-2", conversion=US%L_T2_to_m_s2) CS%id_PFv_bc = register_diag_field('ocean_model', 'PFv_bc', diag%axesCvL, Time, & - 'Density Gradient Meridional Pressure Force Accel.', "meter second-2") + 'Density Gradient Meridional Pressure Force Accel.', "meter second-2", conversion=US%L_T2_to_m_s2) if (CS%id_PFu_bc > 0) then call safe_alloc_ptr(CS%PFu_bc,G%IsdB,G%IedB,G%jsd,G%jed,G%ke) CS%PFu_bc(:,:,:) = 0.0 diff --git a/src/core/MOM_PressureForce_analytic_FV.F90 b/src/core/MOM_PressureForce_analytic_FV.F90 index d23b343cf4..e4710a42a8 100644 --- a/src/core/MOM_PressureForce_analytic_FV.F90 +++ b/src/core/MOM_PressureForce_analytic_FV.F90 @@ -69,8 +69,8 @@ subroutine PressureForce_AFV(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_atm, pbc type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness [H ~> m or kg m-2] type(thermo_var_ptrs), intent(inout) :: tv !< Thermodynamic variables - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(out) :: PFu !< Zonal acceleration [m s-2] - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(out) :: PFv !< Meridional acceleration [m s-2] + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(out) :: PFu !< Zonal acceleration [L T-2 ~> m s-2] + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(out) :: PFv !< Meridional acceleration [L T-2 ~> m s-2] type(PressureForce_AFV_CS), pointer :: CS !< Finite volume PGF control structure type(ALE_CS), pointer :: ALE_CSp !< ALE control structure real, dimension(:,:), optional, pointer :: p_atm !< The pressure at the ice-ocean @@ -105,8 +105,8 @@ subroutine PressureForce_AFV_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness [H ~> kg/m2] type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamic variables - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(out) :: PFu !< Zonal acceleration [m s-2] - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(out) :: PFv !< Meridional acceleration [m s-2] + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(out) :: PFu !< Zonal acceleration [L T-2 ~> m s-2] + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(out) :: PFv !< Meridional acceleration [L T-2 ~> m s-2] type(PressureForce_AFV_CS), pointer :: CS !< Finite volume PGF control structure type(ALE_CS), pointer :: ALE_CSp !< ALE control structure real, dimension(:,:), optional, pointer :: p_atm !< The pressure at the ice-ocean @@ -140,7 +140,7 @@ subroutine PressureForce_AFV_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p e_tidal, & ! The bottom geopotential anomaly due to tidal forces from ! astronomical sources and self-attraction and loading [Z ~> m]. dM, & ! The barotropic adjustment to the Montgomery potential to - ! account for a reduced gravity model [m2 s-2]. + ! account for a reduced gravity model [L2 T-2 ~> m2 s-2]. za ! The geopotential anomaly (i.e. g*e + alpha_0*pressure) at the ! interface atop a layer [m2 s-2]. @@ -341,14 +341,14 @@ subroutine PressureForce_AFV_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p rho_in_situ, Isq, Ieq-Isq+2, tv%eqn_of_state) do i=Isq,Ieq+1 - dM(i,j) = (CS%GFS_scale - 1.0) * & + dM(i,j) = (CS%GFS_scale - 1.0) * US%m_s_to_L_T**2 * & (p(i,j,1)*(1.0/rho_in_situ(i) - alpha_ref) + za(i,j)) enddo enddo else !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - dM(i,j) = (CS%GFS_scale - 1.0) * & + dM(i,j) = (CS%GFS_scale - 1.0) * US%m_s_to_L_T**2 * & (p(i,j,1)*(1.0/GV%Rlay(1) - alpha_ref) + za(i,j)) enddo ; enddo endif @@ -384,8 +384,8 @@ subroutine PressureForce_AFV_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p (za(i+1,j)*dp(i+1,j) + intp_dza(i+1,j,k))) + & ((dp(i+1,j) - dp(i,j)) * intx_za(I,j) - & (p(i+1,j,K) - p(i,j,K)) * intx_dza(I,j,k))) * & - (2.0*G%IdxCu(I,j) / ((dp(i,j) + dp(i+1,j)) + & - dp_neglect)) + (US%m_s_to_L_T**2 * 2.0*US%L_to_m*G%IdxCu(I,j) / & + ((dp(i,j) + dp(i+1,j)) + dp_neglect)) enddo ; enddo !$OMP parallel do default(shared) do J=Jsq,Jeq ; do i=is,ie @@ -394,19 +394,19 @@ subroutine PressureForce_AFV_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p (za(i,j+1)*dp(i,j+1) + intp_dza(i,j+1,k))) + & ((dp(i,j+1) - dp(i,j)) * inty_za(i,J) - & (p(i,j+1,K) - p(i,j,K)) * inty_dza(i,J,k))) * & - (2.0*G%IdyCv(i,J) / ((dp(i,j) + dp(i,j+1)) + & - dp_neglect)) + (US%m_s_to_L_T**2 * 2.0*US%L_to_m*G%IdyCv(i,J) / & + ((dp(i,j) + dp(i,j+1)) + dp_neglect)) enddo ; enddo if (CS%GFS_scale < 1.0) then ! Adjust the Montgomery potential to make this a reduced gravity model. !$OMP parallel do default(shared) do j=js,je ; do I=Isq,Ieq - PFu(I,j,k) = PFu(I,j,k) - (dM(i+1,j) - dM(i,j)) * G%IdxCu(I,j) + PFu(I,j,k) = PFu(I,j,k) - (dM(i+1,j) - dM(i,j)) * US%L_to_m*G%IdxCu(I,j) enddo ; enddo !$OMP parallel do default(shared) do J=Jsq,Jeq ; do i=is,ie - PFv(i,J,k) = PFv(i,J,k) - (dM(i,j+1) - dM(i,j)) * G%IdyCv(i,J) + PFv(i,J,k) = PFv(i,J,k) - (dM(i,j+1) - dM(i,j)) * US%L_to_m*G%IdyCv(i,J) enddo ; enddo endif enddo @@ -448,8 +448,8 @@ subroutine PressureForce_AFV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_at type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness [H ~> m] type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamic variables - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(out) :: PFu !< Zonal acceleration [m s-2] - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(out) :: PFv !< Meridional acceleration [m s-2] + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(out) :: PFu !< Zonal acceleration [L T-2 ~> m s-2] + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(out) :: PFv !< Meridional acceleration [L T-2 ~> m s-2] type(PressureForce_AFV_CS), pointer :: CS !< Finite volume PGF control structure type(ALE_CS), pointer :: ALE_CSp !< ALE control structure real, dimension(:,:), optional, pointer :: p_atm !< The pressure at the ice-ocean @@ -466,7 +466,7 @@ subroutine PressureForce_AFV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_at e_tidal, & ! The bottom geopotential anomaly due to tidal forces from ! astronomical sources and self-attraction and loading [Z ~> m]. dM ! The barotropic adjustment to the Montgomery potential to - ! account for a reduced gravity model [m2 s-2]. + ! account for a reduced gravity model [L2 T-2 ~> m2 s-2]. real, dimension(SZI_(G)) :: & Rho_cv_BL ! The coordinate potential density in the deepest variable ! density near-surface layer [kg m-3]. @@ -502,8 +502,8 @@ subroutine PressureForce_AFV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_at real :: h_neglect ! A thickness that is so small it is usually lost ! in roundoff and can be neglected [H ~> m]. real :: g_Earth_z ! A scaled version of g_Earth [m2 Z-1 s-2 ~> m s-2]. - real :: I_Rho0 ! 1/Rho0 [m3 kg-1]. - real :: G_Rho0 ! G_Earth / Rho0 in [m5 Z-1 s-2 kg-1 ~> m4 s-2 kg-1]. + real :: I_Rho0 ! 1/Rho0 times unit scaling factors [L2 m kg-1 s2 T-2 ~> m3 kg-1]. + real :: G_Rho0 ! G_Earth / Rho0 in [L2 m5 Z-1 T-2 kg-1 ~> m4 s-2 kg-1]. real :: Rho_ref ! The reference density [kg m-3]. real :: dz_neglect ! A minimal thickness [Z ~> m], like e. logical :: use_p_atm ! If true, use the atmospheric pressure. @@ -531,9 +531,9 @@ 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 + I_Rho0 = US%m_s_to_L_T**2 / GV%Rho0 g_Earth_z = US%L_T_to_m_s**2 * GV%g_Earth - G_Rho0 = g_Earth_z/GV%Rho0 + G_Rho0 = GV%g_Earth/GV%Rho0 rho_ref = CS%Rho0 if (CS%tides) then @@ -722,7 +722,7 @@ subroutine PressureForce_AFV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_at (pa(i+1,j)*h(i+1,j,k) + intz_dpa(i+1,j))) + & ((h(i+1,j,k) - h(i,j,k)) * intx_pa(I,j) - & (e(i+1,j,K+1) - e(i,j,K+1)) * intx_dpa(I,j) * GV%Z_to_H)) * & - ((2.0*I_Rho0*G%IdxCu(I,j)) / & + ((2.0*I_Rho0*US%L_to_m*G%IdxCu(I,j)) / & ((h(i,j,k) + h(i+1,j,k)) + h_neglect)) intx_pa(I,j) = intx_pa(I,j) + intx_dpa(I,j) enddo ; enddo @@ -733,7 +733,7 @@ subroutine PressureForce_AFV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_at (pa(i,j+1)*h(i,j+1,k) + intz_dpa(i,j+1))) + & ((h(i,j+1,k) - h(i,j,k)) * inty_pa(i,J) - & (e(i,j+1,K+1) - e(i,j,K+1)) * inty_dpa(i,J) * GV%Z_to_H)) * & - ((2.0*I_Rho0*G%IdyCv(i,J)) / & + ((2.0*I_Rho0*US%L_to_m*G%IdyCv(i,J)) / & ((h(i,j,k) + h(i,j+1,k)) + h_neglect)) inty_pa(i,J) = inty_pa(i,J) + inty_dpa(i,J) enddo ; enddo @@ -747,11 +747,11 @@ subroutine PressureForce_AFV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_at do k=1,nz !$OMP parallel do default(shared) do j=js,je ; do I=Isq,Ieq - PFu(I,j,k) = PFu(I,j,k) - (dM(i+1,j) - dM(i,j)) * G%IdxCu(I,j) + PFu(I,j,k) = PFu(I,j,k) - (dM(i+1,j) - dM(i,j)) * US%L_to_m*G%IdxCu(I,j) enddo ; enddo !$OMP parallel do default(shared) do J=Jsq,Jeq ; do i=is,ie - PFv(i,J,k) = PFv(i,J,k) - (dM(i,j+1) - dM(i,j)) * G%IdyCv(i,J) + PFv(i,J,k) = PFv(i,J,k) - (dM(i,j+1) - dM(i,j)) * US%L_to_m*G%IdyCv(i,J) enddo ; enddo enddo endif @@ -791,8 +791,8 @@ subroutine PressureForce_AFV_init(Time, G, GV, US, param_file, diag, CS, tides_C type(diag_ctrl), target, intent(inout) :: diag !< Diagnostics control structure type(PressureForce_AFV_CS), pointer :: CS !< Finite volume PGF control structure type(tidal_forcing_CS), optional, pointer :: tides_CSp !< Tides control structure -! 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 ! This module's name. logical :: use_ALE diff --git a/src/core/MOM_PressureForce_blocked_AFV.F90 b/src/core/MOM_PressureForce_blocked_AFV.F90 index c9e1b2707c..c3972a0ffe 100644 --- a/src/core/MOM_PressureForce_blocked_AFV.F90 +++ b/src/core/MOM_PressureForce_blocked_AFV.F90 @@ -69,8 +69,8 @@ subroutine PressureForce_blk_AFV(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_atm, type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness [H ~> m or kg m-2] type(thermo_var_ptrs), intent(inout) :: tv !< Thermodynamic variables - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(out) :: PFu !< Zonal acceleration [m s-2] - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(out) :: PFv !< Meridional acceleration [m s-2] + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(out) :: PFu !< Zonal acceleration [L T-2 ~> m s-2] + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(out) :: PFv !< Meridional acceleration [L T-2 ~> m s-2] type(PressureForce_blk_AFV_CS), pointer :: CS !< Finite volume PGF control structure type(ALE_CS), pointer :: ALE_CSp !< ALE control structure real, dimension(:,:), optional, pointer :: p_atm !< The pressure at the ice-ocean @@ -105,8 +105,8 @@ subroutine PressureForce_blk_AFV_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness [H ~> kg m-2] type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamic variables - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(out) :: PFu !< Zonal acceleration [m s-2] - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(out) :: PFv !< Meridional acceleration [m s-2] + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(out) :: PFu !< Zonal acceleration [L T-2 ~> m s-2] + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(out) :: PFv !< Meridional acceleration [L T-2 ~> m s-2] type(PressureForce_blk_AFV_CS), pointer :: CS !< Finite volume PGF control structure real, dimension(:,:), optional, pointer :: p_atm !< The pressure at the ice-ocean !! or atmosphere-ocean interface [Pa]. @@ -307,14 +307,14 @@ subroutine PressureForce_blk_AFV_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, do i=Isq,Ieq+1 dM(i,j) = (CS%GFS_scale - 1.0) * & - (p(i,j,1)*(1.0/rho_in_situ(i) - alpha_ref) + za(i,j)) + US%m_s_to_L_T**2*(p(i,j,1)*(1.0/rho_in_situ(i) - alpha_ref) + za(i,j)) enddo enddo else !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 dM(i,j) = (CS%GFS_scale - 1.0) * & - (p(i,j,1)*(1.0/GV%Rlay(1) - alpha_ref) + za(i,j)) + US%m_s_to_L_T**2*(p(i,j,1)*(1.0/GV%Rlay(1) - alpha_ref) + za(i,j)) enddo ; enddo endif ! else @@ -365,8 +365,8 @@ subroutine PressureForce_blk_AFV_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, (za_bk(ib+1,jb)*dp_bk(ib+1,jb) + intp_dza(i+1,j,k))) + & ((dp_bk(ib+1,jb) - dp_bk(ib,jb)) * intx_za_bk(Ib,jb) - & (p(i+1,j,K) - p(i,j,K)) * intx_dza(I,j,k))) * & - (2.0*G%IdxCu(I,j) / ((dp_bk(ib,jb) + dp_bk(ib+1,jb)) + & - dp_neglect)) + (US%m_s_to_L_T**2 * 2.0*US%L_to_m*G%IdxCu(I,j) / & + ((dp_bk(ib,jb) + dp_bk(ib+1,jb)) + dp_neglect)) enddo ; enddo do Jb=Jsq_bk,Jeq_bk ; do ib=is_bk,ie_bk i = ib+ioff_bk ; J = Jb+joff_bk @@ -375,17 +375,17 @@ subroutine PressureForce_blk_AFV_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, (za_bk(ib,jb+1)*dp_bk(ib,jb+1) + intp_dza(i,j+1,k))) + & ((dp_bk(ib,jb+1) - dp_bk(ib,jb)) * inty_za_bk(ib,Jb) - & (p(i,j+1,K) - p(i,j,K)) * inty_dza(i,J,k))) * & - (2.0*G%IdyCv(i,J) / ((dp_bk(ib,jb) + dp_bk(ib,jb+1)) + & - dp_neglect)) + (US%m_s_to_L_T**2 * 2.0*US%L_to_m*G%IdyCv(i,J) / & + ((dp_bk(ib,jb) + dp_bk(ib,jb+1)) + dp_neglect)) enddo ; enddo if (CS%GFS_scale < 1.0) then ! Adjust the Montgomery potential to make this a reduced gravity model. do j=js_bk+joff_bk,je_bk+joff_bk ; do I=Isq_bk+ioff_bk,Ieq_bk+ioff_bk - PFu(I,j,k) = PFu(I,j,k) - (dM(i+1,j) - dM(i,j)) * G%IdxCu(I,j) + PFu(I,j,k) = PFu(I,j,k) - (dM(i+1,j) - dM(i,j)) * US%L_to_m*G%IdxCu(I,j) enddo ; enddo do J=Jsq_bk+joff_bk,Jeq_bk+joff_bk ; do i=is_bk+ioff_bk,ie_bk+ioff_bk - PFv(i,J,k) = PFv(i,J,k) - (dM(i,j+1) - dM(i,j)) * G%IdyCv(i,J) + PFv(i,J,k) = PFv(i,J,k) - (dM(i,j+1) - dM(i,j)) * US%L_to_m*G%IdyCv(i,J) enddo ; enddo endif enddo @@ -429,8 +429,8 @@ subroutine PressureForce_blk_AFV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type 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 !< Thermodynamic variables - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(out) :: PFu !< Zonal acceleration [m s-2] - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(out) :: PFv !< Meridional acceleration [m s-2] + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(out) :: PFu !< Zonal acceleration [L T-2 ~> m s-2] + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(out) :: PFv !< Meridional acceleration [L T-2 ~> m s-2] type(PressureForce_blk_AFV_CS), pointer :: CS !< Finite volume PGF control structure type(ALE_CS), pointer :: ALE_CSp !< ALE control structure real, dimension(:,:), optional, pointer :: p_atm !< The pressure at the ice-ocean @@ -447,7 +447,7 @@ subroutine PressureForce_blk_AFV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, e_tidal, & ! The bottom geopotential anomaly due to tidal forces from ! astronomical sources and self-attraction and loading, in depth units [Z ~> m]. dM ! The barotropic adjustment to the Montgomery potential to - ! account for a reduced gravity model [m2 s-2]. + ! account for a reduced gravity model [L2 T-2 ~> m2 s-2]. real, dimension(SZI_(G)) :: & Rho_cv_BL ! The coordinate potential density in the deepest variable ! density near-surface layer [kg m-3]. @@ -482,7 +482,7 @@ subroutine PressureForce_blk_AFV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, real :: p0(SZI_(G)) ! An array of zeros to use for pressure [Pa]. 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 :: I_Rho0 ! 1/Rho0 [m3 kg-1]. + real :: I_Rho0 ! 1/Rho0 times unit scaling factors [L2 m kg-1 s2 T-2 ~> m3 kg-1]. real :: g_Earth_z ! A scaled version of g_Earth [m2 Z-1 s-2 ~> m s-2]. real :: G_Rho0 ! G_Earth / Rho0 [m5 Z-1 s-2 kg-1 ~> m4 s-2 kg-1]. real :: Rho_ref ! The reference density [kg m-3]. @@ -515,9 +515,9 @@ 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 + I_Rho0 = US%m_s_to_L_T**2 / GV%Rho0 g_Earth_z = US%L_T_to_m_s**2 * GV%g_Earth - G_Rho0 = g_Earth_z / GV%Rho0 + G_Rho0 = GV%g_Earth / GV%Rho0 rho_ref = CS%Rho0 if (CS%tides) then @@ -716,7 +716,7 @@ subroutine PressureForce_blk_AFV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, (pa_bk(ib+1,jb)*h(i+1,j,k) + intz_dpa_bk(ib+1,jb))) + & ((h(i+1,j,k) - h(i,j,k)) * intx_pa_bk(Ib,jb) - & (e(i+1,j,K+1) - e(i,j,K+1)) * intx_dpa_bk(Ib,jb) * GV%Z_to_H)) * & - ((2.0*I_Rho0*G%IdxCu(I,j)) / & + ((2.0*I_Rho0*US%L_to_m*G%IdxCu(I,j)) / & ((h(i,j,k) + h(i+1,j,k)) + h_neglect)) intx_pa_bk(Ib,jb) = intx_pa_bk(Ib,jb) + intx_dpa_bk(Ib,jb) enddo ; enddo @@ -727,7 +727,7 @@ subroutine PressureForce_blk_AFV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, (pa_bk(ib,jb+1)*h(i,j+1,k) + intz_dpa_bk(ib,jb+1))) + & ((h(i,j+1,k) - h(i,j,k)) * inty_pa_bk(ib,Jb) - & (e(i,j+1,K+1) - e(i,j,K+1)) * inty_dpa_bk(ib,Jb) * GV%Z_to_H)) * & - ((2.0*I_Rho0*G%IdyCv(i,J)) / & + ((2.0*I_Rho0*US%L_to_m*G%IdyCv(i,J)) / & ((h(i,j,k) + h(i,j+1,k)) + h_neglect)) inty_pa_bk(ib,Jb) = inty_pa_bk(ib,Jb) + inty_dpa_bk(ib,Jb) enddo ; enddo @@ -739,10 +739,10 @@ subroutine PressureForce_blk_AFV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, if (CS%GFS_scale < 1.0) then do k=1,nz do j=js_bk+joff_bk,je_bk+joff_bk ; do I=Isq_bk+ioff_bk,Ieq_bk+ioff_bk - PFu(I,j,k) = PFu(I,j,k) - (dM(i+1,j) - dM(i,j)) * G%IdxCu(I,j) + PFu(I,j,k) = PFu(I,j,k) - (dM(i+1,j) - dM(i,j)) * US%L_to_m*G%IdxCu(I,j) enddo ; enddo do J=Jsq_bk+joff_bk,Jeq_bk+joff_bk ; do i=is_bk+ioff_bk,ie_bk+ioff_bk - PFv(i,J,k) = PFv(i,J,k) - (dM(i,j+1) - dM(i,j)) * G%IdyCv(i,J) + PFv(i,J,k) = PFv(i,J,k) - (dM(i,j+1) - dM(i,j)) * US%L_to_m*G%IdyCv(i,J) enddo ; enddo enddo endif From 7e29087446dd2fb1b6f2812a2fecdf61a166fd9e Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Thu, 1 Aug 2019 10:25:51 -0400 Subject: [PATCH 138/297] Rescaled variables in advect_tracer Applied dimensional rescaling to numerous internal variables in MOM_tracer_advect.F90 for expanded dimensional consistency testing. All answers are bitwise identical, but the dimensions of the pressure gradient acceleration have been rescaled. --- src/tracer/MOM_tracer_advect.F90 | 164 +++++++++++++++---------------- 1 file changed, 81 insertions(+), 83 deletions(-) diff --git a/src/tracer/MOM_tracer_advect.F90 b/src/tracer/MOM_tracer_advect.F90 index 1958b60cc8..ced1916a7a 100644 --- a/src/tracer/MOM_tracer_advect.F90 +++ b/src/tracer/MOM_tracer_advect.F90 @@ -1,5 +1,4 @@ -!> This program contains the subroutines that advect tracers -!! along coordinate surfaces. +!> This module contains the subroutines that advect tracers along coordinate surfaces. module MOM_tracer_advect ! This file is part of MOM6. See LICENSE.md for the license. @@ -60,7 +59,7 @@ subroutine advect_tracer(h_end, uhtr, vhtr, OBC, dt, G, GV, US, CS, Reg, & intent(in) :: vhtr !< accumulated volume/mass flux through merid face [H L2 ~> m3 or kg] type(ocean_OBC_type), pointer :: OBC !< specifies whether, where, and what OBCs are used real, intent(in) :: dt !< time increment [s] - 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(tracer_advect_CS), pointer :: CS !< control structure for module type(tracer_registry_type), pointer :: Reg !< pointer to tracer registry real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & @@ -70,25 +69,25 @@ subroutine advect_tracer(h_end, uhtr, vhtr, OBC, dt, G, GV, US, CS, Reg, & !! first in the x- or y-direction. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & optional, intent(out) :: uhr_out !< accumulated volume/mass flux through zonal face - !! [H m2 ~> m3 or kg] + !! [H L2 ~> m3 or kg] real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & optional, intent(out) :: vhr_out !< accumulated volume/mass flux through merid face - !! [H m2 ~> m3 or kg] + !! [H L2 ~> m3 or kg] real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & optional, intent(out) :: h_out !< layer thickness before advection [H ~> m or kg m-2] type(tracer_type) :: Tr(MAX_FIELDS_) ! The array of registered tracers real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: & - hprev ! cell volume at the end of previous tracer change [H m2 ~> m3 or kg] + hprev ! cell volume at the end of previous tracer change [H L2 ~> m3 or kg] real, dimension(SZIB_(G),SZJ_(G),SZK_(G)) :: & - uhr ! The remaining zonal thickness flux [H m2 ~> m3 or kg] + uhr ! The remaining zonal thickness flux [H L2 ~> m3 or kg] real, dimension(SZI_(G),SZJB_(G),SZK_(G)) :: & - vhr ! The remaining meridional thickness fluxes [H m2 ~> m3 or kg] + vhr ! The remaining meridional thickness fluxes [H L2 ~> m3 or kg] real :: uh_neglect(SZIB_(G),SZJ_(G)) ! uh_neglect and vh_neglect are the real :: vh_neglect(SZI_(G),SZJB_(G)) ! magnitude of remaining transports that - ! can be simply discarded [H m2 ~> m3 or kg]. + ! can be simply discarded [H L2 ~> m3 or kg]. - real :: landvolfill ! An arbitrary? nonzero cell volume [H m2 ~> m3 or kg]. + real :: landvolfill ! An arbitrary? nonzero cell volume [H L2 ~> m3 or kg]. real :: Idt ! 1/dt [s-1]. logical :: domore_u(SZJ_(G),SZK_(G)) ! domore__ indicate whether there is more logical :: domore_v(SZJB_(G),SZK_(G)) ! advection to be done in the corresponding @@ -145,27 +144,27 @@ subroutine advect_tracer(h_end, uhtr, vhtr, OBC, dt, G, GV, US, CS, Reg, & ! calculations on them, even though they are never used. !$OMP do - do k = 1, nz - do j = jsd, jed; do i = IsdB, IedB; uhr(i,j,k) = 0.0; enddo ; enddo - do j = jsdB, jedB; do i = Isd, Ied; vhr(i,j,k) = 0.0; enddo ; enddo - do j = jsd, jed; do i = Isd, Ied; hprev(i,j,k) = 0.0; enddo ; enddo + do k=1,nz + do j=jsd,jed ; do I=IsdB,IedB ; uhr(I,j,k) = 0.0 ; enddo ; enddo + do J=jsdB,jedB ; do i=Isd,Ied ; vhr(i,J,k) = 0.0 ; enddo ; enddo + do j=jsd,jed ; do i=Isd,Ied ; hprev(i,j,k) = 0.0 ; enddo ; enddo domore_k(k)=1 ! Put the remaining (total) thickness fluxes into uhr and vhr. - do j=js,je ; do I=is-1,ie ; uhr(I,j,k) = US%L_to_m**2*uhtr(I,j,k) ; enddo ; enddo - do J=js-1,je ; do i=is,ie ; vhr(i,J,k) = US%L_to_m**2*vhtr(i,J,k) ; enddo ; enddo + do j=js,je ; do I=is-1,ie ; uhr(I,j,k) = uhtr(I,j,k) ; enddo ; enddo + do J=js-1,je ; do i=is,ie ; vhr(i,J,k) = vhtr(i,J,k) ; enddo ; enddo if (.not. present(h_prev_opt)) then ! This loop reconstructs the thickness field the last time that the ! tracers were updated, probably just after the diabatic forcing. A useful ! diagnostic could be to compare this reconstruction with that older value. - do i=is,ie ; do j=js,je - hprev(i,j,k) = max(0.0, G%areaT(i,j)*h_end(i,j,k) + & - ((uhr(I,j,k) - uhr(I-1,j,k)) + (vhr(i,J,k) - vhr(i,J-1,k)))) + do i=is,ie ; do j=js,je + hprev(i,j,k) = max(0.0, US%m_to_L**2*G%areaT(i,j)*h_end(i,j,k) + & + ((uhr(I,j,k) - uhr(I-1,j,k)) + (vhr(i,J,k) - vhr(i,J-1,k)))) ! In the case that the layer is now dramatically thinner than it was previously, ! add a bit of mass to avoid truncation errors. This will lead to ! non-conservation of tracers - hprev(i,j,k) = hprev(i,j,k) + & - max(0.0, 1.0e-13*hprev(i,j,k) - G%areaT(i,j)*h_end(i,j,k)) - enddo ; enddo + hprev(i,j,k) = hprev(i,j,k) + & + max(0.0, 1.0e-13*hprev(i,j,k) - US%m_to_L**2*G%areaT(i,j)*h_end(i,j,k)) + enddo ; enddo else do i=is,ie ; do j=js,je hprev(i,j,k) = h_prev_opt(i,j,k) @@ -176,11 +175,11 @@ subroutine advect_tracer(h_end, uhtr, vhtr, OBC, dt, G, GV, US, CS, Reg, & !$OMP do do j=jsd,jed ; do I=isd,ied-1 - uh_neglect(I,j) = GV%H_subroundoff*MIN(G%areaT(i,j),G%areaT(i+1,j)) + uh_neglect(I,j) = GV%H_subroundoff*MIN(US%m_to_L**2*G%areaT(i,j),US%m_to_L**2*G%areaT(i+1,j)) enddo ; enddo !$OMP do do J=jsd,jed-1 ; do i=isd,ied - vh_neglect(i,J) = GV%H_subroundoff*MIN(G%areaT(i,j),G%areaT(i,j+1)) + vh_neglect(i,J) = GV%H_subroundoff*MIN(US%m_to_L**2*G%areaT(i,j),US%m_to_L**2*G%areaT(i,j+1)) enddo ; enddo !$OMP do @@ -266,11 +265,11 @@ subroutine advect_tracer(h_end, uhtr, vhtr, OBC, dt, G, GV, US, CS, Reg, & ! First, advect zonally. call advect_x(Tr, hprev, uhr, uh_neglect, OBC, domore_u, ntr, Idt, & - isv, iev, jsv-stencil, jev+stencil, k, G, GV, CS%usePPM, CS%useHuynh) + isv, iev, jsv-stencil, jev+stencil, k, G, GV, US, CS%usePPM, CS%useHuynh) ! Next, advect meridionally. call advect_y(Tr, hprev, vhr, vh_neglect, OBC, domore_v, ntr, Idt, & - isv, iev, jsv, jev, k, G, GV, CS%usePPM, CS%useHuynh) + isv, iev, jsv, jev, k, G, GV, US, CS%usePPM, CS%useHuynh) domore_k(k) = 0 do j=jsv-stencil,jev+stencil ; if (domore_u(j,k)) domore_k(k) = 1 ; enddo @@ -280,11 +279,11 @@ subroutine advect_tracer(h_end, uhtr, vhtr, OBC, dt, G, GV, US, CS, Reg, & ! First, advect meridionally. call advect_y(Tr, hprev, vhr, vh_neglect, OBC, domore_v, ntr, Idt, & - isv-stencil, iev+stencil, jsv, jev, k, G, GV, CS%usePPM, CS%useHuynh) + isv-stencil, iev+stencil, jsv, jev, k, G, GV, US, CS%usePPM, CS%useHuynh) ! Next, advect zonally. call advect_x(Tr, hprev, uhr, uh_neglect, OBC, domore_u, ntr, Idt, & - isv, iev, jsv, jev, k, G, GV, CS%usePPM, CS%useHuynh) + isv, iev, jsv, jev, k, G, GV, US, CS%usePPM, CS%useHuynh) domore_k(k) = 0 do j=jsv,jev ; if (domore_u(j,k)) domore_k(k) = 1 ; enddo @@ -327,16 +326,16 @@ end subroutine advect_tracer !> This subroutine does 1-d flux-form advection in the zonal direction using !! a monotonic piecewise linear scheme. subroutine advect_x(Tr, hprev, uhr, uh_neglect, OBC, domore_u, ntr, Idt, & - is, ie, js, je, k, G, GV, usePPM, useHuynh) + is, ie, js, je, k, G, GV, US, usePPM, useHuynh) 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(tracer_type), dimension(ntr), intent(inout) :: Tr !< The array of registered tracers to work on real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: hprev !< cell volume at the end of previous - !! tracer change [H m2 ~> m3 or kg] + !! tracer change [H L2 ~> m3 or kg] real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: uhr !< accumulated volume/mass flux through - !! the zonal face [H m2 ~> m3 or kg] + !! the zonal face [H L2 ~> m3 or kg] real, dimension(SZIB_(G),SZJ_(G)), intent(inout) :: uh_neglect !< A tiny zonal mass flux that can - !! be neglected [H m2 ~> m3 or kg] + !! be neglected [H L2 ~> m3 or kg] type(ocean_OBC_type), pointer :: OBC !< specifies whether, where, and what OBCs are used logical, dimension(SZJ_(G),SZK_(G)), intent(inout) :: domore_u !< If true, there is more advection to be !! done in this u-row @@ -347,6 +346,7 @@ subroutine advect_x(Tr, hprev, uhr, uh_neglect, OBC, domore_u, ntr, Idt, & integer, intent(in) :: js !< The starting tracer j-index to work on integer, intent(in) :: je !< The ending tracer j-index to work on integer, intent(in) :: k !< The k-level to work on + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type logical, intent(in) :: usePPM !< If true, use PPM instead of PLM logical, intent(in) :: useHuynh !< If true, use the Huynh scheme !! for PPM interface values @@ -354,18 +354,18 @@ subroutine advect_x(Tr, hprev, uhr, uh_neglect, OBC, domore_u, ntr, Idt, & real, dimension(SZI_(G),ntr) :: & slope_x ! The concentration slope per grid point [conc]. real, dimension(SZIB_(G),ntr) :: & - flux_x ! The tracer flux across a boundary [H m2 conc ~> m3 conc or kg conc]. + flux_x ! The tracer flux across a boundary [H L2 conc ~> m3 conc or kg conc]. real :: maxslope ! The maximum concentration slope per grid point ! consistent with monotonicity [conc]. real :: hup, hlos ! hup is the upwind volume, hlos is the ! part of that volume that might be lost ! due to advection out the other side of - ! the grid box, both in [H m2 ~> m3 or kg]. + ! the grid box, both in [H L2 ~> m3 or kg]. real :: uhh(SZIB_(G)) ! The zonal flux that occurs during the - ! current iteration [H m2 ~> m3 or kg]. + ! current iteration [H L2 ~> m3 or kg]. real, dimension(SZIB_(G)) :: & - hlst, & ! Work variable [H m2 ~> m3 or kg]. - Ihnew, & ! Work variable [H-1 m-2 ~> m-3 or kg-1]. + hlst, & ! Work variable [H L2 ~> m3 or kg]. + Ihnew, & ! Work variable [H-1 L-2 ~> m-3 or kg-1]. CFL ! A nondimensional work variable [nondim]. real :: min_h ! The minimum thickness that can be realized during ! any of the passes [H ~> m or kg m-2]. @@ -431,7 +431,7 @@ subroutine advect_x(Tr, hprev, uhr, uh_neglect, OBC, domore_u, ntr, Idt, & uhh(I) = 0.0 CFL(I) = 0.0 elseif (uhr(I,j,k) < 0.0) then - hup = hprev(i+1,j,k) - G%areaT(i+1,j)*min_h + hup = hprev(i+1,j,k) - US%m_to_L**2*G%areaT(i+1,j)*min_h hlos = MAX(0.0,uhr(I+1,j,k)) if ((((hup - hlos) + uhr(I,j,k)) < 0.0) .and. & ((0.5*hup + uhr(I,j,k)) < 0.0)) then @@ -443,7 +443,7 @@ subroutine advect_x(Tr, hprev, uhr, uh_neglect, OBC, domore_u, ntr, Idt, & !ts2(I) = 0.5*(1.0 + uhh(I)/(hprev(i+1,j,k)+h_neglect)) CFL(I) = - uhh(I)/(hprev(i+1,j,k)+h_neglect) ! CFL is positive else - hup = hprev(i,j,k) - G%areaT(i,j)*min_h + hup = hprev(i,j,k) - US%m_to_L**2*G%areaT(i,j)*min_h hlos = MAX(0.0,-uhr(I-1,j,k)) if ((((hup - hlos) - uhr(I,j,k)) < 0.0) .and. & ((0.5*hup - uhr(I,j,k)) < 0.0)) then @@ -568,18 +568,18 @@ subroutine advect_x(Tr, hprev, uhr, uh_neglect, OBC, domore_u, ntr, Idt, & ishift=0 ! ishift+I corresponds to the nearest interior tracer cell index idir=1 ! idir switches the sign of the flow so that positive is into the reservoir if (segment%direction == OBC_DIRECTION_W) then - ishift=1 - idir=-1 + ishift = 1 + idir = -1 endif ! update the reservoir tracer concentration implicitly ! using Backward-Euler timestep do m=1,ntr if (associated(segment%tr_Reg%Tr(m)%tres)) then - uhh(I)=uhr(I,j,k) - u_L_in=max(idir*uhh(I)*segment%Tr_InvLscale3_in,0.) - u_L_out=min(idir*uhh(I)*segment%Tr_InvLscale3_out,0.) - fac1=1.0+dt*(u_L_in-u_L_out) - segment%tr_Reg%Tr(m)%tres(I,j,k)= (1.0/fac1)*(segment%tr_Reg%Tr(m)%tres(I,j,k) + & + uhh(I) = uhr(I,j,k) + u_L_in = max(idir*uhh(I)*segment%Tr_InvLscale3_in,0.) + u_L_out = min(idir*uhh(I)*segment%Tr_InvLscale3_out,0.) + fac1 = 1.0+dt*(u_L_in-u_L_out) + segment%tr_Reg%Tr(m)%tres(I,j,k) = (1.0/fac1)*(segment%tr_Reg%Tr(m)%tres(I,j,k) + & dt*(u_L_in*Tr(m)%t(I+ishift,j,k) - & u_L_out*segment%tr_Reg%Tr(m)%t(I,j,k))) endif @@ -612,9 +612,9 @@ subroutine advect_x(Tr, hprev, uhr, uh_neglect, OBC, domore_u, ntr, Idt, & hlst(i) = hprev(i,j,k) hprev(i,j,k) = hprev(i,j,k) - (uhh(I) - uhh(I-1)) if (hprev(i,j,k) <= 0.0) then ; do_i(i) = .false. - elseif (hprev(i,j,k) < h_neglect*G%areaT(i,j)) then - hlst(i) = hlst(i) + (h_neglect*G%areaT(i,j) - hprev(i,j,k)) - Ihnew(i) = 1.0 / (h_neglect*G%areaT(i,j)) + elseif (hprev(i,j,k) < h_neglect*US%m_to_L**2*G%areaT(i,j)) then + hlst(i) = hlst(i) + (h_neglect*US%m_to_L**2*G%areaT(i,j) - hprev(i,j,k)) + Ihnew(i) = 1.0 / (h_neglect*US%m_to_L**2*G%areaT(i,j)) else ; Ihnew(i) = 1.0 / hprev(i,j,k) ; endif else do_i(i) = .false. @@ -632,17 +632,18 @@ subroutine advect_x(Tr, hprev, uhr, uh_neglect, OBC, domore_u, ntr, Idt, & ! diagnostics if (associated(Tr(m)%ad_x)) then ; do i=is,ie ; if (do_i(i)) then - Tr(m)%ad_x(I,j,k) = Tr(m)%ad_x(I,j,k) + flux_x(I,m)*Idt + Tr(m)%ad_x(I,j,k) = Tr(m)%ad_x(I,j,k) + US%L_to_m**2*flux_x(I,m)*Idt endif ; enddo ; endif if (associated(Tr(m)%ad2d_x)) then ; do i=is,ie ; if (do_i(i)) then - Tr(m)%ad2d_x(I,j) = Tr(m)%ad2d_x(I,j) + flux_x(I,m)*Idt + Tr(m)%ad2d_x(I,j) = Tr(m)%ad2d_x(I,j) + US%L_to_m**2*flux_x(I,m)*Idt endif ; enddo ; endif ! diagnose convergence of flux_x (do not use the Ihnew(i) part of the logic). ! division by areaT to get into W/m2 for heat and kg/(s*m2) for salt. if (associated(Tr(m)%advection_xy)) then do i=is,ie ; if (do_i(i)) then - Tr(m)%advection_xy(i,j,k) = Tr(m)%advection_xy(i,j,k) - (flux_x(I,m) - flux_x(I-1,m)) * Idt * G%IareaT(i,j) + Tr(m)%advection_xy(i,j,k) = Tr(m)%advection_xy(i,j,k) - (flux_x(I,m) - flux_x(I-1,m)) * & + Idt * US%L_to_m**2*G%IareaT(i,j) endif ; enddo endif @@ -655,16 +656,16 @@ end subroutine advect_x !> This subroutine does 1-d flux-form advection using a monotonic piecewise !! linear scheme. subroutine advect_y(Tr, hprev, vhr, vh_neglect, OBC, domore_v, ntr, Idt, & - is, ie, js, je, k, G, GV, usePPM, useHuynh) + is, ie, js, je, k, G, GV, US, usePPM, useHuynh) 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(tracer_type), dimension(ntr), intent(inout) :: Tr !< The array of registered tracers to work on real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: hprev !< cell volume at the end of previous - !! tracer change [H m2 ~> m3 or kg] + !! tracer change [H L2 ~> m3 or kg] real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: vhr !< accumulated volume/mass flux through - !! the meridional face [H m2 ~> m3 or kg] + !! the meridional face [H L2 ~> m3 or kg] real, dimension(SZI_(G),SZJB_(G)), intent(inout) :: vh_neglect !< A tiny meridional mass flux that can - !! be neglected [H m2 ~> m3 or kg] + !! be neglected [H L2 ~> m3 or kg] type(ocean_OBC_type), pointer :: OBC !< specifies whether, where, and what OBCs are used logical, dimension(SZJB_(G),SZK_(G)), intent(inout) :: domore_v !< If true, there is more advection to be !! done in this v-row @@ -675,6 +676,7 @@ subroutine advect_y(Tr, hprev, vhr, vh_neglect, OBC, domore_v, ntr, Idt, & integer, intent(in) :: js !< The starting tracer j-index to work on integer, intent(in) :: je !< The ending tracer j-index to work on integer, intent(in) :: k !< The k-level to work on + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type logical, intent(in) :: usePPM !< If true, use PPM instead of PLM logical, intent(in) :: useHuynh !< If true, use the Huynh scheme !! for PPM interface values @@ -682,18 +684,18 @@ subroutine advect_y(Tr, hprev, vhr, vh_neglect, OBC, domore_v, ntr, Idt, & real, dimension(SZI_(G),ntr,SZJ_(G)) :: & slope_y ! The concentration slope per grid point [conc]. real, dimension(SZI_(G),ntr,SZJB_(G)) :: & - flux_y ! The tracer flux across a boundary [H m2 conc ~> m3 conc or kg conc]. + flux_y ! The tracer flux across a boundary [H L2 conc ~> m3 conc or kg conc]. real :: maxslope ! The maximum concentration slope per grid point ! consistent with monotonicity [conc]. real :: vhh(SZI_(G),SZJB_(G)) ! The meridional flux that occurs during the - ! current iteration [H m2 ~> m3 or kg]. + ! current iteration [H L2 ~> m3 or kg]. real :: hup, hlos ! hup is the upwind volume, hlos is the ! part of that volume that might be lost ! due to advection out the other side of - ! the grid box, both in [H m2 ~> m3 or kg]. + ! the grid box, both in [H L2 ~> m3 or kg]. real, dimension(SZIB_(G)) :: & - hlst, & ! Work variable [H m2 ~> m3 or kg]. - Ihnew, & ! Work variable [H-1 m-2 ~> m-3 or kg-1]. + hlst, & ! Work variable [H L2 ~> m3 or kg]. + Ihnew, & ! Work variable [H-1 L-2 ~> m-3 or kg-1]. CFL ! A nondimensional work variable. real :: min_h ! The minimum thickness that can be realized during ! any of the passes [H ~> m or kg m-2]. @@ -771,7 +773,7 @@ subroutine advect_y(Tr, hprev, vhr, vh_neglect, OBC, domore_v, ntr, Idt, & vhh(i,J) = 0.0 CFL(i) = 0.0 elseif (vhr(i,J,k) < 0.0) then - hup = hprev(i,j+1,k) - G%areaT(i,j+1)*min_h + hup = hprev(i,j+1,k) - US%m_to_L**2*G%areaT(i,j+1)*min_h hlos = MAX(0.0,vhr(i,J+1,k)) if ((((hup - hlos) + vhr(i,J,k)) < 0.0) .and. & ((0.5*hup + vhr(i,J,k)) < 0.0)) then @@ -783,7 +785,7 @@ subroutine advect_y(Tr, hprev, vhr, vh_neglect, OBC, domore_v, ntr, Idt, & !ts2(i) = 0.5*(1.0 + vhh(i,J) / (hprev(i,j+1,k)+h_neglect)) CFL(i) = - vhh(i,J) / (hprev(i,j+1,k)+h_neglect) ! CFL is positive else - hup = hprev(i,j,k) - G%areaT(i,j)*min_h + hup = hprev(i,j,k) - US%m_to_L**2*G%areaT(i,j)*min_h hlos = MAX(0.0,-vhr(i,J-1,k)) if ((((hup - hlos) - vhr(i,J,k)) < 0.0) .and. & ((0.5*hup - vhr(i,J,k)) < 0.0)) then @@ -902,13 +904,10 @@ subroutine advect_y(Tr, hprev, vhr, vh_neglect, OBC, domore_v, ntr, Idt, & segment=>OBC%segment(n) if (segment%specified) cycle if (.not. associated(segment%tr_Reg)) cycle - if (segment%is_N_or_S .and. & - (J >= segment%HI%JsdB .and. J<= segment%HI%JedB)) then - jshift=0 - jdir=1 + if (segment%is_N_or_S .and. (J >= segment%HI%JsdB .and. J<= segment%HI%JedB)) then + jshift = 0 ; jdir = 1 if (segment%direction == OBC_DIRECTION_S) then - jshift=1 - jdir=-1 + jshift = 1 ; jdir = -1 endif do i=segment%HI%isd,segment%HI%ied ! update the reservoir tracer concentration implicitly @@ -916,10 +915,10 @@ subroutine advect_y(Tr, hprev, vhr, vh_neglect, OBC, domore_v, ntr, Idt, & do m=1,ntr if (associated(segment%tr_Reg%Tr(m)%tres)) then vhh(i,J)=vhr(i,J,k) - v_L_in=max(jdir*vhh(i,J)*segment%Tr_InvLscale3_in,0.) - v_L_out=min(jdir*vhh(i,J)*segment%Tr_InvLscale3_out,0.) - fac1=1.0+dt*(v_L_in-v_L_out) - segment%tr_Reg%Tr(m)%tres(i,J,k)= (1.0/fac1)*(segment%tr_Reg%Tr(m)%tres(i,J,k) + & + v_L_in = max(jdir*vhh(i,J)*segment%Tr_InvLscale3_in,0.) + v_L_out = min(jdir*vhh(i,J)*segment%Tr_InvLscale3_out,0.) + fac1 = 1.0 + dt*(v_L_in-v_L_out) + segment%tr_Reg%Tr(m)%tres(i,J,k) = (1.0/fac1)*(segment%tr_Reg%Tr(m)%tres(i,J,k) + & dt*v_L_in*Tr(m)%t(i,j+jshift,k) - & dt*v_L_out*segment%tr_Reg%Tr(m)%t(i,j,k)) endif @@ -959,9 +958,9 @@ subroutine advect_y(Tr, hprev, vhr, vh_neglect, OBC, domore_v, ntr, Idt, & hlst(i) = hprev(i,j,k) hprev(i,j,k) = max(hprev(i,j,k) - (vhh(i,J) - vhh(i,J-1)), 0.0) if (hprev(i,j,k) <= 0.0) then ; do_i(i) = .false. - elseif (hprev(i,j,k) < h_neglect*G%areaT(i,j)) then - hlst(i) = hlst(i) + (h_neglect*G%areaT(i,j) - hprev(i,j,k)) - Ihnew(i) = 1.0 / (h_neglect*G%areaT(i,j)) + elseif (hprev(i,j,k) < h_neglect*US%m_to_L**2*G%areaT(i,j)) then + hlst(i) = hlst(i) + (h_neglect*US%m_to_L**2*G%areaT(i,j) - hprev(i,j,k)) + Ihnew(i) = 1.0 / (h_neglect*US%m_to_L**2*G%areaT(i,j)) else ; Ihnew(i) = 1.0 / hprev(i,j,k) ; endif else ; do_i(i) = .false. ; endif enddo @@ -975,25 +974,24 @@ subroutine advect_y(Tr, hprev, vhr, vh_neglect, OBC, domore_v, ntr, Idt, & ! diagnostics if (associated(Tr(m)%ad_y)) then ; do i=is,ie ; if (do_i(i)) then - Tr(m)%ad_y(i,J,k) = Tr(m)%ad_y(i,J,k) + flux_y(i,m,J)*Idt + Tr(m)%ad_y(i,J,k) = Tr(m)%ad_y(i,J,k) + US%L_to_m**2*flux_y(i,m,J)*Idt endif ; enddo ; endif if (associated(Tr(m)%ad2d_y)) then ; do i=is,ie ; if (do_i(i)) then - Tr(m)%ad2d_y(i,J) = Tr(m)%ad2d_y(i,J) + flux_y(i,m,J)*Idt + Tr(m)%ad2d_y(i,J) = Tr(m)%ad2d_y(i,J) + US%L_to_m**2*flux_y(i,m,J)*Idt endif ; enddo ; endif ! diagnose convergence of flux_y and add to convergence of flux_x. ! division by areaT to get into W/m2 for heat and kg/(s*m2) for salt. if (associated(Tr(m)%advection_xy)) then do i=is,ie ; if (do_i(i)) then - Tr(m)%advection_xy(i,j,k) = Tr(m)%advection_xy(i,j,k) - (flux_y(i,m,J) - flux_y(i,m,J-1))* Idt * G%IareaT(i,j) + Tr(m)%advection_xy(i,j,k) = Tr(m)%advection_xy(i,j,k) - (flux_y(i,m,J) - flux_y(i,m,J-1))* Idt * & + US%L_to_m**2*G%IareaT(i,j) endif ; enddo endif - enddo endif ; enddo ! End of j-loop. - end subroutine advect_y !> Initialize lateral tracer advection module @@ -1006,8 +1004,8 @@ subroutine tracer_advect_init(Time, G, param_file, diag, CS) integer, save :: init_calls = 0 -! 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_tracer_advect" ! This module's name. character(len=256) :: mesg ! Message for error messages. From 9d75ae98c6d47b8f6df3a9cf348a6cb88daab989 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Thu, 1 Aug 2019 18:36:46 -0400 Subject: [PATCH 139/297] +Rescaled continuity internal calculations Applied dimensional rescaling to all of the velocities used inside of continuity_PPM or passed to continuity_PPM from continuity to work in units of [L T-1]. Also rearranged the dimensional scaling factors that will align with the grid spacing to facilitate later cancellations. This required the addition of unit_scale_type arguments to the continuity initialization routines. All answers are bitwise identical, but the units of the arguments to a public routine that is wrapped inside of another have changed, and there is a new argument to publicly called routines. --- src/core/MOM_continuity.F90 | 30 +- src/core/MOM_continuity_PPM.F90 | 421 +++++++++++++------------- src/core/MOM_dynamics_split_RK2.F90 | 2 +- src/core/MOM_dynamics_unsplit.F90 | 2 +- src/core/MOM_dynamics_unsplit_RK2.F90 | 2 +- 5 files changed, 244 insertions(+), 213 deletions(-) diff --git a/src/core/MOM_continuity.F90 b/src/core/MOM_continuity.F90 index 2a0c844932..47dcf3d365 100644 --- a/src/core/MOM_continuity.F90 +++ b/src/core/MOM_continuity.F90 @@ -88,6 +88,15 @@ subroutine continuity(u, v, hin, h, uh, vh, dt, G, GV, US, CS, uhbt, vhbt, OBC, optional, pointer :: BT_cont !< A structure with elements !! that describe the effective open face areas as a function of barotropic flow. + ! Local variables + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)) :: u_tmp ! Rescaled version of u [L T-1 ~> m s-1] + real, dimension(SZI_(G),SZJB_(G),SZK_(G)) :: v_tmp ! Rescaled version of V [L T-1 ~> m s-1] + integer :: is, ie, js, je, nz, stencil + integer :: i, j, k + + logical :: x_first + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke + if (present(visc_rem_u) .neqv. present(visc_rem_v)) call MOM_error(FATAL, & "MOM_continuity: Either both visc_rem_u and visc_rem_v or neither"// & " one must be present in call to continuity.") @@ -96,8 +105,22 @@ subroutine continuity(u, v, hin, h, uh, vh, dt, G, GV, US, CS, uhbt, vhbt, OBC, " one must be present in call to continuity.") if (CS%continuity_scheme == PPM_SCHEME) then - call continuity_PPM(u, v, hin, h, uh, vh, dt, G, GV, US, CS%PPM_CSp, uhbt, vhbt, OBC, & + do k=1,GV%ke ; do j=G%jsd,G%jed ; do I=G%IsdB,G%IedB + u_tmp(I,j,k) = US%m_s_to_L_T * u(I,j,k) + enddo ; enddo ; enddo + do k=1,GV%ke ; do J=G%JsdB,G%JedB ; do i=G%isd,G%ied + v_tmp(i,J,k) = US%m_s_to_L_T * v(i,J,k) + enddo ; enddo ; enddo + + call continuity_PPM(u_tmp, v_tmp, hin, h, uh, vh, dt, G, GV, US, CS%PPM_CSp, uhbt, vhbt, OBC, & visc_rem_u, visc_rem_v, u_cor, v_cor, BT_cont=BT_cont) + + if (present(u_cor)) then ; do k=1,GV%ke ; do j=G%jsd,G%jed ; do I=G%IsdB,G%IedB + u_cor(I,j,k) = US%L_T_to_m_s * u_cor(I,j,k) + enddo ; enddo ; enddo ; endif + if (present(v_cor)) then ; do k=1,GV%ke ; do J=G%JsdB,G%JedB ; do i=G%isd,G%ied + v_cor(i,J,k) = US%L_T_to_m_s * v_cor(i,J,k) + enddo ; enddo ; enddo ; endif else call MOM_error(FATAL, "continuity: Unrecognized value of continuity_scheme") endif @@ -105,10 +128,11 @@ subroutine continuity(u, v, hin, h, uh, vh, dt, G, GV, US, CS, uhbt, vhbt, OBC, end subroutine continuity !> Initializes continuity_cs -subroutine continuity_init(Time, G, GV, param_file, diag, CS) +subroutine continuity_init(Time, G, GV, US, param_file, diag, CS) type(time_type), target, intent(in) :: Time !< Current model time. type(ocean_grid_type), intent(in) :: G !< Ocean grid structure. type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(param_file_type), intent(in) :: param_file !< Parameter file handles. type(diag_ctrl), target, intent(inout) :: diag !< Diagnostics control structure. type(continuity_CS), pointer :: CS !< Control structure for mom_continuity. @@ -144,7 +168,7 @@ subroutine continuity_init(Time, G, GV, param_file, diag, CS) end select if (CS%continuity_scheme == PPM_SCHEME) then - call continuity_PPM_init(Time, G, GV, param_file, diag, CS%PPM_CSp) + call continuity_PPM_init(Time, G, GV, US, param_file, diag, CS%PPM_CSp) endif end subroutine continuity_init diff --git a/src/core/MOM_continuity_PPM.F90 b/src/core/MOM_continuity_PPM.F90 index 1a2733bbea..c40fcb86f4 100644 --- a/src/core/MOM_continuity_PPM.F90 +++ b/src/core/MOM_continuity_PPM.F90 @@ -39,7 +39,7 @@ module MOM_continuity_PPM !! the sum of the layer thicknesses [H ~> m or kg m-2]. real :: tol_vel !< The tolerance for barotropic velocity !! discrepancies between the barotropic solution and - !! the sum of the layer thicknesses [m s-1]. + !! the sum of the layer thicknesses [L T-1 ~> m s-1]. real :: tol_eta_aux !< The tolerance for free-surface height !! discrepancies between the barotropic solution and !! the sum of the layer thicknesses when calculating @@ -78,9 +78,9 @@ subroutine continuity_PPM(u, v, hin, h, uh, vh, dt, G, GV, US, CS, uhbt, vhbt, O type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. type(continuity_PPM_CS), pointer :: CS !< Module's control structure. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & - intent(in) :: u !< Zonal velocity [m s-1]. + intent(in) :: u !< Zonal velocity [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - intent(in) :: v !< Meridional velocity [m s-1]. + intent(in) :: v !< Meridional velocity [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(in) :: hin !< Initial layer thickness [H ~> m or kg m-2]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & @@ -116,10 +116,11 @@ subroutine continuity_PPM(u, v, hin, h, uh, vh, dt, G, GV, US, CS, uhbt, vhbt, O !! Non-dimensional between 0 (at the bottom) and 1 (far above the bottom). real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & optional, intent(out) :: u_cor - !< The zonal velocities that give uhbt as the depth-integrated transport [m s-1]. + !< The zonal velocities that give uhbt as the depth-integrated transport [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & optional, intent(out) :: v_cor - !< The meridional velocities that give vhbt as the depth-integrated transport [m s-1]. + !< The meridional velocities that give vhbt as the depth-integrated + !! transport [L T-1 ~> m s-1]. 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. @@ -148,7 +149,7 @@ subroutine continuity_PPM(u, v, hin, h, uh, vh, dt, G, GV, US, CS, uhbt, vhbt, O ! 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, US, CS, LB, uhbt, OBC, visc_rem_u, u_cor, BT_cont) + call zonal_mass_flux(u, hin, uh, US%s_to_T*dt, G, GV, US, CS, LB, uhbt, OBC, visc_rem_u, u_cor, BT_cont) call cpu_clock_begin(id_clock_update) !$OMP parallel do default(shared) @@ -163,7 +164,7 @@ subroutine continuity_PPM(u, v, hin, h, uh, vh, dt, G, GV, US, CS, uhbt, vhbt, O ! Now advect meridionally, using the updated thicknesses to determine ! the fluxes. - call meridional_mass_flux(v, h, vh, dt, G, GV, US, CS, LB, vhbt, OBC, visc_rem_v, v_cor, BT_cont) + call meridional_mass_flux(v, h, vh, US%s_to_T*dt, G, GV, US, CS, LB, vhbt, OBC, visc_rem_v, v_cor, BT_cont) call cpu_clock_begin(id_clock_update) !$OMP parallel do default(shared) @@ -179,7 +180,7 @@ subroutine continuity_PPM(u, v, hin, h, uh, vh, dt, G, GV, US, CS, uhbt, vhbt, O 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, US, CS, LB, vhbt, OBC, visc_rem_v, v_cor, BT_cont) + call meridional_mass_flux(v, hin, vh, US%s_to_T*dt, G, GV, US, CS, LB, vhbt, OBC, visc_rem_v, v_cor, BT_cont) call cpu_clock_begin(id_clock_update) !$OMP parallel do default(shared) @@ -191,7 +192,7 @@ subroutine continuity_PPM(u, v, hin, h, uh, vh, dt, G, GV, US, CS, uhbt, vhbt, O ! 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, US, CS, LB, uhbt, OBC, visc_rem_u, u_cor, BT_cont) + call zonal_mass_flux(u, h, uh, US%s_to_T*dt, G, GV, US, CS, LB, uhbt, OBC, visc_rem_u, u_cor, BT_cont) call cpu_clock_begin(id_clock_update) !$OMP parallel do default(shared) @@ -207,18 +208,18 @@ subroutine continuity_PPM(u, v, hin, h, uh, vh, dt, G, GV, US, CS, uhbt, vhbt, O 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, US, CS, LB, uhbt, OBC, & +subroutine zonal_mass_flux(u, h_in, uh, dt_in_T, G, GV, US, CS, LB, uhbt, OBC, & visc_rem_u, u_cor, BT_cont) type(ocean_grid_type), intent(inout) :: G !< Ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< Ocean's vertical grid structure. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & - intent(in) :: u !< Zonal velocity [m s-1]. + intent(in) :: u !< Zonal velocity [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(in) :: h_in !< Layer thickness used to calculate fluxes [H ~> m or kg m-2]. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & intent(out) :: uh !< Volume flux through zonal faces = u*h*dy !! [H L2 T-1 ~> m3 s-1 or kg s-1]. - real, intent(in) :: dt !< Time increment [s]. + real, intent(in) :: dt_in_T !< Time increment [T ~> 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. @@ -241,13 +242,13 @@ subroutine zonal_mass_flux(u, h_in, uh, dt, G, GV, US, CS, LB, uhbt, OBC, & !! effective open face areas as a function of barotropic flow. ! Local variables - real, dimension(SZIB_(G),SZK_(G)) :: duhdu ! Partial derivative of uh with u [H L2 s T-1 m-1 ~> m2 or kg m-1]. + real, dimension(SZIB_(G),SZK_(G)) :: duhdu ! Partial derivative of uh with u [H L ~> m2 or kg m-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: h_L, h_R ! Left and right face thicknesses [H ~> m or kg m-2]. real, dimension(SZIB_(G)) :: & - du, & ! Corrective barotropic change in the velocity [m s-1]. + du, & ! Corrective barotropic change in the velocity [L T-1 ~> m s-1]. du_min_CFL, & ! Min/max limits on du correction du_max_CFL, & ! to avoid CFL violations - duhdu_tot_0, & ! Summed partial derivative of uh with u [H L2 s T-1 m-1 ~> m2 or kg m-1]. + duhdu_tot_0, & ! Summed partial derivative of uh with u [H L ~> m2 or kg m-1]. uh_tot_0, & ! Summed transport with no barotropic correction [H L2 T-1 ~> m3 s-1 or kg s-1]. visc_rem_max ! The column maximum of visc_rem. logical, dimension(SZIB_(G)) :: do_I @@ -257,10 +258,10 @@ subroutine zonal_mass_flux(u, h_in, uh, dt, G, GV, US, CS, LB, uhbt, OBC, & real :: FA_u ! A sum of zonal face areas [H m ~> m2 or kg m-1]. real :: I_vrm ! 1.0 / visc_rem_max, nondim. real :: CFL_dt ! The maximum CFL ratio of the adjusted velocities divided by - ! the time step [s-1]. - real :: I_dt ! 1.0 / dt [s-1]. - real :: du_lim ! The velocity change that give a relative CFL of 1 [m s-1]. - real :: dx_E, dx_W ! Effective x-grid spacings to the east and west [m]. + ! the time step [T-1 ~> s-1]. + real :: I_dt ! 1.0 / dt [T-1 ~> s-1]. + real :: du_lim ! The velocity change that give a relative CFL of 1 [L T-1 ~> m s-1]. + real :: dx_E, dx_W ! Effective x-grid spacings to the east and west [L ~> m]. integer :: i, j, k, ish, ieh, jsh, jeh, n, nz logical :: local_specified_BC, use_visc_rem, set_BT_cont, any_simple_OBC logical :: local_Flather_OBC, local_open_BC, is_simple @@ -277,8 +278,8 @@ subroutine zonal_mass_flux(u, h_in, uh, dt, G, GV, US, CS, LB, uhbt, OBC, & endif ; endif ish = LB%ish ; ieh = LB%ieh ; jsh = LB%jsh ; jeh = LB%jeh ; nz = G%ke - CFL_dt = CS%CFL_limit_adjust / dt - I_dt = 1.0 / dt + CFL_dt = CS%CFL_limit_adjust / (dt_in_T) + I_dt = 1.0 / (dt_in_T) if (CS%aggress_adjust) CFL_dt = I_dt call cpu_clock_begin(id_clock_update) @@ -314,7 +315,7 @@ subroutine zonal_mass_flux(u, h_in, uh, dt, G, GV, US, CS, LB, uhbt, OBC, & enddo ; endif call zonal_flux_layer(u(:,j,k), h_in(:,j,k), h_L(:,j,k), h_R(:,j,k), & uh(:,j,k), duhdu(:,k), visc_rem(:,k), & - dt, G, US, j, ish, ieh, do_I, CS%vol_CFL, OBC) + dt_in_T, G, US, j, ish, ieh, do_I, CS%vol_CFL, OBC) if (local_specified_BC) then do I=ish-1,ieh if (OBC%segment(OBC%segnum_u(I,j))%specified) & @@ -334,9 +335,9 @@ subroutine zonal_mass_flux(u, h_in, uh, dt, G, GV, US, CS, LB, uhbt, OBC, & I_vrm = 0.0 if (visc_rem_max(I) > 0.0) I_vrm = 1.0 / visc_rem_max(I) if (CS%vol_CFL) then - dx_W = ratio_max(G%areaT(i,j), G%dy_Cu(I,j), 1000.0*G%dxT(i,j)) - dx_E = ratio_max(G%areaT(i+1,j), G%dy_Cu(I,j), 1000.0*G%dxT(i+1,j)) - else ; dx_W = G%dxT(i,j) ; dx_E = G%dxT(i+1,j) ; endif + dx_W = US%m_to_L*ratio_max(G%areaT(i,j), G%dy_Cu(I,j), 1000.0*G%dxT(i,j)) + dx_E = US%m_to_L*ratio_max(G%areaT(i+1,j), G%dy_Cu(I,j), 1000.0*G%dxT(i+1,j)) + else ; dx_W = US%m_to_L*G%dxT(i,j) ; dx_E = US%m_to_L*G%dxT(i+1,j) ; endif du_max_CFL(I) = 2.0* (CFL_dt * dx_W) * I_vrm du_min_CFL(I) = -2.0 * (CFL_dt * dx_E) * I_vrm uh_tot_0(I) = 0.0 ; duhdu_tot_0(I) = 0.0 @@ -349,9 +350,9 @@ subroutine zonal_mass_flux(u, h_in, uh, dt, G, GV, US, CS, LB, uhbt, OBC, & if (CS%aggress_adjust) then do k=1,nz ; do I=ish-1,ieh if (CS%vol_CFL) then - dx_W = ratio_max(G%areaT(i,j), G%dy_Cu(I,j), 1000.0*G%dxT(i,j)) - dx_E = ratio_max(G%areaT(i+1,j), G%dy_Cu(I,j), 1000.0*G%dxT(i+1,j)) - else ; dx_W = G%dxT(i,j) ; dx_E = G%dxT(i+1,j) ; endif + dx_W = US%m_to_L*ratio_max(G%areaT(i,j), G%dy_Cu(I,j), 1000.0*G%dxT(i,j)) + dx_E = US%m_to_L*ratio_max(G%areaT(i+1,j), G%dy_Cu(I,j), 1000.0*G%dxT(i+1,j)) + else ; dx_W = US%m_to_L*G%dxT(i,j) ; dx_E = US%m_to_L*G%dxT(i+1,j) ; endif du_lim = 0.499*((dx_W*I_dt - u(I,j,k)) + MIN(0.0,u(I-1,j,k))) if (du_max_CFL(I) * visc_rem(I,k) > du_lim) & @@ -364,9 +365,9 @@ subroutine zonal_mass_flux(u, h_in, uh, dt, G, GV, US, CS, LB, uhbt, OBC, & else do k=1,nz ; do I=ish-1,ieh if (CS%vol_CFL) then - dx_W = ratio_max(G%areaT(i,j), G%dy_Cu(I,j), 1000.0*G%dxT(i,j)) - dx_E = ratio_max(G%areaT(i+1,j), G%dy_Cu(I,j), 1000.0*G%dxT(i+1,j)) - else ; dx_W = G%dxT(i,j) ; dx_E = G%dxT(i+1,j) ; endif + dx_W = US%m_to_L*ratio_max(G%areaT(i,j), G%dy_Cu(I,j), 1000.0*G%dxT(i,j)) + dx_E = US%m_to_L*ratio_max(G%areaT(i+1,j), G%dy_Cu(I,j), 1000.0*G%dxT(i+1,j)) + else ; dx_W = US%m_to_L*G%dxT(i,j) ; dx_E = US%m_to_L*G%dxT(i+1,j) ; endif if (du_max_CFL(I) * visc_rem(I,k) > dx_W*CFL_dt - u(I,j,k)) & du_max_CFL(I) = (dx_W*CFL_dt - u(I,j,k)) / visc_rem(I,k) @@ -378,9 +379,9 @@ subroutine zonal_mass_flux(u, h_in, uh, dt, G, GV, US, CS, LB, uhbt, OBC, & if (CS%aggress_adjust) then do k=1,nz ; do I=ish-1,ieh if (CS%vol_CFL) then - dx_W = ratio_max(G%areaT(i,j), G%dy_Cu(I,j), 1000.0*G%dxT(i,j)) - dx_E = ratio_max(G%areaT(i+1,j), G%dy_Cu(I,j), 1000.0*G%dxT(i+1,j)) - else ; dx_W = G%dxT(i,j) ; dx_E = G%dxT(i+1,j) ; endif + dx_W = US%m_to_L*ratio_max(G%areaT(i,j), G%dy_Cu(I,j), 1000.0*G%dxT(i,j)) + dx_E = US%m_to_L*ratio_max(G%areaT(i+1,j), G%dy_Cu(I,j), 1000.0*G%dxT(i+1,j)) + else ; dx_W = US%m_to_L*G%dxT(i,j) ; dx_E = US%m_to_L*G%dxT(i+1,j) ; endif du_max_CFL(I) = MIN(du_max_CFL(I), 0.499 * & ((dx_W*I_dt - u(I,j,k)) + MIN(0.0,u(I-1,j,k))) ) @@ -390,9 +391,9 @@ subroutine zonal_mass_flux(u, h_in, uh, dt, G, GV, US, CS, LB, uhbt, OBC, & else do k=1,nz ; do I=ish-1,ieh if (CS%vol_CFL) then - dx_W = ratio_max(G%areaT(i,j), G%dy_Cu(I,j), 1000.0*G%dxT(i,j)) - dx_E = ratio_max(G%areaT(i+1,j), G%dy_Cu(I,j), 1000.0*G%dxT(i+1,j)) - else ; dx_W = G%dxT(i,j) ; dx_E = G%dxT(i+1,j) ; endif + dx_W = US%m_to_L*ratio_max(G%areaT(i,j), G%dy_Cu(I,j), 1000.0*G%dxT(i,j)) + dx_E = US%m_to_L*ratio_max(G%areaT(i+1,j), G%dy_Cu(I,j), 1000.0*G%dxT(i+1,j)) + else ; dx_W = US%m_to_L*G%dxT(i,j) ; dx_E = US%m_to_L*G%dxT(i+1,j) ; endif du_max_CFL(I) = MIN(du_max_CFL(I), dx_W*CFL_dt - u(I,j,k)) du_min_CFL(I) = MAX(du_min_CFL(I), -(dx_E*CFL_dt + u(I,j,k))) @@ -418,14 +419,14 @@ subroutine zonal_mass_flux(u, h_in, uh, dt, G, GV, US, CS, LB, uhbt, OBC, & if (present(uhbt)) then call zonal_flux_adjust(u, h_in, h_L, h_R, uhbt(:,j), uh_tot_0, duhdu_tot_0, du, & - du_max_CFL, du_min_CFL, dt, G, US, CS, visc_rem, & + du_max_CFL, du_min_CFL, dt_in_T, G, US, CS, visc_rem, & j, ish, ieh, do_I, .true., uh, OBC=OBC) if (present(u_cor)) then ; do k=1,nz do I=ish-1,ieh ; u_cor(I,j,k) = u(I,j,k) + du(I) * visc_rem(I,k) ; enddo if (local_specified_BC) then ; do I=ish-1,ieh if (OBC%segment(OBC%segnum_u(I,j))%specified) & - u_cor(I,j,k) = OBC%segment(OBC%segnum_u(I,j))%normal_vel(I,j,k) + u_cor(I,j,k) = US%m_s_to_L_T*OBC%segment(OBC%segnum_u(I,j))%normal_vel(I,j,k) enddo ; endif enddo ; endif ! u-corrected @@ -433,7 +434,7 @@ subroutine zonal_mass_flux(u, h_in, uh, dt, G, GV, US, 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, US, CS, visc_rem, & + du_max_CFL, du_min_CFL, dt_in_T, G, US, CS, visc_rem, & visc_rem_max, j, ish, ieh, do_I) if (any_simple_OBC) then do I=ish-1,ieh @@ -486,10 +487,10 @@ subroutine zonal_mass_flux(u, h_in, uh, dt, G, GV, US, CS, LB, uhbt, OBC, & if (set_BT_cont) then ; if (allocated(BT_cont%h_u)) then if (present(u_cor)) then - call zonal_face_thickness(u_cor, h_in, h_L, h_R, BT_cont%h_u, dt, G, LB, & + call zonal_face_thickness(u_cor, h_in, h_L, h_R, BT_cont%h_u, dt_in_T, G, US, LB, & CS%vol_CFL, CS%marginal_faces, visc_rem_u, OBC) else - call zonal_face_thickness(u, h_in, h_L, h_R, BT_cont%h_u, dt, G, LB, & + call zonal_face_thickness(u, h_in, h_L, h_R, BT_cont%h_u, dt_in_T, G, US, LB, & CS%vol_CFL, CS%marginal_faces, visc_rem_u, OBC) endif endif ; endif @@ -497,10 +498,10 @@ subroutine zonal_mass_flux(u, h_in, uh, dt, G, GV, US, CS, LB, uhbt, OBC, & end subroutine zonal_mass_flux !> Evaluates the zonal mass or volume fluxes in a layer. -subroutine zonal_flux_layer(u, h, h_L, h_R, uh, duhdu, visc_rem, dt, G, US, j, & +subroutine zonal_flux_layer(u, h, h_L, h_R, uh, duhdu, visc_rem, dt_in_T, G, US, j, & ish, ieh, do_I, vol_CFL, OBC) type(ocean_grid_type), intent(inout) :: G !< Ocean's grid structure. - real, dimension(SZIB_(G)), intent(in) :: u !< Zonal velocity [m s-1]. + real, dimension(SZIB_(G)), intent(in) :: u !< Zonal velocity [L T-1 ~> m s-1]. real, dimension(SZIB_(G)), intent(in) :: visc_rem !< Both the fraction of the !! momentum originally in a layer that remains after a time-step !! of viscosity, and the fraction of a time-step's worth of a barotropic @@ -512,8 +513,8 @@ subroutine zonal_flux_layer(u, h, h_L, h_R, uh, duhdu, visc_rem, dt, G, US, j, & real, dimension(SZIB_(G)), intent(inout) :: uh !< Zonal mass or volume !! transport [H L2 T-1 ~> m3 s-1 or kg s-1]. real, dimension(SZIB_(G)), intent(inout) :: duhdu !< Partial derivative of uh - !! with u [H L2 s T-1 m-1 ~> m2 or kg m-1]. - real, intent(in) :: dt !< Time increment [s]. + !! with u [H L ~> m2 or kg m-1]. + real, intent(in) :: dt_in_T !< Time increment [T ~> s]. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type integer, intent(in) :: j !< Spatial index. integer, intent(in) :: ish !< Start of index range. @@ -538,35 +539,35 @@ subroutine zonal_flux_layer(u, h, h_L, h_R, uh, duhdu, visc_rem, dt, G, US, j, & do I=ish-1,ieh ; if (do_I(I)) then ! Set new values of uh and duhdu. if (u(I) > 0.0) then - if (vol_CFL) then ; CFL = (u(I) * dt) * (G%dy_Cu(I,j) * G%IareaT(i,j)) - else ; CFL = u(I) * dt * G%IdxT(i,j) ; endif + if (vol_CFL) then ; CFL = (u(I) * dt_in_T) * (US%m_to_L*G%dy_Cu(I,j) * US%L_to_m**2*G%IareaT(i,j)) + else ; CFL = u(I) * dt_in_T * US%L_to_m*G%IdxT(i,j) ; endif curv_3 = h_L(i) + h_R(i) - 2.0*h(i) - uh(I) = US%m_to_L*G%dy_Cu(I,j) * US%m_s_to_L_T*u(I) * & + uh(I) = US%m_to_L*G%dy_Cu(I,j) * u(I) * & (h_R(i) + CFL * (0.5*(h_L(i) - h_R(i)) + curv_3*(CFL - 1.5))) h_marg = h_R(i) + CFL * ((h_L(i) - h_R(i)) + 3.0*curv_3*(CFL - 1.0)) elseif (u(I) < 0.0) then - if (vol_CFL) then ; CFL = (-u(I) * dt) * (G%dy_Cu(I,j) * G%IareaT(i+1,j)) - else ; CFL = -u(I) * dt * G%IdxT(i+1,j) ; endif + if (vol_CFL) then ; CFL = (-u(I) * dt_in_T) * (US%m_to_L*G%dy_Cu(I,j) * US%L_to_m**2*G%IareaT(i+1,j)) + else ; CFL = -u(I) * dt_in_T * US%L_to_m*G%IdxT(i+1,j) ; endif curv_3 = h_L(i+1) + h_R(i+1) - 2.0*h(i+1) - uh(I) = US%m_to_L*G%dy_Cu(I,j) * US%m_s_to_L_T*u(I) * & + uh(I) = US%m_to_L*G%dy_Cu(I,j) * u(I) * & (h_L(i+1) + CFL * (0.5*(h_R(i+1)-h_L(i+1)) + curv_3*(CFL - 1.5))) h_marg = h_L(i+1) + CFL * ((h_R(i+1)-h_L(i+1)) + 3.0*curv_3*(CFL - 1.0)) else uh(I) = 0.0 h_marg = 0.5 * (h_L(i+1) + h_R(i)) endif - duhdu(I) = US%m_s_to_L_T * US%m_to_L*G%dy_Cu(I,j) * h_marg * visc_rem(I) + duhdu(I) = US%m_to_L*G%dy_Cu(I,j) * h_marg * visc_rem(I) endif ; enddo if (local_open_BC) then do I=ish-1,ieh ; if (do_I(I)) then if (OBC%segment(OBC%segnum_u(I,j))%open) then if (OBC%segment(OBC%segnum_u(I,j))%direction == OBC_DIRECTION_E) then - uh(I) = US%m_to_L*G%dy_Cu(I,j) * US%m_s_to_L_T*u(I) * h(i) - duhdu(I) = US%m_s_to_L_T * US%m_to_L*G%dy_Cu(I,j) * h(i) * visc_rem(I) + uh(I) = US%m_to_L*G%dy_Cu(I,j) * u(I) * h(i) + duhdu(I) = US%m_to_L*G%dy_Cu(I,j) * h(i) * visc_rem(I) else - uh(I) = US%m_to_L*G%dy_Cu(I,j) * US%m_s_to_L_T*u(I) * h(i+1) - duhdu(I) = US%m_s_to_L_T * US%m_to_L*G%dy_Cu(I,j) * h(i+1) * visc_rem(I) + uh(I) = US%m_to_L*G%dy_Cu(I,j) * u(I) * h(i+1) + duhdu(I) = US%m_to_L*G%dy_Cu(I,j) * h(i+1) * visc_rem(I) endif endif endif ; enddo @@ -574,10 +575,10 @@ subroutine zonal_flux_layer(u, h, h_L, h_R, uh, duhdu, visc_rem, dt, G, US, j, & end subroutine zonal_flux_layer !> Sets the effective interface thickness at each zonal velocity point. -subroutine zonal_face_thickness(u, h, h_L, h_R, h_u, dt, G, LB, vol_CFL, & +subroutine zonal_face_thickness(u, h, h_L, h_R, h_u, dt_in_T, G, US, LB, vol_CFL, & marginal, visc_rem_u, OBC) 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]. + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: u !< Zonal velocity [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness used to !! calculate fluxes [H ~> m or kg m-2]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h_L !< Left thickness in the @@ -585,7 +586,8 @@ subroutine zonal_face_thickness(u, h, h_L, h_R, h_u, dt, G, LB, vol_CFL, & real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h_R !< Right thickness in the !! reconstruction [H ~> m or kg m-2]. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: h_u !< Thickness at zonal faces [H ~> m or kg m-2]. - real, intent(in) :: dt !< Time increment [s]. + real, intent(in) :: dt_in_T !< Time increment [T ~> s]. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(loop_bounds_type), intent(in) :: LB !< Loop bounds structure. logical, intent(in) :: vol_CFL !< If true, rescale the ratio !! of face areas to the cell areas when estimating the CFL number. @@ -612,14 +614,14 @@ subroutine zonal_face_thickness(u, h, h_L, h_R, h_u, dt, G, LB, vol_CFL, & !$OMP parallel do default(shared) private(CFL,curv_3,h_marg,h_avg) do k=1,nz ; do j=jsh,jeh ; do I=ish-1,ieh if (u(I,j,k) > 0.0) then - if (vol_CFL) then ; CFL = (u(I,j,k) * dt) * (G%dy_Cu(I,j) * G%IareaT(i,j)) - else ; CFL = u(I,j,k) * dt * G%IdxT(i,j) ; endif + if (vol_CFL) then ; CFL = (u(I,j,k) * dt_in_T) * (US%m_to_L*G%dy_Cu(I,j) * US%L_to_m**2*G%IareaT(i,j)) + else ; CFL = u(I,j,k) * dt_in_T * US%L_to_m*G%IdxT(i,j) ; endif curv_3 = h_L(i,j,k) + h_R(i,j,k) - 2.0*h(i,j,k) h_avg = h_R(i,j,k) + CFL * (0.5*(h_L(i,j,k) - h_R(i,j,k)) + curv_3*(CFL - 1.5)) h_marg = h_R(i,j,k) + CFL * ((h_L(i,j,k) - h_R(i,j,k)) + 3.0*curv_3*(CFL - 1.0)) elseif (u(I,j,k) < 0.0) then - if (vol_CFL) then ; CFL = (-u(I,j,k)*dt) * (G%dy_Cu(I,j) * G%IareaT(i+1,j)) - else ; CFL = -u(I,j,k) * dt * G%IdxT(i+1,j) ; endif + if (vol_CFL) then ; CFL = (-u(I,j,k)*dt_in_T) * (US%m_to_L*G%dy_Cu(I,j) * US%L_to_m**2*G%IareaT(i+1,j)) + else ; CFL = -u(I,j,k) * dt_in_T * US%L_to_m*G%IdxT(i+1,j) ; endif curv_3 = h_L(i+1,j,k) + h_R(i+1,j,k) - 2.0*h(i+1,j,k) h_avg = h_L(i+1,j,k) + CFL * (0.5*(h_R(i+1,j,k)-h_L(i+1,j,k)) + curv_3*(CFL - 1.5)) h_marg = h_L(i+1,j,k) + CFL * ((h_R(i+1,j,k)-h_L(i+1,j,k)) + & @@ -681,10 +683,10 @@ end subroutine zonal_face_thickness !> Returns the barotropic velocity adjustment that gives the !! desired barotropic (layer-summed) transport. subroutine zonal_flux_adjust(u, h_in, h_L, h_R, uhbt, uh_tot_0, duhdu_tot_0, & - du, du_max_CFL, du_min_CFL, dt, G, US, CS, visc_rem, & + du, du_max_CFL, du_min_CFL, dt_in_T, G, US, CS, visc_rem, & j, ish, ieh, do_I_in, full_precision, uh_3d, OBC) 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]. + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: u !< Zonal velocity [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h_in !< Layer thickness used to !! calculate fluxes [H ~> m or kg m-2]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h_L !< Left thickness in the @@ -700,16 +702,16 @@ subroutine zonal_flux_adjust(u, h_in, h_L, h_R, uhbt, uh_tot_0, duhdu_tot_0, & !! through zonal faces [H L2 T-1 ~> m3 s-1 or kg s-1]. real, dimension(SZIB_(G)), intent(in) :: du_max_CFL !< Maximum acceptable - !! value of du [m s-1]. + !! value of du [L T-1 ~> m s-1]. real, dimension(SZIB_(G)), intent(in) :: du_min_CFL !< Minimum acceptable - !! value of du [m s-1]. + !! value of du [L T-1 ~> m s-1]. real, dimension(SZIB_(G)), intent(in) :: uh_tot_0 !< The summed transport !! with 0 adjustment [H L2 T-1 ~> m3 s-1 or kg s-1]. real, dimension(SZIB_(G)), intent(in) :: duhdu_tot_0 !< The partial derivative - !! of du_err with du at 0 adjustment [H L2 s T-1 m-1 ~> m2 or kg m-1]. + !! of du_err with du at 0 adjustment [H L ~> m2 or kg m-1]. real, dimension(SZIB_(G)), intent(out) :: du !< - !! The barotropic velocity adjustment [m s-1]. - real, intent(in) :: dt !< Time increment [s]. + !! The barotropic velocity adjustment [L T-1 ~> m s-1]. + real, intent(in) :: dt_in_T !< Time increment [T ~> s]. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(continuity_PPM_CS), pointer :: CS !< This module's control structure. integer, intent(in) :: j !< Spatial index. @@ -726,18 +728,18 @@ subroutine zonal_flux_adjust(u, h_in, h_L, h_R, uhbt, uh_tot_0, duhdu_tot_0, & ! Local variables real, dimension(SZIB_(G),SZK_(G)) :: & uh_aux, & ! An auxiliary zonal volume flux [H L2 s-1 ~> m3 s-1 or kg s-1]. - duhdu ! Partial derivative of uh with u [H L2 s T-1 m-1 ~> m2 or kg m-1]. + duhdu ! Partial derivative of uh with u [H L ~> m2 or kg m-1]. real, dimension(SZIB_(G)) :: & uh_err, & ! Difference between uhbt and the summed uh [H L2 T-1 ~> m3 s-1 or kg s-1]. uh_err_best, & ! The smallest value of uh_err found so far [H L2 T-1 ~> m3 s-1 or kg s-1]. - u_new, & ! The velocity with the correction added [m s-1]. - duhdu_tot,&! Summed partial derivative of uh with u [H L2 s T-1 m-1 ~> m2 or kg m-1]. + u_new, & ! The velocity with the correction added [L T-1 ~> m s-1]. + duhdu_tot,&! Summed partial derivative of uh with u [H L ~> m2 or kg m-1]. du_min, & ! Min/max limits on du correction based on CFL limits - du_max ! and previous iterations [m s-1]. - real :: du_prev ! The previous value of du [m s-1]. - real :: ddu ! The change in du from the previous iteration [m s-1]. + du_max ! and previous iterations [L T-1 ~> m s-1]. + real :: du_prev ! The previous value of du [L T-1 ~> m s-1]. + real :: ddu ! The change in du from the previous iteration [L T-1 ~> m s-1]. real :: tol_eta ! The tolerance for the current iteration [H ~> m or kg m-2]. - real :: tol_vel ! The tolerance for velocity in the current iteration [m s-1]. + real :: tol_vel ! The tolerance for velocity in the current iteration [L T-1 ~> m s-1]. integer :: i, k, nz, itt, max_itts = 20 logical :: full_prec, domore, do_I(SZIB_(G)) @@ -777,7 +779,7 @@ subroutine zonal_flux_adjust(u, h_in, h_L, h_R, uhbt, uh_tot_0, duhdu_tot_0, & enddo domore = .false. do I=ish-1,ieh ; if (do_I(I)) then - if ((US%s_to_T*dt * min(US%L_to_m**2*G%IareaT(i,j),US%L_to_m**2*G%IareaT(i+1,j))*abs(uh_err(I)) > tol_eta) .or. & + if ((dt_in_T * min(US%L_to_m**2*G%IareaT(i,j),US%L_to_m**2*G%IareaT(i+1,j))*abs(uh_err(I)) > tol_eta) .or. & (CS%better_iter .and. ((abs(uh_err(I)) > tol_vel * duhdu_tot(I)) .or. & (abs(uh_err(I)) > uh_err_best(I))) )) then ! Use Newton's method, provided it stays bounded. Otherwise bisect @@ -816,7 +818,7 @@ subroutine zonal_flux_adjust(u, h_in, h_L, h_R, uhbt, uh_tot_0, duhdu_tot_0, & do I=ish-1,ieh ; u_new(I) = u(I,j,k) + du(I) * visc_rem(I,k) ; enddo call zonal_flux_layer(u_new, h_in(:,j,k), h_L(:,j,k), h_R(:,j,k), & uh_aux(:,k), duhdu(:,k), visc_rem(:,k), & - dt, G, US, j, ish, ieh, do_I, CS%vol_CFL, OBC) + dt_in_T, G, US, j, ish, ieh, do_I, CS%vol_CFL, OBC) enddo ; endif if (itt < max_itts) then @@ -845,10 +847,10 @@ 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, US, CS, visc_rem, & + du_max_CFL, du_min_CFL, dt_in_T, 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]. + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: u !< Zonal velocity [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h_in !< Layer thickness used to !! calculate fluxes [H ~> m or kg m-2]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h_L !< Left thickness in the @@ -860,12 +862,12 @@ 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) :: uh_tot_0 !< The summed transport !! with 0 adjustment [H L2 T-1 ~> m3 s-1 or kg s-1]. real, dimension(SZIB_(G)), intent(in) :: duhdu_tot_0 !< The partial derivative - !! of du_err with du at 0 adjustment [H L2 s T-1 m-1 ~> m2 or kg m-1]. + !! of du_err with du at 0 adjustment [H L ~> m2 or kg m-1]. real, dimension(SZIB_(G)), intent(in) :: du_max_CFL !< Maximum acceptable - !! value of du [m s-1]. + !! value of du [L T-1 ~> m s-1]. real, dimension(SZIB_(G)), intent(in) :: du_min_CFL !< Minimum acceptable - !! value of du [m s-1]. - real, intent(in) :: dt !< Time increment [s]. + !! value of du [L T-1 ~> m s-1]. + real, intent(in) :: dt_in_T !< 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 @@ -881,16 +883,16 @@ subroutine set_zonal_BT_cont(u, h_in, h_L, h_R, BT_cont, uh_tot_0, duhdu_tot_0, !! which I values to work on. ! Local variables real, dimension(SZIB_(G)) :: & - du0, & ! The barotropic velocity increment that gives 0 transport [m s-1]. + du0, & ! The barotropic velocity increment that gives 0 transport [L T-1 ~> m s-1]. duL, duR, & ! The barotropic velocity increments that give the westerly - ! (duL) and easterly (duR) test velocities. + ! (duL) and easterly (duR) test velocities [L T-1 ~> m s-1]. zeros, & ! An array of full of 0's. - du_CFL, & ! The velocity increment that corresponds to CFL_min [m s-1]. + du_CFL, & ! The velocity increment that corresponds to CFL_min [L T-1 ~> m s-1]. u_L, u_R, & ! The westerly (u_L), easterly (u_R), and zero-barotropic - u_0, & ! transport (u_0) layer test velocities [m s-1]. + u_0, & ! transport (u_0) layer test velocities [L T-1 ~> m s-1]. duhdu_L, & ! The effective layer marginal face areas with the westerly duhdu_R, & ! (_L), easterly (_R), and zero-barotropic (_0) test - duhdu_0, & ! velocities [H L2 s T-1 m-1 ~> m2 or kg m-1]. + duhdu_0, & ! velocities [H L ~> m2 or kg m-1]. uh_L, uh_R, & ! The layer transports with the westerly (_L), easterly (_R), uh_0, & ! and zero-barotropic (_0) test velocities [H L2 T-1 ~> m3 s-1 or kg s-1]. FAmt_L, FAmt_R, & ! The summed effective marginal face areas for the 3 @@ -909,17 +911,17 @@ subroutine set_zonal_BT_cont(u, h_in, h_L, h_R, BT_cont, uh_tot_0, duhdu_tot_0, ! of visc_rem from leading to large CFL numbers. real :: CFL_min ! A minimal increment in the CFL to try to ensure that the ! flow is truly upwind [nondim] - real :: Idt ! The inverse of the time step [s-1]. + real :: Idt ! The inverse of the time step [T-1 ~> s-1]. logical :: domore integer :: i, k, nz - nz = G%ke ; Idt = 1.0/dt + nz = G%ke ; Idt = 1.0 / (dt_in_T) min_visc_rem = 0.1 ; CFL_min = 1e-6 ! Diagnose the zero-transport correction, du0. do I=ish-1,ieh ; zeros(I) = 0.0 ; enddo call zonal_flux_adjust(u, h_in, h_L, h_R, zeros, uh_tot_0, duhdu_tot_0, du0, & - du_max_CFL, du_min_CFL, dt, G, US, CS, visc_rem, & + du_max_CFL, du_min_CFL, dt_in_T, G, US, CS, visc_rem, & j, ish, ieh, do_I, .true.) ! Determine the westerly- and easterly- fluxes. Choose a sufficiently @@ -928,7 +930,7 @@ subroutine set_zonal_BT_cont(u, h_in, h_L, h_R, BT_cont, uh_tot_0, duhdu_tot_0, domore = .false. do I=ish-1,ieh if (do_I(I)) domore = .true. - du_CFL(I) = (CFL_min * Idt) * G%dxCu(I,j) + du_CFL(I) = (CFL_min * Idt) * US%m_to_L*G%dxCu(I,j) duR(I) = min(0.0,du0(I) - du_CFL(I)) duL(I) = max(0.0,du0(I) + du_CFL(I)) FAmt_L(I) = 0.0 ; FAmt_R(I) = 0.0 ; FAmt_0(I) = 0.0 @@ -961,15 +963,15 @@ subroutine set_zonal_BT_cont(u, h_in, h_L, h_R, BT_cont, uh_tot_0, duhdu_tot_0, u_0(I) = u(I,j,k) + du0(I) * visc_rem(I,k) endif ; enddo call zonal_flux_layer(u_0, h_in(:,j,k), h_L(:,j,k), h_R(:,j,k), uh_0, duhdu_0, & - visc_rem(:,k), dt, G, US, j, ish, ieh, do_I, CS%vol_CFL) + visc_rem(:,k), dt_in_T, G, US, j, ish, ieh, do_I, CS%vol_CFL) call zonal_flux_layer(u_L, h_in(:,j,k), h_L(:,j,k), h_R(:,j,k), uh_L, duhdu_L, & - visc_rem(:,k), dt, G, US, j, ish, ieh, do_I, CS%vol_CFL) + visc_rem(:,k), dt_in_T, G, US, j, ish, ieh, do_I, CS%vol_CFL) call zonal_flux_layer(u_R, h_in(:,j,k), h_L(:,j,k), h_R(:,j,k), uh_R, duhdu_R, & - visc_rem(:,k), dt, G, US, j, ish, ieh, do_I, CS%vol_CFL) + visc_rem(:,k), dt_in_T, G, US, j, ish, ieh, do_I, CS%vol_CFL) do I=ish-1,ieh ; if (do_I(I)) then - FAmt_0(I) = FAmt_0(I) + US%L_T_to_m_s*duhdu_0(I) - FAmt_L(I) = FAmt_L(I) + US%L_T_to_m_s*duhdu_L(I) - FAmt_R(I) = FAmt_R(I) + US%L_T_to_m_s*duhdu_R(I) + FAmt_0(I) = FAmt_0(I) + duhdu_0(I) + FAmt_L(I) = FAmt_L(I) + duhdu_L(I) + FAmt_R(I) = FAmt_R(I) + duhdu_R(I) uhtot_L(I) = uhtot_L(I) + uh_L(I) uhtot_R(I) = uhtot_R(I) + uh_R(I) endif ; enddo @@ -977,25 +979,25 @@ subroutine set_zonal_BT_cont(u, h_in, h_L, h_R, BT_cont, uh_tot_0, duhdu_tot_0, do I=ish-1,ieh ; if (do_I(I)) then FA_0 = FAmt_0(I) ; FA_avg = FAmt_0(I) if ((duL(I) - du0(I)) /= 0.0) & - FA_avg = US%L_T_to_m_s*uhtot_L(I) / (duL(I) - du0(I)) + FA_avg = uhtot_L(I) / (duL(I) - du0(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_u_W0(I,j) = FA_0 ; BT_cont%FA_u_WW(I,j) = 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) = US%m_s_to_L_T*(1.5 * (duL(I) - du0(I))) * & + BT_cont%uBT_WW(I,j) = (1.5 * (duL(I) - du0(I))) * & ((FAmt_L(I) - FA_avg) / (FAmt_L(I) - FA_0)) endif FA_0 = FAmt_0(I) ; FA_avg = FAmt_0(I) if ((duR(I) - du0(I)) /= 0.0) & - FA_avg = US%L_T_to_m_s*uhtot_R(I) / (duR(I) - du0(I)) + FA_avg = uhtot_R(I) / (duR(I) - du0(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_u_E0(I,j) = FA_0 ; BT_cont%FA_u_EE(I,j) = 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) = US%m_s_to_L_T*(1.5 * (duR(I) - du0(I))) * & + BT_cont%uBT_EE(I,j) = (1.5 * (duR(I) - du0(I))) * & ((FAmt_R(I) - FA_avg) / (FAmt_R(I) - FA_0)) endif else @@ -1007,18 +1009,18 @@ 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, US, CS, LB, vhbt, OBC, & +subroutine meridional_mass_flux(v, h_in, vh, dt_in_T, G, GV, US, CS, LB, vhbt, OBC, & visc_rem_v, v_cor, BT_cont) type(ocean_grid_type), intent(inout) :: G !< Ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< Ocean's vertical grid structure. - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: v !< Meridional velocity [m s-1]. + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: v !< Meridional velocity [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h_in !< Layer thickness used to !! calculate fluxes [H ~> m or kg m-2]. 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]. + real, intent(in) :: dt_in_T !< Time increment [T ~> 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(continuity_PPM_CS), pointer :: CS !< This module's control structure.G type(loop_bounds_type), intent(in) :: LB !< Loop bounds structure. type(ocean_OBC_type), optional, pointer :: OBC !< Open boundary condition type !! specifies whether, where, and what open boundary conditions are used. @@ -1033,19 +1035,19 @@ subroutine meridional_mass_flux(v, h_in, vh, dt, G, GV, US, CS, LB, vhbt, OBC, & real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & optional, intent(out) :: v_cor !< The meridional velocitiess (v with a barotropic correction) - !! that give vhbt as the depth-integrated transport [m s-1]. + !! that give vhbt as the depth-integrated transport [L T-1 ~> m s-1]. 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. ! Local variables real, dimension(SZI_(G),SZK_(G)) :: & - dvhdv ! Partial derivative of vh with v [H L2 s T-1 m-1 ~> m2 or kg m-1]. + dvhdv ! Partial derivative of vh with v [H L ~> m2 or kg m-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: & h_L, h_R ! Left and right face thicknesses [H ~> m or kg m-2]. real, dimension(SZI_(G)) :: & - dv, & ! Corrective barotropic change in the velocity [m s-1]. + dv, & ! Corrective barotropic change in the velocity [L T-1 ~> m s-1]. dv_min_CFL, & ! Min/max limits on dv correction dv_max_CFL, & ! to avoid CFL violations - dvhdv_tot_0, & ! Summed partial derivative of vh with v [H L2 s T-1 m-1 ~> m2 or kg m-1]. + dvhdv_tot_0, & ! Summed partial derivative of vh with v [H L ~> m2 or kg m-1]. vh_tot_0, & ! Summed transport with no barotropic correction [H L2 T-1 ~> m3 s-1 or kg s-1]. visc_rem_max ! The column maximum of visc_rem. logical, dimension(SZI_(G)) :: do_I @@ -1055,10 +1057,10 @@ subroutine meridional_mass_flux(v, h_in, vh, dt, G, GV, US, CS, LB, vhbt, OBC, & visc_rem ! A 2-D copy of visc_rem_v or an array of 1's. real :: I_vrm ! 1.0 / visc_rem_max, nondim. real :: CFL_dt ! The maximum CFL ratio of the adjusted velocities divided by - ! the time step [s-1]. - real :: I_dt ! 1.0 / dt [s-1]. - real :: dv_lim ! The velocity change that give a relative CFL of 1 [m s-1]. - real :: dy_N, dy_S ! Effective y-grid spacings to the north and south [m]. + ! the time step [T-1 ~> s-1]. + real :: I_dt ! 1.0 / dt [T-1 ~> s-1]. + real :: dv_lim ! The velocity change that give a relative CFL of 1 [L T-1 ~> m s-1]. + real :: dy_N, dy_S ! Effective y-grid spacings to the north and south [L ~> m]. integer :: i, j, k, ish, ieh, jsh, jeh, n, nz logical :: local_specified_BC, use_visc_rem, set_BT_cont, any_simple_OBC logical :: local_Flather_OBC, is_simple, local_open_BC @@ -1075,8 +1077,8 @@ subroutine meridional_mass_flux(v, h_in, vh, dt, G, GV, US, CS, LB, vhbt, OBC, & endif ; endif ; endif ish = LB%ish ; ieh = LB%ieh ; jsh = LB%jsh ; jeh = LB%jeh ; nz = G%ke - CFL_dt = CS%CFL_limit_adjust / dt - I_dt = 1.0 / dt + CFL_dt = CS%CFL_limit_adjust / (dt_in_T) + I_dt = 1.0 / (dt_in_T) if (CS%aggress_adjust) CFL_dt = I_dt call cpu_clock_begin(id_clock_update) @@ -1113,7 +1115,7 @@ subroutine meridional_mass_flux(v, h_in, vh, dt, G, GV, US, CS, LB, vhbt, OBC, & enddo ; endif call merid_flux_layer(v(:,J,k), h_in(:,:,k), h_L(:,:,k), h_R(:,:,k), & vh(:,J,k), dvhdv(:,k), visc_rem(:,k), & - dt, G, US, J, ish, ieh, do_I, CS%vol_CFL, OBC) + dt_in_T, G, US, J, ish, ieh, do_I, CS%vol_CFL, OBC) if (local_specified_BC) then do i=ish,ieh if (OBC%segment(OBC%segnum_v(i,J))%specified) & @@ -1132,9 +1134,9 @@ subroutine meridional_mass_flux(v, h_in, vh, dt, G, GV, US, CS, LB, vhbt, OBC, & I_vrm = 0.0 if (visc_rem_max(i) > 0.0) I_vrm = 1.0 / visc_rem_max(i) if (CS%vol_CFL) then - dy_S = ratio_max(G%areaT(i,j), G%dx_Cv(i,J), 1000.0*G%dyT(i,j)) - dy_N = ratio_max(G%areaT(i,j+1), G%dx_Cv(i,J), 1000.0*G%dyT(i,j+1)) - else ; dy_S = G%dyT(i,j) ; dy_N = G%dyT(i,j+1) ; endif + dy_S = US%m_to_L*ratio_max(G%areaT(i,j), G%dx_Cv(i,J), 1000.0*G%dyT(i,j)) + dy_N = US%m_to_L*ratio_max(G%areaT(i,j+1), G%dx_Cv(i,J), 1000.0*G%dyT(i,j+1)) + else ; dy_S = US%m_to_L*G%dyT(i,j) ; dy_N = US%m_to_L*G%dyT(i,j+1) ; endif dv_max_CFL(i) = 2.0 * (CFL_dt * dy_S) * I_vrm dv_min_CFL(i) = -2.0 * (CFL_dt * dy_N) * I_vrm vh_tot_0(i) = 0.0 ; dvhdv_tot_0(i) = 0.0 @@ -1148,9 +1150,9 @@ subroutine meridional_mass_flux(v, h_in, vh, dt, G, GV, US, CS, LB, vhbt, OBC, & if (CS%aggress_adjust) then do k=1,nz ; do i=ish,ieh if (CS%vol_CFL) then - dy_S = ratio_max(G%areaT(i,j), G%dx_Cv(I,j), 1000.0*G%dyT(i,j)) - dy_N = ratio_max(G%areaT(i,j+1), G%dx_Cv(I,j), 1000.0*G%dyT(i,j+1)) - else ; dy_S = G%dyT(i,j) ; dy_N = G%dyT(i,j+1) ; endif + dy_S = US%m_to_L*ratio_max(G%areaT(i,j), G%dx_Cv(I,j), 1000.0*G%dyT(i,j)) + dy_N = US%m_to_L*ratio_max(G%areaT(i,j+1), G%dx_Cv(I,j), 1000.0*G%dyT(i,j+1)) + else ; dy_S = US%m_to_L*G%dyT(i,j) ; dy_N = US%m_to_L*G%dyT(i,j+1) ; endif dv_lim = 0.499*((dy_S*I_dt - v(i,J,k)) + MIN(0.0,v(i,J-1,k))) if (dv_max_CFL(i) * visc_rem(i,k) > dv_lim) & dv_max_CFL(i) = dv_lim / visc_rem(i,k) @@ -1162,9 +1164,9 @@ subroutine meridional_mass_flux(v, h_in, vh, dt, G, GV, US, CS, LB, vhbt, OBC, & else do k=1,nz ; do i=ish,ieh if (CS%vol_CFL) then - dy_S = ratio_max(G%areaT(i,j), G%dx_Cv(I,j), 1000.0*G%dyT(i,j)) - dy_N = ratio_max(G%areaT(i,j+1), G%dx_Cv(I,j), 1000.0*G%dyT(i,j+1)) - else ; dy_S = G%dyT(i,j) ; dy_N = G%dyT(i,j+1) ; endif + dy_S = US%m_to_L*ratio_max(G%areaT(i,j), G%dx_Cv(I,j), 1000.0*G%dyT(i,j)) + dy_N = US%m_to_L*ratio_max(G%areaT(i,j+1), G%dx_Cv(I,j), 1000.0*G%dyT(i,j+1)) + else ; dy_S = US%m_to_L*G%dyT(i,j) ; dy_N = US%m_to_L*G%dyT(i,j+1) ; endif if (dv_max_CFL(i) * visc_rem(i,k) > dy_S*CFL_dt - v(i,J,k)) & dv_max_CFL(i) = (dy_S*CFL_dt - v(i,J,k)) / visc_rem(i,k) if (dv_min_CFL(i) * visc_rem(i,k) < -dy_N*CFL_dt - v(i,J,k)) & @@ -1175,9 +1177,9 @@ subroutine meridional_mass_flux(v, h_in, vh, dt, G, GV, US, CS, LB, vhbt, OBC, & if (CS%aggress_adjust) then do k=1,nz ; do i=ish,ieh if (CS%vol_CFL) then - dy_S = ratio_max(G%areaT(i,j), G%dx_Cv(I,j), 1000.0*G%dyT(i,j)) - dy_N = ratio_max(G%areaT(i,j+1), G%dx_Cv(I,j), 1000.0*G%dyT(i,j+1)) - else ; dy_S = G%dyT(i,j) ; dy_N = G%dyT(i,j+1) ; endif + dy_S = US%m_to_L*ratio_max(G%areaT(i,j), G%dx_Cv(I,j), 1000.0*G%dyT(i,j)) + dy_N = US%m_to_L*ratio_max(G%areaT(i,j+1), G%dx_Cv(I,j), 1000.0*G%dyT(i,j+1)) + else ; dy_S = US%m_to_L*G%dyT(i,j) ; dy_N = US%m_to_L*G%dyT(i,j+1) ; endif dv_max_CFL(i) = min(dv_max_CFL(i), 0.499 * & ((dy_S*I_dt - v(i,J,k)) + MIN(0.0,v(i,J-1,k))) ) dv_min_CFL(i) = max(dv_min_CFL(i), 0.499 * & @@ -1186,9 +1188,9 @@ subroutine meridional_mass_flux(v, h_in, vh, dt, G, GV, US, CS, LB, vhbt, OBC, & else do k=1,nz ; do i=ish,ieh if (CS%vol_CFL) then - dy_S = ratio_max(G%areaT(i,j), G%dx_Cv(I,j), 1000.0*G%dyT(i,j)) - dy_N = ratio_max(G%areaT(i,j+1), G%dx_Cv(I,j), 1000.0*G%dyT(i,j+1)) - else ; dy_S = G%dyT(i,j) ; dy_N = G%dyT(i,j+1) ; endif + dy_S = US%m_to_L*ratio_max(G%areaT(i,j), G%dx_Cv(I,j), 1000.0*G%dyT(i,j)) + dy_N = US%m_to_L*ratio_max(G%areaT(i,j+1), G%dx_Cv(I,j), 1000.0*G%dyT(i,j+1)) + else ; dy_S = US%m_to_L*G%dyT(i,j) ; dy_N = US%m_to_L*G%dyT(i,j+1) ; endif dv_max_CFL(i) = min(dv_max_CFL(i), dy_S*CFL_dt - v(i,J,k)) dv_min_CFL(i) = max(dv_min_CFL(i), -(dy_N*CFL_dt + v(i,J,k))) enddo ; enddo @@ -1213,21 +1215,21 @@ subroutine meridional_mass_flux(v, h_in, vh, dt, G, GV, US, CS, LB, vhbt, OBC, & if (present(vhbt)) then call meridional_flux_adjust(v, h_in, h_L, h_R, vhbt(:,J), vh_tot_0, dvhdv_tot_0, dv, & - dv_max_CFL, dv_min_CFL, dt, G, US, CS, visc_rem, & + dv_max_CFL, dv_min_CFL, dt_in_T, G, US, CS, visc_rem, & j, ish, ieh, do_I, .true., vh, OBC=OBC) if (present(v_cor)) then ; do k=1,nz do i=ish,ieh ; v_cor(i,J,k) = v(i,J,k) + dv(i) * visc_rem(i,k) ; enddo if (local_specified_BC) then ; do i=ish,ieh if (OBC%segment(OBC%segnum_v(i,J))%specified) & - v_cor(i,J,k) = OBC%segment(OBC%segnum_v(i,J))%normal_vel(i,J,k) + v_cor(i,J,k) = US%m_s_to_L_T*OBC%segment(OBC%segnum_v(i,J))%normal_vel(i,J,k) enddo ; endif enddo ; endif ! v-corrected endif 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, US, CS, visc_rem, & + dv_max_CFL, dv_min_CFL, dt_in_T, G, US, CS, visc_rem, & visc_rem_max, J, ish, ieh, do_I) if (any_simple_OBC) then do i=ish,ieh @@ -1281,10 +1283,10 @@ subroutine meridional_mass_flux(v, h_in, vh, dt, G, GV, US, CS, LB, vhbt, OBC, & if (set_BT_cont) then ; if (allocated(BT_cont%h_v)) then if (present(v_cor)) then - call merid_face_thickness(v_cor, h_in, h_L, h_R, BT_cont%h_v, dt, G, LB, & + call merid_face_thickness(v_cor, h_in, h_L, h_R, BT_cont%h_v, dt_in_T, G, US, LB, & CS%vol_CFL, CS%marginal_faces, visc_rem_v, OBC) else - call merid_face_thickness(v, h_in, h_L, h_R, BT_cont%h_v, dt, G, LB, & + call merid_face_thickness(v, h_in, h_L, h_R, BT_cont%h_v, dt_in_T, G, US, LB, & CS%vol_CFL, CS%marginal_faces, visc_rem_v, OBC) endif endif ; endif @@ -1292,10 +1294,10 @@ subroutine meridional_mass_flux(v, h_in, vh, dt, G, GV, US, CS, LB, vhbt, OBC, & end subroutine meridional_mass_flux !> Evaluates the meridional mass or volume fluxes in a layer. -subroutine merid_flux_layer(v, h, h_L, h_R, vh, dvhdv, visc_rem, dt, G, US, J, & +subroutine merid_flux_layer(v, h, h_L, h_R, vh, dvhdv, visc_rem, dt_in_T, G, US, J, & ish, ieh, do_I, vol_CFL, OBC) type(ocean_grid_type), intent(inout) :: G !< Ocean's grid structure. - real, dimension(SZI_(G)), intent(in) :: v !< Meridional velocity [m s-1]. + real, dimension(SZI_(G)), intent(in) :: v !< Meridional velocity [L T-1 ~> m s-1]. real, dimension(SZI_(G)), intent(in) :: visc_rem !< Both the fraction of the !! momentum originally in a layer that remains after a time-step !! of viscosity, and the fraction of a time-step's worth of a barotropic @@ -1310,8 +1312,8 @@ subroutine merid_flux_layer(v, h, h_L, h_R, vh, dvhdv, visc_rem, dt, G, US, J, & real, dimension(SZI_(G)), intent(inout) :: vh !< Meridional mass or volume transport !! [H L2 T-1 ~> m3 s-1 or kg s-1]. real, dimension(SZI_(G)), intent(inout) :: dvhdv !< Partial derivative of vh with v - !! [H L2 s T-1 m-1 ~> m2 or kg m-1]. - real, intent(in) :: dt !< Time increment [s]. + !! [H L ~> m2 or kg m-1]. + real, intent(in) :: dt_in_T !< Time increment [T ~> s]. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type integer, intent(in) :: j !< Spatial index. integer, intent(in) :: ish !< Start of index range. @@ -1335,18 +1337,18 @@ subroutine merid_flux_layer(v, h, h_L, h_R, vh, dvhdv, visc_rem, dt, G, US, J, & do i=ish,ieh ; if (do_I(i)) then if (v(i) > 0.0) then - if (vol_CFL) then ; CFL = (v(i) * dt) * (G%dx_Cv(i,J) * G%IareaT(i,j)) - else ; CFL = v(i) * dt * G%IdyT(i,j) ; endif + if (vol_CFL) then ; CFL = (v(i) * dt_in_T) * (US%m_to_L*G%dx_Cv(i,J) * US%L_to_m**2*G%IareaT(i,j)) + else ; CFL = v(i) * dt_in_T * US%L_to_m*G%IdyT(i,j) ; endif curv_3 = h_L(i,j) + h_R(i,j) - 2.0*h(i,j) - vh(i) = US%m_to_L*G%dx_Cv(i,J) * US%m_s_to_L_T*v(i) * ( h_R(i,j) + CFL * & + vh(i) = US%m_to_L*G%dx_Cv(i,J) * v(i) * ( h_R(i,j) + CFL * & (0.5*(h_L(i,j) - h_R(i,j)) + curv_3*(CFL - 1.5)) ) h_marg = h_R(i,j) + CFL * ((h_L(i,j) - h_R(i,j)) + & 3.0*curv_3*(CFL - 1.0)) elseif (v(i) < 0.0) then - if (vol_CFL) then ; CFL = (-v(i) * dt) * (G%dx_Cv(i,J) * G%IareaT(i,j+1)) - else ; CFL = -v(i) * dt * G%IdyT(i,j+1) ; endif + if (vol_CFL) then ; CFL = (-v(i) * dt_in_T) * (US%m_to_L*G%dx_Cv(i,J) * US%L_to_m**2*G%IareaT(i,j+1)) + else ; CFL = -v(i) * dt_in_T * US%L_to_m*G%IdyT(i,j+1) ; endif curv_3 = h_L(i,j+1) + h_R(i,j+1) - 2.0*h(i,j+1) - vh(i) = US%m_to_L*G%dx_Cv(i,J) * US%m_s_to_L_T*v(i) * ( h_L(i,j+1) + CFL * & + vh(i) = US%m_to_L*G%dx_Cv(i,J) * v(i) * ( h_L(i,j+1) + CFL * & (0.5*(h_R(i,j+1)-h_L(i,j+1)) + curv_3*(CFL - 1.5)) ) h_marg = h_L(i,j+1) + CFL * ((h_R(i,j+1)-h_L(i,j+1)) + & 3.0*curv_3*(CFL - 1.0)) @@ -1354,18 +1356,18 @@ subroutine merid_flux_layer(v, h, h_L, h_R, vh, dvhdv, visc_rem, dt, G, US, J, & vh(i) = 0.0 h_marg = 0.5 * (h_L(i,j+1) + h_R(i,j)) endif - dvhdv(i) = US%m_s_to_L_T * US%m_to_L*G%dx_Cv(i,J) * h_marg * visc_rem(i) + dvhdv(i) = US%m_to_L*G%dx_Cv(i,J) * h_marg * visc_rem(i) endif ; enddo if (local_open_BC) then do i=ish,ieh ; if (do_I(i)) then if (OBC%segment(OBC%segnum_v(i,J))%open) then if (OBC%segment(OBC%segnum_v(i,J))%direction == OBC_DIRECTION_N) then - vh(i) = US%m_to_L*G%dx_Cv(i,J) * US%m_s_to_L_T*v(i) * h(i,j) - dvhdv(i) = US%m_s_to_L_T * US%m_to_L*G%dx_Cv(i,J) * h(i,j) * visc_rem(i) + vh(i) = US%m_to_L*G%dx_Cv(i,J) * v(i) * h(i,j) + dvhdv(i) = US%m_to_L*G%dx_Cv(i,J) * h(i,j) * visc_rem(i) else - vh(i) = US%m_to_L*G%dx_Cv(i,J) * US%m_s_to_L_T*v(i) * h(i,j+1) - dvhdv(i) = US%m_s_to_L_T * US%m_to_L*G%dx_Cv(i,J) * h(i,j+1) * visc_rem(i) + vh(i) = US%m_to_L*G%dx_Cv(i,J) * v(i) * h(i,j+1) + dvhdv(i) = US%m_to_L*G%dx_Cv(i,J) * h(i,j+1) * visc_rem(i) endif endif endif ; enddo @@ -1373,10 +1375,10 @@ subroutine merid_flux_layer(v, h, h_L, h_R, vh, dvhdv, visc_rem, dt, G, US, J, & end subroutine merid_flux_layer !> Sets the effective interface thickness at each meridional velocity point. -subroutine merid_face_thickness(v, h, h_L, h_R, h_v, dt, G, LB, vol_CFL, & +subroutine merid_face_thickness(v, h, h_L, h_R, h_v, dt_in_T, G, US, LB, vol_CFL, & marginal, visc_rem_v, OBC) 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]. + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: v !< Meridional velocity [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness used to calculate fluxes, !! [H ~> m or kg m-2]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h_L !< Left thickness in the reconstruction, @@ -1385,8 +1387,9 @@ subroutine merid_face_thickness(v, h, h_L, h_R, h_v, dt, G, LB, vol_CFL, & !! [H ~> m or kg m-2]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: h_v !< Thickness at meridional faces, !! [H ~> m or kg m-2]. - real, intent(in) :: dt !< Time increment [s]. + real, intent(in) :: dt_in_T !< Time increment [T ~> s]. type(loop_bounds_type), intent(in) :: LB !< Loop bounds structure. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type logical, intent(in) :: vol_CFL !< If true, rescale the ratio !! of face areas to the cell areas when estimating the CFL number. logical, intent(in) :: marginal !< If true, report the marginal @@ -1401,7 +1404,7 @@ subroutine merid_face_thickness(v, h, h_L, h_R, h_v, dt, G, LB, vol_CFL, & ! Local variables real :: CFL ! The CFL number based on the local velocity and grid spacing [nondim] real :: curv_3 ! A measure of the thickness curvature over a grid length, - ! with the same units as h_in. + ! with the same units as h [H ~> m or kg m-2] . real :: h_avg ! The average thickness of a flux [H ~> m or kg m-2]. real :: h_marg ! The marginal thickness of a flux [H ~> m or kg m-2]. logical :: local_open_BC @@ -1411,15 +1414,15 @@ subroutine merid_face_thickness(v, h, h_L, h_R, h_v, dt, G, LB, vol_CFL, & !$OMP parallel do default(shared) private(CFL,curv_3,h_marg,h_avg) do k=1,nz ; do J=jsh-1,jeh ; do i=ish,ieh if (v(i,J,k) > 0.0) then - if (vol_CFL) then ; CFL = (v(i,J,k) * dt) * (G%dx_Cv(i,J) * G%IareaT(i,j)) - else ; CFL = v(i,J,k) * dt * G%IdyT(i,j) ; endif + if (vol_CFL) then ; CFL = (v(i,J,k) * dt_in_T) * (US%m_to_L*G%dx_Cv(i,J) * US%L_to_m**2*G%IareaT(i,j)) + else ; CFL = v(i,J,k) * dt_in_T * US%L_to_m*G%IdyT(i,j) ; endif curv_3 = h_L(i,j,k) + h_R(i,j,k) - 2.0*h(i,j,k) h_avg = h_R(i,j,k) + CFL * (0.5*(h_L(i,j,k) - h_R(i,j,k)) + curv_3*(CFL - 1.5)) h_marg = h_R(i,j,k) + CFL * ((h_L(i,j,k) - h_R(i,j,k)) + & 3.0*curv_3*(CFL - 1.0)) elseif (v(i,J,k) < 0.0) then - if (vol_CFL) then ; CFL = (-v(i,J,k)*dt) * (G%dx_Cv(i,J) * G%IareaT(i,j+1)) - else ; CFL = -v(i,J,k) * dt * G%IdyT(i,j+1) ; endif + if (vol_CFL) then ; CFL = (-v(i,J,k)*dt_in_T) * (US%m_to_L*G%dx_Cv(i,J) * US%L_to_m**2*G%IareaT(i,j+1)) + else ; CFL = -v(i,J,k) * dt_in_T * US%L_to_m*G%IdyT(i,j+1) ; endif curv_3 = h_L(i,j+1,k) + h_R(i,j+1,k) - 2.0*h(i,j+1,k) h_avg = h_L(i,j+1,k) + CFL * (0.5*(h_R(i,j+1,k)-h_L(i,j+1,k)) + curv_3*(CFL - 1.5)) h_marg = h_L(i,j+1,k) + CFL * ((h_R(i,j+1,k)-h_L(i,j+1,k)) + & @@ -1481,11 +1484,11 @@ end subroutine merid_face_thickness !> Returns the barotropic velocity adjustment that gives the desired barotropic (layer-summed) transport. subroutine meridional_flux_adjust(v, h_in, h_L, h_R, vhbt, vh_tot_0, dvhdv_tot_0, & - dv, dv_max_CFL, dv_min_CFL, dt, G, US, CS, visc_rem, & + dv, dv_max_CFL, dv_min_CFL, dt_in_T, G, US, CS, visc_rem, & j, ish, ieh, do_I_in, full_precision, vh_3d, OBC) 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]. + intent(in) :: v !< Meridional velocity [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(in) :: h_in !< Layer thickness used to calculate fluxes [H ~> m or kg m-2]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)),& @@ -1501,14 +1504,14 @@ subroutine meridional_flux_adjust(v, h_in, h_L, h_R, vhbt, vh_tot_0, dvhdv_tot_0 real, dimension(SZI_(G)), & optional, intent(in) :: vhbt !< The summed volume flux through meridional faces !! [H L2 T-1 ~> m3 s-1 or kg s-1]. - 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, dimension(SZI_(G)), intent(in) :: dv_max_CFL !< Maximum acceptable value of dv [L T-1 ~> m s-1]. + real, dimension(SZI_(G)), intent(in) :: dv_min_CFL !< Minimum acceptable value of dv [L T-1 ~> m s-1]. real, dimension(SZI_(G)), intent(in) :: vh_tot_0 !< The summed transport with 0 adjustment !! [H L2 T-1 ~> m3 s-1 or kg s-1]. real, dimension(SZI_(G)), intent(in) :: dvhdv_tot_0 !< The partial derivative of dv_err with - !! dv at 0 adjustment [H L2 s T-1 m-1 ~> m2 or kg m-1]. - real, dimension(SZI_(G)), intent(out) :: dv !< The barotropic velocity adjustment [m s-1]. - real, intent(in) :: dt !< Time increment [s]. + !! dv at 0 adjustment [H L ~> m2 or kg m-1]. + real, dimension(SZI_(G)), intent(out) :: dv !< The barotropic velocity adjustment [L T-1 ~> m s-1]. + real, intent(in) :: dt_in_T !< Time increment [T ~> s]. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(continuity_PPM_CS), pointer :: CS !< This module's control structure. integer, intent(in) :: j !< Spatial index. @@ -1529,14 +1532,14 @@ subroutine meridional_flux_adjust(v, h_in, h_L, h_R, vhbt, vh_tot_0, dvhdv_tot_0 real, dimension(SZI_(G)) :: & vh_err, & ! Difference between vhbt and the summed vh [H L2 T-1 ~> m3 s-1 or kg s-1]. vh_err_best, & ! The smallest value of vh_err found so far [H L2 T-1 ~> m3 s-1 or kg s-1]. - v_new, & ! The velocity with the correction added [m s-1]. - dvhdv_tot,&! Summed partial derivative of vh with u [H L2 s T-1 m-1 ~> m2 or kg m-1]. + v_new, & ! The velocity with the correction added [L T-1 ~> m s-1]. + dvhdv_tot,&! Summed partial derivative of vh with u [H L ~> m2 or kg m-1]. dv_min, & ! Min/max limits on dv correction based on CFL limits - dv_max ! and previous iterations [m s-1]. - real :: dv_prev ! The previous value of dv [m s-1]. - real :: ddv ! The change in dv from the previous iteration [m s-1]. + dv_max ! and previous iterations [L T-1 ~> m s-1]. + real :: dv_prev ! The previous value of dv [L T-1 ~> m s-1]. + real :: ddv ! The change in dv from the previous iteration [L T-1 ~> m s-1]. real :: tol_eta ! The tolerance for the current iteration [H ~> m or kg m-2]. - real :: tol_vel ! The tolerance for velocity in the current iteration [m s-1]. + real :: tol_vel ! The tolerance for velocity in the current iteration [L T-1 ~> m s-1]. integer :: i, k, nz, itt, max_itts = 20 logical :: full_prec, domore, do_I(SZI_(G)) @@ -1576,7 +1579,7 @@ subroutine meridional_flux_adjust(v, h_in, h_L, h_R, vhbt, vh_tot_0, dvhdv_tot_0 enddo domore = .false. do i=ish,ieh ; if (do_I(i)) then - if ((US%s_to_T*dt * min(US%L_to_m**2*G%IareaT(i,j),US%L_to_m**2*G%IareaT(i,j+1))*abs(vh_err(i)) > tol_eta) .or. & + if ((dt_in_T * min(US%L_to_m**2*G%IareaT(i,j),US%L_to_m**2*G%IareaT(i,j+1))*abs(vh_err(i)) > tol_eta) .or. & (CS%better_iter .and. ((abs(vh_err(i)) > tol_vel * dvhdv_tot(i)) .or. & (abs(vh_err(i)) > vh_err_best(i))) )) then ! Use Newton's method, provided it stays bounded. Otherwise bisect @@ -1615,7 +1618,7 @@ subroutine meridional_flux_adjust(v, h_in, h_L, h_R, vhbt, vh_tot_0, dvhdv_tot_0 do i=ish,ieh ; v_new(i) = v(i,J,k) + dv(i) * visc_rem(i,k) ; enddo call merid_flux_layer(v_new, h_in(:,:,k), h_L(:,:,k), h_R(:,:,k), & vh_aux(:,k), dvhdv(:,k), visc_rem(:,k), & - dt, G, US, J, ish, ieh, do_I, CS%vol_CFL, OBC) + dt_in_T, G, US, J, ish, ieh, do_I, CS%vol_CFL, OBC) enddo ; endif if (itt < max_itts) then @@ -1644,10 +1647,10 @@ 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, US, CS, visc_rem, & + dv_max_CFL, dv_min_CFL, dt_in_T, 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]. + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: v !< Meridional velocity [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h_in !< Layer thickness used to calculate fluxes, !! [H ~> m or kg m-2]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h_L !< Left thickness in the reconstruction, @@ -1659,10 +1662,12 @@ 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) :: vh_tot_0 !< The summed transport !! with 0 adjustment [H L2 T-1 ~> m3 s-1 or kg s-1]. real, dimension(SZI_(G)), intent(in) :: dvhdv_tot_0 !< The partial derivative - !! of du_err with dv at 0 adjustment [H L2 s T-1 m-1 ~> m2 or kg m-1]. - 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]. + !! of du_err with dv at 0 adjustment [H L ~> m2 or kg m-1]. + real, dimension(SZI_(G)), intent(in) :: dv_max_CFL !< Maximum acceptable value + !! of dv [L T-1 ~> m s-1]. + real, dimension(SZI_(G)), intent(in) :: dv_min_CFL !< Minimum acceptable value + !! of dv [L T-1 ~> m s-1]. + real, intent(in) :: dt_in_T !< Time increment [T ~> 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 @@ -1678,18 +1683,18 @@ subroutine set_merid_BT_cont(v, h_in, h_L, h_R, BT_cont, vh_tot_0, dvhdv_tot_0, !! which I values to work on. ! Local variables real, dimension(SZI_(G)) :: & - dv0, & ! The barotropic velocity increment that gives 0 transport [m s-1]. + dv0, & ! The barotropic velocity increment that gives 0 transport [L T-1 ~> m s-1]. dvL, dvR, & ! The barotropic velocity increments that give the southerly - ! (dvL) and northerly (dvR) test velocities. + ! (dvL) and northerly (dvR) test velocities [L T-1 ~> m s-1]. zeros, & ! An array of full of 0's. - dv_CFL, & ! The velocity increment that corresponds to CFL_min [m s-1]. + dv_CFL, & ! The velocity increment that corresponds to CFL_min [L T-1 ~> m s-1]. v_L, v_R, & ! The southerly (v_L), northerly (v_R), and zero-barotropic - v_0, & ! transport (v_0) layer test velocities [m s-1]. + v_0, & ! transport (v_0) layer test velocities [L T-1 ~> m s-1]. dvhdv_L, & ! The effective layer marginal face areas with the southerly dvhdv_R, & ! (_L), northerly (_R), and zero-barotropic (_0) test - dvhdv_0, & ! velocities [H L2 s T-1 m-1 ~> m2 or kg m-1]. + dvhdv_0, & ! velocities [H L ~> m2 or kg m-1]. vh_L, vh_R, & ! The layer transports with the southerly (_L), northerly (_R) - vh_0, & ! and zero-barotropic (_0) test velocities [H m2 s-1 ~> m3 s-1 or kg s-1]. + vh_0, & ! and zero-barotropic (_0) test velocities [H L2 T-1 ~> m3 s-1 or kg s-1]. FAmt_L, FAmt_R, & ! The summed effective marginal face areas for the 3 FAmt_0, & ! test velocities [H m ~> m2 or kg m-1]. vhtot_L, & ! The summed transport with the southerly (vhtot_L) and @@ -1706,17 +1711,17 @@ subroutine set_merid_BT_cont(v, h_in, h_L, h_R, BT_cont, vh_tot_0, dvhdv_tot_0, ! of visc_rem from leading to large CFL numbers. real :: CFL_min ! A minimal increment in the CFL to try to ensure that the ! flow is truly upwind [nondim] - real :: Idt ! The inverse of the time step [s-1]. + real :: Idt ! The inverse of the time step [T-1 ~> s-1]. logical :: domore integer :: i, k, nz - nz = G%ke ; Idt = 1.0/dt + nz = G%ke ; Idt = 1.0/(dt_in_T) min_visc_rem = 0.1 ; CFL_min = 1e-6 ! Diagnose the zero-transport correction, dv0. do i=ish,ieh ; zeros(i) = 0.0 ; enddo call meridional_flux_adjust(v, h_in, h_L, h_R, zeros, vh_tot_0, dvhdv_tot_0, dv0, & - dv_max_CFL, dv_min_CFL, dt, G, US, CS, visc_rem, & + dv_max_CFL, dv_min_CFL, dt_in_T, G, US, CS, visc_rem, & j, ish, ieh, do_I, .true.) ! Determine the southerly- and northerly- fluxes. Choose a sufficiently @@ -1725,7 +1730,7 @@ subroutine set_merid_BT_cont(v, h_in, h_L, h_R, BT_cont, vh_tot_0, dvhdv_tot_0, domore = .false. do i=ish,ieh ; if (do_I(i)) then domore = .true. - dv_CFL(i) = (CFL_min * Idt) * G%dyCv(i,J) + dv_CFL(i) = (CFL_min * Idt) * US%m_to_L*G%dyCv(i,J) dvR(i) = min(0.0,dv0(i) - dv_CFL(i)) dvL(i) = max(0.0,dv0(i) + dv_CFL(i)) FAmt_L(i) = 0.0 ; FAmt_R(i) = 0.0 ; FAmt_0(i) = 0.0 @@ -1758,15 +1763,15 @@ subroutine set_merid_BT_cont(v, h_in, h_L, h_R, BT_cont, vh_tot_0, dvhdv_tot_0, v_0(i) = v(I,j,k) + dv0(i) * visc_rem(i,k) endif ; enddo call merid_flux_layer(v_0, h_in(:,:,k), h_L(:,:,k), h_R(:,:,k), vh_0, dvhdv_0, & - visc_rem(:,k), dt, G, US, J, ish, ieh, do_I, CS%vol_CFL) + visc_rem(:,k), dt_in_T, G, US, J, ish, ieh, do_I, CS%vol_CFL) call merid_flux_layer(v_L, h_in(:,:,k), h_L(:,:,k), h_R(:,:,k), vh_L, dvhdv_L, & - visc_rem(:,k), dt, G, US, J, ish, ieh, do_I, CS%vol_CFL) + visc_rem(:,k), dt_in_T, G, US, J, ish, ieh, do_I, CS%vol_CFL) call merid_flux_layer(v_R, h_in(:,:,k), h_L(:,:,k), h_R(:,:,k), vh_R, dvhdv_R, & - visc_rem(:,k), dt, G, US, J, ish, ieh, do_I, CS%vol_CFL) + visc_rem(:,k), dt_in_T, G, US, J, ish, ieh, do_I, CS%vol_CFL) do i=ish,ieh ; if (do_I(i)) then - FAmt_0(i) = FAmt_0(i) + US%L_T_to_m_s*dvhdv_0(i) - FAmt_L(i) = FAmt_L(i) + US%L_T_to_m_s*dvhdv_L(i) - FAmt_R(i) = FAmt_R(i) + US%L_T_to_m_s*dvhdv_R(i) + FAmt_0(i) = FAmt_0(i) + dvhdv_0(i) + FAmt_L(i) = FAmt_L(i) + dvhdv_L(i) + FAmt_R(i) = FAmt_R(i) + dvhdv_R(i) vhtot_L(i) = vhtot_L(i) + vh_L(i) vhtot_R(i) = vhtot_R(i) + vh_R(i) endif ; enddo @@ -1774,23 +1779,23 @@ subroutine set_merid_BT_cont(v, h_in, h_L, h_R, BT_cont, vh_tot_0, dvhdv_tot_0, do i=ish,ieh ; if (do_I(i)) then FA_0 = FAmt_0(i) ; FA_avg = FAmt_0(i) if ((dvL(i) - dv0(i)) /= 0.0) & - FA_avg = US%L_T_to_m_s*vhtot_L(i) / (dvL(i) - dv0(i)) + 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) 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) = US%m_s_to_L_T*(1.5 * (dvL(i) - dv0(i))) * & + BT_cont%vBT_SS(i,J) = (1.5 * (dvL(i) - dv0(i))) * & ((FAmt_L(i) - FA_avg) / (FAmt_L(i) - FA_0)) endif FA_0 = FAmt_0(i) ; FA_avg = FAmt_0(i) if ((dvR(i) - dv0(i)) /= 0.0) & - FA_avg = US%L_T_to_m_s*vhtot_R(i) / (dvR(i) - dv0(i)) + 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) 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) = US%m_s_to_L_T*(1.5 * (dvR(i) - dv0(i))) * & + BT_cont%vBT_NN(i,J) = (1.5 * (dvR(i) - dv0(i))) * & ((FAmt_R(i) - FA_avg) / (FAmt_R(i) - FA_0)) endif else @@ -2173,10 +2178,11 @@ function ratio_max(a, b, maxrat) result(ratio) end function ratio_max !> Initializes continuity_ppm_cs -subroutine continuity_PPM_init(Time, G, GV, param_file, diag, CS) - type(time_type), target, intent(in) :: Time !< Time increment [s]. +subroutine continuity_PPM_init(Time, G, GV, US, param_file, diag, CS) + 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 !< 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 indicating !! the open file to parse for model parameter values. type(diag_ctrl), target, intent(inout) :: diag !< A structure that is used to @@ -2232,7 +2238,8 @@ subroutine continuity_PPM_init(Time, G, GV, param_file, diag, CS) call get_param(param_file, mdl, "VELOCITY_TOLERANCE", CS%tol_vel, & "The tolerance for barotropic velocity discrepancies "//& "between the barotropic solution and the sum of the "//& - "layer thicknesses.", units="m s-1", default=3.0e8) ! The speed of light is the default. + "layer thicknesses.", units="m s-1", default=3.0e8, scale=US%m_s_to_L_T) + ! The speed of light is the default. call get_param(param_file, mdl, "CONT_PPM_AGGRESS_ADJUST", CS%aggress_adjust,& "If true, allow the adjusted velocities to have a "//& diff --git a/src/core/MOM_dynamics_split_RK2.F90 b/src/core/MOM_dynamics_split_RK2.F90 index d219433380..d97cdf06a9 100644 --- a/src/core/MOM_dynamics_split_RK2.F90 +++ b/src/core/MOM_dynamics_split_RK2.F90 @@ -1103,7 +1103,7 @@ subroutine initialize_dyn_split_RK2(u, v, h, uh, vh, eta, Time, G, GV, US, param ! Accel_diag%u_accel_bt => CS%u_accel_bt ; Accel_diag%v_accel_bt => CS%v_accel_bt ! Accel_diag%u_av => CS%u_av ; Accel_diag%v_av => CS%v_av - call continuity_init(Time, G, GV, param_file, diag, CS%continuity_CSp) + call continuity_init(Time, G, GV, US, param_file, diag, CS%continuity_CSp) call CoriolisAdv_init(Time, G, GV, US, param_file, diag, CS%ADp, CS%CoriolisAdv_CSp) 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, & diff --git a/src/core/MOM_dynamics_unsplit.F90 b/src/core/MOM_dynamics_unsplit.F90 index 6588bd0154..e4f902c9e0 100644 --- a/src/core/MOM_dynamics_unsplit.F90 +++ b/src/core/MOM_dynamics_unsplit.F90 @@ -647,7 +647,7 @@ subroutine initialize_dyn_unsplit(u, v, h, Time, G, GV, US, param_file, diag, CS Accel_diag%PFu => CS%PFu ; Accel_diag%PFv => CS%PFv Accel_diag%CAu => CS%CAu ; Accel_diag%CAv => CS%CAv - call continuity_init(Time, G, GV, param_file, diag, CS%continuity_CSp) + call continuity_init(Time, G, GV, US, param_file, diag, CS%continuity_CSp) call CoriolisAdv_init(Time, G, GV, US, param_file, diag, CS%ADp, CS%CoriolisAdv_CSp) 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, & diff --git a/src/core/MOM_dynamics_unsplit_RK2.F90 b/src/core/MOM_dynamics_unsplit_RK2.F90 index 65413be92d..e4c92b9783 100644 --- a/src/core/MOM_dynamics_unsplit_RK2.F90 +++ b/src/core/MOM_dynamics_unsplit_RK2.F90 @@ -607,7 +607,7 @@ subroutine initialize_dyn_unsplit_RK2(u, v, h, Time, G, GV, US, param_file, diag Accel_diag%PFu => CS%PFu ; Accel_diag%PFv => CS%PFv Accel_diag%CAu => CS%CAu ; Accel_diag%CAv => CS%CAv - call continuity_init(Time, G, GV, param_file, diag, CS%continuity_CSp) + call continuity_init(Time, G, GV, US, param_file, diag, CS%continuity_CSp) call CoriolisAdv_init(Time, G, GV, US, param_file, diag, CS%ADp, CS%CoriolisAdv_CSp) 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, & From 065225913c7b44409ba25844ba99efbeca747eb7 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Fri, 2 Aug 2019 10:23:37 -0400 Subject: [PATCH 140/297] Add parentheses around grid metric arrays Added parentheses around grid metric arrays in denominators and where they are raised to powers to enable the quasi-automated unit conversion of these grid metrics. All answers are bitwise identical. --- .../coupled_driver/MOM_surface_forcing.F90 | 6 ++--- config_src/mct_driver/MOM_surface_forcing.F90 | 4 +-- .../nuopc_driver/MOM_surface_forcing.F90 | 4 +-- src/core/MOM.F90 | 2 +- src/ice_shelf/MOM_ice_shelf.F90 | 2 +- src/initialization/MOM_grid_initialize.F90 | 6 ++--- .../MOM_shared_initialization.F90 | 14 +++++----- .../MOM_state_initialization.F90 | 18 ++++++------- .../lateral/MOM_hor_visc.F90 | 26 +++++++++---------- .../lateral/MOM_lateral_mixing_coeffs.F90 | 16 ++++++------ .../lateral/MOM_mixed_layer_restrat.F90 | 8 +++--- src/tracer/MOM_offline_aux.F90 | 2 +- src/tracer/MOM_offline_main.F90 | 8 +++--- src/user/DOME2d_initialization.F90 | 2 +- 14 files changed, 59 insertions(+), 59 deletions(-) diff --git a/config_src/coupled_driver/MOM_surface_forcing.F90 b/config_src/coupled_driver/MOM_surface_forcing.F90 index bb6270c177..1dfe0662a4 100644 --- a/config_src/coupled_driver/MOM_surface_forcing.F90 +++ b/config_src/coupled_driver/MOM_surface_forcing.F90 @@ -230,7 +230,7 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, US, CS, sfc PmE_adj, & ! The adjustment to PminusE that will cause the salinity ! to be restored toward its target value [kg m-1 s-1] net_FW, & ! The area integrated net freshwater flux into the ocean [kg s-1] - net_FW2, & ! The area integrated net freshwater flux into the ocean [kg s-1] + net_FW2, & ! The net freshwater flux into the ocean [kg m-2 s-1] work_sum, & ! A 2-d array that is used as the work space for global sums [m2] or [kg s-1] open_ocn_mask ! a binary field indicating where ice is present based on frazil criteria [nondim] @@ -522,13 +522,13 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, US, CS, sfc 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) + net_FW2(i,j) = net_FW(i,j) / (G%areaT(i,j)) enddo ; enddo if (CS%adjust_net_fresh_water_by_scaling) then call adjust_area_mean_to_zero(net_FW2, G, fluxes%netFWGlobalScl) do j=js,je ; do i=is,ie - fluxes%vprec(i,j) = fluxes%vprec(i,j) + (net_FW2(i,j) - net_FW(i,j)/G%areaT(i,j)) * G%mask2dT(i,j) + fluxes%vprec(i,j) = fluxes%vprec(i,j) + (net_FW2(i,j) - net_FW(i,j)/(G%areaT(i,j))) * G%mask2dT(i,j) enddo ; enddo else fluxes%netFWGlobalAdj = reproducing_sum(net_FW(:,:), isr, ier, jsr, jer) / CS%area_surf diff --git a/config_src/mct_driver/MOM_surface_forcing.F90 b/config_src/mct_driver/MOM_surface_forcing.F90 index 5d30f3c9cb..9653a27a4b 100644 --- a/config_src/mct_driver/MOM_surface_forcing.F90 +++ b/config_src/mct_driver/MOM_surface_forcing.F90 @@ -514,13 +514,13 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, Time, G, US, CS, & 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) + net_FW2(i,j) = net_FW(i,j) / (G%areaT(i,j)) enddo; enddo if (CS%adjust_net_fresh_water_by_scaling) then call adjust_area_mean_to_zero(net_FW2, G, fluxes%netFWGlobalScl) do j=js,je ; do i=is,ie - fluxes%vprec(i,j) = fluxes%vprec(i,j) + (net_FW2(i,j) - net_FW(i,j)/G%areaT(i,j)) * G%mask2dT(i,j) + fluxes%vprec(i,j) = fluxes%vprec(i,j) + (net_FW2(i,j) - net_FW(i,j)/(G%areaT(i,j))) * G%mask2dT(i,j) enddo; enddo else fluxes%netFWGlobalAdj = reproducing_sum(net_FW(:,:), isr, ier, jsr, jer) / CS%area_surf diff --git a/config_src/nuopc_driver/MOM_surface_forcing.F90 b/config_src/nuopc_driver/MOM_surface_forcing.F90 index 01cd79acb9..d91a9bfdac 100644 --- a/config_src/nuopc_driver/MOM_surface_forcing.F90 +++ b/config_src/nuopc_driver/MOM_surface_forcing.F90 @@ -542,13 +542,13 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, US, CS, & 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) + net_FW2(i,j) = net_FW(i,j) / (G%areaT(i,j)) enddo ; enddo if (CS%adjust_net_fresh_water_by_scaling) then call adjust_area_mean_to_zero(net_FW2, G, fluxes%netFWGlobalScl) do j=js,je ; do i=is,ie - fluxes%vprec(i,j) = fluxes%vprec(i,j) + (net_FW2(i,j) - net_FW(i,j)/G%areaT(i,j)) * G%mask2dT(i,j) + fluxes%vprec(i,j) = fluxes%vprec(i,j) + (net_FW2(i,j) - net_FW(i,j)/(G%areaT(i,j))) * G%mask2dT(i,j) enddo ; enddo else fluxes%netFWGlobalAdj = reproducing_sum(net_FW(:,:), isr, ier, jsr, jer) / CS%area_surf diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index 91ec256248..acf6cc4351 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -2208,7 +2208,7 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & ! compute fractional ice shelf coverage of h do j=jsd,jed ; do i=isd,ied if (G%areaT(i,j) > 0.0) & - frac_shelf_h(i,j) = area_shelf_h(i,j) / G%areaT(i,j) + frac_shelf_h(i,j) = area_shelf_h(i,j) / (G%areaT(i,j)) enddo ; enddo ! pass to the pointer shelf_area => frac_shelf_h diff --git a/src/ice_shelf/MOM_ice_shelf.F90 b/src/ice_shelf/MOM_ice_shelf.F90 index bc3f8323f0..a753f273aa 100644 --- a/src/ice_shelf/MOM_ice_shelf.F90 +++ b/src/ice_shelf/MOM_ice_shelf.F90 @@ -1511,7 +1511,7 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces, fl endif enddo ; enddo if (present(fluxes)) then ; do j=jsd,jed ; do i=isd,ied - if (G%areaT(i,j) > 0.0) fluxes%frac_shelf_h(i,j) = ISS%area_shelf_h(i,j) / G%areaT(i,j) + if (G%areaT(i,j) > 0.0) fluxes%frac_shelf_h(i,j) = ISS%area_shelf_h(i,j) / (G%areaT(i,j)) enddo ; enddo ; endif if (CS%debug) then diff --git a/src/initialization/MOM_grid_initialize.F90 b/src/initialization/MOM_grid_initialize.F90 index 305087dc44..2dc74c144b 100644 --- a/src/initialization/MOM_grid_initialize.F90 +++ b/src/initialization/MOM_grid_initialize.F90 @@ -857,7 +857,7 @@ subroutine set_grid_metrics_mercator(G, param_file) G%dyBu(I,J) = ds_dj(xq(I,J), yq(I,J), GP) G%areaBu(I,J) = G%dxBu(I,J) * G%dyBu(I,J) - G%IareaBu(I,J) = 1.0 / G%areaBu(I,J) + G%IareaBu(I,J) = 1.0 / (G%areaBu(I,J)) enddo ; enddo do j=jsd,jed ; do i=isd,ied @@ -867,7 +867,7 @@ subroutine set_grid_metrics_mercator(G, param_file) G%dyT(i,j) = ds_dj(xh(i,j), yh(i,j), GP) G%areaT(i,j) = G%dxT(i,j)*G%dyT(i,j) - G%IareaT(i,j) = 1.0 / G%areaT(i,j) + G%IareaT(i,j) = 1.0 / (G%areaT(i,j)) enddo ; enddo do j=jsd,jed ; do I=IsdB,IedB @@ -903,7 +903,7 @@ subroutine set_grid_metrics_mercator(G, param_file) call pass_var(G%areaT,G%Domain) endif do j=jsd,jed ; do i=isd,ied - G%IareaT(i,j) = 1.0 / G%areaT(i,j) + G%IareaT(i,j) = 1.0 / (G%areaT(i,j)) enddo ; enddo endif diff --git a/src/initialization/MOM_shared_initialization.F90 b/src/initialization/MOM_shared_initialization.F90 index 42e99f2ef6..419d71461c 100644 --- a/src/initialization/MOM_shared_initialization.F90 +++ b/src/initialization/MOM_shared_initialization.F90 @@ -715,7 +715,7 @@ subroutine reset_face_lengths_named(G, param_file, name, US) endif G%areaCu(I,j) = G%dxCu(I,j)*G%dy_Cu(I,j) G%IareaCu(I,j) = 0.0 - if (G%areaCu(I,j) > 0.0) G%IareaCu(I,j) = G%mask2dCu(I,j) / G%areaCu(I,j) + if (G%areaCu(I,j) > 0.0) G%IareaCu(I,j) = G%mask2dCu(I,j) / (G%areaCu(I,j)) enddo ; enddo do J=JsdB,JedB ; do i=isd,ied @@ -729,7 +729,7 @@ subroutine reset_face_lengths_named(G, param_file, name, US) endif G%areaCv(i,J) = G%dyCv(i,J)*G%dx_Cv(i,J) G%IareaCv(i,J) = 0.0 - if (G%areaCv(i,J) > 0.0) G%IareaCv(i,J) = G%mask2dCv(i,J) / G%areaCv(i,J) + if (G%areaCv(i,J) > 0.0) G%IareaCv(i,J) = G%mask2dCv(i,J) / (G%areaCv(i,J)) enddo ; enddo end subroutine reset_face_lengths_named @@ -780,7 +780,7 @@ subroutine reset_face_lengths_file(G, param_file, US) endif G%areaCu(I,j) = G%dxCu(I,j)*G%dy_Cu(I,j) G%IareaCu(I,j) = 0.0 - if (G%areaCu(I,j) > 0.0) G%IareaCu(I,j) = G%mask2dCu(I,j) / G%areaCu(I,j) + if (G%areaCu(I,j) > 0.0) G%IareaCu(I,j) = G%mask2dCu(I,j) / (G%areaCu(I,j)) enddo ; enddo do J=JsdB,JedB ; do i=isd,ied @@ -794,7 +794,7 @@ subroutine reset_face_lengths_file(G, param_file, US) endif G%areaCv(i,J) = G%dyCv(i,J)*G%dx_Cv(i,J) G%IareaCv(i,J) = 0.0 - if (G%areaCv(i,J) > 0.0) G%IareaCv(i,J) = G%mask2dCv(i,J) / G%areaCv(i,J) + if (G%areaCv(i,J) > 0.0) G%IareaCv(i,J) = G%mask2dCv(i,J) / (G%areaCv(i,J)) enddo ; enddo call callTree_leave(trim(mdl)//'()') @@ -992,7 +992,7 @@ subroutine reset_face_lengths_list(G, param_file, US) G%areaCu(I,j) = G%dxCu(I,j)*G%dy_Cu(I,j) G%IareaCu(I,j) = 0.0 - if (G%areaCu(I,j) > 0.0) G%IareaCu(I,j) = G%mask2dCu(I,j) / G%areaCu(I,j) + if (G%areaCu(I,j) > 0.0) G%IareaCu(I,j) = G%mask2dCu(I,j) / (G%areaCu(I,j)) enddo ; enddo do J=JsdB,JedB ; do i=isd,ied @@ -1021,7 +1021,7 @@ subroutine reset_face_lengths_list(G, param_file, US) G%areaCv(i,J) = G%dyCv(i,J)*G%dx_Cv(i,J) G%IareaCv(i,J) = 0.0 - if (G%areaCv(i,J) > 0.0) G%IareaCv(i,J) = G%mask2dCv(i,J) / G%areaCv(i,J) + if (G%areaCv(i,J) > 0.0) G%IareaCv(i,J) = G%mask2dCv(i,J) / (G%areaCv(i,J)) enddo ; enddo if (num_lines > 0) then @@ -1147,7 +1147,7 @@ subroutine compute_global_grid_integrals(G) call MOM_error(FATAL, "compute_global_grid_integrals: "//& "zero ocean area (check topography?)") - G%IareaT_global = 1. / G%areaT_global + G%IareaT_global = 1.0 / (G%areaT_global) end subroutine compute_global_grid_integrals ! ----------------------------------------------------------------------------- diff --git a/src/initialization/MOM_state_initialization.F90 b/src/initialization/MOM_state_initialization.F90 index 60d8c4b0d0..e8f42bc6d1 100644 --- a/src/initialization/MOM_state_initialization.F90 +++ b/src/initialization/MOM_state_initialization.F90 @@ -1385,12 +1385,12 @@ subroutine initialize_velocity_circular(u, v, G, param_file, just_read_params) do k=1,nz ; do j=js,je ; do I=Isq,Ieq psi1 = my_psi(I,j) psi2 = my_psi(I,j-1) - u(I,j,k) = (psi1-psi2)/G%dy_Cu(I,j)! *(circular_max_u*G%len_lon/(2.0*dpi)) + u(I,j,k) = (psi1-psi2) / (G%dy_Cu(I,j)) ! *(circular_max_u*G%len_lon/(2.0*dpi)) enddo ; enddo ; enddo do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie psi1 = my_psi(i,J) psi2 = my_psi(i-1,J) - v(i,J,k) = (psi2-psi1)/G%dx_Cv(i,J)! *(circular_max_u*G%len_lon/(2.0*dpi)) + v(i,J,k) = (psi2-psi1) / (G%dx_Cv(i,J)) ! *(circular_max_u*G%len_lon/(2.0*dpi)) enddo ; enddo ; enddo contains @@ -1402,12 +1402,12 @@ real function my_psi(ig,jg) ! Local variables real :: x, y, r - x = 2.0*(G%geoLonBu(ig,jg)-G%west_lon)/G%len_lon-1.0 ! -1 This subroutine sets the 4 bottom depths at velocity points to be the @@ -2156,7 +2156,7 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, G, GV, US, PF, just_read_param ! Compute fractional ice shelf coverage of h do j=jsd,jed ; do i=isd,ied if (G%areaT(i,j) > 0.0) & - frac_shelf_h(i,j) = area_shelf_h(i,j) / G%areaT(i,j) + frac_shelf_h(i,j) = area_shelf_h(i,j) / (G%areaT(i,j)) enddo ; enddo ! Pass to the pointer for use as an argument to regridding_main shelf_area => frac_shelf_h diff --git a/src/parameterizations/lateral/MOM_hor_visc.F90 b/src/parameterizations/lateral/MOM_hor_visc.F90 index 5d871921a9..0f620a1b39 100644 --- a/src/parameterizations/lateral/MOM_hor_visc.F90 +++ b/src/parameterizations/lateral/MOM_hor_visc.F90 @@ -66,7 +66,7 @@ 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 T-1 ~> 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. @@ -102,7 +102,7 @@ module MOM_hor_visc !! velocity differences reach a value of order 1/2 MAXVEL. real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: reduction_xx !< The amount by which stresses through h points are reduced - !! due to partial barriers. Nondimensional. + !! due to partial barriers [nondim]. real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: & 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]. @@ -746,7 +746,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, div_xx(i,j) = 0.5*((G%dyCu(I,j) * u(I,j,k) * (h(i+1,j,k)+h(i,j,k)) - & G%dyCu(I-1,j) * u(I-1,j,k) * (h(i-1,j,k)+h(i,j,k)) ) + & (G%dxCv(i,J) * v(i,J,k) * (h(i,j,k)+h(i,j+1,k)) - & - G%dxCv(i,J-1)*v(i,J-1,k)*(h(i,j,k)+h(i,j-1,k))))*G%IareaT(i,j)/ & + G%dxCv(i,J-1)*v(i,J-1,k)*(h(i,j,k)+h(i,j-1,k))))*G%IareaT(i,j) / & (h(i,j,k) + GV%H_subroundoff) enddo ; enddo @@ -1263,9 +1263,9 @@ 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) - & - CS%DY2h(i+1,j)*str_xx(i+1,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))) * & + CS%DX2q(I,J) *str_xy(I,J))) * & G%IareaCu(I,j)) / (h_u(i,j) + h_neglect) enddo ; enddo @@ -1853,32 +1853,32 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS, MEKE) CS%reduction_xx(i,j) = 1.0 if ((G%dy_Cu(I,j) > 0.0) .and. (G%dy_Cu(I,j) < G%dyCu(I,j)) .and. & (G%dy_Cu(I,j) < G%dyCu(I,j) * CS%reduction_xx(i,j))) & - CS%reduction_xx(i,j) = G%dy_Cu(I,j) / G%dyCu(I,j) + CS%reduction_xx(i,j) = G%dy_Cu(I,j) / (G%dyCu(I,j)) if ((G%dy_Cu(I-1,j) > 0.0) .and. (G%dy_Cu(I-1,j) < G%dyCu(I-1,j)) .and. & (G%dy_Cu(I-1,j) < G%dyCu(I-1,j) * CS%reduction_xx(i,j))) & - CS%reduction_xx(i,j) = G%dy_Cu(I-1,j) / G%dyCu(I-1,j) + CS%reduction_xx(i,j) = G%dy_Cu(I-1,j) / (G%dyCu(I-1,j)) if ((G%dx_Cv(i,J) > 0.0) .and. (G%dx_Cv(i,J) < G%dxCv(i,J)) .and. & (G%dx_Cv(i,J) < G%dxCv(i,J) * CS%reduction_xx(i,j))) & - CS%reduction_xx(i,j) = G%dx_Cv(i,J) / G%dxCv(i,J) + CS%reduction_xx(i,j) = G%dx_Cv(i,J) / (G%dxCv(i,J)) if ((G%dx_Cv(i,J-1) > 0.0) .and. (G%dx_Cv(i,J-1) < G%dxCv(i,J-1)) .and. & (G%dx_Cv(i,J-1) < G%dxCv(i,J-1) * CS%reduction_xx(i,j))) & - CS%reduction_xx(i,j) = G%dx_Cv(i,J-1) / G%dxCv(i,J-1) + CS%reduction_xx(i,j) = G%dx_Cv(i,J-1) / (G%dxCv(i,J-1)) enddo ; enddo do J=js-1,Jeq ; do I=is-1,Ieq CS%reduction_xy(I,J) = 1.0 if ((G%dy_Cu(I,j) > 0.0) .and. (G%dy_Cu(I,j) < G%dyCu(I,j)) .and. & (G%dy_Cu(I,j) < G%dyCu(I,j) * CS%reduction_xy(I,J))) & - CS%reduction_xy(I,J) = G%dy_Cu(I,j) / G%dyCu(I,j) + CS%reduction_xy(I,J) = G%dy_Cu(I,j) / (G%dyCu(I,j)) if ((G%dy_Cu(I,j+1) > 0.0) .and. (G%dy_Cu(I,j+1) < G%dyCu(I,j+1)) .and. & (G%dy_Cu(I,j+1) < G%dyCu(I,j+1) * CS%reduction_xy(I,J))) & - CS%reduction_xy(I,J) = G%dy_Cu(I,j+1) / G%dyCu(I,j+1) + CS%reduction_xy(I,J) = G%dy_Cu(I,j+1) / (G%dyCu(I,j+1)) if ((G%dx_Cv(i,J) > 0.0) .and. (G%dx_Cv(i,J) < G%dxCv(i,J)) .and. & (G%dx_Cv(i,J) < G%dxCv(i,J) * CS%reduction_xy(I,J))) & - CS%reduction_xy(I,J) = G%dx_Cv(i,J) / G%dxCv(i,J) + CS%reduction_xy(I,J) = G%dx_Cv(i,J) / (G%dxCv(i,J)) if ((G%dx_Cv(i+1,J) > 0.0) .and. (G%dx_Cv(i+1,J) < G%dxCv(i+1,J)) .and. & (G%dx_Cv(i+1,J) < G%dxCv(i+1,J) * CS%reduction_xy(I,J))) & - CS%reduction_xy(I,J) = G%dx_Cv(i+1,J) / G%dxCv(i+1,J) + CS%reduction_xy(I,J) = G%dx_Cv(i+1,J) / (G%dxCv(i+1,J)) enddo ; enddo if (CS%Laplacian) then diff --git a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 index 70b80b38cb..7a88529b03 100644 --- a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 +++ b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 @@ -1118,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) = (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) * (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 + & @@ -1128,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) = (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) * (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 + & @@ -1139,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) = (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) * (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) + & @@ -1162,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) = (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) * (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_mixed_layer_restrat.F90 b/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 index 3f1164fc77..5df2b2d166 100644 --- a/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 +++ b/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 @@ -360,7 +360,7 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var 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 = & - ( sqrt( 0.5 * ( G%dxCu(I,j)**2 + G%dyCu(I,j)**2 ) ) * I_l_f ) & + ( sqrt( 0.5 * ( (G%dxCu(I,j))**2 + (G%dyCu(I,j))**2 ) ) * I_l_f ) & * min( 1., 0.5*( VarMix%Rd_dx_h(i,j) + VarMix%Rd_dx_h(i+1,j) ) ) ! peak ML visc: u_star * 0.41 * (h_ml*u_star)/(absf*h_ml + 4.0*u_star) @@ -436,7 +436,7 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var 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 = & - ( sqrt( 0.5 * ( G%dxCv(i,J)**2 + G%dyCv(i,J)**2 ) ) * I_l_f ) & + ( sqrt( 0.5 * ( (G%dxCv(i,J))**2 + (G%dyCv(i,J))**2 ) ) * I_l_f ) & * min( 1., 0.5*( VarMix%Rd_dx_h(i,j) + VarMix%Rd_dx_h(i,j+1) ) ) ! peak ML visc: u_star * 0.41 * (h_ml*u_star)/(absf*h_ml + 4.0*u_star) @@ -663,7 +663,7 @@ subroutine mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, dt, G, GV, US, CS) timescale = 0.0625 * (absf + 2.0*mom_mixrate) / (absf**2 + mom_mixrate**2) timescale = timescale * CS%ml_restrat_coef -! timescale = timescale*(2?)*(L_def/L_MLI)*min(EKE/MKE,1.0 + G%dyCv(i,j)**2/L_def**2)) +! timescale = timescale*(2?)*(L_def/L_MLI)*min(EKE/MKE,1.0 + (G%dyCv(i,j))**2/L_def**2)) uDml(I) = timescale * G%mask2dCu(I,j)*G%dyCu(I,j)* & G%IdxCu(I,j)*(Rml_av(i+1,j)-Rml_av(i,j)) * (h_vel**2 * GV%Z_to_H) @@ -710,7 +710,7 @@ subroutine mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, dt, G, GV, US, CS) timescale = 0.0625 * (absf + 2.0*mom_mixrate) / (absf**2 + mom_mixrate**2) timescale = timescale * CS%ml_restrat_coef -! timescale = timescale*(2?)*(L_def/L_MLI)*min(EKE/MKE,1.0 + G%dyCv(i,j)**2/L_def**2)) +! timescale = timescale*(2?)*(L_def/L_MLI)*min(EKE/MKE,1.0 + (G%dyCv(i,j))**2/L_def**2)) vDml(i) = timescale * G%mask2dCv(i,J)*G%dxCv(i,J)* & G%IdyCv(i,J)*(Rml_av(i,j+1)-Rml_av(i,j)) * (h_vel**2 * GV%Z_to_H) diff --git a/src/tracer/MOM_offline_aux.F90 b/src/tracer/MOM_offline_aux.F90 index 37f66987c0..e8d4424e15 100644 --- a/src/tracer/MOM_offline_aux.F90 +++ b/src/tracer/MOM_offline_aux.F90 @@ -73,7 +73,7 @@ subroutine update_h_horizontal_flux(G, GV, uhtr, vhtr, h_pre, h_new) max(GV%Angstrom_H, 1.0e-13*h_new(i,j,k) - G%areaT(i,j)*h_pre(i,j,k)) ! Convert back to thickness - h_new(i,j,k) = h_new(i,j,k)/G%areaT(i,j) + h_new(i,j,k) = h_new(i,j,k) / (G%areaT(i,j)) enddo ; enddo enddo diff --git a/src/tracer/MOM_offline_main.F90 b/src/tracer/MOM_offline_main.F90 index 0624f98337..f43a7d4e05 100644 --- a/src/tracer/MOM_offline_main.F90 +++ b/src/tracer/MOM_offline_main.F90 @@ -322,7 +322,7 @@ subroutine offline_advection_ale(fluxes, Time_start, time_interval, CS, id_clock do iter=1,CS%num_off_iter do k=1,nz ; do j=js,je ; do i=is,ie - h_vol(i,j,k) = h_new(i,j,k)*G%areaT(i,j) + h_vol(i,j,k) = h_new(i,j,k) * G%areaT(i,j) h_pre(i,j,k) = h_new(i,j,k) enddo ; enddo ; enddo @@ -342,7 +342,7 @@ subroutine offline_advection_ale(fluxes, Time_start, time_interval, CS, id_clock ! Update the new layer thicknesses after one round of advection has happened do k=1,nz ; do j=js,je ; do i=is,ie - h_new(i,j,k) = h_new(i,j,k)/G%areaT(i,j) + h_new(i,j,k) = h_new(i,j,k) / (G%areaT(i,j)) enddo ; enddo ; enddo if (MODULO(iter,CS%off_ale_mod)==0) then @@ -517,7 +517,7 @@ subroutine offline_redistribute_residual(CS, h_pre, uhtr, vhtr, converged) uhtr(I,j,k) = uhr(I,j,k) vhtr(i,J,k) = vhr(i,J,k) h_vol(i,j,k) = h_new(i,j,k) - h_new(i,j,k) = h_new(i,j,k)/G%areaT(i,j) + h_new(i,j,k) = h_new(i,j,k) / (G%areaT(i,j)) h_pre(i,j,k) = h_new(i,j,k) enddo ; enddo ; enddo @@ -562,7 +562,7 @@ subroutine offline_redistribute_residual(CS, h_pre, uhtr, vhtr, converged) uhtr(I,j,k) = uhr(I,j,k) vhtr(i,J,k) = vhr(i,J,k) h_vol(i,j,k) = h_new(i,j,k) - h_new(i,j,k) = h_new(i,j,k)/G%areaT(i,j) + h_new(i,j,k) = h_new(i,j,k) / (G%areaT(i,j)) h_pre(i,j,k) = h_new(i,j,k) enddo ; enddo ; enddo diff --git a/src/user/DOME2d_initialization.F90 b/src/user/DOME2d_initialization.F90 index a9a5be3d42..ddffbab1be 100644 --- a/src/user/DOME2d_initialization.F90 +++ b/src/user/DOME2d_initialization.F90 @@ -471,7 +471,7 @@ subroutine DOME2d_initialize_sponges(G, GV, tv, param_file, use_ALE, CSp, ACSp) z = -G%bathyT(i,j) do k = nz,1,-1 z = z + 0.5 * GV%H_to_Z * h(i,j,k) ! Position of the center of layer k - S(i,j,k) = 34.0 - 1.0 * (z/G%max_depth) + S(i,j,k) = 34.0 - 1.0 * (z / (G%max_depth)) if ( ( G%geoLonT(i,j) - G%west_lon ) / G%len_lon < dome2d_west_sponge_width ) & S(i,j,k) = S_ref + S_range z = z + 0.5 * GV%H_to_Z * h(i,j,k) ! Position of the interface k From 954e6a954c148831f64aa0c2eedc23ed63b03523 Mon Sep 17 00:00:00 2001 From: Marshall Ward Date: Fri, 2 Aug 2019 13:45:42 -0400 Subject: [PATCH 141/297] 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 4cd8641f4ab9a0d6d7513bb6686034a55bc68e92 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Fri, 2 Aug 2019 16:59:12 -0400 Subject: [PATCH 142/297] +Rescaled the units of G%Iarea arrays Rescaled the units of the various G%I_area arrays throughout the MOM6 code to units of [L-2]. In debugging these changes, several new chksums were added to the mom_hor_visc_code, and these were retained. In addition several new unit_scale_type arguments were added to subroutines throughout the code. All answers are bitwise identical, but interfaces have changed. Note that the line-length limits have been temporarily exceeded with these changes. --- config_src/coupled_driver/ocean_model_MOM.F90 | 2 +- .../ice_solo_driver/MOM_surface_forcing.F90 | 4 +- config_src/mct_driver/MOM_ocean_model.F90 | 4 +- config_src/nuopc_driver/MOM_ocean_model.F90 | 4 +- config_src/solo_driver/MOM_driver.F90 | 2 +- .../solo_driver/MOM_surface_forcing.F90 | 4 +- src/core/MOM.F90 | 14 ++-- src/core/MOM_CoriolisAdv.F90 | 8 +-- src/core/MOM_barotropic.F90 | 18 ++--- src/core/MOM_continuity_PPM.F90 | 28 ++++---- src/core/MOM_grid.F90 | 22 ++++--- src/core/MOM_transcribe_grid.F90 | 11 ++-- src/diagnostics/MOM_PointAccel.F90 | 8 +-- src/diagnostics/MOM_diagnostics.F90 | 18 ++--- src/diagnostics/MOM_sum_output.F90 | 8 +-- src/framework/MOM_dyn_horgrid.F90 | 20 +++--- src/ice_shelf/MOM_ice_shelf.F90 | 27 ++++---- .../MOM_fixed_initialization.F90 | 6 +- src/initialization/MOM_grid_initialize.F90 | 66 ++++++++++++------- .../MOM_shared_initialization.F90 | 19 ++++-- src/ocean_data_assim/MOM_oda_driver.F90 | 4 +- src/parameterizations/lateral/MOM_MEKE.F90 | 18 ++--- .../lateral/MOM_hor_visc.F90 | 62 ++++++++++++----- .../lateral/MOM_internal_tides.F90 | 42 ++++++------ .../lateral/MOM_mixed_layer_restrat.F90 | 4 +- .../lateral/MOM_thickness_diffuse.F90 | 20 +++--- .../vertical/MOM_diabatic_aux.F90 | 7 +- .../vertical/MOM_diabatic_driver.F90 | 20 +++--- .../vertical/MOM_set_diffusivity.F90 | 8 +-- .../vertical/MOM_vert_friction.F90 | 24 +++---- src/tracer/MOM_neutral_diffusion.F90 | 8 ++- src/tracer/MOM_tracer_advect.F90 | 4 +- src/tracer/MOM_tracer_hor_diff.F90 | 10 +-- src/user/MOM_controlled_forcing.F90 | 16 +++-- 34 files changed, 311 insertions(+), 229 deletions(-) diff --git a/config_src/coupled_driver/ocean_model_MOM.F90 b/config_src/coupled_driver/ocean_model_MOM.F90 index f9b84a97e1..3aa63ab733 100644 --- a/config_src/coupled_driver/ocean_model_MOM.F90 +++ b/config_src/coupled_driver/ocean_model_MOM.F90 @@ -505,7 +505,7 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, time_start_upda call convert_IOB_to_forces(Ice_ocean_boundary, OS%forces, index_bnds, OS%Time_dyn, OS%grid, OS%US, & OS%forcing_CSp, dt_forcing=dt_coupling, reset_avg=OS%fluxes%fluxes_used) if (OS%use_ice_shelf) & - call add_shelf_forces(OS%grid, OS%Ice_shelf_CSp, OS%forces) + call add_shelf_forces(OS%grid, OS%US, OS%Ice_shelf_CSp, OS%forces) if (OS%icebergs_alter_ocean) & call iceberg_forces(OS%grid, OS%forces, OS%use_ice_shelf, & OS%sfc_state, dt_coupling, OS%marine_ice_CSp) diff --git a/config_src/ice_solo_driver/MOM_surface_forcing.F90 b/config_src/ice_solo_driver/MOM_surface_forcing.F90 index efacc07dc5..ad2352d460 100644 --- a/config_src/ice_solo_driver/MOM_surface_forcing.F90 +++ b/config_src/ice_solo_driver/MOM_surface_forcing.F90 @@ -693,12 +693,12 @@ subroutine buoyancy_forcing_from_files(sfc_state, fluxes, day, dt, G, CS) call MOM_read_data(trim(CS%inputdir)//trim(CS%freshdischarge_file), "disch_w", & temp(:,:), G%Domain, timelevel=time_lev_monthly) do j=js,je ; do i=is,ie - fluxes%lrunoff(i,j) = temp(i,j)*G%IareaT(i,j) + fluxes%lrunoff(i,j) = temp(i,j)*US%m_to_L**2*G%IareaT(i,j) enddo ; enddo call MOM_read_data(trim(CS%inputdir)//trim(CS%freshdischarge_file), "disch_s", & temp(:,:), G%Domain, timelevel=time_lev_monthly) do j=js,je ; do i=is,ie - fluxes%frunoff(i,j) = temp(i,j)*G%IareaT(i,j) + fluxes%frunoff(i,j) = temp(i,j)*US%m_to_L**2*G%IareaT(i,j) enddo ; enddo ! Read the SST and SSS fields for damping. diff --git a/config_src/mct_driver/MOM_ocean_model.F90 b/config_src/mct_driver/MOM_ocean_model.F90 index 8bb3346021..0d5c9a7b87 100644 --- a/config_src/mct_driver/MOM_ocean_model.F90 +++ b/config_src/mct_driver/MOM_ocean_model.F90 @@ -497,7 +497,7 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & ! 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) + call add_shelf_forces(OS%grid, OS%US, OS%Ice_shelf_CSp, OS%forces) endif ! GMM, check ocean_model_MOM.F90 to enable the following option @@ -521,7 +521,7 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & 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) + call add_shelf_forces(OS%grid, OS%US, OS%Ice_shelf_CSp, OS%forces) endif ! GMM, check ocean_model_MOM.F90 to enable the following option diff --git a/config_src/nuopc_driver/MOM_ocean_model.F90 b/config_src/nuopc_driver/MOM_ocean_model.F90 index abe583ffcc..05232b8d0c 100644 --- a/config_src/nuopc_driver/MOM_ocean_model.F90 +++ b/config_src/nuopc_driver/MOM_ocean_model.F90 @@ -520,7 +520,7 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & 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) + call add_shelf_forces(OS%grid, OS%US, OS%Ice_shelf_CSp, OS%forces) endif if (OS%icebergs_alter_ocean) then if (do_dyn) & @@ -551,7 +551,7 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & 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) + call add_shelf_forces(OS%grid, OS%US, OS%Ice_shelf_CSp, OS%forces) endif if (OS%icebergs_alter_ocean) then if (do_dyn) & diff --git a/config_src/solo_driver/MOM_driver.F90 b/config_src/solo_driver/MOM_driver.F90 index 6fba8efdee..b057e06f9e 100644 --- a/config_src/solo_driver/MOM_driver.F90 +++ b/config_src/solo_driver/MOM_driver.F90 @@ -488,7 +488,7 @@ program MOM_main if (use_ice_shelf) then call shelf_calc_flux(sfc_state, fluxes, Time, dt_forcing, ice_shelf_CSp) - call add_shelf_forces(grid, Ice_shelf_CSp, forces) + call add_shelf_forces(grid, US, Ice_shelf_CSp, forces) endif fluxes%fluxes_used = .false. fluxes%dt_buoy_accum = dt_forcing diff --git a/config_src/solo_driver/MOM_surface_forcing.F90 b/config_src/solo_driver/MOM_surface_forcing.F90 index 4d9458a1c9..442047f03c 100644 --- a/config_src/solo_driver/MOM_surface_forcing.F90 +++ b/config_src/solo_driver/MOM_surface_forcing.F90 @@ -909,12 +909,12 @@ subroutine buoyancy_forcing_from_files(sfc_state, fluxes, day, dt, G, US, CS) call MOM_read_data(CS%runoff_file, CS%lrunoff_var, temp(:,:), & G%Domain, timelevel=time_lev) do j=js,je ; do i=is,ie - fluxes%lrunoff(i,j) = temp(i,j)*G%IareaT(i,j) + fluxes%lrunoff(i,j) = temp(i,j)*US%m_to_L**2*G%IareaT(i,j) enddo ; enddo call MOM_read_data(CS%runoff_file, CS%frunoff_var, temp(:,:), & G%Domain, timelevel=time_lev) do j=js,je ; do i=is,ie - fluxes%frunoff(i,j) = temp(i,j)*G%IareaT(i,j) + fluxes%frunoff(i,j) = temp(i,j)*US%m_to_L**2*G%IareaT(i,j) enddo ; enddo else call MOM_read_data(CS%runoff_file, CS%lrunoff_var, fluxes%lrunoff(:,:), & diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index acf6cc4351..b667bcfae8 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -1085,7 +1085,7 @@ subroutine step_MOM_tracer_dyn(CS, G, GV, US, h, Time_local) call advect_tracer(h, CS%uhtr, CS%vhtr, CS%OBC, CS%t_dyn_rel_adv, G, GV, US, & CS%tracer_adv_CSp, CS%tracer_Reg) - call tracer_hordiff(h, CS%t_dyn_rel_adv, CS%MEKE, CS%VarMix, G, GV, & + call tracer_hordiff(h, CS%t_dyn_rel_adv, CS%MEKE, CS%VarMix, G, GV, US, & CS%tracer_diff_CSp, CS%tracer_Reg, CS%tv) if (showCallTree) call callTree_waypoint("finished tracer advection/diffusion (step_MOM)") call cpu_clock_end(id_clock_tracer) ; call cpu_clock_end(id_clock_thermo) @@ -1399,7 +1399,7 @@ subroutine step_offline(forces, fluxes, sfc_state, Time_start, time_interval, CS call calc_resoln_function(CS%h, CS%tv, G, GV, US, CS%VarMix) call calc_slope_functions(CS%h, CS%tv, REAL(dt_offline), G, GV, US, CS%VarMix) endif - call tracer_hordiff(CS%h, REAL(dt_offline), CS%MEKE, CS%VarMix, G, GV, & + call tracer_hordiff(CS%h, REAL(dt_offline), CS%MEKE, CS%VarMix, G, GV, US, & CS%tracer_diff_CSp, CS%tracer_Reg, CS%tv) endif endif @@ -1424,7 +1424,7 @@ subroutine step_offline(forces, fluxes, sfc_state, Time_start, time_interval, CS call calc_resoln_function(CS%h, CS%tv, G, GV, US, CS%VarMix) call calc_slope_functions(CS%h, CS%tv, REAL(dt_offline), G, GV, US, CS%VarMix) endif - call tracer_hordiff(CS%h, REAL(dt_offline), CS%MEKE, CS%VarMix, G, GV, & + call tracer_hordiff(CS%h, REAL(dt_offline), CS%MEKE, CS%VarMix, G, GV, US, & CS%tracer_diff_CSp, CS%tracer_Reg, CS%tv) endif endif @@ -1459,7 +1459,7 @@ subroutine step_offline(forces, fluxes, sfc_state, Time_start, time_interval, CS CS%h, eatr, ebtr, uhtr, vhtr) ! Perform offline diffusion if requested if (.not. skip_diffusion) then - call tracer_hordiff(h_end, REAL(dt_offline), CS%MEKE, CS%VarMix, G, GV, & + call tracer_hordiff(h_end, REAL(dt_offline), CS%MEKE, CS%VarMix, G, GV, US, & CS%tracer_diff_CSp, CS%tracer_Reg, CS%tv) endif @@ -2135,7 +2135,7 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & ! The next line would be needed if G%Domain had not already been init'd above: ! call clone_MOM_domain(dG%Domain, G%Domain) call MOM_grid_init(G, param_file, HI, bathymetry_at_vel=bathy_at_vel) - call copy_dyngrid_to_MOM_grid(dG, G) + call copy_dyngrid_to_MOM_grid(dG, G, US) call destroy_dyn_horgrid(dG) ! Set a few remaining fields that are specific to the ocean grid type. @@ -2165,8 +2165,8 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & call clone_MOM_domain(G%Domain, CS%G%Domain) call MOM_grid_init(CS%G, param_file) - call copy_MOM_grid_to_dyngrid(G, dg) - call copy_dyngrid_to_MOM_grid(dg, CS%G) + call copy_MOM_grid_to_dyngrid(G, dg, US) + call copy_dyngrid_to_MOM_grid(dg, CS%G, US) call destroy_dyn_horgrid(dG) call MOM_grid_end(G) ; deallocate(G) diff --git a/src/core/MOM_CoriolisAdv.F90 b/src/core/MOM_CoriolisAdv.F90 index a5be221f63..7f901f213d 100644 --- a/src/core/MOM_CoriolisAdv.F90 +++ b/src/core/MOM_CoriolisAdv.F90 @@ -407,10 +407,10 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS) do J=Jsq-1,Jeq+1 ; do I=Isq-1,Ieq+1 if (CS%no_slip ) then relative_vorticity = (2.0-G%mask2dBu(I,J)) * US%T_to_s*(dvdx(I,J) - dudy(I,J)) * & - G%IareaBu(I,J) + US%m_to_L**2*G%IareaBu(I,J) else relative_vorticity = G%mask2dBu(I,J) * US%T_to_s*(dvdx(I,J) - dudy(I,J)) * & - G%IareaBu(I,J) + US%m_to_L**2*G%IareaBu(I,J) endif absolute_vorticity = G%CoriolisBu(I,J) + relative_vorticity Ih = 0.0 @@ -867,7 +867,7 @@ subroutine gradKE(u, v, h, KE, KEx, KEy, k, OBC, G, US, CS) +G%areaCu(I-1,j)*(u(I-1,j,k)*u(I-1,j,k)) ) & +( G%areaCv(i, J )*(v(i, J ,k)*v(i, J ,k)) & +G%areaCv(i,J-1)*(v(i,J-1,k)*v(i,J-1,k)) ) & - )*0.25*G%IareaT(i,j) + )*0.25*US%m_to_L**2*G%IareaT(i,j) enddo ; enddo elseif (CS%KE_Scheme == KE_SIMPLE_GUDONOV) then ! The following discretization of KE is based on the one-dimensinal Gudonov @@ -887,7 +887,7 @@ subroutine gradKE(u, v, h, KE, KEx, KEy, k, OBC, G, US, CS) um = 0.5*( u( I ,j,k) - ABS( u( I ,j,k) ) ) ; um2a = um*um*G%areaCu( I ,j) vp = 0.5*( v(i,J-1,k) + ABS( v(i,J-1,k) ) ) ; vp2a = vp*vp*G%areaCv(i,J-1) vm = 0.5*( v(i, J ,k) - ABS( v(i, J ,k) ) ) ; vm2a = vm*vm*G%areaCv(i, J ) - KE(i,j) = ( max(um2a,up2a) + max(vm2a,vp2a) )*0.5*G%IareaT(i,j) + KE(i,j) = ( max(um2a,up2a) + max(vm2a,vp2a) )*0.5*US%m_to_L**2*G%IareaT(i,j) enddo ; enddo endif diff --git a/src/core/MOM_barotropic.F90 b/src/core/MOM_barotropic.F90 index 230a5439ef..4247a2aa5c 100644 --- a/src/core/MOM_barotropic.F90 +++ b/src/core/MOM_barotropic.F90 @@ -1392,7 +1392,7 @@ 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)) * (US%L_to_m**2*G%IareaT(i,j) * & + Idt_max2 = 0.5 * (dgeo_de * (1.0 + 2.0*bebt)) * (US%L_to_m**2*US%m_to_L**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)) + & @@ -1400,7 +1400,7 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, ((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) * & + US%L_to_m**2*US%m_to_L**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) / & @@ -1544,19 +1544,19 @@ 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_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 + if ((ubt(I,j) * (dt_in_T * US%m_to_L*G%dy_Cu(I,j))) * US%L_to_m**2*US%m_to_L**2*G%IareaT(i+1,j) < -CS%CFL_trunc) then ! Add some error reporting later. 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 + elseif ((ubt(I,j) * (dt_in_T * US%m_to_L*G%dy_Cu(I,j))) * US%L_to_m**2*US%m_to_L**2*G%IareaT(i,j) > CS%CFL_trunc) then ! Add some error reporting later. 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_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 + if ((vbt(i,J) * (dt_in_T * US%m_to_L*G%dx_Cv(i,J))) * US%L_to_m**2*US%m_to_L**2*G%IareaT(i,j+1) < -CS%CFL_trunc) then ! Add some error reporting later. 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 + elseif ((vbt(i,J) * (dt_in_T * US%m_to_L*G%dx_Cv(i,J))) * US%L_to_m**2*US%m_to_L**2*G%IareaT(i,j) > CS%CFL_trunc) then ! Add some error reporting later. 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 @@ -2350,7 +2350,7 @@ subroutine set_dtbt(G, GV, US, CS, eta, pbce, BT_cont, gtot_est, SSH_add) 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) * (US%L_to_m**2*G%IareaT(i,j) * & + Idt_max2 = 0.5 * (1.0 + 2.0*CS%bebt) * (US%L_to_m**2*US%m_to_L**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) + & @@ -4078,7 +4078,7 @@ 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) = US%L_to_m**2*G%IareaT(i,j) + CS%IareaT(i,j) = US%L_to_m**2*US%m_to_L**2*G%IareaT(i,j) CS%bathyT(i,j) = G%bathyT(i,j) enddo ; enddo @@ -4344,7 +4344,7 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, US, param_file, diag, CS, ! ### 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 * US%L_to_m**2*G%IareaT(i,j) * 0.1 * CS%maxvel * & + CS%eta_cor_bound(i,j) = GV%m_to_H * US%L_to_m**2*US%m_to_L**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 diff --git a/src/core/MOM_continuity_PPM.F90 b/src/core/MOM_continuity_PPM.F90 index c40fcb86f4..4117a2b5a9 100644 --- a/src/core/MOM_continuity_PPM.F90 +++ b/src/core/MOM_continuity_PPM.F90 @@ -154,7 +154,7 @@ subroutine continuity_PPM(u, v, hin, h, uh, vh, dt, G, GV, US, CS, uhbt, vhbt, O call cpu_clock_begin(id_clock_update) !$OMP parallel do default(shared) do k=1,nz ; do j=LB%jsh,LB%jeh ; do i=LB%ish,LB%ieh - h(i,j,k) = hin(i,j,k) - US%s_to_T*dt * US%L_to_m**2*G%IareaT(i,j) * (uh(I,j,k) - uh(I-1,j,k)) + h(i,j,k) = hin(i,j,k) - US%s_to_T*dt * US%L_to_m**2*US%m_to_L**2*G%IareaT(i,j) * (uh(I,j,k) - uh(I-1,j,k)) ! Uncomment this line to prevent underflow. ! if (h(i,j,k) < h_min) h(i,j,k) = h_min enddo ; enddo ; enddo @@ -169,7 +169,7 @@ subroutine continuity_PPM(u, v, hin, h, uh, vh, dt, G, GV, US, CS, uhbt, vhbt, O call cpu_clock_begin(id_clock_update) !$OMP parallel do default(shared) do k=1,nz ; do j=LB%jsh,LB%jeh ; do i=LB%ish,LB%ieh - h(i,j,k) = h(i,j,k) - US%s_to_T*dt * US%L_to_m**2*G%IareaT(i,j) * (vh(i,J,k) - vh(i,J-1,k)) + h(i,j,k) = h(i,j,k) - US%s_to_T*dt * US%L_to_m**2*US%m_to_L**2*G%IareaT(i,j) * (vh(i,J,k) - vh(i,J-1,k)) ! This line prevents underflow. if (h(i,j,k) < h_min) h(i,j,k) = h_min enddo ; enddo ; enddo @@ -185,7 +185,7 @@ subroutine continuity_PPM(u, v, hin, h, uh, vh, dt, G, GV, US, CS, uhbt, vhbt, O call cpu_clock_begin(id_clock_update) !$OMP parallel do default(shared) do k=1,nz ; do j=LB%jsh,LB%jeh ; do i=LB%ish,LB%ieh - h(i,j,k) = hin(i,j,k) - US%s_to_T*dt * US%L_to_m**2*G%IareaT(i,j) * (vh(i,J,k) - vh(i,J-1,k)) + h(i,j,k) = hin(i,j,k) - US%s_to_T*dt * US%L_to_m**2*US%m_to_L**2*G%IareaT(i,j) * (vh(i,J,k) - vh(i,J-1,k)) enddo ; enddo ; enddo call cpu_clock_end(id_clock_update) @@ -197,7 +197,7 @@ subroutine continuity_PPM(u, v, hin, h, uh, vh, dt, G, GV, US, CS, uhbt, vhbt, O call cpu_clock_begin(id_clock_update) !$OMP parallel do default(shared) do k=1,nz ; do j=LB%jsh,LB%jeh ; do i=LB%ish,LB%ieh - h(i,j,k) = h(i,j,k) - US%s_to_T*dt * US%L_to_m**2*G%IareaT(i,j) * (uh(I,j,k) - uh(I-1,j,k)) + h(i,j,k) = h(i,j,k) - US%s_to_T*dt * US%L_to_m**2*US%m_to_L**2*G%IareaT(i,j) * (uh(I,j,k) - uh(I-1,j,k)) ! This line prevents underflow. if (h(i,j,k) < h_min) h(i,j,k) = h_min enddo ; enddo ; enddo @@ -539,14 +539,14 @@ subroutine zonal_flux_layer(u, h, h_L, h_R, uh, duhdu, visc_rem, dt_in_T, G, US, do I=ish-1,ieh ; if (do_I(I)) then ! Set new values of uh and duhdu. if (u(I) > 0.0) then - if (vol_CFL) then ; CFL = (u(I) * dt_in_T) * (US%m_to_L*G%dy_Cu(I,j) * US%L_to_m**2*G%IareaT(i,j)) + if (vol_CFL) then ; CFL = (u(I) * dt_in_T) * (US%m_to_L*G%dy_Cu(I,j) * US%L_to_m**2*US%m_to_L**2*G%IareaT(i,j)) else ; CFL = u(I) * dt_in_T * US%L_to_m*G%IdxT(i,j) ; endif curv_3 = h_L(i) + h_R(i) - 2.0*h(i) uh(I) = US%m_to_L*G%dy_Cu(I,j) * u(I) * & (h_R(i) + CFL * (0.5*(h_L(i) - h_R(i)) + curv_3*(CFL - 1.5))) h_marg = h_R(i) + CFL * ((h_L(i) - h_R(i)) + 3.0*curv_3*(CFL - 1.0)) elseif (u(I) < 0.0) then - if (vol_CFL) then ; CFL = (-u(I) * dt_in_T) * (US%m_to_L*G%dy_Cu(I,j) * US%L_to_m**2*G%IareaT(i+1,j)) + if (vol_CFL) then ; CFL = (-u(I) * dt_in_T) * (US%m_to_L*G%dy_Cu(I,j) * US%L_to_m**2*US%m_to_L**2*G%IareaT(i+1,j)) else ; CFL = -u(I) * dt_in_T * US%L_to_m*G%IdxT(i+1,j) ; endif curv_3 = h_L(i+1) + h_R(i+1) - 2.0*h(i+1) uh(I) = US%m_to_L*G%dy_Cu(I,j) * u(I) * & @@ -614,13 +614,13 @@ subroutine zonal_face_thickness(u, h, h_L, h_R, h_u, dt_in_T, G, US, LB, vol_CFL !$OMP parallel do default(shared) private(CFL,curv_3,h_marg,h_avg) do k=1,nz ; do j=jsh,jeh ; do I=ish-1,ieh if (u(I,j,k) > 0.0) then - if (vol_CFL) then ; CFL = (u(I,j,k) * dt_in_T) * (US%m_to_L*G%dy_Cu(I,j) * US%L_to_m**2*G%IareaT(i,j)) + if (vol_CFL) then ; CFL = (u(I,j,k) * dt_in_T) * (US%m_to_L*G%dy_Cu(I,j) * US%L_to_m**2*US%m_to_L**2*G%IareaT(i,j)) else ; CFL = u(I,j,k) * dt_in_T * US%L_to_m*G%IdxT(i,j) ; endif curv_3 = h_L(i,j,k) + h_R(i,j,k) - 2.0*h(i,j,k) h_avg = h_R(i,j,k) + CFL * (0.5*(h_L(i,j,k) - h_R(i,j,k)) + curv_3*(CFL - 1.5)) h_marg = h_R(i,j,k) + CFL * ((h_L(i,j,k) - h_R(i,j,k)) + 3.0*curv_3*(CFL - 1.0)) elseif (u(I,j,k) < 0.0) then - if (vol_CFL) then ; CFL = (-u(I,j,k)*dt_in_T) * (US%m_to_L*G%dy_Cu(I,j) * US%L_to_m**2*G%IareaT(i+1,j)) + if (vol_CFL) then ; CFL = (-u(I,j,k)*dt_in_T) * (US%m_to_L*G%dy_Cu(I,j) * US%L_to_m**2*US%m_to_L**2*G%IareaT(i+1,j)) else ; CFL = -u(I,j,k) * dt_in_T * US%L_to_m*G%IdxT(i+1,j) ; endif curv_3 = h_L(i+1,j,k) + h_R(i+1,j,k) - 2.0*h(i+1,j,k) h_avg = h_L(i+1,j,k) + CFL * (0.5*(h_R(i+1,j,k)-h_L(i+1,j,k)) + curv_3*(CFL - 1.5)) @@ -779,7 +779,7 @@ subroutine zonal_flux_adjust(u, h_in, h_L, h_R, uhbt, uh_tot_0, duhdu_tot_0, & enddo domore = .false. do I=ish-1,ieh ; if (do_I(I)) then - if ((dt_in_T * min(US%L_to_m**2*G%IareaT(i,j),US%L_to_m**2*G%IareaT(i+1,j))*abs(uh_err(I)) > tol_eta) .or. & + if ((dt_in_T * min(US%L_to_m**2*US%m_to_L**2*G%IareaT(i,j),US%L_to_m**2*US%m_to_L**2*G%IareaT(i+1,j))*abs(uh_err(I)) > tol_eta) .or. & (CS%better_iter .and. ((abs(uh_err(I)) > tol_vel * duhdu_tot(I)) .or. & (abs(uh_err(I)) > uh_err_best(I))) )) then ! Use Newton's method, provided it stays bounded. Otherwise bisect @@ -1337,7 +1337,7 @@ subroutine merid_flux_layer(v, h, h_L, h_R, vh, dvhdv, visc_rem, dt_in_T, G, US, do i=ish,ieh ; if (do_I(i)) then if (v(i) > 0.0) then - if (vol_CFL) then ; CFL = (v(i) * dt_in_T) * (US%m_to_L*G%dx_Cv(i,J) * US%L_to_m**2*G%IareaT(i,j)) + if (vol_CFL) then ; CFL = (v(i) * dt_in_T) * (US%m_to_L*G%dx_Cv(i,J) * US%L_to_m**2*US%m_to_L**2*G%IareaT(i,j)) else ; CFL = v(i) * dt_in_T * US%L_to_m*G%IdyT(i,j) ; endif curv_3 = h_L(i,j) + h_R(i,j) - 2.0*h(i,j) vh(i) = US%m_to_L*G%dx_Cv(i,J) * v(i) * ( h_R(i,j) + CFL * & @@ -1345,7 +1345,7 @@ subroutine merid_flux_layer(v, h, h_L, h_R, vh, dvhdv, visc_rem, dt_in_T, G, US, h_marg = h_R(i,j) + CFL * ((h_L(i,j) - h_R(i,j)) + & 3.0*curv_3*(CFL - 1.0)) elseif (v(i) < 0.0) then - if (vol_CFL) then ; CFL = (-v(i) * dt_in_T) * (US%m_to_L*G%dx_Cv(i,J) * US%L_to_m**2*G%IareaT(i,j+1)) + if (vol_CFL) then ; CFL = (-v(i) * dt_in_T) * (US%m_to_L*G%dx_Cv(i,J) * US%L_to_m**2*US%m_to_L**2*G%IareaT(i,j+1)) else ; CFL = -v(i) * dt_in_T * US%L_to_m*G%IdyT(i,j+1) ; endif curv_3 = h_L(i,j+1) + h_R(i,j+1) - 2.0*h(i,j+1) vh(i) = US%m_to_L*G%dx_Cv(i,J) * v(i) * ( h_L(i,j+1) + CFL * & @@ -1414,14 +1414,14 @@ subroutine merid_face_thickness(v, h, h_L, h_R, h_v, dt_in_T, G, US, LB, vol_CFL !$OMP parallel do default(shared) private(CFL,curv_3,h_marg,h_avg) do k=1,nz ; do J=jsh-1,jeh ; do i=ish,ieh if (v(i,J,k) > 0.0) then - if (vol_CFL) then ; CFL = (v(i,J,k) * dt_in_T) * (US%m_to_L*G%dx_Cv(i,J) * US%L_to_m**2*G%IareaT(i,j)) + if (vol_CFL) then ; CFL = (v(i,J,k) * dt_in_T) * (US%m_to_L*G%dx_Cv(i,J) * US%L_to_m**2*US%m_to_L**2*G%IareaT(i,j)) else ; CFL = v(i,J,k) * dt_in_T * US%L_to_m*G%IdyT(i,j) ; endif curv_3 = h_L(i,j,k) + h_R(i,j,k) - 2.0*h(i,j,k) h_avg = h_R(i,j,k) + CFL * (0.5*(h_L(i,j,k) - h_R(i,j,k)) + curv_3*(CFL - 1.5)) h_marg = h_R(i,j,k) + CFL * ((h_L(i,j,k) - h_R(i,j,k)) + & 3.0*curv_3*(CFL - 1.0)) elseif (v(i,J,k) < 0.0) then - if (vol_CFL) then ; CFL = (-v(i,J,k)*dt_in_T) * (US%m_to_L*G%dx_Cv(i,J) * US%L_to_m**2*G%IareaT(i,j+1)) + if (vol_CFL) then ; CFL = (-v(i,J,k)*dt_in_T) * (US%m_to_L*G%dx_Cv(i,J) * US%L_to_m**2*US%m_to_L**2*G%IareaT(i,j+1)) else ; CFL = -v(i,J,k) * dt_in_T * US%L_to_m*G%IdyT(i,j+1) ; endif curv_3 = h_L(i,j+1,k) + h_R(i,j+1,k) - 2.0*h(i,j+1,k) h_avg = h_L(i,j+1,k) + CFL * (0.5*(h_R(i,j+1,k)-h_L(i,j+1,k)) + curv_3*(CFL - 1.5)) @@ -1579,7 +1579,7 @@ subroutine meridional_flux_adjust(v, h_in, h_L, h_R, vhbt, vh_tot_0, dvhdv_tot_0 enddo domore = .false. do i=ish,ieh ; if (do_I(i)) then - if ((dt_in_T * min(US%L_to_m**2*G%IareaT(i,j),US%L_to_m**2*G%IareaT(i,j+1))*abs(vh_err(i)) > tol_eta) .or. & + if ((dt_in_T * min(US%L_to_m**2*US%m_to_L**2*G%IareaT(i,j),US%L_to_m**2*US%m_to_L**2*G%IareaT(i,j+1))*abs(vh_err(i)) > tol_eta) .or. & (CS%better_iter .and. ((abs(vh_err(i)) > tol_vel * dvhdv_tot(i)) .or. & (abs(vh_err(i)) > vh_err_best(i))) )) then ! Use Newton's method, provided it stays bounded. Otherwise bisect diff --git a/src/core/MOM_grid.F90 b/src/core/MOM_grid.F90 index b66aecd261..0679c23efa 100644 --- a/src/core/MOM_grid.F90 +++ b/src/core/MOM_grid.F90 @@ -8,6 +8,7 @@ module MOM_grid use MOM_domains, only : get_global_shape, get_domain_extent_dsamp2 use MOM_error_handler, only : MOM_error, MOM_mesg, FATAL use MOM_file_parser, only : get_param, log_param, log_version, param_file_type +use MOM_unit_scaling, only : unit_scale_type implicit none ; private @@ -81,7 +82,7 @@ module MOM_grid dyT, & !< dyT is delta y at h points [m]. IdyT, & !< IdyT is 1/dyT [m-1]. areaT, & !< The area of an h-cell [m2]. - IareaT, & !< 1/areaT [m-2]. + IareaT, & !< 1/areaT [L-2 ~> m-2]. sin_rot, & !< The sine of the angular rotation between the local model grid's northward !! and the true northward directions. cos_rot !< The cosine of the angular rotation between the local model grid's northward @@ -96,7 +97,7 @@ module MOM_grid dyCu, & !< dyCu is delta y at u points [m]. IdyCu, & !< 1/dyCu [m-1]. dy_Cu, & !< The unblocked lengths of the u-faces of the h-cell [m]. - IareaCu, & !< The masked inverse areas of u-grid cells [m2]. + IareaCu, & !< The masked inverse areas of u-grid cells [L-2 ~> m-2]. areaCu !< The areas of the u-grid cells [m2]. real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_) :: & @@ -108,7 +109,7 @@ module MOM_grid dyCv, & !< dyCv is delta y at v points [m]. IdyCv, & !< 1/dyCv [m-1]. dx_Cv, & !< The unblocked lengths of the v-faces of the h-cell [m]. - IareaCv, & !< The masked inverse areas of v-grid cells [m2]. + IareaCv, & !< The masked inverse areas of v-grid cells [L-2 ~> m-2]. areaCv !< The areas of the v-grid cells [m2]. real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEMB_PTR_) :: & @@ -120,7 +121,7 @@ module MOM_grid dyBu, & !< dyBu is delta y at q points [m]. IdyBu, & !< 1/dyBu [m-1]. areaBu, & !< areaBu is the area of a q-cell [m2] - IareaBu !< IareaBu = 1/areaBu [m-2]. + IareaBu !< IareaBu = 1/areaBu [L-2 ~> m-2]. real, pointer, dimension(:) :: & gridLatT => NULL(), & !< The latitude of T points for the purpose of labeling the output axes. @@ -155,9 +156,9 @@ module MOM_grid df_dy !< Derivative d/dy f (Coriolis parameter) at h-points [T-1 m-1 ~> s-1 m-1]. real :: g_Earth !< The gravitational acceleration [m2 Z-1 s-2 ~> m s-2]. - ! These variables are global sums that are useful for 1-d diagnostics + ! These variables are global sums that are useful for 1-d diagnostics and should not be rescaled. real :: areaT_global !< Global sum of h-cell area [m2] - real :: IareaT_global !< Global sum of inverse h-cell area (1/areaT_global) [m2]. + real :: IareaT_global !< Global sum of inverse h-cell area (1/areaT_global) [m-2]. ! These variables are for block structures. integer :: nblocks !< The number of sub-PE blocks on this PE @@ -402,8 +403,9 @@ subroutine rescale_grid_bathymetry(G, m_in_new_units) end subroutine rescale_grid_bathymetry !> set_derived_metrics calculates metric terms that are derived from other metrics. -subroutine set_derived_metrics(G) - type(ocean_grid_type), intent(inout) :: G !< The horizontal grid structure +subroutine set_derived_metrics(G, US) + type(ocean_grid_type), intent(inout) :: G !< The horizontal grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type ! Various inverse grid spacings and derived areas are calculated within this ! subroutine. integer :: i, j, isd, ied, jsd, jed @@ -417,7 +419,7 @@ subroutine set_derived_metrics(G) if (G%dyT(i,j) < 0.0) G%dyT(i,j) = 0.0 G%IdxT(i,j) = Adcroft_reciprocal(G%dxT(i,j)) G%IdyT(i,j) = Adcroft_reciprocal(G%dyT(i,j)) - G%IareaT(i,j) = Adcroft_reciprocal(G%areaT(i,j)) + G%IareaT(i,j) = Adcroft_reciprocal(US%m_to_L**2*G%areaT(i,j)) enddo ; enddo do j=jsd,jed ; do I=IsdB,IedB @@ -442,7 +444,7 @@ subroutine set_derived_metrics(G) G%IdyBu(I,J) = Adcroft_reciprocal(G%dyBu(I,J)) ! areaBu has usually been set to a positive area elsewhere. if (G%areaBu(I,J) <= 0.0) G%areaBu(I,J) = G%dxBu(I,J) * G%dyBu(I,J) - G%IareaBu(I,J) = Adcroft_reciprocal(G%areaBu(I,J)) + G%IareaBu(I,J) = Adcroft_reciprocal(US%m_to_L**2*G%areaBu(I,J)) enddo ; enddo end subroutine set_derived_metrics diff --git a/src/core/MOM_transcribe_grid.F90 b/src/core/MOM_transcribe_grid.F90 index 62ac6e1ea4..045fc9261c 100644 --- a/src/core/MOM_transcribe_grid.F90 +++ b/src/core/MOM_transcribe_grid.F90 @@ -9,6 +9,7 @@ module MOM_transcribe_grid use MOM_dyn_horgrid, only : dyn_horgrid_type, set_derived_dyn_horgrid use MOM_error_handler, only : MOM_error, MOM_mesg, FATAL, WARNING use MOM_grid, only : ocean_grid_type, set_derived_metrics +use MOM_unit_scaling, only : unit_scale_type implicit none ; private @@ -18,9 +19,10 @@ module MOM_transcribe_grid !> Copies information from a dynamic (shared) horizontal grid type into an !! ocean_grid_type. -subroutine copy_dyngrid_to_MOM_grid(dG, oG) +subroutine copy_dyngrid_to_MOM_grid(dG, oG, US) type(dyn_horgrid_type), intent(in) :: dG !< Common horizontal grid type type(ocean_grid_type), intent(inout) :: oG !< Ocean grid type + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type integer :: isd, ied, jsd, jed ! Common data domains. integer :: IsdB, IedB, JsdB, JedB ! Common data domains. @@ -154,16 +156,17 @@ subroutine copy_dyngrid_to_MOM_grid(dG, oG) call pass_vector(oG%Dopen_u, oG%Dopen_v, oG%Domain, To_All+Scalar_Pair, CGRID_NE) endif - call set_derived_metrics(oG) + call set_derived_metrics(oG, US) end subroutine copy_dyngrid_to_MOM_grid !> Copies information from an ocean_grid_type into a dynamic (shared) !! horizontal grid type. -subroutine copy_MOM_grid_to_dyngrid(oG, dG) +subroutine copy_MOM_grid_to_dyngrid(oG, dG, US) type(ocean_grid_type), intent(in) :: oG !< Ocean grid type type(dyn_horgrid_type), intent(inout) :: dG !< Common horizontal grid type + type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type integer :: isd, ied, jsd, jed ! Common data domains. integer :: IsdB, IedB, JsdB, JedB ! Common data domains. @@ -298,7 +301,7 @@ subroutine copy_MOM_grid_to_dyngrid(oG, dG) call pass_vector(dG%Dopen_u, dG%Dopen_v, dG%Domain, To_All+Scalar_Pair, CGRID_NE) endif - call set_derived_dyn_horgrid(dG) + call set_derived_dyn_horgrid(dG, US) end subroutine copy_MOM_grid_to_dyngrid diff --git a/src/diagnostics/MOM_PointAccel.F90 b/src/diagnostics/MOM_PointAccel.F90 index 6dce366ab5..a13003a826 100644 --- a/src/diagnostics/MOM_PointAccel.F90 +++ b/src/diagnostics/MOM_PointAccel.F90 @@ -174,8 +174,8 @@ subroutine write_u_accel(I, j, um, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st write(file,'(/,"CFL u: ",$)') do k=ks,ke ; if (do_k(k)) then CFL = abs(um(I,j,k)) * dt * G%dy_Cu(I,j) - if (um(I,j,k) < 0.0) then ; CFL = CFL * G%IareaT(i+1,j) - else ; CFL = CFL * G%IareaT(i,j) ; endif + if (um(I,j,k) < 0.0) then ; CFL = CFL * US%m_to_L**2*G%IareaT(i+1,j) + else ; CFL = CFL * US%m_to_L**2*G%IareaT(i,j) ; endif write(file,'(ES10.3," ",$)') CFL endif ; enddo write(file,'(/,"CFL0 u:",$)') @@ -505,8 +505,8 @@ subroutine write_v_accel(i, J, vm, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st write(file,'(/,"CFL v: ",$)') do k=ks,ke ; if (do_k(k)) then CFL = abs(vm(i,J,k)) * dt * G%dx_Cv(i,J) - if (vm(i,J,k) < 0.0) then ; CFL = CFL * G%IareaT(i,j+1) - else ; CFL = CFL * G%IareaT(i,j) ; endif + if (vm(i,J,k) < 0.0) then ; CFL = CFL * US%m_to_L**2*G%IareaT(i,j+1) + else ; CFL = CFL * US%m_to_L**2*G%IareaT(i,j) ; endif write(file,'(ES10.3," ",$)') CFL endif ; enddo write(file,'(/,"CFL0 v:",$)') diff --git a/src/diagnostics/MOM_diagnostics.F90 b/src/diagnostics/MOM_diagnostics.F90 index dd9e1b3bb4..74e5e41a09 100644 --- a/src/diagnostics/MOM_diagnostics.F90 +++ b/src/diagnostics/MOM_diagnostics.F90 @@ -947,7 +947,7 @@ subroutine calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, GV, US, CS if (.not.G%symmetric) & call do_group_pass(CS%pass_KE_uv, G%domain) do j=js,je ; do i=is,ie - CS%dKE_dt(i,j,k) = GV%H_to_m * (KE_h(i,j) + 0.5 * US%L_to_m**2*G%IareaT(i,j) * & + CS%dKE_dt(i,j,k) = GV%H_to_m * (KE_h(i,j) + 0.5 * US%L_to_m**2*US%m_to_L**2*G%IareaT(i,j) * & (KE_u(I,j) + KE_u(I-1,j) + KE_v(i,J) + KE_v(i,J-1))) enddo ; enddo enddo @@ -965,7 +965,7 @@ subroutine calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, GV, US, CS if (.not.G%symmetric) & call do_group_pass(CS%pass_KE_uv, G%domain) do j=js,je ; do i=is,ie - CS%PE_to_KE(i,j,k) = GV%H_to_m * 0.5 * US%L_to_m**2*G%IareaT(i,j) * & + CS%PE_to_KE(i,j,k) = GV%H_to_m * 0.5 * US%L_to_m**2*US%m_to_L**2*G%IareaT(i,j) * & (KE_u(I,j) + KE_u(I-1,j) + KE_v(i,J) + KE_v(i,J-1)) enddo ; enddo enddo @@ -981,13 +981,13 @@ subroutine calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, GV, US, CS KE_v(i,J) = US%L_T_to_m_s**2*US%s_to_T*vh(i,J,k)*US%m_to_L*G%dyCv(i,J)*ADp%CAv(i,J,k) enddo ; enddo do j=js,je ; do i=is,ie - KE_h(i,j) = -CS%KE(i,j,k) * US%L_to_m**2*G%IareaT(i,j) * & + KE_h(i,j) = -CS%KE(i,j,k) * US%L_to_m**2*US%m_to_L**2*G%IareaT(i,j) * & US%s_to_T*(uh(I,j,k) - uh(I-1,j,k) + vh(i,J,k) - vh(i,J-1,k)) enddo ; enddo if (.not.G%symmetric) & call do_group_pass(CS%pass_KE_uv, G%domain) do j=js,je ; do i=is,ie - CS%KE_CorAdv(i,j,k) = GV%H_to_m * (KE_h(i,j) + 0.5 * US%L_to_m**2*G%IareaT(i,j) * & + CS%KE_CorAdv(i,j,k) = GV%H_to_m * (KE_h(i,j) + 0.5 * US%L_to_m**2*US%m_to_L**2*G%IareaT(i,j) * & (KE_u(I,j) + KE_u(I-1,j) + KE_v(i,J) + KE_v(i,J-1))) enddo ; enddo enddo @@ -1009,13 +1009,13 @@ subroutine calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, GV, US, CS KE_v(i,J) = US%L_T_to_m_s**2*US%s_to_T*vh(i,J,k)*US%m_to_L*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) * US%L_to_m**2*G%IareaT(i,j) * & + KE_h(i,j) = -CS%KE(i,j,k) * US%L_to_m**2*US%m_to_L**2*G%IareaT(i,j) * & US%s_to_T*(uh(I,j,k) - uh(I-1,j,k) + vh(i,J,k) - vh(i,J-1,k)) enddo ; enddo if (.not.G%symmetric) & call do_group_pass(CS%pass_KE_uv, G%domain) do j=js,je ; do i=is,ie - CS%KE_adv(i,j,k) = GV%H_to_m * (KE_h(i,j) + 0.5 * US%L_to_m**2*G%IareaT(i,j) * & + CS%KE_adv(i,j,k) = GV%H_to_m * (KE_h(i,j) + 0.5 * US%L_to_m**2*US%m_to_L**2*G%IareaT(i,j) * & (KE_u(I,j) + KE_u(I-1,j) + KE_v(i,J) + KE_v(i,J-1))) enddo ; enddo enddo @@ -1033,7 +1033,7 @@ subroutine calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, GV, US, CS if (.not.G%symmetric) & call do_group_pass(CS%pass_KE_uv, G%domain) do j=js,je ; do i=is,ie - CS%KE_visc(i,j,k) = GV%H_to_m * (0.5 * US%L_to_m**2*G%IareaT(i,j) * & + CS%KE_visc(i,j,k) = GV%H_to_m * (0.5 * US%L_to_m**2*US%m_to_L**2*G%IareaT(i,j) * & (KE_u(I,j) + KE_u(I-1,j) + KE_v(i,J) + KE_v(i,J-1))) enddo ; enddo enddo @@ -1051,7 +1051,7 @@ subroutine calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, GV, US, CS if (.not.G%symmetric) & call do_group_pass(CS%pass_KE_uv, G%domain) do j=js,je ; do i=is,ie - CS%KE_horvisc(i,j,k) = GV%H_to_m * 0.5 * US%L_to_m**2*G%IareaT(i,j) * & + CS%KE_horvisc(i,j,k) = GV%H_to_m * 0.5 * US%L_to_m**2*US%m_to_L**2*G%IareaT(i,j) * & (KE_u(I,j) + KE_u(I-1,j) + KE_v(i,J) + KE_v(i,J-1)) enddo ; enddo enddo @@ -1073,7 +1073,7 @@ subroutine calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, GV, US, CS if (.not.G%symmetric) & call do_group_pass(CS%pass_KE_uv, G%domain) do j=js,je ; do i=is,ie - CS%KE_dia(i,j,k) = KE_h(i,j) + GV%H_to_m * 0.5 * US%L_to_m**2*G%IareaT(i,j) * & + CS%KE_dia(i,j,k) = KE_h(i,j) + GV%H_to_m * 0.5 * US%L_to_m**2*US%m_to_L**2*G%IareaT(i,j) * & (KE_u(I,j) + KE_u(I-1,j) + KE_v(i,J) + KE_v(i,J-1)) enddo ; enddo enddo diff --git a/src/diagnostics/MOM_sum_output.F90 b/src/diagnostics/MOM_sum_output.F90 index 73dc411fa5..c30dd3d52b 100644 --- a/src/diagnostics/MOM_sum_output.F90 +++ b/src/diagnostics/MOM_sum_output.F90 @@ -713,9 +713,9 @@ subroutine write_energy(u, v, h, tv, day, n, G, GV, US, CS, tracer_CSp, OBC, dt_ max_CFL(1:2) = 0.0 do k=1,nz ; do j=js,je ; do I=Isq,Ieq if (u(I,j,k) < 0.0) then - CFL_trans = (-u(I,j,k) * CS%dt) * (G%dy_Cu(I,j) * G%IareaT(i+1,j)) + CFL_trans = (-u(I,j,k) * CS%dt) * (G%dy_Cu(I,j) * US%m_to_L**2*G%IareaT(i+1,j)) else - CFL_trans = (u(I,j,k) * CS%dt) * (G%dy_Cu(I,j) * G%IareaT(i,j)) + CFL_trans = (u(I,j,k) * CS%dt) * (G%dy_Cu(I,j) * US%m_to_L**2*G%IareaT(i,j)) endif CFL_lin = abs(u(I,j,k) * CS%dt) * G%IdxCu(I,j) max_CFL(1) = max(max_CFL(1), CFL_trans) @@ -723,9 +723,9 @@ subroutine write_energy(u, v, h, tv, day, n, G, GV, US, CS, tracer_CSp, OBC, dt_ enddo ; enddo ; enddo do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie if (v(i,J,k) < 0.0) then - CFL_trans = (-v(i,J,k) * CS%dt) * (G%dx_Cv(i,J) * G%IareaT(i,j+1)) + CFL_trans = (-v(i,J,k) * CS%dt) * (G%dx_Cv(i,J) * US%m_to_L**2*G%IareaT(i,j+1)) else - CFL_trans = (v(i,J,k) * CS%dt) * (G%dx_Cv(i,J) * G%IareaT(i,j)) + CFL_trans = (v(i,J,k) * CS%dt) * (G%dx_Cv(i,J) * US%m_to_L**2*G%IareaT(i,j)) endif CFL_lin = abs(v(i,J,k) * CS%dt) * G%IdyCv(i,J) max_CFL(1) = max(max_CFL(1), CFL_trans) diff --git a/src/framework/MOM_dyn_horgrid.F90 b/src/framework/MOM_dyn_horgrid.F90 index 0a83ef983e..9bee061016 100644 --- a/src/framework/MOM_dyn_horgrid.F90 +++ b/src/framework/MOM_dyn_horgrid.F90 @@ -7,6 +7,7 @@ module MOM_dyn_horgrid use MOM_hor_index, only : hor_index_type use MOM_domains, only : MOM_domain_type use MOM_error_handler, only : MOM_error, MOM_mesg, FATAL, WARNING +use MOM_unit_scaling, only : unit_scale_type implicit none ; private @@ -74,7 +75,7 @@ module MOM_dyn_horgrid IdxT, & !< 1/dxT [m-1]. dyT, & !< dyT is delta y at h points [m]. IdyT, & !< IdyT is 1/dyT [m-1]. - areaT, & !< The area of an h-cell [m2]. + areaT, & !< The area of an h-cell [L-2 ~> m-2]. IareaT !< 1/areaT [m-2]. real, allocatable, dimension(:,:) :: sin_rot !< The sine of the angular rotation between the local model grid's northward @@ -92,7 +93,7 @@ module MOM_dyn_horgrid dyCu, & !< dyCu is delta y at u points [m]. IdyCu, & !< 1/dyCu [m-1]. dy_Cu, & !< The unblocked lengths of the u-faces of the h-cell [m]. - IareaCu, & !< The masked inverse areas of u-grid cells [m2]. + IareaCu, & !< The masked inverse areas of u-grid cells [L-2 ~> m-2]. areaCu !< The areas of the u-grid cells [m2]. real, allocatable, dimension(:,:) :: & @@ -104,7 +105,7 @@ module MOM_dyn_horgrid dyCv, & !< dyCv is delta y at v points [m]. IdyCv, & !< 1/dyCv [m-1]. dx_Cv, & !< The unblocked lengths of the v-faces of the h-cell [m]. - IareaCv, & !< The masked inverse areas of v-grid cells [m2]. + IareaCv, & !< The masked inverse areas of v-grid cells [L-2 ~> m-2]. areaCv !< The areas of the v-grid cells [m2]. real, allocatable, dimension(:,:) :: & @@ -115,7 +116,7 @@ module MOM_dyn_horgrid IdxBu, & !< 1/dxBu [m-1]. dyBu, & !< dyBu is delta y at q points [m]. IdyBu, & !< 1/dyBu [m-1]. - areaBu, & !< areaBu is the area of a q-cell [m2] + areaBu, & !< areaBu is the area of a q-cell [L-2 ~> m-2] IareaBu !< IareaBu = 1/areaBu [m-2]. real, pointer, dimension(:) :: gridLatT => NULL() @@ -153,7 +154,7 @@ module MOM_dyn_horgrid df_dx, & !< Derivative d/dx f (Coriolis parameter) at h-points [T-1 m-1 ~> s-1 m-1]. df_dy !< Derivative d/dy f (Coriolis parameter) at h-points [T-1 m-1 ~> s-1 m-1]. - ! These variables are global sums that are useful for 1-d diagnostics + ! These variables are global sums that are useful for 1-d diagnostics and should not be rescaled. real :: areaT_global !< Global sum of h-cell area [m2] real :: IareaT_global !< Global sum of inverse h-cell area (1/areaT_global) [m-2] @@ -312,12 +313,15 @@ subroutine rescale_dyn_horgrid_bathymetry(G, m_in_new_units) end subroutine rescale_dyn_horgrid_bathymetry !> set_derived_dyn_horgrid calculates metric terms that are derived from other metrics. -subroutine set_derived_dyn_horgrid(G) +subroutine set_derived_dyn_horgrid(G, US) type(dyn_horgrid_type), intent(inout) :: G !< The dynamic horizontal grid type + type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type ! Various inverse grid spacings and derived areas are calculated within this ! subroutine. + real :: m_to_L ! A unit conversion factor [L m-1 ~> nondim] integer :: i, j, isd, ied, jsd, jed integer :: IsdB, IedB, JsdB, JedB + m_to_L = 1.0 ; if (present(US)) m_to_L = US%m_to_L isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed IsdB = G%IsdB ; IedB = G%IedB ; JsdB = G%JsdB ; JedB = G%JedB @@ -327,7 +331,7 @@ subroutine set_derived_dyn_horgrid(G) if (G%dyT(i,j) < 0.0) G%dyT(i,j) = 0.0 G%IdxT(i,j) = Adcroft_reciprocal(G%dxT(i,j)) G%IdyT(i,j) = Adcroft_reciprocal(G%dyT(i,j)) - G%IareaT(i,j) = Adcroft_reciprocal(G%areaT(i,j)) + G%IareaT(i,j) = Adcroft_reciprocal(m_to_L**2*G%areaT(i,j)) enddo ; enddo do j=jsd,jed ; do I=IsdB,IedB @@ -352,7 +356,7 @@ subroutine set_derived_dyn_horgrid(G) G%IdyBu(I,J) = Adcroft_reciprocal(G%dyBu(I,J)) ! areaBu has usually been set to a positive area elsewhere. if (G%areaBu(I,J) <= 0.0) G%areaBu(I,J) = G%dxBu(I,J) * G%dyBu(I,J) - G%IareaBu(I,J) = Adcroft_reciprocal(G%areaBu(I,J)) + G%IareaBu(I,J) = Adcroft_reciprocal(m_to_L**2*G%areaBu(I,J)) enddo ; enddo end subroutine set_derived_dyn_horgrid diff --git a/src/ice_shelf/MOM_ice_shelf.F90 b/src/ice_shelf/MOM_ice_shelf.F90 index a753f273aa..271ff5cb4b 100644 --- a/src/ice_shelf/MOM_ice_shelf.F90 +++ b/src/ice_shelf/MOM_ice_shelf.F90 @@ -652,7 +652,7 @@ subroutine shelf_calc_flux(state, fluxes, Time, time_step, CS, forces) if (CS%debug) call MOM_forcing_chksum("Before add shelf flux", fluxes, G, CS%US, haloshift=0) - call add_shelf_flux(G, CS, state, fluxes) + call add_shelf_flux(G, US, CS, state, fluxes) ! now the thermodynamic data is passed on... time to update the ice dynamic quantities @@ -686,7 +686,7 @@ subroutine shelf_calc_flux(state, fluxes, Time, time_step, CS, forces) call disable_averaging(CS%diag) if (present(forces)) then - call add_shelf_forces(G, CS, forces, do_shelf_area=(CS%active_shelf_dynamics .or. & + call add_shelf_forces(G, US, CS, forces, do_shelf_area=(CS%active_shelf_dynamics .or. & CS%override_shelf_movement)) endif @@ -750,8 +750,9 @@ end subroutine change_thickness_using_melt !> This subroutine adds the mechanical forcing fields and perhaps shelf areas, based on !! the ice state in ice_shelf_CS. -subroutine add_shelf_forces(G, CS, forces, do_shelf_area) +subroutine add_shelf_forces(G, US, CS, forces, do_shelf_area) 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(ice_shelf_CS), pointer :: CS !< This module's control structure. type(mech_forcing), intent(inout) :: forces !< A structure with the driving mechanical forces logical, optional, intent(in) :: do_shelf_area !< If true find the shelf-covered areas. @@ -793,7 +794,7 @@ subroutine add_shelf_forces(G, CS, forces, do_shelf_area) !### Consider working over a smaller array range. do j=jsd,jed ; do i=isd,ied - press_ice = (ISS%area_shelf_h(i,j) * G%IareaT(i,j)) * (CS%g_Earth * ISS%mass_shelf(i,j)) + press_ice = (ISS%area_shelf_h(i,j) * US%m_to_L**2*G%IareaT(i,j)) * (CS%g_Earth * ISS%mass_shelf(i,j)) if (associated(forces%p_surf)) then if (.not.forces%accumulate_p_surf) forces%p_surf(i,j) = 0.0 forces%p_surf(i,j) = forces%p_surf(i,j) + press_ice @@ -830,8 +831,9 @@ subroutine add_shelf_forces(G, CS, forces, do_shelf_area) end subroutine add_shelf_forces !> This subroutine adds the ice shelf pressure to the fluxes type. -subroutine add_shelf_pressure(G, CS, fluxes) +subroutine add_shelf_pressure(G, US, CS, fluxes) 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(ice_shelf_CS), intent(in) :: CS !< This module's control structure. type(forcing), intent(inout) :: fluxes !< A structure of surface fluxes that may be updated. @@ -844,7 +846,7 @@ subroutine add_shelf_pressure(G, CS, fluxes) call MOM_error(FATAL,"add_shelf_pressure: Incompatible ocean and ice shelf grids.") do j=js,je ; do i=is,ie - press_ice = (CS%ISS%area_shelf_h(i,j) * G%IareaT(i,j)) * (CS%g_Earth * CS%ISS%mass_shelf(i,j)) + press_ice = (CS%ISS%area_shelf_h(i,j) * US%m_to_L**2*G%IareaT(i,j)) * (CS%g_Earth * CS%ISS%mass_shelf(i,j)) if (associated(fluxes%p_surf)) then if (.not.fluxes%accumulate_p_surf) fluxes%p_surf(i,j) = 0.0 fluxes%p_surf(i,j) = fluxes%p_surf(i,j) + press_ice @@ -858,8 +860,9 @@ subroutine add_shelf_pressure(G, CS, fluxes) end subroutine add_shelf_pressure !> Updates surface fluxes that are influenced by sub-ice-shelf melting -subroutine add_shelf_flux(G, CS, state, fluxes) +subroutine add_shelf_flux(G, US, CS, state, fluxes) 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(ice_shelf_CS), pointer :: CS !< This module's control structure. type(surface), intent(inout) :: state!< Surface ocean state type(forcing), intent(inout) :: fluxes !< A structure of surface fluxes that may be used/updated. @@ -903,7 +906,7 @@ subroutine add_shelf_flux(G, CS, state, fluxes) ISS => CS%ISS - call add_shelf_pressure(G, CS, fluxes) + call add_shelf_pressure(G, US, CS, fluxes) ! Determine ustar and the square magnitude of the velocity in the ! bottom boundary layer. Together these give the TKE source and @@ -942,7 +945,7 @@ subroutine add_shelf_flux(G, CS, state, fluxes) if (CS%active_shelf_dynamics .or. CS%override_shelf_movement) then do j=jsd,jed ; do i=isd,ied if (G%areaT(i,j) > 0.0) & - fluxes%frac_shelf_h(i,j) = ISS%area_shelf_h(i,j) * G%IareaT(i,j) + fluxes%frac_shelf_h(i,j) = ISS%area_shelf_h(i,j) * US%m_to_L**2*G%IareaT(i,j) enddo ; enddo endif @@ -1396,7 +1399,7 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces, fl ! Set up the Coriolis parameter, G%f, usually analytically. call MOM_initialize_rotation(dG%CoriolisBu, dG, param_file, US) ! This copies grid elements, including bathyT and CoriolisBu from dG to CS%grid. - call copy_dyngrid_to_MOM_grid(dG, CS%grid) + call copy_dyngrid_to_MOM_grid(dG, CS%grid, US) call destroy_dyn_horgrid(dG) @@ -1519,9 +1522,9 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces, fl endif if (present(forces)) & - call add_shelf_forces(G, CS, forces, do_shelf_area=.not.CS%solo_ice_sheet) + call add_shelf_forces(G, US, CS, forces, do_shelf_area=.not.CS%solo_ice_sheet) - if (present(fluxes)) call add_shelf_pressure(G, CS, fluxes) + if (present(fluxes)) call add_shelf_pressure(G, US, CS, fluxes) if (CS%active_shelf_dynamics .and. .not.CS%isthermo) then ISS%water_flux(:,:) = 0.0 diff --git a/src/initialization/MOM_fixed_initialization.F90 b/src/initialization/MOM_fixed_initialization.F90 index 71d9c4f90b..893bd87a75 100644 --- a/src/initialization/MOM_fixed_initialization.F90 +++ b/src/initialization/MOM_fixed_initialization.F90 @@ -124,9 +124,9 @@ subroutine MOM_initialize_fixed(G, US, OBC, PF, write_geom, output_dir) default="none") select case ( trim(config) ) case ("none") - case ("list") ; call reset_face_lengths_list(G, PF) - case ("file") ; call reset_face_lengths_file(G, PF) - case ("global_1deg") ; call reset_face_lengths_named(G, PF, trim(config)) + case ("list") ; call reset_face_lengths_list(G, PF, US) + case ("file") ; call reset_face_lengths_file(G, PF, US) + case ("global_1deg") ; call reset_face_lengths_named(G, PF, trim(config), US) case default ; call MOM_error(FATAL, "MOM_initialize_fixed: "// & "Unrecognized channel configuration "//trim(config)) end select diff --git a/src/initialization/MOM_grid_initialize.F90 b/src/initialization/MOM_grid_initialize.F90 index 2dc74c144b..2867783c2a 100644 --- a/src/initialization/MOM_grid_initialize.F90 +++ b/src/initialization/MOM_grid_initialize.F90 @@ -87,10 +87,10 @@ subroutine set_grid_metrics(G, param_file, US) ! These are defaults that may be changed in the next select block. G%x_axis_units = "degrees_east" ; G%y_axis_units = "degrees_north" select case (trim(config)) - case ("mosaic"); call set_grid_metrics_from_mosaic(G, param_file) - case ("cartesian"); call set_grid_metrics_cartesian(G, param_file) - case ("spherical"); call set_grid_metrics_spherical(G, param_file) - case ("mercator"); call set_grid_metrics_mercator(G, param_file) + case ("mosaic"); call set_grid_metrics_from_mosaic(G, param_file, US) + case ("cartesian"); call set_grid_metrics_cartesian(G, param_file, US) + case ("spherical"); call set_grid_metrics_spherical(G, param_file, US) + case ("mercator"); call set_grid_metrics_mercator(G, param_file, US) case ("file"); call MOM_error(FATAL, "MOM_grid_init: set_grid_metrics "//& 'GRID_CONFIG "file" is no longer a supported option. Use a '//& 'mosaic file ("mosaic") or one of the analytic forms instead.') @@ -100,10 +100,10 @@ subroutine set_grid_metrics(G, param_file, US) ! Calculate derived metrics (i.e. reciprocals and products) call callTree_enter("set_derived_metrics(), MOM_grid_initialize.F90") - call set_derived_dyn_horgrid(G) + call set_derived_dyn_horgrid(G, US) call callTree_leave("set_derived_metrics()") - if (debug) call grid_metrics_chksum('MOM_grid_init/set_grid_metrics',G) + if (debug) call grid_metrics_chksum('MOM_grid_init/set_grid_metrics', G, US) call callTree_leave("set_grid_metrics()") end subroutine set_grid_metrics @@ -112,11 +112,14 @@ end subroutine set_grid_metrics !> grid_metrics_chksum performs a set of checksums on metrics on the grid for !! debugging. -subroutine grid_metrics_chksum(parent, G) - character(len=*), intent(in) :: parent !< A string identifying the caller +subroutine grid_metrics_chksum(parent, G, US) + character(len=*), intent(in) :: parent !< A string identifying the caller type(dyn_horgrid_type), intent(in) :: G !< The dynamic horizontal grid type + type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type + real :: m_to_L ! A unit conversion factor [L m-1 ~> nondim] integer :: halo + m_to_L = 1.0 ; if (present(US)) m_to_L = US%m_to_L halo = min(G%ied-G%iec, G%jed-G%jec, 1) @@ -146,8 +149,8 @@ subroutine grid_metrics_chksum(parent, G) call hchksum(G%areaT, trim(parent)//': areaT',G%HI, haloshift=halo) call Bchksum(G%areaBu, trim(parent)//': areaBu',G%HI, haloshift=halo) - call hchksum(G%IareaT, trim(parent)//': IareaT',G%HI, haloshift=halo) - call Bchksum(G%IareaBu, trim(parent)//': IareaBu',G%HI, haloshift=halo) + call hchksum(G%IareaT, trim(parent)//': IareaT',G%HI, haloshift=halo, scale=m_to_L**2) + call Bchksum(G%IareaBu, trim(parent)//': IareaBu',G%HI, haloshift=halo, scale=m_to_L**2) call hchksum(G%geoLonT,trim(parent)//': geoLonT',G%HI, haloshift=halo) call hchksum(G%geoLatT,trim(parent)//': geoLatT',G%HI, haloshift=halo) @@ -166,9 +169,10 @@ end subroutine grid_metrics_chksum ! ------------------------------------------------------------------------------ !> Sets the grid metrics from a mosaic file. -subroutine set_grid_metrics_from_mosaic(G, param_file) +subroutine set_grid_metrics_from_mosaic(G, param_file, US) type(dyn_horgrid_type), intent(inout) :: G !< The dynamic horizontal grid type type(param_file_type), intent(in) :: param_file !< Parameter file structure + type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type ! Local variables real, dimension(G%isd :G%ied ,G%jsd :G%jed ) :: tempH1, tempH2, tempH3, tempH4 real, dimension(G%IsdB:G%IedB,G%JsdB:G%JedB) :: tempQ1, tempQ2, tempQ3, tempQ4 @@ -186,6 +190,7 @@ subroutine set_grid_metrics_from_mosaic(G, param_file) real, dimension(2*G%isd-2:2*G%ied+1,2*G%jsd-3:2*G%jed+1) :: tmpV real, dimension(2*G%isd-3:2*G%ied+1,2*G%jsd-3:2*G%jed+1) :: tmpZ real, dimension(:,:), allocatable :: tmpGlbl + real :: m_to_L ! A unit conversion factor [L m-1 ~> nondim] character(len=200) :: filename, grid_file, inputdir character(len=64) :: mdl = "MOM_grid_init set_grid_metrics_from_mosaic" integer :: err=0, ni, nj, global_indices(4) @@ -198,6 +203,7 @@ subroutine set_grid_metrics_from_mosaic(G, param_file) call callTree_enter("set_grid_metrics_from_mosaic(), MOM_grid_initialize.F90") + m_to_L = 1.0 ; if (present(US)) m_to_L = US%m_to_L call get_param(param_file, mdl, "GRID_FILE", grid_file, & "Name of the file from which to read horizontal grid data.", & fail_if_missing=.true.) @@ -415,17 +421,20 @@ end subroutine set_grid_metrics_from_mosaic !! inverses and the cell areas centered on h, q, u, and v points are !! calculated, as are the geographic locations of each of these 4 !! sets of points. -subroutine set_grid_metrics_cartesian(G, param_file) +subroutine set_grid_metrics_cartesian(G, param_file, US) type(dyn_horgrid_type), intent(inout) :: G !< The dynamic horizontal grid type type(param_file_type), intent(in) :: param_file !< Parameter file structure + type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type ! Local variables integer :: i, j, isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB, I1off, J1off integer :: niglobal, njglobal real :: grid_latT(G%jsd:G%jed), grid_latB(G%JsdB:G%JedB) real :: grid_lonT(G%isd:G%ied), grid_lonB(G%IsdB:G%IedB) - real :: dx_everywhere, dy_everywhere ! Grid spacings in m. - real :: I_dx, I_dy ! Inverse grid spacings in m. + real :: dx_everywhere, dy_everywhere ! Grid spacings [m]. + real :: I_dx, I_dy ! Inverse grid spacings [m-1]. real :: PI + real :: m_to_L ! A unit conversion factor [L m-1 ~> nondim] + real :: L_to_m ! A unit conversion factor [m L-1 ~> nondim] character(len=80) :: units_temp character(len=48) :: mdl = "MOM_grid_init set_grid_metrics_cartesian" @@ -436,6 +445,8 @@ subroutine set_grid_metrics_cartesian(G, param_file) call callTree_enter("set_grid_metrics_cartesian(), MOM_grid_initialize.F90") + m_to_L = 1.0 ; if (present(US)) m_to_L = US%m_to_L + L_to_m = 1.0 ; if (present(US)) L_to_m = US%L_to_m PI = 4.0*atan(1.0) call get_param(param_file, mdl, "AXIS_UNITS", units_temp, & @@ -512,14 +523,14 @@ subroutine set_grid_metrics_cartesian(G, param_file) G%dxBu(I,J) = dx_everywhere ; G%IdxBu(I,J) = I_dx G%dyBu(I,J) = dy_everywhere ; G%IdyBu(I,J) = I_dy - G%areaBu(I,J) = dx_everywhere * dy_everywhere ; G%IareaBu(I,J) = I_dx * I_dy + G%areaBu(I,J) = dx_everywhere * dy_everywhere ; G%IareaBu(I,J) = L_to_m**2*I_dx * I_dy enddo ; enddo do j=jsd,jed ; do i=isd,ied G%geoLonT(i,j) = grid_lonT(i) ; G%geoLatT(i,j) = grid_LatT(j) G%dxT(i,j) = dx_everywhere ; G%IdxT(i,j) = I_dx G%dyT(i,j) = dy_everywhere ; G%IdyT(i,j) = I_dy - G%areaT(i,j) = dx_everywhere * dy_everywhere ; G%IareaT(i,j) = I_dx * I_dy + G%areaT(i,j) = dx_everywhere * dy_everywhere ; G%IareaT(i,j) = L_to_m**2*I_dx * I_dy enddo ; enddo do j=jsd,jed ; do I=IsdB,IedB @@ -548,9 +559,10 @@ end subroutine set_grid_metrics_cartesian !! inverses and the cell areas centered on h, q, u, and v points are !! calculated, as are the geographic locations of each of these 4 !! sets of points. -subroutine set_grid_metrics_spherical(G, param_file) +subroutine set_grid_metrics_spherical(G, param_file, US) type(dyn_horgrid_type), intent(inout) :: G !< The dynamic horizontal grid type type(param_file_type), intent(in) :: param_file !< Parameter file structure + type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type ! Local variables real :: PI, PI_180! PI = 3.1415926... as 4*atan(1) integer :: i, j, isd, ied, jsd, jed @@ -559,6 +571,7 @@ subroutine set_grid_metrics_spherical(G, param_file) real :: grid_latT(G%jsd:G%jed), grid_latB(G%JsdB:G%JedB) real :: grid_lonT(G%isd:G%ied), grid_lonB(G%IsdB:G%IedB) real :: dLon,dLat,latitude,longitude,dL_di + real :: m_to_L ! A unit conversion factor [L m-1 ~> nondim] character(len=48) :: mdl = "MOM_grid_init set_grid_metrics_spherical" is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec @@ -568,6 +581,7 @@ subroutine set_grid_metrics_spherical(G, param_file) i_offset = G%idg_offset ; j_offset = G%jdg_offset call callTree_enter("set_grid_metrics_spherical(), MOM_grid_initialize.F90") + m_to_L = 1.0 ; if (present(US)) m_to_L = US%m_to_L ! Calculate the values of the metric terms that might be used ! and save them in arrays. @@ -684,9 +698,10 @@ end subroutine set_grid_metrics_spherical !! inverses and the cell areas centered on h, q, u, and v points are !! calculated, as are the geographic locations of each of these 4 !! sets of points. -subroutine set_grid_metrics_mercator(G, param_file) +subroutine set_grid_metrics_mercator(G, param_file, US) type(dyn_horgrid_type), intent(inout) :: G !< The dynamic horizontal grid type type(param_file_type), intent(in) :: param_file !< Parameter file structure + type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type ! Local variables integer :: i, j, isd, ied, jsd, jed integer :: I_off, J_off @@ -706,6 +721,7 @@ subroutine set_grid_metrics_mercator(G, param_file) real :: fnRef ! fnRef is the value of Int_dj_dy or ! Int_dj_dy at a latitude or longitude that is real :: jRef, iRef ! being set to be at grid index jRef or iRef. + real :: m_to_L ! A unit conversion factor [L m-1 ~> nondim] integer :: itt1, itt2 logical :: debug = .FALSE., simple_area = .true. integer :: is, ie, js, je, Isq, Ieq, Jsq, Jeq, IsdB, IedB, JsdB, JedB @@ -724,6 +740,7 @@ subroutine set_grid_metrics_mercator(G, param_file) call callTree_enter("set_grid_metrics_mercator(), MOM_grid_initialize.F90") + m_to_L = 1.0 ; if (present(US)) m_to_L = US%m_to_L ! Calculate the values of the metric terms that might be used ! and save them in arrays. PI = 4.0*atan(1.0) ; PI_2 = 0.5*PI @@ -857,7 +874,7 @@ subroutine set_grid_metrics_mercator(G, param_file) G%dyBu(I,J) = ds_dj(xq(I,J), yq(I,J), GP) G%areaBu(I,J) = G%dxBu(I,J) * G%dyBu(I,J) - G%IareaBu(I,J) = 1.0 / (G%areaBu(I,J)) + G%IareaBu(I,J) = 1.0 / (m_to_L**2*G%areaBu(I,J)) enddo ; enddo do j=jsd,jed ; do i=isd,ied @@ -867,7 +884,7 @@ subroutine set_grid_metrics_mercator(G, param_file) G%dyT(i,j) = ds_dj(xh(i,j), yh(i,j), GP) G%areaT(i,j) = G%dxT(i,j)*G%dyT(i,j) - G%IareaT(i,j) = 1.0 / (G%areaT(i,j)) + G%IareaT(i,j) = 1.0 / (m_to_L**2*G%areaT(i,j)) enddo ; enddo do j=jsd,jed ; do I=IsdB,IedB @@ -903,7 +920,7 @@ subroutine set_grid_metrics_mercator(G, param_file) call pass_var(G%areaT,G%Domain) endif do j=jsd,jed ; do i=isd,ied - G%IareaT(i,j) = 1.0 / (G%areaT(i,j)) + G%IareaT(i,j) = 1.0 / (m_to_L**2*G%areaT(i,j)) enddo ; enddo endif @@ -1227,6 +1244,7 @@ subroutine initialize_masks(G, PF, US) type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type ! Local variables real :: m_to_Z_scale ! A unit conversion factor from m to Z. + real :: m_to_L ! A unit conversion factor [L m-1 ~> nondim] real :: Dmin ! The depth for masking in the same units as G%bathyT [Z ~> m]. real :: min_depth ! The minimum ocean depth in the same units as G%bathyT [Z ~> m]. real :: mask_depth ! The depth shallower than which to mask a point as land [Z ~> m]. @@ -1235,6 +1253,8 @@ subroutine initialize_masks(G, PF, US) call callTree_enter("initialize_masks(), MOM_grid_initialize.F90") m_to_Z_scale = 1.0 ; if (present(US)) m_to_Z_scale = US%m_to_Z + m_to_L = 1.0 ; if (present(US)) m_to_L = US%m_to_L + call get_param(PF, mdl, "MINIMUM_DEPTH", min_depth, & "If MASKING_DEPTH is unspecified, then anything shallower than "//& "MINIMUM_DEPTH is assumed to be land and all fluxes are masked out. "//& @@ -1291,13 +1311,13 @@ subroutine initialize_masks(G, PF, US) do j=G%jsd,G%jed ; do I=G%IsdB,G%IedB G%dy_Cu(I,j) = G%mask2dCu(I,j) * G%dyCu(I,j) G%areaCu(I,j) = G%dxCu(I,j) * G%dy_Cu(I,j) - G%IareaCu(I,j) = G%mask2dCu(I,j) * Adcroft_reciprocal(G%areaCu(I,j)) + G%IareaCu(I,j) = G%mask2dCu(I,j) * Adcroft_reciprocal(m_to_L**2*G%areaCu(I,j)) enddo ; enddo do J=G%JsdB,G%JedB ; do i=G%isd,G%ied G%dx_Cv(i,J) = G%mask2dCv(i,J) * G%dxCv(i,J) G%areaCv(i,J) = G%dyCv(i,J) * G%dx_Cv(i,J) - G%IareaCv(i,J) = G%mask2dCv(i,J) * Adcroft_reciprocal(G%areaCv(i,J)) + G%IareaCv(i,J) = G%mask2dCv(i,J) * Adcroft_reciprocal(m_to_L**2*G%areaCv(i,J)) enddo ; enddo call callTree_leave("initialize_masks()") diff --git a/src/initialization/MOM_shared_initialization.F90 b/src/initialization/MOM_shared_initialization.F90 index 419d71461c..218ee56353 100644 --- a/src/initialization/MOM_shared_initialization.F90 +++ b/src/initialization/MOM_shared_initialization.F90 @@ -623,6 +623,7 @@ subroutine reset_face_lengths_named(G, param_file, name, US) ! Local variables character(len=256) :: mesg ! Message for error messages. + real :: m_to_L ! A unit conversion factor [L m-1 ~> nondim] real :: dx_2 = -1.0, dy_2 = -1.0 real :: pi_180 integer :: option = -1 @@ -637,6 +638,8 @@ subroutine reset_face_lengths_named(G, param_file, name, US) "Unrecognized channel configuration name "//trim(name)) end select + m_to_L = 1.0 ; if (present(US)) m_to_L = US%m_to_L + if (option==1) then ! 1-degree settings. do j=jsd,jed ; do I=IsdB,IedB ! Change any u-face lengths within this loop. dy_2 = dx_2 * G%dyCu(I,j)*G%IdxCu(I,j) * cos(pi_180 * G%geoLatCu(I,j)) @@ -715,7 +718,7 @@ subroutine reset_face_lengths_named(G, param_file, name, US) endif G%areaCu(I,j) = G%dxCu(I,j)*G%dy_Cu(I,j) G%IareaCu(I,j) = 0.0 - if (G%areaCu(I,j) > 0.0) G%IareaCu(I,j) = G%mask2dCu(I,j) / (G%areaCu(I,j)) + if (G%areaCu(I,j) > 0.0) G%IareaCu(I,j) = G%mask2dCu(I,j) / (m_to_L**2*G%areaCu(I,j)) enddo ; enddo do J=JsdB,JedB ; do i=isd,ied @@ -729,7 +732,7 @@ subroutine reset_face_lengths_named(G, param_file, name, US) endif G%areaCv(i,J) = G%dyCv(i,J)*G%dx_Cv(i,J) G%IareaCv(i,J) = 0.0 - if (G%areaCv(i,J) > 0.0) G%IareaCv(i,J) = G%mask2dCv(i,J) / (G%areaCv(i,J)) + if (G%areaCv(i,J) > 0.0) G%IareaCv(i,J) = G%mask2dCv(i,J) / (m_to_L**2*G%areaCv(i,J)) enddo ; enddo end subroutine reset_face_lengths_named @@ -747,12 +750,14 @@ subroutine reset_face_lengths_file(G, param_file, US) character(len=40) :: mdl = "reset_face_lengths_file" ! This subroutine's name. character(len=256) :: mesg ! Message for error messages. character(len=200) :: filename, chan_file, inputdir ! Strings for file/path + real :: m_to_L ! A unit conversion factor [L m-1 ~> nondim] integer :: i, j, isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed IsdB = G%IsdB ; IedB = G%IedB ; JsdB = G%JsdB ; JedB = G%JedB ! These checks apply regardless of the chosen option. call callTree_enter(trim(mdl)//"(), MOM_shared_initialization.F90") + m_to_L = 1.0 ; if (present(US)) m_to_L = US%m_to_L call get_param(param_file, mdl, "CHANNEL_WIDTH_FILE", chan_file, & "The file from which the list of narrowed channels is read.", & @@ -780,7 +785,7 @@ subroutine reset_face_lengths_file(G, param_file, US) endif G%areaCu(I,j) = G%dxCu(I,j)*G%dy_Cu(I,j) G%IareaCu(I,j) = 0.0 - if (G%areaCu(I,j) > 0.0) G%IareaCu(I,j) = G%mask2dCu(I,j) / (G%areaCu(I,j)) + if (G%areaCu(I,j) > 0.0) G%IareaCu(I,j) = G%mask2dCu(I,j) / (m_to_L**2*G%areaCu(I,j)) enddo ; enddo do J=JsdB,JedB ; do i=isd,ied @@ -794,7 +799,7 @@ subroutine reset_face_lengths_file(G, param_file, US) endif G%areaCv(i,J) = G%dyCv(i,J)*G%dx_Cv(i,J) G%IareaCv(i,J) = 0.0 - if (G%areaCv(i,J) > 0.0) G%IareaCv(i,J) = G%mask2dCv(i,J) / (G%areaCv(i,J)) + if (G%areaCv(i,J) > 0.0) G%IareaCv(i,J) = G%mask2dCv(i,J) / (m_to_L**2*G%areaCv(i,J)) enddo ; enddo call callTree_leave(trim(mdl)//'()') @@ -818,6 +823,7 @@ subroutine reset_face_lengths_list(G, param_file, US) u_lat => NULL(), u_lon => NULL(), v_lat => NULL(), v_lon => NULL() real, pointer, dimension(:) :: & u_width => NULL(), v_width => NULL() + real :: m_to_L ! A unit conversion factor [L m-1 ~> nondim] real :: lat, lon ! The latitude and longitude of a point. real :: len_lon ! The periodic range of longitudes, usually 360 degrees. real :: len_lat ! The range of latitudes, usually 180 degrees. @@ -833,6 +839,7 @@ subroutine reset_face_lengths_list(G, param_file, US) IsdB = G%IsdB ; IedB = G%IedB ; JsdB = G%JsdB ; JedB = G%JedB call callTree_enter(trim(mdl)//"(), MOM_shared_initialization.F90") + m_to_L = 1.0 ; if (present(US)) m_to_L = US%m_to_L call get_param(param_file, mdl, "CHANNEL_LIST_FILE", chan_file, & "The file from which the list of narrowed channels is read.", & @@ -992,7 +999,7 @@ subroutine reset_face_lengths_list(G, param_file, US) G%areaCu(I,j) = G%dxCu(I,j)*G%dy_Cu(I,j) G%IareaCu(I,j) = 0.0 - if (G%areaCu(I,j) > 0.0) G%IareaCu(I,j) = G%mask2dCu(I,j) / (G%areaCu(I,j)) + if (G%areaCu(I,j) > 0.0) G%IareaCu(I,j) = G%mask2dCu(I,j) / (m_to_L**2*G%areaCu(I,j)) enddo ; enddo do J=JsdB,JedB ; do i=isd,ied @@ -1021,7 +1028,7 @@ subroutine reset_face_lengths_list(G, param_file, US) G%areaCv(i,J) = G%dyCv(i,J)*G%dx_Cv(i,J) G%IareaCv(i,J) = 0.0 - if (G%areaCv(i,J) > 0.0) G%IareaCv(i,J) = G%mask2dCv(i,J) / (G%areaCv(i,J)) + if (G%areaCv(i,J) > 0.0) G%IareaCv(i,J) = G%mask2dCv(i,J) / (m_to_L**2*G%areaCv(i,J)) enddo ; enddo if (num_lines > 0) then diff --git a/src/ocean_data_assim/MOM_oda_driver.F90 b/src/ocean_data_assim/MOM_oda_driver.F90 index 27dde7f69d..74afd4868a 100644 --- a/src/ocean_data_assim/MOM_oda_driver.F90 +++ b/src/ocean_data_assim/MOM_oda_driver.F90 @@ -222,8 +222,8 @@ subroutine init_oda(Time, G, GV, CS) dirs%output_directory, tv_dummy, dG%max_depth) call ALE_init(PF, CS%GV, CS%US, dG%max_depth, CS%ALE_CS) call MOM_grid_init(CS%Grid, PF, global_indexing=.true.) - call ALE_updateVerticalGridType(CS%ALE_CS,CS%GV) - call copy_dyngrid_to_MOM_grid(dG, CS%Grid) + call ALE_updateVerticalGridType(CS%ALE_CS, CS%GV) + call copy_dyngrid_to_MOM_grid(dG, CS%Grid, CS%US) CS%mpp_domain => CS%Grid%Domain%mpp_domain CS%Grid%ke = CS%GV%ke CS%nk = CS%GV%ke diff --git a/src/parameterizations/lateral/MOM_MEKE.F90 b/src/parameterizations/lateral/MOM_MEKE.F90 index 0923c33c59..003a84d2f4 100644 --- a/src/parameterizations/lateral/MOM_MEKE.F90 +++ b/src/parameterizations/lateral/MOM_MEKE.F90 @@ -237,7 +237,7 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h !$OMP parallel do default(shared) do j=js,je ; do i=is,ie - drag_rate_visc(i,j) = (0.25*G%IareaT(i,j) * & + drag_rate_visc(i,j) = (0.25*US%m_to_L**2*G%IareaT(i,j) * & ((G%areaCu(I-1,j)*drag_vel_u(I-1,j) + & G%areaCu(I,j)*drag_vel_u(I,j)) + & (G%areaCv(i,J-1)*drag_vel_v(i,J-1) + & @@ -381,9 +381,9 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h !$OMP parallel do default(shared) do j=js-1,je+1 ; do i=is-1,ie+1 - del2MEKE(i,j) = G%IareaT(i,j) * & + del2MEKE(i,j) = US%m_to_L**2*G%IareaT(i,j) * & ((MEKE_uflux(I,j) - MEKE_uflux(I-1,j)) + (MEKE_vflux(i,J) - MEKE_vflux(i,J-1))) - ! del2MEKE(i,j) = (G%IareaT(i,j)*I_mass(i,j)) * & + ! del2MEKE(i,j) = (US%m_to_L**2*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 @@ -393,7 +393,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 + max(US%m_to_L**2*G%IareaT(i,j),US%m_to_L**2*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))) * & @@ -404,7 +404,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 + max(US%m_to_L**2*G%IareaT(i,j),US%m_to_L**2*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))) * & @@ -414,7 +414,7 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h ! Store tendency arising from the bi-harmonic in del4MEKE !$OMP parallel do default(shared) do j=js,je ; do i=is,ie - del4MEKE(i,j) = (sdt*(G%IareaT(i,j)*I_mass(i,j))) * & + del4MEKE(i,j) = (sdt*(US%m_to_L**2*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 @@ -432,7 +432,7 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h if (associated(MEKE%Kh_diff)) & Kh_here = max(0.,CS%MEKE_Kh) + CS%KhMEKE_Fac*0.5*(MEKE%Kh_diff(i,j)+MEKE%Kh_diff(i+1,j)) Inv_Kh_max = 2.0*sdt * ((G%dy_Cu(I,j)*G%IdxCu(I,j)) * & - max(G%IareaT(i,j),G%IareaT(i+1,j))) + max(US%m_to_L**2*G%IareaT(i,j),US%m_to_L**2*G%IareaT(i+1,j))) if (Kh_here*Inv_Kh_max > 0.25) Kh_here = 0.25 / Inv_Kh_max Kh_u(I,j) = Kh_here @@ -447,7 +447,7 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h if (associated(MEKE%Kh_diff)) & Kh_here = max(0.,CS%MEKE_Kh) + CS%KhMEKE_Fac*0.5*(MEKE%Kh_diff(i,j)+MEKE%Kh_diff(i,j+1)) Inv_Kh_max = 2.0*sdt * ((G%dx_Cv(i,J)*G%IdyCv(i,J)) * & - max(G%IareaT(i,j),G%IareaT(i,j+1))) + max(US%m_to_L**2*G%IareaT(i,j),US%m_to_L**2*G%IareaT(i,j+1))) if (Kh_here*Inv_Kh_max > 0.25) Kh_here = 0.25 / Inv_Kh_max Kh_v(i,J) = Kh_here @@ -476,7 +476,7 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h endif !$OMP parallel do default(shared) do j=js,je ; do i=is,ie - MEKE%MEKE(i,j) = MEKE%MEKE(i,j) + (sdt*(G%IareaT(i,j)*I_mass(i,j))) * & + MEKE%MEKE(i,j) = MEKE%MEKE(i,j) + (sdt*(US%m_to_L**2*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 diff --git a/src/parameterizations/lateral/MOM_hor_visc.F90 b/src/parameterizations/lateral/MOM_hor_visc.F90 index 0f620a1b39..f96dc7ae7f 100644 --- a/src/parameterizations/lateral/MOM_hor_visc.F90 +++ b/src/parameterizations/lateral/MOM_hor_visc.F90 @@ -3,6 +3,7 @@ module MOM_hor_visc ! This file is part of MOM6. See LICENSE.md for the license. +use MOM_checksums, only : hchksum, Bchksum 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 : pass_var, CORNER, pass_vector @@ -29,6 +30,7 @@ module MOM_hor_visc type, public :: hor_visc_CS ; private logical :: Laplacian !< Use a Laplacian horizontal viscosity if true. logical :: biharmonic !< Use a biharmonic horizontal viscosity if true. + logical :: debug !< If true, write verbose checksums for debugging purposes. logical :: no_slip !< If true, no slip boundary conditions are used. !! Otherwise free slip boundary conditions are assumed. !! The implementation of the free slip boundary @@ -282,6 +284,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, real, dimension(SZIB_(G),SZJB_(G),SZK_(G)) :: & Ah_q, & ! biharmonic viscosity at corner points [m4 T-1 ~> m4 s-1] Kh_q, & ! Laplacian viscosity at corner points [m2 s-1] + sh_xy_3d, & ! horizontal shearing strain (du/dy + dv/dx) including metric terms [s-1] vort_xy_q, & ! vertical vorticity at corner points [s-1] GME_coeff_q !< GME coeff. at q-points [m2 T-1 ~> m2 s-1] @@ -293,6 +296,7 @@ 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] + sh_xx_3d, & ! horizontal tension (du/dx - dv/dy) including metric terms [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 @@ -365,6 +369,11 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, Ah_h(:,:,:) = 0.0 Kh_h(:,:,:) = 0.0 + if (CS%debug) then + sh_xx_3d(:,:,:) = 0.0 ; sh_xy_3d(:,:,:) = 0.0 + Kh_q(:,:,:) = 0.0 ; Ah_q(:,:,:) = 0.0 + endif + if (present(OBC)) then ; if (associated(OBC)) then ; if (OBC%OBC_pe) then apply_OBC = OBC%Flather_u_BCs_exist_globally .or. OBC%Flather_v_BCs_exist_globally apply_OBC = .true. @@ -746,7 +755,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, div_xx(i,j) = 0.5*((G%dyCu(I,j) * u(I,j,k) * (h(i+1,j,k)+h(i,j,k)) - & G%dyCu(I-1,j) * u(I-1,j,k) * (h(i-1,j,k)+h(i,j,k)) ) + & (G%dxCv(i,J) * v(i,J,k) * (h(i,j,k)+h(i,j+1,k)) - & - G%dxCv(i,J-1)*v(i,J-1,k)*(h(i,j,k)+h(i,j-1,k))))*G%IareaT(i,j) / & + G%dxCv(i,J-1)*v(i,J-1,k)*(h(i,j,k)+h(i,j-1,k))))*US%m_to_L**2*G%IareaT(i,j) / & (h(i,j,k) + GV%H_subroundoff) enddo ; enddo @@ -898,8 +907,9 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, endif endif - if ((CS%id_Kh_h>0) .or. find_FrictWork) Kh_h(i,j,k) = Kh + if ((CS%id_Kh_h>0) .or. find_FrictWork .or. CS%debug) Kh_h(i,j,k) = Kh if (CS%id_div_xx_h>0) div_xx_h(i,j,k) = div_xx(i,j) + if (CS%debug) sh_xx_3d(i,j,k) = sh_xx(i,j) str_xx(i,j) = -Kh * sh_xx(i,j) else ! not Laplacian @@ -940,7 +950,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, Ah = MIN(Ah, visc_bound_rem*hrat_min*CS%Ah_Max_xx(i,j)) endif - if ((CS%id_Ah_h>0) .or. find_FrictWork) Ah_h(i,j,k) = Ah + if ((CS%id_Ah_h>0) .or. find_FrictWork .or. CS%debug) Ah_h(i,j,k) = 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)) - & @@ -1064,8 +1074,9 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, endif endif - if (CS%id_Kh_q>0) Kh_q(I,J,k) = Kh + if (CS%id_Kh_q>0 .or. CS%debug) Kh_q(I,J,k) = Kh if (CS%id_vort_xy_q>0) vort_xy_q(I,J,k) = vort_xy(I,J) + if (CS%debug) sh_xy_3d(I,J,k) = sh_xy(I,J) str_xy(I,J) = -Kh * sh_xy(I,J) else ! not Laplacian @@ -1109,7 +1120,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, Ah = MIN(Ah, visc_bound_rem*hrat_min*CS%Ah_Max_xy(I,J)) endif - if (CS%id_Ah_q>0) Ah_q(I,J,k) = Ah + if (CS%id_Ah_q>0 .or. CS%debug) Ah_q(I,J,k) = Ah str_xy(I,J) = str_xy(I,J) + Ah * ( dvdx(I,J) + dudy(I,J) ) @@ -1266,7 +1277,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, 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))) * & - G%IareaCu(I,j)) / (h_u(i,j) + h_neglect) + US%m_to_L**2*G%IareaCu(I,j)) / (h_u(i,j) + h_neglect) enddo ; enddo if (apply_OBC) then @@ -1288,7 +1299,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, 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))) * & - G%IareaCv(i,J)) / (h_v(i,J) + h_neglect) + US%m_to_L**2*G%IareaCv(i,J)) / (h_v(i,J) + h_neglect) enddo ; enddo if (apply_OBC) then ! This is not the right boundary condition. If all the masking of tendencies are done @@ -1408,6 +1419,17 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, if (CS%id_GME_coeff_h > 0) call post_data(CS%id_GME_coeff_h, GME_coeff_h, CS%diag) if (CS%id_GME_coeff_q > 0) call post_data(CS%id_GME_coeff_q, GME_coeff_q, CS%diag) + if (CS%debug) then + if (CS%Laplacian) then + call hchksum(Kh_h, "Kh_h", G%HI, haloshift=0, scale=US%s_to_T) + call Bchksum(Kh_q, "Kh_q", G%HI, haloshift=0, scale=US%s_to_T) + call Bchksum(sh_xy_3d, "shear_xy", G%HI, haloshift=0) + call hchksum(sh_xx_3d, "shear_xx", G%HI, haloshift=0) + endif + if (CS%biharmonic) call hchksum(Ah_h, "Ah_h", G%HI, haloshift=0, scale=US%s_to_T) + if (CS%biharmonic) call Bchksum(Ah_q, "Ah_q", G%HI, haloshift=0, scale=US%s_to_T) + endif + if (CS%id_FrictWorkIntz > 0) then do j=js,je do i=is,ie ; FrictWorkIntz(i,j) = FrictWork(i,j,1) ; enddo @@ -1527,6 +1549,8 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS, MEKE) "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, "DEBUG", CS%debug, default=.false.) + call get_param(param_file, mdl, "LAPLACIAN", CS%Laplacian, & "If true, use a Laplacian horizontal viscosity.", & default=.false.) @@ -2012,9 +2036,9 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS, MEKE) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 denom = max( & (CS%DY2h(i,j) * CS%DY_dxT(i,j) * (G%IdyCu(I,j) + G%IdyCu(I-1,j)) * & - max(G%IdyCu(I,j)*G%IareaCu(I,j), G%IdyCu(I-1,j)*G%IareaCu(I-1,j)) ), & + max(G%IdyCu(I,j)*US%m_to_L**2*G%IareaCu(I,j), G%IdyCu(I-1,j)*US%m_to_L**2*G%IareaCu(I-1,j)) ), & (CS%DX2h(i,j) * CS%DX_dyT(i,j) * (G%IdxCv(i,J) + G%IdxCv(i,J-1)) * & - max(G%IdxCv(i,J)*G%IareaCv(i,J), G%IdxCv(i,J-1)*G%IareaCv(i,J-1)) ) ) + max(G%IdxCv(i,J)*US%m_to_L**2*G%IareaCv(i,J), G%IdxCv(i,J-1)*US%m_to_L**2*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 @@ -2022,13 +2046,17 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS, MEKE) do J=js-1,Jeq ; do I=is-1,Ieq denom = max( & (CS%DX2q(I,J) * CS%DX_dyBu(I,J) * (G%IdxCu(I,j+1) + G%IdxCu(I,j)) * & - max(G%IdxCu(I,j)*G%IareaCu(I,j), G%IdxCu(I,j+1)*G%IareaCu(I,j+1)) ), & + max(G%IdxCu(I,j)*US%m_to_L**2*G%IareaCu(I,j), G%IdxCu(I,j+1)*US%m_to_L**2*G%IareaCu(I,j+1)) ), & (CS%DY2q(I,J) * CS%DY_dxBu(I,J) * (G%IdyCv(i+1,J) + G%IdyCv(i,J)) * & - max(G%IdyCv(i,J)*G%IareaCv(i,J), G%IdyCv(i+1,J)*G%IareaCv(i+1,J)) ) ) + max(G%IdyCv(i,J)*US%m_to_L**2*G%IareaCv(i,J), G%IdyCv(i+1,J)*US%m_to_L**2*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 enddo ; enddo + if (CS%debug) then + call hchksum(CS%Kh_Max_xx, "Kh_Max_xx", G%HI, haloshift=0, scale=US%s_to_T) + call Bchksum(CS%Kh_Max_xx, "Kh_Max_xy", G%HI, haloshift=0, scale=US%s_to_T) + endif endif ! The biharmonic bounds should avoid overshoots when CS%bound_coef < 0.5, but @@ -2063,11 +2091,11 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS, MEKE) (CS%DY2h(i,j) * & (CS%DY_dxT(i,j)*(G%IdyCu(I,j)*u0u(I,j) + G%IdyCu(I-1,j)*u0u(I-1,j)) + & CS%DX_dyT(i,j)*(G%IdxCv(i,J)*v0u(i,J) + G%IdxCv(i,J-1)*v0u(i,J-1))) * & - max(G%IdyCu(I,j)*G%IareaCu(I,j), G%IdyCu(I-1,j)*G%IareaCu(I-1,j)) ), & + max(G%IdyCu(I,j)*US%m_to_L**2*G%IareaCu(I,j), G%IdyCu(I-1,j)*US%m_to_L**2*G%IareaCu(I-1,j)) ), & (CS%DX2h(i,j) * & (CS%DY_dxT(i,j)*(G%IdyCu(I,j)*u0v(I,j) + G%IdyCu(I-1,j)*u0v(I-1,j)) + & CS%DX_dyT(i,j)*(G%IdxCv(i,J)*v0v(i,J) + G%IdxCv(i,J-1)*v0v(i,J-1))) * & - max(G%IdxCv(i,J)*G%IareaCv(i,J), G%IdxCv(i,J-1)*G%IareaCv(i,J-1)) ) ) + max(G%IdxCv(i,J)*US%m_to_L**2*G%IareaCv(i,J), G%IdxCv(i,J-1)*US%m_to_L**2*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 @@ -2078,15 +2106,19 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS, MEKE) (CS%DX2q(I,J) * & (CS%DX_dyBu(I,J)*(u0u(I,j+1)*G%IdxCu(I,j+1) + u0u(I,j)*G%IdxCu(I,j)) + & CS%DY_dxBu(I,J)*(v0u(i+1,J)*G%IdyCv(i+1,J) + v0u(i,J)*G%IdyCv(i,J))) * & - max(G%IdxCu(I,j)*G%IareaCu(I,j), G%IdxCu(I,j+1)*G%IareaCu(I,j+1)) ), & + max(G%IdxCu(I,j)*US%m_to_L**2*G%IareaCu(I,j), G%IdxCu(I,j+1)*US%m_to_L**2*G%IareaCu(I,j+1)) ), & (CS%DY2q(I,J) * & (CS%DX_dyBu(I,J)*(u0v(I,j+1)*G%IdxCu(I,j+1) + u0v(I,j)*G%IdxCu(I,j)) + & CS%DY_dxBu(I,J)*(v0v(i+1,J)*G%IdyCv(i+1,J) + v0v(i,J)*G%IdyCv(i,J))) * & - max(G%IdyCv(i,J)*G%IareaCv(i,J), G%IdyCv(i+1,J)*G%IareaCv(i+1,J)) ) ) + max(G%IdyCv(i,J)*US%m_to_L**2*G%IareaCv(i,J), G%IdyCv(i+1,J)*US%m_to_L**2*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 enddo ; enddo + if (CS%debug) then + call hchksum(CS%Ah_Max_xx, "Ah_Max_xx", G%HI, haloshift=0, scale=US%s_to_T) + call Bchksum(CS%Ah_Max_xx, "Ah_Max_xy", G%HI, haloshift=0, scale=US%s_to_T) + endif endif ! Register fields for output from this module. diff --git a/src/parameterizations/lateral/MOM_internal_tides.F90 b/src/parameterizations/lateral/MOM_internal_tides.F90 index fb35d5b45c..e3db9b90a6 100644 --- a/src/parameterizations/lateral/MOM_internal_tides.F90 +++ b/src/parameterizations/lateral/MOM_internal_tides.F90 @@ -1052,7 +1052,7 @@ subroutine propagate(En, cn, freq, dt, G, US, CS, NAngle) ! Apply propagation in x-direction (reflection included) LB%jsh = jsh ; LB%jeh = jeh ; LB%ish = ish ; LB%ieh = ieh - call propagate_x(En(:,:,:), speed_x, Cgx_av(:), dCgx(:), dt, G, CS%nAngle, CS, LB) + call propagate_x(En(:,:,:), speed_x, Cgx_av(:), dCgx(:), dt, G, US, CS%nAngle, CS, LB) ! Check for energy conservation on computational domain (for debugging) !call sum_En(G,CS,En(:,:,:),'post-propagate_x') @@ -1063,7 +1063,7 @@ subroutine propagate(En, cn, freq, dt, G, US, CS, NAngle) ! Apply propagation in y-direction (reflection included) ! LB%jsh = js ; LB%jeh = je ; LB%ish = is ; LB%ieh = ie ! Use if no teleport LB%jsh = jsh ; LB%jeh = jeh ; LB%ish = ish ; LB%ieh = ieh - call propagate_y(En(:,:,:), speed_y, Cgy_av(:), dCgy(:), dt, G, CS%nAngle, CS, LB) + call propagate_y(En(:,:,:), speed_y, Cgy_av(:), dCgy(:), dt, G, US, CS%nAngle, CS, LB) ! Check for energy conservation on computational domain (for debugging) !call sum_En(G,CS,En(:,:,:),'post-propagate_y') @@ -1335,7 +1335,7 @@ subroutine propagate_corner_spread(En, energized_wedge, NAngle, speed, dt, G, CS end subroutine propagate_corner_spread !> Propagates the internal wave energy in the logical x-direction. -subroutine propagate_x(En, speed_x, Cgx_av, dCgx, dt, G, Nangle, CS, LB) +subroutine propagate_x(En, speed_x, Cgx_av, dCgx, dt, G, US, Nangle, CS, LB) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. integer, intent(in) :: NAngle !< The number of wave orientations in the !! discretized wave energy spectrum. @@ -1349,6 +1349,7 @@ subroutine propagate_x(En, speed_x, Cgx_av, dCgx, dt, G, Nangle, CS, LB) real, dimension(Nangle), intent(in) :: dCgx !< The difference in x-projections between the !! edges of each angular band. real, intent(in) :: dt !< Time increment [s]. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(int_tide_CS), pointer :: CS !< The control structure returned by a previous call !! to continuity_PPM_init. type(loop_bounds_type), intent(in) :: LB !< A structure with the active energy loop bounds. @@ -1381,7 +1382,7 @@ subroutine propagate_x(En, speed_x, Cgx_av, dCgx, dt, G, Nangle, CS, LB) cg_p(I) = speed_x(I,j) * (Cgx_av(a)) enddo call zonal_flux_En(cg_p, En(:,j,a), EnL(:,j), EnR(:,j), flux1, & - dt, G, j, ish, ieh, CS%vol_CFL) + dt, G, US, j, ish, ieh, CS%vol_CFL) do I=ish-1,ieh ; flux_x(I,j) = flux1(I); enddo enddo @@ -1392,7 +1393,7 @@ subroutine propagate_x(En, speed_x, Cgx_av, dCgx, dt, G, Nangle, CS, LB) ! test with old (take out later) !do j=LB%jsh,LB%jeh ; do i=LB%ish,LB%ieh - ! En(i,j,a) = En(i,j,a) - dt* G%IareaT(i,j) * (flux_x(I,j) - flux_x(I-1,j)) + ! En(i,j,a) = En(i,j,a) - dt* US%m_to_L**2*G%IareaT(i,j) * (flux_x(I,j) - flux_x(I-1,j)) !enddo ; enddo enddo ! a-loop @@ -1408,17 +1409,17 @@ subroutine propagate_x(En, speed_x, Cgx_av, dCgx, dt, G, Nangle, CS, LB) ! Update reflected energy (Jm-2) do j=jsh,jeh ; do i=ish,ieh !do a=1,CS%nAngle - ! if ((En(i,j,a) + G%IareaT(i,j)*(Fdt_m(i,j,a) + Fdt_p(i,j,a))) < 0.0) then ! for debugging + ! if ((En(i,j,a) + US%m_to_L**2*G%IareaT(i,j)*(Fdt_m(i,j,a) + Fdt_p(i,j,a))) < 0.0) then ! for debugging ! call MOM_error(FATAL, "propagate_x: OutFlux>Available") ! endif !enddo - En(i,j,:) = En(i,j,:) + G%IareaT(i,j)*(Fdt_m(i,j,:) + Fdt_p(i,j,:)) + En(i,j,:) = En(i,j,:) + US%m_to_L**2*G%IareaT(i,j)*(Fdt_m(i,j,:) + Fdt_p(i,j,:)) enddo ; enddo end subroutine propagate_x !> Propagates the internal wave energy in the logical y-direction. -subroutine propagate_y(En, speed_y, Cgy_av, dCgy, dt, G, Nangle, CS, LB) +subroutine propagate_y(En, speed_y, Cgy_av, dCgy, dt, G, US, Nangle, CS, LB) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. integer, intent(in) :: NAngle !< The number of wave orientations in the !! discretized wave energy spectrum. @@ -1432,6 +1433,7 @@ subroutine propagate_y(En, speed_y, Cgy_av, dCgy, dt, G, Nangle, CS, LB) real, dimension(Nangle), intent(in) :: dCgy !< The difference in y-projections between the !! edges of each angular band. real, intent(in) :: dt !< Time increment [s]. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(int_tide_CS), pointer :: CS !< The control structure returned by a previous call !! to continuity_PPM_init. type(loop_bounds_type), intent(in) :: LB !< A structure with the active energy loop bounds. @@ -1465,14 +1467,14 @@ subroutine propagate_y(En, speed_y, Cgy_av, dCgy, dt, G, Nangle, CS, LB) cg_p(i) = speed_y(i,J) * (Cgy_av(a)) enddo call merid_flux_En(cg_p, En(:,:,a), EnL(:,:), EnR(:,:), flux1, & - dt, G, J, ish, ieh, CS%vol_CFL) + dt, G, US, J, ish, ieh, CS%vol_CFL) do i=ish,ieh ; flux_y(i,J) = flux1(i); enddo enddo do j=jsh,jeh ; do i=ish,ieh Fdt_m(i,j,a) = dt*flux_y(i,J-1) ! south face influx (J) Fdt_p(i,j,a) = -dt*flux_y(i,J) ! north face influx (J) - !if ((En(i,j,a) + G%IareaT(i,j)*(Fdt_m(i,j,a) + Fdt_p(i,j,a))) < 0.0)then ! for debugging + !if ((En(i,j,a) + US%m_to_L**2*G%IareaT(i,j)*(Fdt_m(i,j,a) + Fdt_p(i,j,a))) < 0.0)then ! for debugging ! call MOM_error(WARNING, "propagate_y: OutFlux>Available prior to reflection", .true.) ! write(mesg,*) "flux_y_south=",flux_y(i,J-1),"flux_y_north=",flux_y(i,J),"En=",En(i,j,a), & ! "cn_south=", speed_y(i,J-1) * (Cgy_av(a)), "cn_north=", speed_y(i,J) * (Cgy_av(a)) @@ -1482,7 +1484,7 @@ subroutine propagate_y(En, speed_y, Cgy_av, dCgy, dt, G, Nangle, CS, LB) ! test with old (take out later) !do j=jsh,jeh ; do i=ish,ieh - ! En(i,j,a) = En(i,j,a) - dt* G%IareaT(i,j) * (flux_y(i,J) - flux_y(i,J-1)) + ! En(i,j,a) = En(i,j,a) - dt* US%m_to_L**2*G%IareaT(i,j) * (flux_y(i,J) - flux_y(i,J-1)) !enddo ; enddo enddo ! a-loop @@ -1498,17 +1500,17 @@ subroutine propagate_y(En, speed_y, Cgy_av, dCgy, dt, G, Nangle, CS, LB) ! Update reflected energy (Jm-2) do j=jsh,jeh ; do i=ish,ieh !do a=1,CS%nAngle - ! if ((En(i,j,a) + G%IareaT(i,j)*(Fdt_m(i,j,a) + Fdt_p(i,j,a))) < 0.0)then ! for debugging + ! if ((En(i,j,a) + US%m_to_L**2*G%IareaT(i,j)*(Fdt_m(i,j,a) + Fdt_p(i,j,a))) < 0.0)then ! for debugging ! call MOM_error(FATAL, "propagate_y: OutFlux>Available", .true.) ! endif !enddo - En(i,j,:) = En(i,j,:) + G%IareaT(i,j)*(Fdt_m(i,j,:) + Fdt_p(i,j,:)) + En(i,j,:) = En(i,j,:) + US%m_to_L**2*G%IareaT(i,j)*(Fdt_m(i,j,:) + Fdt_p(i,j,:)) enddo ; enddo end subroutine propagate_y !> Evaluates the zonal mass or volume fluxes in a layer. -subroutine zonal_flux_En(u, h, hL, hR, uh, dt, G, j, ish, ieh, vol_CFL) +subroutine zonal_flux_En(u, h, hL, hR, uh, dt, G, US, j, ish, ieh, vol_CFL) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. real, dimension(SZIB_(G)), intent(in) :: u !< The zonal velocity [m s-1]. real, dimension(SZI_(G)), intent(in) :: h !< Energy density used to calculate the fluxes @@ -1519,6 +1521,7 @@ subroutine zonal_flux_En(u, h, hL, hR, uh, dt, G, j, ish, ieh, vol_CFL) !! [J m-2]. real, dimension(SZIB_(G)), intent(inout) :: uh !< The zonal energy transport [J s-1]. real, intent(in) :: dt !< Time increment [s]. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type integer, intent(in) :: j !< The j-index to work on. integer, intent(in) :: ish !< The start i-index range to work on. integer, intent(in) :: ieh !< The end i-index range to work on. @@ -1533,13 +1536,13 @@ subroutine zonal_flux_En(u, h, hL, hR, uh, dt, G, j, ish, ieh, vol_CFL) do I=ish-1,ieh ! Set new values of uh and duhdu. if (u(I) > 0.0) then - if (vol_CFL) then ; CFL = (u(I) * dt) * (G%dy_Cu(I,j) * G%IareaT(i,j)) + if (vol_CFL) then ; CFL = (u(I) * dt) * (G%dy_Cu(I,j) * US%m_to_L**2*G%IareaT(i,j)) else ; CFL = u(I) * dt * G%IdxT(i,j) ; endif curv_3 = (hL(i) + hR(i)) - 2.0*h(i) uh(I) = G%dy_Cu(I,j) * u(I) * & (hR(i) + CFL * (0.5*(hL(i) - hR(i)) + curv_3*(CFL - 1.5))) elseif (u(I) < 0.0) then - if (vol_CFL) then ; CFL = (-u(I) * dt) * (G%dy_Cu(I,j) * G%IareaT(i+1,j)) + if (vol_CFL) then ; CFL = (-u(I) * dt) * (G%dy_Cu(I,j) * US%m_to_L**2*G%IareaT(i+1,j)) else ; CFL = -u(I) * dt * G%IdxT(i+1,j) ; endif curv_3 = (hL(i+1) + hR(i+1)) - 2.0*h(i+1) uh(I) = G%dy_Cu(I,j) * u(I) * & @@ -1551,7 +1554,7 @@ subroutine zonal_flux_En(u, h, hL, hR, uh, dt, G, j, ish, ieh, vol_CFL) end subroutine zonal_flux_En !> Evaluates the meridional mass or volume fluxes in a layer. -subroutine merid_flux_En(v, h, hL, hR, vh, dt, G, J, ish, ieh, vol_CFL) +subroutine merid_flux_En(v, h, hL, hR, vh, dt, G, US, J, ish, ieh, vol_CFL) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. real, dimension(SZI_(G)), intent(in) :: v !< The meridional velocity [m s-1]. real, dimension(SZI_(G),SZJ_(G)), intent(in) :: h !< Energy density used to calculate the @@ -1562,6 +1565,7 @@ subroutine merid_flux_En(v, h, hL, hR, vh, dt, G, J, ish, ieh, vol_CFL) !! reconstruction [J m-2]. real, dimension(SZI_(G)), intent(inout) :: vh !< The meridional energy transport [J s-1]. real, intent(in) :: dt !< Time increment [s]. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type integer, intent(in) :: J !< The j-index to work on. integer, intent(in) :: ish !< The start i-index range to work on. integer, intent(in) :: ieh !< The end i-index range to work on. @@ -1576,13 +1580,13 @@ subroutine merid_flux_En(v, h, hL, hR, vh, dt, G, J, ish, ieh, vol_CFL) do i=ish,ieh if (v(i) > 0.0) then - if (vol_CFL) then ; CFL = (v(i) * dt) * (G%dx_Cv(i,J) * G%IareaT(i,j)) + if (vol_CFL) then ; CFL = (v(i) * dt) * (G%dx_Cv(i,J) * US%m_to_L**2*G%IareaT(i,j)) else ; CFL = v(i) * dt * G%IdyT(i,j) ; endif curv_3 = hL(i,j) + hR(i,j) - 2.0*h(i,j) vh(i) = G%dx_Cv(i,J) * v(i) * ( hR(i,j) + CFL * & (0.5*(hL(i,j) - hR(i,j)) + curv_3*(CFL - 1.5)) ) elseif (v(i) < 0.0) then - if (vol_CFL) then ; CFL = (-v(i) * dt) * (G%dx_Cv(i,J) * G%IareaT(i,j+1)) + if (vol_CFL) then ; CFL = (-v(i) * dt) * (G%dx_Cv(i,J) * US%m_to_L**2*G%IareaT(i,j+1)) else ; CFL = -v(i) * dt * G%IdyT(i,j+1) ; endif curv_3 = hL(i,j+1) + hR(i,j+1) - 2.0*h(i,j+1) vh(i) = G%dx_Cv(i,J) * v(i) * ( hL(i,j+1) + CFL * & diff --git a/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 b/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 index 5df2b2d166..286ac580c4 100644 --- a/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 +++ b/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 @@ -507,7 +507,7 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var !$OMP do do j=js,je ; do k=1,nz ; do i=is,ie - h(i,j,k) = h(i,j,k) - dt*G%IareaT(i,j) * & + h(i,j,k) = h(i,j,k) - dt*US%m_to_L**2*G%IareaT(i,j) * & ((uhml(I,j,k) - uhml(I-1,j,k)) + (vhml(i,J,k) - vhml(i,J-1,k))) enddo ; enddo ; enddo !$OMP end parallel @@ -743,7 +743,7 @@ subroutine mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, dt, G, GV, US, CS) !$OMP do do j=js,je ; do k=1,nkml ; do i=is,ie - h(i,j,k) = h(i,j,k) - dt*G%IareaT(i,j) * & + h(i,j,k) = h(i,j,k) - dt*US%m_to_L**2*G%IareaT(i,j) * & ((uhml(I,j,k) - uhml(I-1,j,k)) + (vhml(i,J,k) - vhml(i,J-1,k))) enddo ; enddo ; enddo !$OMP end parallel diff --git a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 index 2b62a388fb..cf19c54e93 100644 --- a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 +++ b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 @@ -484,7 +484,7 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp if (associated(CDp%vhGM)) CDp%vhGM(i,J,k) = vhD(i,J,k) enddo ; enddo do j=js,je ; do i=is,ie - h(i,j,k) = h(i,j,k) - dt * G%IareaT(i,j) * & + h(i,j,k) = h(i,j,k) - dt * US%m_to_L**2*G%IareaT(i,j) * & ((uhD(I,j,k) - uhD(I-1,j,k)) + (vhD(i,J,k) - vhD(i,J-1,k))) if (h(i,j,k) < GV%Angstrom_H) h(i,j,k) = GV%Angstrom_H enddo ; enddo @@ -1269,7 +1269,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV !if (find_work) then ; do j=js,je ; do i=is,ie ; do k=nz,1,-1 if (find_work) then ; do j=js,je ; do i=is,ie ! Note that the units of Work_v and Work_u are W, while Work_h is W m-2. - Work_h = 0.5 * G%IareaT(i,j) * & + Work_h = 0.5 * US%m_to_L**2*G%IareaT(i,j) * & ((Work_u(I-1,j) + Work_u(I,j)) + (Work_v(i,J-1) + Work_v(i,J))) PE_release_h = -0.25*(Kh_u(I,j,k)*(Slope_x_PE(I,j,k)**2) * hN2_x_PE(I,j,k) + & Kh_u(I-1,j,k)*(Slope_x_PE(I-1,j,k)**2) * hN2_x_PE(I-1,j,k) + & @@ -1526,7 +1526,7 @@ subroutine add_detangling_Kh(h, e, Kh_u, Kh_v, KH_u_CFL, KH_v_CFL, tv, dt, G, GV do k=k_top,nz ; do i=ish,ie ; if (do_i(i)) then if (n==1) then ! This is a u-column. dH = 0.0 - denom = ((G%IareaT(i+1,j) + G%IareaT(i,j))*G%dy_Cu(I,j)) + denom = ((US%m_to_L**2*G%IareaT(i+1,j) + US%m_to_L**2*G%IareaT(i,j))*G%dy_Cu(I,j)) ! This expression uses differences in e in place of h for better ! consistency with the slopes. if (denom > 0.0) & @@ -1551,7 +1551,7 @@ subroutine add_detangling_Kh(h, e, Kh_u, Kh_v, KH_u_CFL, KH_v_CFL, tv, dt, G, GV Kh_detangle(I,K+1) = Kh_detangle(I,K+1) + wt2*Kh_lay_u(I,j,k) else ! This is a v-column. dH = 0.0 - denom = ((G%IareaT(i,j+1) + G%IareaT(i,j))*G%dx_Cv(I,j)) + denom = ((US%m_to_L**2*G%IareaT(i,j+1) + US%m_to_L**2*G%IareaT(i,j))*G%dx_Cv(I,j)) if (denom > 0.0) & dH = I_4t * ((e(i,j+1,K) - e(i,j+1,K+1)) - & (e(i,j,K) - e(i,j,K+1))) / denom @@ -1684,14 +1684,14 @@ subroutine add_detangling_Kh(h, e, Kh_u, Kh_v, KH_u_CFL, KH_v_CFL, tv, dt, G, GV ! Sfn(K) = -Kh(i,K) * (e(i+1,j,K)-e(i,j,K)) * G%IdxCu(I,j) ! Sfn(K+1) = -Kh(i,K+1) * (e(i+1,j,K+1)-e(i,j,K+1)) * G%IdxCu(I,j) ! uh_here(k) = (Sfn(K) - Sfn(K+1))*G%dy_Cu(I,j) -! if (abs(uh_here(k))*min(G%IareaT(i,j), G%IareaT(i+1,j)) > & +! if (abs(uh_here(k))*min(US%m_to_L**2*G%IareaT(i,j), US%m_to_L**2*G%IareaT(i+1,j)) > & ! (1e-10*GV%m_to_H)) then ! if (uh_here(k) * (h(i+1,j,k) - h(i,j,k)) > 0.0) then ! call MOM_error(WARNING, & ! "Corrective u-transport is up the thickness gradient.", .true.) ! endif -! if (((h(i,j,k) - 4.0*dt*G%IareaT(i,j)*uh_here(k)) - & -! (h(i+1,j,k) + 4.0*dt*G%IareaT(i+1,j)*uh_here(k))) * & +! if (((h(i,j,k) - 4.0*dt*US%m_to_L**2*G%IareaT(i,j)*uh_here(k)) - & +! (h(i+1,j,k) + 4.0*dt*US%m_to_L**2*G%IareaT(i+1,j)*uh_here(k))) * & ! (h(i,j,k) - h(i+1,j,k)) < 0.0) then ! call MOM_error(WARNING, & ! "Corrective u-transport is too large.", .true.) @@ -1704,14 +1704,14 @@ subroutine add_detangling_Kh(h, e, Kh_u, Kh_v, KH_u_CFL, KH_v_CFL, tv, dt, G, GV ! Sfn(K) = -Kh(i,K) * (e(i,j+1,K)-e(i,j,K)) * G%IdyCv(i,J) ! Sfn(K+1) = -Kh(i,K+1) * (e(i,j+1,K+1)-e(i,j,K+1)) * G%IdyCv(i,J) ! uh_here(k) = (Sfn(K) - Sfn(K+1))*G%dx_Cv(i,J) -! if (abs(uh_here(K))*min(G%IareaT(i,j), G%IareaT(i,j+1)) > & +! if (abs(uh_here(K))*min(US%m_to_L**2*G%IareaT(i,j), US%m_to_L**2*G%IareaT(i,j+1)) > & ! (1e-10*GV%m_to_H)) then ! if (uh_here(K) * (h(i,j+1,k) - h(i,j,k)) > 0.0) then ! call MOM_error(WARNING, & ! "Corrective v-transport is up the thickness gradient.", .true.) ! endif -! if (((h(i,j,k) - 4.0*dt*G%IareaT(i,j)*uh_here(K)) - & -! (h(i,j+1,k) + 4.0*dt*G%IareaT(i,j+1)*uh_here(K))) * & +! if (((h(i,j,k) - 4.0*dt*US%m_to_L**2*G%IareaT(i,j)*uh_here(K)) - & +! (h(i,j+1,k) + 4.0*dt*US%m_to_L**2*G%IareaT(i,j+1)*uh_here(K))) * & ! (h(i,j,k) - h(i,j+1,k)) < 0.0) then ! call MOM_error(WARNING, & ! "Corrective v-transport is too large.", .true.) diff --git a/src/parameterizations/vertical/MOM_diabatic_aux.F90 b/src/parameterizations/vertical/MOM_diabatic_aux.F90 index ca6185aa5d..88714fb1f6 100644 --- a/src/parameterizations/vertical/MOM_diabatic_aux.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_aux.F90 @@ -551,9 +551,10 @@ end subroutine triDiagTS !> This subroutine calculates u_h and v_h (velocities at thickness !! points), optionally using the entrainment amounts passed in as arguments. -subroutine find_uv_at_h(u, v, h, u_h, v_h, G, GV, ea, eb) +subroutine find_uv_at_h(u, v, h, u_h, v_h, G, GV, US, ea, eb) 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)), & @@ -599,7 +600,7 @@ subroutine find_uv_at_h(u, v, h, u_h, v_h, G, GV, ea, eb) do i=is,ie s = G%areaCu(I-1,j)+G%areaCu(I,j) if (s>0.0) then - Idenom = sqrt(0.5*G%IareaT(i,j)/s) + Idenom = sqrt(0.5*US%m_to_L**2*G%IareaT(i,j)/s) a_w(i) = G%areaCu(I-1,j)*Idenom a_e(i) = G%areaCu(I,j)*Idenom else @@ -608,7 +609,7 @@ subroutine find_uv_at_h(u, v, h, u_h, v_h, G, GV, ea, eb) s = G%areaCv(i,J-1)+G%areaCv(i,J) if (s>0.0) then - Idenom = sqrt(0.5*G%IareaT(i,j)/s) + Idenom = sqrt(0.5*US%m_to_L**2*G%IareaT(i,j)/s) a_s(i) = G%areaCv(i,J-1)*Idenom a_n(i) = G%areaCv(i,J)*Idenom else diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index e0df2f3c3f..a0def608fd 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -595,13 +595,13 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim 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, eatr, ebtr) + call find_uv_at_h(u, v, h_orig, u_h, v_h, G, GV, US, eatr, ebtr) if (CS%debug) then 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) + call find_uv_at_h(u, v, h, u_h, v_h, G, GV, US) endif if (showCallTree) call callTree_waypoint("done with find_uv_at_h (diabatic)") endif @@ -842,7 +842,7 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim 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 find_uv_at_h(u, v, h, u_h, v_h, 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) @@ -1380,13 +1380,13 @@ subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, 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, eatr, ebtr) + call find_uv_at_h(u, v, h_orig, u_h, v_h, G, GV, US, eatr, ebtr) if (CS%debug) then 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) + call find_uv_at_h(u, v, h, u_h, v_h, G, GV, US) endif if (showCallTree) call callTree_waypoint("done with find_uv_at_h (diabatic)") endif @@ -1572,7 +1572,7 @@ subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, 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 find_uv_at_h(u, v, h, u_h, v_h, 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) @@ -2077,7 +2077,7 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e ! Monin-Obukhov depth or minimum mixed layer depth. ! (4) Uses any remaining TKE to drive mixed layer entrainment. ! (5) Possibly splits buffer layer into two isopycnal layers (when using isopycnal coordinate) - call find_uv_at_h(u, v, h, u_h, v_h, G, GV) + call find_uv_at_h(u, v, h, u_h, v_h, G, GV, US) call cpu_clock_begin(id_clock_mixedlayer) if (CS%ML_mix_first < 1.0) then @@ -2117,13 +2117,13 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e 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) + call find_uv_at_h(u, v, h_orig, u_h, v_h, G, GV, US, 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) + call find_uv_at_h(u, v, h, u_h, v_h, G, GV, US) endif if (showCallTree) call callTree_waypoint("done with find_uv_at_h (diabatic)") endif @@ -2469,7 +2469,7 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e ! (4) Uses any remaining TKE to drive mixed layer entrainment. ! (5) Possibly splits the buffer layer into two isopycnal layers. - call find_uv_at_h(u, v, hold, u_h, v_h, G, GV, ea, eb) + call find_uv_at_h(u, v, hold, u_h, v_h, G, GV, US, ea, eb) if (CS%debug) call MOM_state_chksum("find_uv_at_h1 ", u, v, h, G, GV, haloshift=0) dt_mix = min(dt_in_T, dt_in_T*(1.0 - CS%ML_mix_first)) diff --git a/src/parameterizations/vertical/MOM_set_diffusivity.F90 b/src/parameterizations/vertical/MOM_set_diffusivity.F90 index dee3422a7a..8d2dd41257 100644 --- a/src/parameterizations/vertical/MOM_set_diffusivity.F90 +++ b/src/parameterizations/vertical/MOM_set_diffusivity.F90 @@ -1262,7 +1262,7 @@ subroutine add_drag_diffusivity(h, u, v, tv, fluxes, visc, j, TKE_to_Kd, & else ; TKE_to_layer = 0.0 ; endif ! TKE_Ray has been initialized to 0 above. - if (Rayleigh_drag) TKE_Ray = 0.5*CS%BBL_effic * G%IareaT(i,j) * & + if (Rayleigh_drag) TKE_Ray = 0.5*CS%BBL_effic * US%m_to_L**2*G%IareaT(i,j) * & 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) + & @@ -1444,7 +1444,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**2 * & - 0.5*CS%BBL_effic * G%IareaT(i,j) * & + 0.5*CS%BBL_effic * US%m_to_L**2*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) + & (G%areaCv(i,J-1) * visc%Ray_v(i,J-1,k) * v(i,J-1,k)**2 + & @@ -1759,7 +1759,7 @@ subroutine set_BBL_TKE(u, v, h, fluxes, visc, G, GV, US, CS) endif ; enddo do i=is,ie - visc%ustar_BBL(i,j) = sqrt(0.5*G%IareaT(i,j) * & + visc%ustar_BBL(i,j) = sqrt(0.5*US%m_to_L**2*G%IareaT(i,j) * & ((G%areaCu(I-1,j)*(ustar(I-1)*ustar(I-1)) + & G%areaCu(I,j)*(ustar(I)*ustar(I))) + & (G%areaCv(i,J-1)*(vstar(i,J-1)*vstar(i,J-1)) + & @@ -1768,7 +1768,7 @@ subroutine set_BBL_TKE(u, v, h, fluxes, visc, G, GV, US, CS) (((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)) + & - G%areaCv(i,J) * (vstar(i,J)*v2_bbl(i,J))) )*G%IareaT(i,j)) + G%areaCv(i,J) * (vstar(i,J)*v2_bbl(i,J))) )*US%m_to_L**2*G%IareaT(i,j)) enddo enddo !$OMP end parallel diff --git a/src/parameterizations/vertical/MOM_vert_friction.F90 b/src/parameterizations/vertical/MOM_vert_friction.F90 index 4c1de70024..c63748c97e 100644 --- a/src/parameterizations/vertical/MOM_vert_friction.F90 +++ b/src/parameterizations/vertical/MOM_vert_friction.F90 @@ -1395,9 +1395,9 @@ subroutine vertvisc_limit_vel(u, v, h, ADp, CDp, forces, visc, dt, G, GV, US, CS do k=1,nz ; do I=Isq,Ieq if (abs(u(I,j,k)) < CS%vel_underflow) u(I,j,k) = 0.0 if (u(I,j,k) < 0.0) then - CFL = (-u(I,j,k) * dt) * (G%dy_Cu(I,j) * G%IareaT(i+1,j)) + CFL = (-u(I,j,k) * dt) * (G%dy_Cu(I,j) * US%m_to_L**2*G%IareaT(i+1,j)) else - CFL = (u(I,j,k) * dt) * (G%dy_Cu(I,j) * G%IareaT(i,j)) + CFL = (u(I,j,k) * dt) * (G%dy_Cu(I,j) * US%m_to_L**2*G%IareaT(i,j)) endif if (CFL > CS%CFL_trunc) trunc_any = .true. if (CFL > CS%CFL_report) then @@ -1421,10 +1421,10 @@ subroutine vertvisc_limit_vel(u, v, h, ADp, CDp, forces, visc, dt, G, GV, US, CS if (trunc_any) then ; if (CS%CFL_based_trunc) then do k=1,nz ; do I=Isq,Ieq - if ((u(I,j,k) * (dt * G%dy_Cu(I,j))) * G%IareaT(i+1,j) < -CS%CFL_trunc) then + if ((u(I,j,k) * (dt * G%dy_Cu(I,j))) * US%m_to_L**2*G%IareaT(i+1,j) < -CS%CFL_trunc) then u(I,j,k) = (-0.9*CS%CFL_trunc) * (G%areaT(i+1,j) / (dt * G%dy_Cu(I,j))) if (h(i,j,k) + h(i+1,j,k) > H_report) CS%ntrunc = CS%ntrunc + 1 - elseif ((u(I,j,k) * (dt * G%dy_Cu(I,j))) * G%IareaT(i,j) > CS%CFL_trunc) then + elseif ((u(I,j,k) * (dt * G%dy_Cu(I,j))) * US%m_to_L**2*G%IareaT(i,j) > CS%CFL_trunc) then u(I,j,k) = (0.9*CS%CFL_trunc) * (G%areaT(i,j) / (dt * G%dy_Cu(I,j))) if (h(i,j,k) + h(i+1,j,k) > H_report) CS%ntrunc = CS%ntrunc + 1 endif @@ -1441,10 +1441,10 @@ subroutine vertvisc_limit_vel(u, v, h, ADp, CDp, forces, visc, dt, G, GV, US, CS !$OMP parallel do default(none) shared(nz,js,je,Isq,Ieq,u,dt,G,CS,h,H_report) do k=1,nz ; do j=js,je ; do I=Isq,Ieq if (abs(u(I,j,k)) < CS%vel_underflow) then ; u(I,j,k) = 0.0 - elseif ((u(I,j,k) * (dt * G%dy_Cu(I,j))) * G%IareaT(i+1,j) < -CS%CFL_trunc) then + elseif ((u(I,j,k) * (dt * G%dy_Cu(I,j))) * US%m_to_L**2*G%IareaT(i+1,j) < -CS%CFL_trunc) then u(I,j,k) = (-0.9*CS%CFL_trunc) * (G%areaT(i+1,j) / (dt * G%dy_Cu(I,j))) if (h(i,j,k) + h(i+1,j,k) > H_report) CS%ntrunc = CS%ntrunc + 1 - elseif ((u(I,j,k) * (dt * G%dy_Cu(I,j))) * G%IareaT(i,j) > CS%CFL_trunc) then + elseif ((u(I,j,k) * (dt * G%dy_Cu(I,j))) * US%m_to_L**2*G%IareaT(i,j) > CS%CFL_trunc) then u(I,j,k) = (0.9*CS%CFL_trunc) * (G%areaT(i,j) / (dt * G%dy_Cu(I,j))) if (h(i,j,k) + h(i+1,j,k) > H_report) CS%ntrunc = CS%ntrunc + 1 endif @@ -1480,9 +1480,9 @@ subroutine vertvisc_limit_vel(u, v, h, ADp, CDp, forces, visc, dt, G, GV, US, CS do k=1,nz ; do i=is,ie if (abs(v(i,J,k)) < CS%vel_underflow) v(i,J,k) = 0.0 if (v(i,J,k) < 0.0) then - CFL = (-v(i,J,k) * dt) * (G%dx_Cv(i,J) * G%IareaT(i,j+1)) + CFL = (-v(i,J,k) * dt) * (G%dx_Cv(i,J) * US%m_to_L**2*G%IareaT(i,j+1)) else - CFL = (v(i,J,k) * dt) * (G%dx_Cv(i,J) * G%IareaT(i,j)) + CFL = (v(i,J,k) * dt) * (G%dx_Cv(i,J) * US%m_to_L**2*G%IareaT(i,j)) endif if (CFL > CS%CFL_trunc) trunc_any = .true. if (CFL > CS%CFL_report) then @@ -1506,10 +1506,10 @@ subroutine vertvisc_limit_vel(u, v, h, ADp, CDp, forces, visc, dt, G, GV, US, CS if (trunc_any) then ; if (CS%CFL_based_trunc) then do k=1,nz; do i=is,ie - if ((v(i,J,k) * (dt * G%dx_Cv(i,J))) * G%IareaT(i,j+1) < -CS%CFL_trunc) then + if ((v(i,J,k) * (dt * G%dx_Cv(i,J))) * US%m_to_L**2*G%IareaT(i,j+1) < -CS%CFL_trunc) then v(i,J,k) = (-0.9*CS%CFL_trunc) * (G%areaT(i,j+1) / (dt * G%dx_Cv(i,J))) if (h(i,j,k) + h(i,j+1,k) > H_report) CS%ntrunc = CS%ntrunc + 1 - elseif ((v(i,J,k) * (dt * G%dx_Cv(i,J))) * G%IareaT(i,j) > CS%CFL_trunc) then + elseif ((v(i,J,k) * (dt * G%dx_Cv(i,J))) * US%m_to_L**2*G%IareaT(i,j) > CS%CFL_trunc) then v(i,J,k) = (0.9*CS%CFL_trunc) * (G%areaT(i,j) / (dt * G%dx_Cv(i,J))) if (h(i,j,k) + h(i,j+1,k) > H_report) CS%ntrunc = CS%ntrunc + 1 endif @@ -1526,10 +1526,10 @@ subroutine vertvisc_limit_vel(u, v, h, ADp, CDp, forces, visc, dt, G, GV, US, CS !$OMP parallel do default(shared) do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie if (abs(v(i,J,k)) < CS%vel_underflow) then ; v(i,J,k) = 0.0 - elseif ((v(i,J,k) * (dt * G%dx_Cv(i,J))) * G%IareaT(i,j+1) < -CS%CFL_trunc) then + elseif ((v(i,J,k) * (dt * G%dx_Cv(i,J))) * US%m_to_L**2*G%IareaT(i,j+1) < -CS%CFL_trunc) then v(i,J,k) = (-0.9*CS%CFL_trunc) * (G%areaT(i,j+1) / (dt * G%dx_Cv(i,J))) if (h(i,j,k) + h(i,j+1,k) > H_report) CS%ntrunc = CS%ntrunc + 1 - elseif ((v(i,J,k) * (dt * G%dx_Cv(i,J))) * G%IareaT(i,j) > CS%CFL_trunc) then + elseif ((v(i,J,k) * (dt * G%dx_Cv(i,J))) * US%m_to_L**2*G%IareaT(i,j) > CS%CFL_trunc) then v(i,J,k) = (0.9*CS%CFL_trunc) * (G%areaT(i,j) / (dt * G%dx_Cv(i,J))) if (h(i,j,k) + h(i,j+1,k) > H_report) CS%ntrunc = CS%ntrunc + 1 endif diff --git a/src/tracer/MOM_neutral_diffusion.F90 b/src/tracer/MOM_neutral_diffusion.F90 index deeb9529ee..f1f6191c74 100644 --- a/src/tracer/MOM_neutral_diffusion.F90 +++ b/src/tracer/MOM_neutral_diffusion.F90 @@ -22,6 +22,7 @@ module MOM_neutral_diffusion use MOM_remapping, only : extract_member_remapping_CS, build_reconstructions_1d use MOM_remapping, only : average_value_ppoly, remappingSchemesDoc, remappingDefaultScheme use MOM_tracer_registry, only : tracer_registry_type, tracer_type +use MOM_unit_scaling, only : unit_scale_type use MOM_verticalGrid, only : verticalGrid_type use polynomial_functions, only : evaluation_polynomial, first_derivative_polynomial use PPM_functions, only : PPM_reconstruction, PPM_boundary_extrapolation @@ -407,7 +408,7 @@ subroutine neutral_diffusion_calc_coeffs(G, GV, h, T, S, CS) end subroutine neutral_diffusion_calc_coeffs !> Update tracer concentration due to neutral diffusion; layer thickness unchanged by this update. -subroutine neutral_diffusion(G, GV, h, Coef_x, Coef_y, dt, Reg, CS) +subroutine neutral_diffusion(G, GV, h, Coef_x, Coef_y, dt, Reg, US, CS) type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness [H ~> m or kg m-2] @@ -416,6 +417,7 @@ subroutine neutral_diffusion(G, GV, h, Coef_x, Coef_y, dt, Reg, CS) real, intent(in) :: dt !< Tracer time step * I_numitts !! (I_numitts in tracer_hordiff) type(tracer_registry_type), pointer :: Reg !< Tracer registry + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(neutral_diffusion_CS), pointer :: CS !< Neutral diffusion control structure ! Local variables @@ -495,12 +497,12 @@ subroutine neutral_diffusion(G, GV, h, Coef_x, Coef_y, dt, Reg, CS) enddo do k = 1, GV%ke tracer%t(i,j,k) = tracer%t(i,j,k) + dTracer(k) * & - ( G%IareaT(i,j) / ( h(i,j,k) + GV%H_subroundoff ) ) + ( US%m_to_L**2*G%IareaT(i,j) / ( h(i,j,k) + GV%H_subroundoff ) ) enddo if (tracer%id_dfxy_conc > 0 .or. tracer%id_dfxy_cont > 0 .or. tracer%id_dfxy_cont_2d > 0 ) then do k = 1, GV%ke - tendency(i,j,k) = dTracer(k) * G%IareaT(i,j) * Idt + tendency(i,j,k) = dTracer(k) * US%m_to_L**2*G%IareaT(i,j) * Idt enddo endif diff --git a/src/tracer/MOM_tracer_advect.F90 b/src/tracer/MOM_tracer_advect.F90 index ced1916a7a..969d237ec0 100644 --- a/src/tracer/MOM_tracer_advect.F90 +++ b/src/tracer/MOM_tracer_advect.F90 @@ -643,7 +643,7 @@ subroutine advect_x(Tr, hprev, uhr, uh_neglect, OBC, domore_u, ntr, Idt, & if (associated(Tr(m)%advection_xy)) then do i=is,ie ; if (do_i(i)) then Tr(m)%advection_xy(i,j,k) = Tr(m)%advection_xy(i,j,k) - (flux_x(I,m) - flux_x(I-1,m)) * & - Idt * US%L_to_m**2*G%IareaT(i,j) + Idt * US%L_to_m**2*US%m_to_L**2*G%IareaT(i,j) endif ; enddo endif @@ -985,7 +985,7 @@ subroutine advect_y(Tr, hprev, vhr, vh_neglect, OBC, domore_v, ntr, Idt, & if (associated(Tr(m)%advection_xy)) then do i=is,ie ; if (do_i(i)) then Tr(m)%advection_xy(i,j,k) = Tr(m)%advection_xy(i,j,k) - (flux_y(i,m,J) - flux_y(i,m,J-1))* Idt * & - US%L_to_m**2*G%IareaT(i,j) + US%L_to_m**2*US%m_to_L**2*G%IareaT(i,j) endif ; enddo endif diff --git a/src/tracer/MOM_tracer_hor_diff.F90 b/src/tracer/MOM_tracer_hor_diff.F90 index 261d8d1315..29b5cde89a 100644 --- a/src/tracer/MOM_tracer_hor_diff.F90 +++ b/src/tracer/MOM_tracer_hor_diff.F90 @@ -23,6 +23,7 @@ module MOM_tracer_hor_diff use MOM_neutral_diffusion, only : neutral_diffusion_CS use MOM_neutral_diffusion, only : neutral_diffusion_calc_coeffs, neutral_diffusion use MOM_tracer_registry, only : tracer_registry_type, tracer_type, MOM_tracer_chksum +use MOM_unit_scaling, only : unit_scale_type use MOM_variables, only : thermo_var_ptrs use MOM_verticalGrid, only : verticalGrid_type @@ -94,7 +95,7 @@ module MOM_tracer_hor_diff !! using the diffusivity in CS%KhTr, or using space-dependent diffusivity. !! Multiple iterations are used (if necessary) so that there is no limit !! on the acceptable time increment. -subroutine tracer_hordiff(h, dt, MEKE, VarMix, G, GV, CS, Reg, tv, do_online_flag, read_khdt_x, read_khdt_y) +subroutine tracer_hordiff(h, dt, MEKE, VarMix, G, GV, US, CS, Reg, tv, do_online_flag, read_khdt_x, read_khdt_y) type(ocean_grid_type), intent(inout) :: G !< Grid type real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(in) :: h !< Layer thickness [H ~> m or kg m-2] @@ -103,6 +104,7 @@ subroutine tracer_hordiff(h, dt, MEKE, VarMix, G, GV, CS, Reg, tv, do_online_fla type(VarMix_CS), pointer :: VarMix !< Variable mixing type type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure type(tracer_hor_diff_CS), pointer :: CS !< module control structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(tracer_registry_type), pointer :: Reg !< registered tracers type(thermo_var_ptrs), intent(in) :: tv !< A structure containing pointers to any available !! thermodynamic fields, including potential temp and @@ -342,7 +344,7 @@ subroutine tracer_hordiff(h, dt, MEKE, VarMix, G, GV, CS, Reg, tv, do_online_fla max_CFL = 0.0 do j=js,je ; do i=is,ie CFL(i,j) = 2.0*((khdt_x(I-1,j) + khdt_x(I,j)) + & - (khdt_y(i,J-1) + khdt_y(i,J))) * G%IareaT(i,j) + (khdt_y(i,J-1) + khdt_y(i,J))) * US%m_to_L**2*G%IareaT(i,j) if (max_CFL < CFL(i,j)) max_CFL = CFL(i,j) enddo ; enddo call cpu_clock_begin(id_clock_sync) @@ -401,7 +403,7 @@ subroutine tracer_hordiff(h, dt, MEKE, VarMix, G, GV, CS, Reg, tv, do_online_fla if (itt>1) then ! Update halos for subsequent iterations call do_group_pass(CS%pass_t, G%Domain, clock=id_clock_pass) endif - call neutral_diffusion(G, GV, h, Coef_x, Coef_y, I_numitts*dt, Reg, CS%neutral_diffusion_CSp) + call neutral_diffusion(G, GV, h, Coef_x, Coef_y, I_numitts*dt, Reg, US, CS%neutral_diffusion_CSp) enddo ! itt else ! following if not using neutral diffusion, but instead along-surface diffusion @@ -432,7 +434,7 @@ subroutine tracer_hordiff(h, dt, MEKE, VarMix, G, GV, CS, Reg, tv, do_online_fla enddo do i=is,ie - Ihdxdy(i,j) = G%IareaT(i,j) / (h(i,j,k)+h_neglect) + Ihdxdy(i,j) = US%m_to_L**2*G%IareaT(i,j) / (h(i,j,k)+h_neglect) enddo enddo diff --git a/src/user/MOM_controlled_forcing.F90 b/src/user/MOM_controlled_forcing.F90 index 3ba4f0c376..cbfce62f39 100644 --- a/src/user/MOM_controlled_forcing.F90 +++ b/src/user/MOM_controlled_forcing.F90 @@ -20,6 +20,7 @@ module MOM_controlled_forcing use MOM_time_manager, only : time_type, operator(+), operator(/), operator(-) use MOM_time_manager, only : get_date, set_date use MOM_time_manager, only : time_type_to_real, real_to_time +use MOM_unit_scaling, only : unit_scale_type use MOM_variables, only : surface implicit none ; private @@ -78,7 +79,7 @@ module MOM_controlled_forcing !> This subroutine calls any of the other subroutines in this file !! that are needed to specify the current surface forcing fields. subroutine apply_ctrl_forcing(SST_anom, SSS_anom, SSS_mean, virt_heat, virt_precip, & - day_start, dt, G, CS) + day_start, dt, G, US, CS) type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. real, dimension(SZI_(G),SZJ_(G)), intent(in) :: SST_anom !< The sea surface temperature !! anomalies [degC]. @@ -96,6 +97,7 @@ subroutine apply_ctrl_forcing(SST_anom, SSS_anom, SSS_mean, virt_heat, virt_prec type(time_type), intent(in) :: day_start !< Start time of the fluxes. real, intent(in) :: dt !< Length of time over which these !! fluxes will be applied [s]. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(ctrl_forcing_CS), pointer :: CS !< A pointer to the control structure !! returned by a previous call to !! ctrl_forcing_init. @@ -146,12 +148,12 @@ subroutine apply_ctrl_forcing(SST_anom, SSS_anom, SSS_mean, virt_heat, virt_prec do j=js,je ; do i=is,ie CS%heat_0(i,j) = CS%heat_0(i,j) + dt_heat_rate * ( & -CS%lam_heat*G%mask2dT(i,j)*SST_anom(i,j) + & - (G%IareaT(i,j) * ((flux_heat_x(I-1,j) - flux_heat_x(I,j)) + & + (US%m_to_L**2*G%IareaT(i,j) * ((flux_heat_x(I-1,j) - flux_heat_x(I,j)) + & (flux_heat_y(i,J-1) - flux_heat_y(i,J))) ) ) CS%precip_0(i,j) = CS%precip_0(i,j) + dt_prec_rate * ( & CS%lam_prec * G%mask2dT(i,j)*(SSS_anom(i,j) / SSS_mean(i,j)) + & - (G%IareaT(i,j) * ((flux_prec_x(I-1,j) - flux_prec_x(I,j)) + & + (US%m_to_L**2*G%IareaT(i,j) * ((flux_prec_x(I-1,j) - flux_prec_x(I,j)) + & (flux_prec_y(i,J-1) - flux_prec_y(i,J))) ) ) virt_heat(i,j) = virt_heat(i,j) + CS%heat_0(i,j) @@ -330,13 +332,13 @@ subroutine apply_ctrl_forcing(SST_anom, SSS_anom, SSS_mean, virt_heat, virt_prec do j=js,je ; do i=is,ie CS%heat_cyc(i,j,m_u1) = CS%heat_cyc(i,j,m_u1) + dt1_heat_rate * ( & -CS%lam_cyc_heat*(CS%avg_SST_anom(i,j,m_u2) - CS%avg_SST_anom(i,j,m_u1)) + & - (G%IareaT(i,j) * ((flux_heat_x(I-1,j) - flux_heat_x(I,j)) + & + (US%m_to_L**2*G%IareaT(i,j) * ((flux_heat_x(I-1,j) - flux_heat_x(I,j)) + & (flux_heat_y(i,J-1) - flux_heat_y(i,J))) ) ) CS%precip_cyc(i,j,m_u1) = CS%precip_cyc(i,j,m_u1) + dt1_prec_rate * ( & CS%lam_cyc_prec * (CS%avg_SSS_anom(i,j,m_u2) - CS%avg_SSS_anom(i,j,m_u1)) / & (0.5*(CS%avg_SSS(i,j,m_u2) + CS%avg_SSS(i,j,m_u1))) + & - (G%IareaT(i,j) * ((flux_prec_x(I-1,j) - flux_prec_x(I,j)) + & + (US%m_to_L**2*G%IareaT(i,j) * ((flux_prec_x(I-1,j) - flux_prec_x(I,j)) + & (flux_prec_y(i,J-1) - flux_prec_y(i,J))) ) ) enddo ; enddo endif @@ -355,13 +357,13 @@ subroutine apply_ctrl_forcing(SST_anom, SSS_anom, SSS_mean, virt_heat, virt_prec do j=js,je ; do i=is,ie CS%heat_cyc(i,j,m_u2) = CS%heat_cyc(i,j,m_u2) + dt1_heat_rate * ( & -CS%lam_cyc_heat*(CS%avg_SST_anom(i,j,m_u3) - CS%avg_SST_anom(i,j,m_u2)) + & - (G%IareaT(i,j) * ((flux_heat_x(I-1,j) - flux_heat_x(I,j)) + & + (US%m_to_L**2*G%IareaT(i,j) * ((flux_heat_x(I-1,j) - flux_heat_x(I,j)) + & (flux_heat_y(i,J-1) - flux_heat_y(i,J))) ) ) CS%precip_cyc(i,j,m_u2) = CS%precip_cyc(i,j,m_u2) + dt1_prec_rate * ( & CS%lam_cyc_prec * (CS%avg_SSS_anom(i,j,m_u3) - CS%avg_SSS_anom(i,j,m_u2)) / & (0.5*(CS%avg_SSS(i,j,m_u3) + CS%avg_SSS(i,j,m_u2))) + & - (G%IareaT(i,j) * ((flux_prec_x(I-1,j) - flux_prec_x(I,j)) + & + (US%m_to_L**2*G%IareaT(i,j) * ((flux_prec_x(I-1,j) - flux_prec_x(I,j)) + & (flux_prec_y(i,J-1) - flux_prec_y(i,J))) ) ) enddo ; enddo endif From 0772696675568881fd57c3d36f88f8a207e7e4b6 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Fri, 2 Aug 2019 17:16:19 -0400 Subject: [PATCH 143/297] Simplified some G%Iarea unit-scaling expressions Simplified some unit-scaling expressions for G%Iarea arrays. With these changes, all lines are one again shorter than 120 characters. All answers are bitwise identical. --- src/core/MOM_barotropic.F90 | 18 ++++++------ src/core/MOM_continuity_PPM.F90 | 28 +++++++++---------- src/diagnostics/MOM_diagnostics.F90 | 18 ++++++------ .../lateral/MOM_hor_visc.F90 | 2 +- src/tracer/MOM_tracer_advect.F90 | 4 +-- 5 files changed, 35 insertions(+), 35 deletions(-) diff --git a/src/core/MOM_barotropic.F90 b/src/core/MOM_barotropic.F90 index 4247a2aa5c..d98022204c 100644 --- a/src/core/MOM_barotropic.F90 +++ b/src/core/MOM_barotropic.F90 @@ -1392,7 +1392,7 @@ 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)) * (US%L_to_m**2*US%m_to_L**2*G%IareaT(i,j) * & + Idt_max2 = 0.5 * (dgeo_de * (1.0 + 2.0*bebt)) * (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)) + & @@ -1400,7 +1400,7 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, ((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*US%m_to_L**2*G%IareaT(i,j) * & + 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) / & @@ -1544,19 +1544,19 @@ 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_in_T * US%m_to_L*G%dy_Cu(I,j))) * US%L_to_m**2*US%m_to_L**2*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))) * G%IareaT(i+1,j) < -CS%CFL_trunc) then ! Add some error reporting later. 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*US%m_to_L**2*G%IareaT(i,j) > CS%CFL_trunc) then + elseif ((ubt(I,j) * (dt_in_T * US%m_to_L*G%dy_Cu(I,j))) * G%IareaT(i,j) > CS%CFL_trunc) then ! Add some error reporting later. 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_in_T * US%m_to_L*G%dx_Cv(i,J))) * US%L_to_m**2*US%m_to_L**2*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))) * G%IareaT(i,j+1) < -CS%CFL_trunc) then ! Add some error reporting later. 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*US%m_to_L**2*G%IareaT(i,j) > CS%CFL_trunc) then + elseif ((vbt(i,J) * (dt_in_T * US%m_to_L*G%dx_Cv(i,J))) * G%IareaT(i,j) > CS%CFL_trunc) then ! Add some error reporting later. 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 @@ -2350,7 +2350,7 @@ subroutine set_dtbt(G, GV, US, CS, eta, pbce, BT_cont, gtot_est, SSH_add) 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) * (US%L_to_m**2*US%m_to_L**2*G%IareaT(i,j) * & + Idt_max2 = 0.5 * (1.0 + 2.0*CS%bebt) * (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) + & @@ -4078,7 +4078,7 @@ 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) = US%L_to_m**2*US%m_to_L**2*G%IareaT(i,j) + CS%IareaT(i,j) = G%IareaT(i,j) CS%bathyT(i,j) = G%bathyT(i,j) enddo ; enddo @@ -4344,7 +4344,7 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, US, param_file, diag, CS, ! ### 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 * US%L_to_m**2*US%m_to_L**2*G%IareaT(i,j) * 0.1 * CS%maxvel * & + CS%eta_cor_bound(i,j) = GV%m_to_H * 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 diff --git a/src/core/MOM_continuity_PPM.F90 b/src/core/MOM_continuity_PPM.F90 index 4117a2b5a9..e9e55d9c4c 100644 --- a/src/core/MOM_continuity_PPM.F90 +++ b/src/core/MOM_continuity_PPM.F90 @@ -154,7 +154,7 @@ subroutine continuity_PPM(u, v, hin, h, uh, vh, dt, G, GV, US, CS, uhbt, vhbt, O call cpu_clock_begin(id_clock_update) !$OMP parallel do default(shared) do k=1,nz ; do j=LB%jsh,LB%jeh ; do i=LB%ish,LB%ieh - h(i,j,k) = hin(i,j,k) - US%s_to_T*dt * US%L_to_m**2*US%m_to_L**2*G%IareaT(i,j) * (uh(I,j,k) - uh(I-1,j,k)) + h(i,j,k) = hin(i,j,k) - US%s_to_T*dt * G%IareaT(i,j) * (uh(I,j,k) - uh(I-1,j,k)) ! Uncomment this line to prevent underflow. ! if (h(i,j,k) < h_min) h(i,j,k) = h_min enddo ; enddo ; enddo @@ -169,7 +169,7 @@ subroutine continuity_PPM(u, v, hin, h, uh, vh, dt, G, GV, US, CS, uhbt, vhbt, O call cpu_clock_begin(id_clock_update) !$OMP parallel do default(shared) do k=1,nz ; do j=LB%jsh,LB%jeh ; do i=LB%ish,LB%ieh - h(i,j,k) = h(i,j,k) - US%s_to_T*dt * US%L_to_m**2*US%m_to_L**2*G%IareaT(i,j) * (vh(i,J,k) - vh(i,J-1,k)) + h(i,j,k) = h(i,j,k) - US%s_to_T*dt * G%IareaT(i,j) * (vh(i,J,k) - vh(i,J-1,k)) ! This line prevents underflow. if (h(i,j,k) < h_min) h(i,j,k) = h_min enddo ; enddo ; enddo @@ -185,7 +185,7 @@ subroutine continuity_PPM(u, v, hin, h, uh, vh, dt, G, GV, US, CS, uhbt, vhbt, O call cpu_clock_begin(id_clock_update) !$OMP parallel do default(shared) do k=1,nz ; do j=LB%jsh,LB%jeh ; do i=LB%ish,LB%ieh - h(i,j,k) = hin(i,j,k) - US%s_to_T*dt * US%L_to_m**2*US%m_to_L**2*G%IareaT(i,j) * (vh(i,J,k) - vh(i,J-1,k)) + h(i,j,k) = hin(i,j,k) - US%s_to_T*dt * G%IareaT(i,j) * (vh(i,J,k) - vh(i,J-1,k)) enddo ; enddo ; enddo call cpu_clock_end(id_clock_update) @@ -197,7 +197,7 @@ subroutine continuity_PPM(u, v, hin, h, uh, vh, dt, G, GV, US, CS, uhbt, vhbt, O call cpu_clock_begin(id_clock_update) !$OMP parallel do default(shared) do k=1,nz ; do j=LB%jsh,LB%jeh ; do i=LB%ish,LB%ieh - h(i,j,k) = h(i,j,k) - US%s_to_T*dt * US%L_to_m**2*US%m_to_L**2*G%IareaT(i,j) * (uh(I,j,k) - uh(I-1,j,k)) + h(i,j,k) = h(i,j,k) - US%s_to_T*dt * G%IareaT(i,j) * (uh(I,j,k) - uh(I-1,j,k)) ! This line prevents underflow. if (h(i,j,k) < h_min) h(i,j,k) = h_min enddo ; enddo ; enddo @@ -539,14 +539,14 @@ subroutine zonal_flux_layer(u, h, h_L, h_R, uh, duhdu, visc_rem, dt_in_T, G, US, do I=ish-1,ieh ; if (do_I(I)) then ! Set new values of uh and duhdu. if (u(I) > 0.0) then - if (vol_CFL) then ; CFL = (u(I) * dt_in_T) * (US%m_to_L*G%dy_Cu(I,j) * US%L_to_m**2*US%m_to_L**2*G%IareaT(i,j)) + if (vol_CFL) then ; CFL = (u(I) * dt_in_T) * (US%m_to_L*G%dy_Cu(I,j) * G%IareaT(i,j)) else ; CFL = u(I) * dt_in_T * US%L_to_m*G%IdxT(i,j) ; endif curv_3 = h_L(i) + h_R(i) - 2.0*h(i) uh(I) = US%m_to_L*G%dy_Cu(I,j) * u(I) * & (h_R(i) + CFL * (0.5*(h_L(i) - h_R(i)) + curv_3*(CFL - 1.5))) h_marg = h_R(i) + CFL * ((h_L(i) - h_R(i)) + 3.0*curv_3*(CFL - 1.0)) elseif (u(I) < 0.0) then - if (vol_CFL) then ; CFL = (-u(I) * dt_in_T) * (US%m_to_L*G%dy_Cu(I,j) * US%L_to_m**2*US%m_to_L**2*G%IareaT(i+1,j)) + if (vol_CFL) then ; CFL = (-u(I) * dt_in_T) * (US%m_to_L*G%dy_Cu(I,j) * G%IareaT(i+1,j)) else ; CFL = -u(I) * dt_in_T * US%L_to_m*G%IdxT(i+1,j) ; endif curv_3 = h_L(i+1) + h_R(i+1) - 2.0*h(i+1) uh(I) = US%m_to_L*G%dy_Cu(I,j) * u(I) * & @@ -614,13 +614,13 @@ subroutine zonal_face_thickness(u, h, h_L, h_R, h_u, dt_in_T, G, US, LB, vol_CFL !$OMP parallel do default(shared) private(CFL,curv_3,h_marg,h_avg) do k=1,nz ; do j=jsh,jeh ; do I=ish-1,ieh if (u(I,j,k) > 0.0) then - if (vol_CFL) then ; CFL = (u(I,j,k) * dt_in_T) * (US%m_to_L*G%dy_Cu(I,j) * US%L_to_m**2*US%m_to_L**2*G%IareaT(i,j)) + if (vol_CFL) then ; CFL = (u(I,j,k) * dt_in_T) * (US%m_to_L*G%dy_Cu(I,j) * G%IareaT(i,j)) else ; CFL = u(I,j,k) * dt_in_T * US%L_to_m*G%IdxT(i,j) ; endif curv_3 = h_L(i,j,k) + h_R(i,j,k) - 2.0*h(i,j,k) h_avg = h_R(i,j,k) + CFL * (0.5*(h_L(i,j,k) - h_R(i,j,k)) + curv_3*(CFL - 1.5)) h_marg = h_R(i,j,k) + CFL * ((h_L(i,j,k) - h_R(i,j,k)) + 3.0*curv_3*(CFL - 1.0)) elseif (u(I,j,k) < 0.0) then - if (vol_CFL) then ; CFL = (-u(I,j,k)*dt_in_T) * (US%m_to_L*G%dy_Cu(I,j) * US%L_to_m**2*US%m_to_L**2*G%IareaT(i+1,j)) + if (vol_CFL) then ; CFL = (-u(I,j,k)*dt_in_T) * (US%m_to_L*G%dy_Cu(I,j) * G%IareaT(i+1,j)) else ; CFL = -u(I,j,k) * dt_in_T * US%L_to_m*G%IdxT(i+1,j) ; endif curv_3 = h_L(i+1,j,k) + h_R(i+1,j,k) - 2.0*h(i+1,j,k) h_avg = h_L(i+1,j,k) + CFL * (0.5*(h_R(i+1,j,k)-h_L(i+1,j,k)) + curv_3*(CFL - 1.5)) @@ -779,7 +779,7 @@ subroutine zonal_flux_adjust(u, h_in, h_L, h_R, uhbt, uh_tot_0, duhdu_tot_0, & enddo domore = .false. do I=ish-1,ieh ; if (do_I(I)) then - if ((dt_in_T * min(US%L_to_m**2*US%m_to_L**2*G%IareaT(i,j),US%L_to_m**2*US%m_to_L**2*G%IareaT(i+1,j))*abs(uh_err(I)) > tol_eta) .or. & + if ((dt_in_T * min(G%IareaT(i,j),G%IareaT(i+1,j))*abs(uh_err(I)) > tol_eta) .or. & (CS%better_iter .and. ((abs(uh_err(I)) > tol_vel * duhdu_tot(I)) .or. & (abs(uh_err(I)) > uh_err_best(I))) )) then ! Use Newton's method, provided it stays bounded. Otherwise bisect @@ -1337,7 +1337,7 @@ subroutine merid_flux_layer(v, h, h_L, h_R, vh, dvhdv, visc_rem, dt_in_T, G, US, do i=ish,ieh ; if (do_I(i)) then if (v(i) > 0.0) then - if (vol_CFL) then ; CFL = (v(i) * dt_in_T) * (US%m_to_L*G%dx_Cv(i,J) * US%L_to_m**2*US%m_to_L**2*G%IareaT(i,j)) + if (vol_CFL) then ; CFL = (v(i) * dt_in_T) * (US%m_to_L*G%dx_Cv(i,J) * G%IareaT(i,j)) else ; CFL = v(i) * dt_in_T * US%L_to_m*G%IdyT(i,j) ; endif curv_3 = h_L(i,j) + h_R(i,j) - 2.0*h(i,j) vh(i) = US%m_to_L*G%dx_Cv(i,J) * v(i) * ( h_R(i,j) + CFL * & @@ -1345,7 +1345,7 @@ subroutine merid_flux_layer(v, h, h_L, h_R, vh, dvhdv, visc_rem, dt_in_T, G, US, h_marg = h_R(i,j) + CFL * ((h_L(i,j) - h_R(i,j)) + & 3.0*curv_3*(CFL - 1.0)) elseif (v(i) < 0.0) then - if (vol_CFL) then ; CFL = (-v(i) * dt_in_T) * (US%m_to_L*G%dx_Cv(i,J) * US%L_to_m**2*US%m_to_L**2*G%IareaT(i,j+1)) + if (vol_CFL) then ; CFL = (-v(i) * dt_in_T) * (US%m_to_L*G%dx_Cv(i,J) * G%IareaT(i,j+1)) else ; CFL = -v(i) * dt_in_T * US%L_to_m*G%IdyT(i,j+1) ; endif curv_3 = h_L(i,j+1) + h_R(i,j+1) - 2.0*h(i,j+1) vh(i) = US%m_to_L*G%dx_Cv(i,J) * v(i) * ( h_L(i,j+1) + CFL * & @@ -1414,14 +1414,14 @@ subroutine merid_face_thickness(v, h, h_L, h_R, h_v, dt_in_T, G, US, LB, vol_CFL !$OMP parallel do default(shared) private(CFL,curv_3,h_marg,h_avg) do k=1,nz ; do J=jsh-1,jeh ; do i=ish,ieh if (v(i,J,k) > 0.0) then - if (vol_CFL) then ; CFL = (v(i,J,k) * dt_in_T) * (US%m_to_L*G%dx_Cv(i,J) * US%L_to_m**2*US%m_to_L**2*G%IareaT(i,j)) + if (vol_CFL) then ; CFL = (v(i,J,k) * dt_in_T) * (US%m_to_L*G%dx_Cv(i,J) * G%IareaT(i,j)) else ; CFL = v(i,J,k) * dt_in_T * US%L_to_m*G%IdyT(i,j) ; endif curv_3 = h_L(i,j,k) + h_R(i,j,k) - 2.0*h(i,j,k) h_avg = h_R(i,j,k) + CFL * (0.5*(h_L(i,j,k) - h_R(i,j,k)) + curv_3*(CFL - 1.5)) h_marg = h_R(i,j,k) + CFL * ((h_L(i,j,k) - h_R(i,j,k)) + & 3.0*curv_3*(CFL - 1.0)) elseif (v(i,J,k) < 0.0) then - if (vol_CFL) then ; CFL = (-v(i,J,k)*dt_in_T) * (US%m_to_L*G%dx_Cv(i,J) * US%L_to_m**2*US%m_to_L**2*G%IareaT(i,j+1)) + if (vol_CFL) then ; CFL = (-v(i,J,k)*dt_in_T) * (US%m_to_L*G%dx_Cv(i,J) * G%IareaT(i,j+1)) else ; CFL = -v(i,J,k) * dt_in_T * US%L_to_m*G%IdyT(i,j+1) ; endif curv_3 = h_L(i,j+1,k) + h_R(i,j+1,k) - 2.0*h(i,j+1,k) h_avg = h_L(i,j+1,k) + CFL * (0.5*(h_R(i,j+1,k)-h_L(i,j+1,k)) + curv_3*(CFL - 1.5)) @@ -1579,7 +1579,7 @@ subroutine meridional_flux_adjust(v, h_in, h_L, h_R, vhbt, vh_tot_0, dvhdv_tot_0 enddo domore = .false. do i=ish,ieh ; if (do_I(i)) then - if ((dt_in_T * min(US%L_to_m**2*US%m_to_L**2*G%IareaT(i,j),US%L_to_m**2*US%m_to_L**2*G%IareaT(i,j+1))*abs(vh_err(i)) > tol_eta) .or. & + if ((dt_in_T * min(G%IareaT(i,j),G%IareaT(i,j+1))*abs(vh_err(i)) > tol_eta) .or. & (CS%better_iter .and. ((abs(vh_err(i)) > tol_vel * dvhdv_tot(i)) .or. & (abs(vh_err(i)) > vh_err_best(i))) )) then ! Use Newton's method, provided it stays bounded. Otherwise bisect diff --git a/src/diagnostics/MOM_diagnostics.F90 b/src/diagnostics/MOM_diagnostics.F90 index 74e5e41a09..9e56e700a7 100644 --- a/src/diagnostics/MOM_diagnostics.F90 +++ b/src/diagnostics/MOM_diagnostics.F90 @@ -947,7 +947,7 @@ subroutine calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, GV, US, CS if (.not.G%symmetric) & call do_group_pass(CS%pass_KE_uv, G%domain) do j=js,je ; do i=is,ie - CS%dKE_dt(i,j,k) = GV%H_to_m * (KE_h(i,j) + 0.5 * US%L_to_m**2*US%m_to_L**2*G%IareaT(i,j) * & + CS%dKE_dt(i,j,k) = GV%H_to_m * (KE_h(i,j) + 0.5 * G%IareaT(i,j) * & (KE_u(I,j) + KE_u(I-1,j) + KE_v(i,J) + KE_v(i,J-1))) enddo ; enddo enddo @@ -965,7 +965,7 @@ subroutine calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, GV, US, CS if (.not.G%symmetric) & call do_group_pass(CS%pass_KE_uv, G%domain) do j=js,je ; do i=is,ie - CS%PE_to_KE(i,j,k) = GV%H_to_m * 0.5 * US%L_to_m**2*US%m_to_L**2*G%IareaT(i,j) * & + CS%PE_to_KE(i,j,k) = GV%H_to_m * 0.5 * G%IareaT(i,j) * & (KE_u(I,j) + KE_u(I-1,j) + KE_v(i,J) + KE_v(i,J-1)) enddo ; enddo enddo @@ -981,13 +981,13 @@ subroutine calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, GV, US, CS KE_v(i,J) = US%L_T_to_m_s**2*US%s_to_T*vh(i,J,k)*US%m_to_L*G%dyCv(i,J)*ADp%CAv(i,J,k) enddo ; enddo do j=js,je ; do i=is,ie - KE_h(i,j) = -CS%KE(i,j,k) * US%L_to_m**2*US%m_to_L**2*G%IareaT(i,j) * & + KE_h(i,j) = -CS%KE(i,j,k) * G%IareaT(i,j) * & US%s_to_T*(uh(I,j,k) - uh(I-1,j,k) + vh(i,J,k) - vh(i,J-1,k)) enddo ; enddo if (.not.G%symmetric) & call do_group_pass(CS%pass_KE_uv, G%domain) do j=js,je ; do i=is,ie - CS%KE_CorAdv(i,j,k) = GV%H_to_m * (KE_h(i,j) + 0.5 * US%L_to_m**2*US%m_to_L**2*G%IareaT(i,j) * & + CS%KE_CorAdv(i,j,k) = GV%H_to_m * (KE_h(i,j) + 0.5 * G%IareaT(i,j) * & (KE_u(I,j) + KE_u(I-1,j) + KE_v(i,J) + KE_v(i,J-1))) enddo ; enddo enddo @@ -1009,13 +1009,13 @@ subroutine calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, GV, US, CS KE_v(i,J) = US%L_T_to_m_s**2*US%s_to_T*vh(i,J,k)*US%m_to_L*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) * US%L_to_m**2*US%m_to_L**2*G%IareaT(i,j) * & + KE_h(i,j) = -CS%KE(i,j,k) * G%IareaT(i,j) * & US%s_to_T*(uh(I,j,k) - uh(I-1,j,k) + vh(i,J,k) - vh(i,J-1,k)) enddo ; enddo if (.not.G%symmetric) & call do_group_pass(CS%pass_KE_uv, G%domain) do j=js,je ; do i=is,ie - CS%KE_adv(i,j,k) = GV%H_to_m * (KE_h(i,j) + 0.5 * US%L_to_m**2*US%m_to_L**2*G%IareaT(i,j) * & + CS%KE_adv(i,j,k) = GV%H_to_m * (KE_h(i,j) + 0.5 * G%IareaT(i,j) * & (KE_u(I,j) + KE_u(I-1,j) + KE_v(i,J) + KE_v(i,J-1))) enddo ; enddo enddo @@ -1033,7 +1033,7 @@ subroutine calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, GV, US, CS if (.not.G%symmetric) & call do_group_pass(CS%pass_KE_uv, G%domain) do j=js,je ; do i=is,ie - CS%KE_visc(i,j,k) = GV%H_to_m * (0.5 * US%L_to_m**2*US%m_to_L**2*G%IareaT(i,j) * & + CS%KE_visc(i,j,k) = GV%H_to_m * (0.5 * G%IareaT(i,j) * & (KE_u(I,j) + KE_u(I-1,j) + KE_v(i,J) + KE_v(i,J-1))) enddo ; enddo enddo @@ -1051,7 +1051,7 @@ subroutine calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, GV, US, CS if (.not.G%symmetric) & call do_group_pass(CS%pass_KE_uv, G%domain) do j=js,je ; do i=is,ie - CS%KE_horvisc(i,j,k) = GV%H_to_m * 0.5 * US%L_to_m**2*US%m_to_L**2*G%IareaT(i,j) * & + CS%KE_horvisc(i,j,k) = GV%H_to_m * 0.5 * G%IareaT(i,j) * & (KE_u(I,j) + KE_u(I-1,j) + KE_v(i,J) + KE_v(i,J-1)) enddo ; enddo enddo @@ -1073,7 +1073,7 @@ subroutine calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, GV, US, CS if (.not.G%symmetric) & call do_group_pass(CS%pass_KE_uv, G%domain) do j=js,je ; do i=is,ie - CS%KE_dia(i,j,k) = KE_h(i,j) + GV%H_to_m * 0.5 * US%L_to_m**2*US%m_to_L**2*G%IareaT(i,j) * & + CS%KE_dia(i,j,k) = KE_h(i,j) + GV%H_to_m * 0.5 * G%IareaT(i,j) * & (KE_u(I,j) + KE_u(I-1,j) + KE_v(i,J) + KE_v(i,J-1)) enddo ; enddo enddo diff --git a/src/parameterizations/lateral/MOM_hor_visc.F90 b/src/parameterizations/lateral/MOM_hor_visc.F90 index f96dc7ae7f..509ce21959 100644 --- a/src/parameterizations/lateral/MOM_hor_visc.F90 +++ b/src/parameterizations/lateral/MOM_hor_visc.F90 @@ -1427,7 +1427,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, call hchksum(sh_xx_3d, "shear_xx", G%HI, haloshift=0) endif if (CS%biharmonic) call hchksum(Ah_h, "Ah_h", G%HI, haloshift=0, scale=US%s_to_T) - if (CS%biharmonic) call Bchksum(Ah_q, "Ah_q", G%HI, haloshift=0, scale=US%s_to_T) + if (CS%biharmonic) call Bchksum(Ah_q, "Ah_q", G%HI, haloshift=0, scale=US%s_to_T) endif if (CS%id_FrictWorkIntz > 0) then diff --git a/src/tracer/MOM_tracer_advect.F90 b/src/tracer/MOM_tracer_advect.F90 index 969d237ec0..af5cb3495d 100644 --- a/src/tracer/MOM_tracer_advect.F90 +++ b/src/tracer/MOM_tracer_advect.F90 @@ -643,7 +643,7 @@ subroutine advect_x(Tr, hprev, uhr, uh_neglect, OBC, domore_u, ntr, Idt, & if (associated(Tr(m)%advection_xy)) then do i=is,ie ; if (do_i(i)) then Tr(m)%advection_xy(i,j,k) = Tr(m)%advection_xy(i,j,k) - (flux_x(I,m) - flux_x(I-1,m)) * & - Idt * US%L_to_m**2*US%m_to_L**2*G%IareaT(i,j) + Idt * G%IareaT(i,j) endif ; enddo endif @@ -985,7 +985,7 @@ subroutine advect_y(Tr, hprev, vhr, vh_neglect, OBC, domore_v, ntr, Idt, & if (associated(Tr(m)%advection_xy)) then do i=is,ie ; if (do_i(i)) then Tr(m)%advection_xy(i,j,k) = Tr(m)%advection_xy(i,j,k) - (flux_y(i,m,J) - flux_y(i,m,J-1))* Idt * & - US%L_to_m**2*US%m_to_L**2*G%IareaT(i,j) + G%IareaT(i,j) endif ; enddo endif From 9b25e9e90fdddb86f53f6309f2b0f4438439e0a7 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sat, 3 Aug 2019 06:00:29 -0400 Subject: [PATCH 144/297] +Add G%US and rescale the units of G%area arrays Rescaled the units of the various G%area arrays throughout the MOM6 code to units of [L2] and added a new pointer (G%US) to a unit_scale_type to the MOM_grid_type. In addition several new unit_scale_type arguments were added to subroutines throughout the code. All answers are bitwise identical, but interfaces and a public type have changed. --- .../coupled_driver/MOM_surface_forcing.F90 | 15 +++---- config_src/coupled_driver/ocean_model_MOM.F90 | 17 ++++---- config_src/mct_driver/MOM_ocean_model.F90 | 13 +++--- config_src/mct_driver/MOM_surface_forcing.F90 | 15 +++---- config_src/mct_driver/ocn_comp_mct.F90 | 8 ++-- config_src/nuopc_driver/MOM_ocean_model.F90 | 15 +++---- .../nuopc_driver/MOM_surface_forcing.F90 | 15 +++---- config_src/nuopc_driver/mom_cap.F90 | 2 +- src/core/MOM.F90 | 6 +-- src/core/MOM_CoriolisAdv.F90 | 18 ++++----- src/core/MOM_barotropic.F90 | 8 ++-- src/core/MOM_checksum_packages.F90 | 4 +- src/core/MOM_continuity_PPM.F90 | 40 +++++++++---------- src/core/MOM_grid.F90 | 14 +++++-- src/core/MOM_open_boundary.F90 | 19 ++++----- src/diagnostics/MOM_diagnostics.F90 | 14 +++---- src/diagnostics/MOM_sum_output.F90 | 28 ++++++------- src/framework/MOM_diag_mediator.F90 | 6 +-- src/framework/MOM_diag_remap.F90 | 18 ++++----- src/framework/MOM_dyn_horgrid.F90 | 8 ++-- src/framework/MOM_spatial_means.F90 | 16 ++++---- src/ice_shelf/MOM_ice_shelf.F90 | 18 ++++----- src/ice_shelf/MOM_ice_shelf_dynamics.F90 | 32 ++++++++------- src/ice_shelf/MOM_ice_shelf_initialize.F90 | 8 ++-- src/ice_shelf/MOM_marine_ice.F90 | 12 +++--- src/ice_shelf/user_shelf_init.F90 | 4 +- .../MOM_fixed_initialization.F90 | 4 +- src/initialization/MOM_grid_initialize.F90 | 40 ++++++++++--------- .../MOM_shared_initialization.F90 | 24 +++++------ .../MOM_state_initialization.F90 | 4 +- src/parameterizations/lateral/MOM_MEKE.F90 | 16 ++++---- .../lateral/MOM_lateral_mixing_coeffs.F90 | 4 +- .../lateral/MOM_mixed_layer_restrat.F90 | 4 +- .../lateral/MOM_thickness_diffuse.F90 | 4 +- .../vertical/MOM_diabatic_aux.F90 | 12 +++--- .../vertical/MOM_set_diffusivity.F90 | 32 +++++++-------- .../vertical/MOM_vert_friction.F90 | 16 ++++---- src/tracer/MOM_OCMIP2_CFC.F90 | 2 +- src/tracer/MOM_generic_tracer.F90 | 4 +- src/tracer/MOM_offline_aux.F90 | 22 +++++----- src/tracer/MOM_offline_main.F90 | 20 +++++----- src/tracer/MOM_tracer_advect.F90 | 28 ++++++------- src/tracer/MOM_tracer_hor_diff.F90 | 18 ++++----- src/tracer/MOM_tracer_registry.F90 | 2 +- src/tracer/advection_test_tracer.F90 | 2 +- src/tracer/boundary_impulse_tracer.F90 | 2 +- src/tracer/dye_example.F90 | 2 +- src/tracer/ideal_age_example.F90 | 2 +- src/tracer/oil_tracer.F90 | 6 +-- src/tracer/pseudo_salt_tracer.F90 | 2 +- src/tracer/tracer_example.F90 | 2 +- 51 files changed, 333 insertions(+), 314 deletions(-) diff --git a/config_src/coupled_driver/MOM_surface_forcing.F90 b/config_src/coupled_driver/MOM_surface_forcing.F90 index 1dfe0662a4..9241e69ebd 100644 --- a/config_src/coupled_driver/MOM_surface_forcing.F90 +++ b/config_src/coupled_driver/MOM_surface_forcing.F90 @@ -327,7 +327,7 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, US, CS, sfc ! 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) + work_sum(i,j) = US%L_to_m**2*G%areaT(i,j) * G%mask2dT(i,j) enddo ; enddo CS%area_surf = reproducing_sum(work_sum, isr, ier, jsr, jer) endif ! endif for allocation and initialization @@ -359,7 +359,7 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, US, CS, sfc call adjust_area_mean_to_zero(fluxes%salt_flux, G, fluxes%saltFluxGlobalScl) fluxes%saltFluxGlobalAdj = 0. else - work_sum(is:ie,js:je) = G%areaT(is:ie,js:je)*fluxes%salt_flux(is:ie,js:je) + work_sum(is:ie,js:je) = US%L_to_m**2*G%areaT(is:ie,js:je)*fluxes%salt_flux(is:ie,js:je) fluxes%saltFluxGlobalAdj = reproducing_sum(work_sum(:,:), isr,ier, jsr,jer)/CS%area_surf fluxes%salt_flux(is:ie,js:je) = fluxes%salt_flux(is:ie,js:je) - fluxes%saltFluxGlobalAdj endif @@ -380,7 +380,7 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, US, CS, sfc call adjust_area_mean_to_zero(fluxes%vprec, G, fluxes%vPrecGlobalScl) fluxes%vPrecGlobalAdj = 0. else - work_sum(is:ie,js:je) = G%areaT(is:ie,js:je)*fluxes%vprec(is:ie,js:je) + work_sum(is:ie,js:je) = US%L_to_m**2*G%areaT(is:ie,js:je)*fluxes%vprec(is:ie,js:je) fluxes%vPrecGlobalAdj = reproducing_sum(work_sum(:,:), isr, ier, jsr, jer) / CS%area_surf do j=js,je ; do i=is,ie fluxes%vprec(i,j) = ( fluxes%vprec(i,j) - fluxes%vPrecGlobalAdj ) * G%mask2dT(i,j) @@ -512,7 +512,7 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, US, CS, sfc do j=js,je ; do i=is,ie net_FW(i,j) = (((fluxes%lprec(i,j) + fluxes%fprec(i,j)) + & (fluxes%lrunoff(i,j) + fluxes%frunoff(i,j))) + & - (fluxes%evap(i,j) + fluxes%vprec(i,j)) ) * G%areaT(i,j) + (fluxes%evap(i,j) + fluxes%vprec(i,j)) ) * US%L_to_m**2*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. @@ -520,15 +520,16 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, US, CS, sfc ! is constant. ! To do this correctly we will need a sea-ice melt field added to IOB. -AJA 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) * & + net_FW(i,j) = net_FW(i,j) + sign_for_net_FW_bug * US%L_to_m**2*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)) + net_FW2(i,j) = net_FW(i,j) / (US%L_to_m**2*G%areaT(i,j)) enddo ; enddo if (CS%adjust_net_fresh_water_by_scaling) then call adjust_area_mean_to_zero(net_FW2, G, fluxes%netFWGlobalScl) do j=js,je ; do i=is,ie - fluxes%vprec(i,j) = fluxes%vprec(i,j) + (net_FW2(i,j) - net_FW(i,j)/(G%areaT(i,j))) * G%mask2dT(i,j) + fluxes%vprec(i,j) = fluxes%vprec(i,j) + & + (net_FW2(i,j) - net_FW(i,j)/(US%L_to_m**2*G%areaT(i,j))) * G%mask2dT(i,j) enddo ; enddo else fluxes%netFWGlobalAdj = reproducing_sum(net_FW(:,:), isr, ier, jsr, jer) / CS%area_surf diff --git a/config_src/coupled_driver/ocean_model_MOM.F90 b/config_src/coupled_driver/ocean_model_MOM.F90 index 3aa63ab733..96366a78e9 100644 --- a/config_src/coupled_driver/ocean_model_MOM.F90 +++ b/config_src/coupled_driver/ocean_model_MOM.F90 @@ -393,7 +393,7 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, gas_fields_ocn) call extract_surface_state(OS%MOM_CSp, OS%sfc_state) - call convert_state_to_ocean_type(OS%sfc_state, Ocean_sfc, OS%grid) + call convert_state_to_ocean_type(OS%sfc_state, Ocean_sfc, OS%grid, OS%US) endif @@ -659,9 +659,9 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, time_start_upda endif ! Translate state into Ocean. -! call convert_state_to_ocean_type(OS%sfc_state, Ocean_sfc, OS%grid, & +! call convert_state_to_ocean_type(OS%sfc_state, Ocean_sfc, OS%grid, OS%US, & ! Ice_ocean_boundary%p, OS%press_to_z) - call convert_state_to_ocean_type(OS%sfc_state, Ocean_sfc, OS%grid) + call convert_state_to_ocean_type(OS%sfc_state, Ocean_sfc, OS%grid, OS%US) Time1 = OS%Time ; if (do_dyn) Time1 = OS%Time_dyn call coupler_type_send_data(Ocean_sfc%fields, Time1) @@ -817,7 +817,7 @@ end subroutine initialize_ocean_public_type !! 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) +subroutine convert_state_to_ocean_type(sfc_state, Ocean_sfc, G, US, 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), & @@ -825,6 +825,7 @@ subroutine convert_state_to_ocean_type(sfc_state, Ocean_sfc, G, patm, press_to_z !! visible ocean surface fields, whose elements !! have their data set here. type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, optional, intent(in) :: patm(:,:) !< The pressure at the ocean surface [Pa]. real, optional, intent(in) :: press_to_z !< A conversion factor between pressure and !! ocean depth in m, usually 1/(rho_0*g) [m Pa-1]. @@ -871,12 +872,12 @@ subroutine convert_state_to_ocean_type(sfc_state, Ocean_sfc, G, patm, press_to_z 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) + Ocean_sfc%area(i,j) = US%L_to_m**2*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) + Ocean_sfc%area(i,j) = US%L_to_m**2*G%areaT(i+i0,j+j0) enddo ; enddo endif @@ -938,7 +939,7 @@ subroutine ocean_model_init_sfc(OS, Ocean_sfc) call extract_surface_state(OS%MOM_CSp, OS%sfc_state) - call convert_state_to_ocean_type(OS%sfc_state, Ocean_sfc, OS%grid) + call convert_state_to_ocean_type(OS%sfc_state, Ocean_sfc, OS%grid, OS%US) end subroutine ocean_model_init_sfc @@ -1036,7 +1037,7 @@ subroutine ocean_model_data2D_get(OS, Ocean, name, array2D, isc, jsc) select case(name) case('area') - array2D(isc:,jsc:) = OS%grid%areaT(g_isc:g_iec,g_jsc:g_jec) + array2D(isc:,jsc:) = OS%US%L_to_m**2*OS%grid%areaT(g_isc:g_iec,g_jsc:g_jec) case('mask') array2D(isc:,jsc:) = OS%grid%mask2dT(g_isc:g_iec,g_jsc:g_jec) !OR same result diff --git a/config_src/mct_driver/MOM_ocean_model.F90 b/config_src/mct_driver/MOM_ocean_model.F90 index 0d5c9a7b87..c146dc5894 100644 --- a/config_src/mct_driver/MOM_ocean_model.F90 +++ b/config_src/mct_driver/MOM_ocean_model.F90 @@ -391,7 +391,7 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, gas_fields_ocn, i if (present(gas_fields_ocn)) then call extract_surface_state(OS%MOM_CSp, OS%sfc_state) - call convert_state_to_ocean_type(OS%sfc_state, Ocean_sfc, OS%grid) + call convert_state_to_ocean_type(OS%sfc_state, Ocean_sfc, OS%grid, OS%US) endif call close_param_file(param_file) @@ -575,7 +575,7 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & ! Translate state into Ocean. ! 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 convert_state_to_ocean_type(OS%sfc_state, Ocean_sfc, OS%grid, OS%US) call callTree_leave("update_ocean_model()") @@ -760,10 +760,11 @@ 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) +subroutine convert_state_to_ocean_type(state, Ocean_sfc, G, US, 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 + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, optional, intent(in) :: patm(:,:) !< Atmospheric pressure. real, optional, intent(in) :: press_to_z !< Factor to tranform atmospheric !! pressure to z? @@ -810,7 +811,7 @@ subroutine convert_state_to_ocean_type(state, Ocean_sfc, G, patm, press_to_z) 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) + Ocean_sfc%area(i,j) = US%L_to_m**2*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)) & @@ -869,7 +870,7 @@ subroutine ocean_model_init_sfc(OS, Ocean_sfc) call extract_surface_state(OS%MOM_CSp, OS%sfc_state) - call convert_state_to_ocean_type(OS%sfc_state, Ocean_sfc, OS%grid) + call convert_state_to_ocean_type(OS%sfc_state, Ocean_sfc, OS%grid, OS%US) end subroutine ocean_model_init_sfc ! @@ -968,7 +969,7 @@ subroutine ocean_model_data2D_get(OS,Ocean, name, array2D,isc,jsc) select case(name) case('area') - array2D(isc:,jsc:) = OS%grid%areaT(g_isc:g_iec,g_jsc:g_jec) + array2D(isc:,jsc:) = OS%US%L_to_m**2*OS%grid%areaT(g_isc:g_iec,g_jsc:g_jec) case('mask') array2D(isc:,jsc:) = OS%grid%mask2dT(g_isc:g_iec,g_jsc:g_jec) !OR same result diff --git a/config_src/mct_driver/MOM_surface_forcing.F90 b/config_src/mct_driver/MOM_surface_forcing.F90 index 9653a27a4b..389f504c73 100644 --- a/config_src/mct_driver/MOM_surface_forcing.F90 +++ b/config_src/mct_driver/MOM_surface_forcing.F90 @@ -317,7 +317,7 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, Time, G, US, CS, & 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) + work_sum(i,j) = US%L_to_m**2*G%areaT(i,j) * G%mask2dT(i,j) enddo; enddo CS%area_surf = reproducing_sum(work_sum, isr, ier, jsr, jer) endif ! endif for allocation and initialization @@ -349,7 +349,7 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, Time, G, US, CS, & call adjust_area_mean_to_zero(fluxes%salt_flux, G, fluxes%saltFluxGlobalScl) fluxes%saltFluxGlobalAdj = 0. else - work_sum(is:ie,js:je) = G%areaT(is:ie,js:je)*fluxes%salt_flux(is:ie,js:je) + work_sum(is:ie,js:je) = US%L_to_m**2*G%areaT(is:ie,js:je)*fluxes%salt_flux(is:ie,js:je) fluxes%saltFluxGlobalAdj = reproducing_sum(work_sum(:,:), isr,ier, jsr,jer)/CS%area_surf fluxes%salt_flux(is:ie,js:je) = fluxes%salt_flux(is:ie,js:je) - fluxes%saltFluxGlobalAdj endif @@ -370,7 +370,7 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, Time, G, US, CS, & call adjust_area_mean_to_zero(fluxes%vprec, G, fluxes%vPrecGlobalScl) fluxes%vPrecGlobalAdj = 0. else - work_sum(is:ie,js:je) = G%areaT(is:ie,js:je)*fluxes%vprec(is:ie,js:je) + work_sum(is:ie,js:je) = US%L_to_m**2*G%areaT(is:ie,js:je)*fluxes%vprec(is:ie,js:je) fluxes%vPrecGlobalAdj = reproducing_sum(work_sum(:,:), isr, ier, jsr, jer) / CS%area_surf do j=js,je ; do i=is,ie fluxes%vprec(i,j) = ( fluxes%vprec(i,j) - fluxes%vPrecGlobalAdj ) * G%mask2dT(i,j) @@ -501,7 +501,7 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, Time, G, US, CS, & do j=js,je ; do i=is,ie 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) + (fluxes%evap(i,j) + fluxes%vprec(i,j)) ) * US%L_to_m**2*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. @@ -511,16 +511,17 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, Time, G, US, CS, & ! 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) * & + net_FW(i,j) = net_FW(i,j) + US%L_to_m**2*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)) + net_FW2(i,j) = net_FW(i,j) / (US%L_to_m**2*G%areaT(i,j)) enddo; enddo if (CS%adjust_net_fresh_water_by_scaling) then call adjust_area_mean_to_zero(net_FW2, G, fluxes%netFWGlobalScl) do j=js,je ; do i=is,ie - fluxes%vprec(i,j) = fluxes%vprec(i,j) + (net_FW2(i,j) - net_FW(i,j)/(G%areaT(i,j))) * G%mask2dT(i,j) + fluxes%vprec(i,j) = fluxes%vprec(i,j) + & + (net_FW2(i,j) - net_FW(i,j)/(US%L_to_m**2*G%areaT(i,j))) * G%mask2dT(i,j) enddo; enddo else fluxes%netFWGlobalAdj = reproducing_sum(net_FW(:,:), isr, ier, jsr, jer) / CS%area_surf diff --git a/config_src/mct_driver/ocn_comp_mct.F90 b/config_src/mct_driver/ocn_comp_mct.F90 index 5698335b6f..215b0f6ac1 100644 --- a/config_src/mct_driver/ocn_comp_mct.F90 +++ b/config_src/mct_driver/ocn_comp_mct.F90 @@ -638,7 +638,7 @@ subroutine ocn_domain_mct( lsize, gsMap_ocn, dom_ocn) integer, pointer :: idata(:) integer :: i,j,k real(kind=SHR_REAL_R8), pointer :: data(:) - real(kind=SHR_REAL_R8) :: m2_to_rad2 + real(kind=SHR_REAL_R8) :: L2_to_rad2 type(ocean_grid_type), pointer :: grid => NULL() ! A pointer to a grid structure grid => glb%grid ! for convenience @@ -683,11 +683,11 @@ subroutine ocn_domain_mct( lsize, gsMap_ocn, dom_ocn) call mct_gGrid_importRattr(dom_ocn,"lat",data,lsize) k = 0 - m2_to_rad2 = 1./grid%Rad_Earth**2 + L2_to_rad2 = grid%US%L_to_m**2 / grid%Rad_Earth**2 do j = grid%jsc, grid%jec do i = grid%isc, grid%iec k = k + 1 ! Increment position within gindex - data(k) = grid%AreaT(i,j) * m2_to_rad2 + data(k) = grid%AreaT(i,j) * L2_to_rad2 enddo enddo call mct_gGrid_importRattr(dom_ocn,"area",data,lsize) @@ -745,7 +745,7 @@ subroutine ocean_model_init_sfc(OS, Ocean_sfc) call extract_surface_state(OS%MOM_CSp, OS%sfc_state) - call convert_state_to_ocean_type(OS%sfc_state, Ocean_sfc, OS%grid) + call convert_state_to_ocean_type(OS%sfc_state, Ocean_sfc, OS%grid, OS%US) end subroutine ocean_model_init_sfc diff --git a/config_src/nuopc_driver/MOM_ocean_model.F90 b/config_src/nuopc_driver/MOM_ocean_model.F90 index 05232b8d0c..f44f0a419d 100644 --- a/config_src/nuopc_driver/MOM_ocean_model.F90 +++ b/config_src/nuopc_driver/MOM_ocean_model.F90 @@ -409,7 +409,7 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, gas_fields_ocn, i call extract_surface_state(OS%MOM_CSp, OS%sfc_state) - call convert_state_to_ocean_type(OS%sfc_state, Ocean_sfc, OS%grid) + call convert_state_to_ocean_type(OS%sfc_state, Ocean_sfc, OS%grid, OS%US) endif @@ -672,7 +672,7 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & ! Translate state into Ocean. ! 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 convert_state_to_ocean_type(OS%sfc_state, Ocean_sfc, OS%grid, OS%US) call coupler_type_send_data(Ocean_sfc%fields, OS%Time) call callTree_leave("update_ocean_model()") @@ -846,7 +846,7 @@ end subroutine initialize_ocean_public_type !! 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) +subroutine convert_state_to_ocean_type(sfc_state, Ocean_sfc, G, US, 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), & @@ -854,6 +854,7 @@ subroutine convert_state_to_ocean_type(sfc_state, Ocean_sfc, G, patm, press_to_z !! visible ocean surface fields, whose elements !! have their data set here. type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type 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. @@ -900,12 +901,12 @@ subroutine convert_state_to_ocean_type(sfc_state, Ocean_sfc, G, patm, press_to_z 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) + Ocean_sfc%area(i,j) = US%L_to_m**2*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) + Ocean_sfc%area(i,j) = US%L_to_m**2*G%areaT(i+i0,j+j0) enddo ; enddo endif @@ -979,7 +980,7 @@ subroutine ocean_model_init_sfc(OS, Ocean_sfc) call extract_surface_state(OS%MOM_CSp, OS%sfc_state) - call convert_state_to_ocean_type(OS%sfc_state, Ocean_sfc, OS%grid) + call convert_state_to_ocean_type(OS%sfc_state, Ocean_sfc, OS%grid, OS%US) end subroutine ocean_model_init_sfc @@ -1077,7 +1078,7 @@ subroutine ocean_model_data2D_get(OS, Ocean, name, array2D, isc, jsc) select case(name) case('area') - array2D(isc:,jsc:) = OS%grid%areaT(g_isc:g_iec,g_jsc:g_jec) + array2D(isc:,jsc:) = OS%US%L_to_m**2*OS%grid%areaT(g_isc:g_iec,g_jsc:g_jec) case('mask') array2D(isc:,jsc:) = OS%grid%mask2dT(g_isc:g_iec,g_jsc:g_jec) !OR same result diff --git a/config_src/nuopc_driver/MOM_surface_forcing.F90 b/config_src/nuopc_driver/MOM_surface_forcing.F90 index d91a9bfdac..d4de732c7c 100644 --- a/config_src/nuopc_driver/MOM_surface_forcing.F90 +++ b/config_src/nuopc_driver/MOM_surface_forcing.F90 @@ -337,7 +337,7 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, US, CS, & ! 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) + work_sum(i,j) = US%L_to_m**2*G%areaT(i,j) * G%mask2dT(i,j) enddo ; enddo CS%area_surf = reproducing_sum(work_sum, isr, ier, jsr, jer) endif ! endif for allocation and initialization @@ -369,7 +369,7 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, US, CS, & call adjust_area_mean_to_zero(fluxes%salt_flux, G, fluxes%saltFluxGlobalScl) fluxes%saltFluxGlobalAdj = 0. else - work_sum(is:ie,js:je) = G%areaT(is:ie,js:je)*fluxes%salt_flux(is:ie,js:je) + work_sum(is:ie,js:je) = US%L_to_m**2*G%areaT(is:ie,js:je)*fluxes%salt_flux(is:ie,js:je) fluxes%saltFluxGlobalAdj = reproducing_sum(work_sum(:,:), isr,ier, jsr,jer)/CS%area_surf fluxes%salt_flux(is:ie,js:je) = fluxes%salt_flux(is:ie,js:je) - fluxes%saltFluxGlobalAdj endif @@ -390,7 +390,7 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, US, CS, & call adjust_area_mean_to_zero(fluxes%vprec, G, fluxes%vPrecGlobalScl) fluxes%vPrecGlobalAdj = 0. else - work_sum(is:ie,js:je) = G%areaT(is:ie,js:je)*fluxes%vprec(is:ie,js:je) + work_sum(is:ie,js:je) = US%L_to_m**2*G%areaT(is:ie,js:je)*fluxes%vprec(is:ie,js:je) fluxes%vPrecGlobalAdj = reproducing_sum(work_sum(:,:), isr, ier, jsr, jer) / CS%area_surf do j=js,je ; do i=is,ie fluxes%vprec(i,j) = ( fluxes%vprec(i,j) - fluxes%vPrecGlobalAdj ) * G%mask2dT(i,j) @@ -529,7 +529,7 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, US, CS, & do j=js,je ; do i=is,ie 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) + (fluxes%evap(i,j) + fluxes%vprec(i,j)) ) * US%L_to_m**2*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 @@ -540,15 +540,16 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, US, CS, & ! 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) * & + net_FW(i,j) = net_FW(i,j) + sign_for_net_FW_bug * US%L_to_m**2*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)) + net_FW2(i,j) = net_FW(i,j) / (US%L_to_m**2*G%areaT(i,j)) enddo ; enddo if (CS%adjust_net_fresh_water_by_scaling) then call adjust_area_mean_to_zero(net_FW2, G, fluxes%netFWGlobalScl) do j=js,je ; do i=is,ie - fluxes%vprec(i,j) = fluxes%vprec(i,j) + (net_FW2(i,j) - net_FW(i,j)/(G%areaT(i,j))) * G%mask2dT(i,j) + fluxes%vprec(i,j) = fluxes%vprec(i,j) + & + (net_FW2(i,j) - net_FW(i,j)/(US%L_to_m**2*G%areaT(i,j))) * G%mask2dT(i,j) enddo ; enddo else fluxes%netFWGlobalAdj = reproducing_sum(net_FW(:,:), isr, ier, jsr, jer) / CS%area_surf diff --git a/config_src/nuopc_driver/mom_cap.F90 b/config_src/nuopc_driver/mom_cap.F90 index 3992aae530..46db11ecab 100644 --- a/config_src/nuopc_driver/mom_cap.F90 +++ b/config_src/nuopc_driver/mom_cap.F90 @@ -1560,7 +1560,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) dataPtr_xcen(i1,j1) = ocean_grid%geolonT(ig,jg) dataPtr_ycen(i1,j1) = ocean_grid%geolatT(ig,jg) if(grid_attach_area) then - dataPtr_area(i1,j1) = ocean_grid%areaT(ig,jg) + dataPtr_area(i1,j1) = ocean_grid%US%L_to_m**2 * ocean_grid%areaT(ig,jg) endif enddo enddo diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index b667bcfae8..bde797c654 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -2134,7 +2134,7 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & ! (potentially static) ocean-specific grid type. ! The next line would be needed if G%Domain had not already been init'd above: ! call clone_MOM_domain(dG%Domain, G%Domain) - call MOM_grid_init(G, param_file, HI, bathymetry_at_vel=bathy_at_vel) + call MOM_grid_init(G, param_file, US, HI, bathymetry_at_vel=bathy_at_vel) call copy_dyngrid_to_MOM_grid(dG, G, US) call destroy_dyn_horgrid(dG) @@ -2163,7 +2163,7 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & call clone_MOM_domain(G%Domain, dG%Domain) call clone_MOM_domain(G%Domain, CS%G%Domain) - call MOM_grid_init(CS%G, param_file) + call MOM_grid_init(CS%G, param_file, US) call copy_MOM_grid_to_dyngrid(G, dg, US) call copy_dyngrid_to_MOM_grid(dg, CS%G, US) @@ -2208,7 +2208,7 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & ! compute fractional ice shelf coverage of h do j=jsd,jed ; do i=isd,ied if (G%areaT(i,j) > 0.0) & - frac_shelf_h(i,j) = area_shelf_h(i,j) / (G%areaT(i,j)) + frac_shelf_h(i,j) = area_shelf_h(i,j) / (US%L_to_m**2*G%areaT(i,j)) enddo ; enddo ! pass to the pointer shelf_area => frac_shelf_h diff --git a/src/core/MOM_CoriolisAdv.F90 b/src/core/MOM_CoriolisAdv.F90 index 7f901f213d..124ad3a166 100644 --- a/src/core/MOM_CoriolisAdv.F90 +++ b/src/core/MOM_CoriolisAdv.F90 @@ -224,7 +224,7 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS) !$OMP parallel do default(private) shared(Isq,Ieq,Jsq,Jeq,G,Area_h) do j=Jsq-1,Jeq+2 ; do I=Isq-1,Ieq+2 - Area_h(i,j) = G%mask2dT(i,j) * G%areaT(i,j) + Area_h(i,j) = G%mask2dT(i,j) * US%L_to_m**2*G%areaT(i,j) enddo ; enddo if (associated(OBC)) then ; do n=1,OBC%number_of_segments if (.not. OBC%segment(n)%on_pe) cycle @@ -863,10 +863,10 @@ subroutine gradKE(u, v, h, KE, KEx, KEy, k, OBC, G, US, CS) ! identified in Arakawa & Lamb 1982 as important for KE conservation. It ! also includes the possibility of partially-blocked tracer cell faces. do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - KE(i,j) = ( ( G%areaCu( I ,j)*(u( I ,j,k)*u( I ,j,k)) & - +G%areaCu(I-1,j)*(u(I-1,j,k)*u(I-1,j,k)) ) & - +( G%areaCv(i, J )*(v(i, J ,k)*v(i, J ,k)) & - +G%areaCv(i,J-1)*(v(i,J-1,k)*v(i,J-1,k)) ) & + KE(i,j) = ( ( US%L_to_m**2*G%areaCu( I ,j)*(u( I ,j,k)*u( I ,j,k)) & + +US%L_to_m**2*G%areaCu(I-1,j)*(u(I-1,j,k)*u(I-1,j,k)) ) & + +( US%L_to_m**2*G%areaCv(i, J )*(v(i, J ,k)*v(i, J ,k)) & + +US%L_to_m**2*G%areaCv(i,J-1)*(v(i,J-1,k)*v(i,J-1,k)) ) & )*0.25*US%m_to_L**2*G%IareaT(i,j) enddo ; enddo elseif (CS%KE_Scheme == KE_SIMPLE_GUDONOV) then @@ -883,10 +883,10 @@ subroutine gradKE(u, v, h, KE, KEx, KEy, k, OBC, G, US, CS) ! The following discretization of KE is based on the one-dimensinal Gudonov ! scheme but has been adapted to take horizontal grid factors into account do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - up = 0.5*( u(I-1,j,k) + ABS( u(I-1,j,k) ) ) ; up2a = up*up*G%areaCu(I-1,j) - um = 0.5*( u( I ,j,k) - ABS( u( I ,j,k) ) ) ; um2a = um*um*G%areaCu( I ,j) - vp = 0.5*( v(i,J-1,k) + ABS( v(i,J-1,k) ) ) ; vp2a = vp*vp*G%areaCv(i,J-1) - vm = 0.5*( v(i, J ,k) - ABS( v(i, J ,k) ) ) ; vm2a = vm*vm*G%areaCv(i, J ) + up = 0.5*( u(I-1,j,k) + ABS( u(I-1,j,k) ) ) ; up2a = up*up*US%L_to_m**2*G%areaCu(I-1,j) + um = 0.5*( u( I ,j,k) - ABS( u( I ,j,k) ) ) ; um2a = um*um*US%L_to_m**2*G%areaCu( I ,j) + vp = 0.5*( v(i,J-1,k) + ABS( v(i,J-1,k) ) ) ; vp2a = vp*vp*US%L_to_m**2*G%areaCv(i,J-1) + vm = 0.5*( v(i, J ,k) - ABS( v(i, J ,k) ) ) ; vm2a = vm*vm*US%L_to_m**2*G%areaCv(i, J ) KE(i,j) = ( max(um2a,up2a) + max(vm2a,vp2a) )*0.5*US%m_to_L**2*G%IareaT(i,j) enddo ; enddo endif diff --git a/src/core/MOM_barotropic.F90 b/src/core/MOM_barotropic.F90 index d98022204c..28d6913051 100644 --- a/src/core/MOM_barotropic.F90 +++ b/src/core/MOM_barotropic.F90 @@ -1546,19 +1546,19 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, do j=jsv,jev ; do I=isv-1,iev if ((ubt(I,j) * (dt_in_T * US%m_to_L*G%dy_Cu(I,j))) * G%IareaT(i+1,j) < -CS%CFL_trunc) then ! Add some error reporting later. - 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))) + ubt(I,j) = (-0.95*CS%CFL_trunc) * (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))) * G%IareaT(i,j) > CS%CFL_trunc) then ! Add some error reporting later. - 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))) + ubt(I,j) = (0.95*CS%CFL_trunc) * (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_in_T * US%m_to_L*G%dx_Cv(i,J))) * G%IareaT(i,j+1) < -CS%CFL_trunc) then ! Add some error reporting later. - 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))) + vbt(i,J) = (-0.9*CS%CFL_trunc) * (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))) * G%IareaT(i,j) > CS%CFL_trunc) then ! Add some error reporting later. - 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))) + vbt(i,J) = (0.9*CS%CFL_trunc) * (G%areaT(i,j) / (dt_in_T * US%m_to_L*G%dx_Cv(i,J))) endif enddo ; enddo endif diff --git a/src/core/MOM_checksum_packages.F90 b/src/core/MOM_checksum_packages.F90 index 195b4061d7..68ad6d3888 100644 --- a/src/core/MOM_checksum_packages.F90 +++ b/src/core/MOM_checksum_packages.F90 @@ -252,14 +252,14 @@ subroutine MOM_state_stats(mesg, u, v, h, Temp, Salt, G, allowChange, permitDimi ! First collect local stats Area = 0. ; Vol = 0. do j = js, je ; do i = is, ie - Area = Area + G%areaT(i,j) + Area = Area + G%US%L_to_m**2*G%areaT(i,j) enddo ; enddo T%minimum = 1.E34 ; T%maximum = -1.E34 ; T%average = 0. S%minimum = 1.E34 ; S%maximum = -1.E34 ; S%average = 0. h_minimum = 1.E34 do k = 1, nz ; do j = js, je ; do i = is, ie if (G%mask2dT(i,j)>0.) then - dV = G%areaT(i,j)*h(i,j,k) ; Vol = Vol + dV + dV = G%US%L_to_m**2*G%areaT(i,j)*h(i,j,k) ; Vol = Vol + dV if (do_TS .and. h(i,j,k)>0.) then T%minimum = min( T%minimum, Temp(i,j,k) ) ; T%maximum = max( T%maximum, Temp(i,j,k) ) T%average = T%average + dV*Temp(i,j,k) diff --git a/src/core/MOM_continuity_PPM.F90 b/src/core/MOM_continuity_PPM.F90 index e9e55d9c4c..e03e82e265 100644 --- a/src/core/MOM_continuity_PPM.F90 +++ b/src/core/MOM_continuity_PPM.F90 @@ -335,8 +335,8 @@ subroutine zonal_mass_flux(u, h_in, uh, dt_in_T, G, GV, US, CS, LB, uhbt, OBC, & I_vrm = 0.0 if (visc_rem_max(I) > 0.0) I_vrm = 1.0 / visc_rem_max(I) if (CS%vol_CFL) then - dx_W = US%m_to_L*ratio_max(G%areaT(i,j), G%dy_Cu(I,j), 1000.0*G%dxT(i,j)) - dx_E = US%m_to_L*ratio_max(G%areaT(i+1,j), G%dy_Cu(I,j), 1000.0*G%dxT(i+1,j)) + dx_W = US%m_to_L*ratio_max(US%L_to_m**2*G%areaT(i,j), G%dy_Cu(I,j), 1000.0*G%dxT(i,j)) + dx_E = US%m_to_L*ratio_max(US%L_to_m**2*G%areaT(i+1,j), G%dy_Cu(I,j), 1000.0*G%dxT(i+1,j)) else ; dx_W = US%m_to_L*G%dxT(i,j) ; dx_E = US%m_to_L*G%dxT(i+1,j) ; endif du_max_CFL(I) = 2.0* (CFL_dt * dx_W) * I_vrm du_min_CFL(I) = -2.0 * (CFL_dt * dx_E) * I_vrm @@ -350,8 +350,8 @@ subroutine zonal_mass_flux(u, h_in, uh, dt_in_T, G, GV, US, CS, LB, uhbt, OBC, & if (CS%aggress_adjust) then do k=1,nz ; do I=ish-1,ieh if (CS%vol_CFL) then - dx_W = US%m_to_L*ratio_max(G%areaT(i,j), G%dy_Cu(I,j), 1000.0*G%dxT(i,j)) - dx_E = US%m_to_L*ratio_max(G%areaT(i+1,j), G%dy_Cu(I,j), 1000.0*G%dxT(i+1,j)) + dx_W = US%m_to_L*ratio_max(US%L_to_m**2*G%areaT(i,j), G%dy_Cu(I,j), 1000.0*G%dxT(i,j)) + dx_E = US%m_to_L*ratio_max(US%L_to_m**2*G%areaT(i+1,j), G%dy_Cu(I,j), 1000.0*G%dxT(i+1,j)) else ; dx_W = US%m_to_L*G%dxT(i,j) ; dx_E = US%m_to_L*G%dxT(i+1,j) ; endif du_lim = 0.499*((dx_W*I_dt - u(I,j,k)) + MIN(0.0,u(I-1,j,k))) @@ -365,8 +365,8 @@ subroutine zonal_mass_flux(u, h_in, uh, dt_in_T, G, GV, US, CS, LB, uhbt, OBC, & else do k=1,nz ; do I=ish-1,ieh if (CS%vol_CFL) then - dx_W = US%m_to_L*ratio_max(G%areaT(i,j), G%dy_Cu(I,j), 1000.0*G%dxT(i,j)) - dx_E = US%m_to_L*ratio_max(G%areaT(i+1,j), G%dy_Cu(I,j), 1000.0*G%dxT(i+1,j)) + dx_W = US%m_to_L*ratio_max(US%L_to_m**2*G%areaT(i,j), G%dy_Cu(I,j), 1000.0*G%dxT(i,j)) + dx_E = US%m_to_L*ratio_max(US%L_to_m**2*G%areaT(i+1,j), G%dy_Cu(I,j), 1000.0*G%dxT(i+1,j)) else ; dx_W = US%m_to_L*G%dxT(i,j) ; dx_E = US%m_to_L*G%dxT(i+1,j) ; endif if (du_max_CFL(I) * visc_rem(I,k) > dx_W*CFL_dt - u(I,j,k)) & @@ -379,8 +379,8 @@ subroutine zonal_mass_flux(u, h_in, uh, dt_in_T, G, GV, US, CS, LB, uhbt, OBC, & if (CS%aggress_adjust) then do k=1,nz ; do I=ish-1,ieh if (CS%vol_CFL) then - dx_W = US%m_to_L*ratio_max(G%areaT(i,j), G%dy_Cu(I,j), 1000.0*G%dxT(i,j)) - dx_E = US%m_to_L*ratio_max(G%areaT(i+1,j), G%dy_Cu(I,j), 1000.0*G%dxT(i+1,j)) + dx_W = US%m_to_L*ratio_max(US%L_to_m**2*G%areaT(i,j), G%dy_Cu(I,j), 1000.0*G%dxT(i,j)) + dx_E = US%m_to_L*ratio_max(US%L_to_m**2*G%areaT(i+1,j), G%dy_Cu(I,j), 1000.0*G%dxT(i+1,j)) else ; dx_W = US%m_to_L*G%dxT(i,j) ; dx_E = US%m_to_L*G%dxT(i+1,j) ; endif du_max_CFL(I) = MIN(du_max_CFL(I), 0.499 * & @@ -391,8 +391,8 @@ subroutine zonal_mass_flux(u, h_in, uh, dt_in_T, G, GV, US, CS, LB, uhbt, OBC, & else do k=1,nz ; do I=ish-1,ieh if (CS%vol_CFL) then - dx_W = US%m_to_L*ratio_max(G%areaT(i,j), G%dy_Cu(I,j), 1000.0*G%dxT(i,j)) - dx_E = US%m_to_L*ratio_max(G%areaT(i+1,j), G%dy_Cu(I,j), 1000.0*G%dxT(i+1,j)) + dx_W = US%m_to_L*ratio_max(US%L_to_m**2*G%areaT(i,j), G%dy_Cu(I,j), 1000.0*G%dxT(i,j)) + dx_E = US%m_to_L*ratio_max(US%L_to_m**2*G%areaT(i+1,j), G%dy_Cu(I,j), 1000.0*G%dxT(i+1,j)) else ; dx_W = US%m_to_L*G%dxT(i,j) ; dx_E = US%m_to_L*G%dxT(i+1,j) ; endif du_max_CFL(I) = MIN(du_max_CFL(I), dx_W*CFL_dt - u(I,j,k)) @@ -1134,8 +1134,8 @@ subroutine meridional_mass_flux(v, h_in, vh, dt_in_T, G, GV, US, CS, LB, vhbt, O I_vrm = 0.0 if (visc_rem_max(i) > 0.0) I_vrm = 1.0 / visc_rem_max(i) if (CS%vol_CFL) then - dy_S = US%m_to_L*ratio_max(G%areaT(i,j), G%dx_Cv(i,J), 1000.0*G%dyT(i,j)) - dy_N = US%m_to_L*ratio_max(G%areaT(i,j+1), G%dx_Cv(i,J), 1000.0*G%dyT(i,j+1)) + dy_S = US%m_to_L*ratio_max(US%L_to_m**2*G%areaT(i,j), G%dx_Cv(i,J), 1000.0*G%dyT(i,j)) + dy_N = US%m_to_L*ratio_max(US%L_to_m**2*G%areaT(i,j+1), G%dx_Cv(i,J), 1000.0*G%dyT(i,j+1)) else ; dy_S = US%m_to_L*G%dyT(i,j) ; dy_N = US%m_to_L*G%dyT(i,j+1) ; endif dv_max_CFL(i) = 2.0 * (CFL_dt * dy_S) * I_vrm dv_min_CFL(i) = -2.0 * (CFL_dt * dy_N) * I_vrm @@ -1150,8 +1150,8 @@ subroutine meridional_mass_flux(v, h_in, vh, dt_in_T, G, GV, US, CS, LB, vhbt, O if (CS%aggress_adjust) then do k=1,nz ; do i=ish,ieh if (CS%vol_CFL) then - dy_S = US%m_to_L*ratio_max(G%areaT(i,j), G%dx_Cv(I,j), 1000.0*G%dyT(i,j)) - dy_N = US%m_to_L*ratio_max(G%areaT(i,j+1), G%dx_Cv(I,j), 1000.0*G%dyT(i,j+1)) + dy_S = US%m_to_L*ratio_max(US%L_to_m**2*G%areaT(i,j), G%dx_Cv(I,j), 1000.0*G%dyT(i,j)) + dy_N = US%m_to_L*ratio_max(US%L_to_m**2*G%areaT(i,j+1), G%dx_Cv(I,j), 1000.0*G%dyT(i,j+1)) else ; dy_S = US%m_to_L*G%dyT(i,j) ; dy_N = US%m_to_L*G%dyT(i,j+1) ; endif dv_lim = 0.499*((dy_S*I_dt - v(i,J,k)) + MIN(0.0,v(i,J-1,k))) if (dv_max_CFL(i) * visc_rem(i,k) > dv_lim) & @@ -1164,8 +1164,8 @@ subroutine meridional_mass_flux(v, h_in, vh, dt_in_T, G, GV, US, CS, LB, vhbt, O else do k=1,nz ; do i=ish,ieh if (CS%vol_CFL) then - dy_S = US%m_to_L*ratio_max(G%areaT(i,j), G%dx_Cv(I,j), 1000.0*G%dyT(i,j)) - dy_N = US%m_to_L*ratio_max(G%areaT(i,j+1), G%dx_Cv(I,j), 1000.0*G%dyT(i,j+1)) + dy_S = US%m_to_L*ratio_max(US%L_to_m**2*G%areaT(i,j), G%dx_Cv(I,j), 1000.0*G%dyT(i,j)) + dy_N = US%m_to_L*ratio_max(US%L_to_m**2*G%areaT(i,j+1), G%dx_Cv(I,j), 1000.0*G%dyT(i,j+1)) else ; dy_S = US%m_to_L*G%dyT(i,j) ; dy_N = US%m_to_L*G%dyT(i,j+1) ; endif if (dv_max_CFL(i) * visc_rem(i,k) > dy_S*CFL_dt - v(i,J,k)) & dv_max_CFL(i) = (dy_S*CFL_dt - v(i,J,k)) / visc_rem(i,k) @@ -1177,8 +1177,8 @@ subroutine meridional_mass_flux(v, h_in, vh, dt_in_T, G, GV, US, CS, LB, vhbt, O if (CS%aggress_adjust) then do k=1,nz ; do i=ish,ieh if (CS%vol_CFL) then - dy_S = US%m_to_L*ratio_max(G%areaT(i,j), G%dx_Cv(I,j), 1000.0*G%dyT(i,j)) - dy_N = US%m_to_L*ratio_max(G%areaT(i,j+1), G%dx_Cv(I,j), 1000.0*G%dyT(i,j+1)) + dy_S = US%m_to_L*ratio_max(US%L_to_m**2*G%areaT(i,j), G%dx_Cv(I,j), 1000.0*G%dyT(i,j)) + dy_N = US%m_to_L*ratio_max(US%L_to_m**2*G%areaT(i,j+1), G%dx_Cv(I,j), 1000.0*G%dyT(i,j+1)) else ; dy_S = US%m_to_L*G%dyT(i,j) ; dy_N = US%m_to_L*G%dyT(i,j+1) ; endif dv_max_CFL(i) = min(dv_max_CFL(i), 0.499 * & ((dy_S*I_dt - v(i,J,k)) + MIN(0.0,v(i,J-1,k))) ) @@ -1188,8 +1188,8 @@ subroutine meridional_mass_flux(v, h_in, vh, dt_in_T, G, GV, US, CS, LB, vhbt, O else do k=1,nz ; do i=ish,ieh if (CS%vol_CFL) then - dy_S = US%m_to_L*ratio_max(G%areaT(i,j), G%dx_Cv(I,j), 1000.0*G%dyT(i,j)) - dy_N = US%m_to_L*ratio_max(G%areaT(i,j+1), G%dx_Cv(I,j), 1000.0*G%dyT(i,j+1)) + dy_S = US%m_to_L*ratio_max(US%L_to_m**2*G%areaT(i,j), G%dx_Cv(I,j), 1000.0*G%dyT(i,j)) + dy_N = US%m_to_L*ratio_max(US%L_to_m**2*G%areaT(i,j+1), G%dx_Cv(I,j), 1000.0*G%dyT(i,j+1)) else ; dy_S = US%m_to_L*G%dyT(i,j) ; dy_N = US%m_to_L*G%dyT(i,j+1) ; endif dv_max_CFL(i) = min(dv_max_CFL(i), dy_S*CFL_dt - v(i,J,k)) dv_min_CFL(i) = max(dv_min_CFL(i), -(dy_N*CFL_dt + v(i,J,k))) diff --git a/src/core/MOM_grid.F90 b/src/core/MOM_grid.F90 index 0679c23efa..04da9abfb8 100644 --- a/src/core/MOM_grid.F90 +++ b/src/core/MOM_grid.F90 @@ -160,6 +160,9 @@ module MOM_grid real :: areaT_global !< Global sum of h-cell area [m2] real :: IareaT_global !< Global sum of inverse h-cell area (1/areaT_global) [m-2]. + type(unit_scale_type), pointer :: US => NULL() !< A dimensional unit scaling type + + ! These variables are for block structures. integer :: nblocks !< The number of sub-PE blocks on this PE type(hor_index_type), pointer :: Block(:) => NULL() !< Index ranges for each block @@ -177,9 +180,10 @@ module MOM_grid contains !> MOM_grid_init initializes the ocean grid array sizes and grid memory. -subroutine MOM_grid_init(G, param_file, HI, global_indexing, bathymetry_at_vel) +subroutine MOM_grid_init(G, param_file, US, HI, global_indexing, bathymetry_at_vel) type(ocean_grid_type), intent(inout) :: G !< The horizontal grid type type(param_file_type), intent(in) :: param_file !< Parameter file handle + type(unit_scale_type), optional, pointer :: US !< A dimensional unit scaling type type(hor_index_type), & optional, intent(in) :: HI !< A hor_index_type for array extents logical, optional, intent(in) :: global_indexing !< If true use global index @@ -215,6 +219,8 @@ subroutine MOM_grid_init(G, param_file, HI, global_indexing, bathymetry_at_vel) "in the y-direction on each processor (for openmp).", default=1, & layoutParam=.true.) + if (present(US)) then ; if (associated(US)) G%US => US ; endif + if (present(HI)) then G%HI = HI @@ -419,7 +425,7 @@ subroutine set_derived_metrics(G, US) if (G%dyT(i,j) < 0.0) G%dyT(i,j) = 0.0 G%IdxT(i,j) = Adcroft_reciprocal(G%dxT(i,j)) G%IdyT(i,j) = Adcroft_reciprocal(G%dyT(i,j)) - G%IareaT(i,j) = Adcroft_reciprocal(US%m_to_L**2*G%areaT(i,j)) + G%IareaT(i,j) = Adcroft_reciprocal(US%m_to_L**2*US%L_to_m**2*G%areaT(i,j)) enddo ; enddo do j=jsd,jed ; do I=IsdB,IedB @@ -443,8 +449,8 @@ subroutine set_derived_metrics(G, US) G%IdxBu(I,J) = Adcroft_reciprocal(G%dxBu(I,J)) G%IdyBu(I,J) = Adcroft_reciprocal(G%dyBu(I,J)) ! areaBu has usually been set to a positive area elsewhere. - if (G%areaBu(I,J) <= 0.0) G%areaBu(I,J) = G%dxBu(I,J) * G%dyBu(I,J) - G%IareaBu(I,J) = Adcroft_reciprocal(US%m_to_L**2*G%areaBu(I,J)) + if (G%areaBu(I,J) <= 0.0) G%areaBu(I,J) = US%m_to_L**2*G%dxBu(I,J) * G%dyBu(I,J) + G%IareaBu(I,J) = Adcroft_reciprocal(US%m_to_L**2*US%L_to_m**2*G%areaBu(I,J)) enddo ; enddo end subroutine set_derived_metrics diff --git a/src/core/MOM_open_boundary.F90 b/src/core/MOM_open_boundary.F90 index 70f3508206..7935d3a529 100644 --- a/src/core/MOM_open_boundary.F90 +++ b/src/core/MOM_open_boundary.F90 @@ -1410,11 +1410,12 @@ end subroutine open_boundary_impose_normal_slope !> Reconcile masks and open boundaries, deallocate OBC on PEs where it is not needed. !! Also adjust u- and v-point cell area on specified open boundaries and mask all !! points outside open boundaries. -subroutine open_boundary_impose_land_mask(OBC, G, areaCu, areaCv) +subroutine open_boundary_impose_land_mask(OBC, G, areaCu, areaCv, US) type(ocean_OBC_type), pointer :: OBC !< Open boundary control structure - type(dyn_horgrid_type), intent(inout) :: G !< Ocean grid structure - real, dimension(SZIB_(G),SZJ_(G)), intent(inout) :: areaCu !< Area of a u-cell [m2] - real, dimension(SZI_(G),SZJB_(G)), intent(inout) :: areaCv !< Area of a u-cell [m2] + type(dyn_horgrid_type), intent(inout) :: G !< Ocean grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + real, dimension(SZIB_(G),SZJ_(G)), intent(inout) :: areaCu !< Area of a u-cell [L2 ~> m2] + real, dimension(SZI_(G),SZJB_(G)), intent(inout) :: areaCv !< Area of a u-cell [L2 ~> m2] ! Local variables integer :: i, j, n type(OBC_segment_type), pointer :: segment => NULL() @@ -1473,9 +1474,9 @@ subroutine open_boundary_impose_land_mask(OBC, G, areaCu, areaCv) I=segment%HI%IsdB do j=segment%HI%jsd,segment%HI%jed if (segment%direction == OBC_DIRECTION_E) then - areaCu(I,j) = G%areaT(i,j) - else ! West - areaCu(I,j) = G%areaT(i+1,j) + areaCu(I,j) = G%areaT(i,j) ! Both of these are in [L2] + else ! West + areaCu(I,j) = G%areaT(i+1,j) ! Both of these are in [L2] endif enddo else @@ -1483,9 +1484,9 @@ subroutine open_boundary_impose_land_mask(OBC, G, areaCu, areaCv) J=segment%HI%JsdB do i=segment%HI%isd,segment%HI%ied if (segment%direction == OBC_DIRECTION_S) then - areaCv(i,J) = G%areaT(i,j+1) + areaCv(i,J) = G%areaT(i,j+1) ! Both of these are in [L2] else ! North - areaCu(i,J) = G%areaT(i,j) + areaCu(i,J) = G%areaT(i,j) ! Both of these are in [L2] endif enddo endif diff --git a/src/diagnostics/MOM_diagnostics.F90 b/src/diagnostics/MOM_diagnostics.F90 index 9e56e700a7..0e099cb079 100644 --- a/src/diagnostics/MOM_diagnostics.F90 +++ b/src/diagnostics/MOM_diagnostics.F90 @@ -320,7 +320,7 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & if (CS%id_masso > 0) then work_2d(:,:) = 0.0 do k=1,nz ; do j=js,je ; do i=is,ie - work_2d(i,j) = work_2d(i,j) + (GV%H_to_kg_m2*h(i,j,k)) * G%areaT(i,j) + work_2d(i,j) = work_2d(i,j) + (GV%H_to_kg_m2*h(i,j,k)) * US%L_to_m**2*G%areaT(i,j) enddo ; enddo ; enddo masso = reproducing_sum(work_2d) call post_data(CS%id_masso, masso, CS%diag) @@ -339,7 +339,7 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & endif ; endif if (CS%id_volcello > 0) then ! volcello = h*area for Boussinesq do k=1,nz; do j=js,je ; do i=is,ie - work_3d(i,j,k) = ( GV%H_to_m*h(i,j,k) ) * G%areaT(i,j) + work_3d(i,j,k) = ( GV%H_to_m*h(i,j,k) ) * US%L_to_m**2*G%areaT(i,j) enddo ; enddo ; enddo call post_data(CS%id_volcello, work_3d, CS%diag) endif @@ -372,7 +372,7 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & if (CS%id_thkcello > 0) call post_data(CS%id_thkcello, work_3d, CS%diag) if (CS%id_volcello > 0) then do k=1,nz; do j=js,je ; do i=is,ie ! volcello = dp/(rho*g)*area for non-Boussinesq - work_3d(i,j,k) = G%areaT(i,j) * work_3d(i,j,k) + work_3d(i,j,k) = US%L_to_m**2*G%areaT(i,j) * work_3d(i,j,k) enddo ; enddo ; enddo call post_data(CS%id_volcello, work_3d, CS%diag) endif @@ -1883,7 +1883,7 @@ subroutine write_static_fields(G, GV, US, tv, diag) if (id > 0) call post_data(id, G%geoLonCu, diag, .true.) id = register_static_field('ocean_model', 'area_t', diag%axesT1, & - 'Surface area of tracer (T) cells', 'm2', & + 'Surface area of tracer (T) cells', 'm2', conversion=US%m_to_L**2, & cmor_field_name='areacello', cmor_standard_name='cell_area', & cmor_long_name='Ocean Grid-Cell Area', & x_cell_method='sum', y_cell_method='sum', area_cell_method='sum') @@ -1893,21 +1893,21 @@ subroutine write_static_fields(G, GV, US, tv, diag) endif id = register_static_field('ocean_model', 'area_u', diag%axesCu1, & - 'Surface area of x-direction flow (U) cells', 'm2', & + 'Surface area of x-direction flow (U) cells', 'm2', conversion=US%m_to_L**2, & cmor_field_name='areacello_cu', cmor_standard_name='cell_area', & cmor_long_name='Ocean Grid-Cell Area', & x_cell_method='sum', y_cell_method='sum', area_cell_method='sum') if (id > 0) call post_data(id, G%areaCu, diag, .true.) id = register_static_field('ocean_model', 'area_v', diag%axesCv1, & - 'Surface area of y-direction flow (V) cells', 'm2', & + 'Surface area of y-direction flow (V) cells', 'm2', conversion=US%m_to_L**2, & cmor_field_name='areacello_cv', cmor_standard_name='cell_area', & cmor_long_name='Ocean Grid-Cell Area', & x_cell_method='sum', y_cell_method='sum', area_cell_method='sum') if (id > 0) call post_data(id, G%areaCv, diag, .true.) id = register_static_field('ocean_model', 'area_q', diag%axesB1, & - 'Surface area of B-grid flow (Q) cells', 'm2', & + 'Surface area of B-grid flow (Q) cells', 'm2', conversion=US%m_to_L**2, & cmor_field_name='areacello_bu', cmor_standard_name='cell_area', & cmor_long_name='Ocean Grid-Cell Area', & x_cell_method='sum', y_cell_method='sum', area_cell_method='sum') diff --git a/src/diagnostics/MOM_sum_output.F90 b/src/diagnostics/MOM_sum_output.F90 index c30dd3d52b..5a6041def3 100644 --- a/src/diagnostics/MOM_sum_output.F90 +++ b/src/diagnostics/MOM_sum_output.F90 @@ -483,7 +483,7 @@ subroutine write_energy(u, v, h, tv, day, n, G, GV, US, CS, tracer_CSp, OBC, dt_ "write_energy: Module must be initialized before it is used.") do j=js,je ; do i=is,ie - areaTm(i,j) = G%mask2dT(i,j)*G%areaT(i,j) + areaTm(i,j) = G%mask2dT(i,j)*US%L_to_m**2*G%areaT(i,j) enddo ; enddo if (GV%Boussinesq) then @@ -972,7 +972,7 @@ subroutine accumulate_net_input(fluxes, sfc_state, dt, G, CS) if (associated(fluxes%evap)) then if (associated(fluxes%lprec) .and. associated(fluxes%fprec)) then do j=js,je ; do i=is,ie - FW_in(i,j) = dt*G%areaT(i,j)*(fluxes%evap(i,j) + & + FW_in(i,j) = dt*G%US%L_to_m**2*G%areaT(i,j)*(fluxes%evap(i,j) + & (((fluxes%lprec(i,j) + fluxes%vprec(i,j)) + fluxes%lrunoff(i,j)) + & (fluxes%fprec(i,j) + fluxes%frunoff(i,j)))) enddo ; enddo @@ -983,25 +983,25 @@ subroutine accumulate_net_input(fluxes, sfc_state, dt, G, CS) endif if (associated(fluxes%seaice_melt)) then ; do j=js,je ; do i=is,ie - FW_in(i,j) = FW_in(i,j) + dt * G%areaT(i,j) * fluxes%seaice_melt(i,j) + FW_in(i,j) = FW_in(i,j) + dt * G%US%L_to_m**2*G%areaT(i,j) * fluxes%seaice_melt(i,j) enddo ; enddo ; endif salt_in(:,:) = 0.0 ; heat_in(:,:) = 0.0 if (CS%use_temperature) then if (associated(fluxes%sw)) then ; do j=js,je ; do i=is,ie - heat_in(i,j) = heat_in(i,j) + dt*G%areaT(i,j) * (fluxes%sw(i,j) + & + heat_in(i,j) = heat_in(i,j) + dt*G%US%L_to_m**2*G%areaT(i,j) * (fluxes%sw(i,j) + & (fluxes%lw(i,j) + (fluxes%latent(i,j) + fluxes%sens(i,j)))) enddo ; enddo ; endif if (associated(fluxes%seaice_melt_heat)) then ; do j=js,je ; do i=is,ie - heat_in(i,j) = heat_in(i,j) + dt*G%areaT(i,j) * fluxes%seaice_melt_heat(i,j) + heat_in(i,j) = heat_in(i,j) + dt*G%US%L_to_m**2*G%areaT(i,j) * fluxes%seaice_melt_heat(i,j) enddo ; enddo ; endif ! smg: new code ! include heat content from water transport across ocean surface ! if (associated(fluxes%heat_content_lprec)) then ; do j=js,je ; do i=is,ie -! heat_in(i,j) = heat_in(i,j) + dt*G%areaT(i,j) * & +! heat_in(i,j) = heat_in(i,j) + dt*G%US%L_to_m**2*G%areaT(i,j) * & ! (fluxes%heat_content_lprec(i,j) + (fluxes%heat_content_fprec(i,j) & ! + (fluxes%heat_content_lrunoff(i,j) + (fluxes%heat_content_frunoff(i,j) & ! + (fluxes%heat_content_cond(i,j) + (fluxes%heat_content_vprec(i,j) & @@ -1011,7 +1011,7 @@ subroutine accumulate_net_input(fluxes, sfc_state, dt, G, CS) ! smg: old code if (associated(sfc_state%TempxPmE)) then do j=js,je ; do i=is,ie - heat_in(i,j) = heat_in(i,j) + (C_p * G%areaT(i,j)) * sfc_state%TempxPmE(i,j) + heat_in(i,j) = heat_in(i,j) + (C_p * G%US%L_to_m**2*G%areaT(i,j)) * sfc_state%TempxPmE(i,j) enddo ; enddo elseif (associated(fluxes%evap)) then do j=js,je ; do i=is,ie @@ -1023,23 +1023,23 @@ subroutine accumulate_net_input(fluxes, sfc_state, dt, G, CS) ! The following heat sources may or may not be used. if (associated(sfc_state%internal_heat)) then do j=js,je ; do i=is,ie - heat_in(i,j) = heat_in(i,j) + (C_p * G%areaT(i,j)) * & + heat_in(i,j) = heat_in(i,j) + (C_p * G%US%L_to_m**2*G%areaT(i,j)) * & sfc_state%internal_heat(i,j) enddo ; enddo endif if (associated(sfc_state%frazil)) then ; do j=js,je ; do i=is,ie - heat_in(i,j) = heat_in(i,j) + G%areaT(i,j) * sfc_state%frazil(i,j) + heat_in(i,j) = heat_in(i,j) + G%US%L_to_m**2*G%areaT(i,j) * sfc_state%frazil(i,j) enddo ; enddo ; endif if (associated(fluxes%heat_added)) then ; do j=js,je ; do i=is,ie - heat_in(i,j) = heat_in(i,j) + dt*G%areaT(i,j)*fluxes%heat_added(i,j) + heat_in(i,j) = heat_in(i,j) + dt*G%US%L_to_m**2*G%areaT(i,j)*fluxes%heat_added(i,j) enddo ; enddo ; endif ! if (associated(sfc_state%sw_lost)) then ; do j=js,je ; do i=is,ie -! heat_in(i,j) = heat_in(i,j) - G%areaT(i,j) * sfc_state%sw_lost(i,j) +! heat_in(i,j) = heat_in(i,j) - G%US%L_to_m**2*G%areaT(i,j) * sfc_state%sw_lost(i,j) ! enddo ; enddo ; endif if (associated(fluxes%salt_flux)) then ; do j=js,je ; do i=is,ie ! convert salt_flux from kg (salt)/(m^2 s) to ppt * [m s-1]. - salt_in(i,j) = dt*G%areaT(i,j)*(1000.0*fluxes%salt_flux(i,j)) + salt_in(i,j) = dt*G%US%L_to_m**2*G%areaT(i,j)*(1000.0*fluxes%salt_flux(i,j)) enddo ; enddo ; endif endif @@ -1128,7 +1128,7 @@ subroutine create_depth_list(G, CS) list_pos = (j_global-1)*G%Domain%niglobal + i_global Dlist(list_pos) = G%bathyT(i,j) - Arealist(list_pos) = G%mask2dT(i,j) * G%areaT(i,j) + Arealist(list_pos) = G%mask2dT(i,j) * G%US%L_to_m**2*G%areaT(i,j) enddo ; enddo ! These sums reproduce across PEs because the arrays are only nonzero on one PE. @@ -1488,7 +1488,7 @@ subroutine get_depth_list_checksums(G, depth_chksum, area_chksum) ! Area checksum do j=G%jsc,G%jec ; do i=G%isc,G%iec - field(i,j) = G%mask2dT(i,j) * G%areaT(i,j) + field(i,j) = G%mask2dT(i,j) * G%US%L_to_m**2*G%areaT(i,j) enddo ; enddo write(area_chksum, '(Z16)') mpp_chksum(field(:,:)) diff --git a/src/framework/MOM_diag_mediator.F90 b/src/framework/MOM_diag_mediator.F90 index 9320f503b5..4a8091752a 100644 --- a/src/framework/MOM_diag_mediator.F90 +++ b/src/framework/MOM_diag_mediator.F90 @@ -3868,7 +3868,7 @@ subroutine downsample_field_3d(field_in, field_out, dl, method, mask, diag_cs, d total_weight = 0.0 do jj=j0,j0+dl-1 ; do ii=i0,i0+dl-1 ! do ii=i0,i0+dl-1 ; do jj=j0,j0+dl-1 !This seems to be faster!!!! - weight = mask(ii,jj,k)*diag_cs%G%areaT(ii,jj)*diag_cs%h(ii,jj,k) + weight = mask(ii,jj,k)*diag_cs%G%US%L_to_m**2*diag_cs%G%areaT(ii,jj)*diag_cs%h(ii,jj,k) total_weight = total_weight + weight ave=ave+field_in(ii,jj,k)*weight enddo; enddo @@ -3896,7 +3896,7 @@ subroutine downsample_field_3d(field_in, field_out, dl, method, mask, diag_cs, d total_weight = 0.0 do jj=j0,j0+dl-1 ; do ii=i0,i0+dl-1 ! do ii=i0,i0+dl-1 ; do jj=j0,j0+dl-1 - weight = mask(ii,jj,k)*diag_cs%G%areaT(ii,jj) + weight = mask(ii,jj,k)*diag_cs%G%US%L_to_m**2*diag_cs%G%areaT(ii,jj) total_weight = total_weight + weight ave=ave+field_in(ii,jj,k)*weight enddo; enddo @@ -4037,7 +4037,7 @@ subroutine downsample_field_2d(field_in, field_out, dl, method, mask, diag_cs, d total_weight = 0.0 do jj=j0,j0+dl-1 ; do ii=i0,i0+dl-1 ! do ii=i0,i0+dl-1 ; do jj=j0,j0+dl-1 - weight = mask(ii,jj)*diag_cs%G%areaT(ii,jj) + weight = mask(ii,jj)*diag_cs%G%US%L_to_m**2*diag_cs%G%areaT(ii,jj) total_weight = total_weight + weight ave=ave+field_in(ii,jj)*weight enddo; enddo diff --git a/src/framework/MOM_diag_remap.F90 b/src/framework/MOM_diag_remap.F90 index 6640a4b15a..8f1d309b06 100644 --- a/src/framework/MOM_diag_remap.F90 +++ b/src/framework/MOM_diag_remap.F90 @@ -673,14 +673,14 @@ subroutine horizontally_average_diag_field(G, h, staggered_in_x, staggered_in_y, if (is_extensive) then do j=G%jsc, G%jec ; do I=G%isc, G%iec I1 = I - G%isdB + 1 - volume(I,j,k) = G%areaCu(I,j) * G%mask2dCu(I,j) + volume(I,j,k) = G%US%L_to_m**2*G%areaCu(I,j) * G%mask2dCu(I,j) stuff(I,j,k) = volume(I,j,k) * field(I1,j,k) enddo ; enddo else ! Intensive do j=G%jsc, G%jec ; do I=G%isc, G%iec I1 = i - G%isdB + 1 height = 0.5 * (h(i,j,k) + h(i+1,j,k)) - volume(I,j,k) = G%areaCu(I,j) * height * G%mask2dCu(I,j) + volume(I,j,k) = G%US%L_to_m**2*G%areaCu(I,j) * height * G%mask2dCu(I,j) stuff(I,j,k) = volume(I,j,k) * field(I1,j,k) enddo ; enddo endif @@ -689,7 +689,7 @@ subroutine horizontally_average_diag_field(G, h, staggered_in_x, staggered_in_y, do k=1,nz do j=G%jsc, G%jec ; do I=G%isc, G%iec I1 = I - G%isdB + 1 - volume(I,j,k) = G%areaCu(I,j) * G%mask2dCu(I,j) + volume(I,j,k) = G%US%L_to_m**2*G%areaCu(I,j) * G%mask2dCu(I,j) stuff(I,j,k) = volume(I,j,k) * field(I1,j,k) enddo ; enddo enddo @@ -701,14 +701,14 @@ subroutine horizontally_average_diag_field(G, h, staggered_in_x, staggered_in_y, if (is_extensive) then do J=G%jsc, G%jec ; do i=G%isc, G%iec J1 = J - G%jsdB + 1 - volume(i,J,k) = G%areaCv(i,J) * G%mask2dCv(i,J) + volume(i,J,k) = G%US%L_to_m**2*G%areaCv(i,J) * G%mask2dCv(i,J) stuff(i,J,k) = volume(i,J,k) * field(i,J1,k) enddo ; enddo else ! Intensive do J=G%jsc, G%jec ; do i=G%isc, G%iec J1 = J - G%jsdB + 1 height = 0.5 * (h(i,j,k) + h(i,j+1,k)) - volume(i,J,k) = G%areaCv(i,J) * height * G%mask2dCv(i,J) + volume(i,J,k) = G%US%L_to_m**2*G%areaCv(i,J) * height * G%mask2dCv(i,J) stuff(i,J,k) = volume(i,J,k) * field(i,J1,k) enddo ; enddo endif @@ -717,7 +717,7 @@ subroutine horizontally_average_diag_field(G, h, staggered_in_x, staggered_in_y, do k=1,nz do J=G%jsc, G%jec ; do i=G%isc, G%iec J1 = J - G%jsdB + 1 - volume(i,J,k) = G%areaCv(i,J) * G%mask2dCv(i,J) + volume(i,J,k) = G%US%L_to_m**2*G%areaCv(i,J) * G%mask2dCv(i,J) stuff(i,J,k) = volume(i,J,k) * field(i,J1,k) enddo ; enddo enddo @@ -729,7 +729,7 @@ subroutine horizontally_average_diag_field(G, h, staggered_in_x, staggered_in_y, if (is_extensive) then do j=G%jsc, G%jec ; do i=G%isc, G%iec if (h(i,j,k) > 0.) then - volume(i,j,k) = G%areaT(i,j) * G%mask2dT(i,j) + volume(i,j,k) = G%US%L_to_m**2*G%areaT(i,j) * G%mask2dT(i,j) stuff(i,j,k) = volume(i,j,k) * field(i,j,k) else volume(i,j,k) = 0. @@ -738,7 +738,7 @@ subroutine horizontally_average_diag_field(G, h, staggered_in_x, staggered_in_y, enddo ; enddo else ! Intensive do j=G%jsc, G%jec ; do i=G%isc, G%iec - volume(i,j,k) = G%areaT(i,j) * h(i,j,k) * G%mask2dT(i,j) + volume(i,j,k) = G%US%L_to_m**2*G%areaT(i,j) * h(i,j,k) * G%mask2dT(i,j) stuff(i,j,k) = volume(i,j,k) * field(i,j,k) enddo ; enddo endif @@ -746,7 +746,7 @@ subroutine horizontally_average_diag_field(G, h, staggered_in_x, staggered_in_y, else ! Interface do k=1,nz do j=G%jsc, G%jec ; do i=G%isc, G%iec - volume(i,j,k) = G%areaT(i,j) * G%mask2dT(i,j) + volume(i,j,k) = G%US%L_to_m**2*G%areaT(i,j) * G%mask2dT(i,j) stuff(i,j,k) = volume(i,j,k) * field(i,j,k) enddo ; enddo enddo diff --git a/src/framework/MOM_dyn_horgrid.F90 b/src/framework/MOM_dyn_horgrid.F90 index 9bee061016..f46b8cb875 100644 --- a/src/framework/MOM_dyn_horgrid.F90 +++ b/src/framework/MOM_dyn_horgrid.F90 @@ -319,9 +319,11 @@ subroutine set_derived_dyn_horgrid(G, US) ! Various inverse grid spacings and derived areas are calculated within this ! subroutine. real :: m_to_L ! A unit conversion factor [L m-1 ~> nondim] + real :: L_to_m ! A unit conversion factor [L m-1 ~> nondim] integer :: i, j, isd, ied, jsd, jed integer :: IsdB, IedB, JsdB, JedB m_to_L = 1.0 ; if (present(US)) m_to_L = US%m_to_L + L_to_m = 1.0 ; if (present(US)) L_to_m = US%L_to_m isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed IsdB = G%IsdB ; IedB = G%IedB ; JsdB = G%JsdB ; JedB = G%JedB @@ -331,7 +333,7 @@ subroutine set_derived_dyn_horgrid(G, US) if (G%dyT(i,j) < 0.0) G%dyT(i,j) = 0.0 G%IdxT(i,j) = Adcroft_reciprocal(G%dxT(i,j)) G%IdyT(i,j) = Adcroft_reciprocal(G%dyT(i,j)) - G%IareaT(i,j) = Adcroft_reciprocal(m_to_L**2*G%areaT(i,j)) + G%IareaT(i,j) = Adcroft_reciprocal(m_to_L**2*L_to_m**2*G%areaT(i,j)) enddo ; enddo do j=jsd,jed ; do I=IsdB,IedB @@ -355,8 +357,8 @@ subroutine set_derived_dyn_horgrid(G, US) G%IdxBu(I,J) = Adcroft_reciprocal(G%dxBu(I,J)) G%IdyBu(I,J) = Adcroft_reciprocal(G%dyBu(I,J)) ! areaBu has usually been set to a positive area elsewhere. - if (G%areaBu(I,J) <= 0.0) G%areaBu(I,J) = G%dxBu(I,J) * G%dyBu(I,J) - G%IareaBu(I,J) = Adcroft_reciprocal(m_to_L**2*G%areaBu(I,J)) + if (G%areaBu(I,J) <= 0.0) G%areaBu(I,J) = m_to_L**2*G%dxBu(I,J) * G%dyBu(I,J) + G%IareaBu(I,J) = Adcroft_reciprocal(m_to_L**2*L_to_m**2*G%areaBu(I,J)) enddo ; enddo end subroutine set_derived_dyn_horgrid diff --git a/src/framework/MOM_spatial_means.F90 b/src/framework/MOM_spatial_means.F90 index 00f1474879..f7084ee7ea 100644 --- a/src/framework/MOM_spatial_means.F90 +++ b/src/framework/MOM_spatial_means.F90 @@ -36,7 +36,7 @@ function global_area_mean(var,G) tmpForSumming(:,:) = 0. do j=js,je ; do i=is, ie - tmpForSumming(i,j) = ( var(i,j) * (G%areaT(i,j) * G%mask2dT(i,j)) ) + tmpForSumming(i,j) = ( var(i,j) * (G%US%L_to_m**2*G%areaT(i,j) * G%mask2dT(i,j)) ) enddo ; enddo global_area_mean = reproducing_sum( tmpForSumming ) * G%IareaT_global @@ -54,7 +54,7 @@ function global_area_integral(var,G) tmpForSumming(:,:) = 0. do j=js,je ; do i=is, ie - tmpForSumming(i,j) = ( var(i,j) * (G%areaT(i,j) * G%mask2dT(i,j)) ) + tmpForSumming(i,j) = ( var(i,j) * (G%US%L_to_m**2*G%areaT(i,j) * G%mask2dT(i,j)) ) enddo ; enddo global_area_integral = reproducing_sum( tmpForSumming ) @@ -77,7 +77,7 @@ function global_layer_mean(var, h, G, GV) tmpForSumming(:,:,:) = 0. ; weight(:,:,:) = 0. do k=1,nz ; do j=js,je ; do i=is,ie - weight(i,j,k) = (GV%H_to_m * h(i,j,k)) * (G%areaT(i,j) * G%mask2dT(i,j)) + weight(i,j,k) = (GV%H_to_m * h(i,j,k)) * (G%US%L_to_m**2*G%areaT(i,j) * G%mask2dT(i,j)) tmpForSumming(i,j,k) = var(i,j,k) * weight(i,j,k) enddo ; enddo ; enddo @@ -108,7 +108,7 @@ function global_volume_mean(var, h, G, GV) tmpForSumming(:,:) = 0. ; sum_weight(:,:) = 0. do k=1,nz ; do j=js,je ; do i=is,ie - weight_here = (GV%H_to_m * h(i,j,k)) * (G%areaT(i,j) * G%mask2dT(i,j)) + weight_here = (GV%H_to_m * h(i,j,k)) * (G%US%L_to_m**2*G%areaT(i,j) * G%mask2dT(i,j)) tmpForSumming(i,j) = tmpForSumming(i,j) + var(i,j,k) * weight_here sum_weight(i,j) = sum_weight(i,j) + weight_here enddo ; enddo ; enddo @@ -141,12 +141,12 @@ function global_mass_integral(h, G, GV, var, on_PE_only) if (present(var)) then do k=1,nz ; do j=js,je ; do i=is,ie tmpForSumming(i,j) = tmpForSumming(i,j) + var(i,j,k) * & - ((GV%H_to_kg_m2 * h(i,j,k)) * (G%areaT(i,j) * G%mask2dT(i,j))) + ((GV%H_to_kg_m2 * h(i,j,k)) * (G%US%L_to_m**2*G%areaT(i,j) * G%mask2dT(i,j))) enddo ; enddo ; enddo else do k=1,nz ; do j=js,je ; do i=is,ie tmpForSumming(i,j) = tmpForSumming(i,j) + & - ((GV%H_to_kg_m2 * h(i,j,k)) * (G%areaT(i,j) * G%mask2dT(i,j))) + ((GV%H_to_kg_m2 * h(i,j,k)) * (G%US%L_to_m**2*G%areaT(i,j) * G%mask2dT(i,j))) enddo ; enddo ; enddo endif global_sum = .true. ; if (present(on_PE_only)) global_sum = .not.on_PE_only @@ -325,9 +325,9 @@ subroutine adjust_area_mean_to_zero(array, G, scaling) do j=G%jsc,G%jec ; do i=G%isc,G%iec posVals(i,j) = max(0., array(i,j)) - areaXposVals(i,j) = G%areaT(i,j) * posVals(i,j) + areaXposVals(i,j) = G%US%L_to_m**2*G%areaT(i,j) * posVals(i,j) negVals(i,j) = min(0., array(i,j)) - areaXnegVals(i,j) = G%areaT(i,j) * negVals(i,j) + areaXnegVals(i,j) = G%US%L_to_m**2*G%areaT(i,j) * negVals(i,j) enddo ; enddo areaIntPosVals = reproducing_sum( areaXposVals ) diff --git a/src/ice_shelf/MOM_ice_shelf.F90 b/src/ice_shelf/MOM_ice_shelf.F90 index 271ff5cb4b..d07fe42676 100644 --- a/src/ice_shelf/MOM_ice_shelf.F90 +++ b/src/ice_shelf/MOM_ice_shelf.F90 @@ -781,13 +781,13 @@ subroutine add_shelf_forces(G, US, CS, forces, do_shelf_area) forces%frac_shelf_u(I,j) = 0.0 if ((G%areaT(i,j) + G%areaT(i+1,j) > 0.0)) & ! .and. (G%areaCu(I,j) > 0.0)) & forces%frac_shelf_u(I,j) = ((ISS%area_shelf_h(i,j) + ISS%area_shelf_h(i+1,j)) / & - (G%areaT(i,j) + G%areaT(i+1,j))) + (US%L_to_m**2*G%areaT(i,j) + US%L_to_m**2*G%areaT(i+1,j))) enddo ; enddo do J=jsd,jed-1 ; do i=isd,ied forces%frac_shelf_v(i,J) = 0.0 if ((G%areaT(i,j) + G%areaT(i,j+1) > 0.0)) & ! .and. (G%areaCv(i,J) > 0.0)) & forces%frac_shelf_v(i,J) = ((ISS%area_shelf_h(i,j) + ISS%area_shelf_h(i,j+1)) / & - (G%areaT(i,j) + G%areaT(i,j+1))) + (US%L_to_m**2*G%areaT(i,j) + US%L_to_m**2*G%areaT(i,j+1))) enddo ; enddo call pass_vector(forces%frac_shelf_u, forces%frac_shelf_v, G%domain, TO_ALL, CGRID_NE) endif @@ -996,7 +996,7 @@ subroutine add_shelf_flux(G, US, CS, state, fluxes) !### These hard-coded limits need to be corrected. They are inappropriate here. if (G%geoLonT(i,j) >= 790.0 .AND. G%geoLonT(i,j) <= 800.0) then - sponge_area = sponge_area + G%areaT(i,j) + sponge_area = sponge_area + US%L_to_m**2*G%areaT(i,j) endif enddo ; enddo @@ -1124,12 +1124,12 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces, fl call MOM_domains_init(CS%grid%domain, param_file, min_halo=wd_halos, symmetric=GRID_SYM_) ! call diag_mediator_init(CS%grid,param_file,CS%diag) ! this needs to be fixed - will probably break when not using coupled driver 0 - call MOM_grid_init(CS%grid, param_file) + call MOM_grid_init(CS%grid, param_file, CS%US) call create_dyn_horgrid(dG, CS%grid%HI) call clone_MOM_domain(CS%grid%Domain, dG%Domain) - call set_grid_metrics(dG, param_file) + call set_grid_metrics(dG, param_file, CS%US) ! call set_diag_mediator_grid(CS%grid, CS%diag) ! The ocean grid possibly uses different symmetry. @@ -1508,13 +1508,13 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces, fl call cpu_clock_end(id_clock_pass) do j=jsd,jed ; do i=isd,ied - if (ISS%area_shelf_h(i,j) > G%areaT(i,j)) then + if (ISS%area_shelf_h(i,j) > US%L_to_m**2*G%areaT(i,j)) then call MOM_error(WARNING,"Initialize_ice_shelf: area_shelf_h exceeds G%areaT.") - ISS%area_shelf_h(i,j) = G%areaT(i,j) + ISS%area_shelf_h(i,j) = US%L_to_m**2*G%areaT(i,j) endif enddo ; enddo if (present(fluxes)) then ; do j=jsd,jed ; do i=isd,ied - if (G%areaT(i,j) > 0.0) fluxes%frac_shelf_h(i,j) = ISS%area_shelf_h(i,j) / (G%areaT(i,j)) + if (G%areaT(i,j) > 0.0) fluxes%frac_shelf_h(i,j) = ISS%area_shelf_h(i,j) / (US%L_to_m**2*G%areaT(i,j)) enddo ; enddo ; endif if (CS%debug) then @@ -1687,7 +1687,7 @@ subroutine update_shelf_mass(G, CS, ISS, Time) ISS%area_shelf_h(i,j) = 0.0 ISS%hmask(i,j) = 0. if (ISS%mass_shelf(i,j) > 0.0) then - ISS%area_shelf_h(i,j) = G%areaT(i,j) + ISS%area_shelf_h(i,j) = G%US%L_to_m**2*G%areaT(i,j) ISS%h_shelf(i,j) = ISS%mass_shelf(i,j) / CS%rho_ice ISS%hmask(i,j) = 1. endif diff --git a/src/ice_shelf/MOM_ice_shelf_dynamics.F90 b/src/ice_shelf/MOM_ice_shelf_dynamics.F90 index 415ae3d813..8d7adf9951 100644 --- a/src/ice_shelf/MOM_ice_shelf_dynamics.F90 +++ b/src/ice_shelf/MOM_ice_shelf_dynamics.F90 @@ -580,14 +580,16 @@ function ice_time_step_CFL(CS, ISS, G) real :: local_u_max, local_v_max integer :: i, j - min_ratio = 1.0e16 ! This is just an arbitrary large value. + min_ratio = 1.0e16 ! This is just an arbitrary large nondiensional value. do j=G%jsc,G%jec ; do i=G%isc,G%iec ; if (ISS%hmask(i,j) == 1.0) then local_u_max = max(abs(CS%u_shelf(i,j)), abs(CS%u_shelf(i+1,j+1)), & abs(CS%u_shelf(i+1,j)), abs(CS%u_shelf(i,j+1))) local_v_max = max(abs(CS%v_shelf(i,j)), abs(CS%v_shelf(i+1,j+1)), & abs(CS%v_shelf(i+1,j)), abs(CS%v_shelf(i,j+1))) - ratio = min(G%areaT(i,j) / (local_u_max+1.0e-12), G%areaT(i,j) / (local_v_max+1.0e-12)) + ! Here the hard-coded 1e-12 has units of m s-1. Consider revising. + ratio = G%US%L_to_m**2*min(G%areaT(i,j) / (local_u_max + 1.0e-12), & + G%areaT(i,j) / (local_v_max + 1.0e-12)) min_ratio = min(min_ratio, ratio) endif ; enddo ; enddo ! i- and j- loops @@ -896,7 +898,7 @@ subroutine ice_shelf_solve_outer(CS, ISS, G, US, u, v, iters, time) Au(:,:) = 0.0 ; Av(:,:) = 0.0 call CG_action(Au, Av, u, v, Phi, Phisub, CS%umask, CS%vmask, ISS%hmask, H_node, & - CS%ice_visc, float_cond, G%bathyT(:,:), CS%taub_beta_eff, G%areaT, & + CS%ice_visc, float_cond, G%bathyT(:,:), CS%taub_beta_eff, G%US%L_to_m**2*G%areaT, & G, G%isc-1, G%iec+1, G%jsc-1, G%jec+1, rhoi_rhow) err_init = 0 ; err_tempu = 0; err_tempv = 0 @@ -955,7 +957,7 @@ subroutine ice_shelf_solve_outer(CS, ISS, G, US, u, v, iters, time) Au(:,:) = 0 ; Av(:,:) = 0 call CG_action(Au, Av, u, v, Phi, Phisub, CS%umask, CS%vmask, ISS%hmask, H_node, & - CS%ice_visc, float_cond, G%bathyT(:,:), CS%taub_beta_eff, G%areaT, & + CS%ice_visc, float_cond, G%bathyT(:,:), CS%taub_beta_eff, G%US%L_to_m**2*G%areaT, & G, G%isc-1, G%iec+1, G%jsc-1, G%jec+1, rhoi_rhow) err_max = 0 @@ -1120,7 +1122,7 @@ subroutine ice_shelf_solve_inner(CS, ISS, G, u, v, taudx, taudy, H_node, float_c call CG_action(Au, Av, u, v, Phi, Phisub, CS%umask, CS%vmask, hmask, & H_node, CS%ice_visc, float_cond, G%bathyT(:,:), CS%taub_beta_eff, & - G%areaT, G, isc-1, iec+1, jsc-1, jec+1, CS%density_ice/CS%density_ocean_avg) + G%US%L_to_m**2*G%areaT, G, isc-1, iec+1, jsc-1, jec+1, CS%density_ice/CS%density_ocean_avg) call pass_vector(Au, Av, G%domain, TO_ALL, BGRID_NE) @@ -1191,7 +1193,7 @@ subroutine ice_shelf_solve_inner(CS, ISS, G, u, v, taudx, taudy, H_node, float_c call CG_action(Au, Av, Du, Dv, Phi, Phisub, CS%umask, CS%vmask, hmask, & H_node, CS%ice_visc, float_cond, G%bathyT(:,:), CS%taub_beta_eff, & - G%areaT, G, is, ie, js, je, CS%density_ice/CS%density_ocean_avg) + G%US%L_to_m**2*G%areaT, G, is, ie, js, je, CS%density_ice/CS%density_ocean_avg) ! Au, Av valid region moves in by 1 @@ -1483,7 +1485,7 @@ subroutine ice_shelf_advect_thickness_x(CS, G, time_step, hmask, h0, h_after_ufl if (hmask(i,j) == 1) then - dxh = G%dxT(i,j) ; dyh = G%dyT(i,j) ; dxdyh = G%areaT(i,j) + dxh = G%dxT(i,j) ; dyh = G%dyT(i,j) ; dxdyh = G%US%L_to_m**2*G%areaT(i,j) h_after_uflux(i,j) = h0(i,j) @@ -1712,7 +1714,7 @@ subroutine ice_shelf_advect_thickness_y(CS, G, time_step, hmask, h_after_uflux, endif if (hmask(i,j) == 1) then - dxh = G%dxT(i,j) ; dyh = G%dyT(i,j) ; dxdyh = G%areaT(i,j) + dxh = G%dxT(i,j) ; dyh = G%dyT(i,j) ; dxdyh = G%US%L_to_m**2*G%areaT(i,j) h_after_vflux(i,j) = h_after_uflux(i,j) stencil(:) = h_after_uflux(i,j-2:j+2) ! fine as long has ny_halo >= 2 @@ -1952,7 +1954,7 @@ subroutine shelf_advance_front(CS, ISS, G, flux_enter) enddo if (n_flux > 0) then - dxdyh = G%areaT(i,j) + dxdyh = G%US%L_to_m**2*G%areaT(i,j) h_reference = h_reference / real(n_flux) partial_vol = ISS%h_shelf(i,j) * ISS%area_shelf_h(i,j) + tot_flux @@ -2142,7 +2144,7 @@ subroutine calc_shelf_driving_stress(CS, ISS, G, US, TAUD_X, TAUD_Y, OD) sy = 0 dxh = G%dxT(i,j) dyh = G%dyT(i,j) - dxdyh = G%areaT(i,j) + dxdyh = G%US%L_to_m**2*G%areaT(i,j) if (ISS%hmask(i,j) == 1) then ! we are inside the global computational bdry, at an ice-filled cell @@ -2673,7 +2675,7 @@ subroutine matrix_diagonal(CS, G, float_cond, H_node, nu, beta, hmask, dens_rati dxh = G%dxT(i,j) dyh = G%dyT(i,j) - dxdyh = G%areaT(i,j) + dxdyh = G%US%L_to_m**2*G%areaT(i,j) X(1:2) = G%geoLonBu(i-1:i,j-1)*1000 X(3:4) = G%geoLonBu(i-1:i,j) *1000 @@ -2866,7 +2868,7 @@ subroutine apply_boundary_values(CS, ISS, G, time, Phisub, H_node, nu, beta, flo dxh = G%dxT(i,j) dyh = G%dyT(i,j) - dxdyh = G%areaT(i,j) + dxdyh = G%US%L_to_m**2*G%areaT(i,j) X(1:2) = G%geoLonBu(i-1:i,j-1)*1000 X(3:4) = G%geoLonBu(i-1:i,j)*1000 @@ -3022,7 +3024,7 @@ subroutine calc_shelf_visc(CS, ISS, G, US, u, v) dxh = G%dxT(i,j) dyh = G%dyT(i,j) - dxdyh = G%areaT(i,j) + dxdyh = US%L_to_m**2*G%areaT(i,j) if (ISS%hmask(i,j) == 1) then ux = (u(i,j) + u(i,j-1) - u(i-1,j) - u(i-1,j-1)) / (2*dxh) @@ -3679,7 +3681,7 @@ subroutine ice_shelf_advect_temp_x(CS, G, time_step, hmask, h0, h_after_uflux, f if (hmask(i,j) == 1) then - dxh = G%dxT(i,j) ; dyh = G%dyT(i,j) ; dxdyh = G%areaT(i,j) + dxh = G%dxT(i,j) ; dyh = G%dyT(i,j) ; dxdyh = G%US%L_to_m**2*G%areaT(i,j) h_after_uflux(i,j) = h0(i,j) @@ -3907,7 +3909,7 @@ subroutine ice_shelf_advect_temp_y(CS, G, time_step, hmask, h_after_uflux, h_aft endif if (hmask(i,j) == 1) then - dxh = G%dxT(i,j) ; dyh = G%dyT(i,j) ; dxdyh = G%areaT(i,j) + dxh = G%dxT(i,j) ; dyh = G%dyT(i,j) ; dxdyh = G%US%L_to_m**2*G%areaT(i,j) h_after_vflux(i,j) = h_after_uflux(i,j) stencil(:) = h_after_uflux(i,j-2:j+2) ! fine as long has ny_halo >= 2 diff --git a/src/ice_shelf/MOM_ice_shelf_initialize.F90 b/src/ice_shelf/MOM_ice_shelf_initialize.F90 index bc00ac61a9..2ace1b2137 100644 --- a/src/ice_shelf/MOM_ice_shelf_initialize.F90 +++ b/src/ice_shelf/MOM_ice_shelf_initialize.F90 @@ -128,11 +128,11 @@ subroutine initialize_ice_thickness_from_file(h_shelf, area_shelf_h, hmask, G, U ! update thickness mask - if (area_shelf_h (i,j) >= G%areaT(i,j)) then + if (area_shelf_h (i,j) >= US%L_to_m**2*G%areaT(i,j)) then hmask(i,j) = 1. elseif (area_shelf_h (i,j) == 0.0) then hmask(i,j) = 0. - elseif ((area_shelf_h(i,j) > 0) .and. (area_shelf_h(i,j) <= G%areaT(i,j))) then + elseif ((area_shelf_h(i,j) > 0) .and. (area_shelf_h(i,j) <= US%L_to_m**2*G%areaT(i,j))) then hmask(i,j) = 2. else call MOM_error(FATAL,mdl// " AREA IN CELL OUT OF RANGE") @@ -206,11 +206,11 @@ subroutine initialize_ice_thickness_channel(h_shelf, area_shelf_h, hmask, G, US, h_shelf (i,j) = 0.0 else if (G%geoLonCu(i,j) > edge_pos) then - area_shelf_h(i,j) = G%areaT(i,j) * (edge_pos - G%geoLonCu(i-1,j)) / & + area_shelf_h(i,j) = US%L_to_m**2*G%areaT(i,j) * (edge_pos - G%geoLonCu(i-1,j)) / & (G%geoLonCu(i,j) - G%geoLonCu(i-1,j)) hmask (i,j) = 2.0 else - area_shelf_h(i,j) = G%areaT(i,j) + area_shelf_h(i,j) = US%L_to_m**2*G%areaT(i,j) hmask (i,j) = 1.0 endif diff --git a/src/ice_shelf/MOM_marine_ice.F90 b/src/ice_shelf/MOM_marine_ice.F90 index 5505154d23..16b543387d 100644 --- a/src/ice_shelf/MOM_marine_ice.F90 +++ b/src/ice_shelf/MOM_marine_ice.F90 @@ -80,18 +80,18 @@ subroutine iceberg_forces(G, forces, use_ice_shelf, sfc_state, & do j=js,je ; do I=is-1,ie if ((G%areaT(i,j) + G%areaT(i+1,j) > 0.0)) & ! .and. (G%dxdy_u(I,j) > 0.0)) & forces%frac_shelf_u(I,j) = forces%frac_shelf_u(I,j) + & - (((forces%area_berg(i,j)*G%areaT(i,j)) + & - (forces%area_berg(i+1,j)*G%areaT(i+1,j))) / & - (G%areaT(i,j) + G%areaT(i+1,j)) ) + (((forces%area_berg(i,j)*G%US%L_to_m**2*G%areaT(i,j)) + & + (forces%area_berg(i+1,j)*G%US%L_to_m**2*G%areaT(i+1,j))) / & + (G%US%L_to_m**2*G%areaT(i,j) + G%US%L_to_m**2*G%areaT(i+1,j)) ) forces%rigidity_ice_u(I,j) = forces%rigidity_ice_u(I,j) + kv_rho_ice * & min(forces%mass_berg(i,j), forces%mass_berg(i+1,j)) enddo ; enddo do J=js-1,je ; do i=is,ie if ((G%areaT(i,j) + G%areaT(i,j+1) > 0.0)) & ! .and. (G%dxdy_v(i,J) > 0.0)) & forces%frac_shelf_v(i,J) = forces%frac_shelf_v(i,J) + & - (((forces%area_berg(i,j)*G%areaT(i,j)) + & - (forces%area_berg(i,j+1)*G%areaT(i,j+1))) / & - (G%areaT(i,j) + G%areaT(i,j+1)) ) + (((forces%area_berg(i,j)*G%US%L_to_m**2*G%areaT(i,j)) + & + (forces%area_berg(i,j+1)*G%US%L_to_m**2*G%areaT(i,j+1))) / & + (G%US%L_to_m**2*G%areaT(i,j) + G%US%L_to_m**2*G%areaT(i,j+1)) ) forces%rigidity_ice_v(i,J) = forces%rigidity_ice_v(i,J) + kv_rho_ice * & min(forces%mass_berg(i,j), forces%mass_berg(i,j+1)) enddo ; enddo diff --git a/src/ice_shelf/user_shelf_init.F90 b/src/ice_shelf/user_shelf_init.F90 index ec2787bae3..c0c7c96a59 100644 --- a/src/ice_shelf/user_shelf_init.F90 +++ b/src/ice_shelf/user_shelf_init.F90 @@ -168,11 +168,11 @@ subroutine USER_update_shelf_mass(mass_shelf, area_shelf_h, h_shelf, hmask, G, C h_shelf (i,j) = 0.0 else if (G%geoLonCu(i,j) > edge_pos) then - area_shelf_h(i,j) = G%areaT(i,j) * (edge_pos - G%geoLonCu(i-1,j)) / & + area_shelf_h(i,j) = G%US%L_to_m**2*G%areaT(i,j) * (edge_pos - G%geoLonCu(i-1,j)) / & (G%geoLonCu(i,j) - G%geoLonCu(i-1,j)) hmask (i,j) = 2.0 else - area_shelf_h(i,j) = G%areaT(i,j) + area_shelf_h(i,j) = G%US%L_to_m**2*G%areaT(i,j) hmask (i,j) = 1.0 endif diff --git a/src/initialization/MOM_fixed_initialization.F90 b/src/initialization/MOM_fixed_initialization.F90 index 893bd87a75..0ee72e9bb0 100644 --- a/src/initialization/MOM_fixed_initialization.F90 +++ b/src/initialization/MOM_fixed_initialization.F90 @@ -78,7 +78,7 @@ subroutine MOM_initialize_fixed(G, US, OBC, PF, write_geom, output_dir) inputdir = slasher(inputdir) ! Set up the parameters of the physical domain (i.e. the grid), G - call set_grid_metrics(G, PF) + call set_grid_metrics(G, PF, US) ! Set up the bottom depth, G%bathyT either analytically or from file ! This also sets G%max_depth based on the input parameter MAXIMUM_DEPTH, @@ -99,7 +99,7 @@ subroutine MOM_initialize_fixed(G, US, OBC, PF, write_geom, output_dir) call initialize_masks(G, PF, US) ! Make OBC mask consistent with land mask - call open_boundary_impose_land_mask(OBC, G, G%areaCu, G%areaCv) + call open_boundary_impose_land_mask(OBC, G, G%areaCu, G%areaCv, US) if (debug) then call hchksum(G%bathyT, 'MOM_initialize_fixed: depth ', G%HI, haloshift=1, scale=US%Z_to_m) diff --git a/src/initialization/MOM_grid_initialize.F90 b/src/initialization/MOM_grid_initialize.F90 index 2867783c2a..5162c1303f 100644 --- a/src/initialization/MOM_grid_initialize.F90 +++ b/src/initialization/MOM_grid_initialize.F90 @@ -118,8 +118,10 @@ subroutine grid_metrics_chksum(parent, G, US) type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type real :: m_to_L ! A unit conversion factor [L m-1 ~> nondim] + real :: L_to_m ! A unit conversion factor [m L-1 ~> nondim] integer :: halo m_to_L = 1.0 ; if (present(US)) m_to_L = US%m_to_L + L_to_m = 1.0 ; if (present(US)) L_to_m = US%L_to_m halo = min(G%ied-G%iec, G%jed-G%jec, 1) @@ -146,8 +148,8 @@ subroutine grid_metrics_chksum(parent, G, US) call Bchksum_pair(trim(parent)//': Id[xy]B[uv]', & G%IdxBu, G%IdyBu, G%HI, haloshift=halo) - call hchksum(G%areaT, trim(parent)//': areaT',G%HI, haloshift=halo) - call Bchksum(G%areaBu, trim(parent)//': areaBu',G%HI, haloshift=halo) + call hchksum(G%areaT, trim(parent)//': areaT',G%HI, haloshift=halo, scale=L_to_m**2) + call Bchksum(G%areaBu, trim(parent)//': areaBu',G%HI, haloshift=halo, scale=L_to_m**2) call hchksum(G%IareaT, trim(parent)//': IareaT',G%HI, haloshift=halo, scale=m_to_L**2) call Bchksum(G%IareaBu, trim(parent)//': IareaBu',G%HI, haloshift=halo, scale=m_to_L**2) @@ -361,7 +363,7 @@ subroutine set_grid_metrics_from_mosaic(G, param_file, US) call pass_var(areaBu, G%Domain, position=CORNER) do i=G%isd,G%ied ; do j=G%jsd,G%jed - G%dxT(i,j) = dxT(i,j) ; G%dyT(i,j) = dyT(i,j) ; G%areaT(i,j) = areaT(i,j) + G%dxT(i,j) = dxT(i,j) ; G%dyT(i,j) = dyT(i,j) ; G%areaT(i,j) = m_to_L**2*areaT(i,j) enddo ; enddo do I=G%IsdB,G%IedB ; do j=G%jsd,G%jed G%dxCu(I,j) = dxCu(I,j) ; G%dyCu(I,j) = dyCu(I,j) @@ -370,7 +372,7 @@ subroutine set_grid_metrics_from_mosaic(G, param_file, US) G%dxCv(i,J) = dxCv(i,J) ; G%dyCv(i,J) = dyCv(i,J) enddo ; enddo do I=G%IsdB,G%IedB ; do J=G%JsdB,G%JedB - G%dxBu(I,J) = dxBu(I,J) ; G%dyBu(I,J) = dyBu(I,J) ; G%areaBu(I,J) = areaBu(I,J) + G%dxBu(I,J) = dxBu(I,J) ; G%dyBu(I,J) = dyBu(I,J) ; G%areaBu(I,J) = m_to_L**2*areaBu(I,J) enddo ; enddo ! Construct axes for diagnostic output (only necessary because "ferret" uses @@ -523,14 +525,14 @@ subroutine set_grid_metrics_cartesian(G, param_file, US) G%dxBu(I,J) = dx_everywhere ; G%IdxBu(I,J) = I_dx G%dyBu(I,J) = dy_everywhere ; G%IdyBu(I,J) = I_dy - G%areaBu(I,J) = dx_everywhere * dy_everywhere ; G%IareaBu(I,J) = L_to_m**2*I_dx * I_dy + G%areaBu(I,J) = m_to_L**2*dx_everywhere * dy_everywhere ; G%IareaBu(I,J) = L_to_m**2*I_dx * I_dy enddo ; enddo do j=jsd,jed ; do i=isd,ied G%geoLonT(i,j) = grid_lonT(i) ; G%geoLatT(i,j) = grid_LatT(j) G%dxT(i,j) = dx_everywhere ; G%IdxT(i,j) = I_dx G%dyT(i,j) = dy_everywhere ; G%IdyT(i,j) = I_dy - G%areaT(i,j) = dx_everywhere * dy_everywhere ; G%IareaT(i,j) = L_to_m**2*I_dx * I_dy + G%areaT(i,j) = m_to_L**2*dx_everywhere * dy_everywhere ; G%IareaT(i,j) = L_to_m**2*I_dx * I_dy enddo ; enddo do j=jsd,jed ; do I=IsdB,IedB @@ -647,7 +649,7 @@ subroutine set_grid_metrics_spherical(G, param_file, US) G%dxBu(I,J) = G%Rad_Earth * COS( G%geoLatBu(I,J)*PI_180 ) * dL_di ! G%dxBu(I,J) = G%Rad_Earth * dLon*PI_180 * COS( G%geoLatBu(I,J)*PI_180 ) G%dyBu(I,J) = G%Rad_Earth * dLat*PI_180 - G%areaBu(I,J) = G%dxBu(I,J) * G%dyBu(I,J) + G%areaBu(I,J) = m_to_L**2 * G%dxBu(I,J) * G%dyBu(I,J) enddo ; enddo do J=JsdB,JedB ; do i=isd,ied @@ -684,8 +686,8 @@ subroutine set_grid_metrics_spherical(G, param_file, US) ! latitude = G%geoLatCv(i,J)*PI_180 ! In radians ! dL_di = G%geoLatCv(i,max(jsd,J-1))*PI_180 ! In radians -! G%areaT(i,j) = Rad_Earth**2*dLon*dLat*ABS(SIN(latitude)-SIN(dL_di)) - G%areaT(i,j) = G%dxT(i,j) * G%dyT(i,j) +! G%areaT(i,j) = m_to_L**2 * Rad_Earth**2*dLon*dLat*ABS(SIN(latitude)-SIN(dL_di)) + G%areaT(i,j) = m_to_L**2 * G%dxT(i,j) * G%dyT(i,j) enddo ; enddo call callTree_leave("set_grid_metrics_spherical()") @@ -873,8 +875,8 @@ subroutine set_grid_metrics_mercator(G, param_file, US) G%dxBu(I,J) = ds_di(xq(I,J), yq(I,J), GP) G%dyBu(I,J) = ds_dj(xq(I,J), yq(I,J), GP) - G%areaBu(I,J) = G%dxBu(I,J) * G%dyBu(I,J) - G%IareaBu(I,J) = 1.0 / (m_to_L**2*G%areaBu(I,J)) + G%areaBu(I,J) = m_to_L**2*G%dxBu(I,J) * G%dyBu(I,J) + G%IareaBu(I,J) = 1.0 / (G%areaBu(I,J)) enddo ; enddo do j=jsd,jed ; do i=isd,ied @@ -883,8 +885,8 @@ subroutine set_grid_metrics_mercator(G, param_file, US) G%dxT(i,j) = ds_di(xh(i,j), yh(i,j), GP) G%dyT(i,j) = ds_dj(xh(i,j), yh(i,j), GP) - G%areaT(i,j) = G%dxT(i,j)*G%dyT(i,j) - G%IareaT(i,j) = 1.0 / (m_to_L**2*G%areaT(i,j)) + G%areaT(i,j) = m_to_L**2*G%dxT(i,j)*G%dyT(i,j) + G%IareaT(i,j) = 1.0 / (G%areaT(i,j)) enddo ; enddo do j=jsd,jed ; do I=IsdB,IedB @@ -903,7 +905,7 @@ subroutine set_grid_metrics_mercator(G, param_file, US) if (.not.simple_area) then do j=JsdB+1,jed ; do i=IsdB+1,ied - G%areaT(I,J) = GP%Rad_Earth**2 * & + G%areaT(I,J) = m_to_L**2*GP%Rad_Earth**2 * & (dL(xq(I-1,J-1),xq(I-1,J),yq(I-1,J-1),yq(I-1,J)) + & (dL(xq(I-1,J),xq(I,J),yq(I-1,J),yq(I,J)) + & (dL(xq(I,J),xq(I,J-1),yq(I,J),yq(I,J-1)) + & @@ -920,7 +922,7 @@ subroutine set_grid_metrics_mercator(G, param_file, US) call pass_var(G%areaT,G%Domain) endif do j=jsd,jed ; do i=isd,ied - G%IareaT(i,j) = 1.0 / (m_to_L**2*G%areaT(i,j)) + G%IareaT(i,j) = 1.0 / (G%areaT(i,j)) enddo ; enddo endif @@ -1310,14 +1312,14 @@ subroutine initialize_masks(G, PF, US) do j=G%jsd,G%jed ; do I=G%IsdB,G%IedB G%dy_Cu(I,j) = G%mask2dCu(I,j) * G%dyCu(I,j) - G%areaCu(I,j) = G%dxCu(I,j) * G%dy_Cu(I,j) - G%IareaCu(I,j) = G%mask2dCu(I,j) * Adcroft_reciprocal(m_to_L**2*G%areaCu(I,j)) + G%areaCu(I,j) = m_to_L**2*G%dxCu(I,j) * G%dy_Cu(I,j) + G%IareaCu(I,j) = G%mask2dCu(I,j) * Adcroft_reciprocal(G%areaCu(I,j)) enddo ; enddo do J=G%JsdB,G%JedB ; do i=G%isd,G%ied G%dx_Cv(i,J) = G%mask2dCv(i,J) * G%dxCv(i,J) - G%areaCv(i,J) = G%dyCv(i,J) * G%dx_Cv(i,J) - G%IareaCv(i,J) = G%mask2dCv(i,J) * Adcroft_reciprocal(m_to_L**2*G%areaCv(i,J)) + G%areaCv(i,J) = m_to_L**2*G%dyCv(i,J) * G%dx_Cv(i,J) + G%IareaCv(i,J) = G%mask2dCv(i,J) * Adcroft_reciprocal(G%areaCv(i,J)) enddo ; enddo call callTree_leave("initialize_masks()") diff --git a/src/initialization/MOM_shared_initialization.F90 b/src/initialization/MOM_shared_initialization.F90 index 218ee56353..d5a748f4a6 100644 --- a/src/initialization/MOM_shared_initialization.F90 +++ b/src/initialization/MOM_shared_initialization.F90 @@ -716,9 +716,9 @@ subroutine reset_face_lengths_named(G, param_file, name, US) G%geoLonCu(I,j), G%geoLatCu(I,j) call MOM_error(FATAL,"reset_face_lengths_named "//mesg) endif - G%areaCu(I,j) = G%dxCu(I,j)*G%dy_Cu(I,j) + G%areaCu(I,j) = m_to_L**2*G%dxCu(I,j)*G%dy_Cu(I,j) G%IareaCu(I,j) = 0.0 - if (G%areaCu(I,j) > 0.0) G%IareaCu(I,j) = G%mask2dCu(I,j) / (m_to_L**2*G%areaCu(I,j)) + if (G%areaCu(I,j) > 0.0) G%IareaCu(I,j) = G%mask2dCu(I,j) / (G%areaCu(I,j)) enddo ; enddo do J=JsdB,JedB ; do i=isd,ied @@ -730,9 +730,9 @@ subroutine reset_face_lengths_named(G, param_file, name, US) call MOM_error(FATAL,"reset_face_lengths_named "//mesg) endif - G%areaCv(i,J) = G%dyCv(i,J)*G%dx_Cv(i,J) + G%areaCv(i,J) = m_to_L**2*G%dyCv(i,J)*G%dx_Cv(i,J) G%IareaCv(i,J) = 0.0 - if (G%areaCv(i,J) > 0.0) G%IareaCv(i,J) = G%mask2dCv(i,J) / (m_to_L**2*G%areaCv(i,J)) + if (G%areaCv(i,J) > 0.0) G%IareaCv(i,J) = G%mask2dCv(i,J) / (G%areaCv(i,J)) enddo ; enddo end subroutine reset_face_lengths_named @@ -783,9 +783,9 @@ subroutine reset_face_lengths_file(G, param_file, US) G%geoLonCu(I,j), G%geoLatCu(I,j) call MOM_error(FATAL,"reset_face_lengths_file "//mesg) endif - G%areaCu(I,j) = G%dxCu(I,j)*G%dy_Cu(I,j) + G%areaCu(I,j) = m_to_L**2*G%dxCu(I,j)*G%dy_Cu(I,j) G%IareaCu(I,j) = 0.0 - if (G%areaCu(I,j) > 0.0) G%IareaCu(I,j) = G%mask2dCu(I,j) / (m_to_L**2*G%areaCu(I,j)) + if (G%areaCu(I,j) > 0.0) G%IareaCu(I,j) = G%mask2dCu(I,j) / (G%areaCu(I,j)) enddo ; enddo do J=JsdB,JedB ; do i=isd,ied @@ -797,9 +797,9 @@ subroutine reset_face_lengths_file(G, param_file, US) call MOM_error(FATAL,"reset_face_lengths_file "//mesg) endif - G%areaCv(i,J) = G%dyCv(i,J)*G%dx_Cv(i,J) + G%areaCv(i,J) = m_to_L**2*G%dyCv(i,J)*G%dx_Cv(i,J) G%IareaCv(i,J) = 0.0 - if (G%areaCv(i,J) > 0.0) G%IareaCv(i,J) = G%mask2dCv(i,J) / (m_to_L**2*G%areaCv(i,J)) + if (G%areaCv(i,J) > 0.0) G%IareaCv(i,J) = G%mask2dCv(i,J) / (G%areaCv(i,J)) enddo ; enddo call callTree_leave(trim(mdl)//'()') @@ -997,9 +997,9 @@ subroutine reset_face_lengths_list(G, param_file, US) endif enddo - G%areaCu(I,j) = G%dxCu(I,j)*G%dy_Cu(I,j) + G%areaCu(I,j) = m_to_L**2*G%dxCu(I,j)*G%dy_Cu(I,j) G%IareaCu(I,j) = 0.0 - if (G%areaCu(I,j) > 0.0) G%IareaCu(I,j) = G%mask2dCu(I,j) / (m_to_L**2*G%areaCu(I,j)) + if (G%areaCu(I,j) > 0.0) G%IareaCu(I,j) = G%mask2dCu(I,j) / (G%areaCu(I,j)) enddo ; enddo do J=JsdB,JedB ; do i=isd,ied @@ -1026,9 +1026,9 @@ subroutine reset_face_lengths_list(G, param_file, US) endif enddo - G%areaCv(i,J) = G%dyCv(i,J)*G%dx_Cv(i,J) + G%areaCv(i,J) = m_to_L**2*G%dyCv(i,J)*G%dx_Cv(i,J) G%IareaCv(i,J) = 0.0 - if (G%areaCv(i,J) > 0.0) G%IareaCv(i,J) = G%mask2dCv(i,J) / (m_to_L**2*G%areaCv(i,J)) + if (G%areaCv(i,J) > 0.0) G%IareaCv(i,J) = G%mask2dCv(i,J) / (G%areaCv(i,J)) enddo ; enddo if (num_lines > 0) then diff --git a/src/initialization/MOM_state_initialization.F90 b/src/initialization/MOM_state_initialization.F90 index e8f42bc6d1..6a1f59baaa 100644 --- a/src/initialization/MOM_state_initialization.F90 +++ b/src/initialization/MOM_state_initialization.F90 @@ -1882,7 +1882,7 @@ subroutine compute_global_grid_integrals(G) tmpForSumming(:,:) = 0. G%areaT_global = 0.0 ; G%IareaT_global = 0.0 do j=G%jsc,G%jec ; do i=G%isc,G%iec - tmpForSumming(i,j) = G%areaT(i,j) * G%mask2dT(i,j) + tmpForSumming(i,j) = G%US%L_to_m**2*G%areaT(i,j) * G%mask2dT(i,j) enddo ; enddo G%areaT_global = reproducing_sum(tmpForSumming) G%IareaT_global = 1. / (G%areaT_global) @@ -2156,7 +2156,7 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, G, GV, US, PF, just_read_param ! Compute fractional ice shelf coverage of h do j=jsd,jed ; do i=isd,ied if (G%areaT(i,j) > 0.0) & - frac_shelf_h(i,j) = area_shelf_h(i,j) / (G%areaT(i,j)) + frac_shelf_h(i,j) = area_shelf_h(i,j) / (US%L_to_m**2*G%areaT(i,j)) enddo ; enddo ! Pass to the pointer for use as an argument to regridding_main shelf_area => frac_shelf_h diff --git a/src/parameterizations/lateral/MOM_MEKE.F90 b/src/parameterizations/lateral/MOM_MEKE.F90 index 003a84d2f4..9b53e39df9 100644 --- a/src/parameterizations/lateral/MOM_MEKE.F90 +++ b/src/parameterizations/lateral/MOM_MEKE.F90 @@ -238,10 +238,10 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h !$OMP parallel do default(shared) do j=js,je ; do i=is,ie drag_rate_visc(i,j) = (0.25*US%m_to_L**2*G%IareaT(i,j) * & - ((G%areaCu(I-1,j)*drag_vel_u(I-1,j) + & - G%areaCu(I,j)*drag_vel_u(I,j)) + & - (G%areaCv(i,J-1)*drag_vel_v(i,J-1) + & - G%areaCv(i,J)*drag_vel_v(i,J)) ) ) + ((US%L_to_m**2*G%areaCu(I-1,j)*drag_vel_u(I-1,j) + & + US%L_to_m**2*G%areaCu(I,j)*drag_vel_u(I,j)) + & + (US%L_to_m**2*G%areaCv(i,J-1)*drag_vel_v(i,J-1) + & + US%L_to_m**2*G%areaCv(i,J)*drag_vel_v(i,J)) ) ) enddo ; enddo else !$OMP parallel do default(shared) @@ -538,13 +538,13 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h !$OMP parallel do default(shared) do j=js,je ; do i=is,ie MEKE%Kh(i,j) = (CS%MEKE_KhCoeff & - * sqrt(2.*max(0.,barotrFac2(i,j)*MEKE%MEKE(i,j))*G%areaT(i,j))) & + * sqrt(2.*max(0.,barotrFac2(i,j)*MEKE%MEKE(i,j))*US%L_to_m**2*G%areaT(i,j))) & * min(MEKE%Rd_dx_h(i,j), 1.0) enddo ; enddo else !$OMP parallel do default(shared) do j=js,je ; do i=is,ie - MEKE%Kh(i,j) = CS%MEKE_KhCoeff*sqrt(2.*max(0.,barotrFac2(i,j)*MEKE%MEKE(i,j))*G%areaT(i,j)) + MEKE%Kh(i,j) = CS%MEKE_KhCoeff*sqrt(2.*max(0.,barotrFac2(i,j)*MEKE%MEKE(i,j))*US%L_to_m**2*G%areaT(i,j)) enddo ; enddo endif else @@ -684,7 +684,7 @@ subroutine MEKE_equilibrium(CS, MEKE, G, GV, US, SN_u, SN_v, drag_rate_visc, I_m do while (resid>0.) n1 = n1 + 1 EKE = EKEmax - call MEKE_lengthScales_0d(CS, G%areaT(i,j), beta, G%bathyT(i,j), & + call MEKE_lengthScales_0d(CS, US%L_to_m**2*G%areaT(i,j), beta, G%bathyT(i,j), & MEKE%Rd_dx_h(i,j), SN, EKE, US%Z_to_m, & bottomFac2, barotrFac2, LmixScale, & Lrhines, Leady) @@ -821,7 +821,7 @@ subroutine MEKE_lengthScales(CS, MEKE, G, GV, US, SN_u, SN_v, & beta = 0. endif ! Returns bottomFac2, barotrFac2 and LmixScale - call MEKE_lengthScales_0d(CS, G%areaT(i,j), beta, G%bathyT(i,j), & + call MEKE_lengthScales_0d(CS, US%L_to_m**2*G%areaT(i,j), beta, G%bathyT(i,j), & MEKE%Rd_dx_h(i,j), SN, MEKE%MEKE(i,j), US%Z_to_m, & bottomFac2(i,j), barotrFac2(i,j), LmixScale(i,j), & Lrhines(i,j), Leady(i,j)) diff --git a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 index 7a88529b03..d4fc2149c8 100644 --- a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 +++ b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 @@ -1024,10 +1024,10 @@ subroutine VarMix_init(Time, G, GV, US, param_file, diag, CS) allocate(CS%L2v(isd:ied,JsdB:JedB)) ; CS%L2v(:,:) = 0.0 if (CS%Visbeck_L_scale<0) then do j=js,je ; do I=is-1,Ieq - CS%L2u(I,j) = CS%Visbeck_L_scale**2*G%areaCu(I,j) + CS%L2u(I,j) = CS%Visbeck_L_scale**2 * US%L_to_m**2*G%areaCu(I,j) enddo; enddo do J=js-1,Jeq ; do i=is,ie - CS%L2v(i,J) = CS%Visbeck_L_scale**2*G%areaCv(i,J) + CS%L2v(i,J) = CS%Visbeck_L_scale**2 * US%L_to_m**2*G%areaCv(i,J) enddo; enddo else CS%L2u(:,:) = CS%Visbeck_L_scale**2 diff --git a/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 b/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 index 286ac580c4..7e4d64229d 100644 --- a/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 +++ b/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 @@ -312,7 +312,7 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var keep_going = .true. do k=1,nz do i=is-1,ie+1 - h_avail(i,j,k) = max(I4dt*G%areaT(i,j)*(h(i,j,k)-GV%Angstrom_H),0.0) + h_avail(i,j,k) = max(I4dt*US%L_to_m**2*G%areaT(i,j)*(h(i,j,k)-GV%Angstrom_H),0.0) enddo if (keep_going) then call calculate_density(tv%T(:,j,k),tv%S(:,j,k),p0,rho_ml(:),is-1,ie-is+3,tv%eqn_of_state) @@ -635,7 +635,7 @@ subroutine mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, dt, G, GV, US, CS) do i=is-1,ie+1 Rml_av(i,j) = Rml_av(i,j) + h(i,j,k)*Rho0(i) htot(i,j) = htot(i,j) + h(i,j,k) - h_avail(i,j,k) = max(I4dt*G%areaT(i,j)*(h(i,j,k)-GV%Angstrom_H),0.0) + h_avail(i,j,k) = max(I4dt*US%L_to_m**2*G%areaT(i,j)*(h(i,j,k)-GV%Angstrom_H),0.0) enddo enddo diff --git a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 index cf19c54e93..c6a05b0401 100644 --- a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 +++ b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 @@ -681,7 +681,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV h_avail_rsum(i,j,1) = 0.0 pres(i,j,1) = 0.0 ! ### This should be atmospheric pressure. - h_avail(i,j,1) = max(I4dt*G%areaT(i,j)*(h(i,j,1)-GV%Angstrom_H),0.0) + h_avail(i,j,1) = max(I4dt*US%L_to_m**2*G%areaT(i,j)*(h(i,j,1)-GV%Angstrom_H),0.0) h_avail_rsum(i,j,2) = h_avail(i,j,1) h_frac(i,j,1) = 1.0 pres(i,j,2) = pres(i,j,1) + GV%H_to_Pa*h(i,j,1) @@ -689,7 +689,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV !$OMP do do j=js-1,je+1 do k=2,nz ; do i=is-1,ie+1 - h_avail(i,j,k) = max(I4dt*G%areaT(i,j)*(h(i,j,k)-GV%Angstrom_H),0.0) + h_avail(i,j,k) = max(I4dt*US%L_to_m**2*G%areaT(i,j)*(h(i,j,k)-GV%Angstrom_H),0.0) h_avail_rsum(i,j,k+1) = h_avail_rsum(i,j,k) + h_avail(i,j,k) h_frac(i,j,k) = 0.0 ; if (h_avail(i,j,k) > 0.0) & h_frac(i,j,k) = h_avail(i,j,k) / h_avail_rsum(i,j,k+1) diff --git a/src/parameterizations/vertical/MOM_diabatic_aux.F90 b/src/parameterizations/vertical/MOM_diabatic_aux.F90 index 88714fb1f6..6354ca8d71 100644 --- a/src/parameterizations/vertical/MOM_diabatic_aux.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_aux.F90 @@ -598,20 +598,20 @@ subroutine find_uv_at_h(u, v, h, u_h, v_h, G, GV, US, ea, eb) !$OMP private(s,Idenom,a_w,a_e,a_s,a_n,b_denom_1,b1,d1,c1) do j=js,je do i=is,ie - s = G%areaCu(I-1,j)+G%areaCu(I,j) + s = US%L_to_m**2*G%areaCu(I-1,j)+US%L_to_m**2*G%areaCu(I,j) if (s>0.0) then Idenom = sqrt(0.5*US%m_to_L**2*G%IareaT(i,j)/s) - a_w(i) = G%areaCu(I-1,j)*Idenom - a_e(i) = G%areaCu(I,j)*Idenom + a_w(i) = US%L_to_m**2*G%areaCu(I-1,j)*Idenom + a_e(i) = US%L_to_m**2*G%areaCu(I,j)*Idenom else a_w(i) = 0.0 ; a_e(i) = 0.0 endif - s = G%areaCv(i,J-1)+G%areaCv(i,J) + s = US%L_to_m**2*G%areaCv(i,J-1)+US%L_to_m**2*G%areaCv(i,J) if (s>0.0) then Idenom = sqrt(0.5*US%m_to_L**2*G%IareaT(i,j)/s) - a_s(i) = G%areaCv(i,J-1)*Idenom - a_n(i) = G%areaCv(i,J)*Idenom + a_s(i) = US%L_to_m**2*G%areaCv(i,J-1)*Idenom + a_n(i) = US%L_to_m**2*G%areaCv(i,J)*Idenom else a_s(i) = 0.0 ; a_n(i) = 0.0 endif diff --git a/src/parameterizations/vertical/MOM_set_diffusivity.F90 b/src/parameterizations/vertical/MOM_set_diffusivity.F90 index 8d2dd41257..1059349454 100644 --- a/src/parameterizations/vertical/MOM_set_diffusivity.F90 +++ b/src/parameterizations/vertical/MOM_set_diffusivity.F90 @@ -1264,10 +1264,10 @@ 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 * US%m_to_L**2*G%IareaT(i,j) * & 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 + & - G%areaCv(i,J) * visc%Ray_v(i,J,k) * v(i,J,k)**2)) + ((US%L_to_m**2*G%areaCu(I-1,j) * visc%Ray_u(I-1,j,k) * u(I-1,j,k)**2 + & + US%L_to_m**2*G%areaCu(I,j) * visc%Ray_u(I,j,k) * u(I,j,k)**2) + & + (US%L_to_m**2*G%areaCv(i,J-1) * visc%Ray_v(i,J-1,k) * v(i,J-1,k)**2 + & + US%L_to_m**2*G%areaCv(i,J) * visc%Ray_v(i,J,k) * v(i,J,k)**2)) if (TKE_to_layer + TKE_Ray > 0.0) then if (CS%BBL_mixing_as_max) then @@ -1445,10 +1445,10 @@ subroutine add_LOTW_BBL_diffusivity(h, u, v, tv, fluxes, visc, j, N2_int, & if (Rayleigh_drag) TKE_remaining = TKE_remaining + & US%m_to_Z**2 * US%T_to_s**2 * & 0.5*CS%BBL_effic * US%m_to_L**2*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) + & - (G%areaCv(i,J-1) * visc%Ray_v(i,J-1,k) * v(i,J-1,k)**2 + & - G%areaCv(i,J) * visc%Ray_v(i,J,k) * v(i,J,k)**2)) + ((US%L_to_m**2*G%areaCu(I-1,j) * visc%Ray_u(I-1,j,k) * u(I-1,j,k)**2 + & + US%L_to_m**2*G%areaCu(I,j) * visc%Ray_u(I,j,k) * u(I,j,k)**2) + & + (US%L_to_m**2*G%areaCv(i,J-1) * visc%Ray_v(i,J-1,k) * v(i,J-1,k)**2 + & + US%L_to_m**2*G%areaCv(i,J) * visc%Ray_v(i,J,k) * v(i,J,k)**2)) ! Exponentially decay TKE across the thickness of the layer. ! This is energy loss in addition to work done as mixing, apparently to Joule heating. @@ -1760,15 +1760,15 @@ subroutine set_BBL_TKE(u, v, h, fluxes, visc, G, GV, US, CS) do i=is,ie visc%ustar_BBL(i,j) = sqrt(0.5*US%m_to_L**2*G%IareaT(i,j) * & - ((G%areaCu(I-1,j)*(ustar(I-1)*ustar(I-1)) + & - 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))) ) ) + ((US%L_to_m**2*G%areaCu(I-1,j)*(ustar(I-1)*ustar(I-1)) + & + US%L_to_m**2*G%areaCu(I,j)*(ustar(I)*ustar(I))) + & + (US%L_to_m**2*G%areaCv(i,J-1)*(vstar(i,J-1)*vstar(i,J-1)) + & + US%L_to_m**2*G%areaCv(i,J)*(vstar(i,J)*vstar(i,J))) ) ) 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)) + & - G%areaCv(i,J) * (vstar(i,J)*v2_bbl(i,J))) )*US%m_to_L**2*G%IareaT(i,j)) + (((US%L_to_m**2*G%areaCu(I-1,j)*(ustar(I-1)*u2_bbl(I-1)) + & + US%L_to_m**2*G%areaCu(I,j) * (ustar(I)*u2_bbl(I))) + & + (US%L_to_m**2*G%areaCv(i,J-1)*(vstar(i,J-1)*v2_bbl(i,J-1)) + & + US%L_to_m**2*G%areaCv(i,J) * (vstar(i,J)*v2_bbl(i,J))) )*US%m_to_L**2*G%IareaT(i,j)) enddo enddo !$OMP end parallel diff --git a/src/parameterizations/vertical/MOM_vert_friction.F90 b/src/parameterizations/vertical/MOM_vert_friction.F90 index c63748c97e..bbf7eac1fa 100644 --- a/src/parameterizations/vertical/MOM_vert_friction.F90 +++ b/src/parameterizations/vertical/MOM_vert_friction.F90 @@ -1422,10 +1422,10 @@ subroutine vertvisc_limit_vel(u, v, h, ADp, CDp, forces, visc, dt, G, GV, US, CS if (trunc_any) then ; if (CS%CFL_based_trunc) then do k=1,nz ; do I=Isq,Ieq if ((u(I,j,k) * (dt * G%dy_Cu(I,j))) * US%m_to_L**2*G%IareaT(i+1,j) < -CS%CFL_trunc) then - u(I,j,k) = (-0.9*CS%CFL_trunc) * (G%areaT(i+1,j) / (dt * G%dy_Cu(I,j))) + u(I,j,k) = (-0.9*CS%CFL_trunc) * (US%L_to_m**2*G%areaT(i+1,j) / (dt * G%dy_Cu(I,j))) if (h(i,j,k) + h(i+1,j,k) > H_report) CS%ntrunc = CS%ntrunc + 1 elseif ((u(I,j,k) * (dt * G%dy_Cu(I,j))) * US%m_to_L**2*G%IareaT(i,j) > CS%CFL_trunc) then - u(I,j,k) = (0.9*CS%CFL_trunc) * (G%areaT(i,j) / (dt * G%dy_Cu(I,j))) + u(I,j,k) = (0.9*CS%CFL_trunc) * (US%L_to_m**2*G%areaT(i,j) / (dt * G%dy_Cu(I,j))) if (h(i,j,k) + h(i+1,j,k) > H_report) CS%ntrunc = CS%ntrunc + 1 endif enddo ; enddo @@ -1442,10 +1442,10 @@ subroutine vertvisc_limit_vel(u, v, h, ADp, CDp, forces, visc, dt, G, GV, US, CS do k=1,nz ; do j=js,je ; do I=Isq,Ieq if (abs(u(I,j,k)) < CS%vel_underflow) then ; u(I,j,k) = 0.0 elseif ((u(I,j,k) * (dt * G%dy_Cu(I,j))) * US%m_to_L**2*G%IareaT(i+1,j) < -CS%CFL_trunc) then - u(I,j,k) = (-0.9*CS%CFL_trunc) * (G%areaT(i+1,j) / (dt * G%dy_Cu(I,j))) + u(I,j,k) = (-0.9*CS%CFL_trunc) * (US%L_to_m**2*G%areaT(i+1,j) / (dt * G%dy_Cu(I,j))) if (h(i,j,k) + h(i+1,j,k) > H_report) CS%ntrunc = CS%ntrunc + 1 elseif ((u(I,j,k) * (dt * G%dy_Cu(I,j))) * US%m_to_L**2*G%IareaT(i,j) > CS%CFL_trunc) then - u(I,j,k) = (0.9*CS%CFL_trunc) * (G%areaT(i,j) / (dt * G%dy_Cu(I,j))) + u(I,j,k) = (0.9*CS%CFL_trunc) * (US%L_to_m**2*G%areaT(i,j) / (dt * G%dy_Cu(I,j))) if (h(i,j,k) + h(i+1,j,k) > H_report) CS%ntrunc = CS%ntrunc + 1 endif enddo ; enddo ; enddo @@ -1507,10 +1507,10 @@ subroutine vertvisc_limit_vel(u, v, h, ADp, CDp, forces, visc, dt, G, GV, US, CS if (trunc_any) then ; if (CS%CFL_based_trunc) then do k=1,nz; do i=is,ie if ((v(i,J,k) * (dt * G%dx_Cv(i,J))) * US%m_to_L**2*G%IareaT(i,j+1) < -CS%CFL_trunc) then - v(i,J,k) = (-0.9*CS%CFL_trunc) * (G%areaT(i,j+1) / (dt * G%dx_Cv(i,J))) + v(i,J,k) = (-0.9*CS%CFL_trunc) * (US%L_to_m**2*G%areaT(i,j+1) / (dt * G%dx_Cv(i,J))) if (h(i,j,k) + h(i,j+1,k) > H_report) CS%ntrunc = CS%ntrunc + 1 elseif ((v(i,J,k) * (dt * G%dx_Cv(i,J))) * US%m_to_L**2*G%IareaT(i,j) > CS%CFL_trunc) then - v(i,J,k) = (0.9*CS%CFL_trunc) * (G%areaT(i,j) / (dt * G%dx_Cv(i,J))) + v(i,J,k) = (0.9*CS%CFL_trunc) * (US%L_to_m**2*G%areaT(i,j) / (dt * G%dx_Cv(i,J))) if (h(i,j,k) + h(i,j+1,k) > H_report) CS%ntrunc = CS%ntrunc + 1 endif enddo ; enddo @@ -1527,10 +1527,10 @@ subroutine vertvisc_limit_vel(u, v, h, ADp, CDp, forces, visc, dt, G, GV, US, CS do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie if (abs(v(i,J,k)) < CS%vel_underflow) then ; v(i,J,k) = 0.0 elseif ((v(i,J,k) * (dt * G%dx_Cv(i,J))) * US%m_to_L**2*G%IareaT(i,j+1) < -CS%CFL_trunc) then - v(i,J,k) = (-0.9*CS%CFL_trunc) * (G%areaT(i,j+1) / (dt * G%dx_Cv(i,J))) + v(i,J,k) = (-0.9*CS%CFL_trunc) * (US%L_to_m**2*G%areaT(i,j+1) / (dt * G%dx_Cv(i,J))) if (h(i,j,k) + h(i,j+1,k) > H_report) CS%ntrunc = CS%ntrunc + 1 elseif ((v(i,J,k) * (dt * G%dx_Cv(i,J))) * US%m_to_L**2*G%IareaT(i,j) > CS%CFL_trunc) then - v(i,J,k) = (0.9*CS%CFL_trunc) * (G%areaT(i,j) / (dt * G%dx_Cv(i,J))) + v(i,J,k) = (0.9*CS%CFL_trunc) * (US%L_to_m**2*G%areaT(i,j) / (dt * G%dx_Cv(i,J))) if (h(i,j,k) + h(i,j+1,k) > H_report) CS%ntrunc = CS%ntrunc + 1 endif enddo ; enddo ; enddo diff --git a/src/tracer/MOM_OCMIP2_CFC.F90 b/src/tracer/MOM_OCMIP2_CFC.F90 index 7d9ed5f0a4..0268c04f17 100644 --- a/src/tracer/MOM_OCMIP2_CFC.F90 +++ b/src/tracer/MOM_OCMIP2_CFC.F90 @@ -528,7 +528,7 @@ function OCMIP2_CFC_stock(h, stocks, G, GV, CS, names, units, stock_index) stocks(1) = 0.0 ; stocks(2) = 0.0 do k=1,nz ; do j=js,je ; do i=is,ie - mass = G%mask2dT(i,j) * G%areaT(i,j) * h(i,j,k) + mass = G%mask2dT(i,j) * G%US%L_to_m**2*G%areaT(i,j) * h(i,j,k) stocks(1) = stocks(1) + CS%CFC11(i,j,k) * mass stocks(2) = stocks(2) + CS%CFC12(i,j,k) * mass enddo ; enddo ; enddo diff --git a/src/tracer/MOM_generic_tracer.F90 b/src/tracer/MOM_generic_tracer.F90 index 7c25f5711a..d12897038f 100644 --- a/src/tracer/MOM_generic_tracer.F90 +++ b/src/tracer/MOM_generic_tracer.F90 @@ -492,7 +492,7 @@ subroutine MOM_generic_tracer_column_physics(h_old, h_new, ea, eb, fluxes, Hml, ! call generic_tracer_source(tv%T,tv%S,rho_dzt,dzt,Hml,G%isd,G%jsd,1,dt,& - G%areaT,get_diag_time_end(CS%diag),& + G%US%L_to_m**2*G%areaT, get_diag_time_end(CS%diag), & optics%nbands, optics%max_wavelength_band, optics%sw_pen_band, optics%opacity_band, & internal_heat=tv%internal_heat, frunoff=fluxes%frunoff, sosga=sosga) @@ -594,7 +594,7 @@ function MOM_generic_tracer_stock(h, stocks, G, GV, CS, names, units, stock_inde tr_ptr => tr_field(:,:,:,1) do k=1,nz ; do j=js,je ; do i=is,ie stocks(m) = stocks(m) + tr_ptr(i,j,k) * & - (G%mask2dT(i,j) * G%areaT(i,j) * h(i,j,k)) + (G%mask2dT(i,j) * G%US%L_to_m**2*G%areaT(i,j) * h(i,j,k)) enddo ; enddo ; enddo stocks(m) = GV%H_to_kg_m2 * stocks(m) diff --git a/src/tracer/MOM_offline_aux.F90 b/src/tracer/MOM_offline_aux.F90 index e8d4424e15..d553af730d 100644 --- a/src/tracer/MOM_offline_aux.F90 +++ b/src/tracer/MOM_offline_aux.F90 @@ -63,17 +63,17 @@ subroutine update_h_horizontal_flux(G, GV, uhtr, vhtr, h_pre, h_new) do k = 1, nz do i=is-1,ie+1 ; do j=js-1,je+1 - h_new(i,j,k) = max(0.0, G%areaT(i,j)*h_pre(i,j,k) + & + h_new(i,j,k) = max(0.0, G%US%L_to_m**2*G%areaT(i,j)*h_pre(i,j,k) + & ((uhtr(I-1,j,k) - uhtr(I,j,k)) + (vhtr(i,J-1,k) - vhtr(i,J,k)))) ! In the case that the layer is now dramatically thinner than it was previously, ! add a bit of mass to avoid truncation errors. This will lead to ! non-conservation of tracers h_new(i,j,k) = h_new(i,j,k) + & - max(GV%Angstrom_H, 1.0e-13*h_new(i,j,k) - G%areaT(i,j)*h_pre(i,j,k)) + max(GV%Angstrom_H, 1.0e-13*h_new(i,j,k) - G%US%L_to_m**2*G%areaT(i,j)*h_pre(i,j,k)) ! Convert back to thickness - h_new(i,j,k) = h_new(i,j,k) / (G%areaT(i,j)) + h_new(i,j,k) = h_new(i,j,k) / (G%US%L_to_m**2*G%areaT(i,j)) enddo ; enddo enddo @@ -189,10 +189,10 @@ subroutine limit_mass_flux_3d(G, GV, uh, vh, ea, eb, h_pre) ! in a given cell and scale it back if it would deplete a layer do k = 1, nz ; do j=js-1,je+1 ; do i=is-1,ie+1 - hvol = h_pre(i,j,k)*G%areaT(i,j) + hvol = h_pre(i,j,k)*G%US%L_to_m**2*G%areaT(i,j) pos_flux = max(0.0,-uh(I-1,j,k)) + max(0.0, -vh(i,J-1,k)) + & max(0.0, uh(I,j,k)) + max(0.0, vh(i,J,k)) + & - max(0.0, top_flux(i,j,k)*G%areaT(i,j)) + max(0.0, bottom_flux(i,j,k)*G%areaT(i,j)) + max(0.0, top_flux(i,j,k)*G%US%L_to_m**2*G%areaT(i,j)) + max(0.0, bottom_flux(i,j,k)*G%US%L_to_m**2*G%areaT(i,j)) if (pos_flux>hvol .and. pos_flux>0.0) then scale_factor = ( hvol )/pos_flux*max_off_cfl @@ -294,7 +294,7 @@ subroutine distribute_residual_uh_barotropic(G, GV, hvol, uh) endif ! Calculate and check that column integrated transports match the original to ! within the tolerance limit - uh_neglect = GV%Angstrom_H*min(G%areaT(i,j),G%areaT(i+1,j)) + uh_neglect = GV%Angstrom_H*min(G%US%L_to_m**2*G%areaT(i,j),G%US%L_to_m**2*G%areaT(i+1,j)) if ( abs(sum(uh2d(I,:))-uh2d_sum(I)) > uh_neglect) & call MOM_error(WARNING,"Column integral of uh does not match after "//& "barotropic redistribution") @@ -364,7 +364,7 @@ subroutine distribute_residual_vh_barotropic(G, GV, hvol, vh) endif ! Calculate and check that column integrated transports match the original to ! within the tolerance limit - vh_neglect = GV%Angstrom_H*min(G%areaT(i,j),G%areaT(i,j+1)) + vh_neglect = GV%Angstrom_H*min(G%US%L_to_m**2*G%areaT(i,j),G%US%L_to_m**2*G%areaT(i,j+1)) if ( abs(sum(vh2d(J,:))-vh2d_sum(J)) > vh_neglect) then call MOM_error(WARNING,"Column integral of vh does not match after "//& "barotropic redistribution") @@ -409,7 +409,7 @@ subroutine distribute_residual_uh_upwards(G, GV, hvol, uh) enddo ; enddo do k=1,nz ; do i=is-1,ie+1 ! Subtract just a little bit of thickness to avoid roundoff errors - h2d(i,k) = hvol(i,j,k)-min_h*G%areaT(i,j) + h2d(i,k) = hvol(i,j,k)-min_h*G%US%L_to_m**2*G%areaT(i,j) enddo ; enddo do i=is-1,ie @@ -460,7 +460,7 @@ subroutine distribute_residual_uh_upwards(G, GV, hvol, uh) ! Calculate and check that column integrated transports match the original to ! within the tolerance limit - uh_neglect = GV%Angstrom_H*min(G%areaT(i,j),G%areaT(i+1,j)) + uh_neglect = GV%Angstrom_H*min(G%US%L_to_m**2*G%areaT(i,j),G%US%L_to_m**2*G%areaT(i+1,j)) if (abs(uh_col - sum(uh2d(I,:)))>uh_neglect) then call MOM_error(WARNING,"Column integral of uh does not match after "//& "upwards redistribution") @@ -506,7 +506,7 @@ subroutine distribute_residual_vh_upwards(G, GV, hvol, vh) vh2d(J,k) = vh(i,J,k) enddo ; enddo do k=1,nz ; do j=js-1,je+1 - h2d(j,k) = hvol(i,j,k)-min_h*G%areaT(i,j) + h2d(j,k) = hvol(i,j,k)-min_h*G%US%L_to_m**2*G%areaT(i,j) enddo ; enddo do j=js-1,je @@ -558,7 +558,7 @@ subroutine distribute_residual_vh_upwards(G, GV, hvol, vh) ! Calculate and check that column integrated transports match the original to ! within the tolerance limit - vh_neglect = GV%Angstrom_H*min(G%areaT(i,j),G%areaT(i,j+1)) + vh_neglect = GV%Angstrom_H*min(G%US%L_to_m**2*G%areaT(i,j),G%US%L_to_m**2*G%areaT(i,j+1)) if ( ABS(vh_col-SUM(vh2d(J,:))) > vh_neglect) then call MOM_error(WARNING,"Column integral of vh does not match after "//& "upwards redistribution") diff --git a/src/tracer/MOM_offline_main.F90 b/src/tracer/MOM_offline_main.F90 index f43a7d4e05..bd482e241b 100644 --- a/src/tracer/MOM_offline_main.F90 +++ b/src/tracer/MOM_offline_main.F90 @@ -322,7 +322,7 @@ subroutine offline_advection_ale(fluxes, Time_start, time_interval, CS, id_clock do iter=1,CS%num_off_iter do k=1,nz ; do j=js,je ; do i=is,ie - h_vol(i,j,k) = h_new(i,j,k) * G%areaT(i,j) + h_vol(i,j,k) = h_new(i,j,k) * G%US%L_to_m**2*G%areaT(i,j) h_pre(i,j,k) = h_new(i,j,k) enddo ; enddo ; enddo @@ -342,7 +342,7 @@ subroutine offline_advection_ale(fluxes, Time_start, time_interval, CS, id_clock ! Update the new layer thicknesses after one round of advection has happened do k=1,nz ; do j=js,je ; do i=is,ie - h_new(i,j,k) = h_new(i,j,k) / (G%areaT(i,j)) + h_new(i,j,k) = h_new(i,j,k) / (G%US%L_to_m**2*G%areaT(i,j)) enddo ; enddo ; enddo if (MODULO(iter,CS%off_ale_mod)==0) then @@ -483,7 +483,7 @@ subroutine offline_redistribute_residual(CS, h_pre, uhtr, vhtr, converged) ! Calculate the layer volumes at beginning of redistribute do k=1,nz ; do j=js,je ; do i=is,ie - h_vol(i,j,k) = h_pre(i,j,k)*G%areaT(i,j) + h_vol(i,j,k) = h_pre(i,j,k)*G%US%L_to_m**2*G%areaT(i,j) enddo ; enddo ; enddo call pass_var(h_vol,G%Domain) call pass_vector(uhtr,vhtr,G%Domain) @@ -517,7 +517,7 @@ subroutine offline_redistribute_residual(CS, h_pre, uhtr, vhtr, converged) uhtr(I,j,k) = uhr(I,j,k) vhtr(i,J,k) = vhr(i,J,k) h_vol(i,j,k) = h_new(i,j,k) - h_new(i,j,k) = h_new(i,j,k) / (G%areaT(i,j)) + h_new(i,j,k) = h_new(i,j,k) / (G%US%L_to_m**2*G%areaT(i,j)) h_pre(i,j,k) = h_new(i,j,k) enddo ; enddo ; enddo @@ -528,7 +528,7 @@ subroutine offline_redistribute_residual(CS, h_pre, uhtr, vhtr, converged) ! Calculate the layer volumes at beginning of redistribute do k=1,nz ; do j=js,je ; do i=is,ie - h_vol(i,j,k) = h_pre(i,j,k)*G%areaT(i,j) + h_vol(i,j,k) = h_pre(i,j,k)*G%US%L_to_m**2*G%areaT(i,j) enddo ; enddo ; enddo call pass_var(h_vol,G%Domain) call pass_vector(uhtr,vhtr,G%Domain) @@ -562,7 +562,7 @@ subroutine offline_redistribute_residual(CS, h_pre, uhtr, vhtr, converged) uhtr(I,j,k) = uhr(I,j,k) vhtr(i,J,k) = vhr(i,J,k) h_vol(i,j,k) = h_new(i,j,k) - h_new(i,j,k) = h_new(i,j,k) / (G%areaT(i,j)) + h_new(i,j,k) = h_new(i,j,k) / (G%US%L_to_m**2*G%areaT(i,j)) h_pre(i,j,k) = h_new(i,j,k) enddo ; enddo ; enddo @@ -628,8 +628,8 @@ real function remaining_transport_sum(CS, uhtr, vhtr) remaining_transport_sum = 0. do k=1,nz; do j=js,je ; do i=is,ie - uh_neglect = h_min*MIN(CS%G%areaT(i,j),CS%G%areaT(i+1,j)) - vh_neglect = h_min*MIN(CS%G%areaT(i,j),CS%G%areaT(i,j+1)) + uh_neglect = h_min*CS%G%US%L_to_m**2*MIN(CS%G%areaT(i,j),CS%G%areaT(i+1,j)) + vh_neglect = h_min*CS%G%US%L_to_m**2*MIN(CS%G%areaT(i,j),CS%G%areaT(i,j+1)) if (ABS(uhtr(I,j,k))>uh_neglect) then remaining_transport_sum = remaining_transport_sum + ABS(uhtr(I,j,k)) endif @@ -917,7 +917,7 @@ subroutine offline_advection_layer(fluxes, Time_start, time_interval, CS, h_pre, ! Second zonal and meridional advection call update_h_horizontal_flux(G, GV, uhtr_sub, vhtr_sub, h_pre, h_new) do k = 1, nz ; do i = is-1, ie+1 ; do j=js-1, je+1 - h_vol(i,j,k) = h_pre(i,j,k)*G%areaT(i,j) + h_vol(i,j,k) = h_pre(i,j,k)*G%US%L_to_m**2*G%areaT(i,j) enddo ; enddo ; enddo call advect_tracer(h_pre, uhtr_sub, vhtr_sub, CS%OBC, dt_iter, G, GV, CS%US, & CS%tracer_adv_CSp, CS%tracer_Reg, h_vol, max_iter_in=30, x_first_in=x_before_y) @@ -934,7 +934,7 @@ subroutine offline_advection_layer(fluxes, Time_start, time_interval, CS, h_pre, ! First zonal and meridional advection call update_h_horizontal_flux(G, GV, uhtr_sub, vhtr_sub, h_pre, h_new) do k = 1, nz ; do i = is-1, ie+1 ; do j=js-1, je+1 - h_vol(i,j,k) = h_pre(i,j,k)*G%areaT(i,j) + h_vol(i,j,k) = h_pre(i,j,k)*G%US%L_to_m**2*G%areaT(i,j) enddo ; enddo ; enddo call advect_tracer(h_pre, uhtr_sub, vhtr_sub, CS%OBC, dt_iter, G, GV, CS%US, & CS%tracer_adv_CSp, CS%tracer_Reg, h_vol, max_iter_in=30, x_first_in=x_before_y) diff --git a/src/tracer/MOM_tracer_advect.F90 b/src/tracer/MOM_tracer_advect.F90 index af5cb3495d..ecf9a09058 100644 --- a/src/tracer/MOM_tracer_advect.F90 +++ b/src/tracer/MOM_tracer_advect.F90 @@ -157,13 +157,13 @@ subroutine advect_tracer(h_end, uhtr, vhtr, OBC, dt, G, GV, US, CS, Reg, & ! tracers were updated, probably just after the diabatic forcing. A useful ! diagnostic could be to compare this reconstruction with that older value. do i=is,ie ; do j=js,je - hprev(i,j,k) = max(0.0, US%m_to_L**2*G%areaT(i,j)*h_end(i,j,k) + & + hprev(i,j,k) = max(0.0, G%areaT(i,j)*h_end(i,j,k) + & ((uhr(I,j,k) - uhr(I-1,j,k)) + (vhr(i,J,k) - vhr(i,J-1,k)))) ! In the case that the layer is now dramatically thinner than it was previously, ! add a bit of mass to avoid truncation errors. This will lead to ! non-conservation of tracers hprev(i,j,k) = hprev(i,j,k) + & - max(0.0, 1.0e-13*hprev(i,j,k) - US%m_to_L**2*G%areaT(i,j)*h_end(i,j,k)) + max(0.0, 1.0e-13*hprev(i,j,k) - G%areaT(i,j)*h_end(i,j,k)) enddo ; enddo else do i=is,ie ; do j=js,je @@ -175,11 +175,11 @@ subroutine advect_tracer(h_end, uhtr, vhtr, OBC, dt, G, GV, US, CS, Reg, & !$OMP do do j=jsd,jed ; do I=isd,ied-1 - uh_neglect(I,j) = GV%H_subroundoff*MIN(US%m_to_L**2*G%areaT(i,j),US%m_to_L**2*G%areaT(i+1,j)) + uh_neglect(I,j) = GV%H_subroundoff*MIN(G%areaT(i,j),G%areaT(i+1,j)) enddo ; enddo !$OMP do do J=jsd,jed-1 ; do i=isd,ied - vh_neglect(i,J) = GV%H_subroundoff*MIN(US%m_to_L**2*G%areaT(i,j),US%m_to_L**2*G%areaT(i,j+1)) + vh_neglect(i,J) = GV%H_subroundoff*MIN(G%areaT(i,j),G%areaT(i,j+1)) enddo ; enddo !$OMP do @@ -431,7 +431,7 @@ subroutine advect_x(Tr, hprev, uhr, uh_neglect, OBC, domore_u, ntr, Idt, & uhh(I) = 0.0 CFL(I) = 0.0 elseif (uhr(I,j,k) < 0.0) then - hup = hprev(i+1,j,k) - US%m_to_L**2*G%areaT(i+1,j)*min_h + hup = hprev(i+1,j,k) - G%areaT(i+1,j)*min_h hlos = MAX(0.0,uhr(I+1,j,k)) if ((((hup - hlos) + uhr(I,j,k)) < 0.0) .and. & ((0.5*hup + uhr(I,j,k)) < 0.0)) then @@ -443,7 +443,7 @@ subroutine advect_x(Tr, hprev, uhr, uh_neglect, OBC, domore_u, ntr, Idt, & !ts2(I) = 0.5*(1.0 + uhh(I)/(hprev(i+1,j,k)+h_neglect)) CFL(I) = - uhh(I)/(hprev(i+1,j,k)+h_neglect) ! CFL is positive else - hup = hprev(i,j,k) - US%m_to_L**2*G%areaT(i,j)*min_h + hup = hprev(i,j,k) - G%areaT(i,j)*min_h hlos = MAX(0.0,-uhr(I-1,j,k)) if ((((hup - hlos) - uhr(I,j,k)) < 0.0) .and. & ((0.5*hup - uhr(I,j,k)) < 0.0)) then @@ -612,9 +612,9 @@ subroutine advect_x(Tr, hprev, uhr, uh_neglect, OBC, domore_u, ntr, Idt, & hlst(i) = hprev(i,j,k) hprev(i,j,k) = hprev(i,j,k) - (uhh(I) - uhh(I-1)) if (hprev(i,j,k) <= 0.0) then ; do_i(i) = .false. - elseif (hprev(i,j,k) < h_neglect*US%m_to_L**2*G%areaT(i,j)) then - hlst(i) = hlst(i) + (h_neglect*US%m_to_L**2*G%areaT(i,j) - hprev(i,j,k)) - Ihnew(i) = 1.0 / (h_neglect*US%m_to_L**2*G%areaT(i,j)) + elseif (hprev(i,j,k) < h_neglect*G%areaT(i,j)) then + hlst(i) = hlst(i) + (h_neglect*G%areaT(i,j) - hprev(i,j,k)) + Ihnew(i) = 1.0 / (h_neglect*G%areaT(i,j)) else ; Ihnew(i) = 1.0 / hprev(i,j,k) ; endif else do_i(i) = .false. @@ -773,7 +773,7 @@ subroutine advect_y(Tr, hprev, vhr, vh_neglect, OBC, domore_v, ntr, Idt, & vhh(i,J) = 0.0 CFL(i) = 0.0 elseif (vhr(i,J,k) < 0.0) then - hup = hprev(i,j+1,k) - US%m_to_L**2*G%areaT(i,j+1)*min_h + hup = hprev(i,j+1,k) - G%areaT(i,j+1)*min_h hlos = MAX(0.0,vhr(i,J+1,k)) if ((((hup - hlos) + vhr(i,J,k)) < 0.0) .and. & ((0.5*hup + vhr(i,J,k)) < 0.0)) then @@ -785,7 +785,7 @@ subroutine advect_y(Tr, hprev, vhr, vh_neglect, OBC, domore_v, ntr, Idt, & !ts2(i) = 0.5*(1.0 + vhh(i,J) / (hprev(i,j+1,k)+h_neglect)) CFL(i) = - vhh(i,J) / (hprev(i,j+1,k)+h_neglect) ! CFL is positive else - hup = hprev(i,j,k) - US%m_to_L**2*G%areaT(i,j)*min_h + hup = hprev(i,j,k) - G%areaT(i,j)*min_h hlos = MAX(0.0,-vhr(i,J-1,k)) if ((((hup - hlos) - vhr(i,J,k)) < 0.0) .and. & ((0.5*hup - vhr(i,J,k)) < 0.0)) then @@ -958,9 +958,9 @@ subroutine advect_y(Tr, hprev, vhr, vh_neglect, OBC, domore_v, ntr, Idt, & hlst(i) = hprev(i,j,k) hprev(i,j,k) = max(hprev(i,j,k) - (vhh(i,J) - vhh(i,J-1)), 0.0) if (hprev(i,j,k) <= 0.0) then ; do_i(i) = .false. - elseif (hprev(i,j,k) < h_neglect*US%m_to_L**2*G%areaT(i,j)) then - hlst(i) = hlst(i) + (h_neglect*US%m_to_L**2*G%areaT(i,j) - hprev(i,j,k)) - Ihnew(i) = 1.0 / (h_neglect*US%m_to_L**2*G%areaT(i,j)) + elseif (hprev(i,j,k) < h_neglect*G%areaT(i,j)) then + hlst(i) = hlst(i) + (h_neglect*G%areaT(i,j) - hprev(i,j,k)) + Ihnew(i) = 1.0 / (h_neglect*G%areaT(i,j)) else ; Ihnew(i) = 1.0 / hprev(i,j,k) ; endif else ; do_i(i) = .false. ; endif enddo diff --git a/src/tracer/MOM_tracer_hor_diff.F90 b/src/tracer/MOM_tracer_hor_diff.F90 index 29b5cde89a..8e9333e7a1 100644 --- a/src/tracer/MOM_tracer_hor_diff.F90 +++ b/src/tracer/MOM_tracer_hor_diff.F90 @@ -294,7 +294,7 @@ subroutine tracer_hordiff(h, dt, MEKE, VarMix, G, GV, US, CS, Reg, tv, do_online if ((CS%id_KhTr_u > 0) .or. (CS%id_KhTr_h > 0)) then !$OMP parallel do default(shared) private(khdt_max) do j=js,je ; do I=is-1,ie - khdt_max = 0.125*CS%max_diff_CFL * min(G%areaT(i,j), G%areaT(i+1,j)) + khdt_max = 0.125*CS%max_diff_CFL * min(US%L_to_m**2*G%areaT(i,j), US%L_to_m**2*G%areaT(i+1,j)) if (khdt_x(I,j) > khdt_max) then khdt_x(I,j) = khdt_max if (dt*(G%dy_Cu(I,j)*G%IdxCu(I,j)) > 0.0) & @@ -304,14 +304,14 @@ subroutine tracer_hordiff(h, dt, MEKE, VarMix, G, GV, US, CS, Reg, tv, do_online else !$OMP parallel do default(shared) private(khdt_max) do j=js,je ; do I=is-1,ie - khdt_max = 0.125*CS%max_diff_CFL * min(G%areaT(i,j), G%areaT(i+1,j)) + khdt_max = 0.125*CS%max_diff_CFL * min(US%L_to_m**2*G%areaT(i,j), US%L_to_m**2*G%areaT(i+1,j)) khdt_x(I,j) = min(khdt_x(I,j), khdt_max) enddo ; enddo endif if ((CS%id_KhTr_v > 0) .or. (CS%id_KhTr_h > 0)) then !$OMP parallel do default(shared) private(khdt_max) do J=js-1,je ; do i=is,ie - khdt_max = 0.125*CS%max_diff_CFL * min(G%areaT(i,j), G%areaT(i,j+1)) + khdt_max = 0.125*CS%max_diff_CFL * min(US%L_to_m**2*G%areaT(i,j), US%L_to_m**2*G%areaT(i,j+1)) if (khdt_y(i,J) > khdt_max) then khdt_y(i,J) = khdt_max if (dt*(G%dx_Cv(i,J)*G%IdyCv(i,J)) > 0.0) & @@ -321,7 +321,7 @@ subroutine tracer_hordiff(h, dt, MEKE, VarMix, G, GV, US, CS, Reg, tv, do_online else !$OMP parallel do default(shared) private(khdt_max) do J=js-1,je ; do i=is,ie - khdt_max = 0.125*CS%max_diff_CFL * min(G%areaT(i,j), G%areaT(i,j+1)) + khdt_max = 0.125*CS%max_diff_CFL * min(US%L_to_m**2*G%areaT(i,j), US%L_to_m**2*G%areaT(i,j+1)) khdt_y(i,J) = min(khdt_y(i,J), khdt_max) enddo ; enddo endif @@ -1129,7 +1129,7 @@ subroutine tracer_epipycnal_ML_diff(h, dt, Tr, ntr, khdt_epi_x, khdt_epi_y, G, & else Tr_adj_vert = 0.0 wt_b = deep_wt_Lu(j)%p(I,k) ; wt_a = 1.0 - wt_b - vol = hP_Lu(j)%p(I,k) * G%areaT(i,j) + vol = hP_Lu(j)%p(I,k) * G%US%L_to_m**2*G%areaT(i,j) ! Ensure that the tracer flux does not drive the tracer values ! outside of the range Tr_min_face <= Tr <= Tr_max_face, or if it @@ -1164,7 +1164,7 @@ subroutine tracer_epipycnal_ML_diff(h, dt, Tr, ntr, khdt_epi_x, khdt_epi_y, G, & else Tr_adj_vert = 0.0 wt_b = deep_wt_Ru(j)%p(I,k) ; wt_a = 1.0 - wt_b - vol = hP_Ru(j)%p(I,k) * G%areaT(i+1,j) + vol = hP_Ru(j)%p(I,k) * G%US%L_to_m**2*G%areaT(i+1,j) ! Ensure that the tracer flux does not drive the tracer values ! outside of the range Tr_min_face <= Tr <= Tr_max_face, or if it @@ -1266,7 +1266,7 @@ subroutine tracer_epipycnal_ML_diff(h, dt, Tr, ntr, khdt_epi_x, khdt_epi_y, G, & if (deep_wt_Lv(J)%p(i,k) < 1.0) then Tr_adj_vert = 0.0 wt_b = deep_wt_Lv(J)%p(i,k) ; wt_a = 1.0 - wt_b - vol = hP_Lv(J)%p(i,k) * G%areaT(i,j) + vol = hP_Lv(J)%p(i,k) * G%US%L_to_m**2*G%areaT(i,j) ! Ensure that the tracer flux does not drive the tracer values ! outside of the range Tr_min_face <= Tr <= Tr_max_face. @@ -1293,7 +1293,7 @@ subroutine tracer_epipycnal_ML_diff(h, dt, Tr, ntr, khdt_epi_x, khdt_epi_y, G, & if (deep_wt_Rv(J)%p(i,k) < 1.0) then Tr_adj_vert = 0.0 wt_b = deep_wt_Rv(J)%p(i,k) ; wt_a = 1.0 - wt_b - vol = hP_Rv(J)%p(i,k) * G%areaT(i,j+1) + vol = hP_Rv(J)%p(i,k) * G%US%L_to_m**2*G%areaT(i,j+1) ! Ensure that the tracer flux does not drive the tracer values ! outside of the range Tr_min_face <= Tr <= Tr_max_face. @@ -1351,7 +1351,7 @@ subroutine tracer_epipycnal_ML_diff(h, dt, Tr, ntr, khdt_epi_x, khdt_epi_y, G, & do k=1,PEmax_kRho ; do j=js,je ; do i=is,ie if ((G%mask2dT(i,j) > 0.5) .and. (h(i,j,k) > 0.0)) then Tr(m)%t(i,j,k) = Tr(m)%t(i,j,k) + tr_flux_conv(i,j,k) / & - (h(i,j,k)*G%areaT(i,j)) + (h(i,j,k)*G%US%L_to_m**2*G%areaT(i,j)) tr_flux_conv(i,j,k) = 0.0 endif enddo ; enddo ; enddo diff --git a/src/tracer/MOM_tracer_registry.F90 b/src/tracer/MOM_tracer_registry.F90 index cbaf18d983..4680c058b4 100644 --- a/src/tracer/MOM_tracer_registry.F90 +++ b/src/tracer/MOM_tracer_registry.F90 @@ -738,7 +738,7 @@ subroutine MOM_tracer_chkinv(mesg, G, h, Tr, ntr) is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke do m=1,ntr do k=1,nz ; do j=js,je ; do i=is,ie - tr_inv(i,j,k) = Tr(m)%t(i,j,k)*h(i,j,k)*G%areaT(i,j)*G%mask2dT(i,j) + tr_inv(i,j,k) = Tr(m)%t(i,j,k)*h(i,j,k)*G%US%L_to_m**2*G%areaT(i,j)*G%mask2dT(i,j) enddo ; enddo ; enddo total_inv = reproducing_sum(tr_inv, is+(1-G%isd), ie+(1-G%isd), js+(1-G%jsd), je+(1-G%jsd)) if (is_root_pe()) write(0,'(A,1X,A5,1X,ES25.16,1X,A)') "h-point: inventory", Tr(m)%name, total_inv, mesg diff --git a/src/tracer/advection_test_tracer.F90 b/src/tracer/advection_test_tracer.F90 index 4db1e9dacd..12fd1e08a1 100644 --- a/src/tracer/advection_test_tracer.F90 +++ b/src/tracer/advection_test_tracer.F90 @@ -381,7 +381,7 @@ function advection_test_stock(h, stocks, G, GV, CS, names, units, stock_index) stocks(m) = 0.0 do k=1,nz ; do j=js,je ; do i=is,ie stocks(m) = stocks(m) + CS%tr(i,j,k,m) * & - (G%mask2dT(i,j) * G%areaT(i,j) * h(i,j,k)) + (G%mask2dT(i,j) * G%US%L_to_m**2*G%areaT(i,j) * h(i,j,k)) enddo ; enddo ; enddo stocks(m) = GV%H_to_kg_m2 * stocks(m) enddo diff --git a/src/tracer/boundary_impulse_tracer.F90 b/src/tracer/boundary_impulse_tracer.F90 index 946a5f981f..e712686521 100644 --- a/src/tracer/boundary_impulse_tracer.F90 +++ b/src/tracer/boundary_impulse_tracer.F90 @@ -320,7 +320,7 @@ function boundary_impulse_stock(h, stocks, G, GV, CS, names, units, stock_index) stocks(m) = 0.0 do k=1,nz ; do j=js,je ; do i=is,ie stocks(m) = stocks(m) + CS%tr(i,j,k,m) * & - (G%mask2dT(i,j) * G%areaT(i,j) * h(i,j,k)) + (G%mask2dT(i,j) * G%US%L_to_m**2*G%areaT(i,j) * h(i,j,k)) enddo ; enddo ; enddo stocks(m) = GV%H_to_kg_m2 * stocks(m) enddo diff --git a/src/tracer/dye_example.F90 b/src/tracer/dye_example.F90 index 39e250da65..92f8491a49 100644 --- a/src/tracer/dye_example.F90 +++ b/src/tracer/dye_example.F90 @@ -360,7 +360,7 @@ function dye_stock(h, stocks, G, GV, CS, names, units, stock_index) stocks(m) = 0.0 do k=1,nz ; do j=js,je ; do i=is,ie stocks(m) = stocks(m) + CS%tr(i,j,k,m) * & - (G%mask2dT(i,j) * G%areaT(i,j) * h(i,j,k)) + (G%mask2dT(i,j) * G%US%L_to_m**2*G%areaT(i,j) * h(i,j,k)) enddo ; enddo ; enddo stocks(m) = GV%H_to_kg_m2 * stocks(m) enddo diff --git a/src/tracer/ideal_age_example.F90 b/src/tracer/ideal_age_example.F90 index d59fddbcba..35975bccb0 100644 --- a/src/tracer/ideal_age_example.F90 +++ b/src/tracer/ideal_age_example.F90 @@ -407,7 +407,7 @@ function ideal_age_stock(h, stocks, G, GV, CS, names, units, stock_index) stocks(m) = 0.0 do k=1,nz ; do j=js,je ; do i=is,ie stocks(m) = stocks(m) + CS%tr(i,j,k,m) * & - (G%mask2dT(i,j) * G%areaT(i,j) * h(i,j,k)) + (G%mask2dT(i,j) * G%US%L_to_m**2*G%areaT(i,j) * h(i,j,k)) enddo ; enddo ; enddo stocks(m) = GV%H_to_kg_m2 * stocks(m) enddo diff --git a/src/tracer/oil_tracer.F90 b/src/tracer/oil_tracer.F90 index 7730b8f12e..09fab89b70 100644 --- a/src/tracer/oil_tracer.F90 +++ b/src/tracer/oil_tracer.F90 @@ -384,7 +384,7 @@ subroutine oil_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, CS if (k>0) then k=min(k,k_max) ! Only insert k or first layer with interface 10 m above bottom CS%tr(i,j,k,m) = CS%tr(i,j,k,m) + CS%oil_source_rate*dt / & - ((h_new(i,j,k)+GV%H_subroundoff) * G%areaT(i,j) ) + ((h_new(i,j,k)+GV%H_subroundoff) * G%US%L_to_m**2*G%areaT(i,j) ) elseif (k<0) then h_total=GV%H_subroundoff do k=1, nz @@ -392,7 +392,7 @@ subroutine oil_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, CS enddo do k=1, nz CS%tr(i,j,k,m) = CS%tr(i,j,k,m) + CS%oil_source_rate*dt/(h_total & - * G%areaT(i,j) ) + * G%US%L_to_m**2*G%areaT(i,j) ) enddo endif enddo @@ -441,7 +441,7 @@ function oil_stock(h, stocks, G, GV, CS, names, units, stock_index) stocks(m) = 0.0 do k=1,nz ; do j=js,je ; do i=is,ie stocks(m) = stocks(m) + CS%tr(i,j,k,m) * & - (G%mask2dT(i,j) * G%areaT(i,j) * h(i,j,k)) + (G%mask2dT(i,j) * G%US%L_to_m**2*G%areaT(i,j) * h(i,j,k)) enddo ; enddo ; enddo stocks(m) = GV%H_to_kg_m2 * stocks(m) enddo diff --git a/src/tracer/pseudo_salt_tracer.F90 b/src/tracer/pseudo_salt_tracer.F90 index ea3ccb8928..af4c1e9659 100644 --- a/src/tracer/pseudo_salt_tracer.F90 +++ b/src/tracer/pseudo_salt_tracer.F90 @@ -286,7 +286,7 @@ function pseudo_salt_stock(h, stocks, G, GV, CS, names, units, stock_index) stocks(1) = 0.0 do k=1,nz ; do j=js,je ; do i=is,ie stocks(1) = stocks(1) + CS%diff(i,j,k) * & - (G%mask2dT(i,j) * G%areaT(i,j) * h(i,j,k)) + (G%mask2dT(i,j) * G%US%L_to_m**2*G%areaT(i,j) * h(i,j,k)) enddo ; enddo ; enddo stocks(1) = GV%H_to_kg_m2 * stocks(1) diff --git a/src/tracer/tracer_example.F90 b/src/tracer/tracer_example.F90 index 9b36254206..aa9d34c4e1 100644 --- a/src/tracer/tracer_example.F90 +++ b/src/tracer/tracer_example.F90 @@ -393,7 +393,7 @@ function USER_tracer_stock(h, stocks, G, GV, CS, names, units, stock_index) stocks(m) = 0.0 do k=1,nz ; do j=js,je ; do i=is,ie stocks(m) = stocks(m) + CS%tr(i,j,k,m) * & - (G%mask2dT(i,j) * G%areaT(i,j) * h(i,j,k)) + (G%mask2dT(i,j) * G%US%L_to_m**2*G%areaT(i,j) * h(i,j,k)) enddo ; enddo ; enddo stocks(m) = GV%H_to_kg_m2 * stocks(m) enddo From a673354a5c784424251628907cfc4525d974a379 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sat, 3 Aug 2019 09:29:16 -0400 Subject: [PATCH 145/297] +Rescaled the units of G%dy_Cu and G%dx_Cv Rescaled G%dy_Cu and G%dx_Cv throughout the MOM6 code to units of [L]. All answers are bitwise identical, but the units of two elements a public type have changed. --- src/core/MOM_CoriolisAdv.F90 | 12 +-- src/core/MOM_barotropic.F90 | 20 ++-- src/core/MOM_continuity_PPM.F90 | 96 +++++++++---------- src/core/MOM_grid.F90 | 10 +- src/core/MOM_open_boundary.F90 | 2 +- src/diagnostics/MOM_PointAccel.F90 | 12 +-- src/diagnostics/MOM_diagnostics.F90 | 4 +- src/diagnostics/MOM_sum_output.F90 | 8 +- src/framework/MOM_dyn_horgrid.F90 | 12 +-- src/initialization/MOM_grid_initialize.F90 | 8 +- .../MOM_shared_initialization.F90 | 87 +++++++++-------- .../MOM_state_initialization.F90 | 4 +- src/parameterizations/lateral/MOM_MEKE.F90 | 24 ++--- .../lateral/MOM_hor_visc.F90 | 48 +++++----- .../lateral/MOM_internal_tides.F90 | 30 +++--- .../lateral/MOM_thickness_diffuse.F90 | 20 ++-- .../vertical/MOM_set_viscosity.F90 | 4 +- .../vertical/MOM_vert_friction.F90 | 40 ++++---- src/tracer/MOM_tracer_hor_diff.F90 | 24 ++--- src/user/MOM_controlled_forcing.F90 | 12 +-- 20 files changed, 242 insertions(+), 235 deletions(-) diff --git a/src/core/MOM_CoriolisAdv.F90 b/src/core/MOM_CoriolisAdv.F90 index 124ad3a166..b144e6f58f 100644 --- a/src/core/MOM_CoriolisAdv.F90 +++ b/src/core/MOM_CoriolisAdv.F90 @@ -273,10 +273,10 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS) enddo ; enddo if (CS%Coriolis_En_Dis) then do j=Jsq,Jeq+1 ; do I=is-1,ie - uh_center(I,j) = 0.5 * (US%m_to_L*G%dy_Cu(I,j) * US%m_s_to_L_T*u(I,j,k)) * (h(i,j,k) + h(i+1,j,k)) + uh_center(I,j) = 0.5 * (G%dy_Cu(I,j) * US%m_s_to_L_T*u(I,j,k)) * (h(i,j,k) + h(i+1,j,k)) enddo ; enddo do J=js-1,je ; do i=Isq,Ieq+1 - vh_center(i,J) = 0.5 * (US%m_to_L*G%dx_Cv(i,J) * US%m_s_to_L_T*v(i,J,k)) * (h(i,j,k) + h(i,j+1,k)) + vh_center(i,J) = 0.5 * (G%dx_Cv(i,J) * US%m_s_to_L_T*v(i,J,k)) * (h(i,j,k) + h(i,j+1,k)) enddo ; enddo endif @@ -319,9 +319,9 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS) if (CS%Coriolis_En_Dis) then do i = max(Isq-1,OBC%segment(n)%HI%isd), min(Ieq+2,OBC%segment(n)%HI%ied) if (OBC%segment(n)%direction == OBC_DIRECTION_N) then - vh_center(i,J) = US%m_to_L*G%dx_Cv(i,J) * US%m_s_to_L_T*v(i,J,k) * h(i,j,k) + vh_center(i,J) = G%dx_Cv(i,J) * US%m_s_to_L_T*v(i,J,k) * h(i,j,k) else ! (OBC%segment(n)%direction == OBC_DIRECTION_S) - vh_center(i,J) = US%m_to_L*G%dx_Cv(i,J) * US%m_s_to_L_T*v(i,J,k) * h(i,j+1,k) + vh_center(i,J) = G%dx_Cv(i,J) * US%m_s_to_L_T*v(i,J,k) * h(i,j+1,k) endif enddo endif @@ -358,9 +358,9 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS) if (CS%Coriolis_En_Dis) then do j = max(Jsq-1,OBC%segment(n)%HI%jsd), min(Jeq+2,OBC%segment(n)%HI%jed) if (OBC%segment(n)%direction == OBC_DIRECTION_E) then - uh_center(I,j) = US%m_to_L*G%dy_Cu(I,j) * US%m_s_to_L_T*u(I,j,k) * h(i,j,k) + uh_center(I,j) = G%dy_Cu(I,j) * US%m_s_to_L_T*u(I,j,k) * h(i,j,k) else ! (OBC%segment(n)%direction == OBC_DIRECTION_W) - uh_center(I,j) = US%m_to_L*G%dy_Cu(I,j) * US%m_s_to_L_T*u(I,j,k) * h(i+1,j,k) + uh_center(I,j) = G%dy_Cu(I,j) * US%m_s_to_L_T*u(I,j,k) * h(i+1,j,k) endif enddo endif diff --git a/src/core/MOM_barotropic.F90 b/src/core/MOM_barotropic.F90 index 28d6913051..be2e25c769 100644 --- a/src/core/MOM_barotropic.F90 +++ b/src/core/MOM_barotropic.F90 @@ -1544,21 +1544,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_in_T * US%m_to_L*G%dy_Cu(I,j))) * G%IareaT(i+1,j) < -CS%CFL_trunc) then + if ((ubt(I,j) * (dt_in_T * G%dy_Cu(I,j))) * 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_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))) * G%IareaT(i,j) > CS%CFL_trunc) then + ubt(I,j) = (-0.95*CS%CFL_trunc) * (G%areaT(i+1,j) / (dt_in_T * G%dy_Cu(I,j))) + elseif ((ubt(I,j) * (dt_in_T * G%dy_Cu(I,j))) * 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_in_T * US%m_to_L*G%dy_Cu(I,j))) + ubt(I,j) = (0.95*CS%CFL_trunc) * (G%areaT(i,j) / (dt_in_T * G%dy_Cu(I,j))) endif enddo ; enddo do J=jsv-1,jev ; do i=isv,iev - if ((vbt(i,J) * (dt_in_T * US%m_to_L*G%dx_Cv(i,J))) * G%IareaT(i,j+1) < -CS%CFL_trunc) then + if ((vbt(i,J) * (dt_in_T * G%dx_Cv(i,J))) * 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_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))) * G%IareaT(i,j) > CS%CFL_trunc) then + vbt(i,J) = (-0.9*CS%CFL_trunc) * (G%areaT(i,j+1) / (dt_in_T * G%dx_Cv(i,J))) + elseif ((vbt(i,J) * (dt_in_T * G%dx_Cv(i,J))) * 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_in_T * US%m_to_L*G%dx_Cv(i,J))) + vbt(i,J) = (0.9*CS%CFL_trunc) * (G%areaT(i,j) / (dt_in_T * G%dx_Cv(i,J))) endif enddo ; enddo endif @@ -4085,10 +4085,10 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, US, param_file, diag, CS, ! 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) = US%L_to_m*G%IdxCu(I,j) ; CS%dy_Cu(I,j) = US%m_to_L*G%dy_Cu(I,j) + CS%IdxCu(I,j) = US%L_to_m*G%IdxCu(I,j) ; CS%dy_Cu(I,j) = G%dy_Cu(I,j) enddo ; enddo do J=G%JsdB,G%JedB ; do i=G%isd,G%ied - 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) + CS%IdyCv(I,j) = US%L_to_m*G%IdyCv(I,j) ; CS%dx_Cv(i,J) = 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) diff --git a/src/core/MOM_continuity_PPM.F90 b/src/core/MOM_continuity_PPM.F90 index e03e82e265..f90650adfc 100644 --- a/src/core/MOM_continuity_PPM.F90 +++ b/src/core/MOM_continuity_PPM.F90 @@ -335,8 +335,8 @@ subroutine zonal_mass_flux(u, h_in, uh, dt_in_T, G, GV, US, CS, LB, uhbt, OBC, & I_vrm = 0.0 if (visc_rem_max(I) > 0.0) I_vrm = 1.0 / visc_rem_max(I) if (CS%vol_CFL) then - dx_W = US%m_to_L*ratio_max(US%L_to_m**2*G%areaT(i,j), G%dy_Cu(I,j), 1000.0*G%dxT(i,j)) - dx_E = US%m_to_L*ratio_max(US%L_to_m**2*G%areaT(i+1,j), G%dy_Cu(I,j), 1000.0*G%dxT(i+1,j)) + dx_W = US%m_to_L*ratio_max(US%L_to_m**2*G%areaT(i,j), US%L_to_m*G%dy_Cu(I,j), 1000.0*G%dxT(i,j)) + dx_E = US%m_to_L*ratio_max(US%L_to_m**2*G%areaT(i+1,j), US%L_to_m*G%dy_Cu(I,j), 1000.0*G%dxT(i+1,j)) else ; dx_W = US%m_to_L*G%dxT(i,j) ; dx_E = US%m_to_L*G%dxT(i+1,j) ; endif du_max_CFL(I) = 2.0* (CFL_dt * dx_W) * I_vrm du_min_CFL(I) = -2.0 * (CFL_dt * dx_E) * I_vrm @@ -350,8 +350,8 @@ subroutine zonal_mass_flux(u, h_in, uh, dt_in_T, G, GV, US, CS, LB, uhbt, OBC, & if (CS%aggress_adjust) then do k=1,nz ; do I=ish-1,ieh if (CS%vol_CFL) then - dx_W = US%m_to_L*ratio_max(US%L_to_m**2*G%areaT(i,j), G%dy_Cu(I,j), 1000.0*G%dxT(i,j)) - dx_E = US%m_to_L*ratio_max(US%L_to_m**2*G%areaT(i+1,j), G%dy_Cu(I,j), 1000.0*G%dxT(i+1,j)) + dx_W = US%m_to_L*ratio_max(US%L_to_m**2*G%areaT(i,j), US%L_to_m*G%dy_Cu(I,j), 1000.0*G%dxT(i,j)) + dx_E = US%m_to_L*ratio_max(US%L_to_m**2*G%areaT(i+1,j), US%L_to_m*G%dy_Cu(I,j), 1000.0*G%dxT(i+1,j)) else ; dx_W = US%m_to_L*G%dxT(i,j) ; dx_E = US%m_to_L*G%dxT(i+1,j) ; endif du_lim = 0.499*((dx_W*I_dt - u(I,j,k)) + MIN(0.0,u(I-1,j,k))) @@ -365,8 +365,8 @@ subroutine zonal_mass_flux(u, h_in, uh, dt_in_T, G, GV, US, CS, LB, uhbt, OBC, & else do k=1,nz ; do I=ish-1,ieh if (CS%vol_CFL) then - dx_W = US%m_to_L*ratio_max(US%L_to_m**2*G%areaT(i,j), G%dy_Cu(I,j), 1000.0*G%dxT(i,j)) - dx_E = US%m_to_L*ratio_max(US%L_to_m**2*G%areaT(i+1,j), G%dy_Cu(I,j), 1000.0*G%dxT(i+1,j)) + dx_W = US%m_to_L*ratio_max(US%L_to_m**2*G%areaT(i,j), US%L_to_m*G%dy_Cu(I,j), 1000.0*G%dxT(i,j)) + dx_E = US%m_to_L*ratio_max(US%L_to_m**2*G%areaT(i+1,j), US%L_to_m*G%dy_Cu(I,j), 1000.0*G%dxT(i+1,j)) else ; dx_W = US%m_to_L*G%dxT(i,j) ; dx_E = US%m_to_L*G%dxT(i+1,j) ; endif if (du_max_CFL(I) * visc_rem(I,k) > dx_W*CFL_dt - u(I,j,k)) & @@ -379,8 +379,8 @@ subroutine zonal_mass_flux(u, h_in, uh, dt_in_T, G, GV, US, CS, LB, uhbt, OBC, & if (CS%aggress_adjust) then do k=1,nz ; do I=ish-1,ieh if (CS%vol_CFL) then - dx_W = US%m_to_L*ratio_max(US%L_to_m**2*G%areaT(i,j), G%dy_Cu(I,j), 1000.0*G%dxT(i,j)) - dx_E = US%m_to_L*ratio_max(US%L_to_m**2*G%areaT(i+1,j), G%dy_Cu(I,j), 1000.0*G%dxT(i+1,j)) + dx_W = US%m_to_L*ratio_max(US%L_to_m**2*G%areaT(i,j), US%L_to_m*G%dy_Cu(I,j), 1000.0*G%dxT(i,j)) + dx_E = US%m_to_L*ratio_max(US%L_to_m**2*G%areaT(i+1,j), US%L_to_m*G%dy_Cu(I,j), 1000.0*G%dxT(i+1,j)) else ; dx_W = US%m_to_L*G%dxT(i,j) ; dx_E = US%m_to_L*G%dxT(i+1,j) ; endif du_max_CFL(I) = MIN(du_max_CFL(I), 0.499 * & @@ -391,8 +391,8 @@ subroutine zonal_mass_flux(u, h_in, uh, dt_in_T, G, GV, US, CS, LB, uhbt, OBC, & else do k=1,nz ; do I=ish-1,ieh if (CS%vol_CFL) then - dx_W = US%m_to_L*ratio_max(US%L_to_m**2*G%areaT(i,j), G%dy_Cu(I,j), 1000.0*G%dxT(i,j)) - dx_E = US%m_to_L*ratio_max(US%L_to_m**2*G%areaT(i+1,j), G%dy_Cu(I,j), 1000.0*G%dxT(i+1,j)) + dx_W = US%m_to_L*ratio_max(US%L_to_m**2*G%areaT(i,j), US%L_to_m*G%dy_Cu(I,j), 1000.0*G%dxT(i,j)) + dx_E = US%m_to_L*ratio_max(US%L_to_m**2*G%areaT(i+1,j), US%L_to_m*G%dy_Cu(I,j), 1000.0*G%dxT(i+1,j)) else ; dx_W = US%m_to_L*G%dxT(i,j) ; dx_E = US%m_to_L*G%dxT(i+1,j) ; endif du_max_CFL(I) = MIN(du_max_CFL(I), dx_W*CFL_dt - u(I,j,k)) @@ -439,7 +439,7 @@ subroutine zonal_mass_flux(u, h_in, uh, dt_in_T, G, GV, US, CS, LB, uhbt, OBC, & if (any_simple_OBC) then do I=ish-1,ieh do_I(I) = OBC%segment(OBC%segnum_u(I,j))%specified - if (do_I(I)) FAuI(I) = GV%H_subroundoff*US%m_to_L*G%dy_Cu(I,j) + if (do_I(I)) FAuI(I) = GV%H_subroundoff*G%dy_Cu(I,j) enddo do k=1,nz ; do I=ish-1,ieh ; if (do_I(I)) then if ((abs(OBC%segment(OBC%segnum_u(I,j))%normal_vel(I,j,k)) > 0.0) .and. & @@ -466,7 +466,7 @@ subroutine zonal_mass_flux(u, h_in, uh, dt_in_T, G, GV, US, 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)*US%m_to_L*G%dy_Cu(I,j) ; enddo + 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 BT_cont%uBT_WW(I,j) = 0.0 ; BT_cont%uBT_EE(I,j) = 0.0 @@ -474,7 +474,7 @@ subroutine zonal_mass_flux(u, h_in, uh, dt_in_T, G, GV, US, CS, LB, uhbt, OBC, & 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)*US%m_to_L*G%dy_Cu(I,j) ; enddo + 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 BT_cont%uBT_WW(I,j) = 0.0 ; BT_cont%uBT_EE(I,j) = 0.0 @@ -539,35 +539,35 @@ subroutine zonal_flux_layer(u, h, h_L, h_R, uh, duhdu, visc_rem, dt_in_T, G, US, do I=ish-1,ieh ; if (do_I(I)) then ! Set new values of uh and duhdu. if (u(I) > 0.0) then - if (vol_CFL) then ; CFL = (u(I) * dt_in_T) * (US%m_to_L*G%dy_Cu(I,j) * G%IareaT(i,j)) + if (vol_CFL) then ; CFL = (u(I) * dt_in_T) * (G%dy_Cu(I,j) * G%IareaT(i,j)) else ; CFL = u(I) * dt_in_T * US%L_to_m*G%IdxT(i,j) ; endif curv_3 = h_L(i) + h_R(i) - 2.0*h(i) - uh(I) = US%m_to_L*G%dy_Cu(I,j) * u(I) * & + uh(I) = G%dy_Cu(I,j) * u(I) * & (h_R(i) + CFL * (0.5*(h_L(i) - h_R(i)) + curv_3*(CFL - 1.5))) h_marg = h_R(i) + CFL * ((h_L(i) - h_R(i)) + 3.0*curv_3*(CFL - 1.0)) elseif (u(I) < 0.0) then - if (vol_CFL) then ; CFL = (-u(I) * dt_in_T) * (US%m_to_L*G%dy_Cu(I,j) * G%IareaT(i+1,j)) + if (vol_CFL) then ; CFL = (-u(I) * dt_in_T) * (G%dy_Cu(I,j) * G%IareaT(i+1,j)) else ; CFL = -u(I) * dt_in_T * US%L_to_m*G%IdxT(i+1,j) ; endif curv_3 = h_L(i+1) + h_R(i+1) - 2.0*h(i+1) - uh(I) = US%m_to_L*G%dy_Cu(I,j) * u(I) * & + uh(I) = G%dy_Cu(I,j) * u(I) * & (h_L(i+1) + CFL * (0.5*(h_R(i+1)-h_L(i+1)) + curv_3*(CFL - 1.5))) h_marg = h_L(i+1) + CFL * ((h_R(i+1)-h_L(i+1)) + 3.0*curv_3*(CFL - 1.0)) else uh(I) = 0.0 h_marg = 0.5 * (h_L(i+1) + h_R(i)) endif - duhdu(I) = US%m_to_L*G%dy_Cu(I,j) * h_marg * visc_rem(I) + duhdu(I) = G%dy_Cu(I,j) * h_marg * visc_rem(I) endif ; enddo if (local_open_BC) then do I=ish-1,ieh ; if (do_I(I)) then if (OBC%segment(OBC%segnum_u(I,j))%open) then if (OBC%segment(OBC%segnum_u(I,j))%direction == OBC_DIRECTION_E) then - uh(I) = US%m_to_L*G%dy_Cu(I,j) * u(I) * h(i) - duhdu(I) = US%m_to_L*G%dy_Cu(I,j) * h(i) * visc_rem(I) + uh(I) = G%dy_Cu(I,j) * u(I) * h(i) + duhdu(I) = G%dy_Cu(I,j) * h(i) * visc_rem(I) else - uh(I) = US%m_to_L*G%dy_Cu(I,j) * u(I) * h(i+1) - duhdu(I) = US%m_to_L*G%dy_Cu(I,j) * h(i+1) * visc_rem(I) + uh(I) = G%dy_Cu(I,j) * u(I) * h(i+1) + duhdu(I) = G%dy_Cu(I,j) * h(i+1) * visc_rem(I) endif endif endif ; enddo @@ -614,13 +614,13 @@ subroutine zonal_face_thickness(u, h, h_L, h_R, h_u, dt_in_T, G, US, LB, vol_CFL !$OMP parallel do default(shared) private(CFL,curv_3,h_marg,h_avg) do k=1,nz ; do j=jsh,jeh ; do I=ish-1,ieh if (u(I,j,k) > 0.0) then - if (vol_CFL) then ; CFL = (u(I,j,k) * dt_in_T) * (US%m_to_L*G%dy_Cu(I,j) * G%IareaT(i,j)) + if (vol_CFL) then ; CFL = (u(I,j,k) * dt_in_T) * (G%dy_Cu(I,j) * G%IareaT(i,j)) else ; CFL = u(I,j,k) * dt_in_T * US%L_to_m*G%IdxT(i,j) ; endif curv_3 = h_L(i,j,k) + h_R(i,j,k) - 2.0*h(i,j,k) h_avg = h_R(i,j,k) + CFL * (0.5*(h_L(i,j,k) - h_R(i,j,k)) + curv_3*(CFL - 1.5)) h_marg = h_R(i,j,k) + CFL * ((h_L(i,j,k) - h_R(i,j,k)) + 3.0*curv_3*(CFL - 1.0)) elseif (u(I,j,k) < 0.0) then - if (vol_CFL) then ; CFL = (-u(I,j,k)*dt_in_T) * (US%m_to_L*G%dy_Cu(I,j) * G%IareaT(i+1,j)) + if (vol_CFL) then ; CFL = (-u(I,j,k)*dt_in_T) * (G%dy_Cu(I,j) * G%IareaT(i+1,j)) else ; CFL = -u(I,j,k) * dt_in_T * US%L_to_m*G%IdxT(i+1,j) ; endif curv_3 = h_L(i+1,j,k) + h_R(i+1,j,k) - 2.0*h(i+1,j,k) h_avg = h_L(i+1,j,k) + CFL * (0.5*(h_R(i+1,j,k)-h_L(i+1,j,k)) + curv_3*(CFL - 1.5)) @@ -1134,8 +1134,8 @@ subroutine meridional_mass_flux(v, h_in, vh, dt_in_T, G, GV, US, CS, LB, vhbt, O I_vrm = 0.0 if (visc_rem_max(i) > 0.0) I_vrm = 1.0 / visc_rem_max(i) if (CS%vol_CFL) then - dy_S = US%m_to_L*ratio_max(US%L_to_m**2*G%areaT(i,j), G%dx_Cv(i,J), 1000.0*G%dyT(i,j)) - dy_N = US%m_to_L*ratio_max(US%L_to_m**2*G%areaT(i,j+1), G%dx_Cv(i,J), 1000.0*G%dyT(i,j+1)) + dy_S = US%m_to_L*ratio_max(US%L_to_m**2*G%areaT(i,j), US%L_to_m*G%dx_Cv(i,J), 1000.0*G%dyT(i,j)) + dy_N = US%m_to_L*ratio_max(US%L_to_m**2*G%areaT(i,j+1), US%L_to_m*G%dx_Cv(i,J), 1000.0*G%dyT(i,j+1)) else ; dy_S = US%m_to_L*G%dyT(i,j) ; dy_N = US%m_to_L*G%dyT(i,j+1) ; endif dv_max_CFL(i) = 2.0 * (CFL_dt * dy_S) * I_vrm dv_min_CFL(i) = -2.0 * (CFL_dt * dy_N) * I_vrm @@ -1150,8 +1150,8 @@ subroutine meridional_mass_flux(v, h_in, vh, dt_in_T, G, GV, US, CS, LB, vhbt, O if (CS%aggress_adjust) then do k=1,nz ; do i=ish,ieh if (CS%vol_CFL) then - dy_S = US%m_to_L*ratio_max(US%L_to_m**2*G%areaT(i,j), G%dx_Cv(I,j), 1000.0*G%dyT(i,j)) - dy_N = US%m_to_L*ratio_max(US%L_to_m**2*G%areaT(i,j+1), G%dx_Cv(I,j), 1000.0*G%dyT(i,j+1)) + dy_S = US%m_to_L*ratio_max(US%L_to_m**2*G%areaT(i,j), US%L_to_m*G%dx_Cv(I,j), 1000.0*G%dyT(i,j)) + dy_N = US%m_to_L*ratio_max(US%L_to_m**2*G%areaT(i,j+1), US%L_to_m*G%dx_Cv(I,j), 1000.0*G%dyT(i,j+1)) else ; dy_S = US%m_to_L*G%dyT(i,j) ; dy_N = US%m_to_L*G%dyT(i,j+1) ; endif dv_lim = 0.499*((dy_S*I_dt - v(i,J,k)) + MIN(0.0,v(i,J-1,k))) if (dv_max_CFL(i) * visc_rem(i,k) > dv_lim) & @@ -1164,8 +1164,8 @@ subroutine meridional_mass_flux(v, h_in, vh, dt_in_T, G, GV, US, CS, LB, vhbt, O else do k=1,nz ; do i=ish,ieh if (CS%vol_CFL) then - dy_S = US%m_to_L*ratio_max(US%L_to_m**2*G%areaT(i,j), G%dx_Cv(I,j), 1000.0*G%dyT(i,j)) - dy_N = US%m_to_L*ratio_max(US%L_to_m**2*G%areaT(i,j+1), G%dx_Cv(I,j), 1000.0*G%dyT(i,j+1)) + dy_S = US%m_to_L*ratio_max(US%L_to_m**2*G%areaT(i,j), US%L_to_m*G%dx_Cv(I,j), 1000.0*G%dyT(i,j)) + dy_N = US%m_to_L*ratio_max(US%L_to_m**2*G%areaT(i,j+1), US%L_to_m*G%dx_Cv(I,j), 1000.0*G%dyT(i,j+1)) else ; dy_S = US%m_to_L*G%dyT(i,j) ; dy_N = US%m_to_L*G%dyT(i,j+1) ; endif if (dv_max_CFL(i) * visc_rem(i,k) > dy_S*CFL_dt - v(i,J,k)) & dv_max_CFL(i) = (dy_S*CFL_dt - v(i,J,k)) / visc_rem(i,k) @@ -1177,8 +1177,8 @@ subroutine meridional_mass_flux(v, h_in, vh, dt_in_T, G, GV, US, CS, LB, vhbt, O if (CS%aggress_adjust) then do k=1,nz ; do i=ish,ieh if (CS%vol_CFL) then - dy_S = US%m_to_L*ratio_max(US%L_to_m**2*G%areaT(i,j), G%dx_Cv(I,j), 1000.0*G%dyT(i,j)) - dy_N = US%m_to_L*ratio_max(US%L_to_m**2*G%areaT(i,j+1), G%dx_Cv(I,j), 1000.0*G%dyT(i,j+1)) + dy_S = US%m_to_L*ratio_max(US%L_to_m**2*G%areaT(i,j), US%L_to_m*G%dx_Cv(I,j), 1000.0*G%dyT(i,j)) + dy_N = US%m_to_L*ratio_max(US%L_to_m**2*G%areaT(i,j+1), US%L_to_m*G%dx_Cv(I,j), 1000.0*G%dyT(i,j+1)) else ; dy_S = US%m_to_L*G%dyT(i,j) ; dy_N = US%m_to_L*G%dyT(i,j+1) ; endif dv_max_CFL(i) = min(dv_max_CFL(i), 0.499 * & ((dy_S*I_dt - v(i,J,k)) + MIN(0.0,v(i,J-1,k))) ) @@ -1188,8 +1188,8 @@ subroutine meridional_mass_flux(v, h_in, vh, dt_in_T, G, GV, US, CS, LB, vhbt, O else do k=1,nz ; do i=ish,ieh if (CS%vol_CFL) then - dy_S = US%m_to_L*ratio_max(US%L_to_m**2*G%areaT(i,j), G%dx_Cv(I,j), 1000.0*G%dyT(i,j)) - dy_N = US%m_to_L*ratio_max(US%L_to_m**2*G%areaT(i,j+1), G%dx_Cv(I,j), 1000.0*G%dyT(i,j+1)) + dy_S = US%m_to_L*ratio_max(US%L_to_m**2*G%areaT(i,j), US%L_to_m*G%dx_Cv(I,j), 1000.0*G%dyT(i,j)) + dy_N = US%m_to_L*ratio_max(US%L_to_m**2*G%areaT(i,j+1), US%L_to_m*G%dx_Cv(I,j), 1000.0*G%dyT(i,j+1)) else ; dy_S = US%m_to_L*G%dyT(i,j) ; dy_N = US%m_to_L*G%dyT(i,j+1) ; endif dv_max_CFL(i) = min(dv_max_CFL(i), dy_S*CFL_dt - v(i,J,k)) dv_min_CFL(i) = max(dv_min_CFL(i), -(dy_N*CFL_dt + v(i,J,k))) @@ -1234,7 +1234,7 @@ subroutine meridional_mass_flux(v, h_in, vh, dt_in_T, G, GV, US, CS, LB, vhbt, O if (any_simple_OBC) then do i=ish,ieh do_I(i) = (OBC%segment(OBC%segnum_v(i,J))%specified) - if (do_I(i)) FAvi(i) = GV%H_subroundoff*US%m_to_L*G%dx_Cv(i,J) + if (do_I(i)) FAvi(i) = GV%H_subroundoff*G%dx_Cv(i,J) enddo do k=1,nz ; do i=ish,ieh ; if (do_I(i)) then if ((abs(OBC%segment(OBC%segnum_v(i,J))%normal_vel(i,J,k)) > 0.0) .and. & @@ -1262,7 +1262,7 @@ subroutine meridional_mass_flux(v, h_in, vh, dt_in_T, G, GV, US, CS, LB, vhbt, O 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)*US%m_to_L*G%dx_Cv(i,J) ; enddo + 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 BT_cont%vBT_SS(i,J) = 0.0 ; BT_cont%vBT_NN(i,J) = 0.0 @@ -1270,7 +1270,7 @@ subroutine meridional_mass_flux(v, h_in, vh, dt_in_T, G, GV, US, CS, LB, vhbt, O 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)*US%m_to_L*G%dx_Cv(i,J) ; enddo + 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 BT_cont%vBT_SS(i,J) = 0.0 ; BT_cont%vBT_NN(i,J) = 0.0 @@ -1337,18 +1337,18 @@ subroutine merid_flux_layer(v, h, h_L, h_R, vh, dvhdv, visc_rem, dt_in_T, G, US, do i=ish,ieh ; if (do_I(i)) then if (v(i) > 0.0) then - if (vol_CFL) then ; CFL = (v(i) * dt_in_T) * (US%m_to_L*G%dx_Cv(i,J) * G%IareaT(i,j)) + if (vol_CFL) then ; CFL = (v(i) * dt_in_T) * (G%dx_Cv(i,J) * G%IareaT(i,j)) else ; CFL = v(i) * dt_in_T * US%L_to_m*G%IdyT(i,j) ; endif curv_3 = h_L(i,j) + h_R(i,j) - 2.0*h(i,j) - vh(i) = US%m_to_L*G%dx_Cv(i,J) * v(i) * ( h_R(i,j) + CFL * & + vh(i) = G%dx_Cv(i,J) * v(i) * ( h_R(i,j) + CFL * & (0.5*(h_L(i,j) - h_R(i,j)) + curv_3*(CFL - 1.5)) ) h_marg = h_R(i,j) + CFL * ((h_L(i,j) - h_R(i,j)) + & 3.0*curv_3*(CFL - 1.0)) elseif (v(i) < 0.0) then - if (vol_CFL) then ; CFL = (-v(i) * dt_in_T) * (US%m_to_L*G%dx_Cv(i,J) * G%IareaT(i,j+1)) + if (vol_CFL) then ; CFL = (-v(i) * dt_in_T) * (G%dx_Cv(i,J) * G%IareaT(i,j+1)) else ; CFL = -v(i) * dt_in_T * US%L_to_m*G%IdyT(i,j+1) ; endif curv_3 = h_L(i,j+1) + h_R(i,j+1) - 2.0*h(i,j+1) - vh(i) = US%m_to_L*G%dx_Cv(i,J) * v(i) * ( h_L(i,j+1) + CFL * & + vh(i) = G%dx_Cv(i,J) * v(i) * ( h_L(i,j+1) + CFL * & (0.5*(h_R(i,j+1)-h_L(i,j+1)) + curv_3*(CFL - 1.5)) ) h_marg = h_L(i,j+1) + CFL * ((h_R(i,j+1)-h_L(i,j+1)) + & 3.0*curv_3*(CFL - 1.0)) @@ -1356,18 +1356,18 @@ subroutine merid_flux_layer(v, h, h_L, h_R, vh, dvhdv, visc_rem, dt_in_T, G, US, vh(i) = 0.0 h_marg = 0.5 * (h_L(i,j+1) + h_R(i,j)) endif - dvhdv(i) = US%m_to_L*G%dx_Cv(i,J) * h_marg * visc_rem(i) + dvhdv(i) = G%dx_Cv(i,J) * h_marg * visc_rem(i) endif ; enddo if (local_open_BC) then do i=ish,ieh ; if (do_I(i)) then if (OBC%segment(OBC%segnum_v(i,J))%open) then if (OBC%segment(OBC%segnum_v(i,J))%direction == OBC_DIRECTION_N) then - vh(i) = US%m_to_L*G%dx_Cv(i,J) * v(i) * h(i,j) - dvhdv(i) = US%m_to_L*G%dx_Cv(i,J) * h(i,j) * visc_rem(i) + vh(i) = G%dx_Cv(i,J) * v(i) * h(i,j) + dvhdv(i) = G%dx_Cv(i,J) * h(i,j) * visc_rem(i) else - vh(i) = US%m_to_L*G%dx_Cv(i,J) * v(i) * h(i,j+1) - dvhdv(i) = US%m_to_L*G%dx_Cv(i,J) * h(i,j+1) * visc_rem(i) + vh(i) = G%dx_Cv(i,J) * v(i) * h(i,j+1) + dvhdv(i) = G%dx_Cv(i,J) * h(i,j+1) * visc_rem(i) endif endif endif ; enddo @@ -1414,14 +1414,14 @@ subroutine merid_face_thickness(v, h, h_L, h_R, h_v, dt_in_T, G, US, LB, vol_CFL !$OMP parallel do default(shared) private(CFL,curv_3,h_marg,h_avg) do k=1,nz ; do J=jsh-1,jeh ; do i=ish,ieh if (v(i,J,k) > 0.0) then - if (vol_CFL) then ; CFL = (v(i,J,k) * dt_in_T) * (US%m_to_L*G%dx_Cv(i,J) * G%IareaT(i,j)) + if (vol_CFL) then ; CFL = (v(i,J,k) * dt_in_T) * (G%dx_Cv(i,J) * G%IareaT(i,j)) else ; CFL = v(i,J,k) * dt_in_T * US%L_to_m*G%IdyT(i,j) ; endif curv_3 = h_L(i,j,k) + h_R(i,j,k) - 2.0*h(i,j,k) h_avg = h_R(i,j,k) + CFL * (0.5*(h_L(i,j,k) - h_R(i,j,k)) + curv_3*(CFL - 1.5)) h_marg = h_R(i,j,k) + CFL * ((h_L(i,j,k) - h_R(i,j,k)) + & 3.0*curv_3*(CFL - 1.0)) elseif (v(i,J,k) < 0.0) then - if (vol_CFL) then ; CFL = (-v(i,J,k)*dt_in_T) * (US%m_to_L*G%dx_Cv(i,J) * G%IareaT(i,j+1)) + if (vol_CFL) then ; CFL = (-v(i,J,k)*dt_in_T) * (G%dx_Cv(i,J) * G%IareaT(i,j+1)) else ; CFL = -v(i,J,k) * dt_in_T * US%L_to_m*G%IdyT(i,j+1) ; endif curv_3 = h_L(i,j+1,k) + h_R(i,j+1,k) - 2.0*h(i,j+1,k) h_avg = h_L(i,j+1,k) + CFL * (0.5*(h_R(i,j+1,k)-h_L(i,j+1,k)) + curv_3*(CFL - 1.5)) diff --git a/src/core/MOM_grid.F90 b/src/core/MOM_grid.F90 index 04da9abfb8..45353cebce 100644 --- a/src/core/MOM_grid.F90 +++ b/src/core/MOM_grid.F90 @@ -96,7 +96,7 @@ module MOM_grid IdxCu, & !< 1/dxCu [m-1]. dyCu, & !< dyCu is delta y at u points [m]. IdyCu, & !< 1/dyCu [m-1]. - dy_Cu, & !< The unblocked lengths of the u-faces of the h-cell [m]. + dy_Cu, & !< The unblocked lengths of the u-faces of the h-cell [L ~> m]. IareaCu, & !< The masked inverse areas of u-grid cells [L-2 ~> m-2]. areaCu !< The areas of the u-grid cells [m2]. @@ -108,7 +108,7 @@ module MOM_grid IdxCv, & !< 1/dxCv [m-1]. dyCv, & !< dyCv is delta y at v points [m]. IdyCv, & !< 1/dyCv [m-1]. - dx_Cv, & !< The unblocked lengths of the v-faces of the h-cell [m]. + dx_Cv, & !< The unblocked lengths of the v-faces of the h-cell [L ~> m]. IareaCv, & !< The masked inverse areas of v-grid cells [L-2 ~> m-2]. areaCv !< The areas of the v-grid cells [m2]. @@ -425,7 +425,7 @@ subroutine set_derived_metrics(G, US) if (G%dyT(i,j) < 0.0) G%dyT(i,j) = 0.0 G%IdxT(i,j) = Adcroft_reciprocal(G%dxT(i,j)) G%IdyT(i,j) = Adcroft_reciprocal(G%dyT(i,j)) - G%IareaT(i,j) = Adcroft_reciprocal(US%m_to_L**2*US%L_to_m**2*G%areaT(i,j)) + G%IareaT(i,j) = Adcroft_reciprocal(G%areaT(i,j)) enddo ; enddo do j=jsd,jed ; do I=IsdB,IedB @@ -449,8 +449,8 @@ subroutine set_derived_metrics(G, US) G%IdxBu(I,J) = Adcroft_reciprocal(G%dxBu(I,J)) G%IdyBu(I,J) = Adcroft_reciprocal(G%dyBu(I,J)) ! areaBu has usually been set to a positive area elsewhere. - if (G%areaBu(I,J) <= 0.0) G%areaBu(I,J) = US%m_to_L**2*G%dxBu(I,J) * G%dyBu(I,J) - G%IareaBu(I,J) = Adcroft_reciprocal(US%m_to_L**2*US%L_to_m**2*G%areaBu(I,J)) + if (G%areaBu(I,J) <= 0.0) G%areaBu(I,J) = US%m_to_L*G%dxBu(I,J) * US%m_to_L*G%dyBu(I,J) + G%IareaBu(I,J) = Adcroft_reciprocal(G%areaBu(I,J)) enddo ; enddo end subroutine set_derived_metrics diff --git a/src/core/MOM_open_boundary.F90 b/src/core/MOM_open_boundary.F90 index 7935d3a529..3f0fb42cfc 100644 --- a/src/core/MOM_open_boundary.F90 +++ b/src/core/MOM_open_boundary.F90 @@ -1475,7 +1475,7 @@ subroutine open_boundary_impose_land_mask(OBC, G, areaCu, areaCv, US) do j=segment%HI%jsd,segment%HI%jed if (segment%direction == OBC_DIRECTION_E) then areaCu(I,j) = G%areaT(i,j) ! Both of these are in [L2] - else ! West + else ! West areaCu(I,j) = G%areaT(i+1,j) ! Both of these are in [L2] endif enddo diff --git a/src/diagnostics/MOM_PointAccel.F90 b/src/diagnostics/MOM_PointAccel.F90 index a13003a826..ca89dfc1c4 100644 --- a/src/diagnostics/MOM_PointAccel.F90 +++ b/src/diagnostics/MOM_PointAccel.F90 @@ -173,9 +173,9 @@ subroutine write_u_accel(I, j, um, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st write(file,'(/,"CFL u: ",$)') do k=ks,ke ; if (do_k(k)) then - CFL = abs(um(I,j,k)) * dt * G%dy_Cu(I,j) - if (um(I,j,k) < 0.0) then ; CFL = CFL * US%m_to_L**2*G%IareaT(i+1,j) - else ; CFL = CFL * US%m_to_L**2*G%IareaT(i,j) ; endif + CFL = abs(US%m_to_L*um(I,j,k)) * dt * G%dy_Cu(I,j) + if (um(I,j,k) < 0.0) then ; CFL = CFL * G%IareaT(i+1,j) + else ; CFL = CFL * G%IareaT(i,j) ; endif write(file,'(ES10.3," ",$)') CFL endif ; enddo write(file,'(/,"CFL0 u:",$)') @@ -504,9 +504,9 @@ 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," ",$)') (CS%v_av(i,J,k)); enddo write(file,'(/,"CFL v: ",$)') do k=ks,ke ; if (do_k(k)) then - CFL = abs(vm(i,J,k)) * dt * G%dx_Cv(i,J) - if (vm(i,J,k) < 0.0) then ; CFL = CFL * US%m_to_L**2*G%IareaT(i,j+1) - else ; CFL = CFL * US%m_to_L**2*G%IareaT(i,j) ; endif + CFL = abs(US%m_to_L*vm(i,J,k)) * dt * G%dx_Cv(i,J) + if (vm(i,J,k) < 0.0) then ; CFL = CFL * G%IareaT(i,j+1) + else ; CFL = CFL * G%IareaT(i,j) ; endif write(file,'(ES10.3," ",$)') CFL endif ; enddo write(file,'(/,"CFL0 v:",$)') diff --git a/src/diagnostics/MOM_diagnostics.F90 b/src/diagnostics/MOM_diagnostics.F90 index 0e099cb079..1089dbb6e9 100644 --- a/src/diagnostics/MOM_diagnostics.F90 +++ b/src/diagnostics/MOM_diagnostics.F90 @@ -1967,11 +1967,11 @@ subroutine write_static_fields(G, GV, US, tv, diag) if (id > 0) call post_data(id, G%dyCv, diag, .true.) id = register_static_field('ocean_model', 'dyCuo', diag%axesCu1, & - 'Open meridional grid spacing at u points (meter)', 'm', interp_method='none') + 'Open meridional grid spacing at u points (meter)', 'm', interp_method='none', conversion=US%L_to_m) if (id > 0) call post_data(id, G%dy_Cu, diag, .true.) id = register_static_field('ocean_model', 'dxCvo', diag%axesCv1, & - 'Open zonal grid spacing at v points (meter)', 'm', interp_method='none') + 'Open zonal grid spacing at v points (meter)', 'm', interp_method='none', conversion=US%L_to_m) if (id > 0) call post_data(id, G%dx_Cv, diag, .true.) id = register_static_field('ocean_model', 'sin_rot', diag%axesT1, & diff --git a/src/diagnostics/MOM_sum_output.F90 b/src/diagnostics/MOM_sum_output.F90 index 5a6041def3..d03fa1ffef 100644 --- a/src/diagnostics/MOM_sum_output.F90 +++ b/src/diagnostics/MOM_sum_output.F90 @@ -713,9 +713,9 @@ subroutine write_energy(u, v, h, tv, day, n, G, GV, US, CS, tracer_CSp, OBC, dt_ max_CFL(1:2) = 0.0 do k=1,nz ; do j=js,je ; do I=Isq,Ieq if (u(I,j,k) < 0.0) then - CFL_trans = (-u(I,j,k) * CS%dt) * (G%dy_Cu(I,j) * US%m_to_L**2*G%IareaT(i+1,j)) + CFL_trans = (-u(I,j,k) * CS%dt) * (US%L_to_m*G%dy_Cu(I,j) * US%m_to_L**2*G%IareaT(i+1,j)) else - CFL_trans = (u(I,j,k) * CS%dt) * (G%dy_Cu(I,j) * US%m_to_L**2*G%IareaT(i,j)) + CFL_trans = (u(I,j,k) * CS%dt) * (US%L_to_m*G%dy_Cu(I,j) * US%m_to_L**2*G%IareaT(i,j)) endif CFL_lin = abs(u(I,j,k) * CS%dt) * G%IdxCu(I,j) max_CFL(1) = max(max_CFL(1), CFL_trans) @@ -723,9 +723,9 @@ subroutine write_energy(u, v, h, tv, day, n, G, GV, US, CS, tracer_CSp, OBC, dt_ enddo ; enddo ; enddo do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie if (v(i,J,k) < 0.0) then - CFL_trans = (-v(i,J,k) * CS%dt) * (G%dx_Cv(i,J) * US%m_to_L**2*G%IareaT(i,j+1)) + CFL_trans = (-v(i,J,k) * CS%dt) * (US%L_to_m*G%dx_Cv(i,J) * US%m_to_L**2*G%IareaT(i,j+1)) else - CFL_trans = (v(i,J,k) * CS%dt) * (G%dx_Cv(i,J) * US%m_to_L**2*G%IareaT(i,j)) + CFL_trans = (v(i,J,k) * CS%dt) * (US%L_to_m*G%dx_Cv(i,J) * US%m_to_L**2*G%IareaT(i,j)) endif CFL_lin = abs(v(i,J,k) * CS%dt) * G%IdyCv(i,J) max_CFL(1) = max(max_CFL(1), CFL_trans) diff --git a/src/framework/MOM_dyn_horgrid.F90 b/src/framework/MOM_dyn_horgrid.F90 index f46b8cb875..d26e072c40 100644 --- a/src/framework/MOM_dyn_horgrid.F90 +++ b/src/framework/MOM_dyn_horgrid.F90 @@ -92,7 +92,7 @@ module MOM_dyn_horgrid IdxCu, & !< 1/dxCu [m-1]. dyCu, & !< dyCu is delta y at u points [m]. IdyCu, & !< 1/dyCu [m-1]. - dy_Cu, & !< The unblocked lengths of the u-faces of the h-cell [m]. + dy_Cu, & !< The unblocked lengths of the u-faces of the h-cell [L ~> m]. IareaCu, & !< The masked inverse areas of u-grid cells [L-2 ~> m-2]. areaCu !< The areas of the u-grid cells [m2]. @@ -104,7 +104,7 @@ module MOM_dyn_horgrid IdxCv, & !< 1/dxCv [m-1]. dyCv, & !< dyCv is delta y at v points [m]. IdyCv, & !< 1/dyCv [m-1]. - dx_Cv, & !< The unblocked lengths of the v-faces of the h-cell [m]. + dx_Cv, & !< The unblocked lengths of the v-faces of the h-cell [L ~> m]. IareaCv, & !< The masked inverse areas of v-grid cells [L-2 ~> m-2]. areaCv !< The areas of the v-grid cells [m2]. @@ -323,7 +323,7 @@ subroutine set_derived_dyn_horgrid(G, US) integer :: i, j, isd, ied, jsd, jed integer :: IsdB, IedB, JsdB, JedB m_to_L = 1.0 ; if (present(US)) m_to_L = US%m_to_L - L_to_m = 1.0 ; if (present(US)) L_to_m = US%L_to_m + L_to_m = 1.0 ; if (present(US)) L_to_m = US%L_to_m isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed IsdB = G%IsdB ; IedB = G%IedB ; JsdB = G%JsdB ; JedB = G%JedB @@ -333,7 +333,7 @@ subroutine set_derived_dyn_horgrid(G, US) if (G%dyT(i,j) < 0.0) G%dyT(i,j) = 0.0 G%IdxT(i,j) = Adcroft_reciprocal(G%dxT(i,j)) G%IdyT(i,j) = Adcroft_reciprocal(G%dyT(i,j)) - G%IareaT(i,j) = Adcroft_reciprocal(m_to_L**2*L_to_m**2*G%areaT(i,j)) + G%IareaT(i,j) = Adcroft_reciprocal(G%areaT(i,j)) enddo ; enddo do j=jsd,jed ; do I=IsdB,IedB @@ -357,8 +357,8 @@ subroutine set_derived_dyn_horgrid(G, US) G%IdxBu(I,J) = Adcroft_reciprocal(G%dxBu(I,J)) G%IdyBu(I,J) = Adcroft_reciprocal(G%dyBu(I,J)) ! areaBu has usually been set to a positive area elsewhere. - if (G%areaBu(I,J) <= 0.0) G%areaBu(I,J) = m_to_L**2*G%dxBu(I,J) * G%dyBu(I,J) - G%IareaBu(I,J) = Adcroft_reciprocal(m_to_L**2*L_to_m**2*G%areaBu(I,J)) + if (G%areaBu(I,J) <= 0.0) G%areaBu(I,J) = m_to_L*G%dxBu(I,J) * m_to_L*G%dyBu(I,J) + G%IareaBu(I,J) = Adcroft_reciprocal(G%areaBu(I,J)) enddo ; enddo end subroutine set_derived_dyn_horgrid diff --git a/src/initialization/MOM_grid_initialize.F90 b/src/initialization/MOM_grid_initialize.F90 index 5162c1303f..132fa9b60a 100644 --- a/src/initialization/MOM_grid_initialize.F90 +++ b/src/initialization/MOM_grid_initialize.F90 @@ -1311,14 +1311,14 @@ subroutine initialize_masks(G, PF, US) call pass_vector(G%mask2dCu, G%mask2dCv, G%Domain, To_All+Scalar_Pair, CGRID_NE) do j=G%jsd,G%jed ; do I=G%IsdB,G%IedB - G%dy_Cu(I,j) = G%mask2dCu(I,j) * G%dyCu(I,j) - G%areaCu(I,j) = m_to_L**2*G%dxCu(I,j) * G%dy_Cu(I,j) + G%dy_Cu(I,j) = G%mask2dCu(I,j) * m_to_L*G%dyCu(I,j) + G%areaCu(I,j) = m_to_L*G%dxCu(I,j) * G%dy_Cu(I,j) G%IareaCu(I,j) = G%mask2dCu(I,j) * Adcroft_reciprocal(G%areaCu(I,j)) enddo ; enddo do J=G%JsdB,G%JedB ; do i=G%isd,G%ied - G%dx_Cv(i,J) = G%mask2dCv(i,J) * G%dxCv(i,J) - G%areaCv(i,J) = m_to_L**2*G%dyCv(i,J) * G%dx_Cv(i,J) + G%dx_Cv(i,J) = G%mask2dCv(i,J) * m_to_L*G%dxCv(i,J) + G%areaCv(i,J) = m_to_L*G%dyCv(i,J) * G%dx_Cv(i,J) G%IareaCv(i,J) = G%mask2dCv(i,J) * Adcroft_reciprocal(G%areaCv(i,J)) enddo ; enddo diff --git a/src/initialization/MOM_shared_initialization.F90 b/src/initialization/MOM_shared_initialization.F90 index d5a748f4a6..346e3d32a8 100644 --- a/src/initialization/MOM_shared_initialization.F90 +++ b/src/initialization/MOM_shared_initialization.F90 @@ -624,6 +624,7 @@ subroutine reset_face_lengths_named(G, param_file, name, US) ! Local variables character(len=256) :: mesg ! Message for error messages. real :: m_to_L ! A unit conversion factor [L m-1 ~> nondim] + real :: L_to_m ! A unit conversion factor [m L-1 ~> nondim] real :: dx_2 = -1.0, dy_2 = -1.0 real :: pi_180 integer :: option = -1 @@ -639,6 +640,7 @@ subroutine reset_face_lengths_named(G, param_file, name, US) end select m_to_L = 1.0 ; if (present(US)) m_to_L = US%m_to_L + L_to_m = 1.0 ; if (present(US)) L_to_m = US%L_to_m if (option==1) then ! 1-degree settings. do j=jsd,jed ; do I=IsdB,IedB ! Change any u-face lengths within this loop. @@ -646,62 +648,61 @@ subroutine reset_face_lengths_named(G, param_file, name, US) if ((abs(G%geoLatCu(I,j)-35.5) < dy_2) .and. (G%geoLonCu(I,j) < -4.5) .and. & (G%geoLonCu(I,j) > -6.5)) & - G%dy_Cu(I,j) = G%mask2dCu(I,j)*12000.0 ! Gibraltar + G%dy_Cu(I,j) = G%mask2dCu(I,j)*12000.0*m_to_L ! Gibraltar if ((abs(G%geoLatCu(I,j)-12.5) < dy_2) .and. (abs(G%geoLonCu(I,j)-43.0) < dx_2)) & - G%dy_Cu(I,j) = G%mask2dCu(I,j)*10000.0 ! Red Sea + G%dy_Cu(I,j) = G%mask2dCu(I,j)*10000.0*m_to_L ! Red Sea if ((abs(G%geoLatCu(I,j)-40.5) < dy_2) .and. (abs(G%geoLonCu(I,j)-26.0) < dx_2)) & - G%dy_Cu(I,j) = G%mask2dCu(I,j)*5000.0 ! Dardanelles + G%dy_Cu(I,j) = G%mask2dCu(I,j)*5000.0*m_to_L ! Dardanelles if ((abs(G%geoLatCu(I,j)-41.5) < dy_2) .and. (abs(G%geoLonCu(I,j)+220.0) < dx_2)) & - G%dy_Cu(I,j) = G%mask2dCu(I,j)*35000.0 ! Tsugaru strait at 140.0e + G%dy_Cu(I,j) = G%mask2dCu(I,j)*35000.0*m_to_L ! Tsugaru strait at 140.0e if ((abs(G%geoLatCu(I,j)-45.5) < dy_2) .and. (abs(G%geoLonCu(I,j)+217.5) < 0.9)) & - G%dy_Cu(I,j) = G%mask2dCu(I,j)*15000.0 ! Betw Hokkaido and Sakhalin at 217&218 = 142e - + G%dy_Cu(I,j) = G%mask2dCu(I,j)*15000.0*m_to_L ! Betw Hokkaido and Sakhalin at 217&218 = 142e ! Greater care needs to be taken in the tripolar region. if ((abs(G%geoLatCu(I,j)-80.84) < 0.2) .and. (abs(G%geoLonCu(I,j)+64.9) < 0.8)) & - G%dy_Cu(I,j) = G%mask2dCu(I,j)*38000.0 ! Smith Sound in Canadian Arch - tripolar region + G%dy_Cu(I,j) = G%mask2dCu(I,j)*38000.0*m_to_L ! Smith Sound in Canadian Arch - tripolar region enddo ; enddo do J=JsdB,JedB ; do i=isd,ied ! Change any v-face lengths within this loop. dy_2 = dx_2 * G%dyCv(i,J)*G%IdxCv(i,J) * cos(pi_180 * G%geoLatCv(i,J)) if ((abs(G%geoLatCv(i,J)-41.0) < dy_2) .and. (abs(G%geoLonCv(i,J)-28.5) < dx_2)) & - G%dx_Cv(i,J) = G%mask2dCv(i,J)*2500.0 ! Bosporus - should be 1000.0 m wide. + G%dx_Cv(i,J) = G%mask2dCv(i,J)*2500.0*m_to_L ! Bosporus - should be 1000.0 m wide. if ((abs(G%geoLatCv(i,J)-13.0) < dy_2) .and. (abs(G%geoLonCv(i,J)-42.5) < dx_2)) & - G%dx_Cv(i,J) = G%mask2dCv(i,J)*10000.0 ! Red Sea + G%dx_Cv(i,J) = G%mask2dCv(i,J)*10000.0*m_to_L ! Red Sea if ((abs(G%geoLatCv(i,J)+2.8) < 0.8) .and. (abs(G%geoLonCv(i,J)+241.5) < dx_2)) & - G%dx_Cv(i,J) = G%mask2dCv(i,J)*40000.0 ! Makassar Straits at 241.5 W = 118.5 E + G%dx_Cv(i,J) = G%mask2dCv(i,J)*40000.0*m_to_L ! Makassar Straits at 241.5 W = 118.5 E if ((abs(G%geoLatCv(i,J)-0.56) < 0.5) .and. (abs(G%geoLonCv(i,J)+240.5) < dx_2)) & - G%dx_Cv(i,J) = G%mask2dCv(i,J)*80000.0 ! entry to Makassar Straits at 240.5 W = 119.5 E + G%dx_Cv(i,J) = G%mask2dCv(i,J)*80000.0*m_to_L ! entry to Makassar Straits at 240.5 W = 119.5 E if ((abs(G%geoLatCv(i,J)-0.19) < 0.5) .and. (abs(G%geoLonCv(i,J)+230.5) < dx_2)) & - G%dx_Cv(i,J) = G%mask2dCv(i,J)*25000.0 ! Channel betw N Guinea and Halmahara 230.5 W = 129.5 E + G%dx_Cv(i,J) = G%mask2dCv(i,J)*25000.0*m_to_L ! Channel betw N Guinea and Halmahara 230.5 W = 129.5 E if ((abs(G%geoLatCv(i,J)-0.19) < 0.5) .and. (abs(G%geoLonCv(i,J)+229.5) < dx_2)) & - G%dx_Cv(i,J) = G%mask2dCv(i,J)*25000.0 ! Channel betw N Guinea and Halmahara 229.5 W = 130.5 E + G%dx_Cv(i,J) = G%mask2dCv(i,J)*25000.0*m_to_L ! Channel betw N Guinea and Halmahara 229.5 W = 130.5 E if ((abs(G%geoLatCv(i,J)-0.0) < 0.25) .and. (abs(G%geoLonCv(i,J)+228.5) < dx_2)) & - G%dx_Cv(i,J) = G%mask2dCv(i,J)*25000.0 ! Channel betw N Guinea and Halmahara 228.5 W = 131.5 E + G%dx_Cv(i,J) = G%mask2dCv(i,J)*25000.0*m_to_L ! Channel betw N Guinea and Halmahara 228.5 W = 131.5 E if ((abs(G%geoLatCv(i,J)+8.5) < 0.5) .and. (abs(G%geoLonCv(i,J)+244.5) < dx_2)) & - G%dx_Cv(i,J) = G%mask2dCv(i,J)*20000.0 ! Lombok Straits at 244.5 W = 115.5 E + G%dx_Cv(i,J) = G%mask2dCv(i,J)*20000.0*m_to_L ! Lombok Straits at 244.5 W = 115.5 E if ((abs(G%geoLatCv(i,J)+8.5) < 0.5) .and. (abs(G%geoLonCv(i,J)+235.5) < dx_2)) & - G%dx_Cv(i,J) = G%mask2dCv(i,J)*20000.0 ! Timor Straits at 235.5 W = 124.5 E + G%dx_Cv(i,J) = G%mask2dCv(i,J)*20000.0*m_to_L ! Timor Straits at 235.5 W = 124.5 E if ((abs(G%geoLatCv(i,J)-52.5) < dy_2) .and. (abs(G%geoLonCv(i,J)+218.5) < dx_2)) & - G%dx_Cv(i,J) = G%mask2dCv(i,J)*2500.0 ! Russia and Sakhalin Straits at 218.5 W = 141.5 E + G%dx_Cv(i,J) = G%mask2dCv(i,J)*2500.0*m_to_L ! Russia and Sakhalin Straits at 218.5 W = 141.5 E ! Greater care needs to be taken in the tripolar region. if ((abs(G%geoLatCv(i,J)-76.8) < 0.06) .and. (abs(G%geoLonCv(i,J)+88.7) < dx_2)) & - G%dx_Cv(i,J) = G%mask2dCv(i,J)*8400.0 ! Jones Sound in Canadian Arch - tripolar region + G%dx_Cv(i,J) = G%mask2dCv(i,J)*8400.0*m_to_L ! Jones Sound in Canadian Arch - tripolar region enddo ; enddo endif @@ -709,28 +710,28 @@ subroutine reset_face_lengths_named(G, param_file, name, US) ! These checks apply regardless of the chosen option. do j=jsd,jed ; do I=IsdB,IedB - if (G%dy_Cu(I,j) > G%dyCu(I,j)) then + if (L_to_m*G%dy_Cu(I,j) > G%dyCu(I,j)) then write(mesg,'("dy_Cu of ",ES11.4," exceeds unrestricted width of ",ES11.4,& &" by ",ES11.4," at lon/lat of ", ES11.4, ES11.4)') & - G%dy_Cu(I,j), G%dyCu(I,j), G%dy_Cu(I,j)-G%dyCu(I,j), & + L_to_m*G%dy_Cu(I,j), G%dyCu(I,j), L_to_m*G%dy_Cu(I,j)-G%dyCu(I,j), & G%geoLonCu(I,j), G%geoLatCu(I,j) call MOM_error(FATAL,"reset_face_lengths_named "//mesg) endif - G%areaCu(I,j) = m_to_L**2*G%dxCu(I,j)*G%dy_Cu(I,j) + G%areaCu(I,j) = m_to_L*G%dxCu(I,j) * G%dy_Cu(I,j) G%IareaCu(I,j) = 0.0 if (G%areaCu(I,j) > 0.0) G%IareaCu(I,j) = G%mask2dCu(I,j) / (G%areaCu(I,j)) enddo ; enddo do J=JsdB,JedB ; do i=isd,ied - if (G%dx_Cv(i,J) > G%dxCv(i,J)) then + if (L_to_m*G%dx_Cv(i,J) > G%dxCv(i,J)) then write(mesg,'("dx_Cv of ",ES11.4," exceeds unrestricted width of ",ES11.4,& &" by ",ES11.4, " at lon/lat of ", ES11.4, ES11.4)') & - G%dx_Cv(i,J), G%dxCv(i,J), G%dx_Cv(i,J)-G%dxCv(i,J), & + L_to_m*G%dx_Cv(i,J), G%dxCv(i,J), L_to_m*G%dx_Cv(i,J)-G%dxCv(i,J), & G%geoLonCv(i,J), G%geoLatCv(i,J) call MOM_error(FATAL,"reset_face_lengths_named "//mesg) endif - G%areaCv(i,J) = m_to_L**2*G%dyCv(i,J)*G%dx_Cv(i,J) + G%areaCv(i,J) = m_to_L*G%dyCv(i,J) * G%dx_Cv(i,J) G%IareaCv(i,J) = 0.0 if (G%areaCv(i,J) > 0.0) G%IareaCv(i,J) = G%mask2dCv(i,J) / (G%areaCv(i,J)) enddo ; enddo @@ -751,6 +752,7 @@ subroutine reset_face_lengths_file(G, param_file, US) character(len=256) :: mesg ! Message for error messages. character(len=200) :: filename, chan_file, inputdir ! Strings for file/path real :: m_to_L ! A unit conversion factor [L m-1 ~> nondim] + real :: L_to_m ! A unit conversion factor [m L-1 ~> nondim] integer :: i, j, isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed IsdB = G%IsdB ; IedB = G%IedB ; JsdB = G%JsdB ; JedB = G%JedB @@ -758,6 +760,7 @@ subroutine reset_face_lengths_file(G, param_file, US) call callTree_enter(trim(mdl)//"(), MOM_shared_initialization.F90") m_to_L = 1.0 ; if (present(US)) m_to_L = US%m_to_L + L_to_m = 1.0 ; if (present(US)) L_to_m = US%L_to_m call get_param(param_file, mdl, "CHANNEL_WIDTH_FILE", chan_file, & "The file from which the list of narrowed channels is read.", & @@ -772,32 +775,32 @@ subroutine reset_face_lengths_file(G, param_file, US) trim(filename)) endif - call MOM_read_vector(filename, "dyCuo", "dxCvo", G%dy_Cu, G%dx_Cv, G%Domain) + call MOM_read_vector(filename, "dyCuo", "dxCvo", G%dy_Cu, G%dx_Cv, G%Domain, scale=m_to_L) call pass_vector(G%dy_Cu, G%dx_Cv, G%Domain, To_All+SCALAR_PAIR, CGRID_NE) do j=jsd,jed ; do I=IsdB,IedB - if (G%dy_Cu(I,j) > G%dyCu(I,j)) then + if (L_to_m*G%dy_Cu(I,j) > G%dyCu(I,j)) then write(mesg,'("dy_Cu of ",ES11.4," exceeds unrestricted width of ",ES11.4,& &" by ",ES11.4," at lon/lat of ", ES11.4, ES11.4)') & - G%dy_Cu(I,j), G%dyCu(I,j), G%dy_Cu(I,j)-G%dyCu(I,j), & + L_to_m*G%dy_Cu(I,j), G%dyCu(I,j), L_to_m*G%dy_Cu(I,j)-G%dyCu(I,j), & G%geoLonCu(I,j), G%geoLatCu(I,j) call MOM_error(FATAL,"reset_face_lengths_file "//mesg) endif - G%areaCu(I,j) = m_to_L**2*G%dxCu(I,j)*G%dy_Cu(I,j) + G%areaCu(I,j) = m_to_L*G%dxCu(I,j) * G%dy_Cu(I,j) G%IareaCu(I,j) = 0.0 if (G%areaCu(I,j) > 0.0) G%IareaCu(I,j) = G%mask2dCu(I,j) / (G%areaCu(I,j)) enddo ; enddo do J=JsdB,JedB ; do i=isd,ied - if (G%dx_Cv(i,J) > G%dxCv(i,J)) then + if (L_to_m*G%dx_Cv(i,J) > G%dxCv(i,J)) then write(mesg,'("dx_Cv of ",ES11.4," exceeds unrestricted width of ",ES11.4,& &" by ",ES11.4, " at lon/lat of ", ES11.4, ES11.4)') & - G%dx_Cv(i,J), G%dxCv(i,J), G%dx_Cv(i,J)-G%dxCv(i,J), & + L_to_m*G%dx_Cv(i,J), G%dxCv(i,J), L_to_m*G%dx_Cv(i,J)-G%dxCv(i,J), & G%geoLonCv(i,J), G%geoLatCv(i,J) call MOM_error(FATAL,"reset_face_lengths_file "//mesg) endif - G%areaCv(i,J) = m_to_L**2*G%dyCv(i,J)*G%dx_Cv(i,J) + G%areaCv(i,J) = m_to_L*G%dyCv(i,J) * G%dx_Cv(i,J) G%IareaCv(i,J) = 0.0 if (G%areaCv(i,J) > 0.0) G%IareaCv(i,J) = G%mask2dCv(i,J) / (G%areaCv(i,J)) enddo ; enddo @@ -824,6 +827,7 @@ subroutine reset_face_lengths_list(G, param_file, US) real, pointer, dimension(:) :: & u_width => NULL(), v_width => NULL() real :: m_to_L ! A unit conversion factor [L m-1 ~> nondim] + real :: L_to_m ! A unit conversion factor [m L-1 ~> nondim] real :: lat, lon ! The latitude and longitude of a point. real :: len_lon ! The periodic range of longitudes, usually 360 degrees. real :: len_lat ! The range of latitudes, usually 180 degrees. @@ -840,6 +844,7 @@ subroutine reset_face_lengths_list(G, param_file, US) call callTree_enter(trim(mdl)//"(), MOM_shared_initialization.F90") m_to_L = 1.0 ; if (present(US)) m_to_L = US%m_to_L + L_to_m = 1.0 ; if (present(US)) L_to_m = US%L_to_m call get_param(param_file, mdl, "CHANNEL_LIST_FILE", chan_file, & "The file from which the list of narrowed channels is read.", & @@ -983,7 +988,7 @@ subroutine reset_face_lengths_list(G, param_file, US) ((lon_p >= u_lon(1,npt)) .and. (lon_p <= u_lon(2,npt))) .or. & ((lon_m >= u_lon(1,npt)) .and. (lon_m <= u_lon(2,npt)))) ) then - G%dy_Cu(I,j) = G%mask2dCu(I,j) * min(G%dyCu(I,j), max(u_width(npt), 0.0)) + G%dy_Cu(I,j) = G%mask2dCu(I,j) * m_to_L*min(G%dyCu(I,j), max(u_width(npt), 0.0)) if (j>=G%jsc .and. j<=G%jec .and. I>=G%isc .and. I<=G%iec) then ! Limit messages/checking to compute domain if ( G%mask2dCu(I,j) == 0.0 ) then write(*,'(A,2F8.2,A,4F8.2,A)') "read_face_lengths_list : G%mask2dCu=0 at ",lat,lon," (",& @@ -991,13 +996,13 @@ subroutine reset_face_lengths_list(G, param_file, US) else write(*,'(A,2F8.2,A,4F8.2,A5,F9.2,A1)') & "read_face_lengths_list : Modifying dy_Cu gridpoint at ",lat,lon," (",& - u_lat(1,npt), u_lat(2,npt), u_lon(1,npt), u_lon(2,npt),") to ",G%dy_Cu(I,j),"m" + u_lat(1,npt), u_lat(2,npt), u_lon(1,npt), u_lon(2,npt),") to ",L_to_m*G%dy_Cu(I,j),"m" endif endif endif enddo - G%areaCu(I,j) = m_to_L**2*G%dxCu(I,j)*G%dy_Cu(I,j) + G%areaCu(I,j) = m_to_L*G%dxCu(I,j) * G%dy_Cu(I,j) G%IareaCu(I,j) = 0.0 if (G%areaCu(I,j) > 0.0) G%IareaCu(I,j) = G%mask2dCu(I,j) / (G%areaCu(I,j)) enddo ; enddo @@ -1012,7 +1017,7 @@ subroutine reset_face_lengths_list(G, param_file, US) (((lon >= v_lon(1,npt)) .and. (lon <= v_lon(2,npt))) .or. & ((lon_p >= v_lon(1,npt)) .and. (lon_p <= v_lon(2,npt))) .or. & ((lon_m >= v_lon(1,npt)) .and. (lon_m <= v_lon(2,npt)))) ) then - G%dx_Cv(i,J) = G%mask2dCv(i,J) * min(G%dxCv(i,J), max(v_width(npt), 0.0)) + G%dx_Cv(i,J) = G%mask2dCv(i,J) * m_to_L*min(G%dxCv(i,J), max(v_width(npt), 0.0)) if (i>=G%isc .and. i<=G%iec .and. J>=G%jsc .and. J<=G%jec) then ! Limit messages/checking to compute domain if ( G%mask2dCv(i,J) == 0.0 ) then write(*,'(A,2F8.2,A,4F8.2,A)') "read_face_lengths_list : G%mask2dCv=0 at ",lat,lon," (",& @@ -1020,13 +1025,13 @@ subroutine reset_face_lengths_list(G, param_file, US) else write(*,'(A,2F8.2,A,4F8.2,A5,F9.2,A1)') & "read_face_lengths_list : Modifying dx_Cv gridpoint at ",lat,lon," (",& - v_lat(1,npt), v_lat(2,npt), v_lon(1,npt), v_lon(2,npt),") to ",G%dx_Cv(I,j),"m" + v_lat(1,npt), v_lat(2,npt), v_lon(1,npt), v_lon(2,npt),") to ",L_to_m*G%dx_Cv(I,j),"m" endif endif endif enddo - G%areaCv(i,J) = m_to_L**2*G%dyCv(i,J)*G%dx_Cv(i,J) + G%areaCv(i,J) = m_to_L*G%dyCv(i,J) * G%dx_Cv(i,J) G%IareaCv(i,J) = 0.0 if (G%areaCv(i,J) > 0.0) G%IareaCv(i,J) = G%mask2dCv(i,J) / (G%areaCv(i,J)) enddo ; enddo @@ -1177,6 +1182,7 @@ subroutine write_ocean_geometry_file(G, param_file, directory, geom_file, US) type(fieldtype) :: fields(nFlds) real :: Z_to_m_scale ! A unit conversion factor from Z to m. real :: s_to_T_scale ! A unit conversion factor from T-1 to s-1. + real :: L_to_m_scale ! A unit conversion factor from L to m. integer :: unit integer :: file_threading integer :: nFlds_used @@ -1195,6 +1201,7 @@ subroutine write_ocean_geometry_file(G, param_file, directory, geom_file, US) Z_to_m_scale = 1.0 ; if (present(US)) Z_to_m_scale = US%Z_to_m s_to_T_scale = 1.0 ; if (present(US)) s_to_T_scale = US%s_to_T + L_to_m_scale = 1.0 ; if (present(US)) L_to_m_scale = US%L_to_m ! vardesc is a structure defined in MOM_io.F90. The elements of ! this structure, in order, are: @@ -1297,8 +1304,10 @@ subroutine write_ocean_geometry_file(G, param_file, directory, geom_file, US) do J=Jsq,Jeq ; do I=Isq,Ieq ; out_q(I,J) = G%areaBu(I,J) ; enddo ; enddo call write_field(unit, fields(16), G%Domain%mpp_domain, out_q) - call write_field(unit, fields(17), G%Domain%mpp_domain, G%dx_Cv) - call write_field(unit, fields(18), G%Domain%mpp_domain, G%dy_Cu) + do J=Jsq,Jeq ; do i=is,ie ; out_v(i,J) = L_to_m_scale*G%dx_Cv(i,J) ; enddo ; enddo + call write_field(unit, fields(17), G%Domain%mpp_domain, out_v) + do j=js,je ; do I=Isq,Ieq ; out_u(I,j) = L_to_m_scale*G%dy_Cu(I,j) ; enddo ; enddo + call write_field(unit, fields(18), G%Domain%mpp_domain, out_u) call write_field(unit, fields(19), G%Domain%mpp_domain, G%mask2dT) if (G%bathymetry_at_vel) then diff --git a/src/initialization/MOM_state_initialization.F90 b/src/initialization/MOM_state_initialization.F90 index 6a1f59baaa..0beda5477c 100644 --- a/src/initialization/MOM_state_initialization.F90 +++ b/src/initialization/MOM_state_initialization.F90 @@ -1385,12 +1385,12 @@ subroutine initialize_velocity_circular(u, v, G, param_file, just_read_params) do k=1,nz ; do j=js,je ; do I=Isq,Ieq psi1 = my_psi(I,j) psi2 = my_psi(I,j-1) - u(I,j,k) = (psi1-psi2) / (G%dy_Cu(I,j)) ! *(circular_max_u*G%len_lon/(2.0*dpi)) + u(I,j,k) = (psi1-psi2) / (G%US%L_to_m*G%dy_Cu(I,j)) ! *(circular_max_u*G%len_lon/(2.0*dpi)) enddo ; enddo ; enddo do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie psi1 = my_psi(i,J) psi2 = my_psi(i-1,J) - v(i,J,k) = (psi2-psi1) / (G%dx_Cv(i,J)) ! *(circular_max_u*G%len_lon/(2.0*dpi)) + v(i,J,k) = (psi2-psi1) / (G%US%L_to_m*G%dx_Cv(i,J)) ! *(circular_max_u*G%len_lon/(2.0*dpi)) enddo ; enddo ; enddo contains diff --git a/src/parameterizations/lateral/MOM_MEKE.F90 b/src/parameterizations/lateral/MOM_MEKE.F90 index 9b53e39df9..39846b81a8 100644 --- a/src/parameterizations/lateral/MOM_MEKE.F90 +++ b/src/parameterizations/lateral/MOM_MEKE.F90 @@ -364,17 +364,17 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h ! Calculate Laplacian of MEKE !$OMP parallel do default(shared) 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_uflux(I,j) = ((US%L_to_m*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)) * & + ! MEKE_uflux(I,j) = ((US%L_to_m*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)) ) * & ! (MEKE%MEKE(i+1,j) - MEKE%MEKE(i,j)) enddo ; enddo !$OMP parallel do default(shared) 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_vflux(i,J) = ((US%L_to_m*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)) * & + ! MEKE_vflux(i,J) = ((US%L_to_m*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 @@ -392,22 +392,22 @@ 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 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)) * & + Inv_Kh_max = 64.0*sdt * (((US%L_to_m*G%dy_Cu(I,j)*G%IdxCu(I,j)) * & max(US%m_to_L**2*G%IareaT(i,j),US%m_to_L**2*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))) * & + MEKE_uflux(I,j) = ((K4_here * (US%L_to_m*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)) ) * & (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 K4_here = CS%MEKE_K4 - Inv_Kh_max = 64.0*sdt * (((G%dx_Cv(i,J)*G%IdyCv(i,J)) * & + Inv_Kh_max = 64.0*sdt * (((US%L_to_m*G%dx_Cv(i,J)*G%IdyCv(i,J)) * & max(US%m_to_L**2*G%IareaT(i,j),US%m_to_L**2*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))) * & + MEKE_vflux(i,J) = ((K4_here * (US%L_to_m*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)) ) * & (del2MEKE(i,j+1) - del2MEKE(i,j)) enddo ; enddo @@ -431,12 +431,12 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h Kh_here = max(0.,CS%MEKE_Kh) + CS%KhMEKE_Fac*0.5*(MEKE%Kh(i,j)+MEKE%Kh(i+1,j)) if (associated(MEKE%Kh_diff)) & Kh_here = max(0.,CS%MEKE_Kh) + CS%KhMEKE_Fac*0.5*(MEKE%Kh_diff(i,j)+MEKE%Kh_diff(i+1,j)) - Inv_Kh_max = 2.0*sdt * ((G%dy_Cu(I,j)*G%IdxCu(I,j)) * & + Inv_Kh_max = 2.0*sdt * ((US%L_to_m*G%dy_Cu(I,j)*G%IdxCu(I,j)) * & max(US%m_to_L**2*G%IareaT(i,j),US%m_to_L**2*G%IareaT(i+1,j))) if (Kh_here*Inv_Kh_max > 0.25) Kh_here = 0.25 / Inv_Kh_max Kh_u(I,j) = Kh_here - MEKE_uflux(I,j) = ((Kh_here * (G%dy_Cu(I,j)*G%IdxCu(I,j))) * & + MEKE_uflux(I,j) = ((Kh_here * (US%L_to_m*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)) ) * & (MEKE%MEKE(i,j) - MEKE%MEKE(i+1,j)) enddo ; enddo @@ -446,12 +446,12 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h Kh_here = max(0.,CS%MEKE_Kh) + CS%KhMEKE_Fac*0.5*(MEKE%Kh(i,j)+MEKE%Kh(i,j+1)) if (associated(MEKE%Kh_diff)) & Kh_here = max(0.,CS%MEKE_Kh) + CS%KhMEKE_Fac*0.5*(MEKE%Kh_diff(i,j)+MEKE%Kh_diff(i,j+1)) - Inv_Kh_max = 2.0*sdt * ((G%dx_Cv(i,J)*G%IdyCv(i,J)) * & + Inv_Kh_max = 2.0*sdt * ((US%L_to_m*G%dx_Cv(i,J)*G%IdyCv(i,J)) * & max(US%m_to_L**2*G%IareaT(i,j),US%m_to_L**2*G%IareaT(i,j+1))) if (Kh_here*Inv_Kh_max > 0.25) Kh_here = 0.25 / Inv_Kh_max Kh_v(i,J) = Kh_here - MEKE_vflux(i,J) = ((Kh_here * (G%dx_Cv(i,J)*G%IdyCv(i,J))) * & + MEKE_vflux(i,J) = ((Kh_here * (US%L_to_m*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) - MEKE%MEKE(i,j+1)) enddo ; enddo diff --git a/src/parameterizations/lateral/MOM_hor_visc.F90 b/src/parameterizations/lateral/MOM_hor_visc.F90 index 509ce21959..4bc095de56 100644 --- a/src/parameterizations/lateral/MOM_hor_visc.F90 +++ b/src/parameterizations/lateral/MOM_hor_visc.F90 @@ -1875,34 +1875,34 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS, MEKE) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 CS%reduction_xx(i,j) = 1.0 - if ((G%dy_Cu(I,j) > 0.0) .and. (G%dy_Cu(I,j) < G%dyCu(I,j)) .and. & - (G%dy_Cu(I,j) < G%dyCu(I,j) * CS%reduction_xx(i,j))) & - CS%reduction_xx(i,j) = G%dy_Cu(I,j) / (G%dyCu(I,j)) - if ((G%dy_Cu(I-1,j) > 0.0) .and. (G%dy_Cu(I-1,j) < G%dyCu(I-1,j)) .and. & - (G%dy_Cu(I-1,j) < G%dyCu(I-1,j) * CS%reduction_xx(i,j))) & - CS%reduction_xx(i,j) = G%dy_Cu(I-1,j) / (G%dyCu(I-1,j)) - if ((G%dx_Cv(i,J) > 0.0) .and. (G%dx_Cv(i,J) < G%dxCv(i,J)) .and. & - (G%dx_Cv(i,J) < G%dxCv(i,J) * CS%reduction_xx(i,j))) & - CS%reduction_xx(i,j) = G%dx_Cv(i,J) / (G%dxCv(i,J)) - if ((G%dx_Cv(i,J-1) > 0.0) .and. (G%dx_Cv(i,J-1) < G%dxCv(i,J-1)) .and. & - (G%dx_Cv(i,J-1) < G%dxCv(i,J-1) * CS%reduction_xx(i,j))) & - CS%reduction_xx(i,j) = G%dx_Cv(i,J-1) / (G%dxCv(i,J-1)) + if ((G%dy_Cu(I,j) > 0.0) .and. (US%L_to_m*G%dy_Cu(I,j) < G%dyCu(I,j)) .and. & + (US%L_to_m*G%dy_Cu(I,j) < G%dyCu(I,j) * CS%reduction_xx(i,j))) & + CS%reduction_xx(i,j) = US%L_to_m*G%dy_Cu(I,j) / (G%dyCu(I,j)) + if ((G%dy_Cu(I-1,j) > 0.0) .and. (US%L_to_m*G%dy_Cu(I-1,j) < G%dyCu(I-1,j)) .and. & + (US%L_to_m*G%dy_Cu(I-1,j) < G%dyCu(I-1,j) * CS%reduction_xx(i,j))) & + CS%reduction_xx(i,j) = US%L_to_m*G%dy_Cu(I-1,j) / (G%dyCu(I-1,j)) + if ((G%dx_Cv(i,J) > 0.0) .and. (US%L_to_m*G%dx_Cv(i,J) < G%dxCv(i,J)) .and. & + (US%L_to_m*G%dx_Cv(i,J) < G%dxCv(i,J) * CS%reduction_xx(i,j))) & + CS%reduction_xx(i,j) = US%L_to_m*G%dx_Cv(i,J) / (G%dxCv(i,J)) + if ((G%dx_Cv(i,J-1) > 0.0) .and. (US%L_to_m*G%dx_Cv(i,J-1) < G%dxCv(i,J-1)) .and. & + (US%L_to_m*G%dx_Cv(i,J-1) < G%dxCv(i,J-1) * CS%reduction_xx(i,j))) & + CS%reduction_xx(i,j) = US%L_to_m*G%dx_Cv(i,J-1) / (G%dxCv(i,J-1)) enddo ; enddo do J=js-1,Jeq ; do I=is-1,Ieq CS%reduction_xy(I,J) = 1.0 - if ((G%dy_Cu(I,j) > 0.0) .and. (G%dy_Cu(I,j) < G%dyCu(I,j)) .and. & - (G%dy_Cu(I,j) < G%dyCu(I,j) * CS%reduction_xy(I,J))) & - CS%reduction_xy(I,J) = G%dy_Cu(I,j) / (G%dyCu(I,j)) - if ((G%dy_Cu(I,j+1) > 0.0) .and. (G%dy_Cu(I,j+1) < G%dyCu(I,j+1)) .and. & - (G%dy_Cu(I,j+1) < G%dyCu(I,j+1) * CS%reduction_xy(I,J))) & - CS%reduction_xy(I,J) = G%dy_Cu(I,j+1) / (G%dyCu(I,j+1)) - if ((G%dx_Cv(i,J) > 0.0) .and. (G%dx_Cv(i,J) < G%dxCv(i,J)) .and. & - (G%dx_Cv(i,J) < G%dxCv(i,J) * CS%reduction_xy(I,J))) & - CS%reduction_xy(I,J) = G%dx_Cv(i,J) / (G%dxCv(i,J)) - if ((G%dx_Cv(i+1,J) > 0.0) .and. (G%dx_Cv(i+1,J) < G%dxCv(i+1,J)) .and. & - (G%dx_Cv(i+1,J) < G%dxCv(i+1,J) * CS%reduction_xy(I,J))) & - CS%reduction_xy(I,J) = G%dx_Cv(i+1,J) / (G%dxCv(i+1,J)) + if ((G%dy_Cu(I,j) > 0.0) .and. (US%L_to_m*G%dy_Cu(I,j) < G%dyCu(I,j)) .and. & + (US%L_to_m*G%dy_Cu(I,j) < G%dyCu(I,j) * CS%reduction_xy(I,J))) & + CS%reduction_xy(I,J) = US%L_to_m*G%dy_Cu(I,j) / (G%dyCu(I,j)) + if ((G%dy_Cu(I,j+1) > 0.0) .and. (US%L_to_m*G%dy_Cu(I,j+1) < G%dyCu(I,j+1)) .and. & + (US%L_to_m*G%dy_Cu(I,j+1) < G%dyCu(I,j+1) * CS%reduction_xy(I,J))) & + CS%reduction_xy(I,J) = US%L_to_m*G%dy_Cu(I,j+1) / (G%dyCu(I,j+1)) + if ((G%dx_Cv(i,J) > 0.0) .and. (US%L_to_m*G%dx_Cv(i,J) < G%dxCv(i,J)) .and. & + (US%L_to_m*G%dx_Cv(i,J) < G%dxCv(i,J) * CS%reduction_xy(I,J))) & + CS%reduction_xy(I,J) = US%L_to_m*G%dx_Cv(i,J) / (G%dxCv(i,J)) + if ((G%dx_Cv(i+1,J) > 0.0) .and. (US%L_to_m*G%dx_Cv(i+1,J) < G%dxCv(i+1,J)) .and. & + (US%L_to_m*G%dx_Cv(i+1,J) < G%dxCv(i+1,J) * CS%reduction_xy(I,J))) & + CS%reduction_xy(I,J) = US%L_to_m*G%dx_Cv(i+1,J) / (G%dxCv(i+1,J)) enddo ; enddo if (CS%Laplacian) then diff --git a/src/parameterizations/lateral/MOM_internal_tides.F90 b/src/parameterizations/lateral/MOM_internal_tides.F90 index e3db9b90a6..b2b63f90ac 100644 --- a/src/parameterizations/lateral/MOM_internal_tides.F90 +++ b/src/parameterizations/lateral/MOM_internal_tides.F90 @@ -1536,16 +1536,16 @@ subroutine zonal_flux_En(u, h, hL, hR, uh, dt, G, US, j, ish, ieh, vol_CFL) do I=ish-1,ieh ! Set new values of uh and duhdu. if (u(I) > 0.0) then - if (vol_CFL) then ; CFL = (u(I) * dt) * (G%dy_Cu(I,j) * US%m_to_L**2*G%IareaT(i,j)) + if (vol_CFL) then ; CFL = (u(I) * dt) * (US%L_to_m*G%dy_Cu(I,j) * US%m_to_L**2*G%IareaT(i,j)) else ; CFL = u(I) * dt * G%IdxT(i,j) ; endif curv_3 = (hL(i) + hR(i)) - 2.0*h(i) - uh(I) = G%dy_Cu(I,j) * u(I) * & + uh(I) = US%L_to_m*G%dy_Cu(I,j) * u(I) * & (hR(i) + CFL * (0.5*(hL(i) - hR(i)) + curv_3*(CFL - 1.5))) elseif (u(I) < 0.0) then - if (vol_CFL) then ; CFL = (-u(I) * dt) * (G%dy_Cu(I,j) * US%m_to_L**2*G%IareaT(i+1,j)) + if (vol_CFL) then ; CFL = (-u(I) * dt) * (US%L_to_m*G%dy_Cu(I,j) * US%m_to_L**2*G%IareaT(i+1,j)) else ; CFL = -u(I) * dt * G%IdxT(i+1,j) ; endif curv_3 = (hL(i+1) + hR(i+1)) - 2.0*h(i+1) - uh(I) = G%dy_Cu(I,j) * u(I) * & + uh(I) = US%L_to_m*G%dy_Cu(I,j) * u(I) * & (hL(i+1) + CFL * (0.5*(hR(i+1)-hL(i+1)) + curv_3*(CFL - 1.5))) else uh(I) = 0.0 @@ -1580,16 +1580,16 @@ subroutine merid_flux_En(v, h, hL, hR, vh, dt, G, US, J, ish, ieh, vol_CFL) do i=ish,ieh if (v(i) > 0.0) then - if (vol_CFL) then ; CFL = (v(i) * dt) * (G%dx_Cv(i,J) * US%m_to_L**2*G%IareaT(i,j)) + if (vol_CFL) then ; CFL = (v(i) * dt) * (US%L_to_m*G%dx_Cv(i,J) * US%m_to_L**2*G%IareaT(i,j)) else ; CFL = v(i) * dt * G%IdyT(i,j) ; endif curv_3 = hL(i,j) + hR(i,j) - 2.0*h(i,j) - vh(i) = G%dx_Cv(i,J) * v(i) * ( hR(i,j) + CFL * & + vh(i) = US%L_to_m*G%dx_Cv(i,J) * v(i) * ( hR(i,j) + CFL * & (0.5*(hL(i,j) - hR(i,j)) + curv_3*(CFL - 1.5)) ) elseif (v(i) < 0.0) then - if (vol_CFL) then ; CFL = (-v(i) * dt) * (G%dx_Cv(i,J) * US%m_to_L**2*G%IareaT(i,j+1)) + if (vol_CFL) then ; CFL = (-v(i) * dt) * (US%L_to_m*G%dx_Cv(i,J) * US%m_to_L**2*G%IareaT(i,j+1)) else ; CFL = -v(i) * dt * G%IdyT(i,j+1) ; endif curv_3 = hL(i,j+1) + hR(i,j+1) - 2.0*h(i,j+1) - vh(i) = G%dx_Cv(i,J) * v(i) * ( hL(i,j+1) + CFL * & + vh(i) = US%L_to_m*G%dx_Cv(i,J) * v(i) * ( hL(i,j+1) + CFL * & (0.5*(hR(i,j+1)-hL(i,j+1)) + curv_3*(CFL - 1.5)) ) else vh(i) = 0.0 @@ -2391,8 +2391,7 @@ subroutine internal_tides_init(Time, G, GV, US, param_file, diag, CS) !call MOM_read_data(filename, 'land_mask', G%mask2dCu, G%domain, timelevel=1) !call MOM_read_data(filename, 'land_mask', G%mask2dCv, G%domain, timelevel=1) !call MOM_read_data(filename, 'land_mask', G%mask2dT, G%domain, timelevel=1) - !call pass_var(G%mask2dCu,G%domain) - !call pass_var(G%mask2dCv,G%domain) + !call pass_vector(G%mask2dCu, G%mask2dCv, G%domain, To_All+Scalar_Pair, CGRID_NE) !call pass_var(G%mask2dT,G%domain) ! Read in prescribed partial east face blockages from file (if overwriting -BDM) @@ -2402,8 +2401,7 @@ subroutine internal_tides_init(Time, G, GV, US, param_file, diag, CS) !filename = trim(CS%inputdir) // trim(dy_Cu_file) !call log_param(param_file, mdl, "INPUTDIR/dy_Cu_FILE", filename) !G%dy_Cu(:,:) = 0.0 - !call MOM_read_data(filename, 'dy_Cu', G%dy_Cu, G%domain, timelevel=1) - !call pass_var(G%dy_Cu,G%domain) + !call MOM_read_data(filename, 'dy_Cu', G%dy_Cu, G%domain, timelevel=1, scale=US%m_to_L) ! Read in prescribed partial north face blockages from file (if overwriting -BDM) !call get_param(param_file, mdl, "dx_Cv_FILE", dx_Cv_file, & @@ -2412,8 +2410,8 @@ subroutine internal_tides_init(Time, G, GV, US, param_file, diag, CS) !filename = trim(CS%inputdir) // trim(dx_Cv_file) !call log_param(param_file, mdl, "INPUTDIR/dx_Cv_FILE", filename) !G%dx_Cv(:,:) = 0.0 - !call MOM_read_data(filename, 'dx_Cv', G%dx_Cv, G%domain, timelevel=1) - !call pass_var(G%dx_Cv,G%domain) + !call MOM_read_data(filename, 'dx_Cv', G%dx_Cv, G%domain, timelevel=1, scale=US%m_to_L) + !call pass_vector(G%dy_Cu, G%dx_Cv, G%domain, To_All+Scalar_Pair, CGRID_NE) ! Register maps of reflection parameters CS%id_refl_ang = register_diag_field('ocean_model', 'refl_angle', diag%axesT1, & @@ -2421,9 +2419,9 @@ subroutine internal_tides_init(Time, G, GV, US, param_file, diag, CS) CS%id_refl_pref = register_diag_field('ocean_model', 'refl_pref', diag%axesT1, & Time, 'Partial reflection coefficients', '') CS%id_dx_Cv = register_diag_field('ocean_model', 'dx_Cv', diag%axesT1, & - Time, 'North face unblocked width', 'm') ! used if overriding (BDM) + Time, 'North face unblocked width', 'm', conversion=US%L_to_m) CS%id_dy_Cu = register_diag_field('ocean_model', 'dy_Cu', diag%axesT1, & - Time, 'East face unblocked width', 'm') ! used if overriding (BDM) + Time, 'East face unblocked width', 'm', conversion=US%L_to_m) CS%id_land_mask = register_diag_field('ocean_model', 'land_mask', diag%axesT1, & Time, 'Land mask', 'logical') ! used if overriding (BDM) ! Output reflection parameters as diags here (not needed every timestep) diff --git a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 index c6a05b0401..f5ef54ffd2 100644 --- a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 +++ b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 @@ -831,7 +831,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV if (CS%id_slope_x > 0) CS%diagSlopeX(I,j,k) = Slope ! Estimate the streamfunction at each interface [m3 s-1]. - Sfn_unlim_u(I,K) = -((KH_u(I,j,K)*G%dy_Cu(I,j))*US%m_to_Z*Slope) + Sfn_unlim_u(I,K) = -((KH_u(I,j,K)*US%L_to_m*G%dy_Cu(I,j))*US%m_to_Z*Slope) ! Avoid moving dense water upslope from below the level of ! the bottom on the receiving side. @@ -860,7 +860,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV Slope = US%Z_to_m*((e(i,j,K)-e(i+1,j,K))*G%IdxCu(I,j)) * G%mask2dCu(I,j) 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) + Sfn_unlim_u(I,K) = ((KH_u(I,j,K)*US%L_to_m*G%dy_Cu(I,j))*US%m_to_Z*Slope) 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) @@ -922,7 +922,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV ! sfn_slope_x(I,j,K) = max(uhtot(I,j)-h_avail(i+1,j,k), & ! min(uhtot(I,j)+h_avail(i,j,k), & ! min(h_avail_rsum(i+1,j,K), max(-h_avail_rsum(i,j,K), & -! (KH_u(I,j,K)*G%dy_Cu(I,j)) * ((e(i,j,K)-e(i+1,j,K))*G%IdxCu(I,j)) )) )) +! (KH_u(I,j,K)*US%L_to_m*G%dy_Cu(I,j)) * ((e(i,j,K)-e(i+1,j,K))*G%IdxCu(I,j)) )) )) else ! k <= nk_linear ! Balance the deeper flow with a return flow uniformly distributed ! though the remaining near-surface layers. This is the same as @@ -1080,7 +1080,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV if (CS%id_slope_y > 0) CS%diagSlopeY(I,j,k) = Slope ! Estimate the streamfunction at each interface [m3 s-1]. - Sfn_unlim_v(i,K) = -((KH_v(i,J,K)*G%dx_Cv(i,J))*US%m_to_Z*Slope) + Sfn_unlim_v(i,K) = -((KH_v(i,J,K)*US%L_to_m*G%dx_Cv(i,J))*US%m_to_Z*Slope) ! Avoid moving dense water upslope from below the level of ! the bottom on the receiving side. @@ -1109,7 +1109,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV Slope = US%Z_to_m*((e(i,j,K)-e(i,j+1,K))*G%IdyCv(i,J)) * G%mask2dCv(i,J) 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) + Sfn_unlim_v(i,K) = ((KH_v(i,J,K)*US%L_to_m*G%dx_Cv(i,J))*US%m_to_Z*Slope) 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) @@ -1171,7 +1171,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV ! sfn_slope_y(i,J,K) = max(vhtot(i,J)-h_avail(i,j+1,k), & ! min(vhtot(i,J)+h_avail(i,j,k), & ! min(h_avail_rsum(i,j+1,K), max(-h_avail_rsum(i,j,K), & -! (KH_v(i,J,K)*G%dx_Cv(i,J)) * ((e(i,j,K)-e(i,j+1,K))*G%IdyCv(i,J)) )) )) +! (KH_v(i,J,K)*US%L_to_m*G%dx_Cv(i,J)) * ((e(i,j,K)-e(i,j+1,K))*G%IdyCv(i,J)) )) )) else ! k <= nk_linear ! Balance the deeper flow with a return flow uniformly distributed ! though the remaining near-surface layers. This is the same as @@ -1526,7 +1526,7 @@ subroutine add_detangling_Kh(h, e, Kh_u, Kh_v, KH_u_CFL, KH_v_CFL, tv, dt, G, GV do k=k_top,nz ; do i=ish,ie ; if (do_i(i)) then if (n==1) then ! This is a u-column. dH = 0.0 - denom = ((US%m_to_L**2*G%IareaT(i+1,j) + US%m_to_L**2*G%IareaT(i,j))*G%dy_Cu(I,j)) + denom = ((US%m_to_L**2*G%IareaT(i+1,j) + US%m_to_L**2*G%IareaT(i,j))*US%L_to_m*G%dy_Cu(I,j)) ! This expression uses differences in e in place of h for better ! consistency with the slopes. if (denom > 0.0) & @@ -1551,7 +1551,7 @@ subroutine add_detangling_Kh(h, e, Kh_u, Kh_v, KH_u_CFL, KH_v_CFL, tv, dt, G, GV Kh_detangle(I,K+1) = Kh_detangle(I,K+1) + wt2*Kh_lay_u(I,j,k) else ! This is a v-column. dH = 0.0 - denom = ((US%m_to_L**2*G%IareaT(i,j+1) + US%m_to_L**2*G%IareaT(i,j))*G%dx_Cv(I,j)) + denom = ((US%m_to_L**2*G%IareaT(i,j+1) + US%m_to_L**2*G%IareaT(i,j))*US%L_to_m*G%dx_Cv(I,j)) if (denom > 0.0) & dH = I_4t * ((e(i,j+1,K) - e(i,j+1,K+1)) - & (e(i,j,K) - e(i,j,K+1))) / denom @@ -1683,7 +1683,7 @@ subroutine add_detangling_Kh(h, e, Kh_u, Kh_v, KH_u_CFL, KH_v_CFL, tv, dt, G, GV ! ((e(i+1,j,K)-e(i+1,j,K+1)) - (e(i,j,K)-e(i,j,K+1))) > 0.0) then ! Sfn(K) = -Kh(i,K) * (e(i+1,j,K)-e(i,j,K)) * G%IdxCu(I,j) ! Sfn(K+1) = -Kh(i,K+1) * (e(i+1,j,K+1)-e(i,j,K+1)) * G%IdxCu(I,j) -! uh_here(k) = (Sfn(K) - Sfn(K+1))*G%dy_Cu(I,j) +! uh_here(k) = (Sfn(K) - Sfn(K+1))*US%L_to_m*G%dy_Cu(I,j) ! if (abs(uh_here(k))*min(US%m_to_L**2*G%IareaT(i,j), US%m_to_L**2*G%IareaT(i+1,j)) > & ! (1e-10*GV%m_to_H)) then ! if (uh_here(k) * (h(i+1,j,k) - h(i,j,k)) > 0.0) then @@ -1703,7 +1703,7 @@ subroutine add_detangling_Kh(h, e, Kh_u, Kh_v, KH_u_CFL, KH_v_CFL, tv, dt, G, GV ! ((e(i,j+1,K)-e(i,j+1,K+1)) - (e(i,j,K)-e(i,j,K+1))) > 0.0) then ! Sfn(K) = -Kh(i,K) * (e(i,j+1,K)-e(i,j,K)) * G%IdyCv(i,J) ! Sfn(K+1) = -Kh(i,K+1) * (e(i,j+1,K+1)-e(i,j,K+1)) * G%IdyCv(i,J) -! uh_here(k) = (Sfn(K) - Sfn(K+1))*G%dx_Cv(i,J) +! uh_here(k) = (Sfn(K) - Sfn(K+1))*US%L_to_m*G%dx_Cv(i,J) ! if (abs(uh_here(K))*min(US%m_to_L**2*G%IareaT(i,j), US%m_to_L**2*G%IareaT(i,j+1)) > & ! (1e-10*GV%m_to_H)) then ! if (uh_here(K) * (h(i,j+1,k) - h(i,j,k)) > 0.0) then diff --git a/src/parameterizations/vertical/MOM_set_viscosity.F90 b/src/parameterizations/vertical/MOM_set_viscosity.F90 index 641415893c..8b4101eb62 100644 --- a/src/parameterizations/vertical/MOM_set_viscosity.F90 +++ b/src/parameterizations/vertical/MOM_set_viscosity.F90 @@ -831,8 +831,8 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, symmetrize) BBL_frac = 0.0 endif - if (m==1) then ; Cell_width = G%dy_Cu(I,j) - else ; Cell_width = G%dx_Cv(i,J) ; endif + if (m==1) then ; Cell_width = US%L_to_m*G%dy_Cu(I,j) + else ; Cell_width = US%L_to_m*G%dx_Cv(i,J) ; endif gam = 1.0 - L(K+1)/L(K) Rayleigh = US%m_to_Z * CS%cdrag * (L(K)-L(K+1)) * (1.0-BBL_frac) * & (12.0*CS%c_Smag*h_vel_pos) / (12.0*CS%c_Smag*h_vel_pos + & diff --git a/src/parameterizations/vertical/MOM_vert_friction.F90 b/src/parameterizations/vertical/MOM_vert_friction.F90 index bbf7eac1fa..ff6d834215 100644 --- a/src/parameterizations/vertical/MOM_vert_friction.F90 +++ b/src/parameterizations/vertical/MOM_vert_friction.F90 @@ -1395,9 +1395,9 @@ subroutine vertvisc_limit_vel(u, v, h, ADp, CDp, forces, visc, dt, G, GV, US, CS do k=1,nz ; do I=Isq,Ieq if (abs(u(I,j,k)) < CS%vel_underflow) u(I,j,k) = 0.0 if (u(I,j,k) < 0.0) then - CFL = (-u(I,j,k) * dt) * (G%dy_Cu(I,j) * US%m_to_L**2*G%IareaT(i+1,j)) + CFL = (-u(I,j,k) * dt) * (US%L_to_m*G%dy_Cu(I,j) * US%m_to_L**2*G%IareaT(i+1,j)) else - CFL = (u(I,j,k) * dt) * (G%dy_Cu(I,j) * US%m_to_L**2*G%IareaT(i,j)) + CFL = (u(I,j,k) * dt) * (US%L_to_m*G%dy_Cu(I,j) * US%m_to_L**2*G%IareaT(i,j)) endif if (CFL > CS%CFL_trunc) trunc_any = .true. if (CFL > CS%CFL_report) then @@ -1421,11 +1421,11 @@ subroutine vertvisc_limit_vel(u, v, h, ADp, CDp, forces, visc, dt, G, GV, US, CS if (trunc_any) then ; if (CS%CFL_based_trunc) then do k=1,nz ; do I=Isq,Ieq - if ((u(I,j,k) * (dt * G%dy_Cu(I,j))) * US%m_to_L**2*G%IareaT(i+1,j) < -CS%CFL_trunc) then - u(I,j,k) = (-0.9*CS%CFL_trunc) * (US%L_to_m**2*G%areaT(i+1,j) / (dt * G%dy_Cu(I,j))) + if ((u(I,j,k) * (dt * US%L_to_m*G%dy_Cu(I,j))) * US%m_to_L**2*G%IareaT(i+1,j) < -CS%CFL_trunc) then + u(I,j,k) = (-0.9*CS%CFL_trunc) * (US%L_to_m**2*G%areaT(i+1,j) / (dt * US%L_to_m*G%dy_Cu(I,j))) if (h(i,j,k) + h(i+1,j,k) > H_report) CS%ntrunc = CS%ntrunc + 1 - elseif ((u(I,j,k) * (dt * G%dy_Cu(I,j))) * US%m_to_L**2*G%IareaT(i,j) > CS%CFL_trunc) then - u(I,j,k) = (0.9*CS%CFL_trunc) * (US%L_to_m**2*G%areaT(i,j) / (dt * G%dy_Cu(I,j))) + elseif ((u(I,j,k) * (dt * US%L_to_m*G%dy_Cu(I,j))) * US%m_to_L**2*G%IareaT(i,j) > CS%CFL_trunc) then + u(I,j,k) = (0.9*CS%CFL_trunc) * (US%L_to_m**2*G%areaT(i,j) / (dt * US%L_to_m*G%dy_Cu(I,j))) if (h(i,j,k) + h(i+1,j,k) > H_report) CS%ntrunc = CS%ntrunc + 1 endif enddo ; enddo @@ -1441,11 +1441,11 @@ subroutine vertvisc_limit_vel(u, v, h, ADp, CDp, forces, visc, dt, G, GV, US, CS !$OMP parallel do default(none) shared(nz,js,je,Isq,Ieq,u,dt,G,CS,h,H_report) do k=1,nz ; do j=js,je ; do I=Isq,Ieq if (abs(u(I,j,k)) < CS%vel_underflow) then ; u(I,j,k) = 0.0 - elseif ((u(I,j,k) * (dt * G%dy_Cu(I,j))) * US%m_to_L**2*G%IareaT(i+1,j) < -CS%CFL_trunc) then - u(I,j,k) = (-0.9*CS%CFL_trunc) * (US%L_to_m**2*G%areaT(i+1,j) / (dt * G%dy_Cu(I,j))) + elseif ((u(I,j,k) * (dt * US%L_to_m*G%dy_Cu(I,j))) * US%m_to_L**2*G%IareaT(i+1,j) < -CS%CFL_trunc) then + u(I,j,k) = (-0.9*CS%CFL_trunc) * (US%L_to_m**2*G%areaT(i+1,j) / (dt * US%L_to_m*G%dy_Cu(I,j))) if (h(i,j,k) + h(i+1,j,k) > H_report) CS%ntrunc = CS%ntrunc + 1 - elseif ((u(I,j,k) * (dt * G%dy_Cu(I,j))) * US%m_to_L**2*G%IareaT(i,j) > CS%CFL_trunc) then - u(I,j,k) = (0.9*CS%CFL_trunc) * (US%L_to_m**2*G%areaT(i,j) / (dt * G%dy_Cu(I,j))) + elseif ((u(I,j,k) * (dt * US%L_to_m*G%dy_Cu(I,j))) * US%m_to_L**2*G%IareaT(i,j) > CS%CFL_trunc) then + u(I,j,k) = (0.9*CS%CFL_trunc) * (US%L_to_m**2*G%areaT(i,j) / (dt * US%L_to_m*G%dy_Cu(I,j))) if (h(i,j,k) + h(i+1,j,k) > H_report) CS%ntrunc = CS%ntrunc + 1 endif enddo ; enddo ; enddo @@ -1480,9 +1480,9 @@ subroutine vertvisc_limit_vel(u, v, h, ADp, CDp, forces, visc, dt, G, GV, US, CS do k=1,nz ; do i=is,ie if (abs(v(i,J,k)) < CS%vel_underflow) v(i,J,k) = 0.0 if (v(i,J,k) < 0.0) then - CFL = (-v(i,J,k) * dt) * (G%dx_Cv(i,J) * US%m_to_L**2*G%IareaT(i,j+1)) + CFL = (-v(i,J,k) * dt) * (US%L_to_m*G%dx_Cv(i,J) * US%m_to_L**2*G%IareaT(i,j+1)) else - CFL = (v(i,J,k) * dt) * (G%dx_Cv(i,J) * US%m_to_L**2*G%IareaT(i,j)) + CFL = (v(i,J,k) * dt) * (US%L_to_m*G%dx_Cv(i,J) * US%m_to_L**2*G%IareaT(i,j)) endif if (CFL > CS%CFL_trunc) trunc_any = .true. if (CFL > CS%CFL_report) then @@ -1506,11 +1506,11 @@ subroutine vertvisc_limit_vel(u, v, h, ADp, CDp, forces, visc, dt, G, GV, US, CS if (trunc_any) then ; if (CS%CFL_based_trunc) then do k=1,nz; do i=is,ie - if ((v(i,J,k) * (dt * G%dx_Cv(i,J))) * US%m_to_L**2*G%IareaT(i,j+1) < -CS%CFL_trunc) then - v(i,J,k) = (-0.9*CS%CFL_trunc) * (US%L_to_m**2*G%areaT(i,j+1) / (dt * G%dx_Cv(i,J))) + if ((v(i,J,k) * (dt * US%L_to_m*G%dx_Cv(i,J))) * US%m_to_L**2*G%IareaT(i,j+1) < -CS%CFL_trunc) then + v(i,J,k) = (-0.9*CS%CFL_trunc) * (US%L_to_m**2*G%areaT(i,j+1) / (dt * US%L_to_m*G%dx_Cv(i,J))) if (h(i,j,k) + h(i,j+1,k) > H_report) CS%ntrunc = CS%ntrunc + 1 - elseif ((v(i,J,k) * (dt * G%dx_Cv(i,J))) * US%m_to_L**2*G%IareaT(i,j) > CS%CFL_trunc) then - v(i,J,k) = (0.9*CS%CFL_trunc) * (US%L_to_m**2*G%areaT(i,j) / (dt * G%dx_Cv(i,J))) + elseif ((v(i,J,k) * (dt * US%L_to_m*G%dx_Cv(i,J))) * US%m_to_L**2*G%IareaT(i,j) > CS%CFL_trunc) then + v(i,J,k) = (0.9*CS%CFL_trunc) * (US%L_to_m**2*G%areaT(i,j) / (dt * US%L_to_m*G%dx_Cv(i,J))) if (h(i,j,k) + h(i,j+1,k) > H_report) CS%ntrunc = CS%ntrunc + 1 endif enddo ; enddo @@ -1526,11 +1526,11 @@ subroutine vertvisc_limit_vel(u, v, h, ADp, CDp, forces, visc, dt, G, GV, US, CS !$OMP parallel do default(shared) do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie if (abs(v(i,J,k)) < CS%vel_underflow) then ; v(i,J,k) = 0.0 - elseif ((v(i,J,k) * (dt * G%dx_Cv(i,J))) * US%m_to_L**2*G%IareaT(i,j+1) < -CS%CFL_trunc) then - v(i,J,k) = (-0.9*CS%CFL_trunc) * (US%L_to_m**2*G%areaT(i,j+1) / (dt * G%dx_Cv(i,J))) + elseif ((v(i,J,k) * (dt * US%L_to_m*G%dx_Cv(i,J))) * US%m_to_L**2*G%IareaT(i,j+1) < -CS%CFL_trunc) then + v(i,J,k) = (-0.9*CS%CFL_trunc) * (US%L_to_m**2*G%areaT(i,j+1) / (dt * US%L_to_m*G%dx_Cv(i,J))) if (h(i,j,k) + h(i,j+1,k) > H_report) CS%ntrunc = CS%ntrunc + 1 - elseif ((v(i,J,k) * (dt * G%dx_Cv(i,J))) * US%m_to_L**2*G%IareaT(i,j) > CS%CFL_trunc) then - v(i,J,k) = (0.9*CS%CFL_trunc) * (US%L_to_m**2*G%areaT(i,j) / (dt * G%dx_Cv(i,J))) + elseif ((v(i,J,k) * (dt * US%L_to_m*G%dx_Cv(i,J))) * US%m_to_L**2*G%IareaT(i,j) > CS%CFL_trunc) then + v(i,J,k) = (0.9*CS%CFL_trunc) * (US%L_to_m**2*G%areaT(i,j) / (dt * US%L_to_m*G%dx_Cv(i,J))) if (h(i,j,k) + h(i,j+1,k) > H_report) CS%ntrunc = CS%ntrunc + 1 endif enddo ; enddo ; enddo diff --git a/src/tracer/MOM_tracer_hor_diff.F90 b/src/tracer/MOM_tracer_hor_diff.F90 index 8e9333e7a1..534c3c20ae 100644 --- a/src/tracer/MOM_tracer_hor_diff.F90 +++ b/src/tracer/MOM_tracer_hor_diff.F90 @@ -244,48 +244,48 @@ subroutine tracer_hordiff(h, dt, MEKE, VarMix, G, GV, US, CS, Reg, tv, do_online !$OMP parallel do default(shared) do j=js,je ; do I=is-1,ie - khdt_x(I,j) = dt*(Kh_u(I,j)*(G%dy_Cu(I,j)*G%IdxCu(I,j))) + khdt_x(I,j) = dt*(Kh_u(I,j)*(US%L_to_m*G%dy_Cu(I,j)*G%IdxCu(I,j))) enddo ; enddo !$OMP parallel do default(shared) do J=js-1,je ; do i=is,ie - khdt_y(i,J) = dt*(Kh_v(i,J)*(G%dx_Cv(i,J)*G%IdyCv(i,J))) + khdt_y(i,J) = dt*(Kh_v(i,J)*(US%L_to_m*G%dx_Cv(i,J)*G%IdyCv(i,J))) enddo ; enddo elseif (Resoln_scaled) then !$OMP parallel do default(shared) private(Res_fn) do j=js,je ; do I=is-1,ie Res_fn = 0.5 * (VarMix%Res_fn_h(i,j) + VarMix%Res_fn_h(i+1,j)) Kh_u(I,j) = max(CS%KhTr * Res_fn, CS%KhTr_min) - khdt_x(I,j) = dt*(CS%KhTr*(G%dy_Cu(I,j)*G%IdxCu(I,j))) * Res_fn + khdt_x(I,j) = dt*(CS%KhTr*(US%L_to_m*G%dy_Cu(I,j)*G%IdxCu(I,j))) * Res_fn enddo ; enddo !$OMP parallel do default(shared) private(Res_fn) do J=js-1,je ; do i=is,ie Res_fn = 0.5*(VarMix%Res_fn_h(i,j) + VarMix%Res_fn_h(i,j+1)) Kh_v(i,J) = max(CS%KhTr * Res_fn, CS%KhTr_min) - khdt_y(i,J) = dt*(CS%KhTr*(G%dx_Cv(i,J)*G%IdyCv(i,J))) * Res_fn + khdt_y(i,J) = dt*(CS%KhTr*(US%L_to_m*G%dx_Cv(i,J)*G%IdyCv(i,J))) * Res_fn enddo ; enddo else ! Use a simple constant diffusivity. if (CS%id_KhTr_u > 0) then !$OMP parallel do default(shared) do j=js,je ; do I=is-1,ie Kh_u(I,j) = CS%KhTr - khdt_x(I,j) = dt*(CS%KhTr*(G%dy_Cu(I,j)*G%IdxCu(I,j))) + khdt_x(I,j) = dt*(CS%KhTr*(US%L_to_m*G%dy_Cu(I,j)*G%IdxCu(I,j))) enddo ; enddo else !$OMP parallel do default(shared) do j=js,je ; do I=is-1,ie - khdt_x(I,j) = dt*(CS%KhTr*(G%dy_Cu(I,j)*G%IdxCu(I,j))) + khdt_x(I,j) = dt*(CS%KhTr*(US%L_to_m*G%dy_Cu(I,j)*G%IdxCu(I,j))) enddo ; enddo endif if (CS%id_KhTr_v > 0) then !$OMP parallel do default(shared) do J=js-1,je ; do i=is,ie Kh_v(i,J) = CS%KhTr - khdt_y(i,J) = dt*(CS%KhTr*(G%dx_Cv(i,J)*G%IdyCv(i,J))) + khdt_y(i,J) = dt*(CS%KhTr*(US%L_to_m*G%dx_Cv(i,J)*G%IdyCv(i,J))) enddo ; enddo else !$OMP parallel do default(shared) do J=js-1,je ; do i=is,ie - khdt_y(i,J) = dt*(CS%KhTr*(G%dx_Cv(i,J)*G%IdyCv(i,J))) + khdt_y(i,J) = dt*(CS%KhTr*(US%L_to_m*G%dx_Cv(i,J)*G%IdyCv(i,J))) enddo ; enddo endif endif ! VarMix @@ -297,8 +297,8 @@ subroutine tracer_hordiff(h, dt, MEKE, VarMix, G, GV, US, CS, Reg, tv, do_online khdt_max = 0.125*CS%max_diff_CFL * min(US%L_to_m**2*G%areaT(i,j), US%L_to_m**2*G%areaT(i+1,j)) if (khdt_x(I,j) > khdt_max) then khdt_x(I,j) = khdt_max - if (dt*(G%dy_Cu(I,j)*G%IdxCu(I,j)) > 0.0) & - Kh_u(I,j) = khdt_x(I,j) / (dt*(G%dy_Cu(I,j)*G%IdxCu(I,j))) + if (dt*(US%L_to_m*G%dy_Cu(I,j)*G%IdxCu(I,j)) > 0.0) & + Kh_u(I,j) = khdt_x(I,j) / (dt*(US%L_to_m*G%dy_Cu(I,j)*G%IdxCu(I,j))) endif enddo ; enddo else @@ -314,8 +314,8 @@ subroutine tracer_hordiff(h, dt, MEKE, VarMix, G, GV, US, CS, Reg, tv, do_online khdt_max = 0.125*CS%max_diff_CFL * min(US%L_to_m**2*G%areaT(i,j), US%L_to_m**2*G%areaT(i,j+1)) if (khdt_y(i,J) > khdt_max) then khdt_y(i,J) = khdt_max - if (dt*(G%dx_Cv(i,J)*G%IdyCv(i,J)) > 0.0) & - Kh_v(i,J) = khdt_y(i,J) / (dt*(G%dx_Cv(i,J)*G%IdyCv(i,J))) + if (dt*(US%L_to_m*G%dx_Cv(i,J)*G%IdyCv(i,J)) > 0.0) & + Kh_v(i,J) = khdt_y(i,J) / (dt*(US%L_to_m*G%dx_Cv(i,J)*G%IdyCv(i,J))) endif enddo ; enddo else diff --git a/src/user/MOM_controlled_forcing.F90 b/src/user/MOM_controlled_forcing.F90 index cbfce62f39..be130a2a06 100644 --- a/src/user/MOM_controlled_forcing.F90 +++ b/src/user/MOM_controlled_forcing.F90 @@ -136,12 +136,12 @@ subroutine apply_ctrl_forcing(SST_anom, SSS_anom, SSS_mean, virt_heat, virt_prec call pass_var(CS%precip_0, G%Domain) do j=js,je ; do I=is-1,ie - coef = CS%Len2 * (G%dy_Cu(I,j)*G%IdxCu(I,j)) + coef = CS%Len2 * (US%L_to_m*G%dy_Cu(I,j)*G%IdxCu(I,j)) flux_heat_x(I,j) = coef * (CS%heat_0(i,j) - CS%heat_0(i+1,j)) flux_prec_x(I,j) = coef * (CS%precip_0(i,j) - CS%precip_0(i+1,j)) enddo ; enddo do J=js-1,je ; do i=is,ie - coef = CS%Len2 * (G%dx_Cv(i,J)*G%IdyCv(i,J)) + coef = CS%Len2 * (US%L_to_m*G%dx_Cv(i,J)*G%IdyCv(i,J)) flux_heat_y(i,J) = coef * (CS%heat_0(i,j) - CS%heat_0(i,j+1)) flux_prec_y(i,J) = coef * (CS%precip_0(i,j) - CS%precip_0(i,j+1)) enddo ; enddo @@ -320,12 +320,12 @@ subroutine apply_ctrl_forcing(SST_anom, SSS_anom, SSS_mean, virt_heat, virt_prec if ((CS%avg_time(m_u1) == -1.0) .and. (CS%avg_time(m_u2) == -1.0)) then do j=js,je ; do I=is-1,ie - coef = CS%Len2 * (G%dy_Cu(I,j)*G%IdxCu(I,j)) + coef = CS%Len2 * (US%L_to_m*G%dy_Cu(I,j)*G%IdxCu(I,j)) flux_heat_x(I,j) = coef * (CS%heat_cyc(i,j,m_u1) - CS%heat_cyc(i+1,j,m_u1)) flux_prec_x(I,j) = coef * (CS%precip_cyc(i,j,m_u1) - CS%precip_cyc(i+1,j,m_u1)) enddo ; enddo do J=js-1,je ; do i=is,ie - coef = CS%Len2 * (G%dx_Cv(i,J)*G%IdyCv(i,J)) + coef = CS%Len2 * (US%L_to_m*G%dx_Cv(i,J)*G%IdyCv(i,J)) flux_heat_y(i,J) = coef * (CS%heat_cyc(i,j,m_u1) - CS%heat_cyc(i,j+1,m_u1)) flux_prec_y(i,J) = coef * (CS%precip_cyc(i,j,m_u1) - CS%precip_cyc(i,j+1,m_u1)) enddo ; enddo @@ -345,12 +345,12 @@ subroutine apply_ctrl_forcing(SST_anom, SSS_anom, SSS_mean, virt_heat, virt_prec if ((wt_per1 < 1.0) .and. (CS%avg_time(m_u1) == -1.0) .and. (CS%avg_time(m_u2) == -1.0)) then do j=js,je ; do I=is-1,ie - coef = CS%Len2 * (G%dy_Cu(I,j)*G%IdxCu(I,j)) + coef = CS%Len2 * (US%L_to_m*G%dy_Cu(I,j)*G%IdxCu(I,j)) flux_heat_x(I,j) = coef * (CS%heat_cyc(i,j,m_u2) - CS%heat_cyc(i+1,j,m_u2)) flux_prec_x(I,j) = coef * (CS%precip_cyc(i,j,m_u2) - CS%precip_cyc(i+1,j,m_u2)) enddo ; enddo do J=js-1,je ; do i=is,ie - coef = CS%Len2 * (G%dx_Cv(i,J)*G%IdyCv(i,J)) + coef = CS%Len2 * (US%L_to_m*G%dx_Cv(i,J)*G%IdyCv(i,J)) flux_heat_y(i,J) = coef * (CS%heat_cyc(i,j,m_u2) - CS%heat_cyc(i,j+1,m_u2)) flux_prec_y(i,J) = coef * (CS%precip_cyc(i,j,m_u2) - CS%precip_cyc(i,j+1,m_u2)) enddo ; enddo From 5ed5cdbe2061fd696c6f2d3c00ff911eee4fc79e Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sat, 3 Aug 2019 10:49:19 -0400 Subject: [PATCH 146/297] +Rescaled the units of G%dyT and G%dxT Rescaled G%dyT and G%dxT throughout the MOM6 code to units of [L]. All answers are bitwise identical, but the units of two elements a public type have changed. --- src/core/MOM_barotropic.F90 | 4 +- src/core/MOM_continuity_PPM.F90 | 60 ++++++++--------- src/core/MOM_grid.F90 | 8 +-- src/diagnostics/MOM_diagnostics.F90 | 8 +-- src/framework/MOM_dyn_horgrid.F90 | 8 +-- src/ice_shelf/MOM_ice_shelf_dynamics.F90 | 65 +++++++++---------- src/initialization/MOM_grid_initialize.F90 | 20 +++--- .../MOM_shared_initialization.F90 | 4 +- .../lateral/MOM_hor_visc.F90 | 4 +- .../lateral/MOM_lateral_mixing_coeffs.F90 | 4 +- 10 files changed, 91 insertions(+), 94 deletions(-) diff --git a/src/core/MOM_barotropic.F90 b/src/core/MOM_barotropic.F90 index be2e25c769..515bba15d9 100644 --- a/src/core/MOM_barotropic.F90 +++ b/src/core/MOM_barotropic.F90 @@ -1351,8 +1351,8 @@ 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 = 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) + 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_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))) + & diff --git a/src/core/MOM_continuity_PPM.F90 b/src/core/MOM_continuity_PPM.F90 index f90650adfc..1f0ecdf652 100644 --- a/src/core/MOM_continuity_PPM.F90 +++ b/src/core/MOM_continuity_PPM.F90 @@ -335,9 +335,9 @@ subroutine zonal_mass_flux(u, h_in, uh, dt_in_T, G, GV, US, CS, LB, uhbt, OBC, & I_vrm = 0.0 if (visc_rem_max(I) > 0.0) I_vrm = 1.0 / visc_rem_max(I) if (CS%vol_CFL) then - dx_W = US%m_to_L*ratio_max(US%L_to_m**2*G%areaT(i,j), US%L_to_m*G%dy_Cu(I,j), 1000.0*G%dxT(i,j)) - dx_E = US%m_to_L*ratio_max(US%L_to_m**2*G%areaT(i+1,j), US%L_to_m*G%dy_Cu(I,j), 1000.0*G%dxT(i+1,j)) - else ; dx_W = US%m_to_L*G%dxT(i,j) ; dx_E = US%m_to_L*G%dxT(i+1,j) ; endif + dx_W = ratio_max(G%areaT(i,j), G%dy_Cu(I,j), 1000.0*G%dxT(i,j)) + dx_E = ratio_max(G%areaT(i+1,j), G%dy_Cu(I,j), 1000.0*G%dxT(i+1,j)) + else ; dx_W = G%dxT(i,j) ; dx_E = G%dxT(i+1,j) ; endif du_max_CFL(I) = 2.0* (CFL_dt * dx_W) * I_vrm du_min_CFL(I) = -2.0 * (CFL_dt * dx_E) * I_vrm uh_tot_0(I) = 0.0 ; duhdu_tot_0(I) = 0.0 @@ -350,9 +350,9 @@ subroutine zonal_mass_flux(u, h_in, uh, dt_in_T, G, GV, US, CS, LB, uhbt, OBC, & if (CS%aggress_adjust) then do k=1,nz ; do I=ish-1,ieh if (CS%vol_CFL) then - dx_W = US%m_to_L*ratio_max(US%L_to_m**2*G%areaT(i,j), US%L_to_m*G%dy_Cu(I,j), 1000.0*G%dxT(i,j)) - dx_E = US%m_to_L*ratio_max(US%L_to_m**2*G%areaT(i+1,j), US%L_to_m*G%dy_Cu(I,j), 1000.0*G%dxT(i+1,j)) - else ; dx_W = US%m_to_L*G%dxT(i,j) ; dx_E = US%m_to_L*G%dxT(i+1,j) ; endif + dx_W = ratio_max(G%areaT(i,j), G%dy_Cu(I,j), 1000.0*G%dxT(i,j)) + dx_E = ratio_max(G%areaT(i+1,j), G%dy_Cu(I,j), 1000.0*G%dxT(i+1,j)) + else ; dx_W = G%dxT(i,j) ; dx_E = G%dxT(i+1,j) ; endif du_lim = 0.499*((dx_W*I_dt - u(I,j,k)) + MIN(0.0,u(I-1,j,k))) if (du_max_CFL(I) * visc_rem(I,k) > du_lim) & @@ -365,9 +365,9 @@ subroutine zonal_mass_flux(u, h_in, uh, dt_in_T, G, GV, US, CS, LB, uhbt, OBC, & else do k=1,nz ; do I=ish-1,ieh if (CS%vol_CFL) then - dx_W = US%m_to_L*ratio_max(US%L_to_m**2*G%areaT(i,j), US%L_to_m*G%dy_Cu(I,j), 1000.0*G%dxT(i,j)) - dx_E = US%m_to_L*ratio_max(US%L_to_m**2*G%areaT(i+1,j), US%L_to_m*G%dy_Cu(I,j), 1000.0*G%dxT(i+1,j)) - else ; dx_W = US%m_to_L*G%dxT(i,j) ; dx_E = US%m_to_L*G%dxT(i+1,j) ; endif + dx_W = ratio_max(G%areaT(i,j), G%dy_Cu(I,j), 1000.0*G%dxT(i,j)) + dx_E = ratio_max(G%areaT(i+1,j), G%dy_Cu(I,j), 1000.0*G%dxT(i+1,j)) + else ; dx_W = G%dxT(i,j) ; dx_E = G%dxT(i+1,j) ; endif if (du_max_CFL(I) * visc_rem(I,k) > dx_W*CFL_dt - u(I,j,k)) & du_max_CFL(I) = (dx_W*CFL_dt - u(I,j,k)) / visc_rem(I,k) @@ -379,9 +379,9 @@ subroutine zonal_mass_flux(u, h_in, uh, dt_in_T, G, GV, US, CS, LB, uhbt, OBC, & if (CS%aggress_adjust) then do k=1,nz ; do I=ish-1,ieh if (CS%vol_CFL) then - dx_W = US%m_to_L*ratio_max(US%L_to_m**2*G%areaT(i,j), US%L_to_m*G%dy_Cu(I,j), 1000.0*G%dxT(i,j)) - dx_E = US%m_to_L*ratio_max(US%L_to_m**2*G%areaT(i+1,j), US%L_to_m*G%dy_Cu(I,j), 1000.0*G%dxT(i+1,j)) - else ; dx_W = US%m_to_L*G%dxT(i,j) ; dx_E = US%m_to_L*G%dxT(i+1,j) ; endif + dx_W = ratio_max(G%areaT(i,j), G%dy_Cu(I,j), 1000.0*G%dxT(i,j)) + dx_E = ratio_max(G%areaT(i+1,j), G%dy_Cu(I,j), 1000.0*G%dxT(i+1,j)) + else ; dx_W = G%dxT(i,j) ; dx_E = G%dxT(i+1,j) ; endif du_max_CFL(I) = MIN(du_max_CFL(I), 0.499 * & ((dx_W*I_dt - u(I,j,k)) + MIN(0.0,u(I-1,j,k))) ) @@ -391,9 +391,9 @@ subroutine zonal_mass_flux(u, h_in, uh, dt_in_T, G, GV, US, CS, LB, uhbt, OBC, & else do k=1,nz ; do I=ish-1,ieh if (CS%vol_CFL) then - dx_W = US%m_to_L*ratio_max(US%L_to_m**2*G%areaT(i,j), US%L_to_m*G%dy_Cu(I,j), 1000.0*G%dxT(i,j)) - dx_E = US%m_to_L*ratio_max(US%L_to_m**2*G%areaT(i+1,j), US%L_to_m*G%dy_Cu(I,j), 1000.0*G%dxT(i+1,j)) - else ; dx_W = US%m_to_L*G%dxT(i,j) ; dx_E = US%m_to_L*G%dxT(i+1,j) ; endif + dx_W = ratio_max(G%areaT(i,j), US%L_to_m*G%dy_Cu(I,j), 1000.0*US%L_to_m*G%dxT(i,j)) + dx_E = ratio_max(G%areaT(i+1,j), US%L_to_m*G%dy_Cu(I,j), 1000.0*US%L_to_m*G%dxT(i+1,j)) + else ; dx_W = G%dxT(i,j) ; dx_E = G%dxT(i+1,j) ; endif du_max_CFL(I) = MIN(du_max_CFL(I), dx_W*CFL_dt - u(I,j,k)) du_min_CFL(I) = MAX(du_min_CFL(I), -(dx_E*CFL_dt + u(I,j,k))) @@ -1134,9 +1134,9 @@ subroutine meridional_mass_flux(v, h_in, vh, dt_in_T, G, GV, US, CS, LB, vhbt, O I_vrm = 0.0 if (visc_rem_max(i) > 0.0) I_vrm = 1.0 / visc_rem_max(i) if (CS%vol_CFL) then - dy_S = US%m_to_L*ratio_max(US%L_to_m**2*G%areaT(i,j), US%L_to_m*G%dx_Cv(i,J), 1000.0*G%dyT(i,j)) - dy_N = US%m_to_L*ratio_max(US%L_to_m**2*G%areaT(i,j+1), US%L_to_m*G%dx_Cv(i,J), 1000.0*G%dyT(i,j+1)) - else ; dy_S = US%m_to_L*G%dyT(i,j) ; dy_N = US%m_to_L*G%dyT(i,j+1) ; endif + dy_S = ratio_max(G%areaT(i,j), G%dx_Cv(i,J), 1000.0*G%dyT(i,j)) + dy_N = ratio_max(G%areaT(i,j+1), G%dx_Cv(i,J), 1000.0*G%dyT(i,j+1)) + else ; dy_S = G%dyT(i,j) ; dy_N = G%dyT(i,j+1) ; endif dv_max_CFL(i) = 2.0 * (CFL_dt * dy_S) * I_vrm dv_min_CFL(i) = -2.0 * (CFL_dt * dy_N) * I_vrm vh_tot_0(i) = 0.0 ; dvhdv_tot_0(i) = 0.0 @@ -1150,9 +1150,9 @@ subroutine meridional_mass_flux(v, h_in, vh, dt_in_T, G, GV, US, CS, LB, vhbt, O if (CS%aggress_adjust) then do k=1,nz ; do i=ish,ieh if (CS%vol_CFL) then - dy_S = US%m_to_L*ratio_max(US%L_to_m**2*G%areaT(i,j), US%L_to_m*G%dx_Cv(I,j), 1000.0*G%dyT(i,j)) - dy_N = US%m_to_L*ratio_max(US%L_to_m**2*G%areaT(i,j+1), US%L_to_m*G%dx_Cv(I,j), 1000.0*G%dyT(i,j+1)) - else ; dy_S = US%m_to_L*G%dyT(i,j) ; dy_N = US%m_to_L*G%dyT(i,j+1) ; endif + dy_S = ratio_max(G%areaT(i,j), G%dx_Cv(I,j), 1000.0*G%dyT(i,j)) + dy_N = ratio_max(G%areaT(i,j+1), G%dx_Cv(I,j), 1000.0*G%dyT(i,j+1)) + else ; dy_S = G%dyT(i,j) ; dy_N = G%dyT(i,j+1) ; endif dv_lim = 0.499*((dy_S*I_dt - v(i,J,k)) + MIN(0.0,v(i,J-1,k))) if (dv_max_CFL(i) * visc_rem(i,k) > dv_lim) & dv_max_CFL(i) = dv_lim / visc_rem(i,k) @@ -1164,9 +1164,9 @@ subroutine meridional_mass_flux(v, h_in, vh, dt_in_T, G, GV, US, CS, LB, vhbt, O else do k=1,nz ; do i=ish,ieh if (CS%vol_CFL) then - dy_S = US%m_to_L*ratio_max(US%L_to_m**2*G%areaT(i,j), US%L_to_m*G%dx_Cv(I,j), 1000.0*G%dyT(i,j)) - dy_N = US%m_to_L*ratio_max(US%L_to_m**2*G%areaT(i,j+1), US%L_to_m*G%dx_Cv(I,j), 1000.0*G%dyT(i,j+1)) - else ; dy_S = US%m_to_L*G%dyT(i,j) ; dy_N = US%m_to_L*G%dyT(i,j+1) ; endif + dy_S = ratio_max(G%areaT(i,j), G%dx_Cv(I,j), 1000.0*G%dyT(i,j)) + dy_N = ratio_max(G%areaT(i,j+1), G%dx_Cv(I,j), 1000.0*G%dyT(i,j+1)) + else ; dy_S = G%dyT(i,j) ; dy_N = G%dyT(i,j+1) ; endif if (dv_max_CFL(i) * visc_rem(i,k) > dy_S*CFL_dt - v(i,J,k)) & dv_max_CFL(i) = (dy_S*CFL_dt - v(i,J,k)) / visc_rem(i,k) if (dv_min_CFL(i) * visc_rem(i,k) < -dy_N*CFL_dt - v(i,J,k)) & @@ -1177,9 +1177,9 @@ subroutine meridional_mass_flux(v, h_in, vh, dt_in_T, G, GV, US, CS, LB, vhbt, O if (CS%aggress_adjust) then do k=1,nz ; do i=ish,ieh if (CS%vol_CFL) then - dy_S = US%m_to_L*ratio_max(US%L_to_m**2*G%areaT(i,j), US%L_to_m*G%dx_Cv(I,j), 1000.0*G%dyT(i,j)) - dy_N = US%m_to_L*ratio_max(US%L_to_m**2*G%areaT(i,j+1), US%L_to_m*G%dx_Cv(I,j), 1000.0*G%dyT(i,j+1)) - else ; dy_S = US%m_to_L*G%dyT(i,j) ; dy_N = US%m_to_L*G%dyT(i,j+1) ; endif + dy_S = ratio_max(G%areaT(i,j), G%dx_Cv(I,j), 1000.0*G%dyT(i,j)) + dy_N = ratio_max(G%areaT(i,j+1), G%dx_Cv(I,j), 1000.0*G%dyT(i,j+1)) + else ; dy_S = G%dyT(i,j) ; dy_N = G%dyT(i,j+1) ; endif dv_max_CFL(i) = min(dv_max_CFL(i), 0.499 * & ((dy_S*I_dt - v(i,J,k)) + MIN(0.0,v(i,J-1,k))) ) dv_min_CFL(i) = max(dv_min_CFL(i), 0.499 * & @@ -1188,9 +1188,9 @@ subroutine meridional_mass_flux(v, h_in, vh, dt_in_T, G, GV, US, CS, LB, vhbt, O else do k=1,nz ; do i=ish,ieh if (CS%vol_CFL) then - dy_S = US%m_to_L*ratio_max(US%L_to_m**2*G%areaT(i,j), US%L_to_m*G%dx_Cv(I,j), 1000.0*G%dyT(i,j)) - dy_N = US%m_to_L*ratio_max(US%L_to_m**2*G%areaT(i,j+1), US%L_to_m*G%dx_Cv(I,j), 1000.0*G%dyT(i,j+1)) - else ; dy_S = US%m_to_L*G%dyT(i,j) ; dy_N = US%m_to_L*G%dyT(i,j+1) ; endif + dy_S = ratio_max(G%areaT(i,j), G%dx_Cv(I,j), 1000.0*G%dyT(i,j)) + dy_N = ratio_max(G%areaT(i,j+1), G%dx_Cv(I,j), 1000.0*G%dyT(i,j+1)) + else ; dy_S = G%dyT(i,j) ; dy_N = G%dyT(i,j+1) ; endif dv_max_CFL(i) = min(dv_max_CFL(i), dy_S*CFL_dt - v(i,J,k)) dv_min_CFL(i) = max(dv_min_CFL(i), -(dy_N*CFL_dt + v(i,J,k))) enddo ; enddo diff --git a/src/core/MOM_grid.F90 b/src/core/MOM_grid.F90 index 45353cebce..5f081e14cd 100644 --- a/src/core/MOM_grid.F90 +++ b/src/core/MOM_grid.F90 @@ -77,9 +77,9 @@ module MOM_grid mask2dT, & !< 0 for land points and 1 for ocean points on the h-grid. Nd. geoLatT, & !< The geographic latitude at q points in degrees of latitude or m. geoLonT, & !< The geographic longitude at q points in degrees of longitude or m. - dxT, & !< dxT is delta x at h points [m]. + dxT, & !< dxT is delta x at h points [L ~> m]. IdxT, & !< 1/dxT [m-1]. - dyT, & !< dyT is delta y at h points [m]. + dyT, & !< dyT is delta y at h points [L ~> m]. IdyT, & !< IdyT is 1/dyT [m-1]. areaT, & !< The area of an h-cell [m2]. IareaT, & !< 1/areaT [L-2 ~> m-2]. @@ -423,8 +423,8 @@ subroutine set_derived_metrics(G, US) do j=jsd,jed ; do i=isd,ied if (G%dxT(i,j) < 0.0) G%dxT(i,j) = 0.0 if (G%dyT(i,j) < 0.0) G%dyT(i,j) = 0.0 - G%IdxT(i,j) = Adcroft_reciprocal(G%dxT(i,j)) - G%IdyT(i,j) = Adcroft_reciprocal(G%dyT(i,j)) + G%IdxT(i,j) = Adcroft_reciprocal(US%L_to_m*G%dxT(i,j)) + G%IdyT(i,j) = Adcroft_reciprocal(US%L_to_m*G%dyT(i,j)) G%IareaT(i,j) = Adcroft_reciprocal(G%areaT(i,j)) enddo ; enddo diff --git a/src/diagnostics/MOM_diagnostics.F90 b/src/diagnostics/MOM_diagnostics.F90 index 1089dbb6e9..f20a63bdfb 100644 --- a/src/diagnostics/MOM_diagnostics.F90 +++ b/src/diagnostics/MOM_diagnostics.F90 @@ -1943,12 +1943,12 @@ subroutine write_static_fields(G, GV, US, tv, diag) if (id > 0) call post_data(id, G%CoriolisBu, diag, .true.) id = register_static_field('ocean_model', 'dxt', diag%axesT1, & - 'Delta(x) at thickness/tracer points (meter)', 'm', interp_method='none') - if (id > 0) call post_data(id, G%dxt, diag, .true.) + 'Delta(x) at thickness/tracer points (meter)', 'm', interp_method='none', conversion=US%L_to_m) + if (id > 0) call post_data(id, G%dxT, diag, .true.) id = register_static_field('ocean_model', 'dyt', diag%axesT1, & - 'Delta(y) at thickness/tracer points (meter)', 'm', interp_method='none') - if (id > 0) call post_data(id, G%dyt, diag, .true.) + 'Delta(y) at thickness/tracer points (meter)', 'm', interp_method='none', conversion=US%L_to_m) + if (id > 0) call post_data(id, G%dyT, diag, .true.) id = register_static_field('ocean_model', 'dxCu', diag%axesCu1, & 'Delta(x) at u points (meter)', 'm', interp_method='none') diff --git a/src/framework/MOM_dyn_horgrid.F90 b/src/framework/MOM_dyn_horgrid.F90 index d26e072c40..a1947b71e5 100644 --- a/src/framework/MOM_dyn_horgrid.F90 +++ b/src/framework/MOM_dyn_horgrid.F90 @@ -71,9 +71,9 @@ module MOM_dyn_horgrid mask2dT, & !< 0 for land points and 1 for ocean points on the h-grid [nondim]. geoLatT, & !< The geographic latitude at q points [degrees of latitude] or [m]. geoLonT, & !< The geographic longitude at q points [degrees of longitude] or [m]. - dxT, & !< dxT is delta x at h points [m]. + dxT, & !< dxT is delta x at h points [L ~> m]. IdxT, & !< 1/dxT [m-1]. - dyT, & !< dyT is delta y at h points [m]. + dyT, & !< dyT is delta y at h points [L ~> m]. IdyT, & !< IdyT is 1/dyT [m-1]. areaT, & !< The area of an h-cell [L-2 ~> m-2]. IareaT !< 1/areaT [m-2]. @@ -331,8 +331,8 @@ subroutine set_derived_dyn_horgrid(G, US) do j=jsd,jed ; do i=isd,ied if (G%dxT(i,j) < 0.0) G%dxT(i,j) = 0.0 if (G%dyT(i,j) < 0.0) G%dyT(i,j) = 0.0 - G%IdxT(i,j) = Adcroft_reciprocal(G%dxT(i,j)) - G%IdyT(i,j) = Adcroft_reciprocal(G%dyT(i,j)) + G%IdxT(i,j) = Adcroft_reciprocal(L_to_m*G%dxT(i,j)) + G%IdyT(i,j) = Adcroft_reciprocal(L_to_m*G%dyT(i,j)) G%IareaT(i,j) = Adcroft_reciprocal(G%areaT(i,j)) enddo ; enddo diff --git a/src/ice_shelf/MOM_ice_shelf_dynamics.F90 b/src/ice_shelf/MOM_ice_shelf_dynamics.F90 index 8d7adf9951..5e53c09923 100644 --- a/src/ice_shelf/MOM_ice_shelf_dynamics.F90 +++ b/src/ice_shelf/MOM_ice_shelf_dynamics.F90 @@ -871,9 +871,9 @@ subroutine ice_shelf_solve_outer(CS, ISS, G, US, u, v, iters, time) Y(:,:) = G%geoLatBu(i-1:i,j-1:j)*1000 else X(2,:) = G%geoLonBu(i,j)*1000 - X(1,:) = G%geoLonBu(i,j)*1000-G%dxT(i,j) + X(1,:) = G%geoLonBu(i,j)*1000 - US%L_to_m*G%dxT(i,j) Y(:,2) = G%geoLatBu(i,j)*1000 - Y(:,1) = G%geoLatBu(i,j)*1000-G%dyT(i,j) + Y(:,1) = G%geoLatBu(i,j)*1000 - US%L_to_m*G%dyT(i,j) endif call bilinear_shape_functions(X, Y, Phi_temp, area) @@ -1485,7 +1485,7 @@ subroutine ice_shelf_advect_thickness_x(CS, G, time_step, hmask, h0, h_after_ufl if (hmask(i,j) == 1) then - dxh = G%dxT(i,j) ; dyh = G%dyT(i,j) ; dxdyh = G%US%L_to_m**2*G%areaT(i,j) + dxh = G%US%L_to_m*G%dxT(i,j) ; dyh = G%US%L_to_m*G%dyT(i,j) ; dxdyh = G%US%L_to_m**2*G%areaT(i,j) h_after_uflux(i,j) = h0(i,j) @@ -1605,16 +1605,16 @@ subroutine ice_shelf_advect_thickness_x(CS, G, time_step, hmask, h0, h_after_ufl if (at_west_bdry .AND. (hmask(i-1,j) == 3)) then u_face = 0.5 * (CS%u_shelf(i-1,j-1) + CS%u_shelf(i-1,j)) - flux_enter(i,j,1) = ABS(u_face) * G%dyT(i,j) * time_step * CS%thickness_bdry_val(i-1,j) + flux_enter(i,j,1) = ABS(u_face) * G%US%L_to_m*G%dyT(i,j) * time_step * CS%thickness_bdry_val(i-1,j) elseif (CS%u_face_mask(i-1,j) == 4.) then - flux_enter(i,j,1) = G%dyT(i,j) * time_step * CS%u_flux_bdry_val(i-1,j) + flux_enter(i,j,1) = G%US%L_to_m*G%dyT(i,j) * time_step * CS%u_flux_bdry_val(i-1,j) endif if (at_east_bdry .AND. (hmask(i+1,j) == 3)) then u_face = 0.5 * (CS%u_shelf(i,j-1) + CS%u_shelf(i,j)) - flux_enter(i,j,2) = ABS(u_face) * G%dyT(i,j) * time_step * CS%thickness_bdry_val(i+1,j) + flux_enter(i,j,2) = ABS(u_face) * G%US%L_to_m*G%dyT(i,j) * time_step * CS%thickness_bdry_val(i+1,j) elseif (CS%u_face_mask(i+1,j) == 4.) then - flux_enter(i,j,2) = G%dyT(i,j) * time_step * CS%u_flux_bdry_val(i+1,j) + flux_enter(i,j,2) = G%US%L_to_m*G%dyT(i,j) * time_step * CS%u_flux_bdry_val(i+1,j) endif if ((i == is) .AND. (hmask(i,j) == 0) .AND. (hmask(i-1,j) == 1)) then @@ -1714,7 +1714,7 @@ subroutine ice_shelf_advect_thickness_y(CS, G, time_step, hmask, h_after_uflux, endif if (hmask(i,j) == 1) then - dxh = G%dxT(i,j) ; dyh = G%dyT(i,j) ; dxdyh = G%US%L_to_m**2*G%areaT(i,j) + dxh = G%US%L_to_m*G%dxT(i,j) ; dyh = G%US%L_to_m*G%dyT(i,j) ; dxdyh = G%US%L_to_m**2*G%areaT(i,j) h_after_vflux(i,j) = h_after_uflux(i,j) stencil(:) = h_after_uflux(i,j-2:j+2) ! fine as long has ny_halo >= 2 @@ -1821,16 +1821,16 @@ subroutine ice_shelf_advect_thickness_y(CS, G, time_step, hmask, h_after_uflux, if (at_south_bdry .AND. (hmask(i,j-1) == 3)) then v_face = 0.5 * (CS%u_shelf(i-1,j-1) + CS%u_shelf(i,j-1)) - flux_enter(i,j,3) = ABS(v_face) * G%dxT(i,j) * time_step * CS%thickness_bdry_val(i,j-1) + flux_enter(i,j,3) = ABS(v_face) * G%US%L_to_m*G%dxT(i,j) * time_step * CS%thickness_bdry_val(i,j-1) elseif (CS%v_face_mask(i,j-1) == 4.) then - flux_enter(i,j,3) = G%dxT(i,j) * time_step * CS%v_flux_bdry_val(i,j-1) + flux_enter(i,j,3) = G%US%L_to_m*G%dxT(i,j) * time_step * CS%v_flux_bdry_val(i,j-1) endif if (at_north_bdry .AND. (hmask(i,j+1) == 3)) then v_face = 0.5 * (CS%u_shelf(i-1,j) + CS%u_shelf(i,j)) - flux_enter(i,j,4) = ABS(v_face) * G%dxT(i,j) * time_step * CS%thickness_bdry_val(i,j+1) + flux_enter(i,j,4) = ABS(v_face) * G%US%L_to_m*G%dxT(i,j) * time_step * CS%thickness_bdry_val(i,j+1) elseif (CS%v_face_mask(i,j+1) == 4.) then - flux_enter(i,j,4) = G%dxT(i,j) * time_step * CS%v_flux_bdry_val(i,j+1) + flux_enter(i,j,4) = G%US%L_to_m*G%dxT(i,j) * time_step * CS%v_flux_bdry_val(i,j+1) endif if ((j == js) .AND. (hmask(i,j) == 0) .AND. (hmask(i,j-1) == 1)) then @@ -2142,9 +2142,9 @@ subroutine calc_shelf_driving_stress(CS, ISS, G, US, TAUD_X, TAUD_Y, OD) cnt = 0 sx = 0 sy = 0 - dxh = G%dxT(i,j) - dyh = G%dyT(i,j) - dxdyh = G%US%L_to_m**2*G%areaT(i,j) + dxh = US%L_to_m*G%dxT(i,j) + dyh = US%L_to_m*G%dyT(i,j) + dxdyh = US%L_to_m**2*G%areaT(i,j) if (ISS%hmask(i,j) == 1) then ! we are inside the global computational bdry, at an ice-filled cell @@ -2673,8 +2673,8 @@ subroutine matrix_diagonal(CS, G, float_cond, H_node, nu, beta, hmask, dens_rati do j=jsc-1,jec+1 ; do i=isc-1,iec+1 ; if (hmask(i,j) == 1) then - dxh = G%dxT(i,j) - dyh = G%dyT(i,j) + dxh = G%US%L_to_m*G%dxT(i,j) + dyh = G%US%L_to_m*G%dyT(i,j) dxdyh = G%US%L_to_m**2*G%areaT(i,j) X(1:2) = G%geoLonBu(i-1:i,j-1)*1000 @@ -2865,9 +2865,8 @@ subroutine apply_boundary_values(CS, ISS, G, time, Phisub, H_node, nu, beta, flo if ((CS%umask(i-1,j-1) == 3) .OR. (CS%umask(i,j-1) == 3) .OR. & (CS%umask(i-1,j) == 3) .OR. (CS%umask(i,j) == 3)) then - - dxh = G%dxT(i,j) - dyh = G%dyT(i,j) + dxh = G%US%L_to_m*G%dxT(i,j) + dyh = G%US%L_to_m*G%dyT(i,j) dxdyh = G%US%L_to_m**2*G%areaT(i,j) X(1:2) = G%geoLonBu(i-1:i,j-1)*1000 @@ -2884,8 +2883,6 @@ subroutine apply_boundary_values(CS, ISS, G, time, Phisub, H_node, nu, beta, flo ! Phi (2*i-1,j) gives d(Phi_i)/dx at quadrature point j ! Phi (2*i,j) gives d(Phi_i)/dy at quadrature point j - - do iq=1,2 ; do jq=1,2 uq = CS%u_bdry_val(i-1,j-1) * xquad(3-iq) * xquad(3-jq) + & @@ -3022,8 +3019,8 @@ subroutine calc_shelf_visc(CS, ISS, G, US, u, v) do j=jsd+1,jed-1 do i=isd+1,ied-1 - dxh = G%dxT(i,j) - dyh = G%dyT(i,j) + dxh = US%L_to_m*G%dxT(i,j) + dyh = US%L_to_m*G%dyT(i,j) dxdyh = US%L_to_m**2*G%areaT(i,j) if (ISS%hmask(i,j) == 1) then @@ -3681,7 +3678,7 @@ subroutine ice_shelf_advect_temp_x(CS, G, time_step, hmask, h0, h_after_uflux, f if (hmask(i,j) == 1) then - dxh = G%dxT(i,j) ; dyh = G%dyT(i,j) ; dxdyh = G%US%L_to_m**2*G%areaT(i,j) + dxh = G%US%L_to_m*G%dxT(i,j) ; dyh = G%US%L_to_m*G%dyT(i,j) ; dxdyh = G%US%L_to_m**2*G%areaT(i,j) h_after_uflux(i,j) = h0(i,j) @@ -3801,18 +3798,18 @@ subroutine ice_shelf_advect_temp_x(CS, G, time_step, hmask, h0, h_after_uflux, f if (at_west_bdry .AND. (hmask(i-1,j) == 3)) then u_face = 0.5 * (CS%u_shelf(i-1,j-1) + CS%u_shelf(i-1,j)) - flux_enter(i,j,1) = ABS(u_face) * G%dyT(i,j) * time_step * CS%t_bdry_val(i-1,j)* & + flux_enter(i,j,1) = ABS(u_face) * G%US%L_to_m*G%dyT(i,j) * time_step * CS%t_bdry_val(i-1,j)* & CS%thickness_bdry_val(i+1,j) elseif (CS%u_face_mask(i-1,j) == 4.) then - flux_enter(i,j,1) = G%dyT(i,j) * time_step * CS%u_flux_bdry_val(i-1,j)*CS%t_bdry_val(i-1,j) + flux_enter(i,j,1) = G%US%L_to_m*G%dyT(i,j) * time_step * CS%u_flux_bdry_val(i-1,j)*CS%t_bdry_val(i-1,j) endif if (at_east_bdry .AND. (hmask(i+1,j) == 3)) then u_face = 0.5 * (CS%u_shelf(i,j-1) + CS%u_shelf(i,j)) - flux_enter(i,j,2) = ABS(u_face) * G%dyT(i,j) * time_step * CS%t_bdry_val(i+1,j)* & + flux_enter(i,j,2) = ABS(u_face) * G%US%L_to_m*G%dyT(i,j) * time_step * CS%t_bdry_val(i+1,j)* & CS%thickness_bdry_val(i+1,j) elseif (CS%u_face_mask(i+1,j) == 4.) then - flux_enter(i,j,2) = G%dyT(i,j) * time_step * CS%u_flux_bdry_val(i+1,j) * CS%t_bdry_val(i+1,j) + flux_enter(i,j,2) = G%US%L_to_m*G%dyT(i,j) * time_step * CS%u_flux_bdry_val(i+1,j) * CS%t_bdry_val(i+1,j) endif ! if ((i == is) .AND. (hmask(i,j) == 0) .AND. (hmask(i-1,j) == 1)) then @@ -3909,7 +3906,7 @@ subroutine ice_shelf_advect_temp_y(CS, G, time_step, hmask, h_after_uflux, h_aft endif if (hmask(i,j) == 1) then - dxh = G%dxT(i,j) ; dyh = G%dyT(i,j) ; dxdyh = G%US%L_to_m**2*G%areaT(i,j) + dxh = G%US%L_to_m*G%dxT(i,j) ; dyh = G%US%L_to_m*G%dyT(i,j) ; dxdyh = G%US%L_to_m**2*G%areaT(i,j) h_after_vflux(i,j) = h_after_uflux(i,j) stencil(:) = h_after_uflux(i,j-2:j+2) ! fine as long has ny_halo >= 2 @@ -4016,18 +4013,18 @@ subroutine ice_shelf_advect_temp_y(CS, G, time_step, hmask, h_after_uflux, h_aft if (at_south_bdry .AND. (hmask(i,j-1) == 3)) then v_face = 0.5 * (CS%v_shelf(i-1,j-1) + CS%v_shelf(i,j-1)) - flux_enter(i,j,3) = ABS(v_face) * G%dxT(i,j) * time_step * CS%t_bdry_val(i,j-1)* & + flux_enter(i,j,3) = ABS(v_face) * G%US%L_to_m*G%dxT(i,j) * time_step * CS%t_bdry_val(i,j-1)* & CS%thickness_bdry_val(i,j-1) elseif (CS%v_face_mask(i,j-1) == 4.) then - flux_enter(i,j,3) = G%dxT(i,j) * time_step * CS%v_flux_bdry_val(i,j-1)*CS%t_bdry_val(i,j-1) + flux_enter(i,j,3) = G%US%L_to_m*G%dxT(i,j) * time_step * CS%v_flux_bdry_val(i,j-1)*CS%t_bdry_val(i,j-1) endif if (at_north_bdry .AND. (hmask(i,j+1) == 3)) then v_face = 0.5 * (CS%v_shelf(i-1,j) + CS%v_shelf(i,j)) - flux_enter(i,j,4) = ABS(v_face) * G%dxT(i,j) * time_step * CS%t_bdry_val(i,j+1)* & + flux_enter(i,j,4) = ABS(v_face) * G%US%L_to_m*G%dxT(i,j) * time_step * CS%t_bdry_val(i,j+1)* & CS%thickness_bdry_val(i,j+1) elseif (CS%v_face_mask(i,j+1) == 4.) then - flux_enter(i,j,4) = G%dxT(i,j) * time_step * CS%v_flux_bdry_val(i,j+1)*CS%t_bdry_val(i,j+1) + flux_enter(i,j,4) = G%US%L_to_m*G%dxT(i,j) * time_step * CS%v_flux_bdry_val(i,j+1)*CS%t_bdry_val(i,j+1) endif ! if ((j == js) .AND. (hmask(i,j) == 0) .AND. (hmask(i,j-1) == 1)) then diff --git a/src/initialization/MOM_grid_initialize.F90 b/src/initialization/MOM_grid_initialize.F90 index 132fa9b60a..504f519b09 100644 --- a/src/initialization/MOM_grid_initialize.F90 +++ b/src/initialization/MOM_grid_initialize.F90 @@ -126,7 +126,7 @@ subroutine grid_metrics_chksum(parent, G, US) halo = min(G%ied-G%iec, G%jed-G%jec, 1) call hchksum_pair(trim(parent)//': d[xy]T', & - G%dxT, G%dyT, G%HI, haloshift=halo) + G%dxT, G%dyT, G%HI, haloshift=halo, scale=L_to_m) call uvchksum(trim(parent)//': dxC[uv]', G%dxCu, G%dyCv, G%HI, haloshift=halo) @@ -363,7 +363,7 @@ subroutine set_grid_metrics_from_mosaic(G, param_file, US) call pass_var(areaBu, G%Domain, position=CORNER) do i=G%isd,G%ied ; do j=G%jsd,G%jed - G%dxT(i,j) = dxT(i,j) ; G%dyT(i,j) = dyT(i,j) ; G%areaT(i,j) = m_to_L**2*areaT(i,j) + G%dxT(i,j) = m_to_L*dxT(i,j) ; G%dyT(i,j) = m_to_L*dyT(i,j) ; G%areaT(i,j) = m_to_L**2*areaT(i,j) enddo ; enddo do I=G%IsdB,G%IedB ; do j=G%jsd,G%jed G%dxCu(I,j) = dxCu(I,j) ; G%dyCu(I,j) = dyCu(I,j) @@ -530,8 +530,8 @@ subroutine set_grid_metrics_cartesian(G, param_file, US) do j=jsd,jed ; do i=isd,ied G%geoLonT(i,j) = grid_lonT(i) ; G%geoLatT(i,j) = grid_LatT(j) - G%dxT(i,j) = dx_everywhere ; G%IdxT(i,j) = I_dx - G%dyT(i,j) = dy_everywhere ; G%IdyT(i,j) = I_dy + G%dxT(i,j) = m_to_L*dx_everywhere ; G%IdxT(i,j) = I_dx + G%dyT(i,j) = m_to_L*dy_everywhere ; G%IdyT(i,j) = I_dy G%areaT(i,j) = m_to_L**2*dx_everywhere * dy_everywhere ; G%IareaT(i,j) = L_to_m**2*I_dx * I_dy enddo ; enddo @@ -680,14 +680,14 @@ subroutine set_grid_metrics_spherical(G, param_file, US) ! The following line is needed to reproduce the solution from ! set_grid_metrics_mercator when used to generate a simple spherical grid. - G%dxT(i,j) = G%Rad_Earth * COS( G%geoLatT(i,j)*PI_180 ) * dL_di + G%dxT(i,j) = m_to_L*G%Rad_Earth * COS( G%geoLatT(i,j)*PI_180 ) * dL_di ! G%dxT(i,j) = G%Rad_Earth * dLon*PI_180 * COS( latitude ) - G%dyT(i,j) = G%Rad_Earth * dLat*PI_180 + G%dyT(i,j) = m_to_L*G%Rad_Earth * dLat*PI_180 ! latitude = G%geoLatCv(i,J)*PI_180 ! In radians ! dL_di = G%geoLatCv(i,max(jsd,J-1))*PI_180 ! In radians ! G%areaT(i,j) = m_to_L**2 * Rad_Earth**2*dLon*dLat*ABS(SIN(latitude)-SIN(dL_di)) - G%areaT(i,j) = m_to_L**2 * G%dxT(i,j) * G%dyT(i,j) + G%areaT(i,j) = G%dxT(i,j) * G%dyT(i,j) enddo ; enddo call callTree_leave("set_grid_metrics_spherical()") @@ -882,10 +882,10 @@ subroutine set_grid_metrics_mercator(G, param_file, US) do j=jsd,jed ; do i=isd,ied G%geoLonT(i,j) = xh(i,j)*180.0/PI G%geoLatT(i,j) = yh(i,j)*180.0/PI - G%dxT(i,j) = ds_di(xh(i,j), yh(i,j), GP) - G%dyT(i,j) = ds_dj(xh(i,j), yh(i,j), GP) + G%dxT(i,j) = m_to_L*ds_di(xh(i,j), yh(i,j), GP) + G%dyT(i,j) = m_to_L*ds_dj(xh(i,j), yh(i,j), GP) - G%areaT(i,j) = m_to_L**2*G%dxT(i,j)*G%dyT(i,j) + G%areaT(i,j) = G%dxT(i,j)*G%dyT(i,j) G%IareaT(i,j) = 1.0 / (G%areaT(i,j)) enddo ; enddo diff --git a/src/initialization/MOM_shared_initialization.F90 b/src/initialization/MOM_shared_initialization.F90 index 346e3d32a8..502dd35a1b 100644 --- a/src/initialization/MOM_shared_initialization.F90 +++ b/src/initialization/MOM_shared_initialization.F90 @@ -1289,9 +1289,9 @@ subroutine write_ocean_geometry_file(G, param_file, directory, geom_file, US) do J=Jsq,Jeq ; do i=is,ie ; out_v(i,J) = G%dyCv(i,J) ; enddo ; enddo call write_field(unit, fields(10), G%Domain%mpp_domain, out_v) - do j=js,je ; do i=is,ie ; out_h(i,j) = G%dxT(i,j); enddo ; enddo + do j=js,je ; do i=is,ie ; out_h(i,j) = L_to_m_scale*G%dxT(i,j); enddo ; enddo call write_field(unit, fields(11), G%Domain%mpp_domain, out_h) - do j=js,je ; do i=is,ie ; out_h(i,j) = G%dyT(i,j) ; enddo ; enddo + do j=js,je ; do i=is,ie ; out_h(i,j) = L_to_m_scale*G%dyT(i,j) ; enddo ; enddo call write_field(unit, fields(12), G%Domain%mpp_domain, out_h) do J=Jsq,Jeq ; do I=Isq,Ieq ; out_q(i,J) = G%dxBu(I,J) ; enddo ; enddo diff --git a/src/parameterizations/lateral/MOM_hor_visc.F90 b/src/parameterizations/lateral/MOM_hor_visc.F90 index 4bc095de56..ce60d2ccc2 100644 --- a/src/parameterizations/lateral/MOM_hor_visc.F90 +++ b/src/parameterizations/lateral/MOM_hor_visc.F90 @@ -1869,8 +1869,8 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS, MEKE) CS%DX_dyBu(I,J) = G%dxBu(I,J)*G%IdyBu(I,J) ; CS%DY_dxBu(I,J) = G%dyBu(I,J)*G%IdxBu(I,J) enddo ; enddo do j=Jsq-1,Jeq+2 ; do i=Isq-1,Ieq+2 - CS%DX2h(i,j) = G%dxT(i,j)*G%dxT(i,j) ; CS%DY2h(i,j) = G%dyT(i,j)*G%dyT(i,j) - CS%DX_dyT(i,j) = G%dxT(i,j)*G%IdyT(i,j) ; CS%DY_dxT(i,j) = G%dyT(i,j)*G%IdxT(i,j) + CS%DX2h(i,j) = US%L_to_m**2*G%dxT(i,j)*G%dxT(i,j) ; CS%DY2h(i,j) = US%L_to_m**2*G%dyT(i,j)*G%dyT(i,j) + CS%DX_dyT(i,j) = US%L_to_m*G%dxT(i,j)*G%IdyT(i,j) ; CS%DY_dxT(i,j) = US%L_to_m*G%dyT(i,j)*G%IdxT(i,j) enddo ; enddo do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 diff --git a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 index d4fc2149c8..adf7cd3d6e 100644 --- a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 +++ b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 @@ -1162,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) = ((G%dxT(i,j))**2 + (G%dyT(i,j))**2) * & + CS%f2_dx2_h(i,j) = ((US%L_to_m*G%dxT(i,j))**2 + (US%L_to_m*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) * (sqrt(0.5 * & + CS%beta_dx2_h(i,j) = oneOrTwo * ((US%L_to_m*G%dxT(i,j))**2 + (US%L_to_m*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 + & From 14ce1d4406113726d90c628a347f699e14f8ec25 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sat, 3 Aug 2019 12:37:10 -0400 Subject: [PATCH 147/297] +Rescaled the units of G%dxCu and G%dyCv Rescaled G%dxCu and G%dyCv throughout the MOM6 code to units of [L]. All answers are bitwise identical, but the units of two elements a public type have changed. --- src/core/MOM_CoriolisAdv.F90 | 20 +++++------ src/core/MOM_continuity_PPM.F90 | 4 +-- src/core/MOM_grid.F90 | 8 ++--- src/diagnostics/MOM_diagnostics.F90 | 36 +++++++++---------- src/framework/MOM_dyn_horgrid.F90 | 8 ++--- src/initialization/MOM_grid_initialize.F90 | 24 ++++++------- .../MOM_shared_initialization.F90 | 18 +++++----- .../lateral/MOM_lateral_mixing_coeffs.F90 | 13 +++---- .../lateral/MOM_mixed_layer_restrat.F90 | 8 ++--- 9 files changed, 70 insertions(+), 69 deletions(-) diff --git a/src/core/MOM_CoriolisAdv.F90 b/src/core/MOM_CoriolisAdv.F90 index b144e6f58f..96a28fc6f5 100644 --- a/src/core/MOM_CoriolisAdv.F90 +++ b/src/core/MOM_CoriolisAdv.F90 @@ -262,8 +262,8 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS) ! but only first order accurate at boundaries with no slip b.c.s. ! First calculate the contributions to the circulation around the q-point. do J=Jsq-1,Jeq+1 ; do I=Isq-1,Ieq+1 - dvdx(I,J) = v(i+1,J,k)*G%dyCv(i+1,J) - v(i,J,k)*G%dyCv(i,J) - dudy(I,J) = u(I,j+1,k)*G%dxCu(I,j+1) - u(I,j,k)*G%dxCu(I,j) + dvdx(I,J) = v(i+1,J,k)*US%L_to_m*G%dyCv(i+1,J) - v(i,J,k)*US%L_to_m*G%dyCv(i,J) + dudy(I,J) = u(I,j+1,k)*US%L_to_m*G%dxCu(I,j+1) - u(I,j,k)*US%L_to_m*G%dxCu(I,j) enddo ; enddo do J=Jsq-1,Jeq+1 ; do i=Isq-1,Ieq+2 hArea_v(i,J) = 0.5*(Area_h(i,j) * h(i,j,k) + Area_h(i,j+1) * h(i,j+1,k)) @@ -294,16 +294,16 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS) enddo ; endif if (OBC%computed_vorticity) then ; do I=OBC%segment(n)%HI%IsdB,OBC%segment(n)%HI%IedB if (OBC%segment(n)%direction == OBC_DIRECTION_N) then - dudy(I,J) = 2.0*(OBC%segment(n)%tangential_vel(I,J,k) - u(I,j,k))*G%dxCu(I,j) + dudy(I,J) = 2.0*(OBC%segment(n)%tangential_vel(I,J,k) - u(I,j,k))*US%L_to_m*G%dxCu(I,j) else ! (OBC%segment(n)%direction == OBC_DIRECTION_S) - dudy(I,J) = 2.0*(u(I,j+1,k) - OBC%segment(n)%tangential_vel(I,J,k))*G%dxCu(I,j+1) + dudy(I,J) = 2.0*(u(I,j+1,k) - OBC%segment(n)%tangential_vel(I,J,k))*US%L_to_m*G%dxCu(I,j+1) endif enddo ; endif if (OBC%specified_vorticity) then ; do I=OBC%segment(n)%HI%IsdB,OBC%segment(n)%HI%IedB if (OBC%segment(n)%direction == OBC_DIRECTION_N) then - dudy(I,J) = OBC%segment(n)%tangential_grad(I,J,k)*G%dxCu(I,j)*G%dyBu(I,J) + dudy(I,J) = OBC%segment(n)%tangential_grad(I,J,k)*US%L_to_m*G%dxCu(I,j)*G%dyBu(I,J) else ! (OBC%segment(n)%direction == OBC_DIRECTION_S) - dudy(I,J) = OBC%segment(n)%tangential_grad(I,J,k)*G%dxCu(I,j+1)*G%dyBu(I,J) + dudy(I,J) = OBC%segment(n)%tangential_grad(I,J,k)*US%L_to_m*G%dxCu(I,j+1)*G%dyBu(I,J) endif enddo ; endif @@ -334,16 +334,16 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS) enddo ; endif if (OBC%computed_vorticity) then ; do J=OBC%segment(n)%HI%JsdB,OBC%segment(n)%HI%JedB if (OBC%segment(n)%direction == OBC_DIRECTION_E) then - dvdx(I,J) = 2.0*(OBC%segment(n)%tangential_vel(I,J,k) - v(i,J,k))*G%dyCv(i,J) + dvdx(I,J) = 2.0*(OBC%segment(n)%tangential_vel(I,J,k) - v(i,J,k))*US%L_to_m*G%dyCv(i,J) else ! (OBC%segment(n)%direction == OBC_DIRECTION_W) - dvdx(I,J) = 2.0*(v(i+1,J,k) - OBC%segment(n)%tangential_vel(I,J,k))*G%dyCv(i+1,J) + dvdx(I,J) = 2.0*(v(i+1,J,k) - OBC%segment(n)%tangential_vel(I,J,k))*US%L_to_m*G%dyCv(i+1,J) endif enddo ; endif if (OBC%specified_vorticity) then ; do J=OBC%segment(n)%HI%JsdB,OBC%segment(n)%HI%JedB if (OBC%segment(n)%direction == OBC_DIRECTION_E) then - dvdx(I,J) = OBC%segment(n)%tangential_grad(I,J,k)*G%dyCv(i,J)*G%dxBu(I,J) + dvdx(I,J) = OBC%segment(n)%tangential_grad(I,J,k)*US%L_to_m*G%dyCv(i,J)*G%dxBu(I,J) else ! (OBC%segment(n)%direction == OBC_DIRECTION_W) - dvdx(I,J) = OBC%segment(n)%tangential_grad(I,J,k)*G%dyCv(i+1,J)*G%dxBu(I,J) + dvdx(I,J) = OBC%segment(n)%tangential_grad(I,J,k)*US%L_to_m*G%dyCv(i+1,J)*G%dxBu(I,J) endif enddo ; endif diff --git a/src/core/MOM_continuity_PPM.F90 b/src/core/MOM_continuity_PPM.F90 index 1f0ecdf652..d606bbdb0f 100644 --- a/src/core/MOM_continuity_PPM.F90 +++ b/src/core/MOM_continuity_PPM.F90 @@ -930,7 +930,7 @@ subroutine set_zonal_BT_cont(u, h_in, h_L, h_R, BT_cont, uh_tot_0, duhdu_tot_0, domore = .false. do I=ish-1,ieh if (do_I(I)) domore = .true. - du_CFL(I) = (CFL_min * Idt) * US%m_to_L*G%dxCu(I,j) + du_CFL(I) = (CFL_min * Idt) * G%dxCu(I,j) duR(I) = min(0.0,du0(I) - du_CFL(I)) duL(I) = max(0.0,du0(I) + du_CFL(I)) FAmt_L(I) = 0.0 ; FAmt_R(I) = 0.0 ; FAmt_0(I) = 0.0 @@ -1730,7 +1730,7 @@ subroutine set_merid_BT_cont(v, h_in, h_L, h_R, BT_cont, vh_tot_0, dvhdv_tot_0, domore = .false. do i=ish,ieh ; if (do_I(i)) then domore = .true. - dv_CFL(i) = (CFL_min * Idt) * US%m_to_L*G%dyCv(i,J) + dv_CFL(i) = (CFL_min * Idt) * G%dyCv(i,J) dvR(i) = min(0.0,dv0(i) - dv_CFL(i)) dvL(i) = max(0.0,dv0(i) + dv_CFL(i)) FAmt_L(i) = 0.0 ; FAmt_R(i) = 0.0 ; FAmt_0(i) = 0.0 diff --git a/src/core/MOM_grid.F90 b/src/core/MOM_grid.F90 index 5f081e14cd..dff2bdf3cf 100644 --- a/src/core/MOM_grid.F90 +++ b/src/core/MOM_grid.F90 @@ -92,7 +92,7 @@ module MOM_grid mask2dCu, & !< 0 for boundary points and 1 for ocean points on the u grid. Nondim. geoLatCu, & !< The geographic latitude at u points in degrees of latitude or m. geoLonCu, & !< The geographic longitude at u points in degrees of longitude or m. - dxCu, & !< dxCu is delta x at u points [m]. + dxCu, & !< dxCu is delta x at u points [L ~> m]. IdxCu, & !< 1/dxCu [m-1]. dyCu, & !< dyCu is delta y at u points [m]. IdyCu, & !< 1/dyCu [m-1]. @@ -106,7 +106,7 @@ module MOM_grid geoLonCv, & !< The geographic longitude at v points in degrees of longitude or m. dxCv, & !< dxCv is delta x at v points [m]. IdxCv, & !< 1/dxCv [m-1]. - dyCv, & !< dyCv is delta y at v points [m]. + dyCv, & !< dyCv is delta y at v points [L ~> m]. IdyCv, & !< 1/dyCv [m-1]. dx_Cv, & !< The unblocked lengths of the v-faces of the h-cell [L ~> m]. IareaCv, & !< The masked inverse areas of v-grid cells [L-2 ~> m-2]. @@ -431,7 +431,7 @@ subroutine set_derived_metrics(G, US) do j=jsd,jed ; do I=IsdB,IedB if (G%dxCu(I,j) < 0.0) G%dxCu(I,j) = 0.0 if (G%dyCu(I,j) < 0.0) G%dyCu(I,j) = 0.0 - G%IdxCu(I,j) = Adcroft_reciprocal(G%dxCu(I,j)) + G%IdxCu(I,j) = Adcroft_reciprocal(US%L_to_m*G%dxCu(I,j)) G%IdyCu(I,j) = Adcroft_reciprocal(G%dyCu(I,j)) enddo ; enddo @@ -439,7 +439,7 @@ subroutine set_derived_metrics(G, US) if (G%dxCv(i,J) < 0.0) G%dxCv(i,J) = 0.0 if (G%dyCv(i,J) < 0.0) G%dyCv(i,J) = 0.0 G%IdxCv(i,J) = Adcroft_reciprocal(G%dxCv(i,J)) - G%IdyCv(i,J) = Adcroft_reciprocal(G%dyCv(i,J)) + G%IdyCv(i,J) = Adcroft_reciprocal(US%L_to_m*G%dyCv(i,J)) enddo ; enddo do J=JsdB,JedB ; do I=IsdB,IedB diff --git a/src/diagnostics/MOM_diagnostics.F90 b/src/diagnostics/MOM_diagnostics.F90 index f20a63bdfb..37ad8ac14a 100644 --- a/src/diagnostics/MOM_diagnostics.F90 +++ b/src/diagnostics/MOM_diagnostics.F90 @@ -936,10 +936,10 @@ subroutine calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, GV, US, CS if (associated(CS%dKE_dt)) then do k=1,nz do j=js,je ; do I=Isq,Ieq - KE_u(I,j) = US%s_to_T*uh(I,j,k)*G%dxCu(I,j)*CS%du_dt(I,j,k) + KE_u(I,j) = US%s_to_T*uh(I,j,k)*US%L_to_m*G%dxCu(I,j)*CS%du_dt(I,j,k) enddo ; enddo do J=Jsq,Jeq ; do i=is,ie - KE_v(i,J) = US%s_to_T*vh(i,J,k)*G%dyCv(i,J)*CS%dv_dt(i,J,k) + KE_v(i,J) = US%s_to_T*vh(i,J,k)*US%L_to_m*G%dyCv(i,J)*CS%dv_dt(i,J,k) enddo ; enddo do j=js,je ; do i=is,ie KE_h(i,j) = CS%KE(i,j,k)*CS%dh_dt(i,j,k) @@ -957,10 +957,10 @@ subroutine calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, GV, US, CS if (associated(CS%PE_to_KE)) then do k=1,nz do j=js,je ; do I=Isq,Ieq - KE_u(I,j) = US%L_T_to_m_s**2*US%s_to_T*uh(I,j,k)*US%m_to_L*G%dxCu(I,j)*ADp%PFu(I,j,k) + KE_u(I,j) = US%L_T_to_m_s**2*US%s_to_T*uh(I,j,k)*G%dxCu(I,j)*ADp%PFu(I,j,k) enddo ; enddo do J=Jsq,Jeq ; do i=is,ie - KE_v(i,J) = US%L_T_to_m_s**2*US%s_to_T*vh(i,J,k)*US%m_to_L*G%dyCv(i,J)*ADp%PFv(i,J,k) + KE_v(i,J) = US%L_T_to_m_s**2*US%s_to_T*vh(i,J,k)*G%dyCv(i,J)*ADp%PFv(i,J,k) enddo ; enddo if (.not.G%symmetric) & call do_group_pass(CS%pass_KE_uv, G%domain) @@ -975,10 +975,10 @@ subroutine calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, GV, US, CS if (associated(CS%KE_CorAdv)) then do k=1,nz do j=js,je ; do I=Isq,Ieq - KE_u(I,j) = US%L_T_to_m_s**2*US%s_to_T*uh(I,j,k)*US%m_to_L*G%dxCu(I,j)*ADp%CAu(I,j,k) + KE_u(I,j) = US%L_T_to_m_s**2*US%s_to_T*uh(I,j,k)*G%dxCu(I,j)*ADp%CAu(I,j,k) enddo ; enddo do J=Jsq,Jeq ; do i=is,ie - KE_v(i,J) = US%L_T_to_m_s**2*US%s_to_T*vh(i,J,k)*US%m_to_L*G%dyCv(i,J)*ADp%CAv(i,J,k) + KE_v(i,J) = US%L_T_to_m_s**2*US%s_to_T*vh(i,J,k)*G%dyCv(i,J)*ADp%CAv(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) * & @@ -1002,11 +1002,11 @@ subroutine calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, GV, US, CS do k=1,nz do j=js,je ; do I=Isq,Ieq if (G%mask2dCu(i,j) /= 0.) & - KE_u(I,j) = US%L_T_to_m_s**2*US%s_to_T*uh(I,j,k)*US%m_to_L*G%dxCu(I,j)*ADp%gradKEu(I,j,k) + KE_u(I,j) = US%L_T_to_m_s**2*US%s_to_T*uh(I,j,k)*G%dxCu(I,j)*ADp%gradKEu(I,j,k) enddo ; enddo do J=Jsq,Jeq ; do i=is,ie if (G%mask2dCv(i,j) /= 0.) & - KE_v(i,J) = US%L_T_to_m_s**2*US%s_to_T*vh(i,J,k)*US%m_to_L*G%dyCv(i,J)*ADp%gradKEv(i,J,k) + KE_v(i,J) = US%L_T_to_m_s**2*US%s_to_T*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) * & @@ -1025,10 +1025,10 @@ subroutine calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, GV, US, CS if (associated(CS%KE_visc)) then do k=1,nz do j=js,je ; do I=Isq,Ieq - KE_u(I,j) = US%s_to_T*uh(I,j,k)*G%dxCu(I,j)*ADp%du_dt_visc(I,j,k) + KE_u(I,j) = US%s_to_T*uh(I,j,k)*US%L_to_m*G%dxCu(I,j)*ADp%du_dt_visc(I,j,k) enddo ; enddo do J=Jsq,Jeq ; do i=is,ie - KE_v(i,J) = US%s_to_T*vh(i,J,k)*G%dyCv(i,J)*ADp%dv_dt_visc(i,J,k) + KE_v(i,J) = US%s_to_T*vh(i,J,k)*US%L_to_m*G%dyCv(i,J)*ADp%dv_dt_visc(i,J,k) enddo ; enddo if (.not.G%symmetric) & call do_group_pass(CS%pass_KE_uv, G%domain) @@ -1043,10 +1043,10 @@ subroutine calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, GV, US, CS if (associated(CS%KE_horvisc)) then do k=1,nz do j=js,je ; do I=Isq,Ieq - KE_u(I,j) = US%s_to_T*uh(I,j,k)*G%dxCu(I,j)*US%s_to_T*ADp%diffu(I,j,k) + KE_u(I,j) = US%s_to_T*uh(I,j,k)*US%L_to_m*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) = US%s_to_T*vh(i,J,k)*G%dyCv(i,J)*US%s_to_T*ADp%diffv(i,J,k) + KE_v(i,J) = US%s_to_T*vh(i,J,k)*US%L_to_m*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) @@ -1061,10 +1061,10 @@ subroutine calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, GV, US, CS if (associated(CS%KE_dia)) then do k=1,nz do j=js,je ; do I=Isq,Ieq - KE_u(I,j) = US%s_to_T*uh(I,j,k)*G%dxCu(I,j)*ADp%du_dt_dia(I,j,k) + KE_u(I,j) = US%s_to_T*uh(I,j,k)*US%L_to_m*G%dxCu(I,j)*ADp%du_dt_dia(I,j,k) enddo ; enddo do J=Jsq,Jeq ; do i=is,ie - KE_v(i,J) = US%s_to_T*vh(i,J,k)*G%dyCv(i,J)*ADp%dv_dt_dia(i,J,k) + KE_v(i,J) = US%s_to_T*vh(i,J,k)*US%L_to_m*G%dyCv(i,J)*ADp%dv_dt_dia(i,J,k) enddo ; enddo do j=js,je ; do i=is,ie KE_h(i,j) = CS%KE(i,j,k) * & @@ -1951,19 +1951,19 @@ subroutine write_static_fields(G, GV, US, tv, diag) if (id > 0) call post_data(id, G%dyT, diag, .true.) id = register_static_field('ocean_model', 'dxCu', diag%axesCu1, & - 'Delta(x) at u points (meter)', 'm', interp_method='none') + 'Delta(x) at u points (meter)', 'm', interp_method='none', conversion=US%L_to_m) if (id > 0) call post_data(id, G%dxCu, diag, .true.) id = register_static_field('ocean_model', 'dyCu', diag%axesCu1, & - 'Delta(y) at u points (meter)', 'm', interp_method='none') + 'Delta(y) at u points (meter)', 'm', interp_method='none') !(, conversion=US%L_to_m) if (id > 0) call post_data(id, G%dyCu, diag, .true.) id = register_static_field('ocean_model', 'dxCv', diag%axesCv1, & - 'Delta(x) at v points (meter)', 'm', interp_method='none') + 'Delta(x) at v points (meter)', 'm', interp_method='none') !(, conversion=US%L_to_m) if (id > 0) call post_data(id, G%dxCv, diag, .true.) id = register_static_field('ocean_model', 'dyCv', diag%axesCv1, & - 'Delta(y) at v points (meter)', 'm', interp_method='none') + 'Delta(y) at v points (meter)', 'm', interp_method='none', conversion=US%L_to_m) if (id > 0) call post_data(id, G%dyCv, diag, .true.) id = register_static_field('ocean_model', 'dyCuo', diag%axesCu1, & diff --git a/src/framework/MOM_dyn_horgrid.F90 b/src/framework/MOM_dyn_horgrid.F90 index a1947b71e5..2fac514036 100644 --- a/src/framework/MOM_dyn_horgrid.F90 +++ b/src/framework/MOM_dyn_horgrid.F90 @@ -88,7 +88,7 @@ module MOM_dyn_horgrid mask2dCu, & !< 0 for boundary points and 1 for ocean points on the u grid [nondim]. geoLatCu, & !< The geographic latitude at u points [degrees of latitude] or [m]. geoLonCu, & !< The geographic longitude at u points [degrees of longitude] or [m]. - dxCu, & !< dxCu is delta x at u points [m]. + dxCu, & !< dxCu is delta x at u points [L ~> m]. IdxCu, & !< 1/dxCu [m-1]. dyCu, & !< dyCu is delta y at u points [m]. IdyCu, & !< 1/dyCu [m-1]. @@ -102,7 +102,7 @@ module MOM_dyn_horgrid geoLonCv, & !< The geographic longitude at v points [degrees of longitude] or [m]. dxCv, & !< dxCv is delta x at v points [m]. IdxCv, & !< 1/dxCv [m-1]. - dyCv, & !< dyCv is delta y at v points [m]. + dyCv, & !< dyCv is delta y at v points [L ~> m]. IdyCv, & !< 1/dyCv [m-1]. dx_Cv, & !< The unblocked lengths of the v-faces of the h-cell [L ~> m]. IareaCv, & !< The masked inverse areas of v-grid cells [L-2 ~> m-2]. @@ -339,7 +339,7 @@ subroutine set_derived_dyn_horgrid(G, US) do j=jsd,jed ; do I=IsdB,IedB if (G%dxCu(I,j) < 0.0) G%dxCu(I,j) = 0.0 if (G%dyCu(I,j) < 0.0) G%dyCu(I,j) = 0.0 - G%IdxCu(I,j) = Adcroft_reciprocal(G%dxCu(I,j)) + G%IdxCu(I,j) = Adcroft_reciprocal(L_to_m*G%dxCu(I,j)) G%IdyCu(I,j) = Adcroft_reciprocal(G%dyCu(I,j)) enddo ; enddo @@ -347,7 +347,7 @@ subroutine set_derived_dyn_horgrid(G, US) if (G%dxCv(i,J) < 0.0) G%dxCv(i,J) = 0.0 if (G%dyCv(i,J) < 0.0) G%dyCv(i,J) = 0.0 G%IdxCv(i,J) = Adcroft_reciprocal(G%dxCv(i,J)) - G%IdyCv(i,J) = Adcroft_reciprocal(G%dyCv(i,J)) + G%IdyCv(i,J) = Adcroft_reciprocal(L_to_m*G%dyCv(i,J)) enddo ; enddo do J=JsdB,JedB ; do I=IsdB,IedB diff --git a/src/initialization/MOM_grid_initialize.F90 b/src/initialization/MOM_grid_initialize.F90 index 504f519b09..9213615333 100644 --- a/src/initialization/MOM_grid_initialize.F90 +++ b/src/initialization/MOM_grid_initialize.F90 @@ -128,7 +128,7 @@ subroutine grid_metrics_chksum(parent, G, US) call hchksum_pair(trim(parent)//': d[xy]T', & G%dxT, G%dyT, G%HI, haloshift=halo, scale=L_to_m) - call uvchksum(trim(parent)//': dxC[uv]', G%dxCu, G%dyCv, G%HI, haloshift=halo) + call uvchksum(trim(parent)//': dxC[uv]', G%dxCu, G%dyCv, G%HI, haloshift=halo, scale=L_to_m) call uvchksum(trim(parent)//': dxC[uv]', & G%dyCu, G%dxCv, G%HI, haloshift=halo) @@ -366,10 +366,10 @@ subroutine set_grid_metrics_from_mosaic(G, param_file, US) G%dxT(i,j) = m_to_L*dxT(i,j) ; G%dyT(i,j) = m_to_L*dyT(i,j) ; G%areaT(i,j) = m_to_L**2*areaT(i,j) enddo ; enddo do I=G%IsdB,G%IedB ; do j=G%jsd,G%jed - G%dxCu(I,j) = dxCu(I,j) ; G%dyCu(I,j) = dyCu(I,j) + G%dxCu(I,j) = m_to_L*dxCu(I,j) ; G%dyCu(I,j) = dyCu(I,j) enddo ; enddo do i=G%isd,G%ied ; do J=G%JsdB,G%JedB - G%dxCv(i,J) = dxCv(i,J) ; G%dyCv(i,J) = dyCv(i,J) + G%dxCv(i,J) = dxCv(i,J) ; G%dyCv(i,J) = m_to_L*dyCv(i,J) enddo ; enddo do I=G%IsdB,G%IedB ; do J=G%JsdB,G%JedB G%dxBu(I,J) = dxBu(I,J) ; G%dyBu(I,J) = dyBu(I,J) ; G%areaBu(I,J) = m_to_L**2*areaBu(I,J) @@ -538,7 +538,7 @@ subroutine set_grid_metrics_cartesian(G, param_file, US) do j=jsd,jed ; do I=IsdB,IedB G%geoLonCu(I,j) = grid_lonB(I) ; G%geoLatCu(I,j) = grid_LatT(j) - G%dxCu(I,j) = dx_everywhere ; G%IdxCu(I,j) = I_dx + G%dxCu(I,j) = m_to_L*dx_everywhere ; G%IdxCu(I,j) = I_dx G%dyCu(I,j) = dy_everywhere ; G%IdyCu(I,j) = I_dy enddo ; enddo @@ -546,7 +546,7 @@ subroutine set_grid_metrics_cartesian(G, param_file, US) G%geoLonCv(i,J) = grid_lonT(i) ; G%geoLatCv(i,J) = grid_latB(J) G%dxCv(i,J) = dx_everywhere ; G%IdxCv(i,J) = I_dx - G%dyCv(i,J) = dy_everywhere ; G%IdyCv(i,J) = I_dy + G%dyCv(i,J) = m_to_L*dy_everywhere ; G%IdyCv(i,J) = I_dy enddo ; enddo call callTree_leave("set_grid_metrics_cartesian()") @@ -660,7 +660,7 @@ subroutine set_grid_metrics_spherical(G, param_file, US) ! set_grid_metrics_mercator when used to generate a simple spherical grid. G%dxCv(i,J) = G%Rad_Earth * COS( G%geoLatCv(i,J)*PI_180 ) * dL_di ! G%dxCv(i,J) = G%Rad_Earth * (dLon*PI_180) * COS( G%geoLatCv(i,J)*PI_180 ) - G%dyCv(i,J) = G%Rad_Earth * dLat*PI_180 + G%dyCv(i,J) = m_to_L*G%Rad_Earth * dLat*PI_180 enddo ; enddo do j=jsd,jed ; do I=IsdB,IedB @@ -669,8 +669,8 @@ subroutine set_grid_metrics_spherical(G, param_file, US) ! The following line is needed to reproduce the solution from ! set_grid_metrics_mercator when used to generate a simple spherical grid. - G%dxCu(I,j) = G%Rad_Earth * COS( G%geoLatCu(I,j)*PI_180 ) * dL_di -! G%dxCu(I,j) = G%Rad_Earth * dLon*PI_180 * COS( latitude ) + G%dxCu(I,j) = m_to_L*G%Rad_Earth * COS( G%geoLatCu(I,j)*PI_180 ) * dL_di +! G%dxCu(I,j) = m_to_L*G%Rad_Earth * dLon*PI_180 * COS( latitude ) G%dyCu(I,j) = G%Rad_Earth * dLat*PI_180 enddo ; enddo @@ -892,7 +892,7 @@ subroutine set_grid_metrics_mercator(G, param_file, US) do j=jsd,jed ; do I=IsdB,IedB G%geoLonCu(I,j) = xu(I,j)*180.0/PI G%geoLatCu(I,j) = yu(I,j)*180.0/PI - G%dxCu(I,j) = ds_di(xu(I,j), yu(I,j), GP) + G%dxCu(I,j) = m_to_L*ds_di(xu(I,j), yu(I,j), GP) G%dyCu(I,j) = ds_dj(xu(I,j), yu(I,j), GP) enddo ; enddo @@ -900,7 +900,7 @@ subroutine set_grid_metrics_mercator(G, param_file, US) G%geoLonCv(i,J) = xv(i,J)*180.0/PI G%geoLatCv(i,J) = yv(i,J)*180.0/PI G%dxCv(i,J) = ds_di(xv(i,J), yv(i,J), GP) - G%dyCv(i,J) = ds_dj(xv(i,J), yv(i,J), GP) + G%dyCv(i,J) = m_to_L*ds_dj(xv(i,J), yv(i,J), GP) enddo ; enddo if (.not.simple_area) then @@ -1312,13 +1312,13 @@ subroutine initialize_masks(G, PF, US) do j=G%jsd,G%jed ; do I=G%IsdB,G%IedB G%dy_Cu(I,j) = G%mask2dCu(I,j) * m_to_L*G%dyCu(I,j) - G%areaCu(I,j) = m_to_L*G%dxCu(I,j) * G%dy_Cu(I,j) + G%areaCu(I,j) = G%dxCu(I,j) * G%dy_Cu(I,j) G%IareaCu(I,j) = G%mask2dCu(I,j) * Adcroft_reciprocal(G%areaCu(I,j)) enddo ; enddo do J=G%JsdB,G%JedB ; do i=G%isd,G%ied G%dx_Cv(i,J) = G%mask2dCv(i,J) * m_to_L*G%dxCv(i,J) - G%areaCv(i,J) = m_to_L*G%dyCv(i,J) * G%dx_Cv(i,J) + G%areaCv(i,J) = G%dyCv(i,J) * G%dx_Cv(i,J) G%IareaCv(i,J) = G%mask2dCv(i,J) * Adcroft_reciprocal(G%areaCv(i,J)) enddo ; enddo diff --git a/src/initialization/MOM_shared_initialization.F90 b/src/initialization/MOM_shared_initialization.F90 index 502dd35a1b..35c42f0775 100644 --- a/src/initialization/MOM_shared_initialization.F90 +++ b/src/initialization/MOM_shared_initialization.F90 @@ -669,7 +669,7 @@ subroutine reset_face_lengths_named(G, param_file, name, US) enddo ; enddo do J=JsdB,JedB ; do i=isd,ied ! Change any v-face lengths within this loop. - dy_2 = dx_2 * G%dyCv(i,J)*G%IdxCv(i,J) * cos(pi_180 * G%geoLatCv(i,J)) + dy_2 = dx_2 * L_to_m*G%dyCv(i,J)*G%IdxCv(i,J) * cos(pi_180 * G%geoLatCv(i,J)) if ((abs(G%geoLatCv(i,J)-41.0) < dy_2) .and. (abs(G%geoLonCv(i,J)-28.5) < dx_2)) & G%dx_Cv(i,J) = G%mask2dCv(i,J)*2500.0*m_to_L ! Bosporus - should be 1000.0 m wide. @@ -717,7 +717,7 @@ subroutine reset_face_lengths_named(G, param_file, name, US) G%geoLonCu(I,j), G%geoLatCu(I,j) call MOM_error(FATAL,"reset_face_lengths_named "//mesg) endif - G%areaCu(I,j) = m_to_L*G%dxCu(I,j) * G%dy_Cu(I,j) + G%areaCu(I,j) = G%dxCu(I,j) * G%dy_Cu(I,j) G%IareaCu(I,j) = 0.0 if (G%areaCu(I,j) > 0.0) G%IareaCu(I,j) = G%mask2dCu(I,j) / (G%areaCu(I,j)) enddo ; enddo @@ -731,7 +731,7 @@ subroutine reset_face_lengths_named(G, param_file, name, US) call MOM_error(FATAL,"reset_face_lengths_named "//mesg) endif - G%areaCv(i,J) = m_to_L*G%dyCv(i,J) * G%dx_Cv(i,J) + G%areaCv(i,J) = G%dyCv(i,J) * G%dx_Cv(i,J) G%IareaCv(i,J) = 0.0 if (G%areaCv(i,J) > 0.0) G%IareaCv(i,J) = G%mask2dCv(i,J) / (G%areaCv(i,J)) enddo ; enddo @@ -786,7 +786,7 @@ subroutine reset_face_lengths_file(G, param_file, US) G%geoLonCu(I,j), G%geoLatCu(I,j) call MOM_error(FATAL,"reset_face_lengths_file "//mesg) endif - G%areaCu(I,j) = m_to_L*G%dxCu(I,j) * G%dy_Cu(I,j) + G%areaCu(I,j) = G%dxCu(I,j) * G%dy_Cu(I,j) G%IareaCu(I,j) = 0.0 if (G%areaCu(I,j) > 0.0) G%IareaCu(I,j) = G%mask2dCu(I,j) / (G%areaCu(I,j)) enddo ; enddo @@ -800,7 +800,7 @@ subroutine reset_face_lengths_file(G, param_file, US) call MOM_error(FATAL,"reset_face_lengths_file "//mesg) endif - G%areaCv(i,J) = m_to_L*G%dyCv(i,J) * G%dx_Cv(i,J) + G%areaCv(i,J) = G%dyCv(i,J) * G%dx_Cv(i,J) G%IareaCv(i,J) = 0.0 if (G%areaCv(i,J) > 0.0) G%IareaCv(i,J) = G%mask2dCv(i,J) / (G%areaCv(i,J)) enddo ; enddo @@ -1002,7 +1002,7 @@ subroutine reset_face_lengths_list(G, param_file, US) endif enddo - G%areaCu(I,j) = m_to_L*G%dxCu(I,j) * G%dy_Cu(I,j) + G%areaCu(I,j) = G%dxCu(I,j) * G%dy_Cu(I,j) G%IareaCu(I,j) = 0.0 if (G%areaCu(I,j) > 0.0) G%IareaCu(I,j) = G%mask2dCu(I,j) / (G%areaCu(I,j)) enddo ; enddo @@ -1031,7 +1031,7 @@ subroutine reset_face_lengths_list(G, param_file, US) endif enddo - G%areaCv(i,J) = m_to_L*G%dyCv(i,J) * G%dx_Cv(i,J) + G%areaCv(i,J) = G%dyCv(i,J) * G%dx_Cv(i,J) G%IareaCv(i,J) = 0.0 if (G%areaCv(i,J) > 0.0) G%IareaCv(i,J) = G%mask2dCv(i,J) / (G%areaCv(i,J)) enddo ; enddo @@ -1284,9 +1284,9 @@ subroutine write_ocean_geometry_file(G, param_file, directory, geom_file, US) do j=js,je ; do I=Isq,Ieq ; out_u(I,j) = G%dyCu(I,j) ; enddo ; enddo call write_field(unit, fields(8), G%Domain%mpp_domain, out_u) - do j=js,je ; do I=Isq,Ieq ; out_u(I,j) = G%dxCu(I,j) ; enddo ; enddo + do j=js,je ; do I=Isq,Ieq ; out_u(I,j) = L_to_m_scale*G%dxCu(I,j) ; enddo ; enddo call write_field(unit, fields(9), G%Domain%mpp_domain, out_u) - do J=Jsq,Jeq ; do i=is,ie ; out_v(i,J) = G%dyCv(i,J) ; enddo ; enddo + do J=Jsq,Jeq ; do i=is,ie ; out_v(i,J) = L_to_m_scale*G%dyCv(i,J) ; enddo ; enddo call write_field(unit, fields(10), G%Domain%mpp_domain, out_v) do j=js,je ; do i=is,ie ; out_h(i,j) = L_to_m_scale*G%dxT(i,j); enddo ; enddo diff --git a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 index adf7cd3d6e..a6926474d0 100644 --- a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 +++ b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 @@ -1128,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) = ((G%dxCu(I,j))**2 + (G%dyCu(I,j))**2) * & + CS%f2_dx2_u(I,j) = ((US%L_to_m*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) * (sqrt( & + CS%beta_dx2_u(I,j) = oneOrTwo * ((US%L_to_m*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 + & @@ -1139,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) = ((G%dxCv(i,J))**2 + (G%dyCv(i,J))**2) * & + CS%f2_dx2_v(i,J) = ((G%dxCv(i,J))**2 + (US%L_to_m*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) * (sqrt( & + CS%beta_dx2_v(i,J) = oneOrTwo * ((G%dxCv(i,J))**2 + (US%L_to_m*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) + & @@ -1207,13 +1207,14 @@ subroutine VarMix_init(Time, G, GV, US, param_file, diag, CS) do j=Jsq,Jeq+1 ; do I=is-1,Ieq ! Static factors in the Leith schemes - grid_sp_u2 = G%dyCu(I,j)*G%dxCu(I,j) + grid_sp_u2 = G%dyCu(I,j)*US%L_to_m*G%dxCu(I,j) grid_sp_u3 = grid_sp_u2*sqrt(grid_sp_u2) CS%Laplac3_const_u(I,j) = Leith_Lap_const * grid_sp_u3 enddo ; enddo do j=js-1,Jeq ; do I=Isq,Ieq+1 ! Static factors in the Leith schemes - grid_sp_v2 = G%dyCv(i,J)*G%dxCu(i,J) + !### The second factor here is wrong. + grid_sp_v2 = US%L_to_m*G%dyCv(i,J)*US%L_to_m*G%dxCu(i,J) grid_sp_v3 = grid_sp_v2*sqrt(grid_sp_v2) CS%Laplac3_const_v(i,J) = Leith_Lap_const * grid_sp_v3 enddo ; enddo diff --git a/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 b/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 index 7e4d64229d..6115e2a8fe 100644 --- a/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 +++ b/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 @@ -360,7 +360,7 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var 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 = & - ( sqrt( 0.5 * ( (G%dxCu(I,j))**2 + (G%dyCu(I,j))**2 ) ) * I_l_f ) & + ( sqrt( 0.5 * ( (US%L_to_m*G%dxCu(I,j))**2 + (G%dyCu(I,j))**2 ) ) * I_l_f ) & * min( 1., 0.5*( VarMix%Rd_dx_h(i,j) + VarMix%Rd_dx_h(i+1,j) ) ) ! peak ML visc: u_star * 0.41 * (h_ml*u_star)/(absf*h_ml + 4.0*u_star) @@ -436,7 +436,7 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var 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 = & - ( sqrt( 0.5 * ( (G%dxCv(i,J))**2 + (G%dyCv(i,J))**2 ) ) * I_l_f ) & + ( sqrt( 0.5 * ( (G%dxCv(i,J))**2 + (US%L_to_m*G%dyCv(i,J))**2 ) ) * I_l_f ) & * min( 1., 0.5*( VarMix%Rd_dx_h(i,j) + VarMix%Rd_dx_h(i,j+1) ) ) ! peak ML visc: u_star * 0.41 * (h_ml*u_star)/(absf*h_ml + 4.0*u_star) @@ -663,7 +663,7 @@ subroutine mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, dt, G, GV, US, CS) timescale = 0.0625 * (absf + 2.0*mom_mixrate) / (absf**2 + mom_mixrate**2) timescale = timescale * CS%ml_restrat_coef -! timescale = timescale*(2?)*(L_def/L_MLI)*min(EKE/MKE,1.0 + (G%dyCv(i,j))**2/L_def**2)) +! timescale = timescale*(2?)*(L_def/L_MLI)*min(EKE/MKE,1.0 + (US%L_to_m*G%dyCv(i,j))**2/L_def**2)) uDml(I) = timescale * G%mask2dCu(I,j)*G%dyCu(I,j)* & G%IdxCu(I,j)*(Rml_av(i+1,j)-Rml_av(i,j)) * (h_vel**2 * GV%Z_to_H) @@ -710,7 +710,7 @@ subroutine mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, dt, G, GV, US, CS) timescale = 0.0625 * (absf + 2.0*mom_mixrate) / (absf**2 + mom_mixrate**2) timescale = timescale * CS%ml_restrat_coef -! timescale = timescale*(2?)*(L_def/L_MLI)*min(EKE/MKE,1.0 + (G%dyCv(i,j))**2/L_def**2)) +! timescale = timescale*(2?)*(L_def/L_MLI)*min(EKE/MKE,1.0 + (US%L_to_m*G%dyCv(i,j))**2/L_def**2)) vDml(i) = timescale * G%mask2dCv(i,J)*G%dxCv(i,J)* & G%IdyCv(i,J)*(Rml_av(i,j+1)-Rml_av(i,j)) * (h_vel**2 * GV%Z_to_H) From 9f3e8df44fecf26faedd614ba256f5dbedafba2e Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sat, 3 Aug 2019 14:32:21 -0400 Subject: [PATCH 148/297] +Rescaled the units of G%dyCu and G%dxCv Rescaled G%dyCu and G%dxCv throughout the MOM6 code to units of [L]. All answers are bitwise identical, but the units of two elements a public type have changed. --- src/core/MOM_grid.F90 | 8 +-- src/core/MOM_open_boundary.F90 | 8 +-- src/diagnostics/MOM_diagnostics.F90 | 4 +- src/framework/MOM_diag_mediator.F90 | 8 +-- src/framework/MOM_dyn_horgrid.F90 | 8 +-- src/initialization/MOM_grid_initialize.F90 | 25 ++++----- .../MOM_shared_initialization.F90 | 26 ++++----- .../lateral/MOM_hor_visc.F90 | 56 +++++++++---------- .../lateral/MOM_lateral_mixing_coeffs.F90 | 12 ++-- .../lateral/MOM_mixed_layer_restrat.F90 | 16 +++--- src/user/Kelvin_initialization.F90 | 4 +- src/user/dyed_channel_initialization.F90 | 2 +- src/user/supercritical_initialization.F90 | 2 +- src/user/tidal_bay_initialization.F90 | 2 +- 14 files changed, 90 insertions(+), 91 deletions(-) diff --git a/src/core/MOM_grid.F90 b/src/core/MOM_grid.F90 index dff2bdf3cf..b65e5200f8 100644 --- a/src/core/MOM_grid.F90 +++ b/src/core/MOM_grid.F90 @@ -94,7 +94,7 @@ module MOM_grid geoLonCu, & !< The geographic longitude at u points in degrees of longitude or m. dxCu, & !< dxCu is delta x at u points [L ~> m]. IdxCu, & !< 1/dxCu [m-1]. - dyCu, & !< dyCu is delta y at u points [m]. + dyCu, & !< dyCu is delta y at u points [L ~> m]. IdyCu, & !< 1/dyCu [m-1]. dy_Cu, & !< The unblocked lengths of the u-faces of the h-cell [L ~> m]. IareaCu, & !< The masked inverse areas of u-grid cells [L-2 ~> m-2]. @@ -104,7 +104,7 @@ module MOM_grid mask2dCv, & !< 0 for boundary points and 1 for ocean points on the v grid. Nondim. geoLatCv, & !< The geographic latitude at v points in degrees of latitude or m. geoLonCv, & !< The geographic longitude at v points in degrees of longitude or m. - dxCv, & !< dxCv is delta x at v points [m]. + dxCv, & !< dxCv is delta x at v points [L ~> m]. IdxCv, & !< 1/dxCv [m-1]. dyCv, & !< dyCv is delta y at v points [L ~> m]. IdyCv, & !< 1/dyCv [m-1]. @@ -432,13 +432,13 @@ subroutine set_derived_metrics(G, US) if (G%dxCu(I,j) < 0.0) G%dxCu(I,j) = 0.0 if (G%dyCu(I,j) < 0.0) G%dyCu(I,j) = 0.0 G%IdxCu(I,j) = Adcroft_reciprocal(US%L_to_m*G%dxCu(I,j)) - G%IdyCu(I,j) = Adcroft_reciprocal(G%dyCu(I,j)) + G%IdyCu(I,j) = Adcroft_reciprocal(US%L_to_m*G%dyCu(I,j)) enddo ; enddo do J=JsdB,JedB ; do i=isd,ied if (G%dxCv(i,J) < 0.0) G%dxCv(i,J) = 0.0 if (G%dyCv(i,J) < 0.0) G%dyCv(i,J) = 0.0 - G%IdxCv(i,J) = Adcroft_reciprocal(G%dxCv(i,J)) + G%IdxCv(i,J) = Adcroft_reciprocal(US%L_to_m*G%dxCv(i,J)) G%IdyCv(i,J) = Adcroft_reciprocal(US%L_to_m*G%dyCv(i,J)) enddo ; enddo diff --git a/src/core/MOM_open_boundary.F90 b/src/core/MOM_open_boundary.F90 index 3f0fb42cfc..078a915871 100644 --- a/src/core/MOM_open_boundary.F90 +++ b/src/core/MOM_open_boundary.F90 @@ -3285,11 +3285,11 @@ subroutine update_OBC_segment_data(G, GV, US, OBC, tv, h, Time) do k=1,G%ke segment%normal_vel(I,j,k) = segment%field(m)%buffer_dst(I,j,k) segment%normal_trans(I,j,k) = segment%field(m)%buffer_dst(I,j,k)*segment%h(I,j,k) * & - G%dyCu(I,j) + US%L_to_m*G%dyCu(I,j) normal_trans_bt(I,j) = normal_trans_bt(I,j)+segment%normal_trans(I,j,k) enddo segment%normal_vel_bt(I,j) = normal_trans_bt(I,j)/(max(segment%Htot(I,j),1.e-12) * & - G%dyCu(I,j)) + US%L_to_m*G%dyCu(I,j)) if (associated(segment%nudged_normal_vel)) segment%nudged_normal_vel(I,j,:) = segment%normal_vel(I,j,:) enddo elseif (trim(segment%field(m)%name) == 'V' .and. segment%is_N_or_S) then @@ -3299,11 +3299,11 @@ subroutine update_OBC_segment_data(G, GV, US, OBC, tv, h, Time) do k=1,G%ke segment%normal_vel(i,J,k) = segment%field(m)%buffer_dst(i,J,k) segment%normal_trans(i,J,k) = segment%field(m)%buffer_dst(i,J,k)*segment%h(i,J,k) * & - G%dxCv(i,J) + US%L_to_m*G%dxCv(i,J) normal_trans_bt(i,J) = normal_trans_bt(i,J)+segment%normal_trans(i,J,k) enddo segment%normal_vel_bt(i,J) = normal_trans_bt(i,J)/(max(segment%Htot(i,J),1.e-12) * & - G%dxCv(i,J)) + US%L_to_m*G%dxCv(i,J)) if (associated(segment%nudged_normal_vel)) segment%nudged_normal_vel(i,J,:) = segment%normal_vel(i,J,:) enddo elseif (trim(segment%field(m)%name) == 'V' .and. segment%is_E_or_W .and. & diff --git a/src/diagnostics/MOM_diagnostics.F90 b/src/diagnostics/MOM_diagnostics.F90 index 37ad8ac14a..03bbec78fb 100644 --- a/src/diagnostics/MOM_diagnostics.F90 +++ b/src/diagnostics/MOM_diagnostics.F90 @@ -1955,11 +1955,11 @@ subroutine write_static_fields(G, GV, US, tv, diag) if (id > 0) call post_data(id, G%dxCu, diag, .true.) id = register_static_field('ocean_model', 'dyCu', diag%axesCu1, & - 'Delta(y) at u points (meter)', 'm', interp_method='none') !(, conversion=US%L_to_m) + 'Delta(y) at u points (meter)', 'm', interp_method='none', conversion=US%L_to_m) if (id > 0) call post_data(id, G%dyCu, diag, .true.) id = register_static_field('ocean_model', 'dxCv', diag%axesCv1, & - 'Delta(x) at v points (meter)', 'm', interp_method='none') !(, conversion=US%L_to_m) + 'Delta(x) at v points (meter)', 'm', interp_method='none', conversion=US%L_to_m) if (id > 0) call post_data(id, G%dxCv, diag, .true.) id = register_static_field('ocean_model', 'dyCv', diag%axesCv1, & diff --git a/src/framework/MOM_diag_mediator.F90 b/src/framework/MOM_diag_mediator.F90 index 4a8091752a..54f1934abd 100644 --- a/src/framework/MOM_diag_mediator.F90 +++ b/src/framework/MOM_diag_mediator.F90 @@ -3910,7 +3910,7 @@ subroutine downsample_field_3d(field_in, field_out, dl, method, mask, diag_cs, d total_weight = 0.0 ii=i0 do jj=j0,j0+dl-1 - weight =mask(ii,jj,k)*diag_cs%G%dyCu(ii,jj)*diag_cs%h(ii,jj,k) + weight =mask(ii,jj,k)*diag_cs%G%US%L_to_m*diag_cs%G%dyCu(ii,jj) * diag_cs%h(ii,jj,k) total_weight = total_weight +weight ave=ave+field_in(ii,jj,k)*weight enddo @@ -3966,7 +3966,7 @@ subroutine downsample_field_3d(field_in, field_out, dl, method, mask, diag_cs, d total_weight = 0.0 jj=j0 do ii=i0,i0+dl-1 - weight = mask(ii,jj,k)*diag_cs%G%dxCv(ii,jj)*diag_cs%h(ii,jj,k) + weight = mask(ii,jj,k)*diag_cs%G%US%L_to_m*diag_cs%G%dxCv(ii,jj)*diag_cs%h(ii,jj,k) total_weight = total_weight + weight ave=ave+field_in(ii,jj,k)*weight enddo @@ -4093,7 +4093,7 @@ subroutine downsample_field_2d(field_in, field_out, dl, method, mask, diag_cs, d total_weight = 0.0 ii=i0 do jj=j0,j0+dl-1 - weight =mask(ii,jj)*diag_cs%G%dyCu(ii,jj)!*diag_cs%h(ii,jj,1) !Niki? + weight = mask(ii,jj)*diag_cs%G%US%L_to_m*diag_cs%G%dyCu(ii,jj)!*diag_cs%h(ii,jj,1) !Niki? total_weight = total_weight +weight ave=ave+field_in(ii,jj)*weight enddo @@ -4107,7 +4107,7 @@ subroutine downsample_field_2d(field_in, field_out, dl, method, mask, diag_cs, d total_weight = 0.0 jj=j0 do ii=i0,i0+dl-1 - weight =mask(ii,jj)*diag_cs%G%dxCv(ii,jj)!*diag_cs%h(ii,jj,1) !Niki? + weight = mask(ii,jj)*diag_cs%G%US%L_to_m*diag_cs%G%dxCv(ii,jj)!*diag_cs%h(ii,jj,1) !Niki? total_weight = total_weight +weight ave=ave+field_in(ii,jj)*weight enddo diff --git a/src/framework/MOM_dyn_horgrid.F90 b/src/framework/MOM_dyn_horgrid.F90 index 2fac514036..5e533e0f05 100644 --- a/src/framework/MOM_dyn_horgrid.F90 +++ b/src/framework/MOM_dyn_horgrid.F90 @@ -90,7 +90,7 @@ module MOM_dyn_horgrid geoLonCu, & !< The geographic longitude at u points [degrees of longitude] or [m]. dxCu, & !< dxCu is delta x at u points [L ~> m]. IdxCu, & !< 1/dxCu [m-1]. - dyCu, & !< dyCu is delta y at u points [m]. + dyCu, & !< dyCu is delta y at u points [L ~> m]. IdyCu, & !< 1/dyCu [m-1]. dy_Cu, & !< The unblocked lengths of the u-faces of the h-cell [L ~> m]. IareaCu, & !< The masked inverse areas of u-grid cells [L-2 ~> m-2]. @@ -100,7 +100,7 @@ module MOM_dyn_horgrid mask2dCv, & !< 0 for boundary points and 1 for ocean points on the v grid [nondim]. geoLatCv, & !< The geographic latitude at v points [degrees of latitude] or [m]. geoLonCv, & !< The geographic longitude at v points [degrees of longitude] or [m]. - dxCv, & !< dxCv is delta x at v points [m]. + dxCv, & !< dxCv is delta x at v points [L ~> m]. IdxCv, & !< 1/dxCv [m-1]. dyCv, & !< dyCv is delta y at v points [L ~> m]. IdyCv, & !< 1/dyCv [m-1]. @@ -340,13 +340,13 @@ subroutine set_derived_dyn_horgrid(G, US) if (G%dxCu(I,j) < 0.0) G%dxCu(I,j) = 0.0 if (G%dyCu(I,j) < 0.0) G%dyCu(I,j) = 0.0 G%IdxCu(I,j) = Adcroft_reciprocal(L_to_m*G%dxCu(I,j)) - G%IdyCu(I,j) = Adcroft_reciprocal(G%dyCu(I,j)) + G%IdyCu(I,j) = Adcroft_reciprocal(L_to_m*G%dyCu(I,j)) enddo ; enddo do J=JsdB,JedB ; do i=isd,ied if (G%dxCv(i,J) < 0.0) G%dxCv(i,J) = 0.0 if (G%dyCv(i,J) < 0.0) G%dyCv(i,J) = 0.0 - G%IdxCv(i,J) = Adcroft_reciprocal(G%dxCv(i,J)) + G%IdxCv(i,J) = Adcroft_reciprocal(L_to_m*G%dxCv(i,J)) G%IdyCv(i,J) = Adcroft_reciprocal(L_to_m*G%dyCv(i,J)) enddo ; enddo diff --git a/src/initialization/MOM_grid_initialize.F90 b/src/initialization/MOM_grid_initialize.F90 index 9213615333..bba879eec7 100644 --- a/src/initialization/MOM_grid_initialize.F90 +++ b/src/initialization/MOM_grid_initialize.F90 @@ -130,8 +130,7 @@ subroutine grid_metrics_chksum(parent, G, US) call uvchksum(trim(parent)//': dxC[uv]', G%dxCu, G%dyCv, G%HI, haloshift=halo, scale=L_to_m) - call uvchksum(trim(parent)//': dxC[uv]', & - G%dyCu, G%dxCv, G%HI, haloshift=halo) + call uvchksum(trim(parent)//': dxC[uv]', G%dyCu, G%dxCv, G%HI, haloshift=halo, scale=L_to_m) call Bchksum_pair(trim(parent)//': dxB[uv]', & G%dxBu, G%dyBu, G%HI, haloshift=halo) @@ -366,10 +365,10 @@ subroutine set_grid_metrics_from_mosaic(G, param_file, US) G%dxT(i,j) = m_to_L*dxT(i,j) ; G%dyT(i,j) = m_to_L*dyT(i,j) ; G%areaT(i,j) = m_to_L**2*areaT(i,j) enddo ; enddo do I=G%IsdB,G%IedB ; do j=G%jsd,G%jed - G%dxCu(I,j) = m_to_L*dxCu(I,j) ; G%dyCu(I,j) = dyCu(I,j) + G%dxCu(I,j) = m_to_L*dxCu(I,j) ; G%dyCu(I,j) = m_to_L*dyCu(I,j) enddo ; enddo do i=G%isd,G%ied ; do J=G%JsdB,G%JedB - G%dxCv(i,J) = dxCv(i,J) ; G%dyCv(i,J) = m_to_L*dyCv(i,J) + G%dxCv(i,J) = m_to_L*dxCv(i,J) ; G%dyCv(i,J) = m_to_L*dyCv(i,J) enddo ; enddo do I=G%IsdB,G%IedB ; do J=G%JsdB,G%JedB G%dxBu(I,J) = dxBu(I,J) ; G%dyBu(I,J) = dyBu(I,J) ; G%areaBu(I,J) = m_to_L**2*areaBu(I,J) @@ -539,13 +538,13 @@ subroutine set_grid_metrics_cartesian(G, param_file, US) G%geoLonCu(I,j) = grid_lonB(I) ; G%geoLatCu(I,j) = grid_LatT(j) G%dxCu(I,j) = m_to_L*dx_everywhere ; G%IdxCu(I,j) = I_dx - G%dyCu(I,j) = dy_everywhere ; G%IdyCu(I,j) = I_dy + G%dyCu(I,j) = m_to_L*dy_everywhere ; G%IdyCu(I,j) = I_dy enddo ; enddo do J=JsdB,JedB ; do i=isd,ied G%geoLonCv(i,J) = grid_lonT(i) ; G%geoLatCv(i,J) = grid_latB(J) - G%dxCv(i,J) = dx_everywhere ; G%IdxCv(i,J) = I_dx + G%dxCv(i,J) = m_to_L*dx_everywhere ; G%IdxCv(i,J) = I_dx G%dyCv(i,J) = m_to_L*dy_everywhere ; G%IdyCv(i,J) = I_dy enddo ; enddo @@ -658,8 +657,8 @@ subroutine set_grid_metrics_spherical(G, param_file, US) ! The following line is needed to reproduce the solution from ! set_grid_metrics_mercator when used to generate a simple spherical grid. - G%dxCv(i,J) = G%Rad_Earth * COS( G%geoLatCv(i,J)*PI_180 ) * dL_di -! G%dxCv(i,J) = G%Rad_Earth * (dLon*PI_180) * COS( G%geoLatCv(i,J)*PI_180 ) + G%dxCv(i,J) = m_to_L*G%Rad_Earth * COS( G%geoLatCv(i,J)*PI_180 ) * dL_di +! G%dxCv(i,J) = m_to_L*G%Rad_Earth * (dLon*PI_180) * COS( G%geoLatCv(i,J)*PI_180 ) G%dyCv(i,J) = m_to_L*G%Rad_Earth * dLat*PI_180 enddo ; enddo @@ -671,7 +670,7 @@ subroutine set_grid_metrics_spherical(G, param_file, US) ! set_grid_metrics_mercator when used to generate a simple spherical grid. G%dxCu(I,j) = m_to_L*G%Rad_Earth * COS( G%geoLatCu(I,j)*PI_180 ) * dL_di ! G%dxCu(I,j) = m_to_L*G%Rad_Earth * dLon*PI_180 * COS( latitude ) - G%dyCu(I,j) = G%Rad_Earth * dLat*PI_180 + G%dyCu(I,j) = m_to_L*G%Rad_Earth * dLat*PI_180 enddo ; enddo do j=jsd,jed ; do i=isd,ied @@ -893,13 +892,13 @@ subroutine set_grid_metrics_mercator(G, param_file, US) G%geoLonCu(I,j) = xu(I,j)*180.0/PI G%geoLatCu(I,j) = yu(I,j)*180.0/PI G%dxCu(I,j) = m_to_L*ds_di(xu(I,j), yu(I,j), GP) - G%dyCu(I,j) = ds_dj(xu(I,j), yu(I,j), GP) + G%dyCu(I,j) = m_to_L*ds_dj(xu(I,j), yu(I,j), GP) enddo ; enddo do J=JsdB,JedB ; do i=isd,ied G%geoLonCv(i,J) = xv(i,J)*180.0/PI G%geoLatCv(i,J) = yv(i,J)*180.0/PI - G%dxCv(i,J) = ds_di(xv(i,J), yv(i,J), GP) + G%dxCv(i,J) = m_to_L*ds_di(xv(i,J), yv(i,J), GP) G%dyCv(i,J) = m_to_L*ds_dj(xv(i,J), yv(i,J), GP) enddo ; enddo @@ -1311,13 +1310,13 @@ subroutine initialize_masks(G, PF, US) call pass_vector(G%mask2dCu, G%mask2dCv, G%Domain, To_All+Scalar_Pair, CGRID_NE) do j=G%jsd,G%jed ; do I=G%IsdB,G%IedB - G%dy_Cu(I,j) = G%mask2dCu(I,j) * m_to_L*G%dyCu(I,j) + G%dy_Cu(I,j) = G%mask2dCu(I,j) * G%dyCu(I,j) G%areaCu(I,j) = G%dxCu(I,j) * G%dy_Cu(I,j) G%IareaCu(I,j) = G%mask2dCu(I,j) * Adcroft_reciprocal(G%areaCu(I,j)) enddo ; enddo do J=G%JsdB,G%JedB ; do i=G%isd,G%ied - G%dx_Cv(i,J) = G%mask2dCv(i,J) * m_to_L*G%dxCv(i,J) + G%dx_Cv(i,J) = G%mask2dCv(i,J) * G%dxCv(i,J) G%areaCv(i,J) = G%dyCv(i,J) * G%dx_Cv(i,J) G%IareaCv(i,J) = G%mask2dCv(i,J) * Adcroft_reciprocal(G%areaCv(i,J)) enddo ; enddo diff --git a/src/initialization/MOM_shared_initialization.F90 b/src/initialization/MOM_shared_initialization.F90 index 35c42f0775..9a6ecde5d8 100644 --- a/src/initialization/MOM_shared_initialization.F90 +++ b/src/initialization/MOM_shared_initialization.F90 @@ -644,7 +644,7 @@ subroutine reset_face_lengths_named(G, param_file, name, US) if (option==1) then ! 1-degree settings. do j=jsd,jed ; do I=IsdB,IedB ! Change any u-face lengths within this loop. - dy_2 = dx_2 * G%dyCu(I,j)*G%IdxCu(I,j) * cos(pi_180 * G%geoLatCu(I,j)) + dy_2 = dx_2 * L_to_m*G%dyCu(I,j)*G%IdxCu(I,j) * cos(pi_180 * G%geoLatCu(I,j)) if ((abs(G%geoLatCu(I,j)-35.5) < dy_2) .and. (G%geoLonCu(I,j) < -4.5) .and. & (G%geoLonCu(I,j) > -6.5)) & @@ -710,10 +710,10 @@ subroutine reset_face_lengths_named(G, param_file, name, US) ! These checks apply regardless of the chosen option. do j=jsd,jed ; do I=IsdB,IedB - if (L_to_m*G%dy_Cu(I,j) > G%dyCu(I,j)) then + if (L_to_m*G%dy_Cu(I,j) > L_to_m*G%dyCu(I,j)) then write(mesg,'("dy_Cu of ",ES11.4," exceeds unrestricted width of ",ES11.4,& &" by ",ES11.4," at lon/lat of ", ES11.4, ES11.4)') & - L_to_m*G%dy_Cu(I,j), G%dyCu(I,j), L_to_m*G%dy_Cu(I,j)-G%dyCu(I,j), & + L_to_m*G%dy_Cu(I,j), L_to_m*G%dyCu(I,j), L_to_m*G%dy_Cu(I,j)-L_to_m*G%dyCu(I,j), & G%geoLonCu(I,j), G%geoLatCu(I,j) call MOM_error(FATAL,"reset_face_lengths_named "//mesg) endif @@ -723,10 +723,10 @@ subroutine reset_face_lengths_named(G, param_file, name, US) enddo ; enddo do J=JsdB,JedB ; do i=isd,ied - if (L_to_m*G%dx_Cv(i,J) > G%dxCv(i,J)) then + if (L_to_m*G%dx_Cv(i,J) > L_to_m*G%dxCv(i,J)) then write(mesg,'("dx_Cv of ",ES11.4," exceeds unrestricted width of ",ES11.4,& &" by ",ES11.4, " at lon/lat of ", ES11.4, ES11.4)') & - L_to_m*G%dx_Cv(i,J), G%dxCv(i,J), L_to_m*G%dx_Cv(i,J)-G%dxCv(i,J), & + L_to_m*G%dx_Cv(i,J), L_to_m*G%dxCv(i,J), L_to_m*G%dx_Cv(i,J)-L_to_m*G%dxCv(i,J), & G%geoLonCv(i,J), G%geoLatCv(i,J) call MOM_error(FATAL,"reset_face_lengths_named "//mesg) @@ -779,10 +779,10 @@ subroutine reset_face_lengths_file(G, param_file, US) call pass_vector(G%dy_Cu, G%dx_Cv, G%Domain, To_All+SCALAR_PAIR, CGRID_NE) do j=jsd,jed ; do I=IsdB,IedB - if (L_to_m*G%dy_Cu(I,j) > G%dyCu(I,j)) then + if (L_to_m*G%dy_Cu(I,j) > L_to_m*G%dyCu(I,j)) then write(mesg,'("dy_Cu of ",ES11.4," exceeds unrestricted width of ",ES11.4,& &" by ",ES11.4," at lon/lat of ", ES11.4, ES11.4)') & - L_to_m*G%dy_Cu(I,j), G%dyCu(I,j), L_to_m*G%dy_Cu(I,j)-G%dyCu(I,j), & + L_to_m*G%dy_Cu(I,j), L_to_m*G%dyCu(I,j), L_to_m*G%dy_Cu(I,j)-L_to_m*G%dyCu(I,j), & G%geoLonCu(I,j), G%geoLatCu(I,j) call MOM_error(FATAL,"reset_face_lengths_file "//mesg) endif @@ -792,10 +792,10 @@ subroutine reset_face_lengths_file(G, param_file, US) enddo ; enddo do J=JsdB,JedB ; do i=isd,ied - if (L_to_m*G%dx_Cv(i,J) > G%dxCv(i,J)) then + if (L_to_m*G%dx_Cv(i,J) > L_to_m*G%dxCv(i,J)) then write(mesg,'("dx_Cv of ",ES11.4," exceeds unrestricted width of ",ES11.4,& &" by ",ES11.4, " at lon/lat of ", ES11.4, ES11.4)') & - L_to_m*G%dx_Cv(i,J), G%dxCv(i,J), L_to_m*G%dx_Cv(i,J)-G%dxCv(i,J), & + L_to_m*G%dx_Cv(i,J), L_to_m*G%dxCv(i,J), L_to_m*G%dx_Cv(i,J)-L_to_m*G%dxCv(i,J), & G%geoLonCv(i,J), G%geoLatCv(i,J) call MOM_error(FATAL,"reset_face_lengths_file "//mesg) @@ -988,7 +988,7 @@ subroutine reset_face_lengths_list(G, param_file, US) ((lon_p >= u_lon(1,npt)) .and. (lon_p <= u_lon(2,npt))) .or. & ((lon_m >= u_lon(1,npt)) .and. (lon_m <= u_lon(2,npt)))) ) then - G%dy_Cu(I,j) = G%mask2dCu(I,j) * m_to_L*min(G%dyCu(I,j), max(u_width(npt), 0.0)) + G%dy_Cu(I,j) = G%mask2dCu(I,j) * m_to_L*min(L_to_m*G%dyCu(I,j), max(u_width(npt), 0.0)) if (j>=G%jsc .and. j<=G%jec .and. I>=G%isc .and. I<=G%iec) then ! Limit messages/checking to compute domain if ( G%mask2dCu(I,j) == 0.0 ) then write(*,'(A,2F8.2,A,4F8.2,A)') "read_face_lengths_list : G%mask2dCu=0 at ",lat,lon," (",& @@ -1017,7 +1017,7 @@ subroutine reset_face_lengths_list(G, param_file, US) (((lon >= v_lon(1,npt)) .and. (lon <= v_lon(2,npt))) .or. & ((lon_p >= v_lon(1,npt)) .and. (lon_p <= v_lon(2,npt))) .or. & ((lon_m >= v_lon(1,npt)) .and. (lon_m <= v_lon(2,npt)))) ) then - G%dx_Cv(i,J) = G%mask2dCv(i,J) * m_to_L*min(G%dxCv(i,J), max(v_width(npt), 0.0)) + G%dx_Cv(i,J) = G%mask2dCv(i,J) * m_to_L*min(L_to_m*G%dxCv(i,J), max(v_width(npt), 0.0)) if (i>=G%isc .and. i<=G%iec .and. J>=G%jsc .and. J<=G%jec) then ! Limit messages/checking to compute domain if ( G%mask2dCv(i,J) == 0.0 ) then write(*,'(A,2F8.2,A,4F8.2,A)') "read_face_lengths_list : G%mask2dCv=0 at ",lat,lon," (",& @@ -1279,9 +1279,9 @@ subroutine write_ocean_geometry_file(G, param_file, directory, geom_file, US) ! I think that all of these copies are holdovers from a much earlier ! ancestor code in which many of the metrics were macros that could have ! had reduced dimensions, and that they are no longer needed in MOM6. -RWH - do J=Jsq,Jeq ; do i=is,ie ; out_v(i,J) = G%dxCv(i,J) ; enddo ; enddo + do J=Jsq,Jeq ; do i=is,ie ; out_v(i,J) = L_to_m_scale*G%dxCv(i,J) ; enddo ; enddo call write_field(unit, fields(7), G%Domain%mpp_domain, out_v) - do j=js,je ; do I=Isq,Ieq ; out_u(I,j) = G%dyCu(I,j) ; enddo ; enddo + do j=js,je ; do I=Isq,Ieq ; out_u(I,j) = L_to_m_scale*G%dyCu(I,j) ; enddo ; enddo call write_field(unit, fields(8), G%Domain%mpp_domain, out_u) do j=js,je ; do I=Isq,Ieq ; out_u(I,j) = L_to_m_scale*G%dxCu(I,j) ; enddo ; enddo diff --git a/src/parameterizations/lateral/MOM_hor_visc.F90 b/src/parameterizations/lateral/MOM_hor_visc.F90 index ce60d2ccc2..9382fd84fa 100644 --- a/src/parameterizations/lateral/MOM_hor_visc.F90 +++ b/src/parameterizations/lateral/MOM_hor_visc.F90 @@ -752,10 +752,10 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, if (CS%modified_Leith) then ! Divergence do j=Jsq-1,Jeq+2 ; do i=Isq-1,Ieq+2 - div_xx(i,j) = 0.5*((G%dyCu(I,j) * u(I,j,k) * (h(i+1,j,k)+h(i,j,k)) - & - G%dyCu(I-1,j) * u(I-1,j,k) * (h(i-1,j,k)+h(i,j,k)) ) + & - (G%dxCv(i,J) * v(i,J,k) * (h(i,j,k)+h(i,j+1,k)) - & - G%dxCv(i,J-1)*v(i,J-1,k)*(h(i,j,k)+h(i,j-1,k))))*US%m_to_L**2*G%IareaT(i,j) / & + div_xx(i,j) = 0.5*((US%L_to_m*G%dyCu(I,j) * u(I,j,k) * (h(i+1,j,k)+h(i,j,k)) - & + US%L_to_m*G%dyCu(I-1,j) * u(I-1,j,k) * (h(i-1,j,k)+h(i,j,k)) ) + & + (US%L_to_m*G%dxCv(i,J) * v(i,J,k) * (h(i,j,k)+h(i,j+1,k)) - & + US%L_to_m*G%dxCv(i,J-1)*v(i,J-1,k)*(h(i,j,k)+h(i,j-1,k))))*US%m_to_L**2*G%IareaT(i,j) / & (h(i,j,k) + GV%H_subroundoff) enddo ; enddo @@ -1875,34 +1875,34 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS, MEKE) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 CS%reduction_xx(i,j) = 1.0 - if ((G%dy_Cu(I,j) > 0.0) .and. (US%L_to_m*G%dy_Cu(I,j) < G%dyCu(I,j)) .and. & - (US%L_to_m*G%dy_Cu(I,j) < G%dyCu(I,j) * CS%reduction_xx(i,j))) & - CS%reduction_xx(i,j) = US%L_to_m*G%dy_Cu(I,j) / (G%dyCu(I,j)) - if ((G%dy_Cu(I-1,j) > 0.0) .and. (US%L_to_m*G%dy_Cu(I-1,j) < G%dyCu(I-1,j)) .and. & - (US%L_to_m*G%dy_Cu(I-1,j) < G%dyCu(I-1,j) * CS%reduction_xx(i,j))) & - CS%reduction_xx(i,j) = US%L_to_m*G%dy_Cu(I-1,j) / (G%dyCu(I-1,j)) - if ((G%dx_Cv(i,J) > 0.0) .and. (US%L_to_m*G%dx_Cv(i,J) < G%dxCv(i,J)) .and. & - (US%L_to_m*G%dx_Cv(i,J) < G%dxCv(i,J) * CS%reduction_xx(i,j))) & - CS%reduction_xx(i,j) = US%L_to_m*G%dx_Cv(i,J) / (G%dxCv(i,J)) - if ((G%dx_Cv(i,J-1) > 0.0) .and. (US%L_to_m*G%dx_Cv(i,J-1) < G%dxCv(i,J-1)) .and. & - (US%L_to_m*G%dx_Cv(i,J-1) < G%dxCv(i,J-1) * CS%reduction_xx(i,j))) & - CS%reduction_xx(i,j) = US%L_to_m*G%dx_Cv(i,J-1) / (G%dxCv(i,J-1)) + if ((G%dy_Cu(I,j) > 0.0) .and. (US%L_to_m*G%dy_Cu(I,j) < US%L_to_m*G%dyCu(I,j)) .and. & + (US%L_to_m*G%dy_Cu(I,j) < US%L_to_m*G%dyCu(I,j) * CS%reduction_xx(i,j))) & + CS%reduction_xx(i,j) = US%L_to_m*G%dy_Cu(I,j) / (US%L_to_m*G%dyCu(I,j)) + if ((G%dy_Cu(I-1,j) > 0.0) .and. (US%L_to_m*G%dy_Cu(I-1,j) < US%L_to_m*G%dyCu(I-1,j)) .and. & + (US%L_to_m*G%dy_Cu(I-1,j) < US%L_to_m*G%dyCu(I-1,j) * CS%reduction_xx(i,j))) & + CS%reduction_xx(i,j) = US%L_to_m*G%dy_Cu(I-1,j) / (US%L_to_m*G%dyCu(I-1,j)) + if ((G%dx_Cv(i,J) > 0.0) .and. (US%L_to_m*G%dx_Cv(i,J) < US%L_to_m*G%dxCv(i,J)) .and. & + (US%L_to_m*G%dx_Cv(i,J) < US%L_to_m*G%dxCv(i,J) * CS%reduction_xx(i,j))) & + CS%reduction_xx(i,j) = US%L_to_m*G%dx_Cv(i,J) / (US%L_to_m*G%dxCv(i,J)) + if ((G%dx_Cv(i,J-1) > 0.0) .and. (US%L_to_m*G%dx_Cv(i,J-1) < US%L_to_m*G%dxCv(i,J-1)) .and. & + (US%L_to_m*G%dx_Cv(i,J-1) < US%L_to_m*G%dxCv(i,J-1) * CS%reduction_xx(i,j))) & + CS%reduction_xx(i,j) = US%L_to_m*G%dx_Cv(i,J-1) / (US%L_to_m*G%dxCv(i,J-1)) enddo ; enddo do J=js-1,Jeq ; do I=is-1,Ieq CS%reduction_xy(I,J) = 1.0 - if ((G%dy_Cu(I,j) > 0.0) .and. (US%L_to_m*G%dy_Cu(I,j) < G%dyCu(I,j)) .and. & - (US%L_to_m*G%dy_Cu(I,j) < G%dyCu(I,j) * CS%reduction_xy(I,J))) & - CS%reduction_xy(I,J) = US%L_to_m*G%dy_Cu(I,j) / (G%dyCu(I,j)) - if ((G%dy_Cu(I,j+1) > 0.0) .and. (US%L_to_m*G%dy_Cu(I,j+1) < G%dyCu(I,j+1)) .and. & - (US%L_to_m*G%dy_Cu(I,j+1) < G%dyCu(I,j+1) * CS%reduction_xy(I,J))) & - CS%reduction_xy(I,J) = US%L_to_m*G%dy_Cu(I,j+1) / (G%dyCu(I,j+1)) - if ((G%dx_Cv(i,J) > 0.0) .and. (US%L_to_m*G%dx_Cv(i,J) < G%dxCv(i,J)) .and. & - (US%L_to_m*G%dx_Cv(i,J) < G%dxCv(i,J) * CS%reduction_xy(I,J))) & - CS%reduction_xy(I,J) = US%L_to_m*G%dx_Cv(i,J) / (G%dxCv(i,J)) - if ((G%dx_Cv(i+1,J) > 0.0) .and. (US%L_to_m*G%dx_Cv(i+1,J) < G%dxCv(i+1,J)) .and. & - (US%L_to_m*G%dx_Cv(i+1,J) < G%dxCv(i+1,J) * CS%reduction_xy(I,J))) & - CS%reduction_xy(I,J) = US%L_to_m*G%dx_Cv(i+1,J) / (G%dxCv(i+1,J)) + if ((G%dy_Cu(I,j) > 0.0) .and. (US%L_to_m*G%dy_Cu(I,j) < US%L_to_m*G%dyCu(I,j)) .and. & + (US%L_to_m*G%dy_Cu(I,j) < US%L_to_m*G%dyCu(I,j) * CS%reduction_xy(I,J))) & + CS%reduction_xy(I,J) = US%L_to_m*G%dy_Cu(I,j) / (US%L_to_m*G%dyCu(I,j)) + if ((G%dy_Cu(I,j+1) > 0.0) .and. (US%L_to_m*G%dy_Cu(I,j+1) < US%L_to_m*G%dyCu(I,j+1)) .and. & + (US%L_to_m*G%dy_Cu(I,j+1) < US%L_to_m*G%dyCu(I,j+1) * CS%reduction_xy(I,J))) & + CS%reduction_xy(I,J) = US%L_to_m*G%dy_Cu(I,j+1) / (US%L_to_m*G%dyCu(I,j+1)) + if ((G%dx_Cv(i,J) > 0.0) .and. (US%L_to_m*G%dx_Cv(i,J) < US%L_to_m*G%dxCv(i,J)) .and. & + (US%L_to_m*G%dx_Cv(i,J) < US%L_to_m*G%dxCv(i,J) * CS%reduction_xy(I,J))) & + CS%reduction_xy(I,J) = US%L_to_m*G%dx_Cv(i,J) / (US%L_to_m*G%dxCv(i,J)) + if ((G%dx_Cv(i+1,J) > 0.0) .and. (US%L_to_m*G%dx_Cv(i+1,J) < US%L_to_m*G%dxCv(i+1,J)) .and. & + (US%L_to_m*G%dx_Cv(i+1,J) < US%L_to_m*G%dxCv(i+1,J) * CS%reduction_xy(I,J))) & + CS%reduction_xy(I,J) = US%L_to_m*G%dx_Cv(i+1,J) / (US%L_to_m*G%dxCv(i+1,J)) enddo ; enddo if (CS%Laplacian) then diff --git a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 index a6926474d0..d4b0b88313 100644 --- a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 +++ b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 @@ -1128,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%L_to_m*G%dxCu(I,j))**2 + (G%dyCu(I,j))**2) * & + CS%f2_dx2_u(I,j) = ((US%L_to_m*G%dxCu(I,j))**2 + (US%L_to_m*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 * ((US%L_to_m*G%dxCu(I,j))**2 + (G%dyCu(I,j))**2) * (sqrt( & + CS%beta_dx2_u(I,j) = oneOrTwo * ((US%L_to_m*G%dxCu(I,j))**2 + (US%L_to_m*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 + & @@ -1139,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) = ((G%dxCv(i,J))**2 + (US%L_to_m*G%dyCv(i,J))**2) * & + CS%f2_dx2_v(i,J) = ((US%L_to_m*G%dxCv(i,J))**2 + (US%L_to_m*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 + (US%L_to_m*G%dyCv(i,J))**2) * (sqrt( & + CS%beta_dx2_v(i,J) = oneOrTwo * ((US%L_to_m*G%dxCv(i,J))**2 + (US%L_to_m*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) + & @@ -1207,13 +1207,13 @@ subroutine VarMix_init(Time, G, GV, US, param_file, diag, CS) do j=Jsq,Jeq+1 ; do I=is-1,Ieq ! Static factors in the Leith schemes - grid_sp_u2 = G%dyCu(I,j)*US%L_to_m*G%dxCu(I,j) + grid_sp_u2 = US%L_to_m*G%dyCu(I,j)*US%L_to_m*G%dxCu(I,j) grid_sp_u3 = grid_sp_u2*sqrt(grid_sp_u2) CS%Laplac3_const_u(I,j) = Leith_Lap_const * grid_sp_u3 enddo ; enddo do j=js-1,Jeq ; do I=Isq,Ieq+1 ! Static factors in the Leith schemes - !### The second factor here is wrong. + !### The second factor here is wrong. It should be G%dxCv(i,J). grid_sp_v2 = US%L_to_m*G%dyCv(i,J)*US%L_to_m*G%dxCu(i,J) grid_sp_v3 = grid_sp_v2*sqrt(grid_sp_v2) CS%Laplac3_const_v(i,J) = Leith_Lap_const * grid_sp_v3 diff --git a/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 b/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 index 6115e2a8fe..c1520e68d7 100644 --- a/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 +++ b/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 @@ -360,7 +360,7 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var 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 = & - ( sqrt( 0.5 * ( (US%L_to_m*G%dxCu(I,j))**2 + (G%dyCu(I,j))**2 ) ) * I_l_f ) & + ( sqrt( 0.5 * ( (US%L_to_m*G%dxCu(I,j))**2 + (US%L_to_m*G%dyCu(I,j))**2 ) ) * I_l_f ) & * min( 1., 0.5*( VarMix%Rd_dx_h(i,j) + VarMix%Rd_dx_h(i+1,j) ) ) ! peak ML visc: u_star * 0.41 * (h_ml*u_star)/(absf*h_ml + 4.0*u_star) @@ -372,7 +372,7 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var timescale = 0.0625 * (absf + 2.0*mom_mixrate) / (absf**2 + mom_mixrate**2) timescale = timescale * CS%ml_restrat_coef if (res_upscale) timescale = timescale * res_scaling_fac - uDml(I) = timescale * G%mask2dCu(I,j)*G%dyCu(I,j)* & + uDml(I) = timescale * G%mask2dCu(I,j)*US%L_to_m*G%dyCu(I,j)* & G%IdxCu(I,j)*(Rml_av_fast(i+1,j)-Rml_av_fast(i,j)) * (h_vel**2 * GV%Z_to_H) ! As above but using the slow filtered MLD h_vel = 0.5*((htot_slow(i,j) + htot_slow(i+1,j)) + h_neglect) * GV%H_to_Z @@ -381,7 +381,7 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var timescale = 0.0625 * (absf + 2.0*mom_mixrate) / (absf**2 + mom_mixrate**2) timescale = timescale * CS%ml_restrat_coef2 if (res_upscale) timescale = timescale * res_scaling_fac - uDml_slow(I) = timescale * G%mask2dCu(I,j)*G%dyCu(I,j)* & + uDml_slow(I) = timescale * G%mask2dCu(I,j)*US%L_to_m*G%dyCu(I,j)* & G%IdxCu(I,j)*(Rml_av_slow(i+1,j)-Rml_av_slow(i,j)) * (h_vel**2 * GV%Z_to_H) if (uDml(I) + uDml_slow(I) == 0.) then @@ -436,7 +436,7 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var 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 = & - ( sqrt( 0.5 * ( (G%dxCv(i,J))**2 + (US%L_to_m*G%dyCv(i,J))**2 ) ) * I_l_f ) & + ( sqrt( 0.5 * ( (US%L_to_m*G%dxCv(i,J))**2 + (US%L_to_m*G%dyCv(i,J))**2 ) ) * I_l_f ) & * min( 1., 0.5*( VarMix%Rd_dx_h(i,j) + VarMix%Rd_dx_h(i,j+1) ) ) ! peak ML visc: u_star * 0.41 * (h_ml*u_star)/(absf*h_ml + 4.0*u_star) @@ -448,7 +448,7 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var timescale = 0.0625 * (absf + 2.0*mom_mixrate) / (absf**2 + mom_mixrate**2) timescale = timescale * CS%ml_restrat_coef if (res_upscale) timescale = timescale * res_scaling_fac - vDml(i) = timescale * G%mask2dCv(i,J)*G%dxCv(i,J)* & + vDml(i) = timescale * G%mask2dCv(i,J)*US%L_to_m*G%dxCv(i,J)* & G%IdyCv(i,J)*(Rml_av_fast(i,j+1)-Rml_av_fast(i,j)) * (h_vel**2 * GV%Z_to_H) ! As above but using the slow filtered MLD h_vel = 0.5*((htot_slow(i,j) + htot_slow(i,j+1)) + h_neglect) * GV%H_to_Z @@ -457,7 +457,7 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var timescale = 0.0625 * (absf + 2.0*mom_mixrate) / (absf**2 + mom_mixrate**2) timescale = timescale * CS%ml_restrat_coef2 if (res_upscale) timescale = timescale * res_scaling_fac - vDml_slow(i) = timescale * G%mask2dCv(i,J)*G%dxCv(i,J)* & + vDml_slow(i) = timescale * G%mask2dCv(i,J)*US%L_to_m*G%dxCv(i,J)* & G%IdyCv(i,J)*(Rml_av_slow(i,j+1)-Rml_av_slow(i,j)) * (h_vel**2 * GV%Z_to_H) if (vDml(i) + vDml_slow(i) == 0.) then @@ -665,7 +665,7 @@ subroutine mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, dt, G, GV, US, CS) timescale = timescale * CS%ml_restrat_coef ! timescale = timescale*(2?)*(L_def/L_MLI)*min(EKE/MKE,1.0 + (US%L_to_m*G%dyCv(i,j))**2/L_def**2)) - uDml(I) = timescale * G%mask2dCu(I,j)*G%dyCu(I,j)* & + uDml(I) = timescale * G%mask2dCu(I,j)*US%L_to_m*G%dyCu(I,j)* & G%IdxCu(I,j)*(Rml_av(i+1,j)-Rml_av(i,j)) * (h_vel**2 * GV%Z_to_H) if (uDml(I) == 0) then @@ -712,7 +712,7 @@ subroutine mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, dt, G, GV, US, CS) timescale = timescale * CS%ml_restrat_coef ! timescale = timescale*(2?)*(L_def/L_MLI)*min(EKE/MKE,1.0 + (US%L_to_m*G%dyCv(i,j))**2/L_def**2)) - vDml(i) = timescale * G%mask2dCv(i,J)*G%dxCv(i,J)* & + vDml(i) = timescale * G%mask2dCv(i,J)*US%L_to_m*G%dxCv(i,J)* & G%IdyCv(i,J)*(Rml_av(i,j+1)-Rml_av(i,j)) * (h_vel**2 * GV%Z_to_H) if (vDml(i) == 0) then do k=1,nkml ; vhml(i,J,k) = 0.0 ; enddo diff --git a/src/user/Kelvin_initialization.F90 b/src/user/Kelvin_initialization.F90 index 60fd96d900..0b1eba8d0f 100644 --- a/src/user/Kelvin_initialization.F90 +++ b/src/user/Kelvin_initialization.F90 @@ -274,7 +274,7 @@ subroutine Kelvin_set_OBC_data(OBC, CS, G, GV, US, h, Time) exp(- lambda * y) * cos(PI * CS%mode * (k - 0.5) / nz) * & cos(omega * time_sec) segment%normal_trans(I,j,k) = segment%normal_vel(I,j,k) * & - h(i+1,j,k) * G%dyCu(I,j) + h(i+1,j,k) * G%US%L_to_m*G%dyCu(I,j) enddo endif endif @@ -330,7 +330,7 @@ subroutine Kelvin_set_OBC_data(OBC, CS, G, GV, US, h, Time) segment%normal_vel(i,J,k) = fac * lambda / CS%F_0 * & exp(- lambda * y) * cos(PI * CS%mode * (k - 0.5) / nz) * cosa segment%normal_trans(i,J,k) = segment%normal_vel(i,J,k) * & - h(i,j+1,k) * G%dxCv(i,J) + h(i,j+1,k) * G%US%L_to_m*G%dxCv(i,J) enddo endif endif diff --git a/src/user/dyed_channel_initialization.F90 b/src/user/dyed_channel_initialization.F90 index 61f8183275..72dfc309e5 100644 --- a/src/user/dyed_channel_initialization.F90 +++ b/src/user/dyed_channel_initialization.F90 @@ -172,7 +172,7 @@ subroutine dyed_channel_update_flow(OBC, CS, G, Time) segment%normal_vel(I,j,k) = flow endif if (segment%specified) then - segment%normal_trans(I,j,k) = flow * G%dyCu(I,j) + segment%normal_trans(I,j,k) = flow * G%US%L_to_m*G%dyCu(I,j) endif enddo ; enddo enddo diff --git a/src/user/supercritical_initialization.F90 b/src/user/supercritical_initialization.F90 index f12378c3d9..0f204b6c6e 100644 --- a/src/user/supercritical_initialization.F90 +++ b/src/user/supercritical_initialization.F90 @@ -58,7 +58,7 @@ subroutine supercritical_set_OBC_data(OBC, G, param_file) segment%normal_vel(I,j,k) = zonal_flow endif if (segment%specified) then - segment%normal_trans(I,j,k) = zonal_flow * G%dyCu(I,j) + segment%normal_trans(I,j,k) = zonal_flow * G%US%L_to_m*G%dyCu(I,j) endif enddo ; enddo enddo diff --git a/src/user/tidal_bay_initialization.F90 b/src/user/tidal_bay_initialization.F90 index 161ad25c11..d84da56f4b 100644 --- a/src/user/tidal_bay_initialization.F90 +++ b/src/user/tidal_bay_initialization.F90 @@ -98,7 +98,7 @@ subroutine tidal_bay_set_OBC_data(OBC, CS, G, h, Time) do j=segment%HI%jsc,segment%HI%jec ; do I=segment%HI%IscB,segment%HI%IecB if (OBC%segnum_u(I,j) /= OBC_NONE) then do k=1,nz - my_area(1,j) = my_area(1,j) + h(I,j,k)*G%dyCu(I,j) + my_area(1,j) = my_area(1,j) + h(I,j,k)*G%US%L_to_m*G%dyCu(I,j) enddo endif enddo ; enddo From 013b9088105b2151619b4b21b98072c18c3301d3 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sun, 4 Aug 2019 06:18:43 -0400 Subject: [PATCH 149/297] +Rescaled the units of G%dxBu and G%dyBu Rescaled G%dxBu and G%dyBu throughout the MOM6 code to units of [L]. All answers are bitwise identical, but the units of two elements a public type have changed. --- src/core/MOM_CoriolisAdv.F90 | 8 ++--- src/core/MOM_grid.F90 | 26 +++++++-------- src/framework/MOM_dyn_horgrid.F90 | 22 ++++++------- src/initialization/MOM_grid_initialize.F90 | 32 ++++++++----------- .../MOM_shared_initialization.F90 | 4 +-- .../lateral/MOM_hor_visc.F90 | 20 ++++++------ .../lateral/MOM_internal_tides.F90 | 4 +-- .../lateral/MOM_lateral_mixing_coeffs.F90 | 4 +-- 8 files changed, 58 insertions(+), 62 deletions(-) diff --git a/src/core/MOM_CoriolisAdv.F90 b/src/core/MOM_CoriolisAdv.F90 index 96a28fc6f5..2cce10933d 100644 --- a/src/core/MOM_CoriolisAdv.F90 +++ b/src/core/MOM_CoriolisAdv.F90 @@ -301,9 +301,9 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS) enddo ; endif if (OBC%specified_vorticity) then ; do I=OBC%segment(n)%HI%IsdB,OBC%segment(n)%HI%IedB if (OBC%segment(n)%direction == OBC_DIRECTION_N) then - dudy(I,J) = OBC%segment(n)%tangential_grad(I,J,k)*US%L_to_m*G%dxCu(I,j)*G%dyBu(I,J) + dudy(I,J) = US%L_to_m**2*OBC%segment(n)%tangential_grad(I,J,k)*G%dxCu(I,j)*G%dyBu(I,J) else ! (OBC%segment(n)%direction == OBC_DIRECTION_S) - dudy(I,J) = OBC%segment(n)%tangential_grad(I,J,k)*US%L_to_m*G%dxCu(I,j+1)*G%dyBu(I,J) + dudy(I,J) = US%L_to_m**2*OBC%segment(n)%tangential_grad(I,J,k)*G%dxCu(I,j+1)*G%dyBu(I,J) endif enddo ; endif @@ -341,9 +341,9 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS) enddo ; endif if (OBC%specified_vorticity) then ; do J=OBC%segment(n)%HI%JsdB,OBC%segment(n)%HI%JedB if (OBC%segment(n)%direction == OBC_DIRECTION_E) then - dvdx(I,J) = OBC%segment(n)%tangential_grad(I,J,k)*US%L_to_m*G%dyCv(i,J)*G%dxBu(I,J) + dvdx(I,J) = US%L_to_m**2*OBC%segment(n)%tangential_grad(I,J,k)*G%dyCv(i,J)*G%dxBu(I,J) else ! (OBC%segment(n)%direction == OBC_DIRECTION_W) - dvdx(I,J) = OBC%segment(n)%tangential_grad(I,J,k)*US%L_to_m*G%dyCv(i+1,J)*G%dxBu(I,J) + dvdx(I,J) = US%L_to_m**2*OBC%segment(n)%tangential_grad(I,J,k)*G%dyCv(i+1,J)*G%dxBu(I,J) endif enddo ; endif diff --git a/src/core/MOM_grid.F90 b/src/core/MOM_grid.F90 index b65e5200f8..9e17faf006 100644 --- a/src/core/MOM_grid.F90 +++ b/src/core/MOM_grid.F90 @@ -74,14 +74,14 @@ module MOM_grid !! set_first_direction. real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: & - mask2dT, & !< 0 for land points and 1 for ocean points on the h-grid. Nd. + mask2dT, & !< 0 for land points and 1 for ocean points on the h-grid [nondim]. geoLatT, & !< The geographic latitude at q points in degrees of latitude or m. geoLonT, & !< The geographic longitude at q points in degrees of longitude or m. dxT, & !< dxT is delta x at h points [L ~> m]. IdxT, & !< 1/dxT [m-1]. dyT, & !< dyT is delta y at h points [L ~> m]. IdyT, & !< IdyT is 1/dyT [m-1]. - areaT, & !< The area of an h-cell [m2]. + areaT, & !< The area of an h-cell [L2 ~> m2]. IareaT, & !< 1/areaT [L-2 ~> m-2]. sin_rot, & !< The sine of the angular rotation between the local model grid's northward !! and the true northward directions. @@ -89,7 +89,7 @@ module MOM_grid !! and the true northward directions. real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_) :: & - mask2dCu, & !< 0 for boundary points and 1 for ocean points on the u grid. Nondim. + mask2dCu, & !< 0 for boundary points and 1 for ocean points on the u grid [nondim]. geoLatCu, & !< The geographic latitude at u points in degrees of latitude or m. geoLonCu, & !< The geographic longitude at u points in degrees of longitude or m. dxCu, & !< dxCu is delta x at u points [L ~> m]. @@ -98,10 +98,10 @@ module MOM_grid IdyCu, & !< 1/dyCu [m-1]. dy_Cu, & !< The unblocked lengths of the u-faces of the h-cell [L ~> m]. IareaCu, & !< The masked inverse areas of u-grid cells [L-2 ~> m-2]. - areaCu !< The areas of the u-grid cells [m2]. + areaCu !< The areas of the u-grid cells [L2 ~> m2]. real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_) :: & - mask2dCv, & !< 0 for boundary points and 1 for ocean points on the v grid. Nondim. + mask2dCv, & !< 0 for boundary points and 1 for ocean points on the v grid [nondim]. geoLatCv, & !< The geographic latitude at v points in degrees of latitude or m. geoLonCv, & !< The geographic longitude at v points in degrees of longitude or m. dxCv, & !< dxCv is delta x at v points [L ~> m]. @@ -110,17 +110,17 @@ module MOM_grid IdyCv, & !< 1/dyCv [m-1]. dx_Cv, & !< The unblocked lengths of the v-faces of the h-cell [L ~> m]. IareaCv, & !< The masked inverse areas of v-grid cells [L-2 ~> m-2]. - areaCv !< The areas of the v-grid cells [m2]. + areaCv !< The areas of the v-grid cells [L2 ~> m2]. real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEMB_PTR_) :: & - mask2dBu, & !< 0 for boundary points and 1 for ocean points on the q grid. Nondim. + mask2dBu, & !< 0 for boundary points and 1 for ocean points on the q grid [nondim]. geoLatBu, & !< The geographic latitude at q points in degrees of latitude or m. geoLonBu, & !< The geographic longitude at q points in degrees of longitude or m. - dxBu, & !< dxBu is delta x at q points [m]. + dxBu, & !< dxBu is delta x at q points [L ~> m]. IdxBu, & !< 1/dxBu [m-1]. - dyBu, & !< dyBu is delta y at q points [m]. + dyBu, & !< dyBu is delta y at q points [L ~> m]. IdyBu, & !< 1/dyBu [m-1]. - areaBu, & !< areaBu is the area of a q-cell [m2] + areaBu, & !< areaBu is the area of a q-cell [L2 ~> m2] IareaBu !< IareaBu = 1/areaBu [L-2 ~> m-2]. real, pointer, dimension(:) :: & @@ -446,10 +446,10 @@ subroutine set_derived_metrics(G, US) if (G%dxBu(I,J) < 0.0) G%dxBu(I,J) = 0.0 if (G%dyBu(I,J) < 0.0) G%dyBu(I,J) = 0.0 - G%IdxBu(I,J) = Adcroft_reciprocal(G%dxBu(I,J)) - G%IdyBu(I,J) = Adcroft_reciprocal(G%dyBu(I,J)) + G%IdxBu(I,J) = Adcroft_reciprocal(US%L_to_m*G%dxBu(I,J)) + G%IdyBu(I,J) = Adcroft_reciprocal(US%L_to_m*G%dyBu(I,J)) ! areaBu has usually been set to a positive area elsewhere. - if (G%areaBu(I,J) <= 0.0) G%areaBu(I,J) = US%m_to_L*G%dxBu(I,J) * US%m_to_L*G%dyBu(I,J) + if (G%areaBu(I,J) <= 0.0) G%areaBu(I,J) = G%dxBu(I,J) * G%dyBu(I,J) G%IareaBu(I,J) = Adcroft_reciprocal(G%areaBu(I,J)) enddo ; enddo end subroutine set_derived_metrics diff --git a/src/framework/MOM_dyn_horgrid.F90 b/src/framework/MOM_dyn_horgrid.F90 index 5e533e0f05..3883dc9011 100644 --- a/src/framework/MOM_dyn_horgrid.F90 +++ b/src/framework/MOM_dyn_horgrid.F90 @@ -75,8 +75,8 @@ module MOM_dyn_horgrid IdxT, & !< 1/dxT [m-1]. dyT, & !< dyT is delta y at h points [L ~> m]. IdyT, & !< IdyT is 1/dyT [m-1]. - areaT, & !< The area of an h-cell [L-2 ~> m-2]. - IareaT !< 1/areaT [m-2]. + areaT, & !< The area of an h-cell [L2 ~> m2]. + IareaT !< 1/areaT [L-2 ~> m-2]. real, allocatable, dimension(:,:) :: sin_rot !< The sine of the angular rotation between the local model grid's northward !! and the true northward directions [nondim]. @@ -94,7 +94,7 @@ module MOM_dyn_horgrid IdyCu, & !< 1/dyCu [m-1]. dy_Cu, & !< The unblocked lengths of the u-faces of the h-cell [L ~> m]. IareaCu, & !< The masked inverse areas of u-grid cells [L-2 ~> m-2]. - areaCu !< The areas of the u-grid cells [m2]. + areaCu !< The areas of the u-grid cells [L2 ~> m2]. real, allocatable, dimension(:,:) :: & mask2dCv, & !< 0 for boundary points and 1 for ocean points on the v grid [nondim]. @@ -106,18 +106,18 @@ module MOM_dyn_horgrid IdyCv, & !< 1/dyCv [m-1]. dx_Cv, & !< The unblocked lengths of the v-faces of the h-cell [L ~> m]. IareaCv, & !< The masked inverse areas of v-grid cells [L-2 ~> m-2]. - areaCv !< The areas of the v-grid cells [m2]. + areaCv !< The areas of the v-grid cells [L2 ~> m2]. real, allocatable, dimension(:,:) :: & mask2dBu, & !< 0 for boundary points and 1 for ocean points on the q grid [nondim]. geoLatBu, & !< The geographic latitude at q points [degrees of latitude] or [m]. geoLonBu, & !< The geographic longitude at q points [degrees of longitude] or [m]. - dxBu, & !< dxBu is delta x at q points [m]. + dxBu, & !< dxBu is delta x at q points [L ~> m]. IdxBu, & !< 1/dxBu [m-1]. - dyBu, & !< dyBu is delta y at q points [m]. + dyBu, & !< dyBu is delta y at q points [L ~> m]. IdyBu, & !< 1/dyBu [m-1]. - areaBu, & !< areaBu is the area of a q-cell [L-2 ~> m-2] - IareaBu !< IareaBu = 1/areaBu [m-2]. + areaBu, & !< areaBu is the area of a q-cell [L ~> m] + IareaBu !< IareaBu = 1/areaBu [L-2 ~> m-2]. real, pointer, dimension(:) :: gridLatT => NULL() !< The latitude of T points for the purpose of labeling the output axes. @@ -354,10 +354,10 @@ subroutine set_derived_dyn_horgrid(G, US) if (G%dxBu(I,J) < 0.0) G%dxBu(I,J) = 0.0 if (G%dyBu(I,J) < 0.0) G%dyBu(I,J) = 0.0 - G%IdxBu(I,J) = Adcroft_reciprocal(G%dxBu(I,J)) - G%IdyBu(I,J) = Adcroft_reciprocal(G%dyBu(I,J)) + G%IdxBu(I,J) = Adcroft_reciprocal(L_to_m*G%dxBu(I,J)) + G%IdyBu(I,J) = Adcroft_reciprocal(L_to_m*G%dyBu(I,J)) ! areaBu has usually been set to a positive area elsewhere. - if (G%areaBu(I,J) <= 0.0) G%areaBu(I,J) = m_to_L*G%dxBu(I,J) * m_to_L*G%dyBu(I,J) + if (G%areaBu(I,J) <= 0.0) G%areaBu(I,J) = G%dxBu(I,J) * G%dyBu(I,J) G%IareaBu(I,J) = Adcroft_reciprocal(G%areaBu(I,J)) enddo ; enddo diff --git a/src/initialization/MOM_grid_initialize.F90 b/src/initialization/MOM_grid_initialize.F90 index bba879eec7..28a01d6e68 100644 --- a/src/initialization/MOM_grid_initialize.F90 +++ b/src/initialization/MOM_grid_initialize.F90 @@ -125,15 +125,13 @@ subroutine grid_metrics_chksum(parent, G, US) halo = min(G%ied-G%iec, G%jed-G%jec, 1) - call hchksum_pair(trim(parent)//': d[xy]T', & - G%dxT, G%dyT, G%HI, haloshift=halo, scale=L_to_m) + call hchksum_pair(trim(parent)//': d[xy]T', G%dxT, G%dyT, G%HI, haloshift=halo, scale=L_to_m) call uvchksum(trim(parent)//': dxC[uv]', G%dxCu, G%dyCv, G%HI, haloshift=halo, scale=L_to_m) call uvchksum(trim(parent)//': dxC[uv]', G%dyCu, G%dxCv, G%HI, haloshift=halo, scale=L_to_m) - call Bchksum_pair(trim(parent)//': dxB[uv]', & - G%dxBu, G%dyBu, G%HI, haloshift=halo) + call Bchksum_pair(trim(parent)//': dxB[uv]', G%dxBu, G%dyBu, G%HI, haloshift=halo, scale=L_to_m) call hchksum_pair(trim(parent)//': Id[xy]T', & G%IdxT, G%IdyT, G%HI, haloshift=halo) @@ -159,11 +157,9 @@ subroutine grid_metrics_chksum(parent, G, US) call Bchksum(G%geoLonBu, trim(parent)//': geoLonBu',G%HI, haloshift=halo) call Bchksum(G%geoLatBu, trim(parent)//': geoLatBu',G%HI, haloshift=halo) - call uvchksum(trim(parent)//': geoLonC[uv]', & - G%geoLonCu, G%geoLonCv, G%HI, haloshift=halo) + call uvchksum(trim(parent)//': geoLonC[uv]', G%geoLonCu, G%geoLonCv, G%HI, haloshift=halo) - call uvchksum(trim(parent)//': geoLatC[uv]', & - G%geoLatCu, G%geoLatCv, G%HI, haloshift=halo) + call uvchksum(trim(parent)//': geoLatC[uv]', G%geoLatCu, G%geoLatCv, G%HI, haloshift=halo) end subroutine grid_metrics_chksum @@ -371,7 +367,7 @@ subroutine set_grid_metrics_from_mosaic(G, param_file, US) G%dxCv(i,J) = m_to_L*dxCv(i,J) ; G%dyCv(i,J) = m_to_L*dyCv(i,J) enddo ; enddo do I=G%IsdB,G%IedB ; do J=G%JsdB,G%JedB - G%dxBu(I,J) = dxBu(I,J) ; G%dyBu(I,J) = dyBu(I,J) ; G%areaBu(I,J) = m_to_L**2*areaBu(I,J) + G%dxBu(I,J) = m_to_L*dxBu(I,J) ; G%dyBu(I,J) = m_to_L*dyBu(I,J) ; G%areaBu(I,J) = m_to_L**2*areaBu(I,J) enddo ; enddo ! Construct axes for diagnostic output (only necessary because "ferret" uses @@ -522,8 +518,8 @@ subroutine set_grid_metrics_cartesian(G, param_file, US) do J=JsdB,JedB ; do I=IsdB,IedB G%geoLonBu(I,J) = grid_lonB(I) ; G%geoLatBu(I,J) = grid_latB(J) - G%dxBu(I,J) = dx_everywhere ; G%IdxBu(I,J) = I_dx - G%dyBu(I,J) = dy_everywhere ; G%IdyBu(I,J) = I_dy + G%dxBu(I,J) = m_to_L*dx_everywhere ; G%IdxBu(I,J) = I_dx + G%dyBu(I,J) = m_to_L*dy_everywhere ; G%IdyBu(I,J) = I_dy G%areaBu(I,J) = m_to_L**2*dx_everywhere * dy_everywhere ; G%IareaBu(I,J) = L_to_m**2*I_dx * I_dy enddo ; enddo @@ -645,10 +641,10 @@ subroutine set_grid_metrics_spherical(G, param_file, US) ! The following line is needed to reproduce the solution from ! set_grid_metrics_mercator when used to generate a simple spherical grid. - G%dxBu(I,J) = G%Rad_Earth * COS( G%geoLatBu(I,J)*PI_180 ) * dL_di -! G%dxBu(I,J) = G%Rad_Earth * dLon*PI_180 * COS( G%geoLatBu(I,J)*PI_180 ) - G%dyBu(I,J) = G%Rad_Earth * dLat*PI_180 - G%areaBu(I,J) = m_to_L**2 * G%dxBu(I,J) * G%dyBu(I,J) + G%dxBu(I,J) = m_to_L*G%Rad_Earth * COS( G%geoLatBu(I,J)*PI_180 ) * dL_di +! G%dxBu(I,J) = m_to_L*G%Rad_Earth * dLon*PI_180 * COS( G%geoLatBu(I,J)*PI_180 ) + G%dyBu(I,J) = m_to_L*G%Rad_Earth * dLat*PI_180 + G%areaBu(I,J) = G%dxBu(I,J) * G%dyBu(I,J) enddo ; enddo do J=JsdB,JedB ; do i=isd,ied @@ -871,10 +867,10 @@ subroutine set_grid_metrics_mercator(G, param_file, US) do J=JsdB,JedB ; do I=IsdB,IedB G%geoLonBu(I,J) = xq(I,J)*180.0/PI G%geoLatBu(I,J) = yq(I,J)*180.0/PI - G%dxBu(I,J) = ds_di(xq(I,J), yq(I,J), GP) - G%dyBu(I,J) = ds_dj(xq(I,J), yq(I,J), GP) + G%dxBu(I,J) = m_to_L*ds_di(xq(I,J), yq(I,J), GP) + G%dyBu(I,J) = m_to_L*ds_dj(xq(I,J), yq(I,J), GP) - G%areaBu(I,J) = m_to_L**2*G%dxBu(I,J) * G%dyBu(I,J) + G%areaBu(I,J) = G%dxBu(I,J) * G%dyBu(I,J) G%IareaBu(I,J) = 1.0 / (G%areaBu(I,J)) enddo ; enddo diff --git a/src/initialization/MOM_shared_initialization.F90 b/src/initialization/MOM_shared_initialization.F90 index 9a6ecde5d8..cb93a0d589 100644 --- a/src/initialization/MOM_shared_initialization.F90 +++ b/src/initialization/MOM_shared_initialization.F90 @@ -1294,9 +1294,9 @@ subroutine write_ocean_geometry_file(G, param_file, directory, geom_file, US) do j=js,je ; do i=is,ie ; out_h(i,j) = L_to_m_scale*G%dyT(i,j) ; enddo ; enddo call write_field(unit, fields(12), G%Domain%mpp_domain, out_h) - do J=Jsq,Jeq ; do I=Isq,Ieq ; out_q(i,J) = G%dxBu(I,J) ; enddo ; enddo + do J=Jsq,Jeq ; do I=Isq,Ieq ; out_q(i,J) = L_to_m_scale*G%dxBu(I,J) ; enddo ; enddo call write_field(unit, fields(13), G%Domain%mpp_domain, out_q) - do J=Jsq,Jeq ; do I=Isq,Ieq ; out_q(I,J) = G%dyBu(I,J) ; enddo ; enddo + do J=Jsq,Jeq ; do I=Isq,Ieq ; out_q(I,J) = L_to_m_scale*G%dyBu(I,J) ; enddo ; enddo call write_field(unit, fields(14), G%Domain%mpp_domain, out_q) do j=js,je ; do i=is,ie ; out_h(i,j) = G%areaT(i,j) ; enddo ; enddo diff --git a/src/parameterizations/lateral/MOM_hor_visc.F90 b/src/parameterizations/lateral/MOM_hor_visc.F90 index 9382fd84fa..3a2e7a06ca 100644 --- a/src/parameterizations/lateral/MOM_hor_visc.F90 +++ b/src/parameterizations/lateral/MOM_hor_visc.F90 @@ -580,9 +580,9 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, endif elseif (OBC%specified_strain) then if (OBC%segment(n)%direction == OBC_DIRECTION_N) then - dudy(I,J) = CS%DX_dyBu(I,J)*OBC%segment(n)%tangential_grad(I,J,k)*G%IdxCu(I,j)*G%dxBu(I,J) + dudy(I,J) = CS%DX_dyBu(I,J)*OBC%segment(n)%tangential_grad(I,J,k)*G%IdxCu(I,j)*US%L_to_m*G%dxBu(I,J) else - dudy(I,J) = CS%DX_dyBu(I,J)*OBC%segment(n)%tangential_grad(I,J,k)*G%IdxCu(I,j+1)*G%dxBu(I,J) + dudy(I,J) = CS%DX_dyBu(I,J)*OBC%segment(n)%tangential_grad(I,J,k)*G%IdxCu(I,j+1)*US%L_to_m*G%dxBu(I,J) endif endif enddo @@ -600,9 +600,9 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, endif elseif (OBC%specified_strain) then if (OBC%segment(n)%direction == OBC_DIRECTION_E) then - dvdx(I,J) = CS%DY_dxBu(I,J)*OBC%segment(n)%tangential_grad(I,J,k)*G%IdyCv(i,J)*G%dxBu(I,J) + dvdx(I,J) = CS%DY_dxBu(I,J)*OBC%segment(n)%tangential_grad(I,J,k)*G%IdyCv(i,J)*US%L_to_m*G%dxBu(I,J) else - dvdx(I,J) = CS%DY_dxBu(I,J)*OBC%segment(n)%tangential_grad(I,J,k)*G%IdyCv(i+1,J)*G%dxBu(I,J) + dvdx(I,J) = CS%DY_dxBu(I,J)*OBC%segment(n)%tangential_grad(I,J,k)*G%IdyCv(i+1,J)*US%L_to_m*G%dxBu(I,J) endif endif enddo @@ -713,9 +713,9 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, ! We will consider using a circulation based calculation of vorticity later. ! Also note this will need OBC boundary conditions re-applied... do J=js-2,Jeq+1 ; do I=is-2,Ieq+1 - DY_dxBu = G%dyBu(I,J) * G%IdxBu(I,J) + DY_dxBu = US%L_to_m*G%dyBu(I,J) * G%IdxBu(I,J) dvdx(I,J) = DY_dxBu * (v(i+1,J,k) * G%IdyCv(i+1,J) - v(i,J,k) * G%IdyCv(i,J)) - DX_dyBu = G%dxBu(I,J) * G%IdyBu(I,J) + DX_dyBu = US%L_to_m*G%dxBu(I,J) * G%IdyBu(I,J) dudy(I,J) = DX_dyBu * (u(I,j+1,k) * G%IdxCu(I,j+1) - u(I,j,k) * G%IdxCu(I,j)) enddo ; enddo @@ -738,12 +738,12 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, ! Vorticity gradient do J=js-2,Jeq+1 ; do i=is-1,Ieq+1 - DY_dxBu = G%dyBu(I,J) * G%IdxBu(I,J) + DY_dxBu = US%L_to_m*G%dyBu(I,J) * G%IdxBu(I,J) vort_xy_dx(i,J) = DY_dxBu * (vort_xy(I,J) * G%IdyCu(I,j) - vort_xy(I-1,J) * G%IdyCu(I-1,j)) enddo ; enddo do j=js-1,Jeq+1 ; do I=is-2,Ieq+1 - DX_dyBu = G%dxBu(I,J) * G%IdyBu(I,J) + DX_dyBu = US%L_to_m*G%dxBu(I,J) * G%IdyBu(I,J) vort_xy_dy(I,j) = DX_dyBu * (vort_xy(I,J) * G%IdxCv(i,J) - vort_xy(I,J-1) * G%IdxCv(i,J-1)) enddo ; enddo @@ -1865,8 +1865,8 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS, MEKE) endif do J=js-2,Jeq+1 ; do I=is-2,Ieq+1 - CS%DX2q(I,J) = G%dxBu(I,J)*G%dxBu(I,J) ; CS%DY2q(I,J) = G%dyBu(I,J)*G%dyBu(I,J) - CS%DX_dyBu(I,J) = G%dxBu(I,J)*G%IdyBu(I,J) ; CS%DY_dxBu(I,J) = G%dyBu(I,J)*G%IdxBu(I,J) + CS%DX2q(I,J) = US%L_to_m**2*G%dxBu(I,J)*G%dxBu(I,J) ; CS%DY2q(I,J) = US%L_to_m**2*G%dyBu(I,J)*G%dyBu(I,J) + CS%DX_dyBu(I,J) = US%L_to_m*G%dxBu(I,J)*G%IdyBu(I,J) ; CS%DY_dxBu(I,J) = US%L_to_m*G%dyBu(I,J)*G%IdxBu(I,J) enddo ; enddo do j=Jsq-1,Jeq+2 ; do i=Isq-1,Ieq+2 CS%DX2h(i,j) = US%L_to_m**2*G%dxT(i,j)*G%dxT(i,j) ; CS%DY2h(i,j) = US%L_to_m**2*G%dyT(i,j)*G%dyT(i,j) diff --git a/src/parameterizations/lateral/MOM_internal_tides.F90 b/src/parameterizations/lateral/MOM_internal_tides.F90 index b2b63f90ac..f488316592 100644 --- a/src/parameterizations/lateral/MOM_internal_tides.F90 +++ b/src/parameterizations/lateral/MOM_internal_tides.F90 @@ -1125,8 +1125,8 @@ subroutine propagate_corner_spread(En, energized_wedge, NAngle, speed, dt, G, CS !energized_angle = Angle_size * real(energized_wedge - 1) + 0.5*Angle_size ! x = G%geoLonBu y = G%geoLatBu - Idx = G%IdxBu; dx = G%dxBu - Idy = G%IdyBu; dy = G%dyBu + Idx = G%IdxBu; dx = G%US%L_to_m*G%dxBu + Idy = G%IdyBu; dy = G%US%L_to_m*G%dyBu do j=jsh,jeh; do i=ish,ieh do m=1,int(Nsubrays) diff --git a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 index d4b0b88313..a2a8a7b682 100644 --- a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 +++ b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 @@ -1118,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) = ((G%dxBu(I,J))**2 + (G%dyBu(I,J))**2) * & + CS%f2_dx2_q(I,J) = US%L_to_m**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) * (sqrt(0.5 * & + CS%beta_dx2_q(I,J) = oneOrTwo * US%L_to_m**2*((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 + & From dc6c85b3d0269214af3b13d3f6f13aff0b3a5d0d Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sun, 4 Aug 2019 06:51:57 -0400 Subject: [PATCH 150/297] +Rescaled the units of G%IdxBu and G%IdyBu Rescaled G%IdxBu and G%IdyBu throughout the MOM6 code to units of [L-1]. All answers are bitwise identical, but the units of two elements a public type have changed. --- src/core/MOM_grid.F90 | 8 +- src/core/MOM_open_boundary.F90 | 88 +++++++++---------- src/framework/MOM_dyn_horgrid.F90 | 8 +- src/initialization/MOM_grid_initialize.F90 | 7 +- .../lateral/MOM_hor_visc.F90 | 42 ++++----- .../lateral/MOM_internal_tides.F90 | 4 +- 6 files changed, 78 insertions(+), 79 deletions(-) diff --git a/src/core/MOM_grid.F90 b/src/core/MOM_grid.F90 index 9e17faf006..0c736d56f0 100644 --- a/src/core/MOM_grid.F90 +++ b/src/core/MOM_grid.F90 @@ -117,9 +117,9 @@ module MOM_grid geoLatBu, & !< The geographic latitude at q points in degrees of latitude or m. geoLonBu, & !< The geographic longitude at q points in degrees of longitude or m. dxBu, & !< dxBu is delta x at q points [L ~> m]. - IdxBu, & !< 1/dxBu [m-1]. + IdxBu, & !< 1/dxBu [L-1 ~> m-1]. dyBu, & !< dyBu is delta y at q points [L ~> m]. - IdyBu, & !< 1/dyBu [m-1]. + IdyBu, & !< 1/dyBu [L-1 ~> m-1]. areaBu, & !< areaBu is the area of a q-cell [L2 ~> m2] IareaBu !< IareaBu = 1/areaBu [L-2 ~> m-2]. @@ -446,8 +446,8 @@ subroutine set_derived_metrics(G, US) if (G%dxBu(I,J) < 0.0) G%dxBu(I,J) = 0.0 if (G%dyBu(I,J) < 0.0) G%dyBu(I,J) = 0.0 - G%IdxBu(I,J) = Adcroft_reciprocal(US%L_to_m*G%dxBu(I,J)) - G%IdyBu(I,J) = Adcroft_reciprocal(US%L_to_m*G%dyBu(I,J)) + G%IdxBu(I,J) = Adcroft_reciprocal(G%dxBu(I,J)) + G%IdyBu(I,J) = Adcroft_reciprocal(G%dyBu(I,J)) ! areaBu has usually been set to a positive area elsewhere. if (G%areaBu(I,J) <= 0.0) G%areaBu(I,J) = G%dxBu(I,J) * G%dyBu(I,J) G%IareaBu(I,J) = Adcroft_reciprocal(G%areaBu(I,J)) diff --git a/src/core/MOM_open_boundary.F90 b/src/core/MOM_open_boundary.F90 index 078a915871..5689d48231 100644 --- a/src/core/MOM_open_boundary.F90 +++ b/src/core/MOM_open_boundary.F90 @@ -1698,16 +1698,16 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) do k=1,nz ; do J=Js_obc,Je_obc rx_avg = rx_tangential(I,J,k) ! if (G%mask2dCu(I-1,j) > 0.0 .and. G%mask2dCu(I-1,j+1) > 0.0) then -! rx_avg = 0.5*(u_new(I-1,j,k) + u_new(I-1,j+1,k))*dt*G%IdxBu(I-1,J) +! rx_avg = 0.5*(u_new(I-1,j,k) + u_new(I-1,j+1,k))*dt*G%US%m_to_L*G%IdxBu(I-1,J) ! elseif (G%mask2dCu(I-1,j) > 0.0) then -! rx_avg = u_new(I-1,j,k)*dt*G%IdxBu(I-1,J) +! rx_avg = u_new(I-1,j,k)*dt*G%US%m_to_L*G%IdxBu(I-1,J) ! elseif (G%mask2dCu(I-1,j+1) > 0.0) then -! rx_avg = u_new(I-1,j+1,k)*dt*G%IdxBu(I-1,J) +! rx_avg = u_new(I-1,j+1,k)*dt*G%US%m_to_L*G%IdxBu(I-1,J) ! else ! rx_avg = 0.0 ! endif - segment%tangential_grad(I,J,k) = ((v_new(i,J,k) - v_new(i-1,J,k))*G%IdxBu(I-1,J) + & - rx_avg*(v_new(i-1,J,k) - v_new(i-2,J,k))*G%IdxBu(I-2,J)) / (1.0+rx_avg) + segment%tangential_grad(I,J,k) = ((v_new(i,J,k) - v_new(i-1,J,k))*G%US%m_to_L*G%IdxBu(I-1,J) + & + rx_avg*(v_new(i-1,J,k) - v_new(i-2,J,k))*G%US%m_to_L*G%IdxBu(I-2,J)) / (1.0+rx_avg) enddo ; enddo endif if (segment%nudged_grad) then @@ -1773,8 +1773,8 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) rx_avg = rx_tangential(I,J,k) ry_avg = ry_tangential(I,J,k) cff_avg = cff_tangential(I,J,k) - segment%tangential_grad(I,J,k) = ((cff_avg*(v_new(i,J,k) - v_new(i-1,J,k))*G%IdxBu(I-1,J) & - + rx_avg*(v_new(i-1,J,k) - v_new(i-2,J,k))*G%IdxBu(I-2,J)) - & + segment%tangential_grad(I,J,k) = ((cff_avg*(v_new(i,J,k) - v_new(i-1,J,k))*G%US%m_to_L*G%IdxBu(I-1,J) & + + rx_avg*(v_new(i-1,J,k) - v_new(i-2,J,k))*G%US%m_to_L*G%IdxBu(I-2,J)) - & (max(ry_avg,0.0)*segment%grad_gradient(J,2,k) + min(ry_avg,0.0)*segment%grad_gradient(J+1,2,k))) / & (cff_avg + rx_avg) enddo ; enddo @@ -1894,16 +1894,16 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) do k=1,nz ; do J=Js_obc,Je_obc rx_avg = rx_tangential(I,J,k) ! if (G%mask2dCu(I+1,j) > 0.0 .and. G%mask2dCu(I+1,j+1) > 0.0) then -! rx_avg = 0.5*(u_new(I+1,j,k) + u_new(I+1,j+1,k))*dt*G%IdxBu(I+1,J) +! rx_avg = 0.5*(u_new(I+1,j,k) + u_new(I+1,j+1,k))*dt*G%US%m_to_L*G%IdxBu(I+1,J) ! elseif (G%mask2dCu(I+1,j) > 0.0) then -! rx_avg = u_new(I+1,j,k)*dt*G%IdxBu(I+1,J) +! rx_avg = u_new(I+1,j,k)*dt*G%US%m_to_L*G%IdxBu(I+1,J) ! elseif (G%mask2dCu(I+1,j+1) > 0.0) then -! rx_avg = u_new(I+1,j+1,k)*dt*G%IdxBu(I+1,J) +! rx_avg = u_new(I+1,j+1,k)*dt*G%US%m_to_L*G%IdxBu(I+1,J) ! else ! rx_avg = 0.0 ! endif - segment%tangential_grad(I,J,k) = ((v_new(i+2,J,k) - v_new(i+1,J,k))*G%IdxBu(I+1,J) + & - rx_avg*(v_new(i+3,J,k) - v_new(i+2,J,k))*G%IdxBu(I+2,J)) / (1.0+rx_avg) + segment%tangential_grad(I,J,k) = ((v_new(i+2,J,k) - v_new(i+1,J,k))*G%US%m_to_L*G%IdxBu(I+1,J) + & + rx_avg*(v_new(i+3,J,k) - v_new(i+2,J,k))*G%US%m_to_L*G%IdxBu(I+2,J)) / (1.0+rx_avg) enddo ; enddo endif if (segment%nudged_grad) then @@ -1969,8 +1969,8 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) rx_avg = rx_tangential(I,J,k) ry_avg = ry_tangential(I,J,k) cff_avg = cff_tangential(I,J,k) - segment%tangential_grad(I,J,k) = ((cff_avg*(v_new(i+2,J,k) - v_new(i+1,J,k))*G%IdxBu(I+1,J) & - + rx_avg*(v_new(i+3,J,k) - v_new(i+2,J,k))*G%IdxBu(I+2,J)) - & + segment%tangential_grad(I,J,k) = ((cff_avg*(v_new(i+2,J,k) - v_new(i+1,J,k))*G%US%m_to_L*G%IdxBu(I+1,J) & + + rx_avg*(v_new(i+3,J,k) - v_new(i+2,J,k))*G%US%m_to_L*G%IdxBu(I+2,J)) - & (max(ry_avg,0.0)*segment%grad_gradient(J,2,k) + min(ry_avg,0.0)*segment%grad_gradient(J+1,2,k))) / & (cff_avg + rx_avg) enddo ; enddo @@ -2091,16 +2091,16 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) do k=1,nz ; do I=Is_obc,Ie_obc rx_avg = rx_tangential(I,J,k) ! if (G%mask2dCv(i,J-1) > 0.0 .and. G%mask2dCv(i+1,J-1) > 0.0) then -! rx_avg = 0.5*(v_new(i,J-1,k) + v_new(i+1,J-1,k)*dt*G%IdyBu(I,J-1)) +! rx_avg = 0.5*(v_new(i,J-1,k) + v_new(i+1,J-1,k)*dt*G%US%m_to_L*G%IdyBu(I,J-1)) ! elseif (G%mask2dCv(i,J-1) > 0.0) then -! rx_avg = v_new(i,J-1,k)*dt*G%IdyBu(I,J-1) +! rx_avg = v_new(i,J-1,k)*dt*G%US%m_to_L*G%IdyBu(I,J-1) ! elseif (G%mask2dCv(i+1,J-1) > 0.0) then -! rx_avg = v_new(i+1,J-1,k)*dt*G%IdyBu(I,J-1) +! rx_avg = v_new(i+1,J-1,k)*dt*G%US%m_to_L*G%IdyBu(I,J-1) ! else ! rx_avg = 0.0 ! endif - segment%tangential_grad(I,J,k) = ((u_new(I,j,k) - u_new(I,j-1,k))*G%IdyBu(I,J-1) + & - rx_avg*(u_new(I,j-1,k) - u_new(I,j-2,k))*G%IdyBu(I,J-2)) / (1.0+rx_avg) + segment%tangential_grad(I,J,k) = ((u_new(I,j,k) - u_new(I,j-1,k))*G%US%m_to_L*G%IdyBu(I,J-1) + & + rx_avg*(u_new(I,j-1,k) - u_new(I,j-2,k))*G%US%m_to_L*G%IdyBu(I,J-2)) / (1.0+rx_avg) enddo ; enddo endif if (segment%nudged_grad) then @@ -2166,8 +2166,8 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) rx_avg = rx_tangential(I,J,k) ry_avg = ry_tangential(I,J,k) cff_avg = cff_tangential(I,J,k) - segment%tangential_grad(I,J,k) = ((cff_avg*(u_new(I,j,k) - u_new(I,j-1,k))*G%IdyBu(I,J-1) & - + rx_avg*(u_new(I,j-1,k) - u_new(I,j-2,k))*G%IdyBu(I,J-2)) - & + segment%tangential_grad(I,J,k) = ((cff_avg*(u_new(I,j,k) - u_new(I,j-1,k))*G%US%m_to_L*G%IdyBu(I,J-1) & + + rx_avg*(u_new(I,j-1,k) - u_new(I,j-2,k))*G%US%m_to_L*G%IdyBu(I,J-2)) - & (max(ry_avg,0.0)*segment%grad_gradient(I,2,k) + min(ry_avg,0.0)*segment%grad_gradient(I+1,2,k))) / & (cff_avg + rx_avg) enddo ; enddo @@ -2287,16 +2287,16 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) do k=1,nz ; do I=Is_obc,Ie_obc rx_avg = rx_tangential(I,J,k) ! if (G%mask2dCv(i,J+1) > 0.0 .and. G%mask2dCv(i+1,J+1) > 0.0) then -! rx_avg = 0.5*(v_new(i,J+1,k) + v_new(i+1,J+1,k))*dt*G%IdyBu(I,J+1) +! rx_avg = 0.5*(v_new(i,J+1,k) + v_new(i+1,J+1,k))*dt*G%US%m_to_L*G%IdyBu(I,J+1) ! elseif (G%mask2dCv(i,J+1) > 0.0) then -! rx_avg = v_new(i,J+1,k)*dt*G%IdyBu(I,J+1) +! rx_avg = v_new(i,J+1,k)*dt*G%US%m_to_L*G%IdyBu(I,J+1) ! elseif (G%mask2dCv(i+1,J+1) > 0.0) then -! rx_avg = v_new(i+1,J+1,k)*dt*G%IdyBu(I,J+1) +! rx_avg = v_new(i+1,J+1,k)*dt*G%US%m_to_L*G%IdyBu(I,J+1) ! else ! rx_avg = 0.0 ! endif - segment%tangential_grad(I,J,k) = ((u_new(I,j+2,k) - u_new(I,j+1,k))*G%IdyBu(I,J+1) + & - rx_avg*(u_new(I,j+3,k) - u_new(I,j+2,k))*G%IdyBu(I,J+2)) / (1.0+rx_avg) + segment%tangential_grad(I,J,k) = ((u_new(I,j+2,k) - u_new(I,j+1,k))*G%US%m_to_L*G%IdyBu(I,J+1) + & + rx_avg*(u_new(I,j+3,k) - u_new(I,j+2,k))*G%US%m_to_L*G%IdyBu(I,J+2)) / (1.0+rx_avg) enddo ; enddo endif if (segment%nudged_grad) then @@ -2362,8 +2362,8 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) rx_avg = rx_tangential(I,J,k) ry_avg = ry_tangential(I,J,k) cff_avg = cff_tangential(I,J,k) - segment%tangential_grad(I,J,k) = ((cff_avg*(u_new(I,j+2,k) - u_new(I,j+1,k))*G%IdyBu(I,J+1) & - + rx_avg*(u_new(I,j+3,k) - u_new(I,j+2,k))*G%IdyBu(I,J+2)) - & + segment%tangential_grad(I,J,k) = ((cff_avg*(u_new(I,j+2,k) - u_new(I,j+1,k))*G%US%m_to_L*G%IdyBu(I,J+1) & + + rx_avg*(u_new(I,j+3,k) - u_new(I,j+2,k))*G%US%m_to_L*G%IdyBu(I,J+2)) - & (max(ry_avg,0.0)*segment%grad_gradient(i,2,k) + min(ry_avg,0.0)*segment%grad_gradient(i+1,2,k))) / & (cff_avg + rx_avg) enddo ; enddo @@ -2491,10 +2491,10 @@ subroutine gradient_at_q_points(G, segment, uvel, vvel) if (segment%oblique_grad) then do k=1,G%ke do J=max(segment%HI%jsd, G%HI%jsd+1),min(segment%HI%jed, G%HI%jed-1) - segment%grad_gradient(j,1,k) = (((vvel(i-1,J,k) - vvel(i-2,J,k))*G%IdxBu(I-2,J)) - & - (vvel(i-1,J-1,k) - vvel(i-2,J-1,k))*G%IdxBu(I-2,J-1)) * G%mask2dCu(I-1,j) - segment%grad_gradient(j,2,k) = (((vvel(i,J,k) - vvel(i-1,J,k))*G%IdxBu(I-1,J)) - & - (vvel(i,J-1,k) - vvel(i-1,J-1,k))*G%IdxBu(I-1,J-1)) * G%mask2dCu(I,j) + segment%grad_gradient(j,1,k) = (((vvel(i-1,J,k) - vvel(i-2,J,k))*G%US%m_to_L*G%IdxBu(I-2,J)) - & + (vvel(i-1,J-1,k) - vvel(i-2,J-1,k))*G%US%m_to_L*G%IdxBu(I-2,J-1)) * G%mask2dCu(I-1,j) + segment%grad_gradient(j,2,k) = (((vvel(i,J,k) - vvel(i-1,J,k))*G%US%m_to_L*G%IdxBu(I-1,J)) - & + (vvel(i,J-1,k) - vvel(i-1,J-1,k))*G%US%m_to_L*G%IdxBu(I-1,J-1)) * G%mask2dCu(I,j) enddo enddo endif @@ -2517,10 +2517,10 @@ subroutine gradient_at_q_points(G, segment, uvel, vvel) if (segment%oblique_grad) then do k=1,G%ke do J=max(segment%HI%jsd, G%HI%jsd+1),min(segment%HI%jed, G%HI%jed-1) - segment%grad_gradient(j,1,k) = (((vvel(i+3,J,k) - vvel(i+2,J,k))*G%IdxBu(I+2,J)) - & - (vvel(i+3,J-1,k) - vvel(i+2,J-1,k))*G%IdxBu(I+2,J-1)) * G%mask2dCu(I+2,j) - segment%grad_gradient(j,2,k) = (((vvel(i+2,J,k) - vvel(i+1,J,k))*G%IdxBu(I+1,J)) - & - (vvel(i+2,J-1,k) - vvel(i+1,J-1,k))*G%IdxBu(I+1,J-1)) * G%mask2dCu(I+1,j) + segment%grad_gradient(j,1,k) = (((vvel(i+3,J,k) - vvel(i+2,J,k))*G%US%m_to_L*G%IdxBu(I+2,J)) - & + (vvel(i+3,J-1,k) - vvel(i+2,J-1,k))*G%US%m_to_L*G%IdxBu(I+2,J-1)) * G%mask2dCu(I+2,j) + segment%grad_gradient(j,2,k) = (((vvel(i+2,J,k) - vvel(i+1,J,k))*G%US%m_to_L*G%IdxBu(I+1,J)) - & + (vvel(i+2,J-1,k) - vvel(i+1,J-1,k))*G%US%m_to_L*G%IdxBu(I+1,J-1)) * G%mask2dCu(I+1,j) enddo enddo endif @@ -2545,10 +2545,10 @@ subroutine gradient_at_q_points(G, segment, uvel, vvel) if (segment%oblique_grad) then do k=1,G%ke do I=max(segment%HI%isd, G%HI%isd+1),min(segment%HI%ied, G%HI%ied-1) - segment%grad_gradient(i,1,k) = (((uvel(I,j-1,k) - uvel(I,j-2,k))*G%IdxBu(I,J-2)) - & - (uvel(I-1,j-1,k) - uvel(I-1,j-2,k))*G%IdxBu(I-1,J-2)) * G%mask2dCv(I,j-1) - segment%grad_gradient(i,2,k) = (((uvel(I,j,k) - uvel(I,j-1,k))*G%IdyBu(I,J-1)) - & - (uvel(I-1,j,k) - uvel(I-1,j-1,k))*G%IdyBu(I-1,J-1)) * G%mask2dCv(i,J) + segment%grad_gradient(i,1,k) = (((uvel(I,j-1,k) - uvel(I,j-2,k))*G%US%m_to_L*G%IdxBu(I,J-2)) - & + (uvel(I-1,j-1,k) - uvel(I-1,j-2,k))*G%US%m_to_L*G%IdxBu(I-1,J-2)) * G%mask2dCv(I,j-1) + segment%grad_gradient(i,2,k) = (((uvel(I,j,k) - uvel(I,j-1,k))*G%US%m_to_L*G%IdyBu(I,J-1)) - & + (uvel(I-1,j,k) - uvel(I-1,j-1,k))*G%US%m_to_L*G%IdyBu(I-1,J-1)) * G%mask2dCv(i,J) enddo enddo endif @@ -2571,10 +2571,10 @@ subroutine gradient_at_q_points(G, segment, uvel, vvel) if (segment%oblique_grad) then do k=1,G%ke do I=max(segment%HI%isd, G%HI%isd+1),min(segment%HI%ied, G%HI%ied-1) - segment%grad_gradient(i,1,k) = (((uvel(I,j+3,k) - uvel(I,j+2,k))*G%IdxBu(I,J+2)) - & - (uvel(I-1,j+3,k) - uvel(I-1,j+2,k))*G%IdyBu(I-1,J+2)) * G%mask2dCv(i,J+2) - segment%grad_gradient(i,2,k) = (((uvel(I,j+2,k) - uvel(I,j+1,k))*G%IdxBu(I,J+1)) - & - (uvel(I-1,j+2,k) - uvel(I-1,j+1,k))*G%IdyBu(I-1,J+1)) * G%mask2dCv(i,J+1) + segment%grad_gradient(i,1,k) = (((uvel(I,j+3,k) - uvel(I,j+2,k))*G%US%m_to_L*G%IdxBu(I,J+2)) - & + (uvel(I-1,j+3,k) - uvel(I-1,j+2,k))*G%US%m_to_L*G%IdyBu(I-1,J+2)) * G%mask2dCv(i,J+2) + segment%grad_gradient(i,2,k) = (((uvel(I,j+2,k) - uvel(I,j+1,k))*G%US%m_to_L*G%IdxBu(I,J+1)) - & + (uvel(I-1,j+2,k) - uvel(I-1,j+1,k))*G%US%m_to_L*G%IdyBu(I-1,J+1)) * G%mask2dCv(i,J+1) enddo enddo endif diff --git a/src/framework/MOM_dyn_horgrid.F90 b/src/framework/MOM_dyn_horgrid.F90 index 3883dc9011..36eec12226 100644 --- a/src/framework/MOM_dyn_horgrid.F90 +++ b/src/framework/MOM_dyn_horgrid.F90 @@ -113,9 +113,9 @@ module MOM_dyn_horgrid geoLatBu, & !< The geographic latitude at q points [degrees of latitude] or [m]. geoLonBu, & !< The geographic longitude at q points [degrees of longitude] or [m]. dxBu, & !< dxBu is delta x at q points [L ~> m]. - IdxBu, & !< 1/dxBu [m-1]. + IdxBu, & !< 1/dxBu [L-1 ~> m-1]. dyBu, & !< dyBu is delta y at q points [L ~> m]. - IdyBu, & !< 1/dyBu [m-1]. + IdyBu, & !< 1/dyBu [L-1 ~> m-1]. areaBu, & !< areaBu is the area of a q-cell [L ~> m] IareaBu !< IareaBu = 1/areaBu [L-2 ~> m-2]. @@ -354,8 +354,8 @@ subroutine set_derived_dyn_horgrid(G, US) if (G%dxBu(I,J) < 0.0) G%dxBu(I,J) = 0.0 if (G%dyBu(I,J) < 0.0) G%dyBu(I,J) = 0.0 - G%IdxBu(I,J) = Adcroft_reciprocal(L_to_m*G%dxBu(I,J)) - G%IdyBu(I,J) = Adcroft_reciprocal(L_to_m*G%dyBu(I,J)) + G%IdxBu(I,J) = Adcroft_reciprocal(G%dxBu(I,J)) + G%IdyBu(I,J) = Adcroft_reciprocal(G%dyBu(I,J)) ! areaBu has usually been set to a positive area elsewhere. if (G%areaBu(I,J) <= 0.0) G%areaBu(I,J) = G%dxBu(I,J) * G%dyBu(I,J) G%IareaBu(I,J) = Adcroft_reciprocal(G%areaBu(I,J)) diff --git a/src/initialization/MOM_grid_initialize.F90 b/src/initialization/MOM_grid_initialize.F90 index 28a01d6e68..7293152f71 100644 --- a/src/initialization/MOM_grid_initialize.F90 +++ b/src/initialization/MOM_grid_initialize.F90 @@ -142,8 +142,7 @@ subroutine grid_metrics_chksum(parent, G, US) call uvchksum(trim(parent)//': Id[xy]C[uv]', & G%IdyCu, G%IdxCv, G%HI, haloshift=halo) - call Bchksum_pair(trim(parent)//': Id[xy]B[uv]', & - G%IdxBu, G%IdyBu, G%HI, haloshift=halo) + call Bchksum_pair(trim(parent)//': Id[xy]B[uv]', G%IdxBu, G%IdyBu, G%HI, haloshift=halo, scale=m_to_L) call hchksum(G%areaT, trim(parent)//': areaT',G%HI, haloshift=halo, scale=L_to_m**2) call Bchksum(G%areaBu, trim(parent)//': areaBu',G%HI, haloshift=halo, scale=L_to_m**2) @@ -518,8 +517,8 @@ subroutine set_grid_metrics_cartesian(G, param_file, US) do J=JsdB,JedB ; do I=IsdB,IedB G%geoLonBu(I,J) = grid_lonB(I) ; G%geoLatBu(I,J) = grid_latB(J) - G%dxBu(I,J) = m_to_L*dx_everywhere ; G%IdxBu(I,J) = I_dx - G%dyBu(I,J) = m_to_L*dy_everywhere ; G%IdyBu(I,J) = I_dy + G%dxBu(I,J) = m_to_L*dx_everywhere ; G%IdxBu(I,J) = L_to_m*I_dx + G%dyBu(I,J) = m_to_L*dy_everywhere ; G%IdyBu(I,J) = L_to_m*I_dy G%areaBu(I,J) = m_to_L**2*dx_everywhere * dy_everywhere ; G%IareaBu(I,J) = L_to_m**2*I_dx * I_dy enddo ; enddo diff --git a/src/parameterizations/lateral/MOM_hor_visc.F90 b/src/parameterizations/lateral/MOM_hor_visc.F90 index 3a2e7a06ca..7a5153bec5 100644 --- a/src/parameterizations/lateral/MOM_hor_visc.F90 +++ b/src/parameterizations/lateral/MOM_hor_visc.F90 @@ -713,9 +713,9 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, ! We will consider using a circulation based calculation of vorticity later. ! Also note this will need OBC boundary conditions re-applied... do J=js-2,Jeq+1 ; do I=is-2,Ieq+1 - DY_dxBu = US%L_to_m*G%dyBu(I,J) * G%IdxBu(I,J) + DY_dxBu = G%dyBu(I,J) * G%IdxBu(I,J) dvdx(I,J) = DY_dxBu * (v(i+1,J,k) * G%IdyCv(i+1,J) - v(i,J,k) * G%IdyCv(i,J)) - DX_dyBu = US%L_to_m*G%dxBu(I,J) * G%IdyBu(I,J) + DX_dyBu = G%dxBu(I,J) * G%IdyBu(I,J) dudy(I,J) = DX_dyBu * (u(I,j+1,k) * G%IdxCu(I,j+1) - u(I,j,k) * G%IdxCu(I,j)) enddo ; enddo @@ -738,12 +738,12 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, ! Vorticity gradient do J=js-2,Jeq+1 ; do i=is-1,Ieq+1 - DY_dxBu = US%L_to_m*G%dyBu(I,J) * G%IdxBu(I,J) + DY_dxBu = G%dyBu(I,J) * G%IdxBu(I,J) vort_xy_dx(i,J) = DY_dxBu * (vort_xy(I,J) * G%IdyCu(I,j) - vort_xy(I-1,J) * G%IdyCu(I-1,j)) enddo ; enddo do j=js-1,Jeq+1 ; do I=is-2,Ieq+1 - DX_dyBu = US%L_to_m*G%dxBu(I,J) * G%IdyBu(I,J) + DX_dyBu = G%dxBu(I,J) * G%IdyBu(I,J) vort_xy_dy(I,j) = DX_dyBu * (vort_xy(I,J) * G%IdxCv(i,J) - vort_xy(I,J-1) * G%IdxCv(i,J-1)) enddo ; enddo @@ -1321,17 +1321,17 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, (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)*( & - (u(I,j+1,k)-u(I,j,k))*G%IdyBu(I,J) & - +(v(i+1,J,k)-v(i,J,k))*G%IdxBu(I,J) ) & + (u(I,j+1,k)-u(I,j,k))*US%m_to_L*G%IdyBu(I,J) & + +(v(i+1,J,k)-v(i,J,k))*US%m_to_L*G%IdxBu(I,J) ) & +str_xy(I-1,J-1)*( & - (u(I-1,j,k)-u(I-1,j-1,k))*G%IdyBu(I-1,J-1) & - +(v(i,J-1,k)-v(i-1,J-1,k))*G%IdxBu(I-1,J-1) )) & + (u(I-1,j,k)-u(I-1,j-1,k))*US%m_to_L*G%IdyBu(I-1,J-1) & + +(v(i,J-1,k)-v(i-1,J-1,k))*US%m_to_L*G%IdxBu(I-1,J-1) )) & +(str_xy(I-1,J)*( & - (u(I-1,j+1,k)-u(I-1,j,k))*G%IdyBu(I-1,J) & - +(v(i,J,k)-v(i-1,J,k))*G%IdxBu(I-1,J) ) & + (u(I-1,j+1,k)-u(I-1,j,k))*US%m_to_L*G%IdyBu(I-1,J) & + +(v(i,J,k)-v(i-1,J,k))*US%m_to_L*G%IdxBu(I-1,J) ) & +str_xy(I,J-1)*( & - (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) )) ) ) + (u(I,j,k)-u(I,j-1,k))*US%m_to_L*G%IdyBu(I,J-1) & + +(v(i+1,J-1,k)-v(i,J-1,k))*US%m_to_L*G%IdxBu(I,J-1) )) ) ) enddo ; enddo ; endif ! Make a similar calculation as for FrictWork above but accumulating into @@ -1372,17 +1372,17 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, ((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))*( & - (u(I,j+1,k)-u(I,j,k))*G%IdyBu(I,J) & - +(v(i+1,J,k)-v(i,J,k))*G%IdxBu(I,J) ) & + (u(I,j+1,k)-u(I,j,k))*US%m_to_L*G%IdyBu(I,J) & + +(v(i+1,J,k)-v(i,J,k))*US%m_to_L*G%IdxBu(I,J) ) & +(str_xy(I-1,J-1)-RoScl*bhstr_xy(I-1,J-1))*( & - (u(I-1,j,k)-u(I-1,j-1,k))*G%IdyBu(I-1,J-1) & - +(v(i,J-1,k)-v(i-1,J-1,k))*G%IdxBu(I-1,J-1) )) & + (u(I-1,j,k)-u(I-1,j-1,k))*US%m_to_L*G%IdyBu(I-1,J-1) & + +(v(i,J-1,k)-v(i-1,J-1,k))*US%m_to_L*G%IdxBu(I-1,J-1) )) & +((str_xy(I-1,J)-RoScl*bhstr_xy(I-1,J))*( & - (u(I-1,j+1,k)-u(I-1,j,k))*G%IdyBu(I-1,J) & - +(v(i,J,k)-v(i-1,J,k))*G%IdxBu(I-1,J) ) & + (u(I-1,j+1,k)-u(I-1,j,k))*US%m_to_L*G%IdyBu(I-1,J) & + +(v(i,J,k)-v(i-1,J,k))*US%m_to_L*G%IdxBu(I-1,J) ) & +(str_xy(I,J-1)-RoScl*bhstr_xy(I,J-1))*( & - (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) )) ) ) + (u(I,j,k)-u(I,j-1,k))*US%m_to_L*G%IdyBu(I,J-1) & + +(v(i+1,J-1,k)-v(i,J-1,k))*US%m_to_L*G%IdxBu(I,J-1) )) ) ) enddo ; enddo else do j=js,je ; do i=is,ie @@ -1866,7 +1866,7 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS, MEKE) do J=js-2,Jeq+1 ; do I=is-2,Ieq+1 CS%DX2q(I,J) = US%L_to_m**2*G%dxBu(I,J)*G%dxBu(I,J) ; CS%DY2q(I,J) = US%L_to_m**2*G%dyBu(I,J)*G%dyBu(I,J) - CS%DX_dyBu(I,J) = US%L_to_m*G%dxBu(I,J)*G%IdyBu(I,J) ; CS%DY_dxBu(I,J) = US%L_to_m*G%dyBu(I,J)*G%IdxBu(I,J) + CS%DX_dyBu(I,J) = G%dxBu(I,J)*G%IdyBu(I,J) ; CS%DY_dxBu(I,J) = G%dyBu(I,J)*G%IdxBu(I,J) enddo ; enddo do j=Jsq-1,Jeq+2 ; do i=Isq-1,Ieq+2 CS%DX2h(i,j) = US%L_to_m**2*G%dxT(i,j)*G%dxT(i,j) ; CS%DY2h(i,j) = US%L_to_m**2*G%dyT(i,j)*G%dyT(i,j) diff --git a/src/parameterizations/lateral/MOM_internal_tides.F90 b/src/parameterizations/lateral/MOM_internal_tides.F90 index f488316592..002f8034db 100644 --- a/src/parameterizations/lateral/MOM_internal_tides.F90 +++ b/src/parameterizations/lateral/MOM_internal_tides.F90 @@ -1125,8 +1125,8 @@ subroutine propagate_corner_spread(En, energized_wedge, NAngle, speed, dt, G, CS !energized_angle = Angle_size * real(energized_wedge - 1) + 0.5*Angle_size ! x = G%geoLonBu y = G%geoLatBu - Idx = G%IdxBu; dx = G%US%L_to_m*G%dxBu - Idy = G%IdyBu; dy = G%US%L_to_m*G%dyBu + Idx = G%US%m_to_L*G%IdxBu ; dx = G%US%L_to_m*G%dxBu + Idy = G%US%m_to_L*G%IdyBu ; dy = G%US%L_to_m*G%dyBu do j=jsh,jeh; do i=ish,ieh do m=1,int(Nsubrays) From e1081a5a276d0e1eba07872d520f44d929aa12fe Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sun, 4 Aug 2019 08:28:44 -0400 Subject: [PATCH 151/297] +Rescaled the units of G%IdxT and G%IdyT Rescaled G%IdxT and G%IdyT throughout the MOM6 code to units of [L-1]. All answers are bitwise identical, but the units of two elements a public type have changed. --- config_src/mct_driver/ocn_cap_methods.F90 | 8 +++---- config_src/nuopc_driver/mom_cap_methods.F90 | 8 +++---- src/core/MOM_barotropic.F90 | 2 +- src/core/MOM_continuity_PPM.F90 | 16 ++++++------- src/core/MOM_grid.F90 | 8 +++---- src/diagnostics/MOM_diagnostics.F90 | 6 ++--- src/framework/MOM_dyn_horgrid.F90 | 8 +++---- src/initialization/MOM_grid_initialize.F90 | 7 +++--- .../MOM_shared_initialization.F90 | 7 ++++-- .../lateral/MOM_hor_visc.F90 | 10 ++++---- .../lateral/MOM_internal_tides.F90 | 24 +++++++++---------- 11 files changed, 53 insertions(+), 51 deletions(-) diff --git a/config_src/mct_driver/ocn_cap_methods.F90 b/config_src/mct_driver/ocn_cap_methods.F90 index 7723f51a6c..2a23621c6f 100644 --- a/config_src/mct_driver/ocn_cap_methods.F90 +++ b/config_src/mct_driver/ocn_cap_methods.F90 @@ -217,7 +217,7 @@ subroutine ocn_export(ind, ocn_public, grid, o2x, dt_int, ncouple_per_day) ! d/dx ssh do j=grid%jsc, grid%jec ; do i=grid%isc,grid%iec ! This is a simple second-order difference - ! o2x(ind%o2x_So_dhdx, n) = 0.5 * (ssh(i+1,j) - ssh(i-1,j)) * grid%IdxT(i,j) * grid%mask2dT(i,j) + ! o2x(ind%o2x_So_dhdx, n) = 0.5 * (ssh(i+1,j) - ssh(i-1,j)) * grid%US%m_to_L*grid%IdxT(i,j) * grid%mask2dT(i,j) ! This is a PLM slope which might be less prone to the A-grid null mode slp_L = (ssh(I,j) - ssh(I-1,j)) * grid%mask2dCu(I-1,j) if (grid%mask2dCu(I-1,j)==0.) slp_L = 0. @@ -235,14 +235,14 @@ subroutine ocn_export(ind, ocn_public, grid, o2x, dt_int, ncouple_per_day) ! larger extreme values. slope = 0.0 endif - sshx(i,j) = slope * grid%IdxT(i,j) * grid%mask2dT(i,j) + sshx(i,j) = slope * grid%US%m_to_L*grid%IdxT(i,j) * grid%mask2dT(i,j) if (grid%mask2dT(i,j)==0.) sshx(i,j) = 0.0 enddo; enddo ! d/dy ssh do j=grid%jsc, grid%jec ; do i=grid%isc,grid%iec ! This is a simple second-order difference - ! o2x(ind%o2x_So_dhdy, n) = 0.5 * (ssh(i,j+1) - ssh(i,j-1)) * grid%IdyT(i,j) * grid%mask2dT(i,j) + ! o2x(ind%o2x_So_dhdy, n) = 0.5 * (ssh(i,j+1) - ssh(i,j-1)) * grid%US%m_to_L*grid%IdyT(i,j) * grid%mask2dT(i,j) ! This is a PLM slope which might be less prone to the A-grid null mode slp_L = ssh(i,J) - ssh(i,J-1) * grid%mask2dCv(i,J-1) if (grid%mask2dCv(i,J-1)==0.) slp_L = 0. @@ -262,7 +262,7 @@ subroutine ocn_export(ind, ocn_public, grid, o2x, dt_int, ncouple_per_day) ! larger extreme values. slope = 0.0 endif - sshy(i,j) = slope * grid%IdyT(i,j) * grid%mask2dT(i,j) + sshy(i,j) = slope * grid%US%m_to_L*grid%IdyT(i,j) * grid%mask2dT(i,j) if (grid%mask2dT(i,j)==0.) sshy(i,j) = 0.0 enddo; enddo diff --git a/config_src/nuopc_driver/mom_cap_methods.F90 b/config_src/nuopc_driver/mom_cap_methods.F90 index e6bdbea307..3ece152f7f 100644 --- a/config_src/nuopc_driver/mom_cap_methods.F90 +++ b/config_src/nuopc_driver/mom_cap_methods.F90 @@ -564,7 +564,7 @@ subroutine mom_export(ocean_public, ocean_grid, ocean_state, exportState, clock, ! d/dx ssh ! This is a simple second-order difference - ! dhdx(i,j) = 0.5 * (ssh(i+1,j) - ssh(i-1,j)) * ocean_grid%IdxT(i,j) * ocean_grid%mask2dT(ig,jg) + ! dhdx(i,j) = 0.5 * (ssh(i+1,j) - ssh(i-1,j)) * ocean_grid%US%m_to_L*ocean_grid%IdxT(i,j) * ocean_grid%mask2dT(ig,jg) do jglob = jsc, jec j = jglob + ocean_grid%jsc - jsc @@ -587,14 +587,14 @@ subroutine mom_export(ocean_public, ocean_grid, ocean_state, exportState, clock, ! larger extreme values. slope = 0.0 endif - dhdx(iglob,jglob) = slope * ocean_grid%IdxT(i,j) * ocean_grid%mask2dT(i,j) + dhdx(iglob,jglob) = slope * ocean_grid%US%m_to_L*ocean_grid%IdxT(i,j) * ocean_grid%mask2dT(i,j) if (ocean_grid%mask2dT(i,j)==0.) dhdx(iglob,jglob) = 0.0 enddo enddo ! d/dy ssh ! This is a simple second-order difference - ! dhdy(i,j) = 0.5 * (ssh(i,j+1) - ssh(i,j-1)) * ocean_grid%IdyT(i,j) * ocean_grid%mask2dT(ig,jg) + ! dhdy(i,j) = 0.5 * (ssh(i,j+1) - ssh(i,j-1)) * ocean_grid%US%m_to_L*ocean_grid%IdyT(i,j) * ocean_grid%mask2dT(ig,jg) do jglob = jsc, jec j = jglob + ocean_grid%jsc - jsc @@ -617,7 +617,7 @@ subroutine mom_export(ocean_public, ocean_grid, ocean_state, exportState, clock, ! larger extreme values. slope = 0.0 endif - dhdy(iglob,jglob) = slope * ocean_grid%IdyT(i,j) * ocean_grid%mask2dT(i,j) + dhdy(iglob,jglob) = slope * ocean_grid%US%m_to_L*ocean_grid%IdyT(i,j) * ocean_grid%mask2dT(i,j) if (ocean_grid%mask2dT(i,j)==0.) dhdy(iglob,jglob) = 0.0 enddo enddo diff --git a/src/core/MOM_barotropic.F90 b/src/core/MOM_barotropic.F90 index 515bba15d9..cdeccff4d5 100644 --- a/src/core/MOM_barotropic.F90 +++ b/src/core/MOM_barotropic.F90 @@ -1399,7 +1399,7 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, 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), & + H_eff_dx2 = max(H_min_dyn * ((G%IdxT(i,j))**2 + (G%IdyT(i,j))**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)) ) ) diff --git a/src/core/MOM_continuity_PPM.F90 b/src/core/MOM_continuity_PPM.F90 index d606bbdb0f..979edadcb0 100644 --- a/src/core/MOM_continuity_PPM.F90 +++ b/src/core/MOM_continuity_PPM.F90 @@ -540,14 +540,14 @@ subroutine zonal_flux_layer(u, h, h_L, h_R, uh, duhdu, visc_rem, dt_in_T, G, US, ! Set new values of uh and duhdu. if (u(I) > 0.0) then if (vol_CFL) then ; CFL = (u(I) * dt_in_T) * (G%dy_Cu(I,j) * G%IareaT(i,j)) - else ; CFL = u(I) * dt_in_T * US%L_to_m*G%IdxT(i,j) ; endif + else ; CFL = u(I) * dt_in_T * G%IdxT(i,j) ; endif curv_3 = h_L(i) + h_R(i) - 2.0*h(i) uh(I) = G%dy_Cu(I,j) * u(I) * & (h_R(i) + CFL * (0.5*(h_L(i) - h_R(i)) + curv_3*(CFL - 1.5))) h_marg = h_R(i) + CFL * ((h_L(i) - h_R(i)) + 3.0*curv_3*(CFL - 1.0)) elseif (u(I) < 0.0) then if (vol_CFL) then ; CFL = (-u(I) * dt_in_T) * (G%dy_Cu(I,j) * G%IareaT(i+1,j)) - else ; CFL = -u(I) * dt_in_T * US%L_to_m*G%IdxT(i+1,j) ; endif + else ; CFL = -u(I) * dt_in_T * G%IdxT(i+1,j) ; endif curv_3 = h_L(i+1) + h_R(i+1) - 2.0*h(i+1) uh(I) = G%dy_Cu(I,j) * u(I) * & (h_L(i+1) + CFL * (0.5*(h_R(i+1)-h_L(i+1)) + curv_3*(CFL - 1.5))) @@ -615,13 +615,13 @@ subroutine zonal_face_thickness(u, h, h_L, h_R, h_u, dt_in_T, G, US, LB, vol_CFL do k=1,nz ; do j=jsh,jeh ; do I=ish-1,ieh if (u(I,j,k) > 0.0) then if (vol_CFL) then ; CFL = (u(I,j,k) * dt_in_T) * (G%dy_Cu(I,j) * G%IareaT(i,j)) - else ; CFL = u(I,j,k) * dt_in_T * US%L_to_m*G%IdxT(i,j) ; endif + else ; CFL = u(I,j,k) * dt_in_T * G%IdxT(i,j) ; endif curv_3 = h_L(i,j,k) + h_R(i,j,k) - 2.0*h(i,j,k) h_avg = h_R(i,j,k) + CFL * (0.5*(h_L(i,j,k) - h_R(i,j,k)) + curv_3*(CFL - 1.5)) h_marg = h_R(i,j,k) + CFL * ((h_L(i,j,k) - h_R(i,j,k)) + 3.0*curv_3*(CFL - 1.0)) elseif (u(I,j,k) < 0.0) then if (vol_CFL) then ; CFL = (-u(I,j,k)*dt_in_T) * (G%dy_Cu(I,j) * G%IareaT(i+1,j)) - else ; CFL = -u(I,j,k) * dt_in_T * US%L_to_m*G%IdxT(i+1,j) ; endif + else ; CFL = -u(I,j,k) * dt_in_T * G%IdxT(i+1,j) ; endif curv_3 = h_L(i+1,j,k) + h_R(i+1,j,k) - 2.0*h(i+1,j,k) h_avg = h_L(i+1,j,k) + CFL * (0.5*(h_R(i+1,j,k)-h_L(i+1,j,k)) + curv_3*(CFL - 1.5)) h_marg = h_L(i+1,j,k) + CFL * ((h_R(i+1,j,k)-h_L(i+1,j,k)) + & @@ -1338,7 +1338,7 @@ subroutine merid_flux_layer(v, h, h_L, h_R, vh, dvhdv, visc_rem, dt_in_T, G, US, do i=ish,ieh ; if (do_I(i)) then if (v(i) > 0.0) then if (vol_CFL) then ; CFL = (v(i) * dt_in_T) * (G%dx_Cv(i,J) * G%IareaT(i,j)) - else ; CFL = v(i) * dt_in_T * US%L_to_m*G%IdyT(i,j) ; endif + else ; CFL = v(i) * dt_in_T * G%IdyT(i,j) ; endif curv_3 = h_L(i,j) + h_R(i,j) - 2.0*h(i,j) vh(i) = G%dx_Cv(i,J) * v(i) * ( h_R(i,j) + CFL * & (0.5*(h_L(i,j) - h_R(i,j)) + curv_3*(CFL - 1.5)) ) @@ -1346,7 +1346,7 @@ subroutine merid_flux_layer(v, h, h_L, h_R, vh, dvhdv, visc_rem, dt_in_T, G, US, 3.0*curv_3*(CFL - 1.0)) elseif (v(i) < 0.0) then if (vol_CFL) then ; CFL = (-v(i) * dt_in_T) * (G%dx_Cv(i,J) * G%IareaT(i,j+1)) - else ; CFL = -v(i) * dt_in_T * US%L_to_m*G%IdyT(i,j+1) ; endif + else ; CFL = -v(i) * dt_in_T * G%IdyT(i,j+1) ; endif curv_3 = h_L(i,j+1) + h_R(i,j+1) - 2.0*h(i,j+1) vh(i) = G%dx_Cv(i,J) * v(i) * ( h_L(i,j+1) + CFL * & (0.5*(h_R(i,j+1)-h_L(i,j+1)) + curv_3*(CFL - 1.5)) ) @@ -1415,14 +1415,14 @@ subroutine merid_face_thickness(v, h, h_L, h_R, h_v, dt_in_T, G, US, LB, vol_CFL do k=1,nz ; do J=jsh-1,jeh ; do i=ish,ieh if (v(i,J,k) > 0.0) then if (vol_CFL) then ; CFL = (v(i,J,k) * dt_in_T) * (G%dx_Cv(i,J) * G%IareaT(i,j)) - else ; CFL = v(i,J,k) * dt_in_T * US%L_to_m*G%IdyT(i,j) ; endif + else ; CFL = v(i,J,k) * dt_in_T * G%IdyT(i,j) ; endif curv_3 = h_L(i,j,k) + h_R(i,j,k) - 2.0*h(i,j,k) h_avg = h_R(i,j,k) + CFL * (0.5*(h_L(i,j,k) - h_R(i,j,k)) + curv_3*(CFL - 1.5)) h_marg = h_R(i,j,k) + CFL * ((h_L(i,j,k) - h_R(i,j,k)) + & 3.0*curv_3*(CFL - 1.0)) elseif (v(i,J,k) < 0.0) then if (vol_CFL) then ; CFL = (-v(i,J,k)*dt_in_T) * (G%dx_Cv(i,J) * G%IareaT(i,j+1)) - else ; CFL = -v(i,J,k) * dt_in_T * US%L_to_m*G%IdyT(i,j+1) ; endif + else ; CFL = -v(i,J,k) * dt_in_T * G%IdyT(i,j+1) ; endif curv_3 = h_L(i,j+1,k) + h_R(i,j+1,k) - 2.0*h(i,j+1,k) h_avg = h_L(i,j+1,k) + CFL * (0.5*(h_R(i,j+1,k)-h_L(i,j+1,k)) + curv_3*(CFL - 1.5)) h_marg = h_L(i,j+1,k) + CFL * ((h_R(i,j+1,k)-h_L(i,j+1,k)) + & diff --git a/src/core/MOM_grid.F90 b/src/core/MOM_grid.F90 index 0c736d56f0..3ec744533a 100644 --- a/src/core/MOM_grid.F90 +++ b/src/core/MOM_grid.F90 @@ -78,9 +78,9 @@ module MOM_grid geoLatT, & !< The geographic latitude at q points in degrees of latitude or m. geoLonT, & !< The geographic longitude at q points in degrees of longitude or m. dxT, & !< dxT is delta x at h points [L ~> m]. - IdxT, & !< 1/dxT [m-1]. + IdxT, & !< 1/dxT [L-1 ~> m-1]. dyT, & !< dyT is delta y at h points [L ~> m]. - IdyT, & !< IdyT is 1/dyT [m-1]. + IdyT, & !< IdyT is 1/dyT [L-1 ~> m-1]. areaT, & !< The area of an h-cell [L2 ~> m2]. IareaT, & !< 1/areaT [L-2 ~> m-2]. sin_rot, & !< The sine of the angular rotation between the local model grid's northward @@ -423,8 +423,8 @@ subroutine set_derived_metrics(G, US) do j=jsd,jed ; do i=isd,ied if (G%dxT(i,j) < 0.0) G%dxT(i,j) = 0.0 if (G%dyT(i,j) < 0.0) G%dyT(i,j) = 0.0 - G%IdxT(i,j) = Adcroft_reciprocal(US%L_to_m*G%dxT(i,j)) - G%IdyT(i,j) = Adcroft_reciprocal(US%L_to_m*G%dyT(i,j)) + G%IdxT(i,j) = Adcroft_reciprocal(G%dxT(i,j)) + G%IdyT(i,j) = Adcroft_reciprocal(G%dyT(i,j)) G%IareaT(i,j) = Adcroft_reciprocal(G%areaT(i,j)) enddo ; enddo diff --git a/src/diagnostics/MOM_diagnostics.F90 b/src/diagnostics/MOM_diagnostics.F90 index 03bbec78fb..a84916aae2 100644 --- a/src/diagnostics/MOM_diagnostics.F90 +++ b/src/diagnostics/MOM_diagnostics.F90 @@ -641,19 +641,19 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & endif if (CS%id_cfl_cg1>0) then do j=js,je ; do i=is,ie - CS%cfl_cg1(i,j) = (dt*CS%cg1(i,j)) * (G%IdxT(i,j) + G%IdyT(i,j)) + CS%cfl_cg1(i,j) = (dt*US%m_to_L*CS%cg1(i,j)) * (G%IdxT(i,j) + G%IdyT(i,j)) enddo ; enddo call post_data(CS%id_cfl_cg1, CS%cfl_cg1, CS%diag) endif if (CS%id_cfl_cg1_x>0) then do j=js,je ; do i=is,ie - CS%cfl_cg1_x(i,j) = (dt*CS%cg1(i,j)) * G%IdxT(i,j) + CS%cfl_cg1_x(i,j) = (dt*US%m_to_L*CS%cg1(i,j)) * G%IdxT(i,j) enddo ; enddo call post_data(CS%id_cfl_cg1_x, CS%cfl_cg1_x, CS%diag) endif if (CS%id_cfl_cg1_y>0) then do j=js,je ; do i=is,ie - CS%cfl_cg1_y(i,j) = (dt*CS%cg1(i,j)) * G%IdyT(i,j) + CS%cfl_cg1_y(i,j) = (dt*US%m_to_L*CS%cg1(i,j)) * G%IdyT(i,j) enddo ; enddo call post_data(CS%id_cfl_cg1_y, CS%cfl_cg1_y, CS%diag) endif diff --git a/src/framework/MOM_dyn_horgrid.F90 b/src/framework/MOM_dyn_horgrid.F90 index 36eec12226..ae0018d9ba 100644 --- a/src/framework/MOM_dyn_horgrid.F90 +++ b/src/framework/MOM_dyn_horgrid.F90 @@ -72,9 +72,9 @@ module MOM_dyn_horgrid geoLatT, & !< The geographic latitude at q points [degrees of latitude] or [m]. geoLonT, & !< The geographic longitude at q points [degrees of longitude] or [m]. dxT, & !< dxT is delta x at h points [L ~> m]. - IdxT, & !< 1/dxT [m-1]. + IdxT, & !< 1/dxT [L-1 ~> m-1]. dyT, & !< dyT is delta y at h points [L ~> m]. - IdyT, & !< IdyT is 1/dyT [m-1]. + IdyT, & !< IdyT is 1/dyT [L-1 ~> m-1]. areaT, & !< The area of an h-cell [L2 ~> m2]. IareaT !< 1/areaT [L-2 ~> m-2]. real, allocatable, dimension(:,:) :: sin_rot @@ -331,8 +331,8 @@ subroutine set_derived_dyn_horgrid(G, US) do j=jsd,jed ; do i=isd,ied if (G%dxT(i,j) < 0.0) G%dxT(i,j) = 0.0 if (G%dyT(i,j) < 0.0) G%dyT(i,j) = 0.0 - G%IdxT(i,j) = Adcroft_reciprocal(L_to_m*G%dxT(i,j)) - G%IdyT(i,j) = Adcroft_reciprocal(L_to_m*G%dyT(i,j)) + G%IdxT(i,j) = Adcroft_reciprocal(G%dxT(i,j)) + G%IdyT(i,j) = Adcroft_reciprocal(G%dyT(i,j)) G%IareaT(i,j) = Adcroft_reciprocal(G%areaT(i,j)) enddo ; enddo diff --git a/src/initialization/MOM_grid_initialize.F90 b/src/initialization/MOM_grid_initialize.F90 index 7293152f71..7bf2295b15 100644 --- a/src/initialization/MOM_grid_initialize.F90 +++ b/src/initialization/MOM_grid_initialize.F90 @@ -133,8 +133,7 @@ subroutine grid_metrics_chksum(parent, G, US) call Bchksum_pair(trim(parent)//': dxB[uv]', G%dxBu, G%dyBu, G%HI, haloshift=halo, scale=L_to_m) - call hchksum_pair(trim(parent)//': Id[xy]T', & - G%IdxT, G%IdyT, G%HI, haloshift=halo) + call hchksum_pair(trim(parent)//': Id[xy]T', G%IdxT, G%IdyT, G%HI, haloshift=halo, scale=m_to_L) call uvchksum(trim(parent)//': Id[xy]C[uv]', & G%IdxCu, G%IdyCv, G%HI, haloshift=halo) @@ -524,8 +523,8 @@ subroutine set_grid_metrics_cartesian(G, param_file, US) do j=jsd,jed ; do i=isd,ied G%geoLonT(i,j) = grid_lonT(i) ; G%geoLatT(i,j) = grid_LatT(j) - G%dxT(i,j) = m_to_L*dx_everywhere ; G%IdxT(i,j) = I_dx - G%dyT(i,j) = m_to_L*dy_everywhere ; G%IdyT(i,j) = I_dy + G%dxT(i,j) = m_to_L*dx_everywhere ; G%IdxT(i,j) = L_to_m*I_dx + G%dyT(i,j) = m_to_L*dy_everywhere ; G%IdyT(i,j) = L_to_m*I_dy G%areaT(i,j) = m_to_L**2*dx_everywhere * dy_everywhere ; G%IareaT(i,j) = L_to_m**2*I_dx * I_dy enddo ; enddo diff --git a/src/initialization/MOM_shared_initialization.F90 b/src/initialization/MOM_shared_initialization.F90 index cb93a0d589..35a590c753 100644 --- a/src/initialization/MOM_shared_initialization.F90 +++ b/src/initialization/MOM_shared_initialization.F90 @@ -96,8 +96,11 @@ subroutine MOM_calculate_grad_Coriolis(dF_dx, dF_dy, G, US) type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type ! Local variables integer :: i,j + real :: m_to_L ! A unit conversion factor [L m-1 ~> nondim] real :: f1, f2 + m_to_L = 1.0 ; if (present(US)) m_to_L = US%m_to_L + if ((LBOUND(G%CoriolisBu,1) > G%isc-1) .or. & (LBOUND(G%CoriolisBu,2) > G%isc-1)) then ! The gradient of the Coriolis parameter can not be calculated with this grid. @@ -108,10 +111,10 @@ subroutine MOM_calculate_grad_Coriolis(dF_dx, dF_dy, G, US) do j=G%jsc, G%jec ; do i=G%isc, G%iec f1 = 0.5*( G%CoriolisBu(I,J) + G%CoriolisBu(I,J-1) ) f2 = 0.5*( G%CoriolisBu(I-1,J) + G%CoriolisBu(I-1,J-1) ) - dF_dx(i,j) = G%IdxT(i,j) * ( f1 - f2 ) + dF_dx(i,j) = m_to_L*G%IdxT(i,j) * ( f1 - f2 ) f1 = 0.5*( G%CoriolisBu(I,J) + G%CoriolisBu(I-1,J) ) f2 = 0.5*( G%CoriolisBu(I,J-1) + G%CoriolisBu(I-1,J-1) ) - dF_dy(i,j) = G%IdyT(i,j) * ( f1 - f2 ) + dF_dy(i,j) = m_to_L*G%IdyT(i,j) * ( f1 - f2 ) enddo ; enddo call pass_vector(dF_dx, dF_dy, G%Domain, stagger=AGRID) end subroutine MOM_calculate_grad_Coriolis diff --git a/src/parameterizations/lateral/MOM_hor_visc.F90 b/src/parameterizations/lateral/MOM_hor_visc.F90 index 7a5153bec5..eab5b8af63 100644 --- a/src/parameterizations/lateral/MOM_hor_visc.F90 +++ b/src/parameterizations/lateral/MOM_hor_visc.F90 @@ -1318,8 +1318,8 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, ! 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) = 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)) & + (str_xx(i,j)*(u(I,j,k)-u(I-1,j,k))*US%m_to_L*G%IdxT(i,j) & + -str_xx(i,j)*(v(i,J,k)-v(i,J-1,k))*US%m_to_L*G%IdyT(i,j)) & +0.25*((str_xy(I,J)*( & (u(I,j+1,k)-u(I,j,k))*US%m_to_L*G%IdyBu(I,J) & +(v(i+1,J,k)-v(i,J,k))*US%m_to_L*G%IdxBu(I,J) ) & @@ -1369,8 +1369,8 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, endif endif 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)) & + ((str_xx(i,j)-RoScl*bhstr_xx(i,j))*(u(I,j,k)-u(I-1,j,k))*US%m_to_L*G%IdxT(i,j) & + -(str_xx(i,j)-RoScl*bhstr_xx(i,j))*(v(i,J,k)-v(i,J-1,k))*US%m_to_L*G%IdyT(i,j)) & +0.25*(((str_xy(I,J)-RoScl*bhstr_xy(I,J))*( & (u(I,j+1,k)-u(I,j,k))*US%m_to_L*G%IdyBu(I,J) & +(v(i+1,J,k)-v(i,J,k))*US%m_to_L*G%IdxBu(I,J) ) & @@ -1870,7 +1870,7 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS, MEKE) enddo ; enddo do j=Jsq-1,Jeq+2 ; do i=Isq-1,Ieq+2 CS%DX2h(i,j) = US%L_to_m**2*G%dxT(i,j)*G%dxT(i,j) ; CS%DY2h(i,j) = US%L_to_m**2*G%dyT(i,j)*G%dyT(i,j) - CS%DX_dyT(i,j) = US%L_to_m*G%dxT(i,j)*G%IdyT(i,j) ; CS%DY_dxT(i,j) = US%L_to_m*G%dyT(i,j)*G%IdxT(i,j) + CS%DX_dyT(i,j) = G%dxT(i,j)*G%IdyT(i,j) ; CS%DY_dxT(i,j) = G%dyT(i,j)*G%IdxT(i,j) enddo ; enddo do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 diff --git a/src/parameterizations/lateral/MOM_internal_tides.F90 b/src/parameterizations/lateral/MOM_internal_tides.F90 index 002f8034db..e5ecb275a3 100644 --- a/src/parameterizations/lateral/MOM_internal_tides.F90 +++ b/src/parameterizations/lateral/MOM_internal_tides.F90 @@ -796,20 +796,20 @@ subroutine refract(En, cn, freq, dt, G, US, NAngle, use_PPMang) (G%CoriolisBu(I,J-1)**2 + G%CoriolisBu(I-1,J)**2)) favg = 0.25*US%s_to_T*((G%CoriolisBu(I,J) + G%CoriolisBu(I-1,J-1)) + & (G%CoriolisBu(I,J-1) + G%CoriolisBu(I-1,J))) - df2_dx = 0.5*US%s_to_T**2 * ((G%CoriolisBu(I,J)**2 + G%CoriolisBu(I,J-1)**2) - & + df2_dx = 0.5*US%m_to_L*US%s_to_T**2 * ((G%CoriolisBu(I,J)**2 + G%CoriolisBu(I,J-1)**2) - & (G%CoriolisBu(I-1,J)**2 + G%CoriolisBu(I-1,J-1)**2)) * & G%IdxT(i,j) - df_dx = 0.5*US%s_to_T*((G%CoriolisBu(I,J) + G%CoriolisBu(I,J-1)) - & + df_dx = 0.5*US%m_to_L*US%s_to_T*((G%CoriolisBu(I,J) + G%CoriolisBu(I,J-1)) - & (G%CoriolisBu(I-1,J) + G%CoriolisBu(I-1,J-1))) * & G%IdxT(i,j) dlnCn_dx = 0.5*( G%IdxCu(I,j) * (cn(i+1,j) - cn(i,j)) / & (0.5*(cn(i+1,j) + cn(i,j)) + cn_subRO) + & G%IdxCu(I-1,j) * (cn(i,j) - cn(i-1,j)) / & (0.5*(cn(i,j) + cn(i-1,j)) + cn_subRO) ) - df2_dy = 0.5*US%s_to_T**2 * ((G%CoriolisBu(I,J)**2 + G%CoriolisBu(I-1,J)**2) - & + df2_dy = 0.5*US%m_to_L*US%s_to_T**2 * ((G%CoriolisBu(I,J)**2 + G%CoriolisBu(I-1,J)**2) - & (G%CoriolisBu(I,J-1)**2 + G%CoriolisBu(I-1,J-1)**2)) * & G%IdyT(i,j) - df_dy = 0.5*US%s_to_T*((G%CoriolisBu(I,J) + G%CoriolisBu(I-1,J)) - & + df_dy = 0.5*US%m_to_L*US%s_to_T*((G%CoriolisBu(I,J) + G%CoriolisBu(I-1,J)) - & (G%CoriolisBu(I,J-1) + G%CoriolisBu(I-1,J-1))) * & G%IdyT(i,j) dlnCn_dy = 0.5*( G%IdyCv(i,J) * (cn(i,j+1) - cn(i,j)) / & @@ -1536,14 +1536,14 @@ subroutine zonal_flux_En(u, h, hL, hR, uh, dt, G, US, j, ish, ieh, vol_CFL) do I=ish-1,ieh ! Set new values of uh and duhdu. if (u(I) > 0.0) then - if (vol_CFL) then ; CFL = (u(I) * dt) * (US%L_to_m*G%dy_Cu(I,j) * US%m_to_L**2*G%IareaT(i,j)) - else ; CFL = u(I) * dt * G%IdxT(i,j) ; endif + if (vol_CFL) then ; CFL = (u(I) * dt) * (G%dy_Cu(I,j) * US%m_to_L*G%IareaT(i,j)) + else ; CFL = u(I) * dt * US%m_to_L*G%IdxT(i,j) ; endif curv_3 = (hL(i) + hR(i)) - 2.0*h(i) uh(I) = US%L_to_m*G%dy_Cu(I,j) * u(I) * & (hR(i) + CFL * (0.5*(hL(i) - hR(i)) + curv_3*(CFL - 1.5))) elseif (u(I) < 0.0) then - if (vol_CFL) then ; CFL = (-u(I) * dt) * (US%L_to_m*G%dy_Cu(I,j) * US%m_to_L**2*G%IareaT(i+1,j)) - else ; CFL = -u(I) * dt * G%IdxT(i+1,j) ; endif + if (vol_CFL) then ; CFL = (-u(I) * dt) * (G%dy_Cu(I,j) * US%m_to_L*G%IareaT(i+1,j)) + else ; CFL = -u(I) * dt * US%m_to_L*G%IdxT(i+1,j) ; endif curv_3 = (hL(i+1) + hR(i+1)) - 2.0*h(i+1) uh(I) = US%L_to_m*G%dy_Cu(I,j) * u(I) * & (hL(i+1) + CFL * (0.5*(hR(i+1)-hL(i+1)) + curv_3*(CFL - 1.5))) @@ -1580,14 +1580,14 @@ subroutine merid_flux_En(v, h, hL, hR, vh, dt, G, US, J, ish, ieh, vol_CFL) do i=ish,ieh if (v(i) > 0.0) then - if (vol_CFL) then ; CFL = (v(i) * dt) * (US%L_to_m*G%dx_Cv(i,J) * US%m_to_L**2*G%IareaT(i,j)) - else ; CFL = v(i) * dt * G%IdyT(i,j) ; endif + if (vol_CFL) then ; CFL = (v(i) * dt) * (G%dx_Cv(i,J) * US%m_to_L*G%IareaT(i,j)) + else ; CFL = v(i) * dt * US%m_to_L*G%IdyT(i,j) ; endif curv_3 = hL(i,j) + hR(i,j) - 2.0*h(i,j) vh(i) = US%L_to_m*G%dx_Cv(i,J) * v(i) * ( hR(i,j) + CFL * & (0.5*(hL(i,j) - hR(i,j)) + curv_3*(CFL - 1.5)) ) elseif (v(i) < 0.0) then - if (vol_CFL) then ; CFL = (-v(i) * dt) * (US%L_to_m*G%dx_Cv(i,J) * US%m_to_L**2*G%IareaT(i,j+1)) - else ; CFL = -v(i) * dt * G%IdyT(i,j+1) ; endif + if (vol_CFL) then ; CFL = (-v(i) * dt) * (G%dx_Cv(i,J) * US%m_to_L*G%IareaT(i,j+1)) + else ; CFL = -v(i) * dt * US%m_to_L*G%IdyT(i,j+1) ; endif curv_3 = hL(i,j+1) + hR(i,j+1) - 2.0*h(i,j+1) vh(i) = US%L_to_m*G%dx_Cv(i,J) * v(i) * ( hL(i,j+1) + CFL * & (0.5*(hR(i,j+1)-hL(i,j+1)) + curv_3*(CFL - 1.5)) ) From 4bf27c6b6c8cffe0ea7e18b469c59e01535d33a7 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Mon, 5 Aug 2019 06:00:45 -0400 Subject: [PATCH 152/297] +Rescaled the units of G%IdyCu and G%IdxCv Rescaled G%IdyCu and G%IdxCv throughout the MOM6 code to units of [L-1]. All answers are bitwise identical, but the units of two elements a public type have changed. --- src/core/MOM_CoriolisAdv.F90 | 16 ++--- src/core/MOM_grid.F90 | 8 +-- src/diagnostics/MOM_PointAccel.F90 | 16 ++--- src/diagnostics/MOM_diagnostics.F90 | 4 +- src/framework/MOM_dyn_horgrid.F90 | 8 +-- src/initialization/MOM_grid_initialize.F90 | 7 +- .../MOM_shared_initialization.F90 | 2 +- .../lateral/MOM_hor_visc.F90 | 68 +++++++++---------- .../lateral/MOM_lateral_mixing_coeffs.F90 | 36 +++++----- .../lateral/MOM_mixed_layer_restrat.F90 | 4 +- .../lateral/MOM_thickness_diffuse.F90 | 4 +- 11 files changed, 86 insertions(+), 87 deletions(-) diff --git a/src/core/MOM_CoriolisAdv.F90 b/src/core/MOM_CoriolisAdv.F90 index 2cce10933d..343acd461d 100644 --- a/src/core/MOM_CoriolisAdv.F90 +++ b/src/core/MOM_CoriolisAdv.F90 @@ -618,16 +618,16 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS) ! Note: Heffs are in lieu of h_at_v that should be returned by the ! continuity solver. AJA do j=js,je ; do I=Isq,Ieq - Heff1 = abs(vh(i,J,k) * US%L_to_m*G%IdxCv(i,J)) / (US%m_s_to_L_T*(eps_vel+abs(v(i,J,k)))) + Heff1 = abs(vh(i,J,k) * G%IdxCv(i,J)) / (US%m_s_to_L_T*(eps_vel+abs(v(i,J,k)))) Heff1 = max(Heff1, min(h(i,j,k),h(i,j+1,k))) Heff1 = min(Heff1, max(h(i,j,k),h(i,j+1,k))) - Heff2 = abs(vh(i,J-1,k) * US%L_to_m*G%IdxCv(i,J-1)) / (US%m_s_to_L_T*(eps_vel+abs(v(i,J-1,k)))) + Heff2 = abs(vh(i,J-1,k) * G%IdxCv(i,J-1)) / (US%m_s_to_L_T*(eps_vel+abs(v(i,J-1,k)))) Heff2 = max(Heff2, min(h(i,j-1,k),h(i,j,k))) Heff2 = min(Heff2, max(h(i,j-1,k),h(i,j,k))) - Heff3 = abs(vh(i+1,J,k) * US%L_to_m*G%IdxCv(i+1,J)) / (US%m_s_to_L_T*(eps_vel+abs(v(i+1,J,k)))) + Heff3 = abs(vh(i+1,J,k) * G%IdxCv(i+1,J)) / (US%m_s_to_L_T*(eps_vel+abs(v(i+1,J,k)))) Heff3 = max(Heff3, min(h(i+1,j,k),h(i+1,j+1,k))) Heff3 = min(Heff3, max(h(i+1,j,k),h(i+1,j+1,k))) - Heff4 = abs(vh(i+1,J-1,k) * US%L_to_m*G%IdxCv(i+1,J-1)) / (US%m_s_to_L_T*(eps_vel+abs(v(i+1,J-1,k)))) + Heff4 = abs(vh(i+1,J-1,k) * G%IdxCv(i+1,J-1)) / (US%m_s_to_L_T*(eps_vel+abs(v(i+1,J-1,k)))) Heff4 = max(Heff4, min(h(i+1,j-1,k),h(i+1,j,k))) Heff4 = min(Heff4, max(h(i+1,j-1,k),h(i+1,j,k))) if (CS%PV_Adv_Scheme == PV_ADV_CENTERED) then @@ -724,16 +724,16 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS) ! Note: Heffs are in lieu of h_at_u that should be returned by the ! continuity solver. AJA do J=Jsq,Jeq ; do i=is,ie - Heff1 = abs(uh(I,j,k) * US%L_to_m*G%IdyCu(I,j)) / (US%m_s_to_L_T*(eps_vel+abs(u(I,j,k)))) + Heff1 = abs(uh(I,j,k) * G%IdyCu(I,j)) / (US%m_s_to_L_T*(eps_vel+abs(u(I,j,k)))) Heff1 = max(Heff1, min(h(i,j,k),h(i+1,j,k))) Heff1 = min(Heff1, max(h(i,j,k),h(i+1,j,k))) - Heff2 = abs(uh(I-1,j,k) * US%L_to_m*G%IdyCu(I-1,j)) / (US%m_s_to_L_T*(eps_vel+abs(u(I-1,j,k)))) + Heff2 = abs(uh(I-1,j,k) * G%IdyCu(I-1,j)) / (US%m_s_to_L_T*(eps_vel+abs(u(I-1,j,k)))) Heff2 = max(Heff2, min(h(i-1,j,k),h(i,j,k))) Heff2 = min(Heff2, max(h(i-1,j,k),h(i,j,k))) - Heff3 = abs(uh(I,j+1,k) * US%L_to_m*G%IdyCu(I,j+1)) / (US%m_s_to_L_T*(eps_vel+abs(u(I,j+1,k)))) + Heff3 = abs(uh(I,j+1,k) * G%IdyCu(I,j+1)) / (US%m_s_to_L_T*(eps_vel+abs(u(I,j+1,k)))) Heff3 = max(Heff3, min(h(i,j+1,k),h(i+1,j+1,k))) Heff3 = min(Heff3, max(h(i,j+1,k),h(i+1,j+1,k))) - Heff4 = abs(uh(I-1,j+1,k) * US%L_to_m*G%IdyCu(I-1,j+1)) / (US%m_s_to_L_T*(eps_vel+abs(u(I-1,j+1,k)))) + Heff4 = abs(uh(I-1,j+1,k) * G%IdyCu(I-1,j+1)) / (US%m_s_to_L_T*(eps_vel+abs(u(I-1,j+1,k)))) Heff4 = max(Heff4, min(h(i-1,j+1,k),h(i,j+1,k))) Heff4 = min(Heff4, max(h(i-1,j+1,k),h(i,j+1,k))) if (CS%PV_Adv_Scheme == PV_ADV_CENTERED) then diff --git a/src/core/MOM_grid.F90 b/src/core/MOM_grid.F90 index 3ec744533a..6b642d3b80 100644 --- a/src/core/MOM_grid.F90 +++ b/src/core/MOM_grid.F90 @@ -95,7 +95,7 @@ module MOM_grid dxCu, & !< dxCu is delta x at u points [L ~> m]. IdxCu, & !< 1/dxCu [m-1]. dyCu, & !< dyCu is delta y at u points [L ~> m]. - IdyCu, & !< 1/dyCu [m-1]. + IdyCu, & !< 1/dyCu [L-1 ~> m-1]. dy_Cu, & !< The unblocked lengths of the u-faces of the h-cell [L ~> m]. IareaCu, & !< The masked inverse areas of u-grid cells [L-2 ~> m-2]. areaCu !< The areas of the u-grid cells [L2 ~> m2]. @@ -105,7 +105,7 @@ module MOM_grid geoLatCv, & !< The geographic latitude at v points in degrees of latitude or m. geoLonCv, & !< The geographic longitude at v points in degrees of longitude or m. dxCv, & !< dxCv is delta x at v points [L ~> m]. - IdxCv, & !< 1/dxCv [m-1]. + IdxCv, & !< 1/dxCv [L-1 ~> m-1]. dyCv, & !< dyCv is delta y at v points [L ~> m]. IdyCv, & !< 1/dyCv [m-1]. dx_Cv, & !< The unblocked lengths of the v-faces of the h-cell [L ~> m]. @@ -432,13 +432,13 @@ subroutine set_derived_metrics(G, US) if (G%dxCu(I,j) < 0.0) G%dxCu(I,j) = 0.0 if (G%dyCu(I,j) < 0.0) G%dyCu(I,j) = 0.0 G%IdxCu(I,j) = Adcroft_reciprocal(US%L_to_m*G%dxCu(I,j)) - G%IdyCu(I,j) = Adcroft_reciprocal(US%L_to_m*G%dyCu(I,j)) + G%IdyCu(I,j) = Adcroft_reciprocal(G%dyCu(I,j)) enddo ; enddo do J=JsdB,JedB ; do i=isd,ied if (G%dxCv(i,J) < 0.0) G%dxCv(i,J) = 0.0 if (G%dyCv(i,J) < 0.0) G%dyCv(i,J) = 0.0 - G%IdxCv(i,J) = Adcroft_reciprocal(US%L_to_m*G%dxCv(i,J)) + G%IdxCv(i,J) = Adcroft_reciprocal(G%dxCv(i,J)) G%IdyCv(i,J) = Adcroft_reciprocal(US%L_to_m*G%dyCv(i,J)) enddo ; enddo diff --git a/src/diagnostics/MOM_PointAccel.F90 b/src/diagnostics/MOM_PointAccel.F90 index ca89dfc1c4..9d4242bfdc 100644 --- a/src/diagnostics/MOM_PointAccel.F90 +++ b/src/diagnostics/MOM_PointAccel.F90 @@ -285,7 +285,7 @@ subroutine write_u_accel(I, j, um, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st write(file,'(/,"vh--: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - (uh_scale*CDp%vh(i,J-1,k)*G%IdxCv(i,J-1)); enddo + (uh_scale*CDp%vh(i,J-1,k)*US%m_to_L*G%IdxCv(i,J-1)); enddo write(file,'(/," vhC--:",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & (0.5*CS%v_av(i,j-1,k)*h_scale*(hin(i,j-1,k) + hin(i,j,k))); enddo @@ -297,7 +297,7 @@ subroutine write_u_accel(I, j, um, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st write(file,'(/,"vh-+: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - (uh_scale*CDp%vh(i,J,k)*G%IdxCv(i,J)); enddo + (uh_scale*CDp%vh(i,J,k)*US%m_to_L*G%IdxCv(i,J)); enddo write(file,'(/," vhC-+:",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & (0.5*CS%v_av(i,J,k)*h_scale*(hin(i,j,k) + hin(i,j+1,k))); enddo @@ -309,7 +309,7 @@ subroutine write_u_accel(I, j, um, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st write(file,'(/,"vh+-: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - (uh_scale*CDp%vh(i+1,J-1,k)*G%IdxCv(i+1,J-1)); enddo + (uh_scale*CDp%vh(i+1,J-1,k)*US%m_to_L*G%IdxCv(i+1,J-1)); enddo write(file,'(/," vhC+-:",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & (0.5*CS%v_av(i+1,J-1,k)*h_scale*(hin(i+1,j-1,k) + hin(i+1,j,k))); enddo @@ -321,7 +321,7 @@ subroutine write_u_accel(I, j, um, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st write(file,'(/,"vh++: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - (uh_scale*CDp%vh(i+1,J,k)*G%IdxCv(i+1,J)); enddo + (uh_scale*CDp%vh(i+1,J,k)*US%m_to_L*G%IdxCv(i+1,J)); enddo write(file,'(/," vhC++:",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & (0.5*CS%v_av(i+1,J,k)*h_scale*(hin(i+1,j,k) + hin(i+1,j+1,k))); enddo @@ -619,7 +619,7 @@ subroutine write_v_accel(i, J, vm, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st write(file,'(/,"uh--: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - (uh_scale*CDp%uh(I-1,j,k)*G%IdyCu(I-1,j)); enddo + (uh_scale*CDp%uh(I-1,j,k)*US%m_to_L*G%IdyCu(I-1,j)); enddo write(file,'(/," uhC--: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & (CS%u_av(I-1,j,k) * h_scale*0.5*(hin(i-1,j,k) + hin(i,j,k))); enddo @@ -631,7 +631,7 @@ subroutine write_v_accel(i, J, vm, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st write(file,'(/,"uh-+: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - (uh_scale*CDp%uh(I-1,j+1,k)*G%IdyCu(I-1,j+1)); enddo + (uh_scale*CDp%uh(I-1,j+1,k)*US%m_to_L*G%IdyCu(I-1,j+1)); enddo write(file,'(/," uhC-+: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & (CS%u_av(I-1,j+1,k) * h_scale*0.5*(hin(i-1,j+1,k) + hin(i,j+1,k))); enddo @@ -643,7 +643,7 @@ subroutine write_v_accel(i, J, vm, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st write(file,'(/,"uh+-: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - (uh_scale*CDp%uh(I,j,k)*G%IdyCu(I,j)); enddo + (uh_scale*CDp%uh(I,j,k)*US%m_to_L*G%IdyCu(I,j)); enddo write(file,'(/," uhC+-: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & (CS%u_av(I,j,k) * h_scale*0.5*(hin(i,j,k) + hin(i+1,j,k))); enddo @@ -655,7 +655,7 @@ subroutine write_v_accel(i, J, vm, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st write(file,'(/,"uh++: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - (uh_scale*CDp%uh(I,j+1,k)*G%IdyCu(I,j+1)); enddo + (uh_scale*CDp%uh(I,j+1,k)*US%m_to_L*G%IdyCu(I,j+1)); enddo write(file,'(/," uhC++: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & (CS%u_av(I,j+1,k) * 0.5*h_scale*(hin(i,j+1,k) + hin(i+1,j+1,k))); enddo diff --git a/src/diagnostics/MOM_diagnostics.F90 b/src/diagnostics/MOM_diagnostics.F90 index a84916aae2..a2bd76766c 100644 --- a/src/diagnostics/MOM_diagnostics.F90 +++ b/src/diagnostics/MOM_diagnostics.F90 @@ -629,7 +629,7 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & f2_h = absurdly_small_freq2 + 0.25 * 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)) - mag_beta = sqrt(0.5 * US%s_to_T**2 * ( & + mag_beta = sqrt(0.5 * US%s_to_T**2*US%m_to_L**2 * ( & (((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 + & @@ -678,7 +678,7 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & f2_h = absurdly_small_freq2 + 0.25 * 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)) - mag_beta = sqrt(0.5 * US%s_to_T**2 * ( & + mag_beta = sqrt(0.5 * US%s_to_T**2*US%m_to_L**2 * ( & (((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/framework/MOM_dyn_horgrid.F90 b/src/framework/MOM_dyn_horgrid.F90 index ae0018d9ba..f72950e9ed 100644 --- a/src/framework/MOM_dyn_horgrid.F90 +++ b/src/framework/MOM_dyn_horgrid.F90 @@ -91,7 +91,7 @@ module MOM_dyn_horgrid dxCu, & !< dxCu is delta x at u points [L ~> m]. IdxCu, & !< 1/dxCu [m-1]. dyCu, & !< dyCu is delta y at u points [L ~> m]. - IdyCu, & !< 1/dyCu [m-1]. + IdyCu, & !< 1/dyCu [L-1 ~> m-1]. dy_Cu, & !< The unblocked lengths of the u-faces of the h-cell [L ~> m]. IareaCu, & !< The masked inverse areas of u-grid cells [L-2 ~> m-2]. areaCu !< The areas of the u-grid cells [L2 ~> m2]. @@ -101,7 +101,7 @@ module MOM_dyn_horgrid geoLatCv, & !< The geographic latitude at v points [degrees of latitude] or [m]. geoLonCv, & !< The geographic longitude at v points [degrees of longitude] or [m]. dxCv, & !< dxCv is delta x at v points [L ~> m]. - IdxCv, & !< 1/dxCv [m-1]. + IdxCv, & !< 1/dxCv [L-1 ~> m-1]. dyCv, & !< dyCv is delta y at v points [L ~> m]. IdyCv, & !< 1/dyCv [m-1]. dx_Cv, & !< The unblocked lengths of the v-faces of the h-cell [L ~> m]. @@ -340,13 +340,13 @@ subroutine set_derived_dyn_horgrid(G, US) if (G%dxCu(I,j) < 0.0) G%dxCu(I,j) = 0.0 if (G%dyCu(I,j) < 0.0) G%dyCu(I,j) = 0.0 G%IdxCu(I,j) = Adcroft_reciprocal(L_to_m*G%dxCu(I,j)) - G%IdyCu(I,j) = Adcroft_reciprocal(L_to_m*G%dyCu(I,j)) + G%IdyCu(I,j) = Adcroft_reciprocal(G%dyCu(I,j)) enddo ; enddo do J=JsdB,JedB ; do i=isd,ied if (G%dxCv(i,J) < 0.0) G%dxCv(i,J) = 0.0 if (G%dyCv(i,J) < 0.0) G%dyCv(i,J) = 0.0 - G%IdxCv(i,J) = Adcroft_reciprocal(L_to_m*G%dxCv(i,J)) + G%IdxCv(i,J) = Adcroft_reciprocal(G%dxCv(i,J)) G%IdyCv(i,J) = Adcroft_reciprocal(L_to_m*G%dyCv(i,J)) enddo ; enddo diff --git a/src/initialization/MOM_grid_initialize.F90 b/src/initialization/MOM_grid_initialize.F90 index 7bf2295b15..310c665c3d 100644 --- a/src/initialization/MOM_grid_initialize.F90 +++ b/src/initialization/MOM_grid_initialize.F90 @@ -138,8 +138,7 @@ subroutine grid_metrics_chksum(parent, G, US) call uvchksum(trim(parent)//': Id[xy]C[uv]', & G%IdxCu, G%IdyCv, G%HI, haloshift=halo) - call uvchksum(trim(parent)//': Id[xy]C[uv]', & - G%IdyCu, G%IdxCv, G%HI, haloshift=halo) + call uvchksum(trim(parent)//': Id[xy]C[uv]', G%IdyCu, G%IdxCv, G%HI, haloshift=halo, scale=m_to_L) call Bchksum_pair(trim(parent)//': Id[xy]B[uv]', G%IdxBu, G%IdyBu, G%HI, haloshift=halo, scale=m_to_L) @@ -532,13 +531,13 @@ subroutine set_grid_metrics_cartesian(G, param_file, US) G%geoLonCu(I,j) = grid_lonB(I) ; G%geoLatCu(I,j) = grid_LatT(j) G%dxCu(I,j) = m_to_L*dx_everywhere ; G%IdxCu(I,j) = I_dx - G%dyCu(I,j) = m_to_L*dy_everywhere ; G%IdyCu(I,j) = I_dy + G%dyCu(I,j) = m_to_L*dy_everywhere ; G%IdyCu(I,j) = L_to_m*I_dy enddo ; enddo do J=JsdB,JedB ; do i=isd,ied G%geoLonCv(i,J) = grid_lonT(i) ; G%geoLatCv(i,J) = grid_latB(J) - G%dxCv(i,J) = m_to_L*dx_everywhere ; G%IdxCv(i,J) = I_dx + G%dxCv(i,J) = m_to_L*dx_everywhere ; G%IdxCv(i,J) = L_to_m*I_dx G%dyCv(i,J) = m_to_L*dy_everywhere ; G%IdyCv(i,J) = I_dy enddo ; enddo diff --git a/src/initialization/MOM_shared_initialization.F90 b/src/initialization/MOM_shared_initialization.F90 index 35a590c753..716bc544e7 100644 --- a/src/initialization/MOM_shared_initialization.F90 +++ b/src/initialization/MOM_shared_initialization.F90 @@ -672,7 +672,7 @@ subroutine reset_face_lengths_named(G, param_file, name, US) enddo ; enddo do J=JsdB,JedB ; do i=isd,ied ! Change any v-face lengths within this loop. - dy_2 = dx_2 * L_to_m*G%dyCv(i,J)*G%IdxCv(i,J) * cos(pi_180 * G%geoLatCv(i,J)) + dy_2 = dx_2 * G%dyCv(i,J)*G%IdxCv(i,J) * cos(pi_180 * G%geoLatCv(i,J)) if ((abs(G%geoLatCv(i,J)-41.0) < dy_2) .and. (abs(G%geoLonCv(i,J)-28.5) < dx_2)) & G%dx_Cv(i,J) = G%mask2dCv(i,J)*2500.0*m_to_L ! Bosporus - should be 1000.0 m wide. diff --git a/src/parameterizations/lateral/MOM_hor_visc.F90 b/src/parameterizations/lateral/MOM_hor_visc.F90 index eab5b8af63..15cd33a9cd 100644 --- a/src/parameterizations/lateral/MOM_hor_visc.F90 +++ b/src/parameterizations/lateral/MOM_hor_visc.F90 @@ -432,9 +432,9 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, !#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) - & + dudx_bt(i,j) = CS%DY_dxT(i,j)*US%m_to_L*(G%IdyCu(I,j) * ubtav(I,j) - & G%IdyCu(I-1,j) * ubtav(I-1,j)) - dvdy_bt(i,j) = CS%DX_dyT(i,j)*(G%IdxCv(i,J) * vbtav(i,J) - & + dvdy_bt(i,j) = CS%DX_dyT(i,j)*US%m_to_L*(G%IdxCv(i,J) * vbtav(i,J) - & G%IdxCv(i,J-1) * vbtav(i,J-1)) enddo; enddo @@ -527,9 +527,9 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, ! Calculate horizontal tension do j=Jsq-1,Jeq+2 ; do i=Isq-1,Ieq+2 - dudx(i,j) = CS%DY_dxT(i,j)*(G%IdyCu(I,j) * u(I,j,k) - & + dudx(i,j) = CS%DY_dxT(i,j)*US%m_to_L*(G%IdyCu(I,j) * u(I,j,k) - & G%IdyCu(I-1,j) * u(I-1,j,k)) - dvdy(i,j) = CS%DX_dyT(i,j)*(G%IdxCv(i,J) * v(i,J,k) - & + dvdy(i,j) = CS%DX_dyT(i,j)*US%m_to_L*(G%IdxCv(i,J) * v(i,J,k) - & G%IdxCv(i,J-1) * v(i,J-1,k)) sh_xx(i,j) = dudx(i,j) - dvdy(i,j) enddo ; enddo @@ -739,12 +739,12 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, ! Vorticity gradient do J=js-2,Jeq+1 ; do i=is-1,Ieq+1 DY_dxBu = G%dyBu(I,J) * G%IdxBu(I,J) - vort_xy_dx(i,J) = DY_dxBu * (vort_xy(I,J) * G%IdyCu(I,j) - vort_xy(I-1,J) * G%IdyCu(I-1,j)) + vort_xy_dx(i,J) = DY_dxBu * US%m_to_L*(vort_xy(I,J) * G%IdyCu(I,j) - vort_xy(I-1,J) * G%IdyCu(I-1,j)) enddo ; enddo do j=js-1,Jeq+1 ; do I=is-2,Ieq+1 DX_dyBu = G%dxBu(I,J) * G%IdyBu(I,J) - vort_xy_dy(I,j) = DX_dyBu * (vort_xy(I,J) * G%IdxCv(i,J) - vort_xy(I,J-1) * G%IdxCv(i,J-1)) + vort_xy_dy(I,j) = DX_dyBu * US%m_to_L*(vort_xy(I,J) * G%IdxCv(i,J) - vort_xy(I,J-1) * G%IdxCv(i,J-1)) enddo ; enddo call pass_vector(vort_xy_dy, vort_xy_dx, G%Domain) @@ -953,13 +953,13 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, if ((CS%id_Ah_h>0) .or. find_FrictWork .or. CS%debug) Ah_h(i,j,k) = 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))) + (CS%DY_dxT(i,j)*US%m_to_L*(G%IdyCu(I,j)*u0(I,j) - G%IdyCu(I-1,j)*u0(I-1,j)) - & + CS%DX_dyT(i,j) *US%m_to_L*(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 * & - (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))) + (CS%DY_dxT(i,j)*US%m_to_L*(G%IdyCu(I,j)*u0(I,j) - G%IdyCu(I-1,j)*u0(I-1,j)) - & + CS%DX_dyT(i,j) *US%m_to_L*(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)) endif ! biharmonic @@ -1273,7 +1273,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%m_to_L*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))) * & @@ -1297,7 +1297,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, 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) - & CS%DY2q(I,J) *str_xy(I,J)) - & - G%IdxCv(i,J)*(CS%DX2h(i,j) *str_xx(i,j) - & + US%m_to_L*G%IdxCv(i,J)*(CS%DX2h(i,j) *str_xx(i,j) - & CS%DX2h(i,j+1)*str_xx(i,j+1))) * & US%m_to_L**2*G%IareaCv(i,J)) / (h_v(i,J) + h_neglect) enddo ; enddo @@ -1967,12 +1967,12 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS, MEKE) if (CS%biharmonic) then do j=js-1,Jeq+1 ; do I=Isq-1,Ieq+1 - CS%IDX2dyCu(I,j) = (G%IdxCu(I,j)*G%IdxCu(I,j)) * G%IdyCu(I,j) - CS%IDXDY2u(I,j) = G%IdxCu(I,j) * (G%IdyCu(I,j)*G%IdyCu(I,j)) + CS%IDX2dyCu(I,j) = (G%IdxCu(I,j)*G%IdxCu(I,j)) * US%m_to_L*G%IdyCu(I,j) + CS%IDXDY2u(I,j) = G%IdxCu(I,j) * US%m_to_L**2*(G%IdyCu(I,j)*G%IdyCu(I,j)) enddo ; enddo do J=Jsq-1,Jeq+1 ; do i=is-1,Ieq+1 - CS%IDX2dyCv(i,J) = (G%IdxCv(i,J)*G%IdxCv(i,J)) * G%IdyCv(i,J) - CS%IDXDY2v(i,J) = G%IdxCv(i,J) * (G%IdyCv(i,J)*G%IdyCv(i,J)) + CS%IDX2dyCv(i,J) = US%m_to_L**2*(G%IdxCv(i,J)*G%IdxCv(i,J)) * G%IdyCv(i,J) + CS%IDXDY2v(i,J) = US%m_to_L*G%IdxCv(i,J) * (G%IdyCv(i,J)*G%IdyCv(i,J)) enddo ; enddo CS%Ah_bg_xy(:,:) = 0.0 @@ -2035,10 +2035,10 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS, MEKE) Idt = 1.0 / dt do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 denom = max( & - (CS%DY2h(i,j) * CS%DY_dxT(i,j) * (G%IdyCu(I,j) + G%IdyCu(I-1,j)) * & - max(G%IdyCu(I,j)*US%m_to_L**2*G%IareaCu(I,j), G%IdyCu(I-1,j)*US%m_to_L**2*G%IareaCu(I-1,j)) ), & - (CS%DX2h(i,j) * CS%DX_dyT(i,j) * (G%IdxCv(i,J) + G%IdxCv(i,J-1)) * & - max(G%IdxCv(i,J)*US%m_to_L**2*G%IareaCv(i,J), G%IdxCv(i,J-1)*US%m_to_L**2*G%IareaCv(i,J-1)) ) ) + (CS%DY2h(i,j) * CS%DY_dxT(i,j) * US%m_to_L*(G%IdyCu(I,j) + G%IdyCu(I-1,j)) * & + US%m_to_L**3*max(G%IdyCu(I,j)*G%IareaCu(I,j), G%IdyCu(I-1,j)*G%IareaCu(I-1,j)) ), & + (CS%DX2h(i,j) * CS%DX_dyT(i,j) * US%m_to_L*(G%IdxCv(i,J) + G%IdxCv(i,J-1)) * & + US%m_to_L**3*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 @@ -2064,38 +2064,38 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS, MEKE) if (CS%biharmonic .and. CS%better_bound_Ah) then Idt = 1.0 / dt do j=js-1,Jeq+1 ; do I=Isq-1,Ieq+1 - u0u(I,j) = CS%IDXDY2u(I,j)*(CS%DY2h(i+1,j)*CS%DY_dxT(i+1,j)*(G%IdyCu(I+1,j) + G%IdyCu(I,j)) + & - CS%DY2h(i,j) * CS%DY_dxT(i,j) * (G%IdyCu(I,j) + G%IdyCu(I-1,j)) ) + & + u0u(I,j) = CS%IDXDY2u(I,j)*(CS%DY2h(i+1,j)*CS%DY_dxT(i+1,j)*US%m_to_L*(G%IdyCu(I+1,j) + G%IdyCu(I,j)) + & + CS%DY2h(i,j) * CS%DY_dxT(i,j) * US%m_to_L*(G%IdyCu(I,j) + G%IdyCu(I-1,j)) ) + & CS%IDX2dyCu(I,j)*(CS%DX2q(I,J) * CS%DX_dyBu(I,J) * (G%IdxCu(I,j+1) + G%IdxCu(I,j)) + & CS%DX2q(I,J-1)*CS%DX_dyBu(I,J-1)*(G%IdxCu(I,j) + G%IdxCu(I,j-1)) ) - u0v(I,j) = CS%IDXDY2u(I,j)*(CS%DY2h(i+1,j)*CS%DX_dyT(i+1,j)*(G%IdxCv(i+1,J) + G%IdxCv(i+1,J-1)) + & - CS%DY2h(i,j) * CS%DX_dyT(i,j) * (G%IdxCv(i,J) + G%IdxCv(i,J-1)) ) + & + u0v(I,j) = CS%IDXDY2u(I,j)*(CS%DY2h(i+1,j)*CS%DX_dyT(i+1,j)*US%m_to_L*(G%IdxCv(i+1,J) + G%IdxCv(i+1,J-1)) + & + CS%DY2h(i,j) * CS%DX_dyT(i,j) * US%m_to_L*(G%IdxCv(i,J) + G%IdxCv(i,J-1)) ) + & CS%IDX2dyCu(I,j)*(CS%DX2q(I,J) * CS%DY_dxBu(I,J) * (G%IdyCv(i+1,J) + G%IdyCv(i,J)) + & CS%DX2q(I,J-1)*CS%DY_dxBu(I,J-1)*(G%IdyCv(i+1,J-1) + G%IdyCv(i,J-1)) ) enddo ; enddo do J=Jsq-1,Jeq+1 ; do i=is-1,Ieq+1 v0u(i,J) = CS%IDXDY2v(i,J)*(CS%DY2q(I,J) * CS%DX_dyBu(I,J) * (G%IdxCu(I,j+1) + G%IdxCu(I,j)) + & CS%DY2q(I-1,J)*CS%DX_dyBu(I-1,J)*(G%IdxCu(I-1,j+1) + G%IdxCu(I-1,j)) ) + & - CS%IDX2dyCv(i,J)*(CS%DX2h(i,j+1)*CS%DY_dxT(i,j+1)*(G%IdyCu(I,j+1) + G%IdyCu(I-1,j+1)) + & - CS%DX2h(i,j) * CS%DY_dxT(i,j) * (G%IdyCu(I,j) + G%IdyCu(I-1,j)) ) + CS%IDX2dyCv(i,J)*(CS%DX2h(i,j+1)*CS%DY_dxT(i,j+1)*US%m_to_L*(G%IdyCu(I,j+1) + G%IdyCu(I-1,j+1)) + & + CS%DX2h(i,j) * CS%DY_dxT(i,j) * US%m_to_L*(G%IdyCu(I,j) + G%IdyCu(I-1,j)) ) v0v(i,J) = CS%IDXDY2v(i,J)*(CS%DY2q(I,J) * CS%DY_dxBu(I,J) * (G%IdyCv(i+1,J) + G%IdyCv(i,J)) + & CS%DY2q(I-1,J)*CS%DY_dxBu(I-1,J)*(G%IdyCv(i,J) + G%IdyCv(i-1,J)) ) + & - CS%IDX2dyCv(i,J)*(CS%DX2h(i,j+1)*CS%DX_dyT(i,j+1)*(G%IdxCv(i,J+1) + G%IdxCv(i,J)) + & - CS%DX2h(i,j) * CS%DX_dyT(i,j) * (G%IdxCv(i,J) + G%IdxCv(i,J-1)) ) + CS%IDX2dyCv(i,J)*(CS%DX2h(i,j+1)*CS%DX_dyT(i,j+1)*US%m_to_L*(G%IdxCv(i,J+1) + G%IdxCv(i,J)) + & + CS%DX2h(i,j) * CS%DX_dyT(i,j) * US%m_to_L*(G%IdxCv(i,J) + G%IdxCv(i,J-1)) ) enddo ; enddo do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 denom = max( & (CS%DY2h(i,j) * & - (CS%DY_dxT(i,j)*(G%IdyCu(I,j)*u0u(I,j) + G%IdyCu(I-1,j)*u0u(I-1,j)) + & - CS%DX_dyT(i,j)*(G%IdxCv(i,J)*v0u(i,J) + G%IdxCv(i,J-1)*v0u(i,J-1))) * & - max(G%IdyCu(I,j)*US%m_to_L**2*G%IareaCu(I,j), G%IdyCu(I-1,j)*US%m_to_L**2*G%IareaCu(I-1,j)) ), & + (CS%DY_dxT(i,j)*US%m_to_L*(G%IdyCu(I,j)*u0u(I,j) + G%IdyCu(I-1,j)*u0u(I-1,j)) + & + CS%DX_dyT(i,j)*US%m_to_L*(G%IdxCv(i,J)*v0u(i,J) + G%IdxCv(i,J-1)*v0u(i,J-1))) * & + US%m_to_L**3*max(G%IdyCu(I,j)*G%IareaCu(I,j), G%IdyCu(I-1,j)*G%IareaCu(I-1,j)) ), & (CS%DX2h(i,j) * & - (CS%DY_dxT(i,j)*(G%IdyCu(I,j)*u0v(I,j) + G%IdyCu(I-1,j)*u0v(I-1,j)) + & - CS%DX_dyT(i,j)*(G%IdxCv(i,J)*v0v(i,J) + G%IdxCv(i,J-1)*v0v(i,J-1))) * & - max(G%IdxCv(i,J)*US%m_to_L**2*G%IareaCv(i,J), G%IdxCv(i,J-1)*US%m_to_L**2*G%IareaCv(i,J-1)) ) ) + (CS%DY_dxT(i,j)*US%m_to_L*(G%IdyCu(I,j)*u0v(I,j) + G%IdyCu(I-1,j)*u0v(I-1,j)) + & + CS%DX_dyT(i,j)*US%m_to_L*(G%IdxCv(i,J)*v0v(i,J) + G%IdxCv(i,J-1)*v0v(i,J-1))) * & + US%m_to_L**3*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 diff --git a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 index a2a8a7b682..0cf88a7ced 100644 --- a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 +++ b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 @@ -1121,32 +1121,32 @@ subroutine VarMix_init(Time, G, GV, US, param_file, diag, CS) CS%f2_dx2_q(I,J) = US%L_to_m**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 * US%L_to_m**2*((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 + & - ((G%CoriolisBu(I,J+1)-G%CoriolisBu(I,J)) * G%IdyCu(I,j+1))**2) ) )) + ( (((G%CoriolisBu(I,J)-G%CoriolisBu(I-1,J)) * US%m_to_L*G%IdxCv(i,J))**2 + & + ((G%CoriolisBu(I+1,J)-G%CoriolisBu(I,J)) * US%m_to_L*G%IdxCv(i+1,J))**2) + & + (((G%CoriolisBu(I,J)-G%CoriolisBu(I,J-1)) * US%m_to_L*G%IdyCu(I,j))**2 + & + ((G%CoriolisBu(I,J+1)-G%CoriolisBu(I,J)) * US%m_to_L*G%IdyCu(I,j+1))**2) ) )) enddo ; enddo do j=js,je ; do I=is-1,Ieq CS%f2_dx2_u(I,j) = ((US%L_to_m*G%dxCu(I,j))**2 + (US%L_to_m*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 * ((US%L_to_m*G%dxCu(I,j))**2 + (US%L_to_m*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 + & - ((G%CoriolisBu(I,J)-G%CoriolisBu(I-1,J)) * G%IdxCv(i,J))**2) ) + & - ((G%CoriolisBu(I,J)-G%CoriolisBu(I,J-1)) * G%IdyCu(I,j))**2 )) + 0.25*( (((G%CoriolisBu(I,J-1)-G%CoriolisBu(I-1,J-1)) * US%m_to_L*G%IdxCv(i,J-1))**2 + & + ((G%CoriolisBu(I+1,J)-G%CoriolisBu(I,J)) * US%m_to_L*G%IdxCv(i+1,J))**2) + & + (((G%CoriolisBu(I+1,J-1)-G%CoriolisBu(I,J-1)) * US%m_to_L*G%IdxCv(i+1,J-1))**2 + & + ((G%CoriolisBu(I,J)-G%CoriolisBu(I-1,J)) * US%m_to_L*G%IdxCv(i,J))**2) ) + & + ((G%CoriolisBu(I,J)-G%CoriolisBu(I,J-1)) * US%m_to_L*G%IdyCu(I,j))**2 )) enddo ; enddo do J=js-1,Jeq ; do i=is,ie CS%f2_dx2_v(i,J) = ((US%L_to_m*G%dxCv(i,J))**2 + (US%L_to_m*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 * ((US%L_to_m*G%dxCv(i,J))**2 + (US%L_to_m*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) + & - (((G%CoriolisBu(I,J+1)-G%CoriolisBu(I,J)) * G%IdyCu(I,j+1))**2 + & - ((G%CoriolisBu(I-1,J)-G%CoriolisBu(I-1,J-1)) * G%IdyCu(I-1,j))**2) ) )) + ((G%CoriolisBu(I,J)-G%CoriolisBu(I-1,J)) * US%m_to_L*G%IdxCv(i,J))**2 + & + 0.25*( (((G%CoriolisBu(I,J)-G%CoriolisBu(I,J-1)) * US%m_to_L*G%IdyCu(I,j))**2 + & + ((G%CoriolisBu(I-1,J+1)-G%CoriolisBu(I-1,J)) * US%m_to_L*G%IdyCu(I-1,j+1))**2) + & + (((G%CoriolisBu(I,J+1)-G%CoriolisBu(I,J)) * US%m_to_L*G%IdyCu(I,j+1))**2 + & + ((G%CoriolisBu(I-1,J)-G%CoriolisBu(I-1,J-1)) * US%m_to_L*G%IdyCu(I-1,j))**2) ) )) enddo ; enddo endif @@ -1167,10 +1167,10 @@ subroutine VarMix_init(Time, G, GV, US, param_file, diag, CS) (G%CoriolisBu(I-1,J)**2 + G%CoriolisBu(I,J-1)**2)), & absurdly_small_freq**2) CS%beta_dx2_h(i,j) = oneOrTwo * ((US%L_to_m*G%dxT(i,j))**2 + (US%L_to_m*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 + & - ((G%CoriolisBu(I-1,J)-G%CoriolisBu(I-1,J-1)) * G%IdyCu(I-1,j))**2) ) )) + ( (((G%CoriolisBu(I,J)-G%CoriolisBu(I-1,J)) * US%m_to_L*G%IdxCv(i,J))**2 + & + ((G%CoriolisBu(I,J-1)-G%CoriolisBu(I-1,J-1)) * US%m_to_L*G%IdxCv(i,J-1))**2) + & + (((G%CoriolisBu(I,J)-G%CoriolisBu(I,J-1)) * US%m_to_L*G%IdyCu(I,j))**2 + & + ((G%CoriolisBu(I-1,J)-G%CoriolisBu(I-1,J-1)) * US%m_to_L*G%IdyCu(I-1,j))**2) ) )) enddo ; enddo endif diff --git a/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 b/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 index c1520e68d7..574d478590 100644 --- a/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 +++ b/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 @@ -526,14 +526,14 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var if (CS%id_uml > 0) then do J=js,je ; do i=is-1,ie h_vel = 0.5*((htot_fast(i,j) + htot_fast(i+1,j)) + h_neglect) - uDml_diag(I,j) = uDml_diag(I,j) / (0.01*h_vel) * G%IdyCu(I,j) * (PSI(0.)-PSI(-.01)) + uDml_diag(I,j) = uDml_diag(I,j) / (0.01*h_vel) * US%m_to_L*G%IdyCu(I,j) * (PSI(0.)-PSI(-.01)) enddo ; enddo call post_data(CS%id_uml, uDml_diag, CS%diag) endif if (CS%id_vml > 0) then do J=js-1,je ; do i=is,ie h_vel = 0.5*((htot_fast(i,j) + htot_fast(i,j+1)) + h_neglect) - vDml_diag(i,J) = vDml_diag(i,J) / (0.01*h_vel) * G%IdxCv(i,J) * (PSI(0.)-PSI(-.01)) + vDml_diag(i,J) = vDml_diag(i,J) / (0.01*h_vel) * US%m_to_L*G%IdxCv(i,J) * (PSI(0.)-PSI(-.01)) enddo ; enddo call post_data(CS%id_vml, vDml_diag, CS%diag) endif diff --git a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 index f5ef54ffd2..4abc826328 100644 --- a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 +++ b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 @@ -183,12 +183,12 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp !$OMP parallel do default(none) shared(is,ie,js,je,KH_u_CFL,dt,G,CS) do j=js,je ; do I=is-1,ie KH_u_CFL(I,j) = (0.25*CS%max_Khth_CFL) / & - (dt*(G%IdxCu(I,j)*G%IdxCu(I,j) + G%IdyCu(I,j)*G%IdyCu(I,j))) + (dt*(G%IdxCu(I,j)*G%IdxCu(I,j) + US%m_to_L**2*G%IdyCu(I,j)*G%IdyCu(I,j))) enddo ; enddo !$OMP parallel do default(none) shared(is,ie,js,je,KH_v_CFL,dt,G,CS) do j=js-1,je ; do I=is,ie KH_v_CFL(i,J) = (0.25*CS%max_Khth_CFL) / & - (dt*(G%IdxCv(i,J)*G%IdxCv(i,J) + G%IdyCv(i,J)*G%IdyCv(i,J))) + (dt*(US%m_to_L**2*G%IdxCv(i,J)*G%IdxCv(i,J) + G%IdyCv(i,J)*G%IdyCv(i,J))) enddo ; enddo ! Calculates interface heights, e, in [Z ~> m]. From 3130e3620ee556c8722f39af7016e43936657d12 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Mon, 5 Aug 2019 13:14:19 -0400 Subject: [PATCH 153/297] +Rescaled the units of G%IdxCu and G%IdyCv Rescaled G%IdxCu and G%IdyCv throughout the MOM6 code to units of [L-1]. All answers are bitwise identical, but the units of two elements a public type have changed. --- src/core/MOM_CoriolisAdv.F90 | 40 ++++----- src/core/MOM_PressureForce_Montgomery.F90 | 24 ++--- src/core/MOM_PressureForce_analytic_FV.F90 | 16 ++-- src/core/MOM_PressureForce_blocked_AFV.F90 | 16 ++-- src/core/MOM_barotropic.F90 | 28 +++--- src/core/MOM_grid.F90 | 8 +- src/core/MOM_isopycnal_slopes.F90 | 10 +-- src/diagnostics/MOM_PointAccel.F90 | 4 +- src/diagnostics/MOM_sum_output.F90 | 4 +- src/framework/MOM_dyn_horgrid.F90 | 8 +- src/initialization/MOM_grid_initialize.F90 | 7 +- .../MOM_shared_initialization.F90 | 2 +- src/parameterizations/lateral/MOM_MEKE.F90 | 42 ++++----- .../lateral/MOM_hor_visc.F90 | 88 ++++++++++--------- .../lateral/MOM_internal_tides.F90 | 8 +- .../lateral/MOM_lateral_mixing_coeffs.F90 | 4 +- .../lateral/MOM_mixed_layer_restrat.F90 | 12 +-- .../lateral/MOM_thickness_diffuse.F90 | 38 ++++---- src/tracer/MOM_tracer_hor_diff.F90 | 24 ++--- src/user/MOM_controlled_forcing.F90 | 12 +-- 20 files changed, 200 insertions(+), 195 deletions(-) diff --git a/src/core/MOM_CoriolisAdv.F90 b/src/core/MOM_CoriolisAdv.F90 index 343acd461d..9d27542e75 100644 --- a/src/core/MOM_CoriolisAdv.F90 +++ b/src/core/MOM_CoriolisAdv.F90 @@ -590,19 +590,19 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS) else temp2 = q(I,J-1) * (vh_min(i,j-1)+vh_min(i+1,j-1)) endif - CAu(I,j,k) = 0.25 * US%L_to_m*G%IdxCu(I,j) * (temp1 + temp2) + CAu(I,j,k) = 0.25 * G%IdxCu(I,j) * (temp1 + temp2) enddo ; enddo else ! Energy conserving scheme, Sadourny 1975 do j=js,je ; do I=Isq,Ieq CAu(I,j,k) = 0.25 * & (q(I,J) * (vh(i+1,J,k) + vh(i,J,k)) + & - q(I,J-1) * (vh(i,J-1,k) + vh(i+1,J-1,k))) * US%L_to_m*G%IdxCu(I,j) + q(I,J-1) * (vh(i,J-1,k) + vh(i+1,J-1,k))) * G%IdxCu(I,j) enddo ; enddo endif elseif (CS%Coriolis_Scheme == SADOURNY75_ENSTRO) then do j=js,je ; do I=Isq,Ieq - CAu(I,j,k) = 0.125 * (US%L_to_m*G%IdxCu(I,j) * (q(I,J) + q(I,J-1))) * & + CAu(I,j,k) = 0.125 * (G%IdxCu(I,j) * (q(I,J) + q(I,J-1))) * & ((vh(i+1,J,k) + vh(i,J,k)) + (vh(i,J-1,k) + vh(i+1,J-1,k))) enddo ; enddo elseif ((CS%Coriolis_Scheme == ARAKAWA_HSU90) .or. & @@ -611,7 +611,7 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS) ! (Global) Energy and (Local) Enstrophy conserving, Arakawa & Hsu 1990 do j=js,je ; do I=Isq,Ieq CAu(I,j,k) = ((a(I,j) * vh(i+1,J,k) + c(I,j) * vh(i,J-1,k)) + & - (b(I,j) * vh(i,J,k) + d(I,j) * vh(i+1,J-1,k))) * US%L_to_m*G%IdxCu(I,j) + (b(I,j) * vh(i,J,k) + d(I,j) * vh(i+1,J-1,k))) * G%IdxCu(I,j) enddo ; enddo elseif (CS%Coriolis_Scheme == ROBUST_ENSTRO) then ! An enstrophy conserving scheme robust to vanishing layers @@ -633,12 +633,12 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS) if (CS%PV_Adv_Scheme == PV_ADV_CENTERED) then CAu(I,j,k) = 0.5*(abs_vort(I,J)+abs_vort(I,J-1)) * & ((vh(i,J,k) + vh(i+1,J-1,k)) + (vh(i,J-1,k) + vh(i+1,J,k)) ) / & - (h_tiny + ((Heff1+Heff4) + (Heff2+Heff3)) ) * US%L_to_m*G%IdxCu(I,j) + (h_tiny + ((Heff1+Heff4) + (Heff2+Heff3)) ) * G%IdxCu(I,j) elseif (CS%PV_Adv_Scheme == PV_ADV_UPWIND1) then VHeff = ((vh(i,J,k) + vh(i+1,J-1,k)) + (vh(i,J-1,k) + vh(i+1,J,k)) ) QVHeff = 0.5*( (abs_vort(I,J)+abs_vort(I,J-1))*VHeff & -(abs_vort(I,J)-abs_vort(I,J-1))*abs(VHeff) ) - CAu(I,j,k) = (QVHeff / ( h_tiny + ((Heff1+Heff4) + (Heff2+Heff3)) ) ) * US%L_to_m*G%IdxCu(I,j) + CAu(I,j,k) = (QVHeff / ( h_tiny + ((Heff1+Heff4) + (Heff2+Heff3)) ) ) * G%IdxCu(I,j) endif enddo ; enddo endif @@ -646,7 +646,7 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS) if ((CS%Coriolis_Scheme == ARAKAWA_LAMB81) .or. & (CS%Coriolis_Scheme == AL_BLEND)) then ; do j=js,je ; do I=Isq,Ieq CAu(I,j,k) = CAu(I,j,k) + & - (ep_u(i,j)*uh(I-1,j,k) - ep_u(i+1,j)*uh(I+1,j,k)) * US%L_to_m*G%IdxCu(I,j) + (ep_u(i,j)*uh(I-1,j,k) - ep_u(i+1,j)*uh(I+1,j,k)) * G%IdxCu(I,j) enddo ; enddo ; endif @@ -694,19 +694,19 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS) else temp2 = q(I,J) * (uh_min(i,j)+uh_min(i,j+1)) endif - CAv(i,J,k) = -0.25 * US%L_to_m*G%IdyCv(i,J) * (temp1 + temp2) + CAv(i,J,k) = -0.25 * G%IdyCv(i,J) * (temp1 + temp2) enddo ; enddo else ! Energy conserving scheme, Sadourny 1975 do J=Jsq,Jeq ; do i=is,ie CAv(i,J,k) = - 0.25* & (q(I-1,J)*(uh(I-1,j,k) + uh(I-1,j+1,k)) + & - q(I,J)*(uh(I,j,k) + uh(I,j+1,k))) * US%L_to_m*G%IdyCv(i,J) + q(I,J)*(uh(I,j,k) + uh(I,j+1,k))) * G%IdyCv(i,J) enddo ; enddo endif elseif (CS%Coriolis_Scheme == SADOURNY75_ENSTRO) then do J=Jsq,Jeq ; do i=is,ie - CAv(i,J,k) = -0.125 * (US%L_to_m*G%IdyCv(i,J) * (q(I-1,J) + q(I,J))) * & + CAv(i,J,k) = -0.125 * (G%IdyCv(i,J) * (q(I-1,J) + q(I,J))) * & ((uh(I-1,j,k) + uh(I-1,j+1,k)) + (uh(I,j,k) + uh(I,j+1,k))) enddo ; enddo elseif ((CS%Coriolis_Scheme == ARAKAWA_HSU90) .or. & @@ -717,7 +717,7 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS) CAv(i,J,k) = - ((a(I-1,j) * uh(I-1,j,k) + & c(I,j+1) * uh(I,j+1,k)) & + (b(I,j) * uh(I,j,k) + & - d(I-1,j+1) * uh(I-1,j+1,k))) * US%L_to_m*G%IdyCv(i,J) + d(I-1,j+1) * uh(I-1,j+1,k))) * G%IdyCv(i,J) enddo ; enddo elseif (CS%Coriolis_Scheme == ROBUST_ENSTRO) then ! An enstrophy conserving scheme robust to vanishing layers @@ -740,14 +740,14 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS) CAv(i,J,k) = - 0.5*(abs_vort(I,J)+abs_vort(I-1,J)) * & ((uh(I ,j ,k)+uh(I-1,j+1,k)) + & (uh(I-1,j ,k)+uh(I ,j+1,k)) ) / & - (h_tiny + ((Heff1+Heff4) +(Heff2+Heff3)) ) * US%L_to_m*G%IdyCv(i,J) + (h_tiny + ((Heff1+Heff4) +(Heff2+Heff3)) ) * G%IdyCv(i,J) elseif (CS%PV_Adv_Scheme == PV_ADV_UPWIND1) then UHeff = ((uh(I ,j ,k)+uh(I-1,j+1,k)) + & (uh(I-1,j ,k)+uh(I ,j+1,k)) ) QUHeff = 0.5*( (abs_vort(I,J)+abs_vort(I-1,J))*UHeff & -(abs_vort(I,J)-abs_vort(I-1,J))*abs(UHeff) ) CAv(i,J,k) = - QUHeff / & - (h_tiny + ((Heff1+Heff4) +(Heff2+Heff3)) ) * US%L_to_m*G%IdyCv(i,J) + (h_tiny + ((Heff1+Heff4) +(Heff2+Heff3)) ) * G%IdyCv(i,J) endif enddo ; enddo endif @@ -755,7 +755,7 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS) if ((CS%Coriolis_Scheme == ARAKAWA_LAMB81) .or. & (CS%Coriolis_Scheme == AL_BLEND)) then ; do J=Jsq,Jeq ; do i=is,ie CAv(i,J,k) = CAv(i,J,k) + & - (ep_v(i,j)*vh(i,J-1,k) - ep_v(i,j+1)*vh(i,J+1,k)) * US%L_to_m*G%IdyCv(i,J) + (ep_v(i,j)*vh(i,J-1,k) - ep_v(i,j+1)*vh(i,J+1,k)) * G%IdyCv(i,J) enddo ; enddo ; endif if (CS%bound_Coriolis) then @@ -783,7 +783,7 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS) do J=Jsq,Jeq ; do i=is,ie AD%rv_x_u(i,J,k) = - 0.25* & (q2(I-1,j)*(uh(I-1,j,k) + uh(I-1,j+1,k)) + & - q2(I,j)*(uh(I,j,k) + uh(I,j+1,k))) * US%L_to_m*G%IdyCv(i,J) + q2(I,j)*(uh(I,j,k) + uh(I,j+1,k))) * G%IdyCv(i,J) enddo ; enddo endif @@ -791,13 +791,13 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS) do j=js,je ; do I=Isq,Ieq AD%rv_x_v(I,j,k) = 0.25 * & (q2(I,j) * (vh(i+1,J,k) + vh(i,J,k)) + & - q2(I,j-1) * (vh(i,J-1,k) + vh(i+1,J-1,k))) * US%L_to_m*G%IdxCu(I,j) + q2(I,j-1) * (vh(i,J-1,k) + vh(i+1,J-1,k))) * G%IdxCu(I,j) enddo ; enddo endif else if (associated(AD%rv_x_u)) then do J=Jsq,Jeq ; do i=is,ie - AD%rv_x_u(i,J,k) = -US%L_to_m*G%IdyCv(i,J) * C1_12 * & + AD%rv_x_u(i,J,k) = -G%IdyCv(i,J) * C1_12 * & ((q2(I,J) + q2(I-1,J) + q2(I-1,J-1)) * uh(I-1,j,k) + & (q2(I-1,J) + q2(I,J) + q2(I,J-1)) * uh(I,j,k) + & (q2(I-1,J) + q2(I,J+1) + q2(I,J)) * uh(I,j+1,k) + & @@ -807,7 +807,7 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS) if (associated(AD%rv_x_v)) then do j=js,je ; do I=Isq,Ieq - AD%rv_x_v(I,j,k) = US%L_to_m*G%IdxCu(I,j) * C1_12 * & + AD%rv_x_v(I,j,k) = G%IdxCu(I,j) * C1_12 * & ((q2(I+1,J) + q2(I,J) + q2(I,J-1)) * vh(i+1,J,k) + & (q2(I-1,J) + q2(I,J) + q2(I,J-1)) * vh(i,J,k) + & (q2(I-1,J-1) + q2(I,J) + q2(I,J-1)) * vh(i,J-1,k) + & @@ -893,12 +893,12 @@ subroutine gradKE(u, v, h, KE, KEx, KEy, k, OBC, G, US, CS) ! Term - d(KE)/dx. do j=js,je ; do I=Isq,Ieq - KEx(I,j) = US%m_s_to_L_T**2*(KE(i+1,j) - KE(i,j)) * US%L_to_m*G%IdxCu(I,j) + KEx(I,j) = US%m_s_to_L_T**2*(KE(i+1,j) - KE(i,j)) * G%IdxCu(I,j) enddo ; enddo ! Term - d(KE)/dy. do J=Jsq,Jeq ; do i=is,ie - KEy(i,J) = US%m_s_to_L_T**2*(KE(i,j+1) - KE(i,j)) * US%L_to_m*G%IdyCv(i,J) + KEy(i,J) = US%m_s_to_L_T**2*(KE(i,j+1) - KE(i,j)) * G%IdyCv(i,J) enddo ; enddo if (associated(OBC)) then diff --git a/src/core/MOM_PressureForce_Montgomery.F90 b/src/core/MOM_PressureForce_Montgomery.F90 index 05ac089c34..9bb0a02606 100644 --- a/src/core/MOM_PressureForce_Montgomery.F90 +++ b/src/core/MOM_PressureForce_Montgomery.F90 @@ -320,17 +320,17 @@ subroutine PressureForce_Mont_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, pb enddo ; enddo do j=js,je ; do I=Isq,Ieq ! PFu_bc = p* grad alpha* - PFu_bc = US%m_s_to_L_T**2*(alpha_star(i+1,j,k) - alpha_star(i,j,k)) * (US%L_to_m*G%IdxCu(I,j) * & + PFu_bc = US%m_s_to_L_T**2*(alpha_star(i+1,j,k) - alpha_star(i,j,k)) * (G%IdxCu(I,j) * & ((dp_star(i,j) * dp_star(i+1,j) + (p(i,j,K) * dp_star(i+1,j) + & p(i+1,j,K) * dp_star(i,j))) / (dp_star(i,j) + dp_star(i+1,j)))) - PFu(I,j,k) = -(M(i+1,j,k) - M(i,j,k)) * US%L_to_m*G%IdxCu(I,j) + PFu_bc + PFu(I,j,k) = -(M(i+1,j,k) - M(i,j,k)) * G%IdxCu(I,j) + PFu_bc if (associated(CS%PFu_bc)) CS%PFu_bc(i,j,k) = PFu_bc enddo ; enddo do J=Jsq,Jeq ; do i=is,ie - PFv_bc = US%m_s_to_L_T**2*(alpha_star(i,j+1,k) - alpha_star(i,j,k)) * (US%L_to_m*G%IdyCv(i,J) * & + PFv_bc = US%m_s_to_L_T**2*(alpha_star(i,j+1,k) - alpha_star(i,j,k)) * (G%IdyCv(i,J) * & ((dp_star(i,j) * dp_star(i,j+1) + (p(i,j,K) * dp_star(i,j+1) + & p(i,j+1,K) * dp_star(i,j))) / (dp_star(i,j) + dp_star(i,j+1)))) - PFv(i,J,k) = -(M(i,j+1,k) - M(i,j,k)) * US%L_to_m*G%IdyCv(i,J) + PFv_bc + PFv(i,J,k) = -(M(i,j+1,k) - M(i,j,k)) * G%IdyCv(i,J) + PFv_bc if (associated(CS%PFv_bc)) CS%PFv_bc(i,j,k) = PFv_bc enddo ; enddo enddo ! k-loop @@ -338,10 +338,10 @@ subroutine PressureForce_Mont_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, pb !$OMP parallel do default(shared) do k=1,nz do j=js,je ; do I=Isq,Ieq - PFu(I,j,k) = -(M(i+1,j,k) - M(i,j,k)) * US%L_to_m*G%IdxCu(I,j) + PFu(I,j,k) = -(M(i+1,j,k) - M(i,j,k)) * G%IdxCu(I,j) enddo ; enddo do J=Jsq,Jeq ; do i=is,ie - PFv(i,J,k) = -(M(i,j+1,k) - M(i,j,k)) * US%L_to_m*G%IdyCv(i,J) + PFv(i,J,k) = -(M(i,j+1,k) - M(i,j,k)) * G%IdyCv(i,J) enddo ; enddo enddo endif ! use_EOS @@ -552,17 +552,17 @@ subroutine PressureForce_Mont_Bouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, pbce, h_star(i,j) = (e(i,j,K) - e(i,j,K+1)) + h_neglect enddo ; enddo do j=js,je ; do I=Isq,Ieq - PFu_bc = -1.0*(rho_star(i+1,j,k) - rho_star(i,j,k)) * (US%L_to_m*G%IdxCu(I,j) * & + PFu_bc = -1.0*(rho_star(i+1,j,k) - rho_star(i,j,k)) * (G%IdxCu(I,j) * & ((h_star(i,j) * h_star(i+1,j) - (e(i,j,K) * h_star(i+1,j) + & e(i+1,j,K) * h_star(i,j))) / (h_star(i,j) + h_star(i+1,j)))) - PFu(I,j,k) = -(M(i+1,j,k) - M(i,j,k)) * US%L_to_m*G%IdxCu(I,j) + PFu_bc + PFu(I,j,k) = -(M(i+1,j,k) - M(i,j,k)) * G%IdxCu(I,j) + PFu_bc if (associated(CS%PFu_bc)) CS%PFu_bc(i,j,k) = PFu_bc enddo ; enddo do J=Jsq,Jeq ; do i=is,ie - PFv_bc = -1.0*(rho_star(i,j+1,k) - rho_star(i,j,k)) * (US%L_to_m*G%IdyCv(i,J) * & + PFv_bc = -1.0*(rho_star(i,j+1,k) - rho_star(i,j,k)) * (G%IdyCv(i,J) * & ((h_star(i,j) * h_star(i,j+1) - (e(i,j,K) * h_star(i,j+1) + & e(i,j+1,K) * h_star(i,j))) / (h_star(i,j) + h_star(i,j+1)))) - PFv(i,J,k) = -(M(i,j+1,k) - M(i,j,k)) * US%L_to_m*G%IdyCv(i,J) + PFv_bc + PFv(i,J,k) = -(M(i,j+1,k) - M(i,j,k)) * G%IdyCv(i,J) + PFv_bc if (associated(CS%PFv_bc)) CS%PFv_bc(i,j,k) = PFv_bc enddo ; enddo enddo ! k-loop @@ -570,10 +570,10 @@ subroutine PressureForce_Mont_Bouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, pbce, !$OMP parallel do default(shared) do k=1,nz do j=js,je ; do I=Isq,Ieq - PFu(I,j,k) = -(M(i+1,j,k) - M(i,j,k)) * US%L_to_m*G%IdxCu(I,j) + PFu(I,j,k) = -(M(i+1,j,k) - M(i,j,k)) * G%IdxCu(I,j) enddo ; enddo do J=Jsq,Jeq ; do i=is,ie - PFv(i,J,k) = -(M(i,j+1,k) - M(i,j,k)) * US%L_to_m*G%IdyCv(i,J) + PFv(i,J,k) = -(M(i,j+1,k) - M(i,j,k)) * G%IdyCv(i,J) enddo ; enddo enddo endif ! use_EOS diff --git a/src/core/MOM_PressureForce_analytic_FV.F90 b/src/core/MOM_PressureForce_analytic_FV.F90 index e4710a42a8..f84b8e780e 100644 --- a/src/core/MOM_PressureForce_analytic_FV.F90 +++ b/src/core/MOM_PressureForce_analytic_FV.F90 @@ -384,7 +384,7 @@ subroutine PressureForce_AFV_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p (za(i+1,j)*dp(i+1,j) + intp_dza(i+1,j,k))) + & ((dp(i+1,j) - dp(i,j)) * intx_za(I,j) - & (p(i+1,j,K) - p(i,j,K)) * intx_dza(I,j,k))) * & - (US%m_s_to_L_T**2 * 2.0*US%L_to_m*G%IdxCu(I,j) / & + (US%m_s_to_L_T**2 * 2.0*G%IdxCu(I,j) / & ((dp(i,j) + dp(i+1,j)) + dp_neglect)) enddo ; enddo !$OMP parallel do default(shared) @@ -394,7 +394,7 @@ subroutine PressureForce_AFV_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p (za(i,j+1)*dp(i,j+1) + intp_dza(i,j+1,k))) + & ((dp(i,j+1) - dp(i,j)) * inty_za(i,J) - & (p(i,j+1,K) - p(i,j,K)) * inty_dza(i,J,k))) * & - (US%m_s_to_L_T**2 * 2.0*US%L_to_m*G%IdyCv(i,J) / & + (US%m_s_to_L_T**2 * 2.0*G%IdyCv(i,J) / & ((dp(i,j) + dp(i,j+1)) + dp_neglect)) enddo ; enddo @@ -402,11 +402,11 @@ subroutine PressureForce_AFV_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p ! Adjust the Montgomery potential to make this a reduced gravity model. !$OMP parallel do default(shared) do j=js,je ; do I=Isq,Ieq - PFu(I,j,k) = PFu(I,j,k) - (dM(i+1,j) - dM(i,j)) * US%L_to_m*G%IdxCu(I,j) + PFu(I,j,k) = PFu(I,j,k) - (dM(i+1,j) - dM(i,j)) * G%IdxCu(I,j) enddo ; enddo !$OMP parallel do default(shared) do J=Jsq,Jeq ; do i=is,ie - PFv(i,J,k) = PFv(i,J,k) - (dM(i,j+1) - dM(i,j)) * US%L_to_m*G%IdyCv(i,J) + PFv(i,J,k) = PFv(i,J,k) - (dM(i,j+1) - dM(i,j)) * G%IdyCv(i,J) enddo ; enddo endif enddo @@ -722,7 +722,7 @@ subroutine PressureForce_AFV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_at (pa(i+1,j)*h(i+1,j,k) + intz_dpa(i+1,j))) + & ((h(i+1,j,k) - h(i,j,k)) * intx_pa(I,j) - & (e(i+1,j,K+1) - e(i,j,K+1)) * intx_dpa(I,j) * GV%Z_to_H)) * & - ((2.0*I_Rho0*US%L_to_m*G%IdxCu(I,j)) / & + ((2.0*I_Rho0*G%IdxCu(I,j)) / & ((h(i,j,k) + h(i+1,j,k)) + h_neglect)) intx_pa(I,j) = intx_pa(I,j) + intx_dpa(I,j) enddo ; enddo @@ -733,7 +733,7 @@ subroutine PressureForce_AFV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_at (pa(i,j+1)*h(i,j+1,k) + intz_dpa(i,j+1))) + & ((h(i,j+1,k) - h(i,j,k)) * inty_pa(i,J) - & (e(i,j+1,K+1) - e(i,j,K+1)) * inty_dpa(i,J) * GV%Z_to_H)) * & - ((2.0*I_Rho0*US%L_to_m*G%IdyCv(i,J)) / & + ((2.0*I_Rho0*G%IdyCv(i,J)) / & ((h(i,j,k) + h(i,j+1,k)) + h_neglect)) inty_pa(i,J) = inty_pa(i,J) + inty_dpa(i,J) enddo ; enddo @@ -747,11 +747,11 @@ subroutine PressureForce_AFV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_at do k=1,nz !$OMP parallel do default(shared) do j=js,je ; do I=Isq,Ieq - PFu(I,j,k) = PFu(I,j,k) - (dM(i+1,j) - dM(i,j)) * US%L_to_m*G%IdxCu(I,j) + PFu(I,j,k) = PFu(I,j,k) - (dM(i+1,j) - dM(i,j)) * G%IdxCu(I,j) enddo ; enddo !$OMP parallel do default(shared) do J=Jsq,Jeq ; do i=is,ie - PFv(i,J,k) = PFv(i,J,k) - (dM(i,j+1) - dM(i,j)) * US%L_to_m*G%IdyCv(i,J) + PFv(i,J,k) = PFv(i,J,k) - (dM(i,j+1) - dM(i,j)) * G%IdyCv(i,J) enddo ; enddo enddo endif diff --git a/src/core/MOM_PressureForce_blocked_AFV.F90 b/src/core/MOM_PressureForce_blocked_AFV.F90 index c3972a0ffe..773bcefc1d 100644 --- a/src/core/MOM_PressureForce_blocked_AFV.F90 +++ b/src/core/MOM_PressureForce_blocked_AFV.F90 @@ -365,7 +365,7 @@ subroutine PressureForce_blk_AFV_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, (za_bk(ib+1,jb)*dp_bk(ib+1,jb) + intp_dza(i+1,j,k))) + & ((dp_bk(ib+1,jb) - dp_bk(ib,jb)) * intx_za_bk(Ib,jb) - & (p(i+1,j,K) - p(i,j,K)) * intx_dza(I,j,k))) * & - (US%m_s_to_L_T**2 * 2.0*US%L_to_m*G%IdxCu(I,j) / & + (US%m_s_to_L_T**2 * 2.0*G%IdxCu(I,j) / & ((dp_bk(ib,jb) + dp_bk(ib+1,jb)) + dp_neglect)) enddo ; enddo do Jb=Jsq_bk,Jeq_bk ; do ib=is_bk,ie_bk @@ -375,17 +375,17 @@ subroutine PressureForce_blk_AFV_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, (za_bk(ib,jb+1)*dp_bk(ib,jb+1) + intp_dza(i,j+1,k))) + & ((dp_bk(ib,jb+1) - dp_bk(ib,jb)) * inty_za_bk(ib,Jb) - & (p(i,j+1,K) - p(i,j,K)) * inty_dza(i,J,k))) * & - (US%m_s_to_L_T**2 * 2.0*US%L_to_m*G%IdyCv(i,J) / & + (US%m_s_to_L_T**2 * 2.0*G%IdyCv(i,J) / & ((dp_bk(ib,jb) + dp_bk(ib,jb+1)) + dp_neglect)) enddo ; enddo if (CS%GFS_scale < 1.0) then ! Adjust the Montgomery potential to make this a reduced gravity model. do j=js_bk+joff_bk,je_bk+joff_bk ; do I=Isq_bk+ioff_bk,Ieq_bk+ioff_bk - PFu(I,j,k) = PFu(I,j,k) - (dM(i+1,j) - dM(i,j)) * US%L_to_m*G%IdxCu(I,j) + PFu(I,j,k) = PFu(I,j,k) - (dM(i+1,j) - dM(i,j)) * G%IdxCu(I,j) enddo ; enddo do J=Jsq_bk+joff_bk,Jeq_bk+joff_bk ; do i=is_bk+ioff_bk,ie_bk+ioff_bk - PFv(i,J,k) = PFv(i,J,k) - (dM(i,j+1) - dM(i,j)) * US%L_to_m*G%IdyCv(i,J) + PFv(i,J,k) = PFv(i,J,k) - (dM(i,j+1) - dM(i,j)) * G%IdyCv(i,J) enddo ; enddo endif enddo @@ -716,7 +716,7 @@ subroutine PressureForce_blk_AFV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, (pa_bk(ib+1,jb)*h(i+1,j,k) + intz_dpa_bk(ib+1,jb))) + & ((h(i+1,j,k) - h(i,j,k)) * intx_pa_bk(Ib,jb) - & (e(i+1,j,K+1) - e(i,j,K+1)) * intx_dpa_bk(Ib,jb) * GV%Z_to_H)) * & - ((2.0*I_Rho0*US%L_to_m*G%IdxCu(I,j)) / & + ((2.0*I_Rho0*G%IdxCu(I,j)) / & ((h(i,j,k) + h(i+1,j,k)) + h_neglect)) intx_pa_bk(Ib,jb) = intx_pa_bk(Ib,jb) + intx_dpa_bk(Ib,jb) enddo ; enddo @@ -727,7 +727,7 @@ subroutine PressureForce_blk_AFV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, (pa_bk(ib,jb+1)*h(i,j+1,k) + intz_dpa_bk(ib,jb+1))) + & ((h(i,j+1,k) - h(i,j,k)) * inty_pa_bk(ib,Jb) - & (e(i,j+1,K+1) - e(i,j,K+1)) * inty_dpa_bk(ib,Jb) * GV%Z_to_H)) * & - ((2.0*I_Rho0*US%L_to_m*G%IdyCv(i,J)) / & + ((2.0*I_Rho0*G%IdyCv(i,J)) / & ((h(i,j,k) + h(i,j+1,k)) + h_neglect)) inty_pa_bk(ib,Jb) = inty_pa_bk(ib,Jb) + inty_dpa_bk(ib,Jb) enddo ; enddo @@ -739,10 +739,10 @@ subroutine PressureForce_blk_AFV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, if (CS%GFS_scale < 1.0) then do k=1,nz do j=js_bk+joff_bk,je_bk+joff_bk ; do I=Isq_bk+ioff_bk,Ieq_bk+ioff_bk - PFu(I,j,k) = PFu(I,j,k) - (dM(i+1,j) - dM(i,j)) * US%L_to_m*G%IdxCu(I,j) + PFu(I,j,k) = PFu(I,j,k) - (dM(i+1,j) - dM(i,j)) * G%IdxCu(I,j) enddo ; enddo do J=Jsq_bk+joff_bk,Jeq_bk+joff_bk ; do i=is_bk+ioff_bk,ie_bk+ioff_bk - PFv(i,J,k) = PFv(i,J,k) - (dM(i,j+1) - dM(i,j)) * US%L_to_m*G%IdyCv(i,J) + PFv(i,J,k) = PFv(i,J,k) - (dM(i,j+1) - dM(i,j)) * G%IdyCv(i,J) enddo ; enddo enddo endif diff --git a/src/core/MOM_barotropic.F90 b/src/core/MOM_barotropic.F90 index cdeccff4d5..b7b1e2847c 100644 --- a/src/core/MOM_barotropic.F90 +++ b/src/core/MOM_barotropic.F90 @@ -1393,16 +1393,16 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, ! 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)*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)))) + & + ((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)))) + & ((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)*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)) ) ) + ((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)) ) ) dyn_coef_max = CS%const_dyn_psurf * max(0.0, 1.0 - dtbt**2 * Idt_max2) / & (dtbt**2 * H_eff_dx2) @@ -2351,8 +2351,8 @@ subroutine set_dtbt(G, GV, US, CS, eta, pbce, BT_cont, gtot_est, SSH_add) ! 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)*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))) + & + ((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))) + & ((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 @@ -2449,7 +2449,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) * US%L_to_m*G%IdxCu(I,j) ! CFL + cfl = dtbt * BT_OBC%Cg_u(I,j) * 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) @@ -2463,7 +2463,7 @@ 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) * US%L_to_m*G%IdxCu(I,j) ! CFL + cfl = dtbt * BT_OBC%Cg_u(I,j) * 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 @@ -2499,7 +2499,7 @@ 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) * US%L_to_m*G%IdyCv(I,j) ! CFL + cfl = dtbt * BT_OBC%Cg_v(i,J) * 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 @@ -2515,7 +2515,7 @@ 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) * US%L_to_m*G%IdyCv(I,j) ! CFL + cfl = dtbt * BT_OBC%Cg_v(i,J) * 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 @@ -4085,10 +4085,10 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, US, param_file, diag, CS, ! 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) = US%L_to_m*G%IdxCu(I,j) ; CS%dy_Cu(I,j) = G%dy_Cu(I,j) + CS%IdxCu(I,j) = G%IdxCu(I,j) ; CS%dy_Cu(I,j) = G%dy_Cu(I,j) enddo ; enddo do J=G%JsdB,G%JedB ; do i=G%isd,G%ied - CS%IdyCv(I,j) = US%L_to_m*G%IdyCv(I,j) ; CS%dx_Cv(i,J) = G%dx_Cv(i,J) + CS%IdyCv(I,j) = G%IdyCv(I,j) ; CS%dx_Cv(i,J) = 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) diff --git a/src/core/MOM_grid.F90 b/src/core/MOM_grid.F90 index 6b642d3b80..e7048cb2d3 100644 --- a/src/core/MOM_grid.F90 +++ b/src/core/MOM_grid.F90 @@ -93,7 +93,7 @@ module MOM_grid geoLatCu, & !< The geographic latitude at u points in degrees of latitude or m. geoLonCu, & !< The geographic longitude at u points in degrees of longitude or m. dxCu, & !< dxCu is delta x at u points [L ~> m]. - IdxCu, & !< 1/dxCu [m-1]. + IdxCu, & !< 1/dxCu [L-1 ~> m-1]. dyCu, & !< dyCu is delta y at u points [L ~> m]. IdyCu, & !< 1/dyCu [L-1 ~> m-1]. dy_Cu, & !< The unblocked lengths of the u-faces of the h-cell [L ~> m]. @@ -107,7 +107,7 @@ module MOM_grid dxCv, & !< dxCv is delta x at v points [L ~> m]. IdxCv, & !< 1/dxCv [L-1 ~> m-1]. dyCv, & !< dyCv is delta y at v points [L ~> m]. - IdyCv, & !< 1/dyCv [m-1]. + IdyCv, & !< 1/dyCv [L-1 ~> m-1]. dx_Cv, & !< The unblocked lengths of the v-faces of the h-cell [L ~> m]. IareaCv, & !< The masked inverse areas of v-grid cells [L-2 ~> m-2]. areaCv !< The areas of the v-grid cells [L2 ~> m2]. @@ -431,7 +431,7 @@ subroutine set_derived_metrics(G, US) do j=jsd,jed ; do I=IsdB,IedB if (G%dxCu(I,j) < 0.0) G%dxCu(I,j) = 0.0 if (G%dyCu(I,j) < 0.0) G%dyCu(I,j) = 0.0 - G%IdxCu(I,j) = Adcroft_reciprocal(US%L_to_m*G%dxCu(I,j)) + G%IdxCu(I,j) = Adcroft_reciprocal(G%dxCu(I,j)) G%IdyCu(I,j) = Adcroft_reciprocal(G%dyCu(I,j)) enddo ; enddo @@ -439,7 +439,7 @@ subroutine set_derived_metrics(G, US) if (G%dxCv(i,J) < 0.0) G%dxCv(i,J) = 0.0 if (G%dyCv(i,J) < 0.0) G%dyCv(i,J) = 0.0 G%IdxCv(i,J) = Adcroft_reciprocal(G%dxCv(i,J)) - G%IdyCv(i,J) = Adcroft_reciprocal(US%L_to_m*G%dyCv(i,J)) + G%IdyCv(i,J) = Adcroft_reciprocal(G%dyCv(i,J)) enddo ; enddo do J=JsdB,JedB ; do I=IsdB,IedB diff --git a/src/core/MOM_isopycnal_slopes.F90 b/src/core/MOM_isopycnal_slopes.F90 index ab5ce700a7..18c47b3e90 100644 --- a/src/core/MOM_isopycnal_slopes.F90 +++ b/src/core/MOM_isopycnal_slopes.F90 @@ -157,7 +157,7 @@ subroutine calc_isoneutral_slopes(G, GV, US, h, e, tv, dt_kappa_smooth, & enddo ; enddo enddo - !$OMP parallel do default(none) shared(nz,is,ie,js,je,IsdB,use_EOS,G,GV,pres,T,S,tv, & + !$OMP parallel do default(none) shared(nz,is,ie,js,je,IsdB,use_EOS,G,GV,US,pres,T,S,tv, & !$OMP h,h_neglect,e,dz_neglect,Z_to_L,L_to_Z,H_to_Z, & !$OMP h_neglect2,present_N2_u,G_Rho0,N2_u,slope_x) & !$OMP private(drdiA,drdiB,drdkL,drdkR,pres_u,T_u,S_u, & @@ -223,7 +223,7 @@ subroutine calc_isoneutral_slopes(G, GV, US, h, e, tv, dt_kappa_smooth, & ! ((hg2L/haL) + (hg2R/haR)) ! This is the gradient of density along geopotentials. drdx = ((wtA * drdiA + wtB * drdiB) / (wtA + wtB) - & - drdz * (e(i,j,K)-e(i+1,j,K))) * G%IdxCu(I,j) + drdz * (e(i,j,K)-e(i+1,j,K))) * US%m_to_L*G%IdxCu(I,j) ! This estimate of slope is accurate for small slopes, but bounded ! to be between -1 and 1. @@ -237,7 +237,7 @@ subroutine calc_isoneutral_slopes(G, GV, US, h, e, tv, dt_kappa_smooth, & if (present_N2_u) N2_u(I,j,k) = G_Rho0 * drdz * G%mask2dCu(I,j) ! Square of Brunt-Vaisala frequency [s-2] else ! With .not.use_EOS, the layers are constant density. - slope_x(I,j,K) = (Z_to_L*(e(i,j,K)-e(i+1,j,K))) * G%IdxCu(I,j) + slope_x(I,j,K) = (Z_to_L*(e(i,j,K)-e(i+1,j,K))) * US%m_to_L*G%IdxCu(I,j) endif enddo ! I @@ -307,7 +307,7 @@ subroutine calc_isoneutral_slopes(G, GV, US, h, e, tv, dt_kappa_smooth, & ! ((hg2L/haL) + (hg2R/haR)) ! This is the gradient of density along geopotentials. drdy = ((wtA * drdjA + wtB * drdjB) / (wtA + wtB) - & - drdz * (e(i,j,K)-e(i,j+1,K))) * G%IdyCv(i,J) + drdz * (e(i,j,K)-e(i,j+1,K))) * US%m_to_L*G%IdyCv(i,J) ! This estimate of slope is accurate for small slopes, but bounded ! to be between -1 and 1. @@ -321,7 +321,7 @@ subroutine calc_isoneutral_slopes(G, GV, US, h, e, tv, dt_kappa_smooth, & if (present_N2_v) N2_v(i,J,k) = G_Rho0 * drdz * G%mask2dCv(i,J) ! Square of Brunt-Vaisala frequency [s-2] else ! With .not.use_EOS, the layers are constant density. - slope_y(i,J,K) = (Z_to_L*(e(i,j,K)-e(i,j+1,K))) * G%IdyCv(i,J) + slope_y(i,J,K) = (Z_to_L*(e(i,j,K)-e(i,j+1,K))) * US%m_to_L*G%IdyCv(i,J) endif enddo ! i diff --git a/src/diagnostics/MOM_PointAccel.F90 b/src/diagnostics/MOM_PointAccel.F90 index 9d4242bfdc..f5ddab01bc 100644 --- a/src/diagnostics/MOM_PointAccel.F90 +++ b/src/diagnostics/MOM_PointAccel.F90 @@ -180,7 +180,7 @@ subroutine write_u_accel(I, j, um, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st endif ; enddo write(file,'(/,"CFL0 u:",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - abs(um(I,j,k)) * dt * G%IdxCu(I,j) ; enddo + abs(um(I,j,k)) * dt * US%m_to_L*G%IdxCu(I,j) ; enddo if (prev_avail) then write(file,'(/,"du: ",$)') @@ -511,7 +511,7 @@ subroutine write_v_accel(i, J, vm, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st endif ; enddo write(file,'(/,"CFL0 v:",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - abs(vm(i,J,k)) * dt * G%IdyCv(i,J) ; enddo + abs(vm(i,J,k)) * dt * US%m_to_L*G%IdyCv(i,J) ; enddo if (prev_avail) then write(file,'(/,"dv: ",$)') diff --git a/src/diagnostics/MOM_sum_output.F90 b/src/diagnostics/MOM_sum_output.F90 index d03fa1ffef..12d5e3c971 100644 --- a/src/diagnostics/MOM_sum_output.F90 +++ b/src/diagnostics/MOM_sum_output.F90 @@ -717,7 +717,7 @@ subroutine write_energy(u, v, h, tv, day, n, G, GV, US, CS, tracer_CSp, OBC, dt_ else CFL_trans = (u(I,j,k) * CS%dt) * (US%L_to_m*G%dy_Cu(I,j) * US%m_to_L**2*G%IareaT(i,j)) endif - CFL_lin = abs(u(I,j,k) * CS%dt) * G%IdxCu(I,j) + CFL_lin = abs(u(I,j,k) * CS%dt) * US%m_to_L*G%IdxCu(I,j) max_CFL(1) = max(max_CFL(1), CFL_trans) max_CFL(2) = max(max_CFL(2), CFL_lin) enddo ; enddo ; enddo @@ -727,7 +727,7 @@ subroutine write_energy(u, v, h, tv, day, n, G, GV, US, CS, tracer_CSp, OBC, dt_ else CFL_trans = (v(i,J,k) * CS%dt) * (US%L_to_m*G%dx_Cv(i,J) * US%m_to_L**2*G%IareaT(i,j)) endif - CFL_lin = abs(v(i,J,k) * CS%dt) * G%IdyCv(i,J) + CFL_lin = abs(v(i,J,k) * CS%dt) * US%m_to_L*G%IdyCv(i,J) max_CFL(1) = max(max_CFL(1), CFL_trans) max_CFL(2) = max(max_CFL(2), CFL_lin) enddo ; enddo ; enddo diff --git a/src/framework/MOM_dyn_horgrid.F90 b/src/framework/MOM_dyn_horgrid.F90 index f72950e9ed..1a1e9cbf43 100644 --- a/src/framework/MOM_dyn_horgrid.F90 +++ b/src/framework/MOM_dyn_horgrid.F90 @@ -89,7 +89,7 @@ module MOM_dyn_horgrid geoLatCu, & !< The geographic latitude at u points [degrees of latitude] or [m]. geoLonCu, & !< The geographic longitude at u points [degrees of longitude] or [m]. dxCu, & !< dxCu is delta x at u points [L ~> m]. - IdxCu, & !< 1/dxCu [m-1]. + IdxCu, & !< 1/dxCu [L-1 ~> m-1]. dyCu, & !< dyCu is delta y at u points [L ~> m]. IdyCu, & !< 1/dyCu [L-1 ~> m-1]. dy_Cu, & !< The unblocked lengths of the u-faces of the h-cell [L ~> m]. @@ -103,7 +103,7 @@ module MOM_dyn_horgrid dxCv, & !< dxCv is delta x at v points [L ~> m]. IdxCv, & !< 1/dxCv [L-1 ~> m-1]. dyCv, & !< dyCv is delta y at v points [L ~> m]. - IdyCv, & !< 1/dyCv [m-1]. + IdyCv, & !< 1/dyCv [L-1 ~> m-1]. dx_Cv, & !< The unblocked lengths of the v-faces of the h-cell [L ~> m]. IareaCv, & !< The masked inverse areas of v-grid cells [L-2 ~> m-2]. areaCv !< The areas of the v-grid cells [L2 ~> m2]. @@ -339,7 +339,7 @@ subroutine set_derived_dyn_horgrid(G, US) do j=jsd,jed ; do I=IsdB,IedB if (G%dxCu(I,j) < 0.0) G%dxCu(I,j) = 0.0 if (G%dyCu(I,j) < 0.0) G%dyCu(I,j) = 0.0 - G%IdxCu(I,j) = Adcroft_reciprocal(L_to_m*G%dxCu(I,j)) + G%IdxCu(I,j) = Adcroft_reciprocal(G%dxCu(I,j)) G%IdyCu(I,j) = Adcroft_reciprocal(G%dyCu(I,j)) enddo ; enddo @@ -347,7 +347,7 @@ subroutine set_derived_dyn_horgrid(G, US) if (G%dxCv(i,J) < 0.0) G%dxCv(i,J) = 0.0 if (G%dyCv(i,J) < 0.0) G%dyCv(i,J) = 0.0 G%IdxCv(i,J) = Adcroft_reciprocal(G%dxCv(i,J)) - G%IdyCv(i,J) = Adcroft_reciprocal(L_to_m*G%dyCv(i,J)) + G%IdyCv(i,J) = Adcroft_reciprocal(G%dyCv(i,J)) enddo ; enddo do J=JsdB,JedB ; do I=IsdB,IedB diff --git a/src/initialization/MOM_grid_initialize.F90 b/src/initialization/MOM_grid_initialize.F90 index 310c665c3d..1c594f45c1 100644 --- a/src/initialization/MOM_grid_initialize.F90 +++ b/src/initialization/MOM_grid_initialize.F90 @@ -135,8 +135,7 @@ subroutine grid_metrics_chksum(parent, G, US) call hchksum_pair(trim(parent)//': Id[xy]T', G%IdxT, G%IdyT, G%HI, haloshift=halo, scale=m_to_L) - call uvchksum(trim(parent)//': Id[xy]C[uv]', & - G%IdxCu, G%IdyCv, G%HI, haloshift=halo) + call uvchksum(trim(parent)//': Id[xy]C[uv]', G%IdxCu, G%IdyCv, G%HI, haloshift=halo, scale=m_to_L) call uvchksum(trim(parent)//': Id[xy]C[uv]', G%IdyCu, G%IdxCv, G%HI, haloshift=halo, scale=m_to_L) @@ -530,7 +529,7 @@ subroutine set_grid_metrics_cartesian(G, param_file, US) do j=jsd,jed ; do I=IsdB,IedB G%geoLonCu(I,j) = grid_lonB(I) ; G%geoLatCu(I,j) = grid_LatT(j) - G%dxCu(I,j) = m_to_L*dx_everywhere ; G%IdxCu(I,j) = I_dx + G%dxCu(I,j) = m_to_L*dx_everywhere ; G%IdxCu(I,j) = L_to_m*I_dx G%dyCu(I,j) = m_to_L*dy_everywhere ; G%IdyCu(I,j) = L_to_m*I_dy enddo ; enddo @@ -538,7 +537,7 @@ subroutine set_grid_metrics_cartesian(G, param_file, US) G%geoLonCv(i,J) = grid_lonT(i) ; G%geoLatCv(i,J) = grid_latB(J) G%dxCv(i,J) = m_to_L*dx_everywhere ; G%IdxCv(i,J) = L_to_m*I_dx - G%dyCv(i,J) = m_to_L*dy_everywhere ; G%IdyCv(i,J) = I_dy + G%dyCv(i,J) = m_to_L*dy_everywhere ; G%IdyCv(i,J) = L_to_m*I_dy enddo ; enddo call callTree_leave("set_grid_metrics_cartesian()") diff --git a/src/initialization/MOM_shared_initialization.F90 b/src/initialization/MOM_shared_initialization.F90 index 716bc544e7..1dac4295b8 100644 --- a/src/initialization/MOM_shared_initialization.F90 +++ b/src/initialization/MOM_shared_initialization.F90 @@ -647,7 +647,7 @@ subroutine reset_face_lengths_named(G, param_file, name, US) if (option==1) then ! 1-degree settings. do j=jsd,jed ; do I=IsdB,IedB ! Change any u-face lengths within this loop. - dy_2 = dx_2 * L_to_m*G%dyCu(I,j)*G%IdxCu(I,j) * cos(pi_180 * G%geoLatCu(I,j)) + dy_2 = dx_2 * G%dyCu(I,j)*G%IdxCu(I,j) * cos(pi_180 * G%geoLatCu(I,j)) if ((abs(G%geoLatCu(I,j)-35.5) < dy_2) .and. (G%geoLonCu(I,j) < -4.5) .and. & (G%geoLonCu(I,j) > -6.5)) & diff --git a/src/parameterizations/lateral/MOM_MEKE.F90 b/src/parameterizations/lateral/MOM_MEKE.F90 index 39846b81a8..b1307efd98 100644 --- a/src/parameterizations/lateral/MOM_MEKE.F90 +++ b/src/parameterizations/lateral/MOM_MEKE.F90 @@ -364,17 +364,17 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h ! Calculate Laplacian of MEKE !$OMP parallel do default(shared) do j=js-1,je+1 ; do I=is-2,ie+1 - MEKE_uflux(I,j) = ((US%L_to_m*G%dy_Cu(I,j)*G%IdxCu(I,j)) * G%mask2dCu(I,j)) * & + MEKE_uflux(I,j) = ((US%L_to_m*G%dy_Cu(I,j)*US%m_to_L*G%IdxCu(I,j)) * G%mask2dCu(I,j)) * & (MEKE%MEKE(i+1,j) - MEKE%MEKE(i,j)) - ! MEKE_uflux(I,j) = ((US%L_to_m*G%dy_Cu(I,j)*G%IdxCu(I,j)) * & + ! MEKE_uflux(I,j) = ((US%L_to_m*G%dy_Cu(I,j)*US%m_to_L*G%IdxCu(I,j)) * & ! ((2.0*mass(i,j)*mass(i+1,j)) / ((mass(i,j)+mass(i+1,j)) + mass_neglect)) ) * & ! (MEKE%MEKE(i+1,j) - MEKE%MEKE(i,j)) enddo ; enddo !$OMP parallel do default(shared) do J=js-2,je+1 ; do i=is-1,ie+1 - MEKE_vflux(i,J) = ((US%L_to_m*G%dx_Cv(i,J)*G%IdyCv(i,J)) * G%mask2dCv(i,J)) * & + MEKE_vflux(i,J) = ((US%L_to_m*G%dx_Cv(i,J)*US%m_to_L*G%IdyCv(i,J)) * G%mask2dCv(i,J)) * & (MEKE%MEKE(i,j+1) - MEKE%MEKE(i,j)) - ! MEKE_vflux(i,J) = ((US%L_to_m*G%dx_Cv(i,J)*G%IdyCv(i,J)) * & + ! MEKE_vflux(i,J) = ((US%L_to_m*G%dx_Cv(i,J)*US%m_to_L*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 @@ -392,22 +392,22 @@ 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 K4_here = CS%MEKE_K4 ! Limit Kh to avoid CFL violations. - Inv_Kh_max = 64.0*sdt * (((US%L_to_m*G%dy_Cu(I,j)*G%IdxCu(I,j)) * & + Inv_Kh_max = 64.0*sdt * (((US%L_to_m*G%dy_Cu(I,j)*US%m_to_L*G%IdxCu(I,j)) * & max(US%m_to_L**2*G%IareaT(i,j),US%m_to_L**2*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 * (US%L_to_m*G%dy_Cu(I,j)*G%IdxCu(I,j))) * & + MEKE_uflux(I,j) = ((K4_here * (US%L_to_m*G%dy_Cu(I,j)*US%m_to_L*G%IdxCu(I,j))) * & ((2.0*mass(i,j)*mass(i+1,j)) / ((mass(i,j)+mass(i+1,j)) + mass_neglect)) ) * & (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 K4_here = CS%MEKE_K4 - Inv_Kh_max = 64.0*sdt * (((US%L_to_m*G%dx_Cv(i,J)*G%IdyCv(i,J)) * & + Inv_Kh_max = 64.0*sdt * (((US%L_to_m*G%dx_Cv(i,J)*US%m_to_L*G%IdyCv(i,J)) * & max(US%m_to_L**2*G%IareaT(i,j),US%m_to_L**2*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 * (US%L_to_m*G%dx_Cv(i,J)*G%IdyCv(i,J))) * & + MEKE_vflux(i,J) = ((K4_here * (US%L_to_m*G%dx_Cv(i,J)*US%m_to_L*G%IdyCv(i,J))) * & ((2.0*mass(i,j)*mass(i,j+1)) / ((mass(i,j)+mass(i,j+1)) + mass_neglect)) ) * & (del2MEKE(i,j+1) - del2MEKE(i,j)) enddo ; enddo @@ -431,12 +431,12 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h Kh_here = max(0.,CS%MEKE_Kh) + CS%KhMEKE_Fac*0.5*(MEKE%Kh(i,j)+MEKE%Kh(i+1,j)) if (associated(MEKE%Kh_diff)) & Kh_here = max(0.,CS%MEKE_Kh) + CS%KhMEKE_Fac*0.5*(MEKE%Kh_diff(i,j)+MEKE%Kh_diff(i+1,j)) - Inv_Kh_max = 2.0*sdt * ((US%L_to_m*G%dy_Cu(I,j)*G%IdxCu(I,j)) * & + Inv_Kh_max = 2.0*sdt * ((US%L_to_m*G%dy_Cu(I,j)*US%m_to_L*G%IdxCu(I,j)) * & max(US%m_to_L**2*G%IareaT(i,j),US%m_to_L**2*G%IareaT(i+1,j))) if (Kh_here*Inv_Kh_max > 0.25) Kh_here = 0.25 / Inv_Kh_max Kh_u(I,j) = Kh_here - MEKE_uflux(I,j) = ((Kh_here * (US%L_to_m*G%dy_Cu(I,j)*G%IdxCu(I,j))) * & + MEKE_uflux(I,j) = ((Kh_here * (US%L_to_m*G%dy_Cu(I,j)*US%m_to_L*G%IdxCu(I,j))) * & ((2.0*mass(i,j)*mass(i+1,j)) / ((mass(i,j)+mass(i+1,j)) + mass_neglect)) ) * & (MEKE%MEKE(i,j) - MEKE%MEKE(i+1,j)) enddo ; enddo @@ -446,12 +446,12 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h Kh_here = max(0.,CS%MEKE_Kh) + CS%KhMEKE_Fac*0.5*(MEKE%Kh(i,j)+MEKE%Kh(i,j+1)) if (associated(MEKE%Kh_diff)) & Kh_here = max(0.,CS%MEKE_Kh) + CS%KhMEKE_Fac*0.5*(MEKE%Kh_diff(i,j)+MEKE%Kh_diff(i,j+1)) - Inv_Kh_max = 2.0*sdt * ((US%L_to_m*G%dx_Cv(i,J)*G%IdyCv(i,J)) * & + Inv_Kh_max = 2.0*sdt * ((US%L_to_m*G%dx_Cv(i,J)*US%m_to_L*G%IdyCv(i,J)) * & max(US%m_to_L**2*G%IareaT(i,j),US%m_to_L**2*G%IareaT(i,j+1))) if (Kh_here*Inv_Kh_max > 0.25) Kh_here = 0.25 / Inv_Kh_max Kh_v(i,J) = Kh_here - MEKE_vflux(i,J) = ((Kh_here * (US%L_to_m*G%dx_Cv(i,J)*G%IdyCv(i,J))) * & + MEKE_vflux(i,J) = ((Kh_here * (US%L_to_m*G%dx_Cv(i,J)*US%m_to_L*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) - MEKE%MEKE(i,j+1)) enddo ; enddo @@ -656,14 +656,15 @@ subroutine MEKE_equilibrium(CS, MEKE, G, GV, US, SN_u, SN_v, drag_rate_visc, I_m !### 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) & + (G%bathyT(i+1,j)-G%bathyT(i,j)) * US%m_to_L*G%IdxCu(I,j) & /max(G%bathyT(i+1,j),G%bathyT(i,j), GV%H_subroundoff) & - + (G%bathyT(i,j)-G%bathyT(i-1,j)) * G%IdxCu(I-1,j) & + + (G%bathyT(i,j)-G%bathyT(i-1,j)) * US%m_to_L*G%IdxCu(I-1,j) & /max(G%bathyT(i,j),G%bathyT(i-1,j), GV%H_subroundoff) ) + !### There is a bug in the 4th lne below, where IdxCu should be IdyCv. beta_topo_y = CS%MEKE_topographic_beta * FatH * 0.5 * ( & - (G%bathyT(i,j+1)-G%bathyT(i,j)) * G%IdyCv(i,J) & + (G%bathyT(i,j+1)-G%bathyT(i,j)) * US%m_to_L*G%IdyCv(i,J) & /max(G%bathyT(i,j+1),G%bathyT(i,j), GV%H_subroundoff) + & - (G%bathyT(i,j)-G%bathyT(i,j-1)) * G%IdxCu(i,J-1) & + (G%bathyT(i,j)-G%bathyT(i,j-1)) * US%m_to_L*G%IdxCu(i,J-1) & /max(G%bathyT(i,j),G%bathyT(i,j-1), GV%H_subroundoff) ) endif @@ -803,14 +804,15 @@ subroutine MEKE_lengthScales(CS, MEKE, G, GV, US, SN_u, SN_v, & !### 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) & + (G%bathyT(i+1,j)-G%bathyT(i,j)) * US%m_to_L*G%IdxCu(I,j) & /max(G%bathyT(i+1,j),G%bathyT(i,j), GV%H_subroundoff) & - + (G%bathyT(i,j)-G%bathyT(i-1,j)) * G%IdxCu(I-1,j) & + + (G%bathyT(i,j)-G%bathyT(i-1,j)) * US%m_to_L*G%IdxCu(I-1,j) & /max(G%bathyT(i,j),G%bathyT(i-1,j), GV%H_subroundoff) ) + !### There is a bug in the 4th lne below, where IdxCu should be IdyCv. beta_topo_y = CS%MEKE_topographic_beta * FatH * 0.5 * ( & - (G%bathyT(i,j+1)-G%bathyT(i,j)) * G%IdyCv(i,J) & + (G%bathyT(i,j+1)-G%bathyT(i,j)) * US%m_to_L*G%IdyCv(i,J) & /max(G%bathyT(i,j+1),G%bathyT(i,j), GV%H_subroundoff) + & - (G%bathyT(i,j)-G%bathyT(i,j-1)) * G%IdxCu(i,J-1) & + (G%bathyT(i,j)-G%bathyT(i,j-1)) * US%m_to_L*G%IdxCu(i,J-1) & /max(G%bathyT(i,j),G%bathyT(i,j-1), GV%H_subroundoff) ) endif diff --git a/src/parameterizations/lateral/MOM_hor_visc.F90 b/src/parameterizations/lateral/MOM_hor_visc.F90 index 15cd33a9cd..951a45de5e 100644 --- a/src/parameterizations/lateral/MOM_hor_visc.F90 +++ b/src/parameterizations/lateral/MOM_hor_visc.F90 @@ -450,9 +450,9 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, ! Components for the barotropic shearing strain do J=js-2,Jeq+1 ; do I=is-2,Ieq+1 - dvdx_bt(I,J) = CS%DY_dxBu(I,J)*(vbtav(i+1,J)*G%IdyCv(i+1,J) & + dvdx_bt(I,J) = CS%DY_dxBu(I,J)*US%m_to_L*(vbtav(i+1,J)*G%IdyCv(i+1,J) & - vbtav(i,J)*G%IdyCv(i,J)) - dudy_bt(I,J) = CS%DX_dyBu(I,J)*(ubtav(I,j+1)*G%IdxCu(I,j+1) & + dudy_bt(I,J) = CS%DX_dyBu(I,J)*US%m_to_L*(ubtav(I,j+1)*G%IdxCu(I,j+1) & - ubtav(I,j)*G%IdxCu(I,j)) enddo ; enddo @@ -536,8 +536,8 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, ! Components for the shearing strain do J=js-2,Jeq+1 ; do I=is-2,Ieq+1 - dvdx(I,J) = CS%DY_dxBu(I,J)*(v(i+1,J,k)*G%IdyCv(i+1,J) - v(i,J,k)*G%IdyCv(i,J)) - dudy(I,J) = CS%DX_dyBu(I,J)*(u(I,j+1,k)*G%IdxCu(I,j+1) - u(I,j,k)*G%IdxCu(I,j)) + dvdx(I,J) = CS%DY_dxBu(I,J)*US%m_to_L*(v(i+1,J,k)*G%IdyCv(i+1,J) - v(i,J,k)*G%IdyCv(i,J)) + dudy(I,J) = CS%DX_dyBu(I,J)*US%m_to_L*(u(I,j+1,k)*G%IdxCu(I,j+1) - u(I,j,k)*G%IdxCu(I,j)) enddo ; enddo ! Interpolate the thicknesses to velocity points. @@ -574,15 +574,17 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, dudy(I,J) = 0. elseif (OBC%computed_strain) then if (OBC%segment(n)%direction == OBC_DIRECTION_N) then - dudy(I,J) = 2.0*CS%DX_dyBu(I,J)*(OBC%segment(n)%tangential_vel(I,J,k) - u(I,j,k))*G%IdxCu(I,j) + dudy(I,J) = 2.0*US%m_to_L*CS%DX_dyBu(I,J)* & + (OBC%segment(n)%tangential_vel(I,J,k) - u(I,j,k))*G%IdxCu(I,j) else - dudy(I,J) = 2.0*CS%DX_dyBu(I,J)*(u(I,j+1,k) - OBC%segment(n)%tangential_vel(I,J,k))*G%IdxCu(I,j+1) + dudy(I,J) = 2.0*US%m_to_L*CS%DX_dyBu(I,J)* & + (u(I,j+1,k) - OBC%segment(n)%tangential_vel(I,J,k))*G%IdxCu(I,j+1) endif elseif (OBC%specified_strain) then if (OBC%segment(n)%direction == OBC_DIRECTION_N) then - dudy(I,J) = CS%DX_dyBu(I,J)*OBC%segment(n)%tangential_grad(I,J,k)*G%IdxCu(I,j)*US%L_to_m*G%dxBu(I,J) + dudy(I,J) = CS%DX_dyBu(I,J)*OBC%segment(n)%tangential_grad(I,J,k)*G%IdxCu(I,j)*G%dxBu(I,J) else - dudy(I,J) = CS%DX_dyBu(I,J)*OBC%segment(n)%tangential_grad(I,J,k)*G%IdxCu(I,j+1)*US%L_to_m*G%dxBu(I,J) + dudy(I,J) = CS%DX_dyBu(I,J)*OBC%segment(n)%tangential_grad(I,J,k)*G%IdxCu(I,j+1)*G%dxBu(I,J) endif endif enddo @@ -594,15 +596,17 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, dvdx(I,J) = 0. elseif (OBC%computed_strain) then if (OBC%segment(n)%direction == OBC_DIRECTION_E) then - dvdx(I,J) = 2.0*CS%DY_dxBu(I,J)*(OBC%segment(n)%tangential_vel(I,J,k) - v(i,J,k))*G%IdyCv(i,J) + dvdx(I,J) = 2.0*US%m_to_L*CS%DY_dxBu(I,J)* & + (OBC%segment(n)%tangential_vel(I,J,k) - v(i,J,k))*G%IdyCv(i,J) else - dvdx(I,J) = 2.0*CS%DY_dxBu(I,J)*(v(i+1,J,k) - OBC%segment(n)%tangential_vel(I,J,k))*G%IdyCv(i+1,J) + dvdx(I,J) = 2.0*US%m_to_L*CS%DY_dxBu(I,J)* & + (v(i+1,J,k) - OBC%segment(n)%tangential_vel(I,J,k))*G%IdyCv(i+1,J) endif elseif (OBC%specified_strain) then if (OBC%segment(n)%direction == OBC_DIRECTION_E) then - dvdx(I,J) = CS%DY_dxBu(I,J)*OBC%segment(n)%tangential_grad(I,J,k)*G%IdyCv(i,J)*US%L_to_m*G%dxBu(I,J) + dvdx(I,J) = CS%DY_dxBu(I,J)*OBC%segment(n)%tangential_grad(I,J,k)*G%IdyCv(i,J)*G%dxBu(I,J) else - dvdx(I,J) = CS%DY_dxBu(I,J)*OBC%segment(n)%tangential_grad(I,J,k)*G%IdyCv(i+1,J)*US%L_to_m*G%dxBu(I,J) + dvdx(I,J) = CS%DY_dxBu(I,J)*OBC%segment(n)%tangential_grad(I,J,k)*G%IdyCv(i+1,J)*G%dxBu(I,J) endif endif enddo @@ -714,9 +718,9 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, ! Also note this will need OBC boundary conditions re-applied... do J=js-2,Jeq+1 ; do I=is-2,Ieq+1 DY_dxBu = G%dyBu(I,J) * G%IdxBu(I,J) - dvdx(I,J) = DY_dxBu * (v(i+1,J,k) * G%IdyCv(i+1,J) - v(i,J,k) * G%IdyCv(i,J)) + dvdx(I,J) = DY_dxBu * US%m_to_L*(v(i+1,J,k) * G%IdyCv(i+1,J) - v(i,J,k) * G%IdyCv(i,J)) DX_dyBu = G%dxBu(I,J) * G%IdyBu(I,J) - dudy(I,J) = DX_dyBu * (u(I,j+1,k) * G%IdxCu(I,j+1) - u(I,j,k) * G%IdxCu(I,j)) + dudy(I,J) = DX_dyBu * US%m_to_L*(u(I,j+1,k) * G%IdxCu(I,j+1) - u(I,j,k) * G%IdxCu(I,j)) enddo ; enddo ! Vorticity @@ -766,11 +770,11 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, ! Divergence gradient !#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)) + div_xx_dx(I,j) = US%m_to_L*G%IdxCu(I,j)*(div_xx(i+1,j) - div_xx(i,j)) enddo ; enddo !#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)) + div_xx_dy(i,J) = US%m_to_L*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. @@ -969,8 +973,8 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, if (CS%biharmonic) then ! Gradient of Laplacian, for use in bi-harmonic term do J=js-1,Jeq ; do I=is-1,Ieq - dvdx(I,J) = CS%DY_dxBu(I,J)*(v0(i+1,J)*G%IdyCv(i+1,J) - v0(i,J)*G%IdyCv(i,J)) - dudy(I,J) = CS%DX_dyBu(I,J)*(u0(I,j+1)*G%IdxCu(I,j+1) - u0(I,j)*G%IdxCu(I,j)) + dvdx(I,J) = CS%DY_dxBu(I,J)*US%m_to_L*(v0(i+1,J)*G%IdyCv(i+1,J) - v0(i,J)*G%IdyCv(i,J)) + dudy(I,J) = CS%DX_dyBu(I,J)*US%m_to_L*(u0(I,j+1)*G%IdxCu(I,j+1) - u0(I,j)*G%IdxCu(I,j)) enddo ; enddo ! Adjust contributions to shearing strain on open boundaries. if (apply_OBC) then ; if (OBC%zero_strain .or. OBC%freeslip_strain) then @@ -1275,7 +1279,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, do j=js,je ; do I=Isq,Ieq diffu(I,j,k) = ((US%m_to_L*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) - & + US%m_to_L*G%IdxCu(I,j)*(CS%DX2q(I,J-1)*str_xy(I,J-1) - & CS%DX2q(I,J) *str_xy(I,J))) * & US%m_to_L**2*G%IareaCu(I,j)) / (h_u(i,j) + h_neglect) @@ -1295,7 +1299,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%m_to_L*G%IdyCv(i,J)*(CS%DY2q(I-1,J)*str_xy(I-1,J) - & CS%DY2q(I,J) *str_xy(I,J)) - & US%m_to_L*G%IdxCv(i,J)*(CS%DX2h(i,j) *str_xx(i,j) - & CS%DX2h(i,j+1)*str_xx(i,j+1))) * & @@ -1967,12 +1971,12 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS, MEKE) if (CS%biharmonic) then do j=js-1,Jeq+1 ; do I=Isq-1,Ieq+1 - CS%IDX2dyCu(I,j) = (G%IdxCu(I,j)*G%IdxCu(I,j)) * US%m_to_L*G%IdyCu(I,j) - CS%IDXDY2u(I,j) = G%IdxCu(I,j) * US%m_to_L**2*(G%IdyCu(I,j)*G%IdyCu(I,j)) + CS%IDX2dyCu(I,j) = (US%m_to_L*G%IdxCu(I,j)*US%m_to_L*G%IdxCu(I,j)) * US%m_to_L*G%IdyCu(I,j) + CS%IDXDY2u(I,j) = US%m_to_L*G%IdxCu(I,j) * US%m_to_L**2*(G%IdyCu(I,j)*G%IdyCu(I,j)) enddo ; enddo do J=Jsq-1,Jeq+1 ; do i=is-1,Ieq+1 - CS%IDX2dyCv(i,J) = US%m_to_L**2*(G%IdxCv(i,J)*G%IdxCv(i,J)) * G%IdyCv(i,J) - CS%IDXDY2v(i,J) = US%m_to_L*G%IdxCv(i,J) * (G%IdyCv(i,J)*G%IdyCv(i,J)) + CS%IDX2dyCv(i,J) = US%m_to_L**2*(G%IdxCv(i,J)*G%IdxCv(i,J)) * US%m_to_L*G%IdyCv(i,J) + CS%IDXDY2v(i,J) = US%m_to_L*G%IdxCv(i,J) * (US%m_to_L*G%IdyCv(i,J)*US%m_to_L*G%IdyCv(i,J)) enddo ; enddo CS%Ah_bg_xy(:,:) = 0.0 @@ -2045,10 +2049,10 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS, MEKE) enddo ; enddo do J=js-1,Jeq ; do I=is-1,Ieq denom = max( & - (CS%DX2q(I,J) * CS%DX_dyBu(I,J) * (G%IdxCu(I,j+1) + G%IdxCu(I,j)) * & - max(G%IdxCu(I,j)*US%m_to_L**2*G%IareaCu(I,j), G%IdxCu(I,j+1)*US%m_to_L**2*G%IareaCu(I,j+1)) ), & - (CS%DY2q(I,J) * CS%DY_dxBu(I,J) * (G%IdyCv(i+1,J) + G%IdyCv(i,J)) * & - max(G%IdyCv(i,J)*US%m_to_L**2*G%IareaCv(i,J), G%IdyCv(i+1,J)*US%m_to_L**2*G%IareaCv(i+1,J)) ) ) + (CS%DX2q(I,J) * CS%DX_dyBu(I,J) * US%m_to_L*(G%IdxCu(I,j+1) + G%IdxCu(I,j)) * & + US%m_to_L**3*max(G%IdxCu(I,j)*G%IareaCu(I,j), G%IdxCu(I,j+1)*G%IareaCu(I,j+1)) ), & + (CS%DY2q(I,J) * CS%DY_dxBu(I,J) * US%m_to_L*(G%IdyCv(i+1,J) + G%IdyCv(i,J)) * & + US%m_to_L**3*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 @@ -2066,22 +2070,22 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS, MEKE) do j=js-1,Jeq+1 ; do I=Isq-1,Ieq+1 u0u(I,j) = CS%IDXDY2u(I,j)*(CS%DY2h(i+1,j)*CS%DY_dxT(i+1,j)*US%m_to_L*(G%IdyCu(I+1,j) + G%IdyCu(I,j)) + & CS%DY2h(i,j) * CS%DY_dxT(i,j) * US%m_to_L*(G%IdyCu(I,j) + G%IdyCu(I-1,j)) ) + & - CS%IDX2dyCu(I,j)*(CS%DX2q(I,J) * CS%DX_dyBu(I,J) * (G%IdxCu(I,j+1) + G%IdxCu(I,j)) + & - CS%DX2q(I,J-1)*CS%DX_dyBu(I,J-1)*(G%IdxCu(I,j) + G%IdxCu(I,j-1)) ) + CS%IDX2dyCu(I,j)*(CS%DX2q(I,J) * CS%DX_dyBu(I,J) * US%m_to_L*(G%IdxCu(I,j+1) + G%IdxCu(I,j)) + & + CS%DX2q(I,J-1)*CS%DX_dyBu(I,J-1)*US%m_to_L*(G%IdxCu(I,j) + G%IdxCu(I,j-1)) ) u0v(I,j) = CS%IDXDY2u(I,j)*(CS%DY2h(i+1,j)*CS%DX_dyT(i+1,j)*US%m_to_L*(G%IdxCv(i+1,J) + G%IdxCv(i+1,J-1)) + & CS%DY2h(i,j) * CS%DX_dyT(i,j) * US%m_to_L*(G%IdxCv(i,J) + G%IdxCv(i,J-1)) ) + & - CS%IDX2dyCu(I,j)*(CS%DX2q(I,J) * CS%DY_dxBu(I,J) * (G%IdyCv(i+1,J) + G%IdyCv(i,J)) + & - CS%DX2q(I,J-1)*CS%DY_dxBu(I,J-1)*(G%IdyCv(i+1,J-1) + G%IdyCv(i,J-1)) ) + CS%IDX2dyCu(I,j)*(CS%DX2q(I,J) * CS%DY_dxBu(I,J) * US%m_to_L*(G%IdyCv(i+1,J) + G%IdyCv(i,J)) + & + CS%DX2q(I,J-1)*CS%DY_dxBu(I,J-1)*US%m_to_L*(G%IdyCv(i+1,J-1) + G%IdyCv(i,J-1)) ) enddo ; enddo do J=Jsq-1,Jeq+1 ; do i=is-1,Ieq+1 - v0u(i,J) = CS%IDXDY2v(i,J)*(CS%DY2q(I,J) * CS%DX_dyBu(I,J) * (G%IdxCu(I,j+1) + G%IdxCu(I,j)) + & - CS%DY2q(I-1,J)*CS%DX_dyBu(I-1,J)*(G%IdxCu(I-1,j+1) + G%IdxCu(I-1,j)) ) + & + v0u(i,J) = CS%IDXDY2v(i,J)*(CS%DY2q(I,J) * CS%DX_dyBu(I,J) * US%m_to_L*(G%IdxCu(I,j+1) + G%IdxCu(I,j)) + & + CS%DY2q(I-1,J)*CS%DX_dyBu(I-1,J)*US%m_to_L*(G%IdxCu(I-1,j+1) + G%IdxCu(I-1,j)) ) + & CS%IDX2dyCv(i,J)*(CS%DX2h(i,j+1)*CS%DY_dxT(i,j+1)*US%m_to_L*(G%IdyCu(I,j+1) + G%IdyCu(I-1,j+1)) + & CS%DX2h(i,j) * CS%DY_dxT(i,j) * US%m_to_L*(G%IdyCu(I,j) + G%IdyCu(I-1,j)) ) - v0v(i,J) = CS%IDXDY2v(i,J)*(CS%DY2q(I,J) * CS%DY_dxBu(I,J) * (G%IdyCv(i+1,J) + G%IdyCv(i,J)) + & - CS%DY2q(I-1,J)*CS%DY_dxBu(I-1,J)*(G%IdyCv(i,J) + G%IdyCv(i-1,J)) ) + & + v0v(i,J) = CS%IDXDY2v(i,J)*(CS%DY2q(I,J) * CS%DY_dxBu(I,J) * US%m_to_L*(G%IdyCv(i+1,J) + G%IdyCv(i,J)) + & + CS%DY2q(I-1,J)*CS%DY_dxBu(I-1,J)*US%m_to_L*(G%IdyCv(i,J) + G%IdyCv(i-1,J)) ) + & CS%IDX2dyCv(i,J)*(CS%DX2h(i,j+1)*CS%DX_dyT(i,j+1)*US%m_to_L*(G%IdxCv(i,J+1) + G%IdxCv(i,J)) + & CS%DX2h(i,j) * CS%DX_dyT(i,j) * US%m_to_L*(G%IdxCv(i,J) + G%IdxCv(i,J-1)) ) enddo ; enddo @@ -2104,13 +2108,13 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS, MEKE) do J=js-1,Jeq ; do I=is-1,Ieq denom = max( & (CS%DX2q(I,J) * & - (CS%DX_dyBu(I,J)*(u0u(I,j+1)*G%IdxCu(I,j+1) + u0u(I,j)*G%IdxCu(I,j)) + & - CS%DY_dxBu(I,J)*(v0u(i+1,J)*G%IdyCv(i+1,J) + v0u(i,J)*G%IdyCv(i,J))) * & - max(G%IdxCu(I,j)*US%m_to_L**2*G%IareaCu(I,j), G%IdxCu(I,j+1)*US%m_to_L**2*G%IareaCu(I,j+1)) ), & + (CS%DX_dyBu(I,J)*US%m_to_L*(u0u(I,j+1)*G%IdxCu(I,j+1) + u0u(I,j)*G%IdxCu(I,j)) + & + CS%DY_dxBu(I,J)*US%m_to_L*(v0u(i+1,J)*G%IdyCv(i+1,J) + v0u(i,J)*G%IdyCv(i,J))) * & + US%m_to_L**3*max(G%IdxCu(I,j)*G%IareaCu(I,j), G%IdxCu(I,j+1)*G%IareaCu(I,j+1)) ), & (CS%DY2q(I,J) * & - (CS%DX_dyBu(I,J)*(u0v(I,j+1)*G%IdxCu(I,j+1) + u0v(I,j)*G%IdxCu(I,j)) + & - CS%DY_dxBu(I,J)*(v0v(i+1,J)*G%IdyCv(i+1,J) + v0v(i,J)*G%IdyCv(i,J))) * & - max(G%IdyCv(i,J)*US%m_to_L**2*G%IareaCv(i,J), G%IdyCv(i+1,J)*US%m_to_L**2*G%IareaCv(i+1,J)) ) ) + (CS%DX_dyBu(I,J)*US%m_to_L*(u0v(I,j+1)*G%IdxCu(I,j+1) + u0v(I,j)*G%IdxCu(I,j)) + & + CS%DY_dxBu(I,J)*US%m_to_L*(v0v(i+1,J)*G%IdyCv(i+1,J) + v0v(i,J)*G%IdyCv(i,J))) * & + US%m_to_L**3*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 diff --git a/src/parameterizations/lateral/MOM_internal_tides.F90 b/src/parameterizations/lateral/MOM_internal_tides.F90 index e5ecb275a3..5a6837c1ad 100644 --- a/src/parameterizations/lateral/MOM_internal_tides.F90 +++ b/src/parameterizations/lateral/MOM_internal_tides.F90 @@ -802,9 +802,9 @@ subroutine refract(En, cn, freq, dt, G, US, NAngle, use_PPMang) df_dx = 0.5*US%m_to_L*US%s_to_T*((G%CoriolisBu(I,J) + G%CoriolisBu(I,J-1)) - & (G%CoriolisBu(I-1,J) + G%CoriolisBu(I-1,J-1))) * & G%IdxT(i,j) - dlnCn_dx = 0.5*( G%IdxCu(I,j) * (cn(i+1,j) - cn(i,j)) / & + dlnCn_dx = 0.5*( US%m_to_L*G%IdxCu(I,j) * (cn(i+1,j) - cn(i,j)) / & (0.5*(cn(i+1,j) + cn(i,j)) + cn_subRO) + & - G%IdxCu(I-1,j) * (cn(i,j) - cn(i-1,j)) / & + US%m_to_L*G%IdxCu(I-1,j) * (cn(i,j) - cn(i-1,j)) / & (0.5*(cn(i,j) + cn(i-1,j)) + cn_subRO) ) df2_dy = 0.5*US%m_to_L*US%s_to_T**2 * ((G%CoriolisBu(I,J)**2 + G%CoriolisBu(I-1,J)**2) - & (G%CoriolisBu(I,J-1)**2 + G%CoriolisBu(I-1,J-1)**2)) * & @@ -812,9 +812,9 @@ subroutine refract(En, cn, freq, dt, G, US, NAngle, use_PPMang) df_dy = 0.5*US%m_to_L*US%s_to_T*((G%CoriolisBu(I,J) + G%CoriolisBu(I-1,J)) - & (G%CoriolisBu(I,J-1) + G%CoriolisBu(I-1,J-1))) * & G%IdyT(i,j) - dlnCn_dy = 0.5*( G%IdyCv(i,J) * (cn(i,j+1) - cn(i,j)) / & + dlnCn_dy = 0.5*( US%m_to_L*G%IdyCv(i,J) * (cn(i,j+1) - cn(i,j)) / & (0.5*(cn(i,j+1) + cn(i,j)) + cn_subRO) + & - G%IdyCv(i,J-1) * (cn(i,j) - cn(i,j-1)) / & + US%m_to_L*G%IdyCv(i,J-1) * (cn(i,j) - cn(i,j-1)) / & (0.5*(cn(i,j) + cn(i,j-1)) + cn_subRO) ) Kmag2 = (freq**2 - f2) / (cn(i,j)**2 + cn_subRO**2) if (Kmag2 > 0.0) then diff --git a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 index 0cf88a7ced..2768e3034d 100644 --- a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 +++ b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 @@ -622,12 +622,12 @@ subroutine calc_slope_functions_using_just_e(h, G, GV, US, CS, e, calculate_slop if (calculate_slopes) then ! Calculate the interface slopes E_x and E_y and u- and v- points respectively do j=js-1,je+1 ; do I=is-1,ie - E_x(I,j) = Z_to_L*(e(i+1,j,K)-e(i,j,K))*G%IdxCu(I,j) + E_x(I,j) = Z_to_L*(e(i+1,j,K)-e(i,j,K))*US%m_to_L*G%IdxCu(I,j) ! Mask slopes where interface intersects topography if (min(h(I,j,k),h(I+1,j,k)) < H_cutoff) E_x(I,j) = 0. enddo ; enddo do J=js-1,je ; do i=is-1,ie+1 - E_y(i,J) = Z_to_L*(e(i,j+1,K)-e(i,j,K))*G%IdyCv(i,J) + E_y(i,J) = Z_to_L*(e(i,j+1,K)-e(i,j,K))*US%m_to_L*G%IdyCv(i,J) ! Mask slopes where interface intersects topography if (min(h(i,J,k),h(i,J+1,k)) < H_cutoff) E_y(I,j) = 0. enddo ; enddo diff --git a/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 b/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 index 574d478590..4e1b257c31 100644 --- a/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 +++ b/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 @@ -373,7 +373,7 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var timescale = timescale * CS%ml_restrat_coef if (res_upscale) timescale = timescale * res_scaling_fac uDml(I) = timescale * G%mask2dCu(I,j)*US%L_to_m*G%dyCu(I,j)* & - G%IdxCu(I,j)*(Rml_av_fast(i+1,j)-Rml_av_fast(i,j)) * (h_vel**2 * GV%Z_to_H) + US%m_to_L*G%IdxCu(I,j)*(Rml_av_fast(i+1,j)-Rml_av_fast(i,j)) * (h_vel**2 * GV%Z_to_H) ! As above but using the slow filtered MLD h_vel = 0.5*((htot_slow(i,j) + htot_slow(i+1,j)) + h_neglect) * GV%H_to_Z mom_mixrate = (0.41*9.8696)*u_star**2 / & @@ -382,7 +382,7 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var timescale = timescale * CS%ml_restrat_coef2 if (res_upscale) timescale = timescale * res_scaling_fac uDml_slow(I) = timescale * G%mask2dCu(I,j)*US%L_to_m*G%dyCu(I,j)* & - G%IdxCu(I,j)*(Rml_av_slow(i+1,j)-Rml_av_slow(i,j)) * (h_vel**2 * GV%Z_to_H) + US%m_to_L*G%IdxCu(I,j)*(Rml_av_slow(i+1,j)-Rml_av_slow(i,j)) * (h_vel**2 * GV%Z_to_H) if (uDml(I) + uDml_slow(I) == 0.) then do k=1,nz ; uhml(I,j,k) = 0.0 ; enddo @@ -449,7 +449,7 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var timescale = timescale * CS%ml_restrat_coef if (res_upscale) timescale = timescale * res_scaling_fac vDml(i) = timescale * G%mask2dCv(i,J)*US%L_to_m*G%dxCv(i,J)* & - G%IdyCv(i,J)*(Rml_av_fast(i,j+1)-Rml_av_fast(i,j)) * (h_vel**2 * GV%Z_to_H) + US%m_to_L*G%IdyCv(i,J)*(Rml_av_fast(i,j+1)-Rml_av_fast(i,j)) * (h_vel**2 * GV%Z_to_H) ! As above but using the slow filtered MLD h_vel = 0.5*((htot_slow(i,j) + htot_slow(i,j+1)) + h_neglect) * GV%H_to_Z mom_mixrate = (0.41*9.8696)*u_star**2 / & @@ -458,7 +458,7 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var timescale = timescale * CS%ml_restrat_coef2 if (res_upscale) timescale = timescale * res_scaling_fac vDml_slow(i) = timescale * G%mask2dCv(i,J)*US%L_to_m*G%dxCv(i,J)* & - G%IdyCv(i,J)*(Rml_av_slow(i,j+1)-Rml_av_slow(i,j)) * (h_vel**2 * GV%Z_to_H) + US%m_to_L*G%IdyCv(i,J)*(Rml_av_slow(i,j+1)-Rml_av_slow(i,j)) * (h_vel**2 * GV%Z_to_H) if (vDml(i) + vDml_slow(i) == 0.) then do k=1,nz ; vhml(i,J,k) = 0.0 ; enddo @@ -666,7 +666,7 @@ subroutine mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, dt, G, GV, US, CS) ! timescale = timescale*(2?)*(L_def/L_MLI)*min(EKE/MKE,1.0 + (US%L_to_m*G%dyCv(i,j))**2/L_def**2)) uDml(I) = timescale * G%mask2dCu(I,j)*US%L_to_m*G%dyCu(I,j)* & - G%IdxCu(I,j)*(Rml_av(i+1,j)-Rml_av(i,j)) * (h_vel**2 * GV%Z_to_H) + US%m_to_L*G%IdxCu(I,j)*(Rml_av(i+1,j)-Rml_av(i,j)) * (h_vel**2 * GV%Z_to_H) if (uDml(I) == 0) then do k=1,nkml ; uhml(I,j,k) = 0.0 ; enddo @@ -713,7 +713,7 @@ subroutine mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, dt, G, GV, US, CS) ! timescale = timescale*(2?)*(L_def/L_MLI)*min(EKE/MKE,1.0 + (US%L_to_m*G%dyCv(i,j))**2/L_def**2)) vDml(i) = timescale * G%mask2dCv(i,J)*US%L_to_m*G%dxCv(i,J)* & - G%IdyCv(i,J)*(Rml_av(i,j+1)-Rml_av(i,j)) * (h_vel**2 * GV%Z_to_H) + US%m_to_L*G%IdyCv(i,J)*(Rml_av(i,j+1)-Rml_av(i,j)) * (h_vel**2 * GV%Z_to_H) if (vDml(i) == 0) then do k=1,nkml ; vhml(i,J,k) = 0.0 ; enddo else diff --git a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 index 4abc826328..671bdb1225 100644 --- a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 +++ b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 @@ -183,12 +183,12 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp !$OMP parallel do default(none) shared(is,ie,js,je,KH_u_CFL,dt,G,CS) do j=js,je ; do I=is-1,ie KH_u_CFL(I,j) = (0.25*CS%max_Khth_CFL) / & - (dt*(G%IdxCu(I,j)*G%IdxCu(I,j) + US%m_to_L**2*G%IdyCu(I,j)*G%IdyCu(I,j))) + (dt*US%m_to_L**2*(G%IdxCu(I,j)*G%IdxCu(I,j) + G%IdyCu(I,j)*G%IdyCu(I,j))) enddo ; enddo !$OMP parallel do default(none) shared(is,ie,js,je,KH_v_CFL,dt,G,CS) do j=js-1,je ; do I=is,ie KH_v_CFL(i,J) = (0.25*CS%max_Khth_CFL) / & - (dt*(US%m_to_L**2*G%IdxCv(i,J)*G%IdxCv(i,J) + G%IdyCv(i,J)*G%IdyCv(i,J))) + (dt*US%m_to_L**2*(G%IdxCv(i,J)*G%IdxCv(i,J) + G%IdyCv(i,J)*G%IdyCv(i,J))) enddo ; enddo ! Calculates interface heights, e, in [Z ~> m]. @@ -804,7 +804,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV wtA = hg2A*haB ; wtB = hg2B*haA ! This is the gradient of density along geopotentials. drdx = ((wtA * drdiA + wtB * drdiB) / (wtA + wtB) - & - drdz * (e(i,j,K)-e(i+1,j,K))) * G%IdxCu(I,j) + drdz * (e(i,j,K)-e(i+1,j,K))) * US%m_to_L*G%IdxCu(I,j) ! This estimate of slope is accurate for small slopes, but bounded ! to be between -1 and 1. @@ -822,7 +822,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV ! that ignore density gradients along layers. if (present_int_slope_u) then Slope = (1.0 - int_slope_u(I,j,K)) * Slope + & - int_slope_u(I,j,K) * US%Z_to_m*((e(i+1,j,K)-e(i,j,K)) * G%IdxCu(I,j)) + int_slope_u(I,j,K) * US%Z_to_m*((e(i+1,j,K)-e(i,j,K)) * US%m_to_L*G%IdxCu(I,j)) slope2_Ratio_u(I,K) = (1.0 - int_slope_u(I,j,K)) * slope2_Ratio_u(I,K) endif @@ -857,7 +857,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV if (present_slope_x) then Slope = slope_x(I,j,k) else - Slope = US%Z_to_m*((e(i,j,K)-e(i+1,j,K))*G%IdxCu(I,j)) * G%mask2dCu(I,j) + Slope = US%Z_to_m*((e(i,j,K)-e(i+1,j,K))*US%m_to_L*G%IdxCu(I,j)) * G%mask2dCu(I,j) endif if (CS%id_slope_x > 0) CS%diagSlopeX(I,j,k) = Slope Sfn_unlim_u(I,K) = ((KH_u(I,j,K)*US%L_to_m*G%dy_Cu(I,j))*US%m_to_Z*Slope) @@ -922,7 +922,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV ! sfn_slope_x(I,j,K) = max(uhtot(I,j)-h_avail(i+1,j,k), & ! min(uhtot(I,j)+h_avail(i,j,k), & ! min(h_avail_rsum(i+1,j,K), max(-h_avail_rsum(i,j,K), & -! (KH_u(I,j,K)*US%L_to_m*G%dy_Cu(I,j)) * ((e(i,j,K)-e(i+1,j,K))*G%IdxCu(I,j)) )) )) +! (KH_u(I,j,K)*US%L_to_m*G%dy_Cu(I,j)) * ((e(i,j,K)-e(i+1,j,K))*US%m_to_L*G%IdxCu(I,j)) )) )) else ! k <= nk_linear ! Balance the deeper flow with a return flow uniformly distributed ! though the remaining near-surface layers. This is the same as @@ -1053,7 +1053,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV wtA = hg2A*haB ; wtB = hg2B*haA ! This is the gradient of density along geopotentials. drdy = ((wtA * drdjA + wtB * drdjB) / (wtA + wtB) - & - drdz * (e(i,j,K)-e(i,j+1,K))) * G%IdyCv(i,J) + drdz * (e(i,j,K)-e(i,j+1,K))) * US%m_to_L*G%IdyCv(i,J) ! This estimate of slope is accurate for small slopes, but bounded ! to be between -1 and 1. @@ -1071,7 +1071,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV ! that ignore density gradients along layers. if (present_int_slope_v) then Slope = (1.0 - int_slope_v(i,J,K)) * Slope + & - int_slope_v(i,J,K) * US%Z_to_m*((e(i,j+1,K)-e(i,j,K)) * G%IdyCv(i,J)) + int_slope_v(i,J,K) * US%Z_to_m*((e(i,j+1,K)-e(i,j,K)) * US%m_to_L*G%IdyCv(i,J)) slope2_Ratio_v(i,K) = (1.0 - int_slope_v(i,J,K)) * slope2_Ratio_v(i,K) endif @@ -1106,7 +1106,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV if (present_slope_y) then Slope = slope_y(i,J,k) else - Slope = US%Z_to_m*((e(i,j,K)-e(i,j+1,K))*G%IdyCv(i,J)) * G%mask2dCv(i,J) + Slope = US%Z_to_m*((e(i,j,K)-e(i,j+1,K))*US%m_to_L*G%IdyCv(i,J)) * G%mask2dCv(i,J) endif if (CS%id_slope_y > 0) CS%diagSlopeY(I,j,k) = Slope Sfn_unlim_v(i,K) = ((KH_v(i,J,K)*US%L_to_m*G%dx_Cv(i,J))*US%m_to_Z*Slope) @@ -1171,7 +1171,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV ! sfn_slope_y(i,J,K) = max(vhtot(i,J)-h_avail(i,j+1,k), & ! min(vhtot(i,J)+h_avail(i,j,k), & ! min(h_avail_rsum(i,j+1,K), max(-h_avail_rsum(i,j,K), & -! (KH_v(i,J,K)*US%L_to_m*G%dx_Cv(i,J)) * ((e(i,j,K)-e(i,j+1,K))*G%IdyCv(i,J)) )) )) +! (KH_v(i,J,K)*US%L_to_m*G%dx_Cv(i,J)) * ((e(i,j,K)-e(i,j+1,K))*US%m_to_L*G%IdyCv(i,J)) )) )) else ! k <= nk_linear ! Balance the deeper flow with a return flow uniformly distributed ! though the remaining near-surface layers. This is the same as @@ -1536,8 +1536,8 @@ subroutine add_detangling_Kh(h, e, Kh_u, Kh_v, KH_u_CFL, KH_v_CFL, tv, dt, G, GV adH = abs(dH) sign = 1.0*US%Z_to_m ; if (dH < 0) sign = -1.0*US%Z_to_m - sl_K = sign * (e(i+1,j,K)-e(i,j,K)) * G%IdxCu(I,j) - sl_Kp1 = sign * (e(i+1,j,K+1)-e(i,j,K+1)) * G%IdxCu(I,j) + sl_K = sign * (e(i+1,j,K)-e(i,j,K)) * US%m_to_L*G%IdxCu(I,j) + sl_Kp1 = sign * (e(i+1,j,K+1)-e(i,j,K+1)) * US%m_to_L*G%IdxCu(I,j) ! Add the incremental diffusivites to the surrounding interfaces. ! Adding more to the more steeply sloping layers (as below) makes @@ -1559,8 +1559,8 @@ subroutine add_detangling_Kh(h, e, Kh_u, Kh_v, KH_u_CFL, KH_v_CFL, tv, dt, G, GV adH = abs(dH) sign = 1.0*US%Z_to_m ; if (dH < 0) sign = -1.0*US%Z_to_m - sl_K = sign * (e(i,j+1,K)-e(i,j,K)) * G%IdyCv(i,J) - sl_Kp1 = sign * (e(i,j+1,K+1)-e(i,j,K+1)) * G%IdyCv(i,J) + sl_K = sign * (e(i,j+1,K)-e(i,j,K)) * US%m_to_L*G%IdyCv(i,J) + sl_Kp1 = sign * (e(i,j+1,K+1)-e(i,j,K+1)) * US%m_to_L*G%IdyCv(i,J) ! Add the incremental diffusviites to the surrounding interfaces. ! Adding more to the more steeply sloping layers (as below) makes @@ -1681,8 +1681,8 @@ subroutine add_detangling_Kh(h, e, Kh_u, Kh_v, KH_u_CFL, KH_v_CFL, tv, dt, G, GV ! if (n==1) then ! u-point. ! if ((h(i+1,j,k) - h(i,j,k)) * & ! ((e(i+1,j,K)-e(i+1,j,K+1)) - (e(i,j,K)-e(i,j,K+1))) > 0.0) then -! Sfn(K) = -Kh(i,K) * (e(i+1,j,K)-e(i,j,K)) * G%IdxCu(I,j) -! Sfn(K+1) = -Kh(i,K+1) * (e(i+1,j,K+1)-e(i,j,K+1)) * G%IdxCu(I,j) +! Sfn(K) = -Kh(i,K) * (e(i+1,j,K)-e(i,j,K)) * US%m_to_L*G%IdxCu(I,j) +! Sfn(K+1) = -Kh(i,K+1) * (e(i+1,j,K+1)-e(i,j,K+1)) * US%m_to_L*G%IdxCu(I,j) ! uh_here(k) = (Sfn(K) - Sfn(K+1))*US%L_to_m*G%dy_Cu(I,j) ! if (abs(uh_here(k))*min(US%m_to_L**2*G%IareaT(i,j), US%m_to_L**2*G%IareaT(i+1,j)) > & ! (1e-10*GV%m_to_H)) then @@ -1701,8 +1701,8 @@ subroutine add_detangling_Kh(h, e, Kh_u, Kh_v, KH_u_CFL, KH_v_CFL, tv, dt, G, GV ! else ! v-point ! if ((h(i,j+1,k) - h(i,j,k)) * & ! ((e(i,j+1,K)-e(i,j+1,K+1)) - (e(i,j,K)-e(i,j,K+1))) > 0.0) then -! Sfn(K) = -Kh(i,K) * (e(i,j+1,K)-e(i,j,K)) * G%IdyCv(i,J) -! Sfn(K+1) = -Kh(i,K+1) * (e(i,j+1,K+1)-e(i,j,K+1)) * G%IdyCv(i,J) +! Sfn(K) = -Kh(i,K) * (e(i,j+1,K)-e(i,j,K)) * US%m_to_L*G%IdyCv(i,J) +! Sfn(K+1) = -Kh(i,K+1) * (e(i,j+1,K+1)-e(i,j,K+1)) * US%m_to_L*G%IdyCv(i,J) ! uh_here(k) = (Sfn(K) - Sfn(K+1))*US%L_to_m*G%dx_Cv(i,J) ! if (abs(uh_here(K))*min(US%m_to_L**2*G%IareaT(i,j), US%m_to_L**2*G%IareaT(i,j+1)) > & ! (1e-10*GV%m_to_H)) then @@ -1719,7 +1719,7 @@ subroutine add_detangling_Kh(h, e, Kh_u, Kh_v, KH_u_CFL, KH_v_CFL, tv, dt, G, GV ! endif ! endif ! endif ! u- or v- selection. -! ! de_dx(I,K) = (e(i+1,j,K)-e(i,j,K)) * G%IdxCu(I,j) +! ! de_dx(I,K) = (e(i+1,j,K)-e(i,j,K)) * US%m_to_L*G%IdxCu(I,j) ! endif ! enddo ! enddo diff --git a/src/tracer/MOM_tracer_hor_diff.F90 b/src/tracer/MOM_tracer_hor_diff.F90 index 534c3c20ae..b279c20d8c 100644 --- a/src/tracer/MOM_tracer_hor_diff.F90 +++ b/src/tracer/MOM_tracer_hor_diff.F90 @@ -244,48 +244,48 @@ subroutine tracer_hordiff(h, dt, MEKE, VarMix, G, GV, US, CS, Reg, tv, do_online !$OMP parallel do default(shared) do j=js,je ; do I=is-1,ie - khdt_x(I,j) = dt*(Kh_u(I,j)*(US%L_to_m*G%dy_Cu(I,j)*G%IdxCu(I,j))) + khdt_x(I,j) = dt*(Kh_u(I,j)*(US%L_to_m*G%dy_Cu(I,j)*US%m_to_L*G%IdxCu(I,j))) enddo ; enddo !$OMP parallel do default(shared) do J=js-1,je ; do i=is,ie - khdt_y(i,J) = dt*(Kh_v(i,J)*(US%L_to_m*G%dx_Cv(i,J)*G%IdyCv(i,J))) + khdt_y(i,J) = dt*(Kh_v(i,J)*(US%L_to_m*G%dx_Cv(i,J)*US%m_to_L*G%IdyCv(i,J))) enddo ; enddo elseif (Resoln_scaled) then !$OMP parallel do default(shared) private(Res_fn) do j=js,je ; do I=is-1,ie Res_fn = 0.5 * (VarMix%Res_fn_h(i,j) + VarMix%Res_fn_h(i+1,j)) Kh_u(I,j) = max(CS%KhTr * Res_fn, CS%KhTr_min) - khdt_x(I,j) = dt*(CS%KhTr*(US%L_to_m*G%dy_Cu(I,j)*G%IdxCu(I,j))) * Res_fn + khdt_x(I,j) = dt*(CS%KhTr*(US%L_to_m*G%dy_Cu(I,j)*US%m_to_L*G%IdxCu(I,j))) * Res_fn enddo ; enddo !$OMP parallel do default(shared) private(Res_fn) do J=js-1,je ; do i=is,ie Res_fn = 0.5*(VarMix%Res_fn_h(i,j) + VarMix%Res_fn_h(i,j+1)) Kh_v(i,J) = max(CS%KhTr * Res_fn, CS%KhTr_min) - khdt_y(i,J) = dt*(CS%KhTr*(US%L_to_m*G%dx_Cv(i,J)*G%IdyCv(i,J))) * Res_fn + khdt_y(i,J) = dt*(CS%KhTr*(US%L_to_m*G%dx_Cv(i,J)*US%m_to_L*G%IdyCv(i,J))) * Res_fn enddo ; enddo else ! Use a simple constant diffusivity. if (CS%id_KhTr_u > 0) then !$OMP parallel do default(shared) do j=js,je ; do I=is-1,ie Kh_u(I,j) = CS%KhTr - khdt_x(I,j) = dt*(CS%KhTr*(US%L_to_m*G%dy_Cu(I,j)*G%IdxCu(I,j))) + khdt_x(I,j) = dt*(CS%KhTr*(US%L_to_m*G%dy_Cu(I,j)*US%m_to_L*G%IdxCu(I,j))) enddo ; enddo else !$OMP parallel do default(shared) do j=js,je ; do I=is-1,ie - khdt_x(I,j) = dt*(CS%KhTr*(US%L_to_m*G%dy_Cu(I,j)*G%IdxCu(I,j))) + khdt_x(I,j) = dt*(CS%KhTr*(US%L_to_m*G%dy_Cu(I,j)*US%m_to_L*G%IdxCu(I,j))) enddo ; enddo endif if (CS%id_KhTr_v > 0) then !$OMP parallel do default(shared) do J=js-1,je ; do i=is,ie Kh_v(i,J) = CS%KhTr - khdt_y(i,J) = dt*(CS%KhTr*(US%L_to_m*G%dx_Cv(i,J)*G%IdyCv(i,J))) + khdt_y(i,J) = dt*(CS%KhTr*(US%L_to_m*G%dx_Cv(i,J)*US%m_to_L*G%IdyCv(i,J))) enddo ; enddo else !$OMP parallel do default(shared) do J=js-1,je ; do i=is,ie - khdt_y(i,J) = dt*(CS%KhTr*(US%L_to_m*G%dx_Cv(i,J)*G%IdyCv(i,J))) + khdt_y(i,J) = dt*(CS%KhTr*(US%L_to_m*G%dx_Cv(i,J)*US%m_to_L*G%IdyCv(i,J))) enddo ; enddo endif endif ! VarMix @@ -297,8 +297,8 @@ subroutine tracer_hordiff(h, dt, MEKE, VarMix, G, GV, US, CS, Reg, tv, do_online khdt_max = 0.125*CS%max_diff_CFL * min(US%L_to_m**2*G%areaT(i,j), US%L_to_m**2*G%areaT(i+1,j)) if (khdt_x(I,j) > khdt_max) then khdt_x(I,j) = khdt_max - if (dt*(US%L_to_m*G%dy_Cu(I,j)*G%IdxCu(I,j)) > 0.0) & - Kh_u(I,j) = khdt_x(I,j) / (dt*(US%L_to_m*G%dy_Cu(I,j)*G%IdxCu(I,j))) + if (dt*(US%L_to_m*G%dy_Cu(I,j)*US%m_to_L*G%IdxCu(I,j)) > 0.0) & + Kh_u(I,j) = khdt_x(I,j) / (dt*(US%L_to_m*G%dy_Cu(I,j)*US%m_to_L*G%IdxCu(I,j))) endif enddo ; enddo else @@ -314,8 +314,8 @@ subroutine tracer_hordiff(h, dt, MEKE, VarMix, G, GV, US, CS, Reg, tv, do_online khdt_max = 0.125*CS%max_diff_CFL * min(US%L_to_m**2*G%areaT(i,j), US%L_to_m**2*G%areaT(i,j+1)) if (khdt_y(i,J) > khdt_max) then khdt_y(i,J) = khdt_max - if (dt*(US%L_to_m*G%dx_Cv(i,J)*G%IdyCv(i,J)) > 0.0) & - Kh_v(i,J) = khdt_y(i,J) / (dt*(US%L_to_m*G%dx_Cv(i,J)*G%IdyCv(i,J))) + if (dt*(US%L_to_m*G%dx_Cv(i,J)*US%m_to_L*G%IdyCv(i,J)) > 0.0) & + Kh_v(i,J) = khdt_y(i,J) / (dt*(US%L_to_m*G%dx_Cv(i,J)*US%m_to_L*G%IdyCv(i,J))) endif enddo ; enddo else diff --git a/src/user/MOM_controlled_forcing.F90 b/src/user/MOM_controlled_forcing.F90 index be130a2a06..bace6f6e40 100644 --- a/src/user/MOM_controlled_forcing.F90 +++ b/src/user/MOM_controlled_forcing.F90 @@ -136,12 +136,12 @@ subroutine apply_ctrl_forcing(SST_anom, SSS_anom, SSS_mean, virt_heat, virt_prec call pass_var(CS%precip_0, G%Domain) do j=js,je ; do I=is-1,ie - coef = CS%Len2 * (US%L_to_m*G%dy_Cu(I,j)*G%IdxCu(I,j)) + coef = CS%Len2 * (US%L_to_m*G%dy_Cu(I,j)*US%m_to_L*G%IdxCu(I,j)) flux_heat_x(I,j) = coef * (CS%heat_0(i,j) - CS%heat_0(i+1,j)) flux_prec_x(I,j) = coef * (CS%precip_0(i,j) - CS%precip_0(i+1,j)) enddo ; enddo do J=js-1,je ; do i=is,ie - coef = CS%Len2 * (US%L_to_m*G%dx_Cv(i,J)*G%IdyCv(i,J)) + coef = CS%Len2 * (US%L_to_m*G%dx_Cv(i,J)*US%m_to_L*G%IdyCv(i,J)) flux_heat_y(i,J) = coef * (CS%heat_0(i,j) - CS%heat_0(i,j+1)) flux_prec_y(i,J) = coef * (CS%precip_0(i,j) - CS%precip_0(i,j+1)) enddo ; enddo @@ -320,12 +320,12 @@ subroutine apply_ctrl_forcing(SST_anom, SSS_anom, SSS_mean, virt_heat, virt_prec if ((CS%avg_time(m_u1) == -1.0) .and. (CS%avg_time(m_u2) == -1.0)) then do j=js,je ; do I=is-1,ie - coef = CS%Len2 * (US%L_to_m*G%dy_Cu(I,j)*G%IdxCu(I,j)) + coef = CS%Len2 * (US%L_to_m*G%dy_Cu(I,j)*US%m_to_L*G%IdxCu(I,j)) flux_heat_x(I,j) = coef * (CS%heat_cyc(i,j,m_u1) - CS%heat_cyc(i+1,j,m_u1)) flux_prec_x(I,j) = coef * (CS%precip_cyc(i,j,m_u1) - CS%precip_cyc(i+1,j,m_u1)) enddo ; enddo do J=js-1,je ; do i=is,ie - coef = CS%Len2 * (US%L_to_m*G%dx_Cv(i,J)*G%IdyCv(i,J)) + coef = CS%Len2 * (US%L_to_m*G%dx_Cv(i,J)*US%m_to_L*G%IdyCv(i,J)) flux_heat_y(i,J) = coef * (CS%heat_cyc(i,j,m_u1) - CS%heat_cyc(i,j+1,m_u1)) flux_prec_y(i,J) = coef * (CS%precip_cyc(i,j,m_u1) - CS%precip_cyc(i,j+1,m_u1)) enddo ; enddo @@ -345,12 +345,12 @@ subroutine apply_ctrl_forcing(SST_anom, SSS_anom, SSS_mean, virt_heat, virt_prec if ((wt_per1 < 1.0) .and. (CS%avg_time(m_u1) == -1.0) .and. (CS%avg_time(m_u2) == -1.0)) then do j=js,je ; do I=is-1,ie - coef = CS%Len2 * (US%L_to_m*G%dy_Cu(I,j)*G%IdxCu(I,j)) + coef = CS%Len2 * (US%L_to_m*G%dy_Cu(I,j)*US%m_to_L*G%IdxCu(I,j)) flux_heat_x(I,j) = coef * (CS%heat_cyc(i,j,m_u2) - CS%heat_cyc(i+1,j,m_u2)) flux_prec_x(I,j) = coef * (CS%precip_cyc(i,j,m_u2) - CS%precip_cyc(i+1,j,m_u2)) enddo ; enddo do J=js-1,je ; do i=is,ie - coef = CS%Len2 * (US%L_to_m*G%dx_Cv(i,J)*G%IdyCv(i,J)) + coef = CS%Len2 * (US%L_to_m*G%dx_Cv(i,J)*US%m_to_L*G%IdyCv(i,J)) flux_heat_y(i,J) = coef * (CS%heat_cyc(i,j,m_u2) - CS%heat_cyc(i,j+1,m_u2)) flux_prec_y(i,J) = coef * (CS%precip_cyc(i,j,m_u2) - CS%precip_cyc(i,j+1,m_u2)) enddo ; enddo From 37a570a9c2ffde258e2092d8369afabad17e6f5e Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Mon, 5 Aug 2019 15:27:35 -0400 Subject: [PATCH 154/297] Simplified rescaling in MOM_sum_output.F90 Simplification of dimensional rescaling factors in single line expressions in MOM_sum_output.F90. All answers are bitwise identical. --- src/diagnostics/MOM_sum_output.F90 | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/src/diagnostics/MOM_sum_output.F90 b/src/diagnostics/MOM_sum_output.F90 index 12d5e3c971..d2c21551ce 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*US%L_to_m**2*US%s_to_T**2*GV%g_prime(K)) * & + PE_pt(i,j,K) = 0.5 * areaTm(i,j) * US%Z_to_m*US%L_T_to_m_s**2*(GV%Rho0*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*US%L_to_m**2*US%s_to_T**2*GV%g_prime(K))) * & + PE_pt(i,j,K) = 0.5 * (areaTm(i,j) * US%Z_to_m*US%L_T_to_m_s**2*(GV%Rho0*GV%g_prime(K))) * & (hint * hint - hbot * hbot) enddo enddo ; enddo @@ -713,21 +713,21 @@ subroutine write_energy(u, v, h, tv, day, n, G, GV, US, CS, tracer_CSp, OBC, dt_ max_CFL(1:2) = 0.0 do k=1,nz ; do j=js,je ; do I=Isq,Ieq if (u(I,j,k) < 0.0) then - CFL_trans = (-u(I,j,k) * CS%dt) * (US%L_to_m*G%dy_Cu(I,j) * US%m_to_L**2*G%IareaT(i+1,j)) + CFL_trans = (-US%m_s_to_L_T*u(I,j,k) * US%s_to_T*CS%dt) * (G%dy_Cu(I,j) * G%IareaT(i+1,j)) else - CFL_trans = (u(I,j,k) * CS%dt) * (US%L_to_m*G%dy_Cu(I,j) * US%m_to_L**2*G%IareaT(i,j)) + CFL_trans = (US%m_s_to_L_T*u(I,j,k) * US%s_to_T*CS%dt) * (G%dy_Cu(I,j) * G%IareaT(i,j)) endif - CFL_lin = abs(u(I,j,k) * CS%dt) * US%m_to_L*G%IdxCu(I,j) + CFL_lin = abs(US%m_s_to_L_T*u(I,j,k) * US%s_to_T*CS%dt) * G%IdxCu(I,j) max_CFL(1) = max(max_CFL(1), CFL_trans) max_CFL(2) = max(max_CFL(2), CFL_lin) enddo ; enddo ; enddo do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie if (v(i,J,k) < 0.0) then - CFL_trans = (-v(i,J,k) * CS%dt) * (US%L_to_m*G%dx_Cv(i,J) * US%m_to_L**2*G%IareaT(i,j+1)) + CFL_trans = (-US%m_s_to_L_T*v(i,J,k) * US%s_to_T*CS%dt) * (G%dx_Cv(i,J) * G%IareaT(i,j+1)) else - CFL_trans = (v(i,J,k) * CS%dt) * (US%L_to_m*G%dx_Cv(i,J) * US%m_to_L**2*G%IareaT(i,j)) + CFL_trans = (US%m_s_to_L_T*v(i,J,k) * US%s_to_T*CS%dt) * (G%dx_Cv(i,J) * G%IareaT(i,j)) endif - CFL_lin = abs(v(i,J,k) * CS%dt) * US%m_to_L*G%IdyCv(i,J) + CFL_lin = abs(US%m_s_to_L_T*v(i,J,k) * US%s_to_T*CS%dt) * G%IdyCv(i,J) max_CFL(1) = max(max_CFL(1), CFL_trans) max_CFL(2) = max(max_CFL(2), CFL_lin) enddo ; enddo ; enddo From 7b11e002b3363987c74f7a02d0abf2ae29cb8f59 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Mon, 5 Aug 2019 15:27:56 -0400 Subject: [PATCH 155/297] Simplified rescaling in MOM_controlled_forcing.F90 Simplification of dimensional rescaling factors in single line expressions in MOM_controlled_forcing.F90. All answers are bitwise identical. --- src/user/MOM_controlled_forcing.F90 | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/src/user/MOM_controlled_forcing.F90 b/src/user/MOM_controlled_forcing.F90 index bace6f6e40..cbfce62f39 100644 --- a/src/user/MOM_controlled_forcing.F90 +++ b/src/user/MOM_controlled_forcing.F90 @@ -136,12 +136,12 @@ subroutine apply_ctrl_forcing(SST_anom, SSS_anom, SSS_mean, virt_heat, virt_prec call pass_var(CS%precip_0, G%Domain) do j=js,je ; do I=is-1,ie - coef = CS%Len2 * (US%L_to_m*G%dy_Cu(I,j)*US%m_to_L*G%IdxCu(I,j)) + coef = CS%Len2 * (G%dy_Cu(I,j)*G%IdxCu(I,j)) flux_heat_x(I,j) = coef * (CS%heat_0(i,j) - CS%heat_0(i+1,j)) flux_prec_x(I,j) = coef * (CS%precip_0(i,j) - CS%precip_0(i+1,j)) enddo ; enddo do J=js-1,je ; do i=is,ie - coef = CS%Len2 * (US%L_to_m*G%dx_Cv(i,J)*US%m_to_L*G%IdyCv(i,J)) + coef = CS%Len2 * (G%dx_Cv(i,J)*G%IdyCv(i,J)) flux_heat_y(i,J) = coef * (CS%heat_0(i,j) - CS%heat_0(i,j+1)) flux_prec_y(i,J) = coef * (CS%precip_0(i,j) - CS%precip_0(i,j+1)) enddo ; enddo @@ -320,12 +320,12 @@ subroutine apply_ctrl_forcing(SST_anom, SSS_anom, SSS_mean, virt_heat, virt_prec if ((CS%avg_time(m_u1) == -1.0) .and. (CS%avg_time(m_u2) == -1.0)) then do j=js,je ; do I=is-1,ie - coef = CS%Len2 * (US%L_to_m*G%dy_Cu(I,j)*US%m_to_L*G%IdxCu(I,j)) + coef = CS%Len2 * (G%dy_Cu(I,j)*G%IdxCu(I,j)) flux_heat_x(I,j) = coef * (CS%heat_cyc(i,j,m_u1) - CS%heat_cyc(i+1,j,m_u1)) flux_prec_x(I,j) = coef * (CS%precip_cyc(i,j,m_u1) - CS%precip_cyc(i+1,j,m_u1)) enddo ; enddo do J=js-1,je ; do i=is,ie - coef = CS%Len2 * (US%L_to_m*G%dx_Cv(i,J)*US%m_to_L*G%IdyCv(i,J)) + coef = CS%Len2 * (G%dx_Cv(i,J)*G%IdyCv(i,J)) flux_heat_y(i,J) = coef * (CS%heat_cyc(i,j,m_u1) - CS%heat_cyc(i,j+1,m_u1)) flux_prec_y(i,J) = coef * (CS%precip_cyc(i,j,m_u1) - CS%precip_cyc(i,j+1,m_u1)) enddo ; enddo @@ -345,12 +345,12 @@ subroutine apply_ctrl_forcing(SST_anom, SSS_anom, SSS_mean, virt_heat, virt_prec if ((wt_per1 < 1.0) .and. (CS%avg_time(m_u1) == -1.0) .and. (CS%avg_time(m_u2) == -1.0)) then do j=js,je ; do I=is-1,ie - coef = CS%Len2 * (US%L_to_m*G%dy_Cu(I,j)*US%m_to_L*G%IdxCu(I,j)) + coef = CS%Len2 * (G%dy_Cu(I,j)*G%IdxCu(I,j)) flux_heat_x(I,j) = coef * (CS%heat_cyc(i,j,m_u2) - CS%heat_cyc(i+1,j,m_u2)) flux_prec_x(I,j) = coef * (CS%precip_cyc(i,j,m_u2) - CS%precip_cyc(i+1,j,m_u2)) enddo ; enddo do J=js-1,je ; do i=is,ie - coef = CS%Len2 * (US%L_to_m*G%dx_Cv(i,J)*US%m_to_L*G%IdyCv(i,J)) + coef = CS%Len2 * (G%dx_Cv(i,J)*G%IdyCv(i,J)) flux_heat_y(i,J) = coef * (CS%heat_cyc(i,j,m_u2) - CS%heat_cyc(i,j+1,m_u2)) flux_prec_y(i,J) = coef * (CS%precip_cyc(i,j,m_u2) - CS%precip_cyc(i,j+1,m_u2)) enddo ; enddo From b72dd75692ddd56df516745dd650712d607a0c27 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Mon, 5 Aug 2019 15:28:51 -0400 Subject: [PATCH 156/297] Simplified rescaling in MOM_MEKE.F90 Simplification of dimensional rescaling factors in single line expressions in MOM_MEKE.F90. All answers are bitwise identical. --- src/parameterizations/lateral/MOM_MEKE.F90 | 34 +++++++++++----------- 1 file changed, 17 insertions(+), 17 deletions(-) diff --git a/src/parameterizations/lateral/MOM_MEKE.F90 b/src/parameterizations/lateral/MOM_MEKE.F90 index b1307efd98..20caf163a4 100644 --- a/src/parameterizations/lateral/MOM_MEKE.F90 +++ b/src/parameterizations/lateral/MOM_MEKE.F90 @@ -237,11 +237,11 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h !$OMP parallel do default(shared) do j=js,je ; do i=is,ie - drag_rate_visc(i,j) = (0.25*US%m_to_L**2*G%IareaT(i,j) * & - ((US%L_to_m**2*G%areaCu(I-1,j)*drag_vel_u(I-1,j) + & - US%L_to_m**2*G%areaCu(I,j)*drag_vel_u(I,j)) + & - (US%L_to_m**2*G%areaCv(i,J-1)*drag_vel_v(i,J-1) + & - US%L_to_m**2*G%areaCv(i,J)*drag_vel_v(i,J)) ) ) + drag_rate_visc(i,j) = (0.25*G%IareaT(i,j) * & + ((G%areaCu(I-1,j)*drag_vel_u(I-1,j) + & + G%areaCu(I,j)*drag_vel_u(I,j)) + & + (G%areaCv(i,J-1)*drag_vel_v(i,J-1) + & + G%areaCv(i,J)*drag_vel_v(i,J)) ) ) enddo ; enddo else !$OMP parallel do default(shared) @@ -364,17 +364,17 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h ! Calculate Laplacian of MEKE !$OMP parallel do default(shared) do j=js-1,je+1 ; do I=is-2,ie+1 - MEKE_uflux(I,j) = ((US%L_to_m*G%dy_Cu(I,j)*US%m_to_L*G%IdxCu(I,j)) * G%mask2dCu(I,j)) * & + 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) = ((US%L_to_m*G%dy_Cu(I,j)*US%m_to_L*G%IdxCu(I,j)) * & + ! MEKE_uflux(I,j) = ((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)) ) * & ! (MEKE%MEKE(i+1,j) - MEKE%MEKE(i,j)) enddo ; enddo !$OMP parallel do default(shared) do J=js-2,je+1 ; do i=is-1,ie+1 - MEKE_vflux(i,J) = ((US%L_to_m*G%dx_Cv(i,J)*US%m_to_L*G%IdyCv(i,J)) * G%mask2dCv(i,J)) * & + 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) = ((US%L_to_m*G%dx_Cv(i,J)*US%m_to_L*G%IdyCv(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 @@ -392,22 +392,22 @@ 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 K4_here = CS%MEKE_K4 ! Limit Kh to avoid CFL violations. - Inv_Kh_max = 64.0*sdt * (((US%L_to_m*G%dy_Cu(I,j)*US%m_to_L*G%IdxCu(I,j)) * & + Inv_Kh_max = 64.0*sdt * (((G%dy_Cu(I,j)*G%IdxCu(I,j)) * & max(US%m_to_L**2*G%IareaT(i,j),US%m_to_L**2*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 * (US%L_to_m*G%dy_Cu(I,j)*US%m_to_L*G%IdxCu(I,j))) * & + 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)) ) * & (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 K4_here = CS%MEKE_K4 - Inv_Kh_max = 64.0*sdt * (((US%L_to_m*G%dx_Cv(i,J)*US%m_to_L*G%IdyCv(i,J)) * & + Inv_Kh_max = 64.0*sdt * (((G%dx_Cv(i,J)*G%IdyCv(i,J)) * & max(US%m_to_L**2*G%IareaT(i,j),US%m_to_L**2*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 * (US%L_to_m*G%dx_Cv(i,J)*US%m_to_L*G%IdyCv(i,J))) * & + 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)) ) * & (del2MEKE(i,j+1) - del2MEKE(i,j)) enddo ; enddo @@ -431,12 +431,12 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h Kh_here = max(0.,CS%MEKE_Kh) + CS%KhMEKE_Fac*0.5*(MEKE%Kh(i,j)+MEKE%Kh(i+1,j)) if (associated(MEKE%Kh_diff)) & Kh_here = max(0.,CS%MEKE_Kh) + CS%KhMEKE_Fac*0.5*(MEKE%Kh_diff(i,j)+MEKE%Kh_diff(i+1,j)) - Inv_Kh_max = 2.0*sdt * ((US%L_to_m*G%dy_Cu(I,j)*US%m_to_L*G%IdxCu(I,j)) * & + Inv_Kh_max = 2.0*sdt * ((G%dy_Cu(I,j)*G%IdxCu(I,j)) * & max(US%m_to_L**2*G%IareaT(i,j),US%m_to_L**2*G%IareaT(i+1,j))) if (Kh_here*Inv_Kh_max > 0.25) Kh_here = 0.25 / Inv_Kh_max Kh_u(I,j) = Kh_here - MEKE_uflux(I,j) = ((Kh_here * (US%L_to_m*G%dy_Cu(I,j)*US%m_to_L*G%IdxCu(I,j))) * & + MEKE_uflux(I,j) = ((Kh_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)) ) * & (MEKE%MEKE(i,j) - MEKE%MEKE(i+1,j)) enddo ; enddo @@ -446,12 +446,12 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h Kh_here = max(0.,CS%MEKE_Kh) + CS%KhMEKE_Fac*0.5*(MEKE%Kh(i,j)+MEKE%Kh(i,j+1)) if (associated(MEKE%Kh_diff)) & Kh_here = max(0.,CS%MEKE_Kh) + CS%KhMEKE_Fac*0.5*(MEKE%Kh_diff(i,j)+MEKE%Kh_diff(i,j+1)) - Inv_Kh_max = 2.0*sdt * ((US%L_to_m*G%dx_Cv(i,J)*US%m_to_L*G%IdyCv(i,J)) * & + Inv_Kh_max = 2.0*sdt * ((G%dx_Cv(i,J)*G%IdyCv(i,J)) * & max(US%m_to_L**2*G%IareaT(i,j),US%m_to_L**2*G%IareaT(i,j+1))) if (Kh_here*Inv_Kh_max > 0.25) Kh_here = 0.25 / Inv_Kh_max Kh_v(i,J) = Kh_here - MEKE_vflux(i,J) = ((Kh_here * (US%L_to_m*G%dx_Cv(i,J)*US%m_to_L*G%IdyCv(i,J))) * & + MEKE_vflux(i,J) = ((Kh_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)) ) * & (MEKE%MEKE(i,j) - MEKE%MEKE(i,j+1)) enddo ; enddo From 77692a3defbc5da2892f27a3214ddc232d3466ed Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Mon, 5 Aug 2019 15:29:12 -0400 Subject: [PATCH 157/297] Simplified rescaling in MOM_hor_visc.F90 Simplification of dimensional rescaling factors in single line expressions in MOM_hor_visc.F90. All answers are bitwise identical. --- .../lateral/MOM_hor_visc.F90 | 56 +++++++++---------- 1 file changed, 28 insertions(+), 28 deletions(-) diff --git a/src/parameterizations/lateral/MOM_hor_visc.F90 b/src/parameterizations/lateral/MOM_hor_visc.F90 index 951a45de5e..2162e373fa 100644 --- a/src/parameterizations/lateral/MOM_hor_visc.F90 +++ b/src/parameterizations/lateral/MOM_hor_visc.F90 @@ -756,10 +756,10 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, if (CS%modified_Leith) then ! Divergence do j=Jsq-1,Jeq+2 ; do i=Isq-1,Ieq+2 - div_xx(i,j) = 0.5*((US%L_to_m*G%dyCu(I,j) * u(I,j,k) * (h(i+1,j,k)+h(i,j,k)) - & - US%L_to_m*G%dyCu(I-1,j) * u(I-1,j,k) * (h(i-1,j,k)+h(i,j,k)) ) + & - (US%L_to_m*G%dxCv(i,J) * v(i,J,k) * (h(i,j,k)+h(i,j+1,k)) - & - US%L_to_m*G%dxCv(i,J-1)*v(i,J-1,k)*(h(i,j,k)+h(i,j-1,k))))*US%m_to_L**2*G%IareaT(i,j) / & + div_xx(i,j) = 0.5*US%m_to_L*((G%dyCu(I,j) * u(I,j,k) * (h(i+1,j,k)+h(i,j,k)) - & + G%dyCu(I-1,j) * u(I-1,j,k) * (h(i-1,j,k)+h(i,j,k)) ) + & + (G%dxCv(i,J) * v(i,J,k) * (h(i,j,k)+h(i,j+1,k)) - & + G%dxCv(i,J-1)*v(i,J-1,k)*(h(i,j,k)+h(i,j-1,k))))*G%IareaT(i,j) / & (h(i,j,k) + GV%H_subroundoff) enddo ; enddo @@ -1879,34 +1879,34 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS, MEKE) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 CS%reduction_xx(i,j) = 1.0 - if ((G%dy_Cu(I,j) > 0.0) .and. (US%L_to_m*G%dy_Cu(I,j) < US%L_to_m*G%dyCu(I,j)) .and. & - (US%L_to_m*G%dy_Cu(I,j) < US%L_to_m*G%dyCu(I,j) * CS%reduction_xx(i,j))) & - CS%reduction_xx(i,j) = US%L_to_m*G%dy_Cu(I,j) / (US%L_to_m*G%dyCu(I,j)) - if ((G%dy_Cu(I-1,j) > 0.0) .and. (US%L_to_m*G%dy_Cu(I-1,j) < US%L_to_m*G%dyCu(I-1,j)) .and. & - (US%L_to_m*G%dy_Cu(I-1,j) < US%L_to_m*G%dyCu(I-1,j) * CS%reduction_xx(i,j))) & - CS%reduction_xx(i,j) = US%L_to_m*G%dy_Cu(I-1,j) / (US%L_to_m*G%dyCu(I-1,j)) - if ((G%dx_Cv(i,J) > 0.0) .and. (US%L_to_m*G%dx_Cv(i,J) < US%L_to_m*G%dxCv(i,J)) .and. & - (US%L_to_m*G%dx_Cv(i,J) < US%L_to_m*G%dxCv(i,J) * CS%reduction_xx(i,j))) & - CS%reduction_xx(i,j) = US%L_to_m*G%dx_Cv(i,J) / (US%L_to_m*G%dxCv(i,J)) - if ((G%dx_Cv(i,J-1) > 0.0) .and. (US%L_to_m*G%dx_Cv(i,J-1) < US%L_to_m*G%dxCv(i,J-1)) .and. & - (US%L_to_m*G%dx_Cv(i,J-1) < US%L_to_m*G%dxCv(i,J-1) * CS%reduction_xx(i,j))) & - CS%reduction_xx(i,j) = US%L_to_m*G%dx_Cv(i,J-1) / (US%L_to_m*G%dxCv(i,J-1)) + if ((G%dy_Cu(I,j) > 0.0) .and. (G%dy_Cu(I,j) < G%dyCu(I,j)) .and. & + (G%dy_Cu(I,j) < G%dyCu(I,j) * CS%reduction_xx(i,j))) & + CS%reduction_xx(i,j) = G%dy_Cu(I,j) / (G%dyCu(I,j)) + if ((G%dy_Cu(I-1,j) > 0.0) .and. (G%dy_Cu(I-1,j) < G%dyCu(I-1,j)) .and. & + (G%dy_Cu(I-1,j) < G%dyCu(I-1,j) * CS%reduction_xx(i,j))) & + CS%reduction_xx(i,j) = G%dy_Cu(I-1,j) / (G%dyCu(I-1,j)) + if ((G%dx_Cv(i,J) > 0.0) .and. (G%dx_Cv(i,J) < G%dxCv(i,J)) .and. & + (G%dx_Cv(i,J) < G%dxCv(i,J) * CS%reduction_xx(i,j))) & + CS%reduction_xx(i,j) = G%dx_Cv(i,J) / (G%dxCv(i,J)) + if ((G%dx_Cv(i,J-1) > 0.0) .and. (G%dx_Cv(i,J-1) < G%dxCv(i,J-1)) .and. & + (G%dx_Cv(i,J-1) < G%dxCv(i,J-1) * CS%reduction_xx(i,j))) & + CS%reduction_xx(i,j) = G%dx_Cv(i,J-1) / (G%dxCv(i,J-1)) enddo ; enddo do J=js-1,Jeq ; do I=is-1,Ieq CS%reduction_xy(I,J) = 1.0 - if ((G%dy_Cu(I,j) > 0.0) .and. (US%L_to_m*G%dy_Cu(I,j) < US%L_to_m*G%dyCu(I,j)) .and. & - (US%L_to_m*G%dy_Cu(I,j) < US%L_to_m*G%dyCu(I,j) * CS%reduction_xy(I,J))) & - CS%reduction_xy(I,J) = US%L_to_m*G%dy_Cu(I,j) / (US%L_to_m*G%dyCu(I,j)) - if ((G%dy_Cu(I,j+1) > 0.0) .and. (US%L_to_m*G%dy_Cu(I,j+1) < US%L_to_m*G%dyCu(I,j+1)) .and. & - (US%L_to_m*G%dy_Cu(I,j+1) < US%L_to_m*G%dyCu(I,j+1) * CS%reduction_xy(I,J))) & - CS%reduction_xy(I,J) = US%L_to_m*G%dy_Cu(I,j+1) / (US%L_to_m*G%dyCu(I,j+1)) - if ((G%dx_Cv(i,J) > 0.0) .and. (US%L_to_m*G%dx_Cv(i,J) < US%L_to_m*G%dxCv(i,J)) .and. & - (US%L_to_m*G%dx_Cv(i,J) < US%L_to_m*G%dxCv(i,J) * CS%reduction_xy(I,J))) & - CS%reduction_xy(I,J) = US%L_to_m*G%dx_Cv(i,J) / (US%L_to_m*G%dxCv(i,J)) - if ((G%dx_Cv(i+1,J) > 0.0) .and. (US%L_to_m*G%dx_Cv(i+1,J) < US%L_to_m*G%dxCv(i+1,J)) .and. & - (US%L_to_m*G%dx_Cv(i+1,J) < US%L_to_m*G%dxCv(i+1,J) * CS%reduction_xy(I,J))) & - CS%reduction_xy(I,J) = US%L_to_m*G%dx_Cv(i+1,J) / (US%L_to_m*G%dxCv(i+1,J)) + if ((G%dy_Cu(I,j) > 0.0) .and. (G%dy_Cu(I,j) < G%dyCu(I,j)) .and. & + (G%dy_Cu(I,j) < G%dyCu(I,j) * CS%reduction_xy(I,J))) & + CS%reduction_xy(I,J) = G%dy_Cu(I,j) / (G%dyCu(I,j)) + if ((G%dy_Cu(I,j+1) > 0.0) .and. (G%dy_Cu(I,j+1) < G%dyCu(I,j+1)) .and. & + (G%dy_Cu(I,j+1) < G%dyCu(I,j+1) * CS%reduction_xy(I,J))) & + CS%reduction_xy(I,J) = G%dy_Cu(I,j+1) / (G%dyCu(I,j+1)) + if ((G%dx_Cv(i,J) > 0.0) .and. (G%dx_Cv(i,J) < G%dxCv(i,J)) .and. & + (G%dx_Cv(i,J) < G%dxCv(i,J) * CS%reduction_xy(I,J))) & + CS%reduction_xy(I,J) = G%dx_Cv(i,J) / (G%dxCv(i,J)) + if ((G%dx_Cv(i+1,J) > 0.0) .and. (G%dx_Cv(i+1,J) < G%dxCv(i+1,J)) .and. & + (G%dx_Cv(i+1,J) < G%dxCv(i+1,J) * CS%reduction_xy(I,J))) & + CS%reduction_xy(I,J) = G%dx_Cv(i+1,J) / (G%dxCv(i+1,J)) enddo ; enddo if (CS%Laplacian) then From 587e988ef69cfc27b4a47f38add72abdf54996e1 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Mon, 5 Aug 2019 15:29:34 -0400 Subject: [PATCH 158/297] Simplified rescaling in MOM_thickness_diffuse.F90 Simplification of dimensional rescaling factors in single line expressions in MOM_thickness_diffuse.F90. All answers are bitwise identical. --- src/parameterizations/lateral/MOM_thickness_diffuse.F90 | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 index 671bdb1225..4bc664859d 100644 --- a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 +++ b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 @@ -922,7 +922,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV ! sfn_slope_x(I,j,K) = max(uhtot(I,j)-h_avail(i+1,j,k), & ! min(uhtot(I,j)+h_avail(i,j,k), & ! min(h_avail_rsum(i+1,j,K), max(-h_avail_rsum(i,j,K), & -! (KH_u(I,j,K)*US%L_to_m*G%dy_Cu(I,j)) * ((e(i,j,K)-e(i+1,j,K))*US%m_to_L*G%IdxCu(I,j)) )) )) +! (KH_u(I,j,K)*G%dy_Cu(I,j)) * ((e(i,j,K)-e(i+1,j,K))*G%IdxCu(I,j)) )) )) else ! k <= nk_linear ! Balance the deeper flow with a return flow uniformly distributed ! though the remaining near-surface layers. This is the same as @@ -1171,7 +1171,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV ! sfn_slope_y(i,J,K) = max(vhtot(i,J)-h_avail(i,j+1,k), & ! min(vhtot(i,J)+h_avail(i,j,k), & ! min(h_avail_rsum(i,j+1,K), max(-h_avail_rsum(i,j,K), & -! (KH_v(i,J,K)*US%L_to_m*G%dx_Cv(i,J)) * ((e(i,j,K)-e(i,j+1,K))*US%m_to_L*G%IdyCv(i,J)) )) )) +! (KH_v(i,J,K)*G%dx_Cv(i,J)) * ((e(i,j,K)-e(i,j+1,K))*G%IdyCv(i,J)) )) )) else ! k <= nk_linear ! Balance the deeper flow with a return flow uniformly distributed ! though the remaining near-surface layers. This is the same as @@ -1526,7 +1526,7 @@ subroutine add_detangling_Kh(h, e, Kh_u, Kh_v, KH_u_CFL, KH_v_CFL, tv, dt, G, GV do k=k_top,nz ; do i=ish,ie ; if (do_i(i)) then if (n==1) then ! This is a u-column. dH = 0.0 - denom = ((US%m_to_L**2*G%IareaT(i+1,j) + US%m_to_L**2*G%IareaT(i,j))*US%L_to_m*G%dy_Cu(I,j)) + denom = US%m_to_L * ((G%IareaT(i+1,j) + G%IareaT(i,j)) * G%dy_Cu(I,j)) ! This expression uses differences in e in place of h for better ! consistency with the slopes. if (denom > 0.0) & @@ -1551,7 +1551,7 @@ subroutine add_detangling_Kh(h, e, Kh_u, Kh_v, KH_u_CFL, KH_v_CFL, tv, dt, G, GV Kh_detangle(I,K+1) = Kh_detangle(I,K+1) + wt2*Kh_lay_u(I,j,k) else ! This is a v-column. dH = 0.0 - denom = ((US%m_to_L**2*G%IareaT(i,j+1) + US%m_to_L**2*G%IareaT(i,j))*US%L_to_m*G%dx_Cv(I,j)) + denom = US%m_to_L * ((G%IareaT(i,j+1) + G%IareaT(i,j)) * G%dx_Cv(I,j)) if (denom > 0.0) & dH = I_4t * ((e(i,j+1,K) - e(i,j+1,K+1)) - & (e(i,j,K) - e(i,j,K+1))) / denom From 57c2343c5e6054316c68db200a677d8c0ac3e0f6 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Mon, 5 Aug 2019 15:30:04 -0400 Subject: [PATCH 159/297] Simplified rescaling in MOM_set_diffusivity.F90 Simplification of dimensional rescaling factors in single line expressions in MOM_set_diffusivity.F90. All answers are bitwise identical. --- .../vertical/MOM_set_diffusivity.F90 | 38 +++++++++---------- 1 file changed, 19 insertions(+), 19 deletions(-) diff --git a/src/parameterizations/vertical/MOM_set_diffusivity.F90 b/src/parameterizations/vertical/MOM_set_diffusivity.F90 index 1059349454..dee3422a7a 100644 --- a/src/parameterizations/vertical/MOM_set_diffusivity.F90 +++ b/src/parameterizations/vertical/MOM_set_diffusivity.F90 @@ -1262,12 +1262,12 @@ subroutine add_drag_diffusivity(h, u, v, tv, fluxes, visc, j, TKE_to_Kd, & else ; TKE_to_layer = 0.0 ; endif ! TKE_Ray has been initialized to 0 above. - if (Rayleigh_drag) TKE_Ray = 0.5*CS%BBL_effic * US%m_to_L**2*G%IareaT(i,j) * & + if (Rayleigh_drag) TKE_Ray = 0.5*CS%BBL_effic * G%IareaT(i,j) * & US%m_to_Z**2 * US%T_to_s**2 * & - ((US%L_to_m**2*G%areaCu(I-1,j) * visc%Ray_u(I-1,j,k) * u(I-1,j,k)**2 + & - US%L_to_m**2*G%areaCu(I,j) * visc%Ray_u(I,j,k) * u(I,j,k)**2) + & - (US%L_to_m**2*G%areaCv(i,J-1) * visc%Ray_v(i,J-1,k) * v(i,J-1,k)**2 + & - US%L_to_m**2*G%areaCv(i,J) * visc%Ray_v(i,J,k) * v(i,J,k)**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 + & + G%areaCv(i,J) * visc%Ray_v(i,J,k) * v(i,J,k)**2)) if (TKE_to_layer + TKE_Ray > 0.0) then if (CS%BBL_mixing_as_max) then @@ -1444,11 +1444,11 @@ 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**2 * & - 0.5*CS%BBL_effic * US%m_to_L**2*G%IareaT(i,j) * & - ((US%L_to_m**2*G%areaCu(I-1,j) * visc%Ray_u(I-1,j,k) * u(I-1,j,k)**2 + & - US%L_to_m**2*G%areaCu(I,j) * visc%Ray_u(I,j,k) * u(I,j,k)**2) + & - (US%L_to_m**2*G%areaCv(i,J-1) * visc%Ray_v(i,J-1,k) * v(i,J-1,k)**2 + & - US%L_to_m**2*G%areaCv(i,J) * visc%Ray_v(i,J,k) * v(i,J,k)**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) + & + (G%areaCv(i,J-1) * visc%Ray_v(i,J-1,k) * v(i,J-1,k)**2 + & + G%areaCv(i,J) * visc%Ray_v(i,J,k) * v(i,J,k)**2)) ! Exponentially decay TKE across the thickness of the layer. ! This is energy loss in addition to work done as mixing, apparently to Joule heating. @@ -1759,16 +1759,16 @@ subroutine set_BBL_TKE(u, v, h, fluxes, visc, G, GV, US, CS) endif ; enddo do i=is,ie - visc%ustar_BBL(i,j) = sqrt(0.5*US%m_to_L**2*G%IareaT(i,j) * & - ((US%L_to_m**2*G%areaCu(I-1,j)*(ustar(I-1)*ustar(I-1)) + & - US%L_to_m**2*G%areaCu(I,j)*(ustar(I)*ustar(I))) + & - (US%L_to_m**2*G%areaCv(i,J-1)*(vstar(i,J-1)*vstar(i,J-1)) + & - US%L_to_m**2*G%areaCv(i,J)*(vstar(i,J)*vstar(i,J))) ) ) + visc%ustar_BBL(i,j) = sqrt(0.5*G%IareaT(i,j) * & + ((G%areaCu(I-1,j)*(ustar(I-1)*ustar(I-1)) + & + 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**2 * US%m_to_Z**2 * & - (((US%L_to_m**2*G%areaCu(I-1,j)*(ustar(I-1)*u2_bbl(I-1)) + & - US%L_to_m**2*G%areaCu(I,j) * (ustar(I)*u2_bbl(I))) + & - (US%L_to_m**2*G%areaCv(i,J-1)*(vstar(i,J-1)*v2_bbl(i,J-1)) + & - US%L_to_m**2*G%areaCv(i,J) * (vstar(i,J)*v2_bbl(i,J))) )*US%m_to_L**2*G%IareaT(i,j)) + (((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)) + & + G%areaCv(i,J) * (vstar(i,J)*v2_bbl(i,J))) )*G%IareaT(i,j)) enddo enddo !$OMP end parallel From b758eb41d5f03f258f8b95ec5b66b574200ebc54 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Mon, 5 Aug 2019 15:30:25 -0400 Subject: [PATCH 160/297] Simplified rescaling in MOM_vert_friction.F90 Simplification of dimensional rescaling factors in single line expressions in MOM_vert_friction.F90. All answers are bitwise identical. --- .../vertical/MOM_vert_friction.F90 | 40 +++++++++---------- 1 file changed, 20 insertions(+), 20 deletions(-) diff --git a/src/parameterizations/vertical/MOM_vert_friction.F90 b/src/parameterizations/vertical/MOM_vert_friction.F90 index ff6d834215..930fcbdc6b 100644 --- a/src/parameterizations/vertical/MOM_vert_friction.F90 +++ b/src/parameterizations/vertical/MOM_vert_friction.F90 @@ -1395,9 +1395,9 @@ subroutine vertvisc_limit_vel(u, v, h, ADp, CDp, forces, visc, dt, G, GV, US, CS do k=1,nz ; do I=Isq,Ieq if (abs(u(I,j,k)) < CS%vel_underflow) u(I,j,k) = 0.0 if (u(I,j,k) < 0.0) then - CFL = (-u(I,j,k) * dt) * (US%L_to_m*G%dy_Cu(I,j) * US%m_to_L**2*G%IareaT(i+1,j)) + CFL = (-US%m_s_to_L_T*u(I,j,k) * US%s_to_T*dt) * (G%dy_Cu(I,j) * G%IareaT(i+1,j)) else - CFL = (u(I,j,k) * dt) * (US%L_to_m*G%dy_Cu(I,j) * US%m_to_L**2*G%IareaT(i,j)) + CFL = (US%m_s_to_L_T*u(I,j,k) * US%s_to_T*dt) * (G%dy_Cu(I,j) * G%IareaT(i,j)) endif if (CFL > CS%CFL_trunc) trunc_any = .true. if (CFL > CS%CFL_report) then @@ -1421,11 +1421,11 @@ subroutine vertvisc_limit_vel(u, v, h, ADp, CDp, forces, visc, dt, G, GV, US, CS if (trunc_any) then ; if (CS%CFL_based_trunc) then do k=1,nz ; do I=Isq,Ieq - if ((u(I,j,k) * (dt * US%L_to_m*G%dy_Cu(I,j))) * US%m_to_L**2*G%IareaT(i+1,j) < -CS%CFL_trunc) then - u(I,j,k) = (-0.9*CS%CFL_trunc) * (US%L_to_m**2*G%areaT(i+1,j) / (dt * US%L_to_m*G%dy_Cu(I,j))) + if ((US%m_s_to_L_T*u(I,j,k) * (US%s_to_T*dt * G%dy_Cu(I,j))) * G%IareaT(i+1,j) < -CS%CFL_trunc) then + u(I,j,k) = US%L_T_to_m_s*(-0.9*CS%CFL_trunc) * (G%areaT(i+1,j) / (US%s_to_T*dt * G%dy_Cu(I,j))) if (h(i,j,k) + h(i+1,j,k) > H_report) CS%ntrunc = CS%ntrunc + 1 - elseif ((u(I,j,k) * (dt * US%L_to_m*G%dy_Cu(I,j))) * US%m_to_L**2*G%IareaT(i,j) > CS%CFL_trunc) then - u(I,j,k) = (0.9*CS%CFL_trunc) * (US%L_to_m**2*G%areaT(i,j) / (dt * US%L_to_m*G%dy_Cu(I,j))) + elseif ((US%m_s_to_L_T*u(I,j,k) * (US%s_to_T*dt * G%dy_Cu(I,j))) * G%IareaT(i,j) > CS%CFL_trunc) then + u(I,j,k) = US%L_T_to_m_s*(0.9*CS%CFL_trunc) * (G%areaT(i,j) / (US%s_to_T*dt * G%dy_Cu(I,j))) if (h(i,j,k) + h(i+1,j,k) > H_report) CS%ntrunc = CS%ntrunc + 1 endif enddo ; enddo @@ -1441,11 +1441,11 @@ subroutine vertvisc_limit_vel(u, v, h, ADp, CDp, forces, visc, dt, G, GV, US, CS !$OMP parallel do default(none) shared(nz,js,je,Isq,Ieq,u,dt,G,CS,h,H_report) do k=1,nz ; do j=js,je ; do I=Isq,Ieq if (abs(u(I,j,k)) < CS%vel_underflow) then ; u(I,j,k) = 0.0 - elseif ((u(I,j,k) * (dt * US%L_to_m*G%dy_Cu(I,j))) * US%m_to_L**2*G%IareaT(i+1,j) < -CS%CFL_trunc) then - u(I,j,k) = (-0.9*CS%CFL_trunc) * (US%L_to_m**2*G%areaT(i+1,j) / (dt * US%L_to_m*G%dy_Cu(I,j))) + elseif ((US%m_s_to_L_T*u(I,j,k) * (US%s_to_T*dt * G%dy_Cu(I,j))) * G%IareaT(i+1,j) < -CS%CFL_trunc) then + u(I,j,k) = US%L_T_to_m_s*(-0.9*CS%CFL_trunc) * (G%areaT(i+1,j) / (US%s_to_T*dt * G%dy_Cu(I,j))) if (h(i,j,k) + h(i+1,j,k) > H_report) CS%ntrunc = CS%ntrunc + 1 - elseif ((u(I,j,k) * (dt * US%L_to_m*G%dy_Cu(I,j))) * US%m_to_L**2*G%IareaT(i,j) > CS%CFL_trunc) then - u(I,j,k) = (0.9*CS%CFL_trunc) * (US%L_to_m**2*G%areaT(i,j) / (dt * US%L_to_m*G%dy_Cu(I,j))) + elseif ((US%m_s_to_L_T*u(I,j,k) * (US%s_to_T*dt * G%dy_Cu(I,j))) * G%IareaT(i,j) > CS%CFL_trunc) then + u(I,j,k) = US%L_T_to_m_s*(0.9*CS%CFL_trunc) * (G%areaT(i,j) / (US%s_to_T*dt * G%dy_Cu(I,j))) if (h(i,j,k) + h(i+1,j,k) > H_report) CS%ntrunc = CS%ntrunc + 1 endif enddo ; enddo ; enddo @@ -1480,9 +1480,9 @@ subroutine vertvisc_limit_vel(u, v, h, ADp, CDp, forces, visc, dt, G, GV, US, CS do k=1,nz ; do i=is,ie if (abs(v(i,J,k)) < CS%vel_underflow) v(i,J,k) = 0.0 if (v(i,J,k) < 0.0) then - CFL = (-v(i,J,k) * dt) * (US%L_to_m*G%dx_Cv(i,J) * US%m_to_L**2*G%IareaT(i,j+1)) + CFL = (-US%m_s_to_L_T*v(i,J,k) * US%s_to_T*dt) * (G%dx_Cv(i,J) * G%IareaT(i,j+1)) else - CFL = (v(i,J,k) * dt) * (US%L_to_m*G%dx_Cv(i,J) * US%m_to_L**2*G%IareaT(i,j)) + CFL = (US%m_s_to_L_T*v(i,J,k) * US%s_to_T*dt) * (G%dx_Cv(i,J) * G%IareaT(i,j)) endif if (CFL > CS%CFL_trunc) trunc_any = .true. if (CFL > CS%CFL_report) then @@ -1506,11 +1506,11 @@ subroutine vertvisc_limit_vel(u, v, h, ADp, CDp, forces, visc, dt, G, GV, US, CS if (trunc_any) then ; if (CS%CFL_based_trunc) then do k=1,nz; do i=is,ie - if ((v(i,J,k) * (dt * US%L_to_m*G%dx_Cv(i,J))) * US%m_to_L**2*G%IareaT(i,j+1) < -CS%CFL_trunc) then - v(i,J,k) = (-0.9*CS%CFL_trunc) * (US%L_to_m**2*G%areaT(i,j+1) / (dt * US%L_to_m*G%dx_Cv(i,J))) + if ((US%m_s_to_L_T*v(i,J,k) * (US%s_to_T*dt * G%dx_Cv(i,J))) * G%IareaT(i,j+1) < -CS%CFL_trunc) then + v(i,J,k) = US%L_T_to_m_s*(-0.9*CS%CFL_trunc) * (G%areaT(i,j+1) / (US%s_to_T*dt * G%dx_Cv(i,J))) if (h(i,j,k) + h(i,j+1,k) > H_report) CS%ntrunc = CS%ntrunc + 1 - elseif ((v(i,J,k) * (dt * US%L_to_m*G%dx_Cv(i,J))) * US%m_to_L**2*G%IareaT(i,j) > CS%CFL_trunc) then - v(i,J,k) = (0.9*CS%CFL_trunc) * (US%L_to_m**2*G%areaT(i,j) / (dt * US%L_to_m*G%dx_Cv(i,J))) + elseif ((US%m_s_to_L_T*v(i,J,k) * (US%s_to_T*dt * G%dx_Cv(i,J))) * G%IareaT(i,j) > CS%CFL_trunc) then + v(i,J,k) = US%L_T_to_m_s*(0.9*CS%CFL_trunc) * (G%areaT(i,j) / (US%s_to_T*dt * G%dx_Cv(i,J))) if (h(i,j,k) + h(i,j+1,k) > H_report) CS%ntrunc = CS%ntrunc + 1 endif enddo ; enddo @@ -1526,11 +1526,11 @@ subroutine vertvisc_limit_vel(u, v, h, ADp, CDp, forces, visc, dt, G, GV, US, CS !$OMP parallel do default(shared) do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie if (abs(v(i,J,k)) < CS%vel_underflow) then ; v(i,J,k) = 0.0 - elseif ((v(i,J,k) * (dt * US%L_to_m*G%dx_Cv(i,J))) * US%m_to_L**2*G%IareaT(i,j+1) < -CS%CFL_trunc) then - v(i,J,k) = (-0.9*CS%CFL_trunc) * (US%L_to_m**2*G%areaT(i,j+1) / (dt * US%L_to_m*G%dx_Cv(i,J))) + elseif ((US%m_s_to_L_T*v(i,J,k) * (US%s_to_T*dt * G%dx_Cv(i,J))) * G%IareaT(i,j+1) < -CS%CFL_trunc) then + v(i,J,k) = US%L_T_to_m_s*(-0.9*CS%CFL_trunc) * (G%areaT(i,j+1) / (US%s_to_T*dt * G%dx_Cv(i,J))) if (h(i,j,k) + h(i,j+1,k) > H_report) CS%ntrunc = CS%ntrunc + 1 - elseif ((v(i,J,k) * (dt * US%L_to_m*G%dx_Cv(i,J))) * US%m_to_L**2*G%IareaT(i,j) > CS%CFL_trunc) then - v(i,J,k) = (0.9*CS%CFL_trunc) * (US%L_to_m**2*G%areaT(i,j) / (dt * US%L_to_m*G%dx_Cv(i,J))) + elseif ((US%m_s_to_L_T*v(i,J,k) * (US%s_to_T*dt * G%dx_Cv(i,J))) * G%IareaT(i,j) > CS%CFL_trunc) then + v(i,J,k) = US%L_T_to_m_s*(0.9*CS%CFL_trunc) * (G%areaT(i,j) / (US%s_to_T*dt * G%dx_Cv(i,J))) if (h(i,j,k) + h(i,j+1,k) > H_report) CS%ntrunc = CS%ntrunc + 1 endif enddo ; enddo ; enddo From 606280196825e2e6675bf595ff76aefcb061033a Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Mon, 5 Aug 2019 15:30:54 -0400 Subject: [PATCH 161/297] Simplified rescaling in MOM_tracer_hor_diff.F90 Simplification of dimensional rescaling factors in single line expressions in MOM_tracer_hor_diff.F90. All answers are bitwise identical. --- src/tracer/MOM_tracer_hor_diff.F90 | 32 +++++++++++++++--------------- 1 file changed, 16 insertions(+), 16 deletions(-) diff --git a/src/tracer/MOM_tracer_hor_diff.F90 b/src/tracer/MOM_tracer_hor_diff.F90 index b279c20d8c..1f4e0b8987 100644 --- a/src/tracer/MOM_tracer_hor_diff.F90 +++ b/src/tracer/MOM_tracer_hor_diff.F90 @@ -244,48 +244,48 @@ subroutine tracer_hordiff(h, dt, MEKE, VarMix, G, GV, US, CS, Reg, tv, do_online !$OMP parallel do default(shared) do j=js,je ; do I=is-1,ie - khdt_x(I,j) = dt*(Kh_u(I,j)*(US%L_to_m*G%dy_Cu(I,j)*US%m_to_L*G%IdxCu(I,j))) + khdt_x(I,j) = dt*(Kh_u(I,j)*(G%dy_Cu(I,j)*G%IdxCu(I,j))) enddo ; enddo !$OMP parallel do default(shared) do J=js-1,je ; do i=is,ie - khdt_y(i,J) = dt*(Kh_v(i,J)*(US%L_to_m*G%dx_Cv(i,J)*US%m_to_L*G%IdyCv(i,J))) + khdt_y(i,J) = dt*(Kh_v(i,J)*(G%dx_Cv(i,J)*G%IdyCv(i,J))) enddo ; enddo elseif (Resoln_scaled) then !$OMP parallel do default(shared) private(Res_fn) do j=js,je ; do I=is-1,ie Res_fn = 0.5 * (VarMix%Res_fn_h(i,j) + VarMix%Res_fn_h(i+1,j)) Kh_u(I,j) = max(CS%KhTr * Res_fn, CS%KhTr_min) - khdt_x(I,j) = dt*(CS%KhTr*(US%L_to_m*G%dy_Cu(I,j)*US%m_to_L*G%IdxCu(I,j))) * Res_fn + khdt_x(I,j) = dt*(CS%KhTr*(G%dy_Cu(I,j)*G%IdxCu(I,j))) * Res_fn enddo ; enddo !$OMP parallel do default(shared) private(Res_fn) do J=js-1,je ; do i=is,ie Res_fn = 0.5*(VarMix%Res_fn_h(i,j) + VarMix%Res_fn_h(i,j+1)) Kh_v(i,J) = max(CS%KhTr * Res_fn, CS%KhTr_min) - khdt_y(i,J) = dt*(CS%KhTr*(US%L_to_m*G%dx_Cv(i,J)*US%m_to_L*G%IdyCv(i,J))) * Res_fn + khdt_y(i,J) = dt*(CS%KhTr*(G%dx_Cv(i,J)*G%IdyCv(i,J))) * Res_fn enddo ; enddo else ! Use a simple constant diffusivity. if (CS%id_KhTr_u > 0) then !$OMP parallel do default(shared) do j=js,je ; do I=is-1,ie Kh_u(I,j) = CS%KhTr - khdt_x(I,j) = dt*(CS%KhTr*(US%L_to_m*G%dy_Cu(I,j)*US%m_to_L*G%IdxCu(I,j))) + khdt_x(I,j) = dt*(CS%KhTr*(G%dy_Cu(I,j)*G%IdxCu(I,j))) enddo ; enddo else !$OMP parallel do default(shared) do j=js,je ; do I=is-1,ie - khdt_x(I,j) = dt*(CS%KhTr*(US%L_to_m*G%dy_Cu(I,j)*US%m_to_L*G%IdxCu(I,j))) + khdt_x(I,j) = dt*(CS%KhTr*(G%dy_Cu(I,j)*G%IdxCu(I,j))) enddo ; enddo endif if (CS%id_KhTr_v > 0) then !$OMP parallel do default(shared) do J=js-1,je ; do i=is,ie Kh_v(i,J) = CS%KhTr - khdt_y(i,J) = dt*(CS%KhTr*(US%L_to_m*G%dx_Cv(i,J)*US%m_to_L*G%IdyCv(i,J))) + khdt_y(i,J) = dt*(CS%KhTr*(G%dx_Cv(i,J)*G%IdyCv(i,J))) enddo ; enddo else !$OMP parallel do default(shared) do J=js-1,je ; do i=is,ie - khdt_y(i,J) = dt*(CS%KhTr*(US%L_to_m*G%dx_Cv(i,J)*US%m_to_L*G%IdyCv(i,J))) + khdt_y(i,J) = dt*(CS%KhTr*(G%dx_Cv(i,J)*G%IdyCv(i,J))) enddo ; enddo endif endif ! VarMix @@ -294,34 +294,34 @@ subroutine tracer_hordiff(h, dt, MEKE, VarMix, G, GV, US, CS, Reg, tv, do_online if ((CS%id_KhTr_u > 0) .or. (CS%id_KhTr_h > 0)) then !$OMP parallel do default(shared) private(khdt_max) do j=js,je ; do I=is-1,ie - khdt_max = 0.125*CS%max_diff_CFL * min(US%L_to_m**2*G%areaT(i,j), US%L_to_m**2*G%areaT(i+1,j)) + khdt_max = 0.125*CS%max_diff_CFL * US%L_to_m**2*min(G%areaT(i,j), G%areaT(i+1,j)) if (khdt_x(I,j) > khdt_max) then khdt_x(I,j) = khdt_max - if (dt*(US%L_to_m*G%dy_Cu(I,j)*US%m_to_L*G%IdxCu(I,j)) > 0.0) & - Kh_u(I,j) = khdt_x(I,j) / (dt*(US%L_to_m*G%dy_Cu(I,j)*US%m_to_L*G%IdxCu(I,j))) + if (dt*(G%dy_Cu(I,j)*G%IdxCu(I,j)) > 0.0) & + Kh_u(I,j) = khdt_x(I,j) / (dt*(G%dy_Cu(I,j)*G%IdxCu(I,j))) endif enddo ; enddo else !$OMP parallel do default(shared) private(khdt_max) do j=js,je ; do I=is-1,ie - khdt_max = 0.125*CS%max_diff_CFL * min(US%L_to_m**2*G%areaT(i,j), US%L_to_m**2*G%areaT(i+1,j)) + khdt_max = 0.125*CS%max_diff_CFL * US%L_to_m**2*min(G%areaT(i,j), G%areaT(i+1,j)) khdt_x(I,j) = min(khdt_x(I,j), khdt_max) enddo ; enddo endif if ((CS%id_KhTr_v > 0) .or. (CS%id_KhTr_h > 0)) then !$OMP parallel do default(shared) private(khdt_max) do J=js-1,je ; do i=is,ie - khdt_max = 0.125*CS%max_diff_CFL * min(US%L_to_m**2*G%areaT(i,j), US%L_to_m**2*G%areaT(i,j+1)) + khdt_max = 0.125*CS%max_diff_CFL * US%L_to_m**2*min(G%areaT(i,j), G%areaT(i,j+1)) if (khdt_y(i,J) > khdt_max) then khdt_y(i,J) = khdt_max - if (dt*(US%L_to_m*G%dx_Cv(i,J)*US%m_to_L*G%IdyCv(i,J)) > 0.0) & - Kh_v(i,J) = khdt_y(i,J) / (dt*(US%L_to_m*G%dx_Cv(i,J)*US%m_to_L*G%IdyCv(i,J))) + if (dt*(G%dx_Cv(i,J)*G%IdyCv(i,J)) > 0.0) & + Kh_v(i,J) = khdt_y(i,J) / (dt*(G%dx_Cv(i,J)*G%IdyCv(i,J))) endif enddo ; enddo else !$OMP parallel do default(shared) private(khdt_max) do J=js-1,je ; do i=is,ie - khdt_max = 0.125*CS%max_diff_CFL * min(US%L_to_m**2*G%areaT(i,j), US%L_to_m**2*G%areaT(i,j+1)) + khdt_max = 0.125*CS%max_diff_CFL * US%L_to_m**2*min(G%areaT(i,j), G%areaT(i,j+1)) khdt_y(i,J) = min(khdt_y(i,J), khdt_max) enddo ; enddo endif From 3689eb51a6a3e18612b0506bb26fb1a123265f16 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 6 Aug 2019 18:40:35 -0400 Subject: [PATCH 162/297] Rescaled internal variables in MOM_hor_visc.F90 Rescaled multiple internal variables in MOM_hor_visc.F90 for more complete dimensional consistency testing. One dimensionally inconsistent expression (i.e., a bug) was identified and marked, but the code has not been changed yet so that the answers do not change. It is conceivable that underflow would be an issue in some test cases with out an explicitly set underflow velocity, but all answers in the MOM6-examples test csaes are bitwise identical. --- .../lateral/MOM_hor_visc.F90 | 652 +++++++++--------- 1 file changed, 342 insertions(+), 310 deletions(-) diff --git a/src/parameterizations/lateral/MOM_hor_visc.F90 b/src/parameterizations/lateral/MOM_hor_visc.F90 index 2162e373fa..93c6324025 100644 --- a/src/parameterizations/lateral/MOM_hor_visc.F90 +++ b/src/parameterizations/lateral/MOM_hor_visc.F90 @@ -68,14 +68,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 T-1 ~> m2 s-1]. The default is 0.0. + !! viscosity [L2 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 T-1 ~> m2 s-1]. + real :: Kh_aniso !< The anisotropic viscosity [L2 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 @@ -86,15 +86,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 T-1 ~> m2 s-1]. + !< The background Laplacian viscosity at h points [L2 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 T-1 ~> m2 s-1]. + !< The background Laplacian viscosity at h points [L2 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 T-1 ~> m4 s-1]. + !< The background biharmonic viscosity at h points [L4 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 @@ -106,17 +106,17 @@ module MOM_hor_visc !< The amount by which stresses through h points are reduced !! due to partial barriers [nondim]. real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: & - 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]. + Kh_Max_xx, & !< The maximum permitted Laplacian viscosity [L2 T-1 ~> m2 s-1]. + Ah_Max_xx, & !< The maximum permitted biharmonic viscosity [L4 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 T-1 ~> m2 s-1]. + !< The background Laplacian viscosity at q points [L2 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 T-1 ~> m4 s-1]. + !< The background biharmonic viscosity at q points [L4 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 @@ -128,43 +128,43 @@ 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 T-1 ~> m2 s-1]. - Ah_Max_xy, & !< The maximum permitted biharmonic viscosity [m4 T-1 ~> m4 s-1]. + Kh_Max_xy, & !< The maximum permitted Laplacian viscosity [L2 T-1 ~> m2 s-1]. + Ah_Max_xy, & !< The maximum permitted biharmonic viscosity [L4 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 real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: & - dx2h, & !< Pre-calculated dx^2 at h points [m2] - dy2h, & !< Pre-calculated dy^2 at h points [m2] + dx2h, & !< Pre-calculated dx^2 at h points [L2 ~> m2] + dy2h, & !< Pre-calculated dy^2 at h points [L2 ~> m2] dx_dyT, & !< Pre-calculated dx/dy at h points [nondim] dy_dxT !< Pre-calculated dy/dx at h points [nondim] real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEMB_PTR_) :: & - dx2q, & !< Pre-calculated dx^2 at q points [m2] - dy2q, & !< Pre-calculated dy^2 at q points [m2] + dx2q, & !< Pre-calculated dx^2 at q points [L2 ~> m2] + dy2q, & !< Pre-calculated dy^2 at q points [L2 ~> m2] dx_dyBu, & !< Pre-calculated dx/dy at q points [nondim] dy_dxBu !< Pre-calculated dy/dx at q points [nondim] real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_) :: & - Idx2dyCu, & !< 1/(dx^2 dy) at u points [m-3] - Idxdy2u !< 1/(dx dy^2) at u points [m-3] + Idx2dyCu, & !< 1/(dx^2 dy) at u points [L-3 ~> m-3] + Idxdy2u !< 1/(dx dy^2) at u points [L-3 ~> m-3] real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_) :: & - Idx2dyCv, & !< 1/(dx^2 dy) at v points [m-3] - Idxdy2v !< 1/(dx dy^2) at v points [m-3] + Idx2dyCv, & !< 1/(dx^2 dy) at v points [L-3 ~> m-3] + Idxdy2v !< 1/(dx dy^2) at v points [L-3 ~> m-3] ! 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 [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] + Laplac2_const_xx, & !< Laplacian metric-dependent constants [L2 ~> m2] + Biharm5_const_xx, & !< Biharmonic metric-dependent constants [L5 ~> m5] + Laplac3_const_xx, & !< Laplacian metric-dependent constants [L3 ~> m3] + Biharm_const_xx, & !< Biharmonic metric-dependent constants [L4 ~> m4] + Biharm_const2_xx !< Biharmonic metric-dependent constants [T L4 ~> s m4] real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEMB_PTR_) :: & - 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] + Laplac2_const_xy, & !< Laplacian metric-dependent constants [L2 ~> m2] + Biharm5_const_xy, & !< Biharmonic metric-dependent constants [L5 ~> m5] + Laplac3_const_xy, & !< Laplacian metric-dependent constants [L3 ~> m3] + Biharm_const_xy, & !< Biharmonic metric-dependent constants [L4 ~> m4] + Biharm_const2_xy !< Biharmonic metric-dependent constants [T L4 ~> s m4] type(diag_ctrl), pointer :: diag => NULL() !< structure to regulate diagnostics @@ -197,14 +197,14 @@ module MOM_hor_visc !! u[is-2:ie+2,js-2:je+2] !! v[is-2:ie+2,js-2:je+2] !! h[is-1:ie+1,js-1:je+1] -subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, & +subroutine horizontal_viscosity(u_in, v_in, h, diffu, diffv, MEKE, VarMix, G, GV, US, & CS, OBC, BT) 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(SZIB_(G),SZJ_(G),SZK_(G)), & - intent(in) :: u !< The zonal velocity [m s-1]. + intent(in) :: u_in !< The zonal velocity [m s-1]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - intent(in) :: v !< The meridional velocity [m s-1]. + intent(in) :: v_in !< The meridional velocity [m s-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(inout) :: h !< Layer thicknesses [H ~> m or kg m-2]. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & @@ -224,69 +224,74 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, type(barotropic_CS), optional, pointer :: BT !< Pointer to a structure containing !! barotropic velocities. + !### Temporary variables that will be removed later. + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)) :: u !< The zonal velocity [L T-1 ~> m s-1]. + real, dimension(SZI_(G),SZJB_(G),SZK_(G)) :: v !< The meridional velocity [L T-1 ~> m s-1]. + ! Local variables real, dimension(SZIB_(G),SZJ_(G)) :: & - u0, & ! Laplacian of u [m-1 s-1] + u0, & ! Laplacian of u [L-1 T-1 ~> m-1 s-1] h_u, & ! Thickness interpolated to u points [H ~> m or kg m-2]. 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] ubtav ! zonal barotropic vel. ave. over baroclinic time-step [m s-1] real, dimension(SZI_(G),SZJB_(G)) :: & - v0, & ! Laplacian of v [m-1 s-1] + v0, & ! Laplacian of v [L-1 T-1 ~> m-1 s-1] h_v, & ! Thickness interpolated to v points [H ~> m or kg m-2]. 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] vbtav ! meridional barotropic vel. ave. over baroclinic time-step [m s-1] real, dimension(SZI_(G),SZJ_(G)) :: & - dudx_bt, dvdy_bt, & ! components in the barotropic horizontal tension [s-1] - 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-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] + dudx_bt, dvdy_bt, & ! components in the barotropic horizontal tension [T-1 ~> s-1] + div_xx, & ! Estimate of horizontal divergence at h-points [T-1 ~> s-1] + sh_xx, & ! horizontal tension (du/dx - dv/dy) including metric terms [T-1 ~> s-1] + sh_xx_bt, & ! barotropic horizontal tension (du/dx - dv/dy) including metric terms [T-1 ~> s-1] + str_xx,& ! str_xx is the diagonal term in the stress tensor [H L2 T-2 ~> m3 s-2 or kg s-2] + str_xx_GME,& ! smoothed diagonal term in the stress tensor from GME [H L2 T-2 ~> 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] - beta_h, & ! Gradient of planetary vorticity at h-points [m-1 s-1] - grad_vort_mag_h, & ! Magnitude of vorticity gradient at h-points [m-1 s-1] - grad_vort_mag_h_2d, & ! Magnitude of 2d vorticity gradient at h-points [m-1 s-1] - grad_div_mag_h, & ! Magnitude of divergence gradient at h-points [m-1 s-1] - dudx, dvdy, & ! components in the horizontal tension [s-1] - grad_vel_mag_h, & ! Magnitude of the velocity gradient tensor squared at h-points [s-2] - grad_vel_mag_bt_h, & ! Magnitude of the barotropic velocity gradient tensor squared at h-points [s-2] - grad_d2vel_mag_h, & ! Magnitude of the Laplacian of the velocity vector, squared [m-2 s-2] + ! [H L2 T-2 ~> m3 s-2 or kg s-2] + FrictWorkIntz, & ! depth integrated energy dissipated by lateral friction [kg m-2 L2 T-3 ~> 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] + ! beta_h, & ! Gradient of planetary vorticity at h-points [m-1 s-1] + grad_vort_mag_h, & ! Magnitude of vorticity gradient at h-points [L-1 T-1 ~> m-1 s-1] + grad_vort_mag_h_2d, & ! Magnitude of 2d vorticity gradient at h-points [L-1 T-1 ~> m-1 s-1] + grad_div_mag_h, & ! Magnitude of divergence gradient at h-points [L-1 T-1 ~> m-1 s-1] + dudx, dvdy, & ! components in the horizontal tension [T-1 ~> s-1] + grad_vel_mag_h, & ! Magnitude of the velocity gradient tensor squared at h-points [T-2 ~> s-2] + grad_vel_mag_bt_h, & ! Magnitude of the barotropic velocity gradient tensor squared at h-points [T-2 ~> s-2] + grad_d2vel_mag_h, & ! Magnitude of the Laplacian of the velocity vector, squared [L-2 T-2 ~> m-2 s-2] max_diss_rate_bt, & ! maximum possible energy dissipated by barotropic lateral friction [m2 s-3] - boundary_mask ! A mask that zeroes out cells with at least one land edge + boundary_mask ! A mask that zeroes out cells with at least one land edge [nondim] real, dimension(SZIB_(G),SZJB_(G)) :: & - dvdx, dudy, & ! components in the shearing strain [s-1] - dvdx_bt, dudy_bt, & ! components in the barotropic shearing strain [s-1] - sh_xy, & ! horizontal shearing strain (du/dy + dv/dx) including metric terms [s-1] - 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] + dvdx, dudy, & ! components in the shearing strain [T-1 s-1] + dv0dx, du0dy, & ! Components in the biharmonic equivalent of the shearing strain [L-2 T-1 ~> m-2 s-1] + dvdx_bt, dudy_bt, & ! components in the barotropic shearing strain [T-1 s-1] + sh_xy, & ! horizontal shearing strain (du/dy + dv/dx) including metric terms [T-1 ~> s-1] + sh_xy_bt, & ! barotropic horizontal shearing strain (du/dy + dv/dx) inc. metric terms [T-1 ~> s-1] + str_xy, & ! str_xy is the cross term in the stress tensor [H L2 T-2 ~> m3 s-2 or kg s-2] + str_xy_GME, & ! smoothed cross term in the stress tensor from GME [H L2 T-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] - beta_q, & ! Gradient of planetary vorticity at q-points [m-1 s-1] - grad_vort_mag_q, & ! Magnitude of vorticity gradient at q-points [m-1 s-1] - 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] + ! [H L2 T-2 ~> m3 s-2 or kg s-2] + vort_xy, & ! Vertical vorticity (dv/dx - du/dy) including metric terms [T-1 ~> 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] + ! beta_q, & ! Gradient of planetary vorticity at q-points [m-1 s-1] + grad_vort_mag_q, & ! Magnitude of vorticity gradient at q-points [L-1 T-1 ~> m-1 s-1] + grad_vort_mag_q_2d, & ! Magnitude of 2d vorticity gradient at q-points [L-1 T-1 ~> m-1 s-1] + grad_div_mag_q, & ! Magnitude of divergence gradient at q-points [L-1 T-1 ~> m-1 s-1] + grad_vel_mag_q, & ! Magnitude of the velocity gradient tensor squared at q-points [T-2 ~> 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. - grad_vel_mag_bt_q ! Magnitude of the barotropic velocity gradient tensor squared at q-points [s-2] + grad_vel_mag_bt_q ! Magnitude of the barotropic velocity gradient tensor squared at q-points [T-2 ~> s-2] real, dimension(SZIB_(G),SZJB_(G),SZK_(G)) :: & - Ah_q, & ! biharmonic viscosity at corner points [m4 T-1 ~> m4 s-1] - Kh_q, & ! Laplacian viscosity at corner points [m2 s-1] - sh_xy_3d, & ! horizontal shearing strain (du/dy + dv/dx) including metric terms [s-1] - vort_xy_q, & ! vertical vorticity at corner points [s-1] - GME_coeff_q !< GME coeff. at q-points [m2 T-1 ~> m2 s-1] + Ah_q, & ! biharmonic viscosity at corner points [L4 T-1 ~> m4 s-1] + Kh_q, & ! Laplacian viscosity at corner points [L2 T-1 ~> m2 s-1] + sh_xy_3d, & ! horizontal shearing strain (du/dy + dv/dx) including metric terms [T-1 ~> s-1] + vort_xy_q, & ! vertical vorticity at corner points [T-1 ~> s-1] + GME_coeff_q !< GME coeff. at q-points [L2 T-1 ~> m2 s-1] ! These 3-d arrays are unused. ! real, dimension(SZIB_(G),SZJ_(G),SZK_(G)+1) :: & @@ -294,33 +299,31 @@ 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 T-1 ~> m4 s-1] - Kh_h, & ! Laplacian viscosity at thickness points [m2 T-1 ~> m2 s-1] - sh_xx_3d, & ! horizontal tension (du/dx - dv/dy) including metric terms [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] + Ah_h, & ! biharmonic viscosity at thickness points [L4 T-1 ~> m4 s-1] + Kh_h, & ! Laplacian viscosity at thickness points [L2 T-1 ~> m2 s-1] + sh_xx_3d, & ! horizontal tension (du/dx - dv/dy) including metric terms [T-1 ~> s-1] + diss_rate, & ! MKE dissipated by parameterized shear production [L2 T-3 ~> m2 s-3] + max_diss_rate, & ! maximum possible energy dissipated by lateral friction [L2 T-3 ~> 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_GME, & ! work done by GME [W m-2] - div_xx_h ! horizontal divergence [s-1] + ! by friction [L2 T-3 ~> m2 s-3] + FrictWork, & ! work done by MKE dissipation mechanisms [kg m-2 L2 T-3 ~> W m-2] + FrictWork_diss, & ! negative definite work done by MKE dissipation mechanisms [kg m-2 L2 T-3 ~> W m-2] + FrictWorkMax, & ! maximum possible work done by MKE dissipation mechanisms [kg m-2 L2 T-3 ~> W m-2] + FrictWork_GME, & ! work done by GME [kg m-2 L2 T-3 ~> W m-2] + div_xx_h ! horizontal divergence [T-1 ~> s-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 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] + GME_coeff_h !< GME coeff. at h-points [L2 T-1 ~> m2 s-1] + real :: Ah ! biharmonic viscosity [L4 T-1 ~> m4 s-1] + real :: Kh ! Laplacian viscosity [L2 T-1 ~> m2 s-1] + real :: AhSm ! Smagorinsky biharmonic viscosity [L4 T-1 ~> m4 s-1] + real :: AhLth ! 2D Leith biharmonic viscosity [L4 T-1 ~> m4 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. real :: Shear_mag ! magnitude of the shear [T-1 ~> s-1] - real :: vert_vort_mag ! magnitude of the vertical vorticity gradient [m-1 T-1 ~> m-1 s-1] + real :: vert_vort_mag ! magnitude of the vertical vorticity gradient [L-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 @@ -338,10 +341,10 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, ! 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 [T-1 ~> s-1] - real :: local_strain ! Local variable for interpolating computed strain rates [s-1]. + real :: local_strain ! Local variable for interpolating computed strain rates [T-1 ~> 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 T-1 ~> m2 s-1] - real :: GME_coeff_limiter ! Maximum permitted value of the GME coefficient [m2 T-1 ~> m2 s-1] + real :: GME_coeff ! The GME (negative) viscosity coefficient [L2 T-1 ~> m2 s-1] + real :: GME_coeff_limiter ! Maximum permitted value of the GME coefficient [L2 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] @@ -416,7 +419,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*US%T_to_s + GME_coeff_limiter = 1e7*US%m_to_L**2*US%T_to_s ! initialize diag. array with zeros GME_coeff_h(:,:,:) = 0.0 @@ -432,9 +435,9 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, !#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)*US%m_to_L*(G%IdyCu(I,j) * ubtav(I,j) - & + dudx_bt(i,j) = CS%DY_dxT(i,j)*US%m_s_to_L_T*(G%IdyCu(I,j) * ubtav(I,j) - & G%IdyCu(I-1,j) * ubtav(I-1,j)) - dvdy_bt(i,j) = CS%DX_dyT(i,j)*US%m_to_L*(G%IdxCv(i,J) * vbtav(i,J) - & + dvdy_bt(i,j) = CS%DX_dyT(i,j)*US%m_s_to_L_T*(G%IdxCv(i,J) * vbtav(i,J) - & G%IdxCv(i,J-1) * vbtav(i,J-1)) enddo; enddo @@ -450,9 +453,9 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, ! Components for the barotropic shearing strain do J=js-2,Jeq+1 ; do I=is-2,Ieq+1 - dvdx_bt(I,J) = CS%DY_dxBu(I,J)*US%m_to_L*(vbtav(i+1,J)*G%IdyCv(i+1,J) & + dvdx_bt(I,J) = CS%DY_dxBu(I,J)*US%m_s_to_L_T*(vbtav(i+1,J)*G%IdyCv(i+1,J) & - vbtav(i,J)*G%IdyCv(i,J)) - dudy_bt(I,J) = CS%DX_dyBu(I,J)*US%m_to_L*(ubtav(I,j+1)*G%IdxCu(I,j+1) & + dudy_bt(I,J) = CS%DX_dyBu(I,J)*US%m_s_to_L_T*(ubtav(I,j+1)*G%IdxCu(I,j+1) & - ubtav(I,j)*G%IdxCu(I,j)) enddo ; enddo @@ -486,10 +489,12 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, enddo ; enddo !#GME# max_diss_rate_bt is not used. + !### Also, the expression for max_diss_rate_bt is dimensionally inconsistent. Perhaps + ! US%s_to_T**2*grad_vel_mag_t_h should be US%s_to_T*sqrt(grad_vel_mag_bt_h) if (associated(MEKE)) then ; if (associated(MEKE%mom_src)) then !#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) + max_diss_rate_bt(i,j) = 2.0*MEKE%MEKE(i,j) * US%s_to_T**2*grad_vel_mag_bt_h(i,j) enddo ; enddo endif ; endif @@ -500,7 +505,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, 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 + & - (0.25*(dvdy_bt(i,j)+dvdy_bt(i+1,j)+dvdy_bt(i,j+1)+dvdy_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 endif ! use_GME @@ -521,23 +526,32 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, !$OMP Shear_mag, h2uq, h2vq, hq, Kh_scale, hrat_min) do k=1,nz + ! This is temporary code until the input velocities have been dimensionally rescaled. + do j=Jsq-1,Jeq+2 ; do I=Isq-2,Ieq+2 + u(I,j,k) = US%m_s_to_L_T*u_in(I,j,k) + enddo ; enddo + do j=Jsq-2,Jeq+2 ; do i=Isq-1,Ieq+2 + v(i,J,k) = US%m_s_to_L_T*v_in(i,J,k) + enddo ; enddo + + ! The following are the forms of the horizontal tension and horizontal ! shearing strain advocated by Smagorinsky (1993) and discussed in ! Griffies and Hallberg (2000). ! Calculate horizontal tension do j=Jsq-1,Jeq+2 ; do i=Isq-1,Ieq+2 - dudx(i,j) = CS%DY_dxT(i,j)*US%m_to_L*(G%IdyCu(I,j) * u(I,j,k) - & + dudx(i,j) = CS%DY_dxT(i,j)*(G%IdyCu(I,j) * u(I,j,k) - & G%IdyCu(I-1,j) * u(I-1,j,k)) - dvdy(i,j) = CS%DX_dyT(i,j)*US%m_to_L*(G%IdxCv(i,J) * v(i,J,k) - & + dvdy(i,j) = CS%DX_dyT(i,j)*(G%IdxCv(i,J) * v(i,J,k) - & G%IdxCv(i,J-1) * v(i,J-1,k)) sh_xx(i,j) = dudx(i,j) - dvdy(i,j) enddo ; enddo ! Components for the shearing strain do J=js-2,Jeq+1 ; do I=is-2,Ieq+1 - dvdx(I,J) = CS%DY_dxBu(I,J)*US%m_to_L*(v(i+1,J,k)*G%IdyCv(i+1,J) - v(i,J,k)*G%IdyCv(i,J)) - dudy(I,J) = CS%DX_dyBu(I,J)*US%m_to_L*(u(I,j+1,k)*G%IdxCu(I,j+1) - u(I,j,k)*G%IdxCu(I,j)) + dvdx(I,J) = CS%DY_dxBu(I,J)*(v(i+1,J,k)*G%IdyCv(i+1,J) - v(i,J,k)*G%IdyCv(i,J)) + dudy(I,J) = CS%DX_dyBu(I,J)*(u(I,j+1,k)*G%IdxCu(I,j+1) - u(I,j,k)*G%IdxCu(I,j)) enddo ; enddo ! Interpolate the thicknesses to velocity points. @@ -574,17 +588,17 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, dudy(I,J) = 0. elseif (OBC%computed_strain) then if (OBC%segment(n)%direction == OBC_DIRECTION_N) then - dudy(I,J) = 2.0*US%m_to_L*CS%DX_dyBu(I,J)* & - (OBC%segment(n)%tangential_vel(I,J,k) - u(I,j,k))*G%IdxCu(I,j) + dudy(I,J) = 2.0*CS%DX_dyBu(I,J)* & + (US%m_s_to_L_T*OBC%segment(n)%tangential_vel(I,J,k) - u(I,j,k))*G%IdxCu(I,j) else - dudy(I,J) = 2.0*US%m_to_L*CS%DX_dyBu(I,J)* & - (u(I,j+1,k) - OBC%segment(n)%tangential_vel(I,J,k))*G%IdxCu(I,j+1) + dudy(I,J) = 2.0*CS%DX_dyBu(I,J)* & + (u(I,j+1,k) - US%m_s_to_L_T*OBC%segment(n)%tangential_vel(I,J,k))*G%IdxCu(I,j+1) endif elseif (OBC%specified_strain) then if (OBC%segment(n)%direction == OBC_DIRECTION_N) then - dudy(I,J) = CS%DX_dyBu(I,J)*OBC%segment(n)%tangential_grad(I,J,k)*G%IdxCu(I,j)*G%dxBu(I,J) + dudy(I,J) = CS%DX_dyBu(I,J)*US%T_to_s*OBC%segment(n)%tangential_grad(I,J,k)*G%IdxCu(I,j)*G%dxBu(I,J) else - dudy(I,J) = CS%DX_dyBu(I,J)*OBC%segment(n)%tangential_grad(I,J,k)*G%IdxCu(I,j+1)*G%dxBu(I,J) + dudy(I,J) = CS%DX_dyBu(I,J)*US%T_to_s*OBC%segment(n)%tangential_grad(I,J,k)*G%IdxCu(I,j+1)*G%dxBu(I,J) endif endif enddo @@ -596,17 +610,17 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, dvdx(I,J) = 0. elseif (OBC%computed_strain) then if (OBC%segment(n)%direction == OBC_DIRECTION_E) then - dvdx(I,J) = 2.0*US%m_to_L*CS%DY_dxBu(I,J)* & - (OBC%segment(n)%tangential_vel(I,J,k) - v(i,J,k))*G%IdyCv(i,J) + dvdx(I,J) = 2.0*CS%DY_dxBu(I,J)* & + (US%m_s_to_L_T*OBC%segment(n)%tangential_vel(I,J,k) - v(i,J,k))*G%IdyCv(i,J) else - dvdx(I,J) = 2.0*US%m_to_L*CS%DY_dxBu(I,J)* & - (v(i+1,J,k) - OBC%segment(n)%tangential_vel(I,J,k))*G%IdyCv(i+1,J) + dvdx(I,J) = 2.0*CS%DY_dxBu(I,J)* & + (v(i+1,J,k) - US%m_s_to_L_T*OBC%segment(n)%tangential_vel(I,J,k))*G%IdyCv(i+1,J) endif elseif (OBC%specified_strain) then if (OBC%segment(n)%direction == OBC_DIRECTION_E) then - dvdx(I,J) = CS%DY_dxBu(I,J)*OBC%segment(n)%tangential_grad(I,J,k)*G%IdyCv(i,J)*G%dxBu(I,J) + dvdx(I,J) = CS%DY_dxBu(I,J)*US%T_to_s*OBC%segment(n)%tangential_grad(I,J,k)*G%IdyCv(i,J)*G%dxBu(I,J) else - dvdx(I,J) = CS%DY_dxBu(I,J)*OBC%segment(n)%tangential_grad(I,J,k)*G%IdyCv(i+1,J)*G%dxBu(I,J) + dvdx(I,J) = CS%DY_dxBu(I,J)*US%T_to_s*OBC%segment(n)%tangential_grad(I,J,k)*G%IdyCv(i+1,J)*G%dxBu(I,J) endif endif enddo @@ -687,12 +701,12 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, ! Evaluate u0 = x.Div(Grad u) and v0 = y.Div( Grad u) if (CS%biharmonic) then do j=js-1,Jeq+1 ; do I=Isq-1,Ieq+1 - u0(I,j) = CS%IDXDY2u(I,j)*(CS%DY2h(i+1,j)*sh_xx(i+1,j) - CS%DY2h(i,j)*sh_xx(i,j)) + & - CS%IDX2dyCu(I,j)*(CS%DX2q(I,J)*sh_xy(I,J) - CS%DX2q(I,J-1)*sh_xy(I,J-1)) + u0(I,j) = CS%Idxdy2u(I,j)*(CS%dy2h(i+1,j)*sh_xx(i+1,j) - CS%dy2h(i,j)*sh_xx(i,j)) + & + CS%Idx2dyCu(I,j)*(CS%dx2q(I,J)*sh_xy(I,J) - CS%dx2q(I,J-1)*sh_xy(I,J-1)) enddo ; enddo do J=Jsq-1,Jeq+1 ; do i=is-1,Ieq+1 - v0(i,J) = CS%IDXDY2v(i,J)*(CS%DY2q(I,J)*sh_xy(I,J) - CS%DY2q(I-1,J)*sh_xy(I-1,J)) - & - CS%IDX2dyCv(i,J)*(CS%DX2h(i,j+1)*sh_xx(i,j+1) - CS%DX2h(i,j)*sh_xx(i,j)) + v0(i,J) = CS%Idxdy2v(i,J)*(CS%dy2q(I,J)*sh_xy(I,J) - CS%dy2q(I-1,J)*sh_xy(I-1,J)) - & + CS%Idx2dyCv(i,J)*(CS%dx2h(i,j+1)*sh_xx(i,j+1) - CS%dx2h(i,j)*sh_xx(i,j)) enddo ; enddo if (apply_OBC) then; if (OBC%zero_biharmonic) then do n=1,OBC%number_of_segments @@ -718,9 +732,9 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, ! Also note this will need OBC boundary conditions re-applied... do J=js-2,Jeq+1 ; do I=is-2,Ieq+1 DY_dxBu = G%dyBu(I,J) * G%IdxBu(I,J) - dvdx(I,J) = DY_dxBu * US%m_to_L*(v(i+1,J,k) * G%IdyCv(i+1,J) - v(i,J,k) * G%IdyCv(i,J)) + dvdx(I,J) = DY_dxBu * (v(i+1,J,k) * G%IdyCv(i+1,J) - v(i,J,k) * G%IdyCv(i,J)) DX_dyBu = G%dxBu(I,J) * G%IdyBu(I,J) - dudy(I,J) = DX_dyBu * US%m_to_L*(u(I,j+1,k) * G%IdxCu(I,j+1) - u(I,j,k) * G%IdxCu(I,j)) + dudy(I,J) = DX_dyBu * (u(I,j+1,k) * G%IdxCu(I,j+1) - u(I,j,k) * G%IdxCu(I,j)) enddo ; enddo ! Vorticity @@ -743,12 +757,12 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, ! Vorticity gradient do J=js-2,Jeq+1 ; do i=is-1,Ieq+1 DY_dxBu = G%dyBu(I,J) * G%IdxBu(I,J) - vort_xy_dx(i,J) = DY_dxBu * US%m_to_L*(vort_xy(I,J) * G%IdyCu(I,j) - vort_xy(I-1,J) * G%IdyCu(I-1,j)) + vort_xy_dx(i,J) = DY_dxBu * US%m_to_L*US%s_to_T*(vort_xy(I,J) * G%IdyCu(I,j) - vort_xy(I-1,J) * G%IdyCu(I-1,j)) enddo ; enddo do j=js-1,Jeq+1 ; do I=is-2,Ieq+1 DX_dyBu = G%dxBu(I,J) * G%IdyBu(I,J) - vort_xy_dy(I,j) = DX_dyBu * US%m_to_L*(vort_xy(I,J) * G%IdxCv(i,J) - vort_xy(I,J-1) * G%IdxCv(i,J-1)) + vort_xy_dy(I,j) = DX_dyBu * US%m_to_L*US%s_to_T*(vort_xy(I,J) * G%IdxCv(i,J) - vort_xy(I,J-1) * G%IdxCv(i,J-1)) enddo ; enddo call pass_vector(vort_xy_dy, vort_xy_dx, G%Domain) @@ -756,7 +770,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, if (CS%modified_Leith) then ! Divergence do j=Jsq-1,Jeq+2 ; do i=Isq-1,Ieq+2 - div_xx(i,j) = 0.5*US%m_to_L*((G%dyCu(I,j) * u(I,j,k) * (h(i+1,j,k)+h(i,j,k)) - & + div_xx(i,j) = 0.5*((G%dyCu(I,j) * u(I,j,k) * (h(i+1,j,k)+h(i,j,k)) - & G%dyCu(I-1,j) * u(I-1,j,k) * (h(i-1,j,k)+h(i,j,k)) ) + & (G%dxCv(i,J) * v(i,J,k) * (h(i,j,k)+h(i,j+1,k)) - & G%dxCv(i,J-1)*v(i,J-1,k)*(h(i,j,k)+h(i,j-1,k))))*G%IareaT(i,j) / & @@ -770,11 +784,11 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, ! Divergence gradient !#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) = US%m_to_L*G%IdxCu(I,j)*(div_xx(i+1,j) - div_xx(i,j)) + div_xx_dx(I,j) = US%s_to_T*US%m_to_L*G%IdxCu(I,j)*(div_xx(i+1,j) - div_xx(i,j)) enddo ; enddo !#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) = US%m_to_L*G%IdyCv(i,J)*(div_xx(i,j+1) - div_xx(i,j)) + div_xx_dy(i,J) = US%s_to_T*US%m_to_L*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. @@ -784,12 +798,12 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, ! Why use the magnitude of the average instead of the average magnitude? !#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 + & + grad_div_mag_h(i,j) = US%L_to_m*US%T_to_s*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 !#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 + & + grad_div_mag_q(I,J) = US%L_to_m*US%T_to_s*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 @@ -815,13 +829,13 @@ 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 !#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 - 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) ) - enddo ; enddo + ! 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) ) + ! 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)) @@ -835,15 +849,16 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, !#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 + & + grad_vort_mag_h_2d(i,j) = US%L_to_m*US%T_to_s*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 !#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 + & + grad_vort_mag_q_2d(I,J) = US%L_to_m*US%T_to_s*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 + ! This accumulates terms, some of which are in VarMix, so rescaling can not be done here. call calc_QG_Leith_viscosity(VarMix, G, GV, h, k, div_xx_dx, div_xx_dy, & vort_xy_dx, vort_xy_dy) @@ -851,12 +866,12 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, !#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 + & + grad_vort_mag_h(i,j) = US%L_to_m*US%T_to_s*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 !#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 + & + grad_vort_mag_q(I,J) = US%L_to_m*US%T_to_s*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 @@ -866,15 +881,15 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 if ((CS%Smagorinsky_Kh) .or. (CS%Smagorinsky_Ah)) then - Shear_mag = US%T_to_s * sqrt(sh_xx(i,j)*sh_xx(i,j) + & + Shear_mag = 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 if ((CS%Leith_Kh) .or. (CS%Leith_Ah)) then if (CS%use_QG_Leith_visc) then - 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)) + vert_vort_mag = 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 = US%T_to_s*(grad_vort_mag_h(i,j) + grad_div_mag_h(i,j)) + vert_vort_mag = (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 @@ -896,7 +911,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 + MEKE%Ku(i,j) * meke_res_fn ! *Add* the MEKE contribution (might be negative) + Kh = Kh + US%m_to_L**2*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 @@ -940,7 +955,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) * 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)) @@ -948,7 +963,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 + MEKE%Au(i,j) ! *Add* the MEKE contribution + if (use_MEKE_Au) Ah = Ah + US%L_to_m**4*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)) @@ -957,13 +972,13 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, if ((CS%id_Ah_h>0) .or. find_FrictWork .or. CS%debug) Ah_h(i,j,k) = Ah str_xx(i,j) = str_xx(i,j) + Ah * & - (CS%DY_dxT(i,j)*US%m_to_L*(G%IdyCu(I,j)*u0(I,j) - G%IdyCu(I-1,j)*u0(I-1,j)) - & - CS%DX_dyT(i,j) *US%m_to_L*(G%IdxCv(i,J)*v0(i,J) - G%IdxCv(i,J-1)*v0(i,J-1))) + (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 * & - (CS%DY_dxT(i,j)*US%m_to_L*(G%IdyCu(I,j)*u0(I,j) - G%IdyCu(I-1,j)*u0(I-1,j)) - & - CS%DX_dyT(i,j) *US%m_to_L*(G%IdxCv(i,J)*v0(i,J) - G%IdxCv(i,J-1)*v0(i,J-1))) + 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)) endif ! biharmonic @@ -973,8 +988,8 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, if (CS%biharmonic) then ! Gradient of Laplacian, for use in bi-harmonic term do J=js-1,Jeq ; do I=is-1,Ieq - dvdx(I,J) = CS%DY_dxBu(I,J)*US%m_to_L*(v0(i+1,J)*G%IdyCv(i+1,J) - v0(i,J)*G%IdyCv(i,J)) - dudy(I,J) = CS%DX_dyBu(I,J)*US%m_to_L*(u0(I,j+1)*G%IdxCu(I,j+1) - u0(I,j)*G%IdxCu(I,j)) + dv0dx(I,J) = CS%DY_dxBu(I,J)*(v0(i+1,J)*G%IdyCv(i+1,J) - v0(i,J)*G%IdyCv(i,J)) + du0dy(I,J) = CS%DX_dyBu(I,J)*(u0(I,j+1)*G%IdxCu(I,j+1) - u0(I,j)*G%IdxCu(I,j)) enddo ; enddo ! Adjust contributions to shearing strain on open boundaries. if (apply_OBC) then ; if (OBC%zero_strain .or. OBC%freeslip_strain) then @@ -983,17 +998,17 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, if (OBC%segment(n)%is_N_or_S .and. (J >= js-1) .and. (J <= Jeq)) then do I=OBC%segment(n)%HI%IsdB,OBC%segment(n)%HI%IedB if (OBC%zero_strain) then - dvdx(I,J) = 0. ; dudy(I,J) = 0. + dv0dx(I,J) = 0. ; du0dy(I,J) = 0. elseif (OBC%freeslip_strain) then - dudy(I,J) = 0. + du0dy(I,J) = 0. endif enddo elseif (OBC%segment(n)%is_E_or_W .and. (I >= is-1) .and. (I <= Ieq)) then do J=OBC%segment(n)%HI%JsdB,OBC%segment(n)%HI%JedB if (OBC%zero_strain) then - dvdx(I,J) = 0. ; dudy(I,J) = 0. + dv0dx(I,J) = 0. ; du0dy(I,J) = 0. elseif (OBC%freeslip_strain) then - dvdx(I,J) = 0. + dv0dx(I,J) = 0. endif enddo endif @@ -1005,15 +1020,15 @@ 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 = US%T_to_s * sqrt(sh_xy(I,J)*sh_xy(I,J) + & + Shear_mag = 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 if ((CS%Leith_Kh) .or. (CS%Leith_Ah)) then if (CS%use_QG_Leith_visc) then - 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)) + vert_vort_mag = 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 = US%T_to_s*(grad_vort_mag_q(I,J) + grad_div_mag_q(I,J)) + vert_vort_mag = (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) @@ -1060,7 +1075,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 + 0.25*US%m_to_L**2*( (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 @@ -1116,8 +1131,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 + 0.25*US%L_to_m**4*( (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 @@ -1126,19 +1141,29 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, if (CS%id_Ah_q>0 .or. CS%debug) 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) + Ah * ( dv0dx(I,J) + du0dy(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) = Ah * ( dv0dx(I,J) + du0dy(I,J) ) * & (hq(I,J) * G%mask2dBu(I,J) * CS%reduction_xy(I,J)) endif ! biharmonic enddo ; enddo - if (find_FrictWork) then if (CS%Laplacian) then + if (CS%biharmonic) then + !### This code is dimensionally incorrect, but needed to reproduce previous answers. + ! This should be considered a serious bug in cases where the answers change if the + ! following code is commented out - i.e. if both biharmonic and Laplacian are used + ! and FindFrictWork is true. + do J=js-1,Jeq ; do I=is-1,Ieq + dvdx(I,J) = US%m_to_L**2*dv0dx(I,J) + dudy(I,J) = US%m_to_L**2*du0dy(I,J) + enddo ; enddo + endif + 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 + & @@ -1160,8 +1185,9 @@ 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) + 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) enddo ; enddo else do j=js,je ; do i=is,ie @@ -1171,13 +1197,13 @@ 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) = -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) + 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) if (associated(MEKE)) then ; if (associated(MEKE%mom_src)) then ! This is the maximum possible amount of energy that can be converted ! per unit time, according to theory (multiplied by h) - max_diss_rate(i,j,k) = 2.0*MEKE%MEKE(i,j) * sqrt(grad_vel_mag_h(i,j)) + max_diss_rate(i,j,k) = 2.0*US%m_s_to_L_T**2*MEKE%MEKE(i,j) * sqrt(grad_vel_mag_h(i,j)) FrictWork_diss(i,j,k) = diss_rate(i,j,k) * h(i,j,k) * GV%H_to_kg_m2 FrictWorkMax(i,j,k) = -max_diss_rate(i,j,k) * h(i,j,k) * GV%H_to_kg_m2 @@ -1202,8 +1228,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*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) + 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) if ((G%bathyT(i,j) < H0_GME) .and. (H0_GME > 0.0)) & GME_coeff = (G%bathyT(i,j) / H0_GME)**2 * GME_coeff @@ -1222,8 +1248,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*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) + 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 @@ -1237,7 +1263,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, enddo ; enddo - ! applying GME diagonal term + ! Applying GME diagonal term. This is linear and the arguments can be rescaled. call smooth_GME(CS,G,GME_flux_h=str_xx_GME) call smooth_GME(CS,G,GME_flux_q=str_xy_GME) @@ -1256,7 +1282,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) = 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) + 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) enddo ; enddo endif @@ -1277,11 +1303,12 @@ 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%m_to_L*G%IdyCu(I,j)*(CS%DY2h(i,j) *str_xx(i,j) - & - CS%DY2h(i+1,j)*str_xx(i+1,j)) + & - US%m_to_L*G%IdxCu(I,j)*(CS%DX2q(I,J-1)*str_xy(I,J-1) - & - CS%DX2q(I,J) *str_xy(I,J))) * & - US%m_to_L**2*G%IareaCu(I,j)) / (h_u(i,j) + h_neglect) + diffu(I,j,k) = US%L_T_to_m_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))) * & + G%IareaCu(I,j)) / (h_u(i,j) + h_neglect) enddo ; enddo if (apply_OBC) then @@ -1299,11 +1326,12 @@ 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%m_to_L*G%IdyCv(i,J)*(CS%DY2q(I-1,J)*str_xy(I-1,J) - & - CS%DY2q(I,J) *str_xy(I,J)) - & - US%m_to_L*G%IdxCv(i,J)*(CS%DX2h(i,j) *str_xx(i,j) - & - CS%DX2h(i,j+1)*str_xx(i,j+1))) * & - US%m_to_L**2*G%IareaCv(i,J)) / (h_v(i,J) + h_neglect) + diffv(i,J,k) = US%L_T_to_m_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))) * & + G%IareaCv(i,J)) / (h_v(i,J) + h_neglect) enddo ; enddo if (apply_OBC) then ! This is not the right boundary condition. If all the masking of tendencies are done @@ -1321,21 +1349,21 @@ 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) = US%s_to_T*GV%H_to_kg_m2 * ( & - (str_xx(i,j)*(u(I,j,k)-u(I-1,j,k))*US%m_to_L*G%IdxT(i,j) & - -str_xx(i,j)*(v(i,J,k)-v(i,J-1,k))*US%m_to_L*G%IdyT(i,j)) & + FrictWork(i,j,k) = 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)*( & - (u(I,j+1,k)-u(I,j,k))*US%m_to_L*G%IdyBu(I,J) & - +(v(i+1,J,k)-v(i,J,k))*US%m_to_L*G%IdxBu(I,J) ) & + (u(I,j+1,k)-u(I,j,k))*G%IdyBu(I,J) & + +(v(i+1,J,k)-v(i,J,k))*G%IdxBu(I,J) ) & +str_xy(I-1,J-1)*( & - (u(I-1,j,k)-u(I-1,j-1,k))*US%m_to_L*G%IdyBu(I-1,J-1) & - +(v(i,J-1,k)-v(i-1,J-1,k))*US%m_to_L*G%IdxBu(I-1,J-1) )) & + (u(I-1,j,k)-u(I-1,j-1,k))*G%IdyBu(I-1,J-1) & + +(v(i,J-1,k)-v(i-1,J-1,k))*G%IdxBu(I-1,J-1) )) & +(str_xy(I-1,J)*( & - (u(I-1,j+1,k)-u(I-1,j,k))*US%m_to_L*G%IdyBu(I-1,J) & - +(v(i,J,k)-v(i-1,J,k))*US%m_to_L*G%IdxBu(I-1,J) ) & + (u(I-1,j+1,k)-u(I-1,j,k))*G%IdyBu(I-1,J) & + +(v(i,J,k)-v(i-1,J,k))*G%IdxBu(I-1,J) ) & +str_xy(I,J-1)*( & - (u(I,j,k)-u(I,j-1,k))*US%m_to_L*G%IdyBu(I,J-1) & - +(v(i+1,J-1,k)-v(i,J-1,k))*US%m_to_L*G%IdxBu(I,J-1) )) ) ) + (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 ; endif ! Make a similar calculation as for FrictWork above but accumulating into @@ -1352,7 +1380,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, do j=js,je ; do i=is,ie 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) + & + Shear_mag = 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)))) if (CS%answers_2018) then @@ -1372,33 +1400,34 @@ 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) + 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))*US%m_to_L*G%IdxT(i,j) & - -(str_xx(i,j)-RoScl*bhstr_xx(i,j))*(v(i,J,k)-v(i,J-1,k))*US%m_to_L*G%IdyT(i,j)) & + MEKE%mom_src(i,j) = MEKE%mom_src(i,j) + US%L_to_m**2*US%s_to_T**3*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))*( & - (u(I,j+1,k)-u(I,j,k))*US%m_to_L*G%IdyBu(I,J) & - +(v(i+1,J,k)-v(i,J,k))*US%m_to_L*G%IdxBu(I,J) ) & + (u(I,j+1,k)-u(I,j,k))*G%IdyBu(I,J) & + +(v(i+1,J,k)-v(i,J,k))*G%IdxBu(I,J) ) & +(str_xy(I-1,J-1)-RoScl*bhstr_xy(I-1,J-1))*( & - (u(I-1,j,k)-u(I-1,j-1,k))*US%m_to_L*G%IdyBu(I-1,J-1) & - +(v(i,J-1,k)-v(i-1,J-1,k))*US%m_to_L*G%IdxBu(I-1,J-1) )) & + (u(I-1,j,k)-u(I-1,j-1,k))*G%IdyBu(I-1,J-1) & + +(v(i,J-1,k)-v(i-1,J-1,k))*G%IdxBu(I-1,J-1) )) & +((str_xy(I-1,J)-RoScl*bhstr_xy(I-1,J))*( & - (u(I-1,j+1,k)-u(I-1,j,k))*US%m_to_L*G%IdyBu(I-1,J) & - +(v(i,J,k)-v(i-1,J,k))*US%m_to_L*G%IdxBu(I-1,J) ) & + (u(I-1,j+1,k)-u(I-1,j,k))*G%IdyBu(I-1,J) & + +(v(i,J,k)-v(i-1,J,k))*G%IdxBu(I-1,J) ) & +(str_xy(I,J-1)-RoScl*bhstr_xy(I,J-1))*( & - (u(I,j,k)-u(I,j-1,k))*US%m_to_L*G%IdyBu(I,J-1) & - +(v(i+1,J-1,k)-v(i,J-1,k))*US%m_to_L*G%IdxBu(I,J-1) )) ) ) + (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 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)) + MEKE%mom_src(i,j) = MEKE%mom_src(i,j) + & + US%L_to_m**2*US%s_to_T**3*MAX(FrictWork_diss(i,j,k), FrictWorkMax(i,j,k)) enddo ; enddo endif ! MEKE%backscatter if (CS%use_GME .and. associated(MEKE)) then if (associated(MEKE%GME_snk)) then do j=js,je ; do i=is,ie - MEKE%GME_snk(i,j) = MEKE%GME_snk(i,j) + FrictWork_GME(i,j,k) + MEKE%GME_snk(i,j) = MEKE%GME_snk(i,j) + US%L_to_m**2*US%s_to_T**3*FrictWork_GME(i,j,k) enddo ; enddo endif endif @@ -1425,13 +1454,13 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, if (CS%debug) then if (CS%Laplacian) then - call hchksum(Kh_h, "Kh_h", G%HI, haloshift=0, scale=US%s_to_T) - call Bchksum(Kh_q, "Kh_q", G%HI, haloshift=0, scale=US%s_to_T) - call Bchksum(sh_xy_3d, "shear_xy", G%HI, haloshift=0) - call hchksum(sh_xx_3d, "shear_xx", G%HI, haloshift=0) + call hchksum(Kh_h, "Kh_h", G%HI, haloshift=0, scale=US%L_to_m**2*US%s_to_T) + call Bchksum(Kh_q, "Kh_q", G%HI, haloshift=0, scale=US%L_to_m**2*US%s_to_T) + call Bchksum(sh_xy_3d, "shear_xy", G%HI, haloshift=0, scale=US%s_to_T) + call hchksum(sh_xx_3d, "shear_xx", G%HI, haloshift=0, scale=US%s_to_T) endif - if (CS%biharmonic) call hchksum(Ah_h, "Ah_h", G%HI, haloshift=0, scale=US%s_to_T) - if (CS%biharmonic) call Bchksum(Ah_q, "Ah_q", G%HI, haloshift=0, scale=US%s_to_T) + if (CS%biharmonic) call hchksum(Ah_h, "Ah_h", G%HI, haloshift=0, scale=US%L_to_m**4*US%s_to_T) + if (CS%biharmonic) call Bchksum(Ah_q, "Ah_q", G%HI, haloshift=0, scale=US%L_to_m**4*US%s_to_T) endif if (CS%id_FrictWorkIntz > 0) then @@ -1462,11 +1491,11 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS, MEKE) real, dimension(SZIB_(G),SZJ_(G)) :: u0u, u0v real, dimension(SZI_(G),SZJB_(G)) :: v0u, v0v ! u0v is the Laplacian sensitivities to the v velocities - ! at u points [m-2], with u0u, v0u, and v0v defined similarly. - real :: grid_sp_h2 ! Harmonic mean of the squares of the grid [m2] - 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] + ! at u points [L-2 ~> m-2], with u0u, v0u, and v0v defined similarly. + real :: grid_sp_h2 ! Harmonic mean of the squares of the grid [L2 ~> m2] + real :: grid_sp_h3 ! Harmonic mean of the squares of the grid^(3/2) [L3 ~> m3] + real :: grid_sp_q2 ! spacings at h and q points [L2 ~> m2] + real :: grid_sp_q3 ! spacings at h and q points^(3/2) [L3 ~> m3] 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 @@ -1475,10 +1504,10 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS, MEKE) ! [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] - real :: Ah ! biharmonic horizontal viscosity [m4 s-1] - 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 :: Kh ! Lapacian horizontal viscosity [L2 s-1] + real :: Ah ! biharmonic horizontal viscosity [L4 s-1] + real :: Kh_vel_scale ! this speed [L T-1 ~> m s-1] times grid spacing gives Lap visc + real :: Ah_vel_scale ! this speed [L 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 @@ -1491,7 +1520,7 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS, MEKE) 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 T-1 ~> m2 s-1] + real :: Kh_sin_lat ! Amplitude of latitudinally dependent viscosity [L2 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 @@ -1561,20 +1590,20 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS, MEKE) 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, scale=US%T_to_s) + units = "m2 s-1", default=0.0, scale=US%m_to_L**2*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, scale=US%T_to_s) + units = "m2 s-1", default=0.0, scale=US%m_to_L**2*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, scale=US%T_to_s) + units="m s-1", default=0.0, scale=US%m_s_to_L_T) 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, scale=US%T_to_s) + units = "m2 s-1", default=0.0, scale=US%m_to_L**2*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 "//& @@ -1637,7 +1666,7 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS, MEKE) 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, scale=US%T_to_s) + units = "m2 s-1", default=0.0, scale=US%m_to_L**2*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"//& @@ -1665,13 +1694,13 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS, MEKE) 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, scale=US%T_to_s) + units = "m4 s-1", default=0.0, scale=US%m_to_L**4*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, scale=US%T_to_s) + units="m s-1", default=0.0, scale=US%m_s_to_L_T) 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. "//& @@ -1838,7 +1867,7 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS, MEKE) 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, scale=US%T_to_s) + G%domain, timelevel=1, scale=US%m_to_L**2*US%T_to_s) call pass_var(CS%Kh_bg_2d, G%domain) endif @@ -1869,11 +1898,11 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS, MEKE) endif do J=js-2,Jeq+1 ; do I=is-2,Ieq+1 - CS%DX2q(I,J) = US%L_to_m**2*G%dxBu(I,J)*G%dxBu(I,J) ; CS%DY2q(I,J) = US%L_to_m**2*G%dyBu(I,J)*G%dyBu(I,J) + CS%dx2q(I,J) = G%dxBu(I,J)*G%dxBu(I,J) ; CS%dy2q(I,J) = G%dyBu(I,J)*G%dyBu(I,J) CS%DX_dyBu(I,J) = G%dxBu(I,J)*G%IdyBu(I,J) ; CS%DY_dxBu(I,J) = G%dyBu(I,J)*G%IdxBu(I,J) enddo ; enddo do j=Jsq-1,Jeq+2 ; do i=Isq-1,Ieq+2 - CS%DX2h(i,j) = US%L_to_m**2*G%dxT(i,j)*G%dxT(i,j) ; CS%DY2h(i,j) = US%L_to_m**2*G%dyT(i,j)*G%dyT(i,j) + CS%dx2h(i,j) = G%dxT(i,j)*G%dxT(i,j) ; CS%dy2h(i,j) = G%dyT(i,j)*G%dyT(i,j) CS%DX_dyT(i,j) = G%dxT(i,j)*G%IdyT(i,j) ; CS%DY_dxT(i,j) = G%dyT(i,j)*G%IdxT(i,j) enddo ; enddo @@ -1917,7 +1946,7 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS, MEKE) ! Calculate and store the background viscosity at h-points do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 ! Static factors in the Smagorinsky and Leith schemes - grid_sp_h2 = (2.0*CS%DX2h(i,j)*CS%DY2h(i,j)) / (CS%DX2h(i,j) + CS%DY2h(i,j)) + grid_sp_h2 = (2.0*CS%dx2h(i,j)*CS%dy2h(i,j)) / (CS%dx2h(i,j) + CS%dy2h(i,j)) grid_sp_h3 = grid_sp_h2*sqrt(grid_sp_h2) if (CS%Smagorinsky_Kh) CS%Laplac2_const_xx(i,j) = Smag_Lap_const * grid_sp_h2 if (CS%Leith_Kh) CS%Laplac3_const_xx(i,j) = Leith_Lap_const * grid_sp_h3 @@ -1943,7 +1972,7 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS, MEKE) ! Calculate and store the background viscosity at q-points do J=js-1,Jeq ; do I=is-1,Ieq ! Static factors in the Smagorinsky and Leith schemes - grid_sp_q2 = (2.0*CS%DX2q(I,J)*CS%DY2q(I,J)) / (CS%DX2q(I,J) + CS%DY2q(I,J)) + grid_sp_q2 = (2.0*CS%dx2q(I,J)*CS%dy2q(I,J)) / (CS%dx2q(I,J) + CS%dy2q(I,J)) grid_sp_q3 = grid_sp_q2*sqrt(grid_sp_q2) if (CS%Smagorinsky_Kh) CS%Laplac2_const_xy(I,J) = Smag_Lap_const * grid_sp_q2 if (CS%Leith_Kh) CS%Laplac3_const_xy(I,J) = Leith_Lap_const * grid_sp_q3 @@ -1971,12 +2000,12 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS, MEKE) if (CS%biharmonic) then do j=js-1,Jeq+1 ; do I=Isq-1,Ieq+1 - CS%IDX2dyCu(I,j) = (US%m_to_L*G%IdxCu(I,j)*US%m_to_L*G%IdxCu(I,j)) * US%m_to_L*G%IdyCu(I,j) - CS%IDXDY2u(I,j) = US%m_to_L*G%IdxCu(I,j) * US%m_to_L**2*(G%IdyCu(I,j)*G%IdyCu(I,j)) + CS%Idx2dyCu(I,j) = (G%IdxCu(I,j)*G%IdxCu(I,j)) * G%IdyCu(I,j) + CS%Idxdy2u(I,j) = G%IdxCu(I,j) * (G%IdyCu(I,j)*G%IdyCu(I,j)) enddo ; enddo do J=Jsq-1,Jeq+1 ; do i=is-1,Ieq+1 - CS%IDX2dyCv(i,J) = US%m_to_L**2*(G%IdxCv(i,J)*G%IdxCv(i,J)) * US%m_to_L*G%IdyCv(i,J) - CS%IDXDY2v(i,J) = US%m_to_L*G%IdxCv(i,J) * (US%m_to_L*G%IdyCv(i,J)*US%m_to_L*G%IdyCv(i,J)) + CS%Idx2dyCv(i,J) = (G%IdxCv(i,J)*G%IdxCv(i,J)) * G%IdyCv(i,J) + CS%Idxdy2v(i,J) = G%IdxCv(i,J) * (G%IdyCv(i,J)*G%IdyCv(i,J)) enddo ; enddo CS%Ah_bg_xy(:,:) = 0.0 @@ -1986,7 +2015,7 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS, MEKE) 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 - grid_sp_h2 = (2.0*CS%DX2h(i,j)*CS%DY2h(i,j)) / (CS%DX2h(i,j)+CS%DY2h(i,j)) + grid_sp_h2 = (2.0*CS%dx2h(i,j)*CS%dy2h(i,j)) / (CS%dx2h(i,j)+CS%dy2h(i,j)) grid_sp_h3 = grid_sp_h2*sqrt(grid_sp_h2) if (CS%Smagorinsky_Ah) then @@ -1994,7 +2023,7 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS, MEKE) 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))) - CS%Biharm_const2_xx(i,j) = US%m_to_L**2*(grid_sp_h2 * grid_sp_h2 * grid_sp_h2) * & + CS%Biharm_const2_xx(i,j) = (grid_sp_h2 * grid_sp_h2 * grid_sp_h2) * & (fmax * BoundCorConst) endif endif @@ -2010,13 +2039,13 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS, MEKE) endif enddo ; enddo do J=js-1,Jeq ; do I=is-1,Ieq - grid_sp_q2 = (2.0*CS%DX2q(I,J)*CS%DY2q(I,J)) / (CS%DX2q(I,J)+CS%DY2q(I,J)) + grid_sp_q2 = (2.0*CS%dx2q(I,J)*CS%dy2q(I,J)) / (CS%dx2q(I,J)+CS%dy2q(I,J)) grid_sp_q3 = grid_sp_q2*sqrt(grid_sp_q2) 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) = US%m_to_L**2*(grid_sp_q2 * grid_sp_q2 * grid_sp_q2) * & + CS%Biharm_const2_xy(I,J) = (grid_sp_q2 * grid_sp_q2 * grid_sp_q2) * & (abs(G%CoriolisBu(I,J)) * BoundCorConst) endif endif @@ -2039,27 +2068,27 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS, MEKE) Idt = 1.0 / dt do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 denom = max( & - (CS%DY2h(i,j) * CS%DY_dxT(i,j) * US%m_to_L*(G%IdyCu(I,j) + G%IdyCu(I-1,j)) * & - US%m_to_L**3*max(G%IdyCu(I,j)*G%IareaCu(I,j), G%IdyCu(I-1,j)*G%IareaCu(I-1,j)) ), & - (CS%DX2h(i,j) * CS%DX_dyT(i,j) * US%m_to_L*(G%IdxCv(i,J) + G%IdxCv(i,J-1)) * & - US%m_to_L**3*max(G%IdxCv(i,J)*G%IareaCv(i,J), G%IdxCv(i,J-1)*G%IareaCv(i,J-1)) ) ) + (CS%dy2h(i,j) * CS%DY_dxT(i,j) * (G%IdyCu(I,j) + G%IdyCu(I-1,j)) * & + max(G%IdyCu(I,j)*G%IareaCu(I,j), G%IdyCu(I-1,j)*G%IareaCu(I-1,j)) ), & + (CS%dx2h(i,j) * CS%DX_dyT(i,j) * (G%IdxCv(i,J) + G%IdxCv(i,J-1)) * & + 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 enddo ; enddo do J=js-1,Jeq ; do I=is-1,Ieq denom = max( & - (CS%DX2q(I,J) * CS%DX_dyBu(I,J) * US%m_to_L*(G%IdxCu(I,j+1) + G%IdxCu(I,j)) * & - US%m_to_L**3*max(G%IdxCu(I,j)*G%IareaCu(I,j), G%IdxCu(I,j+1)*G%IareaCu(I,j+1)) ), & - (CS%DY2q(I,J) * CS%DY_dxBu(I,J) * US%m_to_L*(G%IdyCv(i+1,J) + G%IdyCv(i,J)) * & - US%m_to_L**3*max(G%IdyCv(i,J)*G%IareaCv(i,J), G%IdyCv(i+1,J)*G%IareaCv(i+1,J)) ) ) + (CS%dx2q(I,J) * CS%DX_dyBu(I,J) * (G%IdxCu(I,j+1) + G%IdxCu(I,j)) * & + max(G%IdxCu(I,j)*G%IareaCu(I,j), G%IdxCu(I,j+1)*G%IareaCu(I,j+1)) ), & + (CS%dy2q(I,J) * CS%DY_dxBu(I,J) * (G%IdyCv(i+1,J) + G%IdyCv(i,J)) * & + 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 enddo ; enddo if (CS%debug) then - call hchksum(CS%Kh_Max_xx, "Kh_Max_xx", G%HI, haloshift=0, scale=US%s_to_T) - call Bchksum(CS%Kh_Max_xx, "Kh_Max_xy", G%HI, haloshift=0, scale=US%s_to_T) + call hchksum(CS%Kh_Max_xx, "Kh_Max_xx", G%HI, haloshift=0, scale=US%L_to_m**2*US%s_to_T) + call Bchksum(CS%Kh_Max_xx, "Kh_Max_xy", G%HI, haloshift=0, scale=US%L_to_m**2*US%s_to_T) endif endif @@ -2068,38 +2097,38 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS, MEKE) if (CS%biharmonic .and. CS%better_bound_Ah) then Idt = 1.0 / dt do j=js-1,Jeq+1 ; do I=Isq-1,Ieq+1 - u0u(I,j) = CS%IDXDY2u(I,j)*(CS%DY2h(i+1,j)*CS%DY_dxT(i+1,j)*US%m_to_L*(G%IdyCu(I+1,j) + G%IdyCu(I,j)) + & - CS%DY2h(i,j) * CS%DY_dxT(i,j) * US%m_to_L*(G%IdyCu(I,j) + G%IdyCu(I-1,j)) ) + & - CS%IDX2dyCu(I,j)*(CS%DX2q(I,J) * CS%DX_dyBu(I,J) * US%m_to_L*(G%IdxCu(I,j+1) + G%IdxCu(I,j)) + & - CS%DX2q(I,J-1)*CS%DX_dyBu(I,J-1)*US%m_to_L*(G%IdxCu(I,j) + G%IdxCu(I,j-1)) ) - - u0v(I,j) = CS%IDXDY2u(I,j)*(CS%DY2h(i+1,j)*CS%DX_dyT(i+1,j)*US%m_to_L*(G%IdxCv(i+1,J) + G%IdxCv(i+1,J-1)) + & - CS%DY2h(i,j) * CS%DX_dyT(i,j) * US%m_to_L*(G%IdxCv(i,J) + G%IdxCv(i,J-1)) ) + & - CS%IDX2dyCu(I,j)*(CS%DX2q(I,J) * CS%DY_dxBu(I,J) * US%m_to_L*(G%IdyCv(i+1,J) + G%IdyCv(i,J)) + & - CS%DX2q(I,J-1)*CS%DY_dxBu(I,J-1)*US%m_to_L*(G%IdyCv(i+1,J-1) + G%IdyCv(i,J-1)) ) + u0u(I,j) = (CS%Idxdy2u(I,j)*(CS%dy2h(i+1,j)*CS%DY_dxT(i+1,j)*(G%IdyCu(I+1,j) + G%IdyCu(I,j)) + & + CS%dy2h(i,j) * CS%DY_dxT(i,j) * (G%IdyCu(I,j) + G%IdyCu(I-1,j)) ) + & + CS%Idx2dyCu(I,j)*(CS%dx2q(I,J) * CS%DX_dyBu(I,J) * (G%IdxCu(I,j+1) + G%IdxCu(I,j)) + & + CS%dx2q(I,J-1)*CS%DX_dyBu(I,J-1)*(G%IdxCu(I,j) + G%IdxCu(I,j-1)) ) ) + + u0v(I,j) = (CS%Idxdy2u(I,j)*(CS%dy2h(i+1,j)*CS%DX_dyT(i+1,j)*(G%IdxCv(i+1,J) + G%IdxCv(i+1,J-1)) + & + CS%dy2h(i,j) * CS%DX_dyT(i,j) * (G%IdxCv(i,J) + G%IdxCv(i,J-1)) ) + & + CS%Idx2dyCu(I,j)*(CS%dx2q(I,J) * CS%DY_dxBu(I,J) * (G%IdyCv(i+1,J) + G%IdyCv(i,J)) + & + CS%dx2q(I,J-1)*CS%DY_dxBu(I,J-1)*(G%IdyCv(i+1,J-1) + G%IdyCv(i,J-1)) ) ) enddo ; enddo do J=Jsq-1,Jeq+1 ; do i=is-1,Ieq+1 - v0u(i,J) = CS%IDXDY2v(i,J)*(CS%DY2q(I,J) * CS%DX_dyBu(I,J) * US%m_to_L*(G%IdxCu(I,j+1) + G%IdxCu(I,j)) + & - CS%DY2q(I-1,J)*CS%DX_dyBu(I-1,J)*US%m_to_L*(G%IdxCu(I-1,j+1) + G%IdxCu(I-1,j)) ) + & - CS%IDX2dyCv(i,J)*(CS%DX2h(i,j+1)*CS%DY_dxT(i,j+1)*US%m_to_L*(G%IdyCu(I,j+1) + G%IdyCu(I-1,j+1)) + & - CS%DX2h(i,j) * CS%DY_dxT(i,j) * US%m_to_L*(G%IdyCu(I,j) + G%IdyCu(I-1,j)) ) - - v0v(i,J) = CS%IDXDY2v(i,J)*(CS%DY2q(I,J) * CS%DY_dxBu(I,J) * US%m_to_L*(G%IdyCv(i+1,J) + G%IdyCv(i,J)) + & - CS%DY2q(I-1,J)*CS%DY_dxBu(I-1,J)*US%m_to_L*(G%IdyCv(i,J) + G%IdyCv(i-1,J)) ) + & - CS%IDX2dyCv(i,J)*(CS%DX2h(i,j+1)*CS%DX_dyT(i,j+1)*US%m_to_L*(G%IdxCv(i,J+1) + G%IdxCv(i,J)) + & - CS%DX2h(i,j) * CS%DX_dyT(i,j) * US%m_to_L*(G%IdxCv(i,J) + G%IdxCv(i,J-1)) ) + v0u(i,J) = (CS%Idxdy2v(i,J)*(CS%dy2q(I,J) * CS%DX_dyBu(I,J) * (G%IdxCu(I,j+1) + G%IdxCu(I,j)) + & + CS%dy2q(I-1,J)*CS%DX_dyBu(I-1,J)*(G%IdxCu(I-1,j+1) + G%IdxCu(I-1,j)) ) + & + CS%Idx2dyCv(i,J)*(CS%dx2h(i,j+1)*CS%DY_dxT(i,j+1)*(G%IdyCu(I,j+1) + G%IdyCu(I-1,j+1)) + & + CS%dx2h(i,j) * CS%DY_dxT(i,j) * (G%IdyCu(I,j) + G%IdyCu(I-1,j)) ) ) + + v0v(i,J) = (CS%Idxdy2v(i,J)*(CS%dy2q(I,J) * CS%DY_dxBu(I,J) * (G%IdyCv(i+1,J) + G%IdyCv(i,J)) + & + CS%dy2q(I-1,J)*CS%DY_dxBu(I-1,J)*(G%IdyCv(i,J) + G%IdyCv(i-1,J)) ) + & + CS%Idx2dyCv(i,J)*(CS%dx2h(i,j+1)*CS%DX_dyT(i,j+1)*(G%IdxCv(i,J+1) + G%IdxCv(i,J)) + & + CS%dx2h(i,j) * CS%DX_dyT(i,j) * (G%IdxCv(i,J) + G%IdxCv(i,J-1)) ) ) enddo ; enddo do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 denom = max( & - (CS%DY2h(i,j) * & - (CS%DY_dxT(i,j)*US%m_to_L*(G%IdyCu(I,j)*u0u(I,j) + G%IdyCu(I-1,j)*u0u(I-1,j)) + & - CS%DX_dyT(i,j)*US%m_to_L*(G%IdxCv(i,J)*v0u(i,J) + G%IdxCv(i,J-1)*v0u(i,J-1))) * & - US%m_to_L**3*max(G%IdyCu(I,j)*G%IareaCu(I,j), G%IdyCu(I-1,j)*G%IareaCu(I-1,j)) ), & - (CS%DX2h(i,j) * & - (CS%DY_dxT(i,j)*US%m_to_L*(G%IdyCu(I,j)*u0v(I,j) + G%IdyCu(I-1,j)*u0v(I-1,j)) + & - CS%DX_dyT(i,j)*US%m_to_L*(G%IdxCv(i,J)*v0v(i,J) + G%IdxCv(i,J-1)*v0v(i,J-1))) * & - US%m_to_L**3*max(G%IdxCv(i,J)*G%IareaCv(i,J), G%IdxCv(i,J-1)*G%IareaCv(i,J-1)) ) ) + (CS%dy2h(i,j) * & + (CS%DY_dxT(i,j)*(G%IdyCu(I,j)*u0u(I,j) + G%IdyCu(I-1,j)*u0u(I-1,j)) + & + CS%DX_dyT(i,j)*(G%IdxCv(i,J)*v0u(i,J) + G%IdxCv(i,J-1)*v0u(i,J-1))) * & + max(G%IdyCu(I,j)*G%IareaCu(I,j), G%IdyCu(I-1,j)*G%IareaCu(I-1,j)) ), & + (CS%dx2h(i,j) * & + (CS%DY_dxT(i,j)*(G%IdyCu(I,j)*u0v(I,j) + G%IdyCu(I-1,j)*u0v(I-1,j)) + & + CS%DX_dyT(i,j)*(G%IdxCv(i,J)*v0v(i,J) + G%IdxCv(i,J-1)*v0v(i,J-1))) * & + 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 @@ -2107,21 +2136,21 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS, MEKE) do J=js-1,Jeq ; do I=is-1,Ieq denom = max( & - (CS%DX2q(I,J) * & - (CS%DX_dyBu(I,J)*US%m_to_L*(u0u(I,j+1)*G%IdxCu(I,j+1) + u0u(I,j)*G%IdxCu(I,j)) + & - CS%DY_dxBu(I,J)*US%m_to_L*(v0u(i+1,J)*G%IdyCv(i+1,J) + v0u(i,J)*G%IdyCv(i,J))) * & - US%m_to_L**3*max(G%IdxCu(I,j)*G%IareaCu(I,j), G%IdxCu(I,j+1)*G%IareaCu(I,j+1)) ), & - (CS%DY2q(I,J) * & - (CS%DX_dyBu(I,J)*US%m_to_L*(u0v(I,j+1)*G%IdxCu(I,j+1) + u0v(I,j)*G%IdxCu(I,j)) + & - CS%DY_dxBu(I,J)*US%m_to_L*(v0v(i+1,J)*G%IdyCv(i+1,J) + v0v(i,J)*G%IdyCv(i,J))) * & - US%m_to_L**3*max(G%IdyCv(i,J)*G%IareaCv(i,J), G%IdyCv(i+1,J)*G%IareaCv(i+1,J)) ) ) + (CS%dx2q(I,J) * & + (CS%DX_dyBu(I,J)*(u0u(I,j+1)*G%IdxCu(I,j+1) + u0u(I,j)*G%IdxCu(I,j)) + & + CS%DY_dxBu(I,J)*(v0u(i+1,J)*G%IdyCv(i+1,J) + v0u(i,J)*G%IdyCv(i,J))) * & + max(G%IdxCu(I,j)*G%IareaCu(I,j), G%IdxCu(I,j+1)*G%IareaCu(I,j+1)) ), & + (CS%dy2q(I,J) * & + (CS%DX_dyBu(I,J)*(u0v(I,j+1)*G%IdxCu(I,j+1) + u0v(I,j)*G%IdxCu(I,j)) + & + CS%DY_dxBu(I,J)*(v0v(i+1,J)*G%IdyCv(i+1,J) + v0v(i,J)*G%IdyCv(i,J))) * & + 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 enddo ; enddo if (CS%debug) then - call hchksum(CS%Ah_Max_xx, "Ah_Max_xx", G%HI, haloshift=0, scale=US%s_to_T) - call Bchksum(CS%Ah_Max_xx, "Ah_Max_xy", G%HI, haloshift=0, scale=US%s_to_T) + call hchksum(CS%Ah_Max_xx, "Ah_Max_xx", G%HI, haloshift=0, scale=US%L_to_m**4*US%s_to_T) + call Bchksum(CS%Ah_Max_xx, "Ah_Max_xy", G%HI, haloshift=0, scale=US%L_to_m**4*US%s_to_T) endif endif @@ -2135,61 +2164,64 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS, MEKE) 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', conversion=US%s_to_T, & + 'Biharmonic Horizontal Viscosity at h Points', 'm4 s-1', conversion=US%L_to_m**4*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', conversion=US%s_to_T) + 'Biharmonic Horizontal Viscosity at q Points', 'm4 s-1', conversion=US%L_to_m**4*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', conversion=US%s_to_T, & + 'Laplacian Horizontal Viscosity at h Points', 'm2 s-1', conversion=US%L_to_m**2*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', conversion=US%s_to_T) + 'Laplacian Horizontal Viscosity at q Points', 'm2 s-1', conversion=US%L_to_m**2*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, & - 'Vertical vorticity at q Points', 's-1') + 'Vertical vorticity at q Points', 's-1', conversion=US%s_to_T) CS%id_div_xx_h = register_diag_field('ocean_model', 'div_xx_h', diag%axesTL, Time, & - 'Horizontal divergence at h Points', 's-1') + 'Horizontal divergence at h Points', 's-1', conversion=US%s_to_T) endif endif 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', 'm2 s-1', conversion=US%s_to_T) + 'GME coefficient at h Points', 'm2 s-1', conversion=US%L_to_m**2*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', 'm2 s-1', conversion=US%s_to_T) + 'GME coefficient at q Points', 'm2 s-1', conversion=US%L_to_m**2*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') + 'Integral work done by lateral friction terms in GME (excluding diffusion of energy)', & + 'W m-2', conversion=US%s_to_T**3*US%L_to_m**2) endif CS%id_FrictWork = register_diag_field('ocean_model','FrictWork',diag%axesTL,Time,& - 'Integral work done by lateral friction terms', 'W m-2') + 'Integral work done by lateral friction terms', 'W m-2', conversion=US%s_to_T**3*US%L_to_m**2) 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') + 'Integral work done by lateral friction terms (excluding diffusion of energy)', & + 'W m-2', conversion=US%s_to_T**3*US%L_to_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') + 'Maximum possible integral work done by lateral friction terms', & + 'W m-2', conversion=US%s_to_T**3*US%L_to_m**2) endif endif CS%id_FrictWorkIntz = register_diag_field('ocean_model','FrictWorkIntz',diag%axesT1,Time, & - 'Depth integrated work done by lateral friction', 'W m-2', & + 'Depth integrated work done by lateral friction', 'W m-2', conversion=US%s_to_T**3*US%L_to_m**2, & cmor_field_name='dispkexyfo', & cmor_long_name='Depth integrated ocean kinetic energy dissipation due to lateral friction',& cmor_standard_name='ocean_kinetic_energy_dissipation_per_unit_area_due_to_xy_friction') From 9438c735955e75c2c6042f312e5d5ea790e53f87 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 6 Aug 2019 19:01:53 -0400 Subject: [PATCH 163/297] +Rescaled ubtav returned by barotropic_get_tav Changed the units of ubtav and vbtav as returned by barotropic_get_tav from [m s-1] to [L T-1] for dimensional consistency testing, and made corresponding changes inside of MOM_hor_visc.F90. All answers are bitwise identical. --- src/core/MOM_barotropic.F90 | 8 ++++---- src/parameterizations/lateral/MOM_hor_visc.F90 | 12 ++++++------ 2 files changed, 10 insertions(+), 10 deletions(-) diff --git a/src/core/MOM_barotropic.F90 b/src/core/MOM_barotropic.F90 index b7b1e2847c..6438efc816 100644 --- a/src/core/MOM_barotropic.F90 +++ b/src/core/MOM_barotropic.F90 @@ -4384,19 +4384,19 @@ 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] + !! over a baroclinic timestep [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJB_(G)), intent(inout) :: vbtav !< Meridional barotropic velocity averaged - !! over a baroclinic timestep [m s-1] + !! over a baroclinic timestep [L T-1 ~> 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) = US%L_T_to_m_s*CS%ubtav(I,j) + ubtav(I,j) = CS%ubtav(I,j) enddo ; enddo do J=G%jsc-1,G%jec ; do i=G%isc,G%iec - vbtav(i,J) = US%L_T_to_m_s*CS%vbtav(i,J) + vbtav(i,J) = 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 93c6324025..1bc42c3994 100644 --- a/src/parameterizations/lateral/MOM_hor_visc.F90 +++ b/src/parameterizations/lateral/MOM_hor_visc.F90 @@ -234,13 +234,13 @@ subroutine horizontal_viscosity(u_in, v_in, h, diffu, diffv, MEKE, VarMix, G, GV h_u, & ! Thickness interpolated to u points [H ~> m or kg m-2]. 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] - ubtav ! zonal barotropic vel. ave. over baroclinic time-step [m s-1] + ubtav ! zonal barotropic vel. ave. over baroclinic time-step [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJB_(G)) :: & v0, & ! Laplacian of v [L-1 T-1 ~> m-1 s-1] h_v, & ! Thickness interpolated to v points [H ~> m or kg m-2]. 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] - vbtav ! meridional barotropic vel. ave. over baroclinic time-step [m s-1] + vbtav ! meridional barotropic vel. ave. over baroclinic time-step [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJ_(G)) :: & dudx_bt, dvdy_bt, & ! components in the barotropic horizontal tension [T-1 ~> s-1] div_xx, & ! Estimate of horizontal divergence at h-points [T-1 ~> s-1] @@ -435,9 +435,9 @@ subroutine horizontal_viscosity(u_in, v_in, h, diffu, diffv, MEKE, VarMix, G, GV !#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)*US%m_s_to_L_T*(G%IdyCu(I,j) * ubtav(I,j) - & + 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)) - dvdy_bt(i,j) = CS%DX_dyT(i,j)*US%m_s_to_L_T*(G%IdxCv(i,J) * vbtav(i,J) - & + dvdy_bt(i,j) = CS%DX_dyT(i,j)*(G%IdxCv(i,J) * vbtav(i,J) - & G%IdxCv(i,J-1) * vbtav(i,J-1)) enddo; enddo @@ -453,9 +453,9 @@ subroutine horizontal_viscosity(u_in, v_in, h, diffu, diffv, MEKE, VarMix, G, GV ! Components for the barotropic shearing strain do J=js-2,Jeq+1 ; do I=is-2,Ieq+1 - dvdx_bt(I,J) = CS%DY_dxBu(I,J)*US%m_s_to_L_T*(vbtav(i+1,J)*G%IdyCv(i+1,J) & + dvdx_bt(I,J) = CS%DY_dxBu(I,J)*(vbtav(i+1,J)*G%IdyCv(i+1,J) & - vbtav(i,J)*G%IdyCv(i,J)) - dudy_bt(I,J) = CS%DX_dyBu(I,J)*US%m_s_to_L_T*(ubtav(I,j+1)*G%IdxCu(I,j+1) & + dudy_bt(I,J) = CS%DX_dyBu(I,J)*(ubtav(I,j+1)*G%IdxCu(I,j+1) & - ubtav(I,j)*G%IdxCu(I,j)) enddo ; enddo From 4a59fef9c1021c8d624f63e381af3142a0638fb1 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Wed, 7 Aug 2019 05:21:01 -0400 Subject: [PATCH 164/297] +Rescaled div_xx_dx sent to calc_QG_Leith_viscosity Changed the units of div_xx_dx, div_xx_dy, vort_xy_dx and vort_xy_dy that passed to calc_QG_Leith_viscosity from [m-1 s-1] to [L-1 T-1] for dimensional consistency testing, making corresponding changes inside of horizontal_viscosity and calc_QG_Leith_viscosity. Also passed a new unit_scale_type argument to calc_QG_Leith_viscosity. All answers in the MOM6-examples test cases are bitwise identical and pass the dimensional rescaling tests, but I do not believe that cases with Leith viscosity are being adequately tested by the MOM6-examples test suite. --- .../lateral/MOM_hor_visc.F90 | 30 +++++++------- .../lateral/MOM_lateral_mixing_coeffs.F90 | 40 ++++++++++--------- 2 files changed, 36 insertions(+), 34 deletions(-) diff --git a/src/parameterizations/lateral/MOM_hor_visc.F90 b/src/parameterizations/lateral/MOM_hor_visc.F90 index 1bc42c3994..2b915fd3fa 100644 --- a/src/parameterizations/lateral/MOM_hor_visc.F90 +++ b/src/parameterizations/lateral/MOM_hor_visc.F90 @@ -232,14 +232,14 @@ subroutine horizontal_viscosity(u_in, v_in, h, diffu, diffv, MEKE, VarMix, G, GV real, dimension(SZIB_(G),SZJ_(G)) :: & u0, & ! Laplacian of u [L-1 T-1 ~> m-1 s-1] h_u, & ! Thickness interpolated to u points [H ~> m or kg m-2]. - 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)) [L-1 T-1 ~> m-1 s-1] + div_xx_dx, & ! x-derivative of horizontal divergence (d/dx(du/dx + dv/dy)) [L-1 T-1 ~> m-1 s-1] ubtav ! zonal barotropic vel. ave. over baroclinic time-step [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJB_(G)) :: & v0, & ! Laplacian of v [L-1 T-1 ~> m-1 s-1] h_v, & ! Thickness interpolated to v points [H ~> m or kg m-2]. - 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] + vort_xy_dx, & ! x-derivative of vertical vorticity (d/dx(dv/dx - du/dy)) [L-1 T-1 ~> m-1 s-1] + div_xx_dy, & ! y-derivative of horizontal divergence (d/dy(du/dx + dv/dy)) [L-1 T-1 ~> m-1 s-1] vbtav ! meridional barotropic vel. ave. over baroclinic time-step [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJ_(G)) :: & dudx_bt, dvdy_bt, & ! components in the barotropic horizontal tension [T-1 ~> s-1] @@ -757,12 +757,12 @@ subroutine horizontal_viscosity(u_in, v_in, h, diffu, diffv, MEKE, VarMix, G, GV ! Vorticity gradient do J=js-2,Jeq+1 ; do i=is-1,Ieq+1 DY_dxBu = G%dyBu(I,J) * G%IdxBu(I,J) - vort_xy_dx(i,J) = DY_dxBu * US%m_to_L*US%s_to_T*(vort_xy(I,J) * G%IdyCu(I,j) - vort_xy(I-1,J) * G%IdyCu(I-1,j)) + vort_xy_dx(i,J) = DY_dxBu * (vort_xy(I,J) * G%IdyCu(I,j) - vort_xy(I-1,J) * G%IdyCu(I-1,j)) enddo ; enddo do j=js-1,Jeq+1 ; do I=is-2,Ieq+1 DX_dyBu = G%dxBu(I,J) * G%IdyBu(I,J) - vort_xy_dy(I,j) = DX_dyBu * US%m_to_L*US%s_to_T*(vort_xy(I,J) * G%IdxCv(i,J) - vort_xy(I,J-1) * G%IdxCv(i,J-1)) + vort_xy_dy(I,j) = DX_dyBu * (vort_xy(I,J) * G%IdxCv(i,J) - vort_xy(I,J-1) * G%IdxCv(i,J-1)) enddo ; enddo call pass_vector(vort_xy_dy, vort_xy_dx, G%Domain) @@ -784,11 +784,11 @@ subroutine horizontal_viscosity(u_in, v_in, h, diffu, diffv, MEKE, VarMix, G, GV ! Divergence gradient !#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) = US%s_to_T*US%m_to_L*G%IdxCu(I,j)*(div_xx(i+1,j) - div_xx(i,j)) + div_xx_dx(I,j) = G%IdxCu(I,j)*(div_xx(i+1,j) - div_xx(i,j)) enddo ; enddo !#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) = US%s_to_T*US%m_to_L*G%IdyCv(i,J)*(div_xx(i,j+1) - div_xx(i,j)) + 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. @@ -798,12 +798,12 @@ subroutine horizontal_viscosity(u_in, v_in, h, diffu, diffv, MEKE, VarMix, G, GV ! Why use the magnitude of the average instead of the average magnitude? !#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) = US%L_to_m*US%T_to_s*sqrt((0.5*(div_xx_dx(I,j) + div_xx_dx(I-1,j)))**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 !#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) = US%L_to_m*US%T_to_s*sqrt((0.5*(div_xx_dx(I,j) + div_xx_dx(I,j+1)))**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 @@ -849,29 +849,29 @@ subroutine horizontal_viscosity(u_in, v_in, h, diffu, diffv, MEKE, VarMix, G, GV !#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) = US%L_to_m*US%T_to_s*SQRT((0.5*(vort_xy_dx(i,J) + vort_xy_dx(i,J-1)))**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 !#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) = US%L_to_m*US%T_to_s*SQRT((0.5*(vort_xy_dx(i,J) + vort_xy_dx(i+1,J)))**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 ! This accumulates terms, some of which are in VarMix, so rescaling can not be done here. - call calc_QG_Leith_viscosity(VarMix, G, GV, h, k, div_xx_dx, div_xx_dy, & + call calc_QG_Leith_viscosity(VarMix, G, GV, US, h, k, div_xx_dx, div_xx_dy, & vort_xy_dx, vort_xy_dy) endif !#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) = US%L_to_m*US%T_to_s*SQRT((0.5*(vort_xy_dx(i,J) + vort_xy_dx(i,J-1)))**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 !#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) = US%L_to_m*US%T_to_s*SQRT((0.5*(vort_xy_dx(i,J) + vort_xy_dx(i+1,J)))**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 diff --git a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 index 2768e3034d..58bc2776e0 100644 --- a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 +++ b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 @@ -706,22 +706,23 @@ subroutine calc_slope_functions_using_just_e(h, G, GV, US, CS, e, calculate_slop 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) +subroutine calc_QG_Leith_viscosity(CS, G, GV, US, 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(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 !< 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] + !! (d/dx(du/dx + dv/dy)) [L-1 T-1 ~> 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] + !! (d/dy(du/dx + dv/dy)) [L-1 T-1 ~> 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] + !! (d/dx(dv/dx - du/dy)) [L-1 T-1 ~> 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] + !! (d/dy(dv/dx - du/dy)) [L-1 T-1 ~> 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 @@ -736,8 +737,8 @@ subroutine calc_QG_Leith_viscosity(CS, G, GV, h, k, div_xx_dx, div_xx_dy, vort_x ! 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] +! vort_xy_dx, & ! x-derivative of vertical vorticity (d/dx(dv/dx - du/dy)) [L-1 T-1 ~> m-1 s-1] +! div_xx_dy, & ! y-derivative of horizontal divergence (d/dy(du/dx + dv/dy)) [L-1 T-1 ~> 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] @@ -745,16 +746,17 @@ subroutine calc_QG_Leith_viscosity(CS, G, GV, h, k, div_xx_dx, div_xx_dy, vort_x 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] - dslopex_dz, & ! z-derivative of x-slope at u-points (m-1) +! vort_xy_dy, & ! y-derivative of vertical vorticity (d/dy(dv/dx - du/dy)) [L-1 T-1 ~> m-1 s-1] +! div_xx_dx, & ! x-derivative of horizontal divergence (d/dx(du/dx + dv/dy)) [L-1 T-1 ~> m-1 s-1] + dslopex_dz, & ! z-derivative of x-slope at u-points [m-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] + grad_vort_mag_u, & ! mag. of vort. grad. at u-points [s-1 m-1] + grad_div_mag_u ! mag. of div. grad. at u-points [s-1 m-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 + real :: h_at_slope_above, h_at_slope_below, Ih + real :: f ! A copy of the Coriolis parameter [T-1 ~> s-1] integer :: i, j, is, ie, js, je, Isq, Ieq, Jsq, Jeq,nz real :: inv_PI3 @@ -801,7 +803,7 @@ subroutine calc_QG_Leith_viscosity(CS, G, GV, h, k, div_xx_dx, div_xx_dy, vort_x !### 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 * & + vort_xy_dx(i,J) = vort_xy_dx(i,J) - f * US%L_to_m * & ( ( h_at_u(I,j) * dslopex_dz(I,j) + h_at_u(I-1,j+1) * dslopex_dz(I-1,j+1) ) & + ( h_at_u(I-1,j) * dslopex_dz(I-1,j) + h_at_u(I,j+1) * dslopex_dz(I,j+1) ) ) / & ( ( 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) @@ -811,7 +813,7 @@ subroutine calc_QG_Leith_viscosity(CS, G, GV, h, k, div_xx_dx, div_xx_dy, vort_x 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 * & + vort_xy_dy(I,j) = vort_xy_dx(I,j) - f * US%L_to_m * & ( ( 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) ) ) / & ( ( h_at_v(i,J) + h_at_v(i+1,J-1) ) + ( h_at_v(i,J-1) + h_at_v(i+1,J) ) + GV%H_subroundoff) @@ -824,9 +826,9 @@ subroutine calc_QG_Leith_viscosity(CS, G, GV, h, k, div_xx_dx, div_xx_dy, vort_x 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) & + grad_vort_mag_u(I,j) = US%m_to_L*US%s_to_T*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) & + grad_div_mag_u(I,j) = US%m_to_L*US%s_to_T*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 beta_u(I,j) = sqrt( (0.5*(G%dF_dx(i,j)+G%dF_dx(i+1,j))**2) + & @@ -840,9 +842,9 @@ subroutine calc_QG_Leith_viscosity(CS, G, GV, h, k, div_xx_dx, div_xx_dy, vort_x 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) & + grad_vort_mag_v(i,J) = US%m_to_L*US%s_to_T*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) & + grad_div_mag_v(i,J) = US%m_to_L*US%s_to_T*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) + & From 63ba91b8fa36f8f8f408465f2f303d2bdc7c50c3 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Wed, 7 Aug 2019 05:37:24 -0400 Subject: [PATCH 165/297] Renamed u0 to Del2u in horizontal_viscosity Renamed u0 and v0 variables to Del2u and Del2v in horizontal_viscosity for greater code clarity. Also added some missing variables to an OMP statement. All answers are bitwise identical. --- .../lateral/MOM_hor_visc.F90 | 64 +++++++++---------- 1 file changed, 32 insertions(+), 32 deletions(-) diff --git a/src/parameterizations/lateral/MOM_hor_visc.F90 b/src/parameterizations/lateral/MOM_hor_visc.F90 index 2b915fd3fa..7149d508f9 100644 --- a/src/parameterizations/lateral/MOM_hor_visc.F90 +++ b/src/parameterizations/lateral/MOM_hor_visc.F90 @@ -230,13 +230,13 @@ subroutine horizontal_viscosity(u_in, v_in, h, diffu, diffv, MEKE, VarMix, G, GV ! Local variables real, dimension(SZIB_(G),SZJ_(G)) :: & - u0, & ! Laplacian of u [L-1 T-1 ~> m-1 s-1] + Del2u, & ! The u-compontent of the Laplacian of velocity [L-1 T-1 ~> m-1 s-1] h_u, & ! Thickness interpolated to u points [H ~> m or kg m-2]. vort_xy_dy, & ! y-derivative of vertical vorticity (d/dy(dv/dx - du/dy)) [L-1 T-1 ~> m-1 s-1] div_xx_dx, & ! x-derivative of horizontal divergence (d/dx(du/dx + dv/dy)) [L-1 T-1 ~> m-1 s-1] ubtav ! zonal barotropic vel. ave. over baroclinic time-step [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJB_(G)) :: & - v0, & ! Laplacian of v [L-1 T-1 ~> m-1 s-1] + Del2v, & ! The v-compontent of the Laplacian of velocity [L-1 T-1 ~> m-1 s-1] h_v, & ! Thickness interpolated to v points [H ~> m or kg m-2]. vort_xy_dx, & ! x-derivative of vertical vorticity (d/dx(dv/dx - du/dy)) [L-1 T-1 ~> m-1 s-1] div_xx_dy, & ! y-derivative of horizontal divergence (d/dy(du/dx + dv/dy)) [L-1 T-1 ~> m-1 s-1] @@ -266,7 +266,7 @@ subroutine horizontal_viscosity(u_in, v_in, h, diffu, diffv, MEKE, VarMix, G, GV real, dimension(SZIB_(G),SZJB_(G)) :: & dvdx, dudy, & ! components in the shearing strain [T-1 s-1] - dv0dx, du0dy, & ! Components in the biharmonic equivalent of the shearing strain [L-2 T-1 ~> m-2 s-1] + dDel2vdx, dDel2udy, & ! Components in the biharmonic equivalent of the shearing strain [L-2 T-1 ~> m-2 s-1] dvdx_bt, dudy_bt, & ! components in the barotropic shearing strain [T-1 s-1] sh_xy, & ! horizontal shearing strain (du/dy + dv/dx) including metric terms [T-1 ~> s-1] sh_xy_bt, & ! barotropic horizontal shearing strain (du/dy + dv/dx) inc. metric terms [T-1 ~> s-1] @@ -510,16 +510,16 @@ subroutine horizontal_viscosity(u_in, v_in, h, diffu, diffv, MEKE, VarMix, G, GV endif ! use_GME - !$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 parallel do default(none) shared(Isq,Ieq,Jsq,Jeq,nz,CS,G,GV,US,u,v,is,js,ie,je, & + !$OMP h,rescale_Kh,VarMix,h_neglect,h_neglect3, & !$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) & - !$OMP private(u0, v0, sh_xx, str_xx, visc_bound_rem, & - !$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 private(Del2u, Del2v, sh_xx, str_xx, visc_bound_rem, & + !$OMP sh_xy,str_xy,Ah,Kh,AhSm,dvdx,dudy,dDel2udy, & + !$OMP dDel2vdx,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, & !$OMP div_xx, div_xx_dx, div_xx_dy, local_strain, & !$OMP meke_res_fn,Sh_F_pow, & @@ -698,26 +698,26 @@ subroutine horizontal_viscosity(u_in, v_in, h, diffu, diffv, MEKE, VarMix, G, GV enddo ; enddo endif - ! Evaluate u0 = x.Div(Grad u) and v0 = y.Div( Grad u) + ! Evaluate Del2u = x.Div(Grad u) and Del2v = y.Div( Grad u) if (CS%biharmonic) then do j=js-1,Jeq+1 ; do I=Isq-1,Ieq+1 - u0(I,j) = CS%Idxdy2u(I,j)*(CS%dy2h(i+1,j)*sh_xx(i+1,j) - CS%dy2h(i,j)*sh_xx(i,j)) + & - CS%Idx2dyCu(I,j)*(CS%dx2q(I,J)*sh_xy(I,J) - CS%dx2q(I,J-1)*sh_xy(I,J-1)) + Del2u(I,j) = CS%Idxdy2u(I,j)*(CS%dy2h(i+1,j)*sh_xx(i+1,j) - CS%dy2h(i,j)*sh_xx(i,j)) + & + CS%Idx2dyCu(I,j)*(CS%dx2q(I,J)*sh_xy(I,J) - CS%dx2q(I,J-1)*sh_xy(I,J-1)) enddo ; enddo do J=Jsq-1,Jeq+1 ; do i=is-1,Ieq+1 - v0(i,J) = CS%Idxdy2v(i,J)*(CS%dy2q(I,J)*sh_xy(I,J) - CS%dy2q(I-1,J)*sh_xy(I-1,J)) - & - CS%Idx2dyCv(i,J)*(CS%dx2h(i,j+1)*sh_xx(i,j+1) - CS%dx2h(i,j)*sh_xx(i,j)) + Del2v(i,J) = CS%Idxdy2v(i,J)*(CS%dy2q(I,J)*sh_xy(I,J) - CS%dy2q(I-1,J)*sh_xy(I-1,J)) - & + CS%Idx2dyCv(i,J)*(CS%dx2h(i,j+1)*sh_xx(i,j+1) - CS%dx2h(i,j)*sh_xx(i,j)) enddo ; enddo if (apply_OBC) then; if (OBC%zero_biharmonic) then do n=1,OBC%number_of_segments I = OBC%segment(n)%HI%IsdB ; J = OBC%segment(n)%HI%JsdB if (OBC%segment(n)%is_N_or_S .and. (J >= Jsq-1) .and. (J <= Jeq+1)) then do I=OBC%segment(n)%HI%isd,OBC%segment(n)%HI%ied - v0(i,J) = 0. + Del2v(i,J) = 0. enddo elseif (OBC%segment(n)%is_E_or_W .and. (I >= Isq-1) .and. (I <= Ieq+1)) then do j=OBC%segment(n)%HI%jsd,OBC%segment(n)%HI%jed - u0(I,j) = 0. + Del2u(I,j) = 0. enddo endif enddo @@ -972,13 +972,13 @@ subroutine horizontal_viscosity(u_in, v_in, h, diffu, diffv, MEKE, VarMix, G, GV if ((CS%id_Ah_h>0) .or. find_FrictWork .or. CS%debug) Ah_h(i,j,k) = 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))) + (CS%DY_dxT(i,j) * (G%IdyCu(I,j)*Del2u(I,j) - G%IdyCu(I-1,j)*Del2u(I-1,j)) - & + CS%DX_dyT(i,j) * (G%IdxCv(i,J)*Del2v(i,J) - G%IdxCv(i,J-1)*Del2v(i,J-1))) ! Keep a copy of the biharmonic contribution for backscatter parameterization 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))) + (CS%DY_dxT(i,j) * (G%IdyCu(I,j)*Del2u(I,j) - G%IdyCu(I-1,j)*Del2u(I-1,j)) - & + CS%DX_dyT(i,j) * (G%IdxCv(i,J)*Del2v(i,J) - G%IdxCv(i,J-1)*Del2v(i,J-1))) bhstr_xx(i,j) = bhstr_xx(i,j) * (h(i,j,k) * CS%reduction_xx(i,j)) endif ! biharmonic @@ -988,8 +988,8 @@ subroutine horizontal_viscosity(u_in, v_in, h, diffu, diffv, MEKE, VarMix, G, GV if (CS%biharmonic) then ! Gradient of Laplacian, for use in bi-harmonic term do J=js-1,Jeq ; do I=is-1,Ieq - dv0dx(I,J) = CS%DY_dxBu(I,J)*(v0(i+1,J)*G%IdyCv(i+1,J) - v0(i,J)*G%IdyCv(i,J)) - du0dy(I,J) = CS%DX_dyBu(I,J)*(u0(I,j+1)*G%IdxCu(I,j+1) - u0(I,j)*G%IdxCu(I,j)) + dDel2vdx(I,J) = CS%DY_dxBu(I,J)*(Del2v(i+1,J)*G%IdyCv(i+1,J) - Del2v(i,J)*G%IdyCv(i,J)) + dDel2udy(I,J) = CS%DX_dyBu(I,J)*(Del2u(I,j+1)*G%IdxCu(I,j+1) - Del2u(I,j)*G%IdxCu(I,j)) enddo ; enddo ! Adjust contributions to shearing strain on open boundaries. if (apply_OBC) then ; if (OBC%zero_strain .or. OBC%freeslip_strain) then @@ -998,17 +998,17 @@ subroutine horizontal_viscosity(u_in, v_in, h, diffu, diffv, MEKE, VarMix, G, GV if (OBC%segment(n)%is_N_or_S .and. (J >= js-1) .and. (J <= Jeq)) then do I=OBC%segment(n)%HI%IsdB,OBC%segment(n)%HI%IedB if (OBC%zero_strain) then - dv0dx(I,J) = 0. ; du0dy(I,J) = 0. + dDel2vdx(I,J) = 0. ; dDel2udy(I,J) = 0. elseif (OBC%freeslip_strain) then - du0dy(I,J) = 0. + dDel2udy(I,J) = 0. endif enddo elseif (OBC%segment(n)%is_E_or_W .and. (I >= is-1) .and. (I <= Ieq)) then do J=OBC%segment(n)%HI%JsdB,OBC%segment(n)%HI%JedB if (OBC%zero_strain) then - dv0dx(I,J) = 0. ; du0dy(I,J) = 0. + dDel2vdx(I,J) = 0. ; dDel2udy(I,J) = 0. elseif (OBC%freeslip_strain) then - dv0dx(I,J) = 0. + dDel2vdx(I,J) = 0. endif enddo endif @@ -1141,10 +1141,10 @@ subroutine horizontal_viscosity(u_in, v_in, h, diffu, diffv, MEKE, VarMix, G, GV if (CS%id_Ah_q>0 .or. CS%debug) Ah_q(I,J,k) = Ah - str_xy(I,J) = str_xy(I,J) + Ah * ( dv0dx(I,J) + du0dy(I,J) ) + str_xy(I,J) = str_xy(I,J) + Ah * ( dDel2vdx(I,J) + dDel2udy(I,J) ) ! Keep a copy of the biharmonic contribution for backscatter parameterization - bhstr_xy(I,J) = Ah * ( dv0dx(I,J) + du0dy(I,J) ) * & + bhstr_xy(I,J) = Ah * ( dDel2vdx(I,J) + dDel2udy(I,J) ) * & (hq(I,J) * G%mask2dBu(I,J) * CS%reduction_xy(I,J)) endif ! biharmonic @@ -1159,8 +1159,8 @@ subroutine horizontal_viscosity(u_in, v_in, h, diffu, diffv, MEKE, VarMix, G, GV ! following code is commented out - i.e. if both biharmonic and Laplacian are used ! and FindFrictWork is true. do J=js-1,Jeq ; do I=is-1,Ieq - dvdx(I,J) = US%m_to_L**2*dv0dx(I,J) - dudy(I,J) = US%m_to_L**2*du0dy(I,J) + dvdx(I,J) = US%m_to_L**2*dDel2vdx(I,J) + dudy(I,J) = US%m_to_L**2*dDel2udy(I,J) enddo ; enddo endif @@ -1186,8 +1186,8 @@ subroutine horizontal_viscosity(u_in, v_in, h, diffu, diffv, MEKE, VarMix, G, GV 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*(Del2u(I,j) + Del2u(I-1,j)))**2 + & + (0.5*(Del2v(i,J) + Del2v(i,J-1)))**2) enddo ; enddo else do j=js,je ; do i=is,ie From b4df1471dd49b127b83e8c40af40b5a169ff6cab Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Wed, 7 Aug 2019 08:16:29 -0400 Subject: [PATCH 166/297] +Rescaled 9 elements of the MEKE_type Rescaled the dimensions of the MEKE, GM_src, mom_src, GME_snk, Kh, Kh_diff, Ku, and Au elements of the MEKE_type. All answers are bitwise identical, but the units of 9 elements of a public type have changed. --- src/parameterizations/lateral/MOM_MEKE.F90 | 168 +++++++++++------- .../lateral/MOM_MEKE_types.F90 | 16 +- .../lateral/MOM_hor_visc.F90 | 23 ++- .../lateral/MOM_thickness_diffuse.F90 | 20 +-- src/tracer/MOM_tracer_hor_diff.F90 | 4 +- 5 files changed, 134 insertions(+), 97 deletions(-) diff --git a/src/parameterizations/lateral/MOM_MEKE.F90 b/src/parameterizations/lateral/MOM_MEKE.F90 index 20caf163a4..20aecb07c1 100644 --- a/src/parameterizations/lateral/MOM_MEKE.F90 +++ b/src/parameterizations/lateral/MOM_MEKE.F90 @@ -175,10 +175,13 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h if (associated(MEKE%MEKE)) then if (CS%debug) then - if (associated(MEKE%mom_src)) call hchksum(MEKE%mom_src, 'MEKE mom_src',G%HI) - if (associated(MEKE%GME_snk)) call hchksum(MEKE%GME_snk, 'MEKE GME_snk',G%HI) - if (associated(MEKE%GM_src)) call hchksum(MEKE%GM_src, 'MEKE GM_src',G%HI) - if (associated(MEKE%MEKE)) call hchksum(MEKE%MEKE, 'MEKE MEKE',G%HI) + if (associated(MEKE%mom_src)) & + call hchksum(MEKE%mom_src, 'MEKE mom_src', G%HI, scale=US%L_to_m**2*US%s_to_T**3) + if (associated(MEKE%GME_snk)) & + call hchksum(MEKE%GME_snk, 'MEKE GME_snk', G%HI, scale=US%L_to_m**2*US%s_to_T**3) + if (associated(MEKE%GM_src)) & + call hchksum(MEKE%GM_src, 'MEKE GM_src', G%HI, scale=US%L_to_m**2*US%s_to_T**3) + if (associated(MEKE%MEKE)) call hchksum(MEKE%MEKE, 'MEKE MEKE', G%HI, scale=US%L_T_to_m_s**2) call uvchksum("MEKE SN_[uv]", SN_u, SN_v, G%HI) call uvchksum("MEKE h[uv]", hu, hv, G%HI, haloshift=1, scale=GV%H_to_m) endif @@ -287,26 +290,28 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h if (associated(MEKE%mom_src)) then !$OMP parallel do default(shared) do j=js,je ; do i=is,ie - src(i,j) = src(i,j) - CS%MEKE_FrCoeff*I_mass(i,j)*MEKE%mom_src(i,j) + src(i,j) = src(i,j) - CS%MEKE_FrCoeff*I_mass(i,j)*US%L_to_m**2*US%s_to_T**3*MEKE%mom_src(i,j) enddo ; enddo endif if (associated(MEKE%GME_snk)) then -!$OMP do + !$OMP parallel do default(shared) do j=js,je ; do i=is,ie - src(i,j) = src(i,j) - CS%MEKE_GMECoeff*I_mass(i,j)*MEKE%GME_snk(i,j) + src(i,j) = src(i,j) - CS%MEKE_GMECoeff*I_mass(i,j)*US%L_to_m**2*US%s_to_T**3*MEKE%GME_snk(i,j) enddo ; enddo endif if (associated(MEKE%GM_src)) then -!$OMP do if (CS%GM_src_alt) then + !$OMP parallel do default(shared) do j=js,je ; do i=is,ie - src(i,j) = src(i,j) - CS%MEKE_GMcoeff*MEKE%GM_src(i,j) / MAX(1.0,G%bathyT(i,j)) + src(i,j) = src(i,j) - CS%MEKE_GMcoeff*US%L_to_m**2*US%s_to_T**3*MEKE%GM_src(i,j) / & + MAX(1.0, G%bathyT(i,j)) !### 1.0 seems to be a hard-coded dimensional constant. enddo ; enddo else + !$OMP parallel do default(shared) do j=js,je ; do i=is,ie - src(i,j) = src(i,j) - CS%MEKE_GMcoeff*I_mass(i,j)*MEKE%GM_src(i,j) + src(i,j) = src(i,j) - CS%MEKE_GMcoeff*I_mass(i,j)*US%L_to_m**2*US%s_to_T**3*MEKE%GM_src(i,j) enddo ; enddo endif endif @@ -314,44 +319,47 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h ! Increase EKE by a full time-steps worth of source !$OMP parallel do default(shared) do j=js,je ; do i=is,ie - MEKE%MEKE(i,j) = (MEKE%MEKE(i,j) + sdt*src(i,j) )*G%mask2dT(i,j) + MEKE%MEKE(i,j) = (MEKE%MEKE(i,j) + US%m_s_to_L_T**2*sdt*src(i,j) )*G%mask2dT(i,j) enddo ; enddo 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 + !$OMP parallel do default(shared) 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) + 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)*US%L_T_to_m_s**2*MEKE%MEKE(i,j)) * & + 2.0 * bottomFac2(i,j)*US%L_T_to_m_s**2*MEKE%MEKE(i,j) enddo ; enddo else + !$OMP parallel do default(shared) 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 ) ) + + cdrag2 * ( max(0.0, 2.0*bottomFac2(i,j)*US%L_T_to_m_s**2*MEKE%MEKE(i,j)) + CS%MEKE_Uscale**2 ) ) enddo ; enddo endif endif ! First stage of Strang splitting -!$OMP do if (CS%Jansen15_drag) then + !$OMP parallel do default(shared) 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%MEKE(i,j) = MEKE%MEKE(i,j) - MIN(MEKE%MEKE(i,j), US%m_s_to_L_T**2*sdt_damp*drag_rate(i,j)) MEKE_decay(i,j) = ldamping*G%mask2dT(i,j) enddo ; enddo else + !$OMP parallel do default(shared) 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. + 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 end parallel if (CS%kh_flux_enabled .or. CS%MEKE_K4 >= 0.0) then ! Update MEKE in the halos for lateral or bi-harmonic diffusion @@ -365,18 +373,18 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h !$OMP parallel do default(shared) 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)) + US%L_T_to_m_s**2*(MEKE%MEKE(i+1,j) - MEKE%MEKE(i,j)) ! MEKE_uflux(I,j) = ((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)) ) * & - ! (MEKE%MEKE(i+1,j) - MEKE%MEKE(i,j)) + ! US%L_T_to_m_s**2*(MEKE%MEKE(i+1,j) - MEKE%MEKE(i,j)) enddo ; enddo !$OMP parallel do default(shared) 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)) + US%L_T_to_m_s**2*(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)) + ! US%L_T_to_m_s**2*(MEKE%MEKE(i,j+1) - MEKE%MEKE(i,j)) enddo ; enddo !$OMP parallel do default(shared) @@ -428,9 +436,11 @@ 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 ! Limit Kh to avoid CFL violations. if (associated(MEKE%Kh)) & - Kh_here = max(0.,CS%MEKE_Kh) + CS%KhMEKE_Fac*0.5*(MEKE%Kh(i,j)+MEKE%Kh(i+1,j)) + Kh_here = max(0.,CS%MEKE_Kh) + & + CS%KhMEKE_Fac*0.5*US%L_to_m**2*US%s_to_T*(MEKE%Kh(i,j)+MEKE%Kh(i+1,j)) if (associated(MEKE%Kh_diff)) & - Kh_here = max(0.,CS%MEKE_Kh) + CS%KhMEKE_Fac*0.5*(MEKE%Kh_diff(i,j)+MEKE%Kh_diff(i+1,j)) + Kh_here = max(0.,CS%MEKE_Kh) + & + CS%KhMEKE_Fac*0.5*US%L_to_m**2*US%s_to_T*(MEKE%Kh_diff(i,j)+MEKE%Kh_diff(i+1,j)) Inv_Kh_max = 2.0*sdt * ((G%dy_Cu(I,j)*G%IdxCu(I,j)) * & max(US%m_to_L**2*G%IareaT(i,j),US%m_to_L**2*G%IareaT(i+1,j))) if (Kh_here*Inv_Kh_max > 0.25) Kh_here = 0.25 / Inv_Kh_max @@ -438,14 +448,16 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h MEKE_uflux(I,j) = ((Kh_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)) ) * & - (MEKE%MEKE(i,j) - MEKE%MEKE(i+1,j)) + US%L_T_to_m_s**2*(MEKE%MEKE(i,j) - MEKE%MEKE(i+1,j)) enddo ; enddo !$OMP parallel do default(shared) firstprivate(Kh_here) private(Inv_Kh_max) do J=js-1,je ; do i=is,ie if (associated(MEKE%Kh)) & - Kh_here = max(0.,CS%MEKE_Kh) + CS%KhMEKE_Fac*0.5*(MEKE%Kh(i,j)+MEKE%Kh(i,j+1)) + Kh_here = max(0.,CS%MEKE_Kh) + & + CS%KhMEKE_Fac*0.5*US%L_to_m**2*US%s_to_T*(MEKE%Kh(i,j)+MEKE%Kh(i,j+1)) if (associated(MEKE%Kh_diff)) & - Kh_here = max(0.,CS%MEKE_Kh) + CS%KhMEKE_Fac*0.5*(MEKE%Kh_diff(i,j)+MEKE%Kh_diff(i,j+1)) + Kh_here = max(0.,CS%MEKE_Kh) + & + CS%KhMEKE_Fac*0.5*US%L_to_m**2*US%s_to_T*(MEKE%Kh_diff(i,j)+MEKE%Kh_diff(i,j+1)) Inv_Kh_max = 2.0*sdt * ((G%dx_Cv(i,J)*G%IdyCv(i,J)) * & max(US%m_to_L**2*G%IareaT(i,j),US%m_to_L**2*G%IareaT(i,j+1))) if (Kh_here*Inv_Kh_max > 0.25) Kh_here = 0.25 / Inv_Kh_max @@ -453,30 +465,30 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h MEKE_vflux(i,J) = ((Kh_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)) ) * & - (MEKE%MEKE(i,j) - MEKE%MEKE(i,j+1)) + US%L_T_to_m_s**2*(MEKE%MEKE(i,j) - MEKE%MEKE(i,j+1)) enddo ; enddo if (CS%MEKE_advection_factor>0.) then advFac = GV%H_to_m * CS%MEKE_advection_factor / dt !$OMP parallel do default(shared) do j=js,je ; do I=is-1,ie if (baroHu(I,j)>0.) then - MEKE_uflux(I,j) = MEKE_uflux(I,j) + baroHu(I,j)*MEKE%MEKE(i,j)*advFac + MEKE_uflux(I,j) = MEKE_uflux(I,j) + baroHu(I,j)*US%L_T_to_m_s**2*MEKE%MEKE(i,j)*advFac elseif (baroHu(I,j)<0.) then - MEKE_uflux(I,j) = MEKE_uflux(I,j) + baroHu(I,j)*MEKE%MEKE(i+1,j)*advFac + MEKE_uflux(I,j) = MEKE_uflux(I,j) + baroHu(I,j)*US%L_T_to_m_s**2*MEKE%MEKE(i+1,j)*advFac endif enddo ; enddo !$OMP parallel do default(shared) do J=js-1,je ; do i=is,ie if (baroHv(i,J)>0.) then - MEKE_vflux(i,J) = MEKE_vflux(i,J) + baroHv(i,J)*MEKE%MEKE(i,j)*advFac + MEKE_vflux(i,J) = MEKE_vflux(i,J) + baroHv(i,J)*US%L_T_to_m_s**2*MEKE%MEKE(i,j)*advFac elseif (baroHv(i,J)<0.) then - MEKE_vflux(i,J) = MEKE_vflux(i,J) + baroHv(i,J)*MEKE%MEKE(i,j+1)*advFac + MEKE_vflux(i,J) = MEKE_vflux(i,J) + baroHv(i,J)*US%L_T_to_m_s**2*MEKE%MEKE(i,j+1)*advFac endif enddo ; enddo endif !$OMP parallel do default(shared) do j=js,je ; do i=is,ie - MEKE%MEKE(i,j) = MEKE%MEKE(i,j) + (sdt*(US%m_to_L**2*G%IareaT(i,j)*I_mass(i,j))) * & + MEKE%MEKE(i,j) = MEKE%MEKE(i,j) + US%m_s_to_L_T**2*(sdt*(US%m_to_L**2*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 @@ -486,7 +498,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) + del4MEKE(i,j) + MEKE%MEKE(i,j) = MEKE%MEKE(i,j) + US%m_s_to_L_T**2*del4MEKE(i,j) enddo ; enddo endif @@ -495,21 +507,23 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h if (sdt>sdt_damp) then ! Recalculate the drag rate, since MEKE has changed. if (use_drag_rate) then -!$OMP do if (CS%Jansen15_drag) then + !$OMP parallel do default(shared) 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%MEKE(i,j) = MEKE%MEKE(i,j) - US%m_s_to_L_T**2*sdt_damp*drag_rate(i,j) MEKE_decay(i,j) = ldamping*G%mask2dT(i,j) enddo ; enddo else + !$OMP parallel do default(shared) 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 ) ) + + cdrag2 * ( max(0.0, 2.0*bottomFac2(i,j)*US%L_T_to_m_s**2*MEKE%MEKE(i,j)) + CS%MEKE_Uscale**2 ) ) enddo ; enddo + !$OMP parallel do default(shared) 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. + 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) @@ -517,7 +531,6 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h enddo ; enddo endif endif -!$OMP do endif endif ! MEKE_KH>=0 @@ -525,7 +538,6 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h ! MEKE%MEKE(i,j) = MAX(MEKE%MEKE(i,j),0.0) ! enddo ; enddo -!$OMP end parallel 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) @@ -537,20 +549,22 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h if (CS%Rd_as_max_scale) then !$OMP parallel do default(shared) do j=js,je ; do i=is,ie - MEKE%Kh(i,j) = (CS%MEKE_KhCoeff & - * sqrt(2.*max(0.,barotrFac2(i,j)*MEKE%MEKE(i,j))*US%L_to_m**2*G%areaT(i,j))) & - * min(MEKE%Rd_dx_h(i,j), 1.0) + MEKE%Kh(i,j) = (CS%MEKE_KhCoeff * & + sqrt(2.*max(0.,barotrFac2(i,j)*MEKE%MEKE(i,j))*G%areaT(i,j)) ) * & + min(MEKE%Rd_dx_h(i,j), 1.0) enddo ; enddo else !$OMP parallel do default(shared) do j=js,je ; do i=is,ie - MEKE%Kh(i,j) = CS%MEKE_KhCoeff*sqrt(2.*max(0.,barotrFac2(i,j)*MEKE%MEKE(i,j))*US%L_to_m**2*G%areaT(i,j)) + MEKE%Kh(i,j) = CS%MEKE_KhCoeff * & + sqrt(2.*max(0., barotrFac2(i,j)*MEKE%MEKE(i,j))*G%areaT(i,j)) enddo ; enddo endif else !$OMP parallel do default(shared) do j=js,je ; do i=is,ie - MEKE%Kh(i,j) = (CS%MEKE_KhCoeff*sqrt(2.*max(0.,barotrFac2(i,j)*MEKE%MEKE(i,j)))*LmixScale(i,j)) + MEKE%Kh(i,j) = CS%MEKE_KhCoeff * & + sqrt(2.*max(0., barotrFac2(i,j)*MEKE%MEKE(i,j))) * US%m_to_L*LmixScale(i,j) enddo ; enddo endif endif @@ -559,13 +573,13 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h ! 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) = US%T_to_s*CS%viscosity_coeff_Ku*sqrt(2.*max(0.,MEKE%MEKE(i,j)))*LmixScale(i,j) + MEKE%Ku(i,j) = CS%viscosity_coeff_Ku * sqrt(2.*max(0.,MEKE%MEKE(i,j))) * US%m_to_L*LmixScale(i,j) enddo ; enddo 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 + MEKE%Au(i,j) = CS%viscosity_coeff_Au * sqrt(2.*max(0.,MEKE%MEKE(i,j))) * US%m_to_L**3*LmixScale(i,j)**3 enddo ; enddo endif @@ -752,8 +766,8 @@ subroutine MEKE_equilibrium(CS, MEKE, G, GV, US, SN_u, SN_v, drag_rate_visc, I_m else EKE = 0. endif - MEKE%MEKE(i,j) = EKE -! MEKE%MEKE(i,j) = (US%Z_to_m*G%bathyT(i,j)*SN / (8*CS%cdrag))**2 + MEKE%MEKE(i,j) = US%m_s_to_L_T**2*EKE +! MEKE%MEKE(i,j) = US%m_s_to_L_T**2*(US%Z_to_m*G%bathyT(i,j)*SN / (8*CS%cdrag))**2 enddo ; enddo end subroutine MEKE_equilibrium @@ -771,7 +785,7 @@ subroutine MEKE_lengthScales(CS, MEKE, G, GV, US, SN_u, SN_v, & type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZIB_(G),SZJ_(G)), intent(in) :: SN_u !< Eady growth rate at u-points [s-1]. real, dimension(SZI_(G),SZJB_(G)), intent(in) :: SN_v !< Eady growth rate at v-points [s-1]. - real, dimension(SZI_(G),SZJ_(G)), intent(in) :: EKE !< Eddy kinetic energy [m2 s-2]. + real, dimension(SZI_(G),SZJ_(G)), intent(in) :: EKE !< Eddy kinetic energy [L2 T-2 ~> m2 s-2]. real, dimension(SZI_(G),SZJ_(G)), intent(out) :: bottomFac2 !< gamma_b^2 real, dimension(SZI_(G),SZJ_(G)), intent(out) :: barotrFac2 !< gamma_t^2 real, dimension(SZI_(G),SZJ_(G)), intent(out) :: LmixScale !< Eddy mixing length [m]. @@ -824,7 +838,7 @@ subroutine MEKE_lengthScales(CS, MEKE, G, GV, US, SN_u, SN_v, & endif ! Returns bottomFac2, barotrFac2 and LmixScale call MEKE_lengthScales_0d(CS, US%L_to_m**2*G%areaT(i,j), beta, G%bathyT(i,j), & - MEKE%Rd_dx_h(i,j), SN, MEKE%MEKE(i,j), US%Z_to_m, & + MEKE%Rd_dx_h(i,j), SN, US%L_T_to_m_s**2*MEKE%MEKE(i,j), US%Z_to_m, & bottomFac2(i,j), barotrFac2(i,j), LmixScale(i,j), & Lrhines(i,j), Leady(i,j)) enddo ; enddo @@ -920,6 +934,8 @@ logical function MEKE_init(Time, G, US, param_file, diag, CS, MEKE, restart_CS) ! 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. + real :: L_rescale ! A rescaling factor for length 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". @@ -1122,38 +1138,38 @@ logical function MEKE_init(Time, G, US, param_file, diag, CS, MEKE, restart_CS) ! Register fields for output from this module. CS%diag => diag CS%id_MEKE = register_diag_field('ocean_model', 'MEKE', diag%axesT1, Time, & - 'Mesoscale Eddy Kinetic Energy', 'm2 s-2') + 'Mesoscale Eddy Kinetic Energy', 'm2 s-2', conversion=US%L_T_to_m_s**2) if (.not. associated(MEKE%MEKE)) CS%id_MEKE = -1 CS%id_Kh = register_diag_field('ocean_model', 'MEKE_KH', diag%axesT1, Time, & - 'MEKE derived diffusivity', 'm2 s-1') + 'MEKE derived diffusivity', 'm2 s-1', conversion=US%L_to_m**2*US%s_to_T) 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', conversion=US%s_to_T) + 'MEKE derived lateral viscosity', 'm2 s-1', conversion=US%L_to_m**2*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', conversion=US%s_to_T) + 'MEKE derived lateral biharmonic viscosity', 'm4 s-1', conversion=US%L_to_m**4*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') + 'MEKE derived eddy-velocity scale', 'm s-1', conversion=US%L_T_to_m_s) if (.not. associated(MEKE%MEKE)) CS%id_Ue = -1 CS%id_Ub = register_diag_field('ocean_model', 'MEKE_Ub', diag%axesT1, Time, & - 'MEKE derived bottom eddy-velocity scale', 'm s-1') + 'MEKE derived bottom eddy-velocity scale', 'm s-1', conversion=US%L_T_to_m_s) if (.not. associated(MEKE%MEKE)) CS%id_Ub = -1 CS%id_Ut = register_diag_field('ocean_model', 'MEKE_Ut', diag%axesT1, Time, & - 'MEKE derived barotropic eddy-velocity scale', 'm s-1') + 'MEKE derived barotropic eddy-velocity scale', 'm s-1', conversion=US%L_T_to_m_s) if (.not. associated(MEKE%MEKE)) CS%id_Ut = -1 CS%id_src = register_diag_field('ocean_model', 'MEKE_src', diag%axesT1, Time, & 'MEKE energy source', 'm2 s-3') CS%id_decay = register_diag_field('ocean_model', 'MEKE_decay', diag%axesT1, Time, & 'MEKE decay rate', 's-1') CS%id_GM_src = register_diag_field('ocean_model', 'MEKE_GM_src', diag%axesT1, Time, & - 'MEKE energy available from thickness mixing', 'W m-2') + 'MEKE energy available from thickness mixing', 'W m-2', conversion=US%L_to_m**2*US%s_to_T**3) if (.not. associated(MEKE%GM_src)) CS%id_GM_src = -1 CS%id_mom_src = register_diag_field('ocean_model', 'MEKE_mom_src',diag%axesT1, Time, & - 'MEKE energy available from momentum', 'W m-2') + 'MEKE energy available from momentum', 'W m-2', conversion=US%L_to_m**2*US%s_to_T**3) if (.not. associated(MEKE%mom_src)) CS%id_mom_src = -1 CS%id_GME_snk = register_diag_field('ocean_model', 'MEKE_GME_snk',diag%axesT1, Time, & - 'MEKE energy lost to GME backscatter', 'W m-2') + 'MEKE energy lost to GME backscatter', 'W m-2', conversion=US%L_to_m**2*US%s_to_T**3) if (.not. associated(MEKE%GME_snk)) CS%id_GME_snk = -1 CS%id_Le = register_diag_field('ocean_model', 'MEKE_Le', diag%axesT1, Time, & 'Eddy mixing length used in the MEKE derived eddy diffusivity', 'm') @@ -1188,16 +1204,38 @@ logical function MEKE_init(Time, G, US, param_file, diag, CS, MEKE, restart_CS) 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 + L_rescale = 1.0 + if ((US%m_to_L_restart /= 0.0) .and. (US%m_to_L_restart /= US%m_to_L)) & + L_rescale = US%m_to_L / US%m_to_L_restart - if (I_T_rescale /= 1.0) then + if (L_rescale*I_T_rescale /= 1.0) then + if (associated(MEKE%MEKE)) then ; if (query_initialized(MEKE%MEKE, "MEKE_MEKE", restart_CS)) then + do j=js,je ; do i=is,ie + MEKE%MEKE(i,j) = L_rescale*I_T_rescale * MEKE%MEKE(i,j) + enddo ; enddo + endif ; endif + endif + if (L_rescale**2*I_T_rescale /= 1.0) then + if (associated(MEKE%Kh)) then ; if (query_initialized(MEKE%Kh, "MEKE_Kh", restart_CS)) then + do j=js,je ; do i=is,ie + MEKE%Kh(i,j) = L_rescale**2*I_T_rescale * MEKE%Kh(i,j) + enddo ; enddo + endif ; endif 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) + MEKE%Ku(i,j) = L_rescale**2*I_T_rescale * MEKE%Ku(i,j) enddo ; enddo endif ; endif + if (associated(MEKE%Kh_diff)) then ; if (query_initialized(MEKE%Kh, "MEKE_Kh_diff", restart_CS)) then + do j=js,je ; do i=is,ie + MEKE%Kh_diff(i,j) = L_rescale**2*I_T_rescale * MEKE%Kh_diff(i,j) + enddo ; enddo + endif ; endif + endif + if (L_rescale**4*I_T_rescale /= 1.0) then 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) + MEKE%Au(i,j) = L_rescale**4*I_T_rescale * MEKE%Au(i,j) enddo ; enddo endif ; endif endif diff --git a/src/parameterizations/lateral/MOM_MEKE_types.F90 b/src/parameterizations/lateral/MOM_MEKE_types.F90 index 438e394e3b..33f8f5d1b2 100644 --- a/src/parameterizations/lateral/MOM_MEKE_types.F90 +++ b/src/parameterizations/lateral/MOM_MEKE_types.F90 @@ -8,20 +8,20 @@ module MOM_MEKE_types type, public :: MEKE_type ! Variables real, dimension(:,:), pointer :: & - MEKE => NULL(), & !< Vertically averaged eddy kinetic energy [m2 s-2]. - GM_src => NULL(), & !< MEKE source due to thickness mixing (GM) [W m-2]. - 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]. + MEKE => NULL(), & !< Vertically averaged eddy kinetic energy [L2 T-2 ~> m2 s-2]. + GM_src => NULL(), & !< MEKE source due to thickness mixing (GM) [kg m-2 L2 T-3 ~> W m-2]. + mom_src => NULL(),& !< MEKE source from lateral friction in the momentum equations [kg m-2 L2 T-3 ~> W m-2]. + GME_snk => NULL(),& !< MEKE sink from GME backscatter in the momentum equations [kg m-2 L2 T-3 ~> W m-2]. + Kh => NULL(), & !< The MEKE-derived lateral mixing coefficient [L2 T-1 ~> m2 s-1]. Kh_diff => NULL(), & !< Uses the non-MEKE-derived thickness diffusion coefficient to diffuse - !! MEKE [m2 s-1]. + !! MEKE [L2 T-1 ~> 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 T-1 ~> m2 s-1]. This viscosity can be negative when representing + !! [L2 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]. + !! coefficient [L4 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 7149d508f9..98b9d6c49a 100644 --- a/src/parameterizations/lateral/MOM_hor_visc.F90 +++ b/src/parameterizations/lateral/MOM_hor_visc.F90 @@ -261,7 +261,7 @@ subroutine horizontal_viscosity(u_in, v_in, h, diffu, diffv, MEKE, VarMix, G, GV grad_vel_mag_h, & ! Magnitude of the velocity gradient tensor squared at h-points [T-2 ~> s-2] grad_vel_mag_bt_h, & ! Magnitude of the barotropic velocity gradient tensor squared at h-points [T-2 ~> s-2] grad_d2vel_mag_h, & ! Magnitude of the Laplacian of the velocity vector, squared [L-2 T-2 ~> m-2 s-2] - max_diss_rate_bt, & ! maximum possible energy dissipated by barotropic lateral friction [m2 s-3] + max_diss_rate_bt, & ! maximum possible energy dissipated by barotropic lateral friction [L2 T-3 ~> m2 s-3] boundary_mask ! A mask that zeroes out cells with at least one land edge [nondim] real, dimension(SZIB_(G),SZJB_(G)) :: & @@ -494,7 +494,7 @@ subroutine horizontal_viscosity(u_in, v_in, h, diffu, diffv, MEKE, VarMix, G, GV if (associated(MEKE)) then ; if (associated(MEKE%mom_src)) then !#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) * US%s_to_T**2*grad_vel_mag_bt_h(i,j) + max_diss_rate_bt(i,j) = 2.0*MEKE%MEKE(i,j) * US%s_to_T*grad_vel_mag_bt_h(i,j) enddo ; enddo endif ; endif @@ -911,7 +911,7 @@ subroutine horizontal_viscosity(u_in, v_in, h, diffu, diffv, MEKE, VarMix, G, GV 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%m_to_L**2*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 @@ -963,7 +963,7 @@ subroutine horizontal_viscosity(u_in, v_in, h, diffu, diffv, MEKE, VarMix, G, GV Ah = CS%Ah_bg_xx(i,j) endif ! Smagorinsky_Ah or Leith_Ah - if (use_MEKE_Au) Ah = Ah + US%L_to_m**4*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)) @@ -1075,7 +1075,7 @@ subroutine horizontal_viscosity(u_in, v_in, h, diffu, diffv, MEKE, VarMix, G, GV 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*US%m_to_L**2*( (MEKE%Ku(i,j) + MEKE%Ku(i+1,j+1)) + & + 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 @@ -1131,8 +1131,8 @@ subroutine horizontal_viscosity(u_in, v_in, h, diffu, diffv, MEKE, VarMix, G, GV endif ! Smagorinsky_Ah or Leith_Ah if (use_MEKE_Au) then ! *Add* the MEKE contribution - Ah = Ah + 0.25*US%L_to_m**4*( (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 @@ -1203,7 +1203,7 @@ subroutine horizontal_viscosity(u_in, v_in, h, diffu, diffv, MEKE, VarMix, G, GV if (associated(MEKE)) then ; if (associated(MEKE%mom_src)) then ! This is the maximum possible amount of energy that can be converted ! per unit time, according to theory (multiplied by h) - max_diss_rate(i,j,k) = 2.0*US%m_s_to_L_T**2*MEKE%MEKE(i,j) * sqrt(grad_vel_mag_h(i,j)) + max_diss_rate(i,j,k) = 2.0*MEKE%MEKE(i,j) * sqrt(grad_vel_mag_h(i,j)) FrictWork_diss(i,j,k) = diss_rate(i,j,k) * h(i,j,k) * GV%H_to_kg_m2 FrictWorkMax(i,j,k) = -max_diss_rate(i,j,k) * h(i,j,k) * GV%H_to_kg_m2 @@ -1400,7 +1400,7 @@ subroutine horizontal_viscosity(u_in, v_in, h, diffu, diffv, MEKE, VarMix, G, GV 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) + US%L_to_m**2*US%s_to_T**3*GV%H_to_kg_m2 * ( & + 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)) & +0.25*(((str_xy(I,J)-RoScl*bhstr_xy(I,J))*( & @@ -1419,15 +1419,14 @@ subroutine horizontal_viscosity(u_in, v_in, h, diffu, diffv, MEKE, VarMix, G, GV else 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) + & - US%L_to_m**2*US%s_to_T**3*MAX(FrictWork_diss(i,j,k), FrictWorkMax(i,j,k)) + 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 if (CS%use_GME .and. associated(MEKE)) then if (associated(MEKE%GME_snk)) then do j=js,je ; do i=is,ie - MEKE%GME_snk(i,j) = MEKE%GME_snk(i,j) + US%L_to_m**2*US%s_to_T**3*FrictWork_GME(i,j,k) + MEKE%GME_snk(i,j) = MEKE%GME_snk(i,j) + FrictWork_GME(i,j,k) enddo ; enddo endif endif diff --git a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 index 4bc664859d..1878072e52 100644 --- a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 +++ b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 @@ -217,13 +217,13 @@ 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 * & + US%L_T_to_m_s**2*0.5*(MEKE%MEKE(i,j)+MEKE%MEKE(i+1,j)) / & (VarMix%SN_u(I,j) + CS%MEKE_GEOMETRIC_epsilon) enddo ; enddo else do j=js,je ; do I=is-1,ie - Khth_Loc_u(I,j) = Khth_Loc_u(I,j) + MEKE%KhTh_fac*sqrt(MEKE%Kh(i,j)*MEKE%Kh(i+1,j)) + Khth_Loc_u(I,j) = Khth_Loc_u(I,j) + MEKE%KhTh_fac*US%L_to_m**2*US%s_to_T*sqrt(MEKE%Kh(i,j)*MEKE%Kh(i+1,j)) enddo ; enddo endif endif ; endif @@ -296,13 +296,13 @@ 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)) / & + Khth_Loc(I,j) = Khth_Loc(I,j) + G%mask2dCv(i,J) * CS%MEKE_GEOMETRIC_alpha * & + US%L_T_to_m_s**2*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 - Khth_Loc(i,j) = Khth_Loc(i,j) + MEKE%KhTh_fac*sqrt(MEKE%Kh(i,j)*MEKE%Kh(i,j+1)) + Khth_Loc(i,j) = Khth_Loc(i,j) + MEKE%KhTh_fac*US%L_to_m**2*US%s_to_T*sqrt(MEKE%Kh(i,j)*MEKE%Kh(i,j+1)) enddo ; enddo endif endif ; endif @@ -365,7 +365,7 @@ 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,ie - MEKE%Kh(i,j) = CS%MEKE_GEOMETRIC_alpha * MEKE%MEKE(i,j) / & + MEKE%Kh(i,j) = CS%MEKE_GEOMETRIC_alpha * US%s_to_T*MEKE%MEKE(i,j) / & (0.25*(VarMix%SN_u(I,j)+VarMix%SN_u(I-1,j)+VarMix%SN_v(i,J)+VarMix%SN_v(i,J-1)) + & CS%MEKE_GEOMETRIC_epsilon) enddo ; enddo @@ -458,7 +458,7 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp MEKE%Kh_diff(:,:) = 0.0 do k=1,nz do j=js,je ; do i=is,ie - MEKE%Kh_diff(i,j) = MEKE%Kh_diff(i,j) + KH_t(i,j,k) * h(i,j,k) + MEKE%Kh_diff(i,j) = MEKE%Kh_diff(i,j) + US%m_to_L**2*US%T_to_s*KH_t(i,j,k) * h(i,j,k) enddo; enddo enddo @@ -1278,9 +1278,9 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV if (associated(CS%GMwork)) CS%GMwork(i,j) = Work_h if (associated(MEKE)) then ; if (associated(MEKE%GM_src)) then if (CS%GM_src_alt) then - MEKE%GM_src(i,j) = MEKE%GM_src(i,j) + PE_release_h + MEKE%GM_src(i,j) = MEKE%GM_src(i,j) + US%m_to_L**2*US%T_to_s**3*PE_release_h else - MEKE%GM_src(i,j) = MEKE%GM_src(i,j) + Work_h + MEKE%GM_src(i,j) = MEKE%GM_src(i,j) + US%m_to_L**2*US%T_to_s**3*Work_h endif endif ; endif !enddo ; enddo ; enddo ; endif diff --git a/src/tracer/MOM_tracer_hor_diff.F90 b/src/tracer/MOM_tracer_hor_diff.F90 index 1f4e0b8987..a61af65ee9 100644 --- a/src/tracer/MOM_tracer_hor_diff.F90 +++ b/src/tracer/MOM_tracer_hor_diff.F90 @@ -212,7 +212,7 @@ subroutine tracer_hordiff(h, dt, MEKE, VarMix, G, GV, US, CS, Reg, tv, do_online Kh_loc = CS%KhTr if (use_Eady) Kh_loc = Kh_loc + CS%KhTr_Slope_Cff*VarMix%L2u(I,j)*VarMix%SN_u(I,j) if (associated(MEKE%Kh)) & - Kh_Loc = Kh_Loc + MEKE%KhTr_fac*sqrt(MEKE%Kh(i,j)*MEKE%Kh(i+1,j)) + Kh_Loc = Kh_Loc + MEKE%KhTr_fac*US%L_to_m**2*US%s_to_T*sqrt(MEKE%Kh(i,j)*MEKE%Kh(i+1,j)) if (CS%KhTr_max > 0.) Kh_loc = min(Kh_loc, CS%KhTr_max) if (Resoln_scaled) & Kh_Loc = Kh_Loc * 0.5*(VarMix%Res_fn_h(i,j) + VarMix%Res_fn_h(i+1,j)) @@ -229,7 +229,7 @@ subroutine tracer_hordiff(h, dt, MEKE, VarMix, G, GV, US, CS, Reg, tv, do_online Kh_loc = CS%KhTr if (use_Eady) Kh_loc = Kh_loc + CS%KhTr_Slope_Cff*VarMix%L2v(i,J)*VarMix%SN_v(i,J) if (associated(MEKE%Kh)) & - Kh_Loc = Kh_Loc + MEKE%KhTr_fac*sqrt(MEKE%Kh(i,j)*MEKE%Kh(i,j+1)) + Kh_Loc = Kh_Loc + MEKE%KhTr_fac*US%L_to_m**2*US%s_to_T*sqrt(MEKE%Kh(i,j)*MEKE%Kh(i,j+1)) if (CS%KhTr_max > 0.) Kh_loc = min(Kh_loc, CS%KhTr_max) if (Resoln_scaled) & Kh_Loc = Kh_Loc * 0.5*(VarMix%Res_fn_h(i,j) + VarMix%Res_fn_h(i,j+1)) From 1ff9073ff6b9da9ee984c861a4aa1c6d6f205c36 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Wed, 7 Aug 2019 09:02:54 -0400 Subject: [PATCH 167/297] +Rescaled horizontal viscosity accelerations Applied dimensional rescaling to the horizontal viscosity accelerations, diffu and diffv, that are returned from horizontal_viscosity, into [L T-2]. This change also includes rescaling of two diagnostics. All answers are bitwise identical, but the units of the arguments to a public routine have changed. --- src/core/MOM_checksum_packages.F90 | 6 ++-- src/core/MOM_dynamics_split_RK2.F90 | 14 ++++----- src/core/MOM_dynamics_unsplit.F90 | 14 ++++----- src/core/MOM_dynamics_unsplit_RK2.F90 | 30 +++++++++---------- src/diagnostics/MOM_PointAccel.F90 | 8 ++--- src/diagnostics/MOM_diagnostics.F90 | 4 +-- .../lateral/MOM_hor_visc.F90 | 14 ++++----- 7 files changed, 44 insertions(+), 46 deletions(-) diff --git a/src/core/MOM_checksum_packages.F90 b/src/core/MOM_checksum_packages.F90 index 68ad6d3888..795885e817 100644 --- a/src/core/MOM_checksum_packages.F90 +++ b/src/core/MOM_checksum_packages.F90 @@ -179,10 +179,10 @@ subroutine MOM_accel_chksum(mesg, CAu, CAv, PFu, PFv, diffu, diffv, G, GV, US, p !! (equal to -dM/dy) [L T-2 ~> 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-1 T-1 ~> m s-2]. + !! along-isopycnal stress tensor [L T-2 ~> 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-1 T-1 ~> m s-2]. + !! the along-isopycnal stress tensor [L T-2 ~> 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 @@ -208,7 +208,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, scale=US%L_T2_to_m_s2) call uvchksum(mesg//" PF[uv]", PFu, PFv, G%HI, haloshift=0, symmetric=sym, scale=US%L_T2_to_m_s2) - call uvchksum(mesg//" diffu", diffu, diffv, G%HI,haloshift=0, symmetric=sym, scale=US%s_to_T) + call uvchksum(mesg//" diffu", diffu, diffv, G%HI,haloshift=0, symmetric=sym, scale=US%L_T2_to_m_s2) 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 d97cdf06a9..193062ac42 100644 --- a/src/core/MOM_dynamics_split_RK2.F90 +++ b/src/core/MOM_dynamics_split_RK2.F90 @@ -70,13 +70,13 @@ module MOM_dynamics_split_RK2 type, public :: MOM_dyn_split_RK2_CS ; private real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_,NKMEM_) :: & CAu, & !< CAu = f*v - u.grad(u) [L T-2 ~> m s-2] - PFu, & !< PFu = -dM/dx [m s-2] - diffu !< Zonal acceleration due to convergence of the along-isopycnal stress tensor [m s-1 T-1 ~> m s-2] + PFu, & !< PFu = -dM/dx [L T-2 ~> m s-2] + diffu !< Zonal acceleration due to convergence of the along-isopycnal stress tensor [L T-2 ~> m s-2] real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_,NKMEM_) :: & CAv, & !< CAv = -f*u - u.grad(v) [L T-2 ~> m s-2] PFv, & !< PFv = -dM/dy [L T-2 ~> m s-2] - diffv !< Meridional acceleration due to convergence of the along-isopycnal stress tensor [m s-1 T-1 ~> m s-2] + diffv !< Meridional acceleration due to convergence of the along-isopycnal stress tensor [L T-2 ~> 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)) + US%m_s_to_L_T*CS%diffu(I,j,k) + u_bc_accel(I,j,k) = (CS%CAu(I,j,k) + CS%PFu(I,j,k)) + 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)) + US%m_s_to_L_T*CS%diffv(i,J,k) + v_bc_accel(i,J,k) = (CS%CAv(i,J,k) + CS%PFv(i,J,k)) + CS%diffv(i,J,k) enddo ; enddo enddo if (associated(CS%OBC)) then @@ -707,10 +707,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)) + US%m_s_to_L_T*CS%diffu(I,j,k) + u_bc_accel(I,j,k) = (CS%Cau(I,j,k) + CS%PFu(I,j,k)) + 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)) + US%m_s_to_L_T*CS%diffv(i,J,k) + v_bc_accel(i,J,k) = (CS%Cav(i,J,k) + CS%PFv(i,J,k)) + 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 e4f902c9e0..286aa96c77 100644 --- a/src/core/MOM_dynamics_unsplit.F90 +++ b/src/core/MOM_dynamics_unsplit.F90 @@ -108,16 +108,16 @@ module MOM_dynamics_unsplit type, public :: MOM_dyn_unsplit_CS ; private real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_,NKMEM_) :: & CAu, & !< CAu = f*v - u.grad(u) [L T-2 ~> m s-2]. - PFu, & !< PFu = -dM/dx [m s-2]. - diffu !< Zonal acceleration due to convergence of the along-isopycnal stress tensor [m s-1 T-1 ~> mm s-2]. + PFu, & !< PFu = -dM/dx [L T-2 ~> m s-2]. + diffu !< Zonal acceleration due to convergence of the along-isopycnal stress tensor [L T-2 ~> m s-2]. real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_,NKMEM_) :: & CAv, & !< CAv = -f*u - u.grad(v) [L T-2 ~> m s-2]. PFv, & !< PFv = -dM/dy [L T-2 ~> m s-2]. - diffv !< Meridional acceleration due to convergence of the along-isopycnal stress tensor [m s-1 T-1 ~> m s-2]. + diffv !< Meridional acceleration due to convergence of the along-isopycnal stress tensor [L T-2 ~> 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) + 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] logical :: debug !< If true, write verbose checksums for debugging purposes. @@ -282,10 +282,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 * US%s_to_T*CS%diffu(I,j,k) * G%mask2dCu(I,j) + u(I,j,k) = u(I,j,k) + US%s_to_T*dt * US%L_T_to_m_s*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 * US%s_to_T*CS%diffv(i,J,k) * G%mask2dCv(i,J) + v(i,J,k) = v(i,J,k) + US%s_to_T*dt * US%L_T_to_m_s*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*US%s_to_T*dt*uh(i,j,k) diff --git a/src/core/MOM_dynamics_unsplit_RK2.F90 b/src/core/MOM_dynamics_unsplit_RK2.F90 index e4c92b9783..c3faabf8ba 100644 --- a/src/core/MOM_dynamics_unsplit_RK2.F90 +++ b/src/core/MOM_dynamics_unsplit_RK2.F90 @@ -105,13 +105,13 @@ module MOM_dynamics_unsplit_RK2 type, public :: MOM_dyn_unsplit_RK2_CS ; private real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_,NKMEM_) :: & CAu, & !< CAu = f*v - u.grad(u) [L T-2 ~> m s-2]. - PFu, & !< PFu = -dM/dx [m s-2]. - diffu !< Zonal acceleration due to convergence of the along-isopycnal stress tensor [m s-1 T-1 ~> m s-2]. + PFu, & !< PFu = -dM/dx [L T-2 ~> m s-2]. + diffu !< Zonal acceleration due to convergence of the along-isopycnal stress tensor [L T-2 ~> m s-2]. real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_,NKMEM_) :: & CAv, & !< CAv = -f*u - u.grad(v) [L T-2 ~> m s-2]. PFv, & !< PFv = -dM/dy [L T-2 ~> m s-2]. - diffv !< Meridional acceleration due to convergence of the along-isopycnal stress tensor [m s-1 T-1 ~> m s-2]. + diffv !< Meridional acceleration due to convergence of the along-isopycnal stress tensor [L T-2 ~> 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) @@ -321,12 +321,12 @@ subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt, ! up+[n-1/2] = u[n-1] + dt_pred * (PFu + CAu) 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 * & - (US%L_T2_to_m_s2*(CS%PFu(I,j,k) + CS%CAu(I,j,k)) + US%s_to_T*CS%diffu(I,j,k))) + up(I,j,k) = G%mask2dCu(I,j) * (u_in(I,j,k) + US%L_T_to_m_s * US%s_to_T*dt_pred * & + ((CS%PFu(I,j,k) + CS%CAu(I,j,k)) + 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 * & - (US%L_T2_to_m_s2*(CS%PFv(i,J,k) + CS%CAv(i,J,k)) + US%s_to_T*CS%diffv(i,J,k))) + vp(i,J,k) = G%mask2dCv(i,J) * (v_in(i,J,k) + US%L_T_to_m_s * US%s_to_T*dt_pred * & + ((CS%PFv(i,J,k) + CS%CAv(i,J,k)) + CS%diffv(i,J,k))) enddo ; enddo ; enddo call cpu_clock_end(id_clock_mom_update) @@ -377,16 +377,16 @@ subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt, ! up* = u[n] + (1+gamma) * dt * ( PFu + CAu ) Extrapolated for damping ! 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) * & - (US%L_T2_to_m_s2*(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 * & - (US%L_T2_to_m_s2*(CS%PFu(I,j,k) + CS%CAu(I,j,k)) + US%s_to_T*CS%diffu(I,j,k))) + up(I,j,k) = G%mask2dCu(I,j) * (u_in(I,j,k) + US%L_T_to_m_s * US%s_to_T*dt * (1.+CS%begw) * & + ((CS%PFu(I,j,k) + CS%CAu(I,j,k)) + CS%diffu(I,j,k))) + u_in(I,j,k) = G%mask2dCu(I,j) * (u_in(I,j,k) + US%L_T_to_m_s * US%s_to_T*dt * & + ((CS%PFu(I,j,k) + CS%CAu(I,j,k)) + 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) * & - (US%L_T2_to_m_s2*(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 * & - (US%L_T2_to_m_s2*(CS%PFv(i,J,k) + CS%CAv(i,J,k)) + US%s_to_T*CS%diffv(i,J,k))) + vp(i,J,k) = G%mask2dCv(i,J) * (v_in(i,J,k) + US%L_T_to_m_s * US%s_to_T*dt * (1.+CS%begw) * & + ((CS%PFv(i,J,k) + CS%CAv(i,J,k)) + CS%diffv(i,J,k))) + v_in(i,J,k) = G%mask2dCv(i,J) * (v_in(i,J,k) + US%L_T_to_m_s * US%s_to_T*dt * & + ((CS%PFv(i,J,k) + CS%CAv(i,J,k)) + CS%diffv(i,J,k))) enddo ; enddo ; enddo ! up[n] <- up* + dt d/dz visc d/dz up diff --git a/src/diagnostics/MOM_PointAccel.F90 b/src/diagnostics/MOM_PointAccel.F90 index f5ddab01bc..92292bb8e7 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*US%L_T2_to_m_s2*ADp%PFu(I,j,k)); enddo write(file,'(/,"diffu: ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (dt*US%s_to_T*ADp%diffu(I,j,k)); enddo + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (dt*US%L_T2_to_m_s2*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*US%s_to_T*ADp%diffu(I,j,k)*Inorm(k)); enddo + (dt*US%L_T2_to_m_s2*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*US%L_T2_to_m_s2*ADp%PFv(i,J,k)); enddo write(file,'(/,"diffv: ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (dt*US%s_to_T*ADp%diffv(i,J,k)); enddo + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (dt*US%L_T2_to_m_s2*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*US%L_T2_to_m_s2*ADp%PFv(i,J,k)*Inorm(k)); enddo write(file,'(/,"diffv: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(F10.6," ",$)') & - (dt*US%s_to_T*ADp%diffv(i,J,k)*Inorm(k)); enddo + (dt*US%L_T2_to_m_s2*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 a2bd76766c..eef2955ee0 100644 --- a/src/diagnostics/MOM_diagnostics.F90 +++ b/src/diagnostics/MOM_diagnostics.F90 @@ -1043,10 +1043,10 @@ subroutine calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, GV, US, CS if (associated(CS%KE_horvisc)) then do k=1,nz do j=js,je ; do I=Isq,Ieq - KE_u(I,j) = US%s_to_T*uh(I,j,k)*US%L_to_m*G%dxCu(I,j)*US%s_to_T*ADp%diffu(I,j,k) + KE_u(I,j) = US%s_to_T*uh(I,j,k)*US%L_to_m*G%dxCu(I,j)*US%L_T2_to_m_s2*ADp%diffu(I,j,k) enddo ; enddo do J=Jsq,Jeq ; do i=is,ie - KE_v(i,J) = US%s_to_T*vh(i,J,k)*US%L_to_m*G%dyCv(i,J)*US%s_to_T*ADp%diffv(i,J,k) + KE_v(i,J) = US%s_to_T*vh(i,J,k)*US%L_to_m*G%dyCv(i,J)*US%L_T2_to_m_s2*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 98b9d6c49a..876cea507f 100644 --- a/src/parameterizations/lateral/MOM_hor_visc.F90 +++ b/src/parameterizations/lateral/MOM_hor_visc.F90 @@ -209,10 +209,10 @@ subroutine horizontal_viscosity(u_in, v_in, h, diffu, diffv, MEKE, VarMix, G, GV 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-1 T-1 ~> m s-2] + !! along-coordinate stress tensor [L T-2 ~> 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-1 T-1 ~> m s-2]. + !! of along-coordinate stress tensor [L T-2 ~> 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 @@ -1303,8 +1303,7 @@ subroutine horizontal_viscosity(u_in, v_in, h, diffu, diffv, MEKE, VarMix, G, GV ! 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%L_T_to_m_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))) * & @@ -1326,8 +1325,7 @@ subroutine horizontal_viscosity(u_in, v_in, h, diffu, diffv, MEKE, VarMix, G, GV ! 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%L_T_to_m_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))) * & @@ -2156,10 +2154,10 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS, MEKE) ! 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', conversion=US%s_to_T) + 'Zonal Acceleration from Horizontal Viscosity', 'm s-2', conversion=US%L_T2_to_m_s2) CS%id_diffv = register_diag_field('ocean_model', 'diffv', diag%axesCvL, Time, & - 'Meridional Acceleration from Horizontal Viscosity', 'm s-2', conversion=US%s_to_T) + 'Meridional Acceleration from Horizontal Viscosity', 'm s-2', conversion=US%L_T2_to_m_s2) if (CS%biharmonic) then CS%id_Ah_h = register_diag_field('ocean_model', 'Ahh', diag%axesTL, Time, & From 070c6048b8b58ecca18bed0ad846ac59e75a37ec Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Thu, 8 Aug 2019 04:31:29 -0400 Subject: [PATCH 168/297] (*)Eliminated a bug in horizontal viscosity work Commented out code that deliberately retained a bug, thereby eliminating the dimensionally inconsistent expressions for the limits on the estimates of energy extracted by the horizontal viscosity. The decision to simply eliminate this bug by commenting out code instead of adding a run-time bugfix parameter was taken after consulting with Scott Bachman and Malte Jansen, whose simulations seemed the most likely to be impacted. All answers are bitwise identical in the dev/gfdl MOM6-examples test cases, but other solutions could be changed. --- src/parameterizations/lateral/MOM_hor_visc.F90 | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/src/parameterizations/lateral/MOM_hor_visc.F90 b/src/parameterizations/lateral/MOM_hor_visc.F90 index 876cea507f..65b120c62e 100644 --- a/src/parameterizations/lateral/MOM_hor_visc.F90 +++ b/src/parameterizations/lateral/MOM_hor_visc.F90 @@ -1153,16 +1153,16 @@ subroutine horizontal_viscosity(u_in, v_in, h, diffu, diffv, MEKE, VarMix, G, GV if (find_FrictWork) then if (CS%Laplacian) then - if (CS%biharmonic) then + ! if (CS%biharmonic) then !### This code is dimensionally incorrect, but needed to reproduce previous answers. ! This should be considered a serious bug in cases where the answers change if the ! following code is commented out - i.e. if both biharmonic and Laplacian are used ! and FindFrictWork is true. - do J=js-1,Jeq ; do I=is-1,Ieq - dvdx(I,J) = US%m_to_L**2*dDel2vdx(I,J) - dudy(I,J) = US%m_to_L**2*dDel2udy(I,J) - enddo ; enddo - endif + ! do J=js-1,Jeq ; do I=is-1,Ieq + ! dvdx(I,J) = US%m_to_L**2*dDel2vdx(I,J) + ! dudy(I,J) = US%m_to_L**2*dDel2udy(I,J) + ! enddo ; enddo + ! endif if (CS%answers_2018) then do j=js,je ; do i=is,ie From f07e85f47e90c3d2cf77907cbba3aefb469552ce Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Thu, 8 Aug 2019 05:15:26 -0400 Subject: [PATCH 169/297] Rescaled internal variables in MOM_MEKE.F90 Rescaled multiple internal variables in MOM_MEKE.F90 for more complete dimensional consistency testing. Two dimensionally inconsistent expressions (i.e., bugs) were identified and marked; one of these bugs makes the horizontal advection of MEKE much less effective than is should have been, the other arises from dimensional inconsistency in the use of the dragrate variable when MEKE_JANSEN15_DRAG is true. It is conceivable that underflow would be an issue in some test cases with out an explicitly set underflow velocity, but all answers in the MOM6-examples test cases are bitwise identical. --- src/parameterizations/lateral/MOM_MEKE.F90 | 420 +++++++++++---------- 1 file changed, 220 insertions(+), 200 deletions(-) diff --git a/src/parameterizations/lateral/MOM_MEKE.F90 b/src/parameterizations/lateral/MOM_MEKE.F90 index 20aecb07c1..aa0242b8fc 100644 --- a/src/parameterizations/lateral/MOM_MEKE.F90 +++ b/src/parameterizations/lateral/MOM_MEKE.F90 @@ -33,7 +33,7 @@ module MOM_MEKE real :: MEKE_FrCoeff !< Efficiency of conversion of ME into MEKE [nondim] real :: MEKE_GMcoeff !< Efficiency of conversion of PE into MEKE [nondim] real :: MEKE_GMECoeff !< Efficiency of conversion of MEKE into ME by GME [nondim] - real :: MEKE_damping !< Local depth-independent MEKE dissipation rate [s-1]. + real :: MEKE_damping !< Local depth-independent MEKE dissipation rate [T-1 ~> s-1]. real :: MEKE_Cd_scale !< The ratio of the bottom eddy velocity to the column mean !! eddy velocity, i.e. sqrt(2*MEKE). This should be less than 1 !! to account for the surface intensification of MEKE. @@ -51,12 +51,12 @@ module MOM_MEKE logical :: use_old_lscale !< Use the old formula for mixing length scale. logical :: use_min_lscale !< Use simple minimum for mixing length scale. real :: cdrag !< The bottom drag coefficient for MEKE [nondim]. - real :: MEKE_BGsrc !< Background energy source for MEKE [W kg-1] (= m2 s-3). + real :: MEKE_BGsrc !< Background energy source for MEKE [L2 T-3 ~> W kg-1] (= m2 s-3). real :: MEKE_dtScale !< Scale factor to accelerate time-stepping [nondim] real :: MEKE_KhCoeff !< Scaling factor to convert MEKE into Kh [nondim] - real :: MEKE_Uscale !< MEKE velocity scale for bottom drag [m s-1] - real :: MEKE_KH !< Background lateral diffusion of MEKE [m2 s-1] - real :: MEKE_K4 !< Background bi-harmonic diffusivity (of MEKE) [m4 s-1] + real :: MEKE_Uscale !< MEKE velocity scale for bottom drag [L T-1 ~> m s-1] + real :: MEKE_KH !< Background lateral diffusion of MEKE [L2 T-1 ~> m2 s-1] + real :: MEKE_K4 !< Background bi-harmonic diffusivity (of MEKE) [L4 T-1 ~> m4 s-1] real :: KhMEKE_Fac !< A factor relating MEKE%Kh to the diffusivity used for !! MEKE itself [nondim]. real :: viscosity_coeff_Ku !< The scaling coefficient in the expression for @@ -65,7 +65,7 @@ module MOM_MEKE real :: viscosity_coeff_Au !< The scaling coefficient in the expression for !! viscosity used to parameterize lateral biharmonic momentum mixing !! by unresolved eddies represented by MEKE. - real :: Lfixed !< Fixed mixing length scale [m]. + real :: Lfixed !< Fixed mixing length scale [L ~> m]. real :: aDeform !< Weighting towards deformation scale of mixing length [nondim] real :: aRhines !< Weighting towards Rhines scale of mixing length [nondim] real :: aFrict !< Weighting towards frictional arrest scale of mixing length [nondim] @@ -116,40 +116,47 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h real, dimension(SZI_(G),SZJ_(G)) :: & mass, & ! The total mass of the water column [kg m-2]. I_mass, & ! The inverse of mass [m2 kg-1]. - src, & ! The sum of all MEKE sources [m2 s-3]. - MEKE_decay, & ! The MEKE decay timescale [s-1]. - MEKE_GM_src, & ! The MEKE source from thickness mixing [m2 s-3]. - MEKE_mom_src, & ! The MEKE source from momentum [m2 s-3]. - 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]. + src, & ! The sum of all MEKE sources [L2 T-3 ~> W kg-1] (= m2 s-3). + MEKE_decay, & ! A diagnostic of the MEKE decay timescale [T-1 ~> s-1]. + ! MEKE_GM_src, & ! The MEKE source from thickness mixing [m2 s-3]. + ! MEKE_mom_src, & ! The MEKE source from momentum [m2 s-3]. + ! MEKE_GME_snk, & ! The MEKE sink from GME backscatter [m2 s-3]. + drag_rate_visc, & ! Near-bottom velocity contribution to bottom dratg [L T-1 ~> m s-1] + drag_rate, & ! The MEKE spindown timescale due to bottom drag [T-1 ~> s-1]. + drag_rate_J15, & ! The MEKE spindown timescale due to bottom drag with the Jansen 2015 scheme. + ! Unfortunately, as written the units seem inconsistent. [T-1 ~> s-1]. + del2MEKE, & ! Laplacian of MEKE, used for bi-harmonic diffusion [T-2 ~> s-2]. + del4MEKE, & ! Time-integrated MEKE tendency arising from the biharmonic of MEKE [L2 T-2 ~> m2 s-2]. + LmixScale, & ! Eddy mixing length [L ~> m]. barotrFac2, & ! Ratio of EKE_barotropic / EKE [nondim] bottomFac2 ! Ratio of EKE_bottom / EKE [nondim] real, dimension(SZIB_(G),SZJ_(G)) :: & - MEKE_uflux, & ! The zonal diffusive flux of MEKE [kg m2 s-3]. - Kh_u, & ! The zonal diffusivity that is actually used [m2 s-1]. - baroHu, & ! Depth integrated accumulated zonal mass flux [H m2 ~> m3 or kg]. + MEKE_uflux, & ! The zonal advective and diffusive flux of MEKE with different units in different + ! places of [L2 T-2 ~> m2 s-2] or [m L4 T-3 ~> m5 s-3] or [kg m-2 L4 T-3 ~> kg m-2 s-3]. + Kh_u, & ! The zonal diffusivity that is actually used [L2 T-1 ~> m2 s-1]. + baroHu, & ! Depth integrated accumulated zonal mass flux [H L2 ~> m3 or kg]. drag_vel_u ! A (vertical) viscosity associated with bottom drag at - ! u-points [m s-1]. + ! u-points [Z T-1 ~> m s-1]. real, dimension(SZI_(G),SZJB_(G)) :: & - MEKE_vflux, & ! The meridional diffusive flux of MEKE [kg m2 s-3]. - Kh_v, & ! The meridional diffusivity that is actually used [m2 s-1]. - baroHv, & ! Depth integrated accumulated meridional mass flux [H m2 ~> m3 or kg]. + MEKE_vflux, & ! The meridional advective and diffusive flux of MEKE with different units in different + ! places of [L2 T-2 ~> m2 s-2] or [m L4 T-3 ~> m5 s-3] or [kg m-2 L4 T-3 ~> kg m-2 s-3]. + Kh_v, & ! The meridional diffusivity that is actually used [L2 T-1 ~> m2 s-1]. + baroHv, & ! Depth integrated accumulated meridional mass flux [H L2 ~> m3 or kg]. drag_vel_v ! A (vertical) viscosity associated with bottom drag at - ! v-points [m s-1]. - real :: Kh_here, Inv_Kh_max, K4_here + ! v-points [Z T-1 ~> m s-1]. + real :: Kh_here ! The local horizontal viscosity [L2 T-1 ~> m2 s-1] + real :: Inv_Kh_max ! The inverse of the local horizontal viscosity [T L-2 ~> s m-2] + real :: K4_here ! The local horizontal biharmonic viscosity [L4 T-1 ~> m4 s-1] + real :: Inv_K4_max ! The inverse of the local horizontal biharmonic viscosity [T L-4 ~> s m-4] real :: cdrag2 real :: advFac ! The product of the advection scaling factor and some unit conversion - ! factors divided by the timestep [m H-1 s-1 ~> s-1 or m3 kg-1 s-1] + ! factors divided by the timestep [m H-1 T-1 ~> s-1 or m3 kg-1 s-1] real :: mass_neglect ! A negligible mass [kg m-2]. - real :: ldamping ! The MEKE damping rate [s-1]. + real :: ldamping ! The MEKE damping rate [T-1 ~> s-1]. real :: Rho0 ! A density used to convert mass to distance [kg m-3]. - real :: sdt ! dt to use locally [s] (could be scaled to accelerate) - real :: sdt_damp ! dt for damping [s] (sdt could be split). + real :: sdt ! dt to use locally [T ~> s] (could be scaled to accelerate) + real :: sdt_damp ! dt for damping [T ~> s] (sdt could be split). logical :: use_drag_rate ! Flag to indicate drag_rate is finite integer :: i, j, k, is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz @@ -161,10 +168,7 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h if (.not.associated(MEKE)) call MOM_error(FATAL, & "MOM_MEKE: MEKE must be initialized before it is used.") - Rho0 = GV%H_to_kg_m2 * GV%m_to_H - mass_neglect = GV%H_to_kg_m2 * GV%H_subroundoff - sdt = dt*CS%MEKE_dtScale ! Scaled dt to use for time-stepping - if (CS%MEKE_damping + CS%MEKE_Cd_scale > 0.0 .or. CS%MEKE_Cb>0. & + if ((US%s_to_T*CS%MEKE_damping + CS%MEKE_Cd_scale > 0.0) .or. (CS%MEKE_Cb>0.) & .or. CS%visc_drag) then use_drag_rate = .true. else @@ -172,7 +176,10 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h endif ! Only integrate the MEKE equations if MEKE is required. - if (associated(MEKE%MEKE)) then + if (.not.associated(MEKE%MEKE)) then +! call MOM_error(FATAL, "MOM_MEKE: MEKE%MEKE is not associated!") + return + endif if (CS%debug) then if (associated(MEKE%mom_src)) & @@ -186,8 +193,7 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h call uvchksum("MEKE h[uv]", hu, hv, G%HI, haloshift=1, scale=GV%H_to_m) endif - ! Why are these 3 lines repeated from above? - sdt = dt*CS%MEKE_dtScale ! Scaled dt to use for time-stepping + sdt = US%s_to_T*dt*CS%MEKE_dtScale ! Scaled dt to use for time-stepping Rho0 = GV%H_to_kg_m2 * GV%m_to_H mass_neglect = GV%H_to_kg_m2 * GV%H_subroundoff cdrag2 = CS%cdrag**2 @@ -203,7 +209,7 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h enddo ; enddo do k=1,nz do j=js,je ; do I=is-1,ie - baroHu(I,j) = US%L_to_m**2*hu(I,j,k) + baroHu(I,j) = hu(I,j,k) enddo ; enddo enddo do J=js-1,je ; do i=is,ie @@ -211,7 +217,7 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h enddo ; enddo do k=1,nz do J=js-1,je ; do i=is,ie - baroHv(i,J) = US%L_to_m**2*hv(i,J,k) + baroHv(i,J) = hv(i,J,k) enddo ; enddo enddo endif @@ -219,7 +225,7 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h if (CS%MEKE_Cd_scale == 0.0 .and. .not. CS%visc_drag) then !$OMP parallel do default(shared) private(ldamping) do j=js,je ; do i=is,ie - drag_rate(i,j) = 0. + drag_rate(i,j) = 0. ; drag_rate_J15(i,j) = 0. enddo ; enddo endif @@ -229,18 +235,18 @@ 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*US%s_to_T*visc%Kv_bbl_u(I,j) / visc%bbl_thick_u(I,j) + drag_vel_u(I,j) = 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*US%s_to_T*visc%Kv_bbl_v(i,J) / visc%bbl_thick_v(i,J) + drag_vel_v(i,J) = visc%Kv_bbl_v(i,J) / visc%bbl_thick_v(i,J) enddo ; enddo !$OMP parallel do default(shared) do j=js,je ; do i=is,ie - drag_rate_visc(i,j) = (0.25*G%IareaT(i,j) * & + drag_rate_visc(i,j) = (0.25*G%IareaT(i,j) * US%Z_to_L * & ((G%areaCu(I-1,j)*drag_vel_u(I-1,j) + & G%areaCu(I,j)*drag_vel_u(I,j)) + & (G%areaCv(i,J-1)*drag_vel_v(i,J-1) + & @@ -273,12 +279,12 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h ! Calculates bottomFac2, barotrFac2 and LmixScale call MEKE_lengthScales(CS, MEKE, G, GV, US, SN_u, SN_v, MEKE%MEKE, bottomFac2, barotrFac2, LmixScale) if (CS%debug) then - call uvchksum("MEKE drag_vel_[uv]", drag_vel_u, drag_vel_v, G%HI) + call uvchksum("MEKE drag_vel_[uv]", drag_vel_u, drag_vel_v, G%HI, scale=US%Z_to_m*US%s_to_T) call hchksum(mass, 'MEKE mass',G%HI,haloshift=1) - call hchksum(drag_rate_visc, 'MEKE drag_rate_visc',G%HI) + call hchksum(drag_rate_visc, 'MEKE drag_rate_visc',G%HI, scale=US%L_T_to_m_s) call hchksum(bottomFac2, 'MEKE bottomFac2',G%HI) call hchksum(barotrFac2, 'MEKE barotrFac2',G%HI) - call hchksum(LmixScale, 'MEKE LmixScale',G%HI) + call hchksum(LmixScale, 'MEKE LmixScale',G%HI,scale=US%L_to_m) endif ! Aggregate sources of MEKE (background, frictional and GM) @@ -290,14 +296,14 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h if (associated(MEKE%mom_src)) then !$OMP parallel do default(shared) do j=js,je ; do i=is,ie - src(i,j) = src(i,j) - CS%MEKE_FrCoeff*I_mass(i,j)*US%L_to_m**2*US%s_to_T**3*MEKE%mom_src(i,j) + src(i,j) = src(i,j) - CS%MEKE_FrCoeff*I_mass(i,j)*MEKE%mom_src(i,j) enddo ; enddo endif if (associated(MEKE%GME_snk)) then !$OMP parallel do default(shared) do j=js,je ; do i=is,ie - src(i,j) = src(i,j) - CS%MEKE_GMECoeff*I_mass(i,j)*US%L_to_m**2*US%s_to_T**3*MEKE%GME_snk(i,j) + src(i,j) = src(i,j) - CS%MEKE_GMECoeff*I_mass(i,j)*MEKE%GME_snk(i,j) enddo ; enddo endif @@ -305,13 +311,13 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h if (CS%GM_src_alt) then !$OMP parallel do default(shared) do j=js,je ; do i=is,ie - src(i,j) = src(i,j) - CS%MEKE_GMcoeff*US%L_to_m**2*US%s_to_T**3*MEKE%GM_src(i,j) / & - MAX(1.0, G%bathyT(i,j)) !### 1.0 seems to be a hard-coded dimensional constant. + src(i,j) = src(i,j) - CS%MEKE_GMcoeff*MEKE%GM_src(i,j) / & + MAX(1.0, G%bathyT(i,j)) !### 1.0 seems to be a hard-coded dimensional constant (1 m?). enddo ; enddo else !$OMP parallel do default(shared) do j=js,je ; do i=is,ie - src(i,j) = src(i,j) - CS%MEKE_GMcoeff*I_mass(i,j)*US%L_to_m**2*US%s_to_T**3*MEKE%GM_src(i,j) + src(i,j) = src(i,j) - CS%MEKE_GMcoeff*I_mass(i,j)*MEKE%GM_src(i,j) enddo ; enddo endif endif @@ -319,7 +325,7 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h ! Increase EKE by a full time-steps worth of source !$OMP parallel do default(shared) do j=js,je ; do i=is,ie - MEKE%MEKE(i,j) = (MEKE%MEKE(i,j) + US%m_s_to_L_T**2*sdt*src(i,j) )*G%mask2dT(i,j) + MEKE%MEKE(i,j) = (MEKE%MEKE(i,j) + sdt*src(i,j))*G%mask2dT(i,j) enddo ; enddo if (use_drag_rate) then @@ -327,16 +333,15 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h if (CS%Jansen15_drag) then !$OMP parallel do default(shared) 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)*US%L_T_to_m_s**2*MEKE%MEKE(i,j)) * & - 2.0 * bottomFac2(i,j)*US%L_T_to_m_s**2*MEKE%MEKE(i,j) + drag_rate_J15(i,j) = US%L_to_m**3*US%s_to_T**2 * (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 !$OMP parallel do default(shared) 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)*US%L_T_to_m_s**2*MEKE%MEKE(i,j)) + CS%MEKE_Uscale**2 ) ) + drag_rate(i,j) = (US%L_to_m*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 endif @@ -345,8 +350,8 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h if (CS%Jansen15_drag) then !$OMP parallel do default(shared) 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), US%m_s_to_L_T**2*sdt_damp*drag_rate(i,j)) + ldamping = CS%MEKE_damping + drag_rate_J15(i,j) + MEKE%MEKE(i,j) = MEKE%MEKE(i,j) - MIN(MEKE%MEKE(i,j), US%m_to_L**2*US%T_to_s**2*sdt_damp*drag_rate_J15(i,j)) MEKE_decay(i,j) = ldamping*G%mask2dT(i,j) enddo ; enddo else @@ -372,48 +377,50 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h ! Calculate Laplacian of MEKE !$OMP parallel do default(shared) do j=js-1,je+1 ; do I=is-2,ie+1 + ! Here the units of MEKE_uflux are [L2 T-2]. MEKE_uflux(I,j) = ((G%dy_Cu(I,j)*G%IdxCu(I,j)) * G%mask2dCu(I,j)) * & - US%L_T_to_m_s**2*(MEKE%MEKE(i+1,j) - MEKE%MEKE(i,j)) + (MEKE%MEKE(i+1,j) - MEKE%MEKE(i,j)) ! MEKE_uflux(I,j) = ((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)) ) * & - ! US%L_T_to_m_s**2*(MEKE%MEKE(i+1,j) - MEKE%MEKE(i,j)) + ! (MEKE%MEKE(i+1,j) - MEKE%MEKE(i,j)) enddo ; enddo !$OMP parallel do default(shared) do J=js-2,je+1 ; do i=is-1,ie+1 + ! Here the units of MEKE_vflux are [L2 T-2]. MEKE_vflux(i,J) = ((G%dx_Cv(i,J)*G%IdyCv(i,J)) * G%mask2dCv(i,J)) * & - US%L_T_to_m_s**2*(MEKE%MEKE(i,j+1) - MEKE%MEKE(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)) ) * & - ! US%L_T_to_m_s**2*(MEKE%MEKE(i,j+1) - MEKE%MEKE(i,j)) + ! (MEKE%MEKE(i,j+1) - MEKE%MEKE(i,j)) enddo ; enddo !$OMP parallel do default(shared) do j=js-1,je+1 ; do i=is-1,ie+1 - del2MEKE(i,j) = US%m_to_L**2*G%IareaT(i,j) * & + 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))) - ! del2MEKE(i,j) = (US%m_to_L**2*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 ! Bi-harmonic diffusion of MEKE - !$OMP parallel do default(shared) private(K4_here,Inv_Kh_max) + !$OMP parallel do default(shared) private(K4_here,Inv_K4_max) do j=js,je ; do I=is-1,ie 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(US%m_to_L**2*G%IareaT(i,j),US%m_to_L**2*G%IareaT(i+1,j))))**2 - if (K4_here*Inv_Kh_max > 0.3) K4_here = 0.3 / Inv_Kh_max + Inv_K4_max = 64.0 * sdt * ((G%dy_Cu(I,j)*G%IdxCu(I,j)) * & + max(G%IareaT(i,j), G%IareaT(i+1,j)))**2 + if (K4_here*Inv_K4_max > 0.3) K4_here = 0.3 / Inv_K4_max + ! Here the units of MEKE_uflux are [kg m-2 L4 T-3]. 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)) ) * & (del2MEKE(i+1,j) - del2MEKE(i,j)) enddo ; enddo - !$OMP parallel do default(shared) private(K4_here,Inv_Kh_max) + !$OMP parallel do default(shared) private(K4_here,Inv_K4_max) 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(US%m_to_L**2*G%IareaT(i,j),US%m_to_L**2*G%IareaT(i,j+1))))**2 - if (K4_here*Inv_Kh_max > 0.3) K4_here = 0.3 / Inv_Kh_max + Inv_K4_max = 64.0 * sdt * ((G%dx_Cv(i,J)*G%IdyCv(i,J)) * max(G%IareaT(i,j), G%IareaT(i,j+1)))**2 + if (K4_here*Inv_K4_max > 0.3) K4_here = 0.3 / Inv_K4_max 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)) ) * & @@ -422,7 +429,7 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h ! Store tendency arising from the bi-harmonic in del4MEKE !$OMP parallel do default(shared) do j=js,je ; do i=is,ie - del4MEKE(i,j) = (sdt*(US%m_to_L**2*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 @@ -431,64 +438,70 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h if (CS%kh_flux_enabled) then ! Lateral diffusion of MEKE - Kh_here = max(0.,CS%MEKE_Kh) + Kh_here = max(0., CS%MEKE_Kh) !$OMP parallel do default(shared) firstprivate(Kh_here) private(Inv_Kh_max) do j=js,je ; do I=is-1,ie ! Limit Kh to avoid CFL violations. if (associated(MEKE%Kh)) & - Kh_here = max(0.,CS%MEKE_Kh) + & - CS%KhMEKE_Fac*0.5*US%L_to_m**2*US%s_to_T*(MEKE%Kh(i,j)+MEKE%Kh(i+1,j)) + Kh_here = max(0., CS%MEKE_Kh) + & + CS%KhMEKE_Fac*0.5*(MEKE%Kh(i,j)+MEKE%Kh(i+1,j)) if (associated(MEKE%Kh_diff)) & Kh_here = max(0.,CS%MEKE_Kh) + & - CS%KhMEKE_Fac*0.5*US%L_to_m**2*US%s_to_T*(MEKE%Kh_diff(i,j)+MEKE%Kh_diff(i+1,j)) + CS%KhMEKE_Fac*0.5*(MEKE%Kh_diff(i,j)+MEKE%Kh_diff(i+1,j)) Inv_Kh_max = 2.0*sdt * ((G%dy_Cu(I,j)*G%IdxCu(I,j)) * & - max(US%m_to_L**2*G%IareaT(i,j),US%m_to_L**2*G%IareaT(i+1,j))) + max(G%IareaT(i,j),G%IareaT(i+1,j))) if (Kh_here*Inv_Kh_max > 0.25) Kh_here = 0.25 / Inv_Kh_max Kh_u(I,j) = Kh_here + ! Here the units of MEKE_uflux and MEKE_vflux are [kg m-2 L4 T-3]. MEKE_uflux(I,j) = ((Kh_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)) ) * & - US%L_T_to_m_s**2*(MEKE%MEKE(i,j) - MEKE%MEKE(i+1,j)) + (MEKE%MEKE(i,j) - MEKE%MEKE(i+1,j)) enddo ; enddo !$OMP parallel do default(shared) firstprivate(Kh_here) private(Inv_Kh_max) do J=js-1,je ; do i=is,ie if (associated(MEKE%Kh)) & - Kh_here = max(0.,CS%MEKE_Kh) + & - CS%KhMEKE_Fac*0.5*US%L_to_m**2*US%s_to_T*(MEKE%Kh(i,j)+MEKE%Kh(i,j+1)) + Kh_here = max(0.,CS%MEKE_Kh) + CS%KhMEKE_Fac * 0.5*(MEKE%Kh(i,j)+MEKE%Kh(i,j+1)) if (associated(MEKE%Kh_diff)) & - Kh_here = max(0.,CS%MEKE_Kh) + & - CS%KhMEKE_Fac*0.5*US%L_to_m**2*US%s_to_T*(MEKE%Kh_diff(i,j)+MEKE%Kh_diff(i,j+1)) - Inv_Kh_max = 2.0*sdt * ((G%dx_Cv(i,J)*G%IdyCv(i,J)) * & - max(US%m_to_L**2*G%IareaT(i,j),US%m_to_L**2*G%IareaT(i,j+1))) + Kh_here = max(0.,CS%MEKE_Kh) + CS%KhMEKE_Fac * 0.5*(MEKE%Kh_diff(i,j)+MEKE%Kh_diff(i,j+1)) + Inv_Kh_max = 2.0*sdt * ((G%dx_Cv(i,J)*G%IdyCv(i,J)) * max(G%IareaT(i,j),G%IareaT(i,j+1))) if (Kh_here*Inv_Kh_max > 0.25) Kh_here = 0.25 / Inv_Kh_max Kh_v(i,J) = Kh_here + ! Here the units of MEKE_uflux and MEKE_vflux are [kg m-2 L4 T-3]. MEKE_vflux(i,J) = ((Kh_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)) ) * & - US%L_T_to_m_s**2*(MEKE%MEKE(i,j) - MEKE%MEKE(i,j+1)) + (MEKE%MEKE(i,j) - MEKE%MEKE(i,j+1)) enddo ; enddo if (CS%MEKE_advection_factor>0.) then - advFac = GV%H_to_m * CS%MEKE_advection_factor / dt + !### I think that for dimensional consistency, this should be: + ! advFac = GV%H_to_kg_m2 * CS%MEKE_advection_factor / (US%s_to_T*dt) + advFac = GV%H_to_m * CS%MEKE_advection_factor / (US%s_to_T*dt) !$OMP parallel do default(shared) do j=js,je ; do I=is-1,ie + ! Here the units of the quantities added to MEKE_uflux and MEKE_vflux are [m L4 T-3]. if (baroHu(I,j)>0.) then - MEKE_uflux(I,j) = MEKE_uflux(I,j) + baroHu(I,j)*US%L_T_to_m_s**2*MEKE%MEKE(i,j)*advFac + MEKE_uflux(I,j) = MEKE_uflux(I,j) + baroHu(I,j)*MEKE%MEKE(i,j)*advFac elseif (baroHu(I,j)<0.) then - MEKE_uflux(I,j) = MEKE_uflux(I,j) + baroHu(I,j)*US%L_T_to_m_s**2*MEKE%MEKE(i+1,j)*advFac + MEKE_uflux(I,j) = MEKE_uflux(I,j) + baroHu(I,j)*MEKE%MEKE(i+1,j)*advFac endif enddo ; enddo !$OMP parallel do default(shared) do J=js-1,je ; do i=is,ie + ! Here the units of the quantities added to MEKE_uflux and MEKE_vflux are [m L4 T-3]. if (baroHv(i,J)>0.) then - MEKE_vflux(i,J) = MEKE_vflux(i,J) + baroHv(i,J)*US%L_T_to_m_s**2*MEKE%MEKE(i,j)*advFac + MEKE_vflux(i,J) = MEKE_vflux(i,J) + baroHv(i,J)*MEKE%MEKE(i,j)*advFac elseif (baroHv(i,J)<0.) then - MEKE_vflux(i,J) = MEKE_vflux(i,J) + baroHv(i,J)*US%L_T_to_m_s**2*MEKE%MEKE(i,j+1)*advFac + MEKE_vflux(i,J) = MEKE_vflux(i,J) + baroHv(i,J)*MEKE%MEKE(i,j+1)*advFac endif enddo ; enddo endif + + !$OMP parallel do default(shared) do j=js,je ; do i=is,ie - MEKE%MEKE(i,j) = MEKE%MEKE(i,j) + US%m_s_to_L_T**2*(sdt*(US%m_to_L**2*G%IareaT(i,j)*I_mass(i,j))) * & + ! This expression is correct if the units of MEKE_uflux and MEKE_vflux are [kg m-2 L4 T-3]. + MEKE%MEKE(i,j) = MEKE%MEKE(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 @@ -498,7 +511,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) + US%m_s_to_L_T**2*del4MEKE(i,j) + MEKE%MEKE(i,j) = MEKE%MEKE(i,j) + del4MEKE(i,j) enddo ; enddo endif @@ -510,15 +523,15 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h if (CS%Jansen15_drag) then !$OMP parallel do default(shared) do j=js,je ; do i=is,ie - ldamping = CS%MEKE_damping + drag_rate(i,j) - MEKE%MEKE(i,j) = MEKE%MEKE(i,j) - US%m_s_to_L_T**2*sdt_damp*drag_rate(i,j) + ldamping = CS%MEKE_damping + drag_rate_J15(i,j) + MEKE%MEKE(i,j) = MEKE%MEKE(i,j) - US%m_to_L**2*US%T_to_s**2*sdt_damp*drag_rate_J15(i,j) MEKE_decay(i,j) = ldamping*G%mask2dT(i,j) enddo ; enddo else !$OMP parallel do default(shared) 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)*US%L_T_to_m_s**2*MEKE%MEKE(i,j)) + CS%MEKE_Uscale**2 ) ) + drag_rate(i,j) = (US%L_to_m*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 !$OMP parallel do default(shared) do j=js,je ; do i=is,ie @@ -564,7 +577,7 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h !$OMP parallel do default(shared) do j=js,je ; do i=is,ie MEKE%Kh(i,j) = CS%MEKE_KhCoeff * & - sqrt(2.*max(0., barotrFac2(i,j)*MEKE%MEKE(i,j))) * US%m_to_L*LmixScale(i,j) + sqrt(2.*max(0., barotrFac2(i,j)*MEKE%MEKE(i,j))) * LmixScale(i,j) enddo ; enddo endif endif @@ -573,13 +586,13 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h ! 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))) * US%m_to_L*LmixScale(i,j) + MEKE%Ku(i,j) = CS%viscosity_coeff_Ku * sqrt(2.*max(0.,MEKE%MEKE(i,j))) * LmixScale(i,j) enddo ; enddo endif 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))) * US%m_to_L**3*LmixScale(i,j)**3 + MEKE%Au(i,j) = CS%viscosity_coeff_Au * sqrt(2.*max(0.,MEKE%MEKE(i,j))) * LmixScale(i,j)**3 enddo ; enddo endif @@ -618,10 +631,6 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h call post_data(CS%id_gamma_t, barotrFac2, CS%diag) endif -! else ! if MEKE%MEKE -! call MOM_error(FATAL, "MOM_MEKE: MEKE%MEKE is not associated!") - endif - end subroutine step_forward_MEKE !> Calculates the equilibrium solutino where the source depends only on MEKE diffusivity @@ -632,17 +641,28 @@ subroutine MEKE_equilibrium(CS, MEKE, G, GV, US, SN_u, SN_v, drag_rate_visc, I_m type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(MEKE_CS), pointer :: CS !< MEKE control structure. - type(MEKE_type), pointer :: MEKE !< MEKE data. + type(MEKE_type), pointer :: MEKE !< A structure with MEKE data. real, dimension(SZIB_(G),SZJ_(G)), intent(in) :: SN_u !< Eady growth rate at u-points [s-1]. real, dimension(SZI_(G),SZJB_(G)), intent(in) :: SN_v !< Eady growth rate at v-points [s-1]. - real, dimension(SZI_(G),SZJ_(G)), intent(in) :: drag_rate_visc !< Mean flow contrib. to drag rate - real, dimension(SZI_(G),SZJ_(G)), intent(in) :: I_mass !< Inverse of column mass. + real, dimension(SZI_(G),SZJ_(G)), intent(in) :: drag_rate_visc !< Mean flow velocity contribution + !! to the MEKE drag rate [L T-1 ~> m s-1] + real, dimension(SZI_(G),SZJ_(G)), intent(in) :: I_mass !< Inverse of column mass [m2 kg-1]. ! Local variables - real :: beta, SN, bottomFac2, barotrFac2, LmixScale, Lrhines, Leady - real :: I_H, KhCoeff, Kh, Ubg2, cd2, drag_rate, ldamping, src - real :: EKE, EKEmin, EKEmax, resid, ResMin, ResMax, EKEerr - real :: FatH ! Coriolis parameter at h points; to compute topographic beta [s-1] - real :: beta_topo_x, beta_topo_y ! Topographic PV gradients in x and y [s-1 m-1] + real :: beta ! Combined topograpic and planetary vorticity gradient [T-1 L-1 ~> s-1 m-1] + real :: SN ! The local Eady growth rate [T-1 ~> s-1] + real :: bottomFac2, barotrFac2 ! Vertical structure factors [nondim] + real :: LmixScale, LRhines, LEady ! Various mixing length scales [L ~> m] + real :: I_H, KhCoeff + real :: Kh ! A lateral diffusivity [L2 T-1 ~> m2 s-1] + real :: Ubg2 ! Background (tidal?) velocity squared [L2 T-2 ~> m2 s-2] + real :: cd2 + real :: drag_rate ! The MEKE spindown timescale due to bottom drag [T-1 ~> s-1]. + real :: src ! The sum of MEKE sources [L2 T-3 ~> W kg-1] + real :: ldamping ! The MEKE damping rate [T-1 ~> s-1]. + real :: EKE, EKEmin, EKEmax, EKEerr ! [L2 T-2 ~> m2 s-2] + real :: resid, ResMin, ResMax ! Residuals [L2 T-3 ~> W kg-1] + real :: FatH ! Coriolis parameter at h points; to compute topographic beta [T-1 ~> s-1] + real :: beta_topo_x, beta_topo_y ! Topographic PV gradients in x and y [T-1 L-1 ~> s-1 m-1] integer :: i, j, is, ie, js, je, n1, n2 real, parameter :: tolerance = 1.e-12 ! Width of EKE bracket [m2 s-2]. logical :: useSecant, debugIteration @@ -656,12 +676,12 @@ subroutine MEKE_equilibrium(CS, MEKE, G, GV, US, SN_u, SN_v, drag_rate_visc, I_m !$OMP do do j=js,je ; do i=is,ie - !SN = 0.25*max( (SN_u(I,j) + SN_u(I-1,j)) + (SN_v(i,J) + SN_v(i,J-1)), 0.) + ! SN = 0.25*max( (SN_u(I,j) + SN_u(I-1,j)) + (SN_v(i,J) + SN_v(i,J-1)), 0.) ! 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)) ) + SN = US%T_to_s * min(SN_u(I,j), SN_u(I-1,j), 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*((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 @@ -670,63 +690,61 @@ subroutine MEKE_equilibrium(CS, MEKE, G, GV, US, SN_u, SN_v, drag_rate_visc, I_m !### 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)) * US%m_to_L*G%IdxCu(I,j) & - /max(G%bathyT(i+1,j),G%bathyT(i,j), GV%H_subroundoff) & - + (G%bathyT(i,j)-G%bathyT(i-1,j)) * US%m_to_L*G%IdxCu(I-1,j) & - /max(G%bathyT(i,j),G%bathyT(i-1,j), GV%H_subroundoff) ) + (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) & + + (G%bathyT(i,j)-G%bathyT(i-1,j)) * G%IdxCu(I-1,j) & + / max(G%bathyT(i,j),G%bathyT(i-1,j), GV%H_subroundoff) ) !### There is a bug in the 4th lne below, where IdxCu should be IdyCv. beta_topo_y = CS%MEKE_topographic_beta * FatH * 0.5 * ( & - (G%bathyT(i,j+1)-G%bathyT(i,j)) * US%m_to_L*G%IdyCv(i,J) & - /max(G%bathyT(i,j+1),G%bathyT(i,j), GV%H_subroundoff) + & - (G%bathyT(i,j)-G%bathyT(i,j-1)) * US%m_to_L*G%IdxCu(i,J-1) & - /max(G%bathyT(i,j),G%bathyT(i,j-1), GV%H_subroundoff) ) + (G%bathyT(i,j+1)-G%bathyT(i,j)) * G%IdyCv(i,J) & + / max(G%bathyT(i,j+1),G%bathyT(i,j), GV%H_subroundoff) + & + (G%bathyT(i,j)-G%bathyT(i,j-1)) * G%IdxCu(i,J-1) & + / max(G%bathyT(i,j),G%bathyT(i,j-1), GV%H_subroundoff) ) endif + beta = sqrt((US%L_to_m*G%dF_dx(i,j) - beta_topo_x)**2 + & + (US%L_to_m*G%dF_dy(i,j) - beta_topo_y)**2 ) - beta = sqrt((US%s_to_T * G%dF_dx(i,j) - beta_topo_x)**2 & - + (US%s_to_T * G%dF_dy(i,j) - beta_topo_y)**2 ) - - I_H = GV%Rho0 * I_mass(i,j) + I_H = US%L_to_m*GV%Rho0 * I_mass(i,j) if (KhCoeff*SN*I_H>0.) then ! Solve resid(E) = 0, where resid = Kh(E) * (SN)^2 - damp_rate(E) E EKEmin = 0. ! Use the trivial root as the left bracket ResMin = 0. ! Need to detect direction of left residual - EKEmax = 0.01 ! First guess at right bracket + EKEmax = 0.01*US%m_s_to_L_T**2 ! First guess at right bracket useSecant = .false. ! Start using a bisection method ! First find right bracket for which resid<0 - resid = 1. ; n1 = 0 + resid = 1.0*US%m_to_L**2*US%T_to_s**3 ; n1 = 0 do while (resid>0.) n1 = n1 + 1 EKE = EKEmax - call MEKE_lengthScales_0d(CS, US%L_to_m**2*G%areaT(i,j), beta, G%bathyT(i,j), & - MEKE%Rd_dx_h(i,j), SN, EKE, US%Z_to_m, & - bottomFac2, barotrFac2, LmixScale, & - Lrhines, Leady) + call MEKE_lengthScales_0d(CS, US, G%areaT(i,j), beta, G%bathyT(i,j), & + MEKE%Rd_dx_h(i,j), SN, EKE, & + bottomFac2, barotrFac2, LmixScale, LRhines, LEady) ! TODO: Should include resolution function in Kh Kh = (KhCoeff * sqrt(2.*barotrFac2*EKE) * LmixScale) src = Kh * (SN * SN) - drag_rate = I_H * sqrt( drag_rate_visc(i,j)**2 + cd2 * ( 2.0*bottomFac2*EKE + Ubg2 ) ) + drag_rate = I_H * sqrt(drag_rate_visc(i,j)**2 + cd2 * ( 2.0*bottomFac2*EKE + Ubg2 ) ) ldamping = CS%MEKE_damping + drag_rate * bottomFac2 resid = src - ldamping * EKE - if (debugIteration) then - write(0,*) n1, 'EKE=',EKE,'resid=',resid - write(0,*) 'EKEmin=',EKEmin,'ResMin=',ResMin - write(0,*) 'src=',src,'ldamping=',ldamping - write(0,*) 'gamma-b=',bottomFac2,'gamma-t=',barotrFac2 - write(0,*) 'drag_visc=',drag_rate_visc(i,j),'Ubg2=',Ubg2 - endif + ! if (debugIteration) then + ! write(0,*) n1, 'EKE=',EKE,'resid=',resid + ! write(0,*) 'EKEmin=',EKEmin,'ResMin=',ResMin + ! write(0,*) 'src=',src,'ldamping=',ldamping + ! write(0,*) 'gamma-b=',bottomFac2,'gamma-t=',barotrFac2 + ! write(0,*) 'drag_visc=',drag_rate_visc(i,j),'Ubg2=',Ubg2 + ! endif if (resid>0.) then ! EKE is to the left of the root EKEmin = EKE ! so we move the left bracket here EKEmax = 10. * EKE ! and guess again for the right bracket if (resid 2.e17) then + if (US%L_T_to_m_s**2*EKEmax > 2.e17) then if (debugIteration) stop 'Something has gone very wrong' debugIteration = .true. resid = 1. ; n1 = 0 EKEmin = 0. ; ResMin = 0. - EKEmax = 0.01 + EKEmax = 0.01*US%m_s_to_L_T**2 useSecant = .false. endif endif @@ -735,7 +753,7 @@ subroutine MEKE_equilibrium(CS, MEKE, G, GV, US, SN_u, SN_v, drag_rate_visc, I_m ! Bisect the bracket n2 = 0 ; EKEerr = EKEmax - EKEmin - do while (EKEerr>tolerance) + do while (US%L_T_to_m_s**2*EKEerr>tolerance) n2 = n2 + 1 if (useSecant) then EKE = EKEmin + (EKEmax - EKEmin) * (ResMin / (ResMin - ResMax)) @@ -749,7 +767,7 @@ subroutine MEKE_equilibrium(CS, MEKE, G, GV, US, SN_u, SN_v, drag_rate_visc, I_m drag_rate = I_H * sqrt( drag_rate_visc(i,j)**2 + cd2 * ( 2.0*bottomFac2*EKE + Ubg2 ) ) ldamping = CS%MEKE_damping + drag_rate * bottomFac2 resid = src - ldamping * EKE - if (useSecant.and.resid>ResMin) useSecant = .false. + if (useSecant .and. resid>ResMin) useSecant = .false. if (resid>0.) then ! EKE is to the left of the root EKEmin = EKE ! so we move the left bracket here if (resid m2 s-2]. real, dimension(SZI_(G),SZJ_(G)), intent(out) :: bottomFac2 !< gamma_b^2 real, dimension(SZI_(G),SZJ_(G)), intent(out) :: barotrFac2 !< gamma_t^2 - real, dimension(SZI_(G),SZJ_(G)), intent(out) :: LmixScale !< Eddy mixing length [m]. + real, dimension(SZI_(G),SZJ_(G)), intent(out) :: LmixScale !< Eddy mixing length [L ~> m]. ! Local variables - real, dimension(SZI_(G),SZJ_(G)) :: Lrhines, Leady - real :: beta, SN - real :: FatH ! Coriolis parameter at h points [s-1] - real :: beta_topo_x, beta_topo_y ! Topographic PV gradients in x and y [s-1 m-1] + real, dimension(SZI_(G),SZJ_(G)) :: LRhines, LEady ! Possible mixing length scales [L ~> m] + real :: beta ! Combined topograpic and planetary vorticity gradient [T-1 L-1 ~> s-1 m-1] + real :: SN ! The local Eady growth rate [T-1 ~> s-1] + real :: FatH ! Coriolis parameter at h points [T-1 ~> s-1] + real :: beta_topo_x, beta_topo_y ! Topographic PV gradients in x and y [T-1 L-1 ~> s-1 m-1] integer :: i, j, is, ie, js, je is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec @@ -802,12 +821,12 @@ subroutine MEKE_lengthScales(CS, MEKE, G, GV, US, SN_u, SN_v, & do j=js,je ; do i=is,ie if (.not.CS%use_old_lscale) then if (CS%aEady > 0.) then - SN = 0.25*( (SN_u(I,j) + SN_u(I-1,j)) + (SN_v(i,J) + SN_v(i,J-1)) ) + SN = 0.25 * US%T_to_s*( (SN_u(I,j) + SN_u(I-1,j)) + (SN_v(i,J) + SN_v(i,J-1)) ) else SN = 0. endif - 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* ( ( 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 ! If bathyT is zero, then a division by zero FPE will be raised. In this ! case, we apply Adcroft's rule of reciprocals and set the term to zero. @@ -818,61 +837,62 @@ subroutine MEKE_lengthScales(CS, MEKE, G, GV, US, SN_u, SN_v, & !### 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)) * US%m_to_L*G%IdxCu(I,j) & - /max(G%bathyT(i+1,j),G%bathyT(i,j), GV%H_subroundoff) & - + (G%bathyT(i,j)-G%bathyT(i-1,j)) * US%m_to_L*G%IdxCu(I-1,j) & - /max(G%bathyT(i,j),G%bathyT(i-1,j), GV%H_subroundoff) ) + (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) & + + (G%bathyT(i,j)-G%bathyT(i-1,j)) * G%IdxCu(I-1,j) & + / max(G%bathyT(i,j),G%bathyT(i-1,j), GV%H_subroundoff) ) !### There is a bug in the 4th lne below, where IdxCu should be IdyCv. beta_topo_y = CS%MEKE_topographic_beta * FatH * 0.5 * ( & - (G%bathyT(i,j+1)-G%bathyT(i,j)) * US%m_to_L*G%IdyCv(i,J) & - /max(G%bathyT(i,j+1),G%bathyT(i,j), GV%H_subroundoff) + & - (G%bathyT(i,j)-G%bathyT(i,j-1)) * US%m_to_L*G%IdxCu(i,J-1) & - /max(G%bathyT(i,j),G%bathyT(i,j-1), GV%H_subroundoff) ) + (G%bathyT(i,j+1)-G%bathyT(i,j)) * G%IdyCv(i,J) & + / max(G%bathyT(i,j+1),G%bathyT(i,j), GV%H_subroundoff) + & + (G%bathyT(i,j)-G%bathyT(i,j-1)) * G%IdxCu(i,J-1) & + / max(G%bathyT(i,j),G%bathyT(i,j-1), GV%H_subroundoff) ) endif - - beta = sqrt((US%s_to_T * G%dF_dx(i,j) - beta_topo_x)**2 & - + (US%s_to_T * G%dF_dy(i,j) - beta_topo_y)**2 ) + beta = sqrt((US%L_to_m*G%dF_dx(i,j) - beta_topo_x)**2 + & + (US%L_to_m*G%dF_dy(i,j) - beta_topo_y)**2 ) else beta = 0. endif ! Returns bottomFac2, barotrFac2 and LmixScale - call MEKE_lengthScales_0d(CS, US%L_to_m**2*G%areaT(i,j), beta, G%bathyT(i,j), & - MEKE%Rd_dx_h(i,j), SN, US%L_T_to_m_s**2*MEKE%MEKE(i,j), US%Z_to_m, & + call MEKE_lengthScales_0d(CS, US, G%areaT(i,j), beta, G%bathyT(i,j), & + MEKE%Rd_dx_h(i,j), SN, MEKE%MEKE(i,j), & bottomFac2(i,j), barotrFac2(i,j), LmixScale(i,j), & - Lrhines(i,j), Leady(i,j)) + LRhines(i,j), LEady(i,j)) enddo ; enddo - if (CS%id_Lrhines>0) call post_data(CS%id_Lrhines, Lrhines, CS%diag) - if (CS%id_Leady>0) call post_data(CS%id_Leady, Leady, CS%diag) + if (CS%id_Lrhines>0) call post_data(CS%id_LRhines, LRhines, CS%diag) + if (CS%id_Leady>0) call post_data(CS%id_LEady, LEady, CS%diag) end subroutine MEKE_lengthScales !> Calculates the eddy mixing length scale and \f$\gamma_b\f$ and \f$\gamma_t\f$ !! functions that are ratios of either bottom or barotropic eddy energy to the !! column eddy energy, respectively. See \ref section_MEKE_equations. -subroutine MEKE_lengthScales_0d(CS, area, beta, depth, Rd_dx, SN, EKE, Z_to_L, & +subroutine MEKE_lengthScales_0d(CS, US, area, beta, depth, Rd_dx, SN, EKE, & ! Z_to_L, & bottomFac2, barotrFac2, LmixScale, Lrhines, Leady) type(MEKE_CS), pointer :: CS !< MEKE control structure. - real, intent(in) :: area !< Grid cell area [m2] - real, intent(in) :: beta !< Planetary beta = |grad F| [s-1 m-1] + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + real, intent(in) :: area !< Grid cell area [L2 ~> m2] + real, intent(in) :: beta !< Planetary beta = |grad F| [T-1 L-1 ~> s-1 m-1] real, intent(in) :: depth !< Ocean depth [Z ~> m] real, intent(in) :: Rd_dx !< Resolution Ld/dx [nondim]. - real, intent(in) :: SN !< Eady growth rate [s-1]. - real, intent(in) :: EKE !< Eddy kinetic energy [m s-1]. - real, intent(in) :: Z_to_L !< A conversion factor from depth units (Z) to - !! the units for lateral distances (L). + real, intent(in) :: SN !< Eady growth rate [T-1 ~> s-1]. + real, intent(in) :: EKE !< Eddy kinetic energy [L2 T-2 ~> m2 s-2]. +! real, intent(in) :: Z_to_L !< A conversion factor from depth units (Z) to +! !! the units for lateral distances (L). real, intent(out) :: bottomFac2 !< gamma_b^2 real, intent(out) :: barotrFac2 !< gamma_t^2 - real, intent(out) :: LmixScale !< Eddy mixing length [m]. - real, intent(out) :: Lrhines !< Rhines length scale [m]. - real, intent(out) :: Leady !< Eady length scale [m]. + real, intent(out) :: LmixScale !< Eddy mixing length [L ~> m]. + real, intent(out) :: Lrhines !< Rhines length scale [L ~> m]. + real, intent(out) :: Leady !< Eady length scale [L ~> m]. ! Local variables - real :: Lgrid, Ldeform, LdeformLim, Ue, Lfrict + real :: Lgrid, Ldeform, Lfrict ! Length scales [L ~> m] + real :: Ue ! An eddy velocity [L T-1 ~> m s-1] ! Length scale for MEKE derived diffusivity Lgrid = sqrt(area) ! Grid scale Ldeform = Lgrid * Rd_dx ! Deformation scale - Lfrict = (Z_to_L * depth) / CS%cdrag ! Frictional arrest scale + Lfrict = (US%Z_to_L * depth) / CS%cdrag ! Frictional arrest scale ! gamma_b^2 is the ratio of bottom eddy energy to mean column eddy energy ! used in calculating bottom drag bottomFac2 = CS%MEKE_CD_SCALE**2 @@ -881,7 +901,7 @@ subroutine MEKE_lengthScales_0d(CS, area, beta, depth, Rd_dx, SN, EKE, Z_to_L, & ! gamma_t^2 is the ratio of barotropic eddy energy to mean column eddy energy ! used in the velocity scale for diffusivity barotrFac2 = 1. - if (Lfrict*CS%MEKE_Ct>0.) barotrFac2 = 1./( 1. + CS%MEKE_Ct*(Ldeform/Lfrict) )**0.25 + if (Lfrict*CS%MEKE_Ct>0.) barotrFac2 = 1. / ( 1. + CS%MEKE_Ct*(Ldeform/Lfrict) )**0.25 barotrFac2 = max(barotrFac2, CS%MEKE_min_gamma) if (CS%use_old_lscale) then if (CS%Rd_as_max_scale) then @@ -891,9 +911,9 @@ subroutine MEKE_lengthScales_0d(CS, area, beta, depth, Rd_dx, SN, EKE, Z_to_L, & endif else Ue = sqrt( 2.0 * max( 0., barotrFac2*EKE ) ) ! Barotropic eddy flow scale - Lrhines = sqrt( Ue / max( beta, 1.e-30 ) ) ! Rhines scale + Lrhines = sqrt( Ue / max( beta, 1.e-30*US%T_to_s*US%L_to_m ) ) ! Rhines scale if (CS%aEady > 0.) then - Leady = Ue / max( SN, 1.e-15 ) ! Bound Eady time-scale < 1e15 seconds + Leady = Ue / max( SN, 1.e-15*US%T_to_s ) ! Bound Eady time-scale < 1e15 seconds else Leady = 0. endif @@ -970,7 +990,7 @@ logical function MEKE_init(Time, G, US, param_file, diag, CS, MEKE, restart_CS) ! Read all relevant parameters and write them to the model log. call get_param(param_file, mdl, "MEKE_DAMPING", CS%MEKE_damping, & "The local depth-independent MEKE dissipation rate.", & - units="s-1", default=0.0) + units="s-1", default=0.0, scale=US%T_to_s) call get_param(param_file, mdl, "MEKE_CD_SCALE", CS%MEKE_Cd_scale, & "The ratio of the bottom eddy velocity to the column mean "//& "eddy velocity, i.e. sqrt(2*MEKE). This should be less than 1 "//& @@ -1005,15 +1025,15 @@ logical function MEKE_init(Time, G, US, param_file, diag, CS, MEKE, restart_CS) "is not used or calculated.", units="nondim", default=-1.0) call get_param(param_file, mdl, "MEKE_BGSRC", CS%MEKE_BGsrc, & "A background energy source for MEKE.", units="W kg-1", & - default=0.0) + default=0.0, scale=US%m_to_L**2*US%T_to_s**3) call get_param(param_file, mdl, "MEKE_KH", CS%MEKE_Kh, & "A background lateral diffusivity of MEKE. "//& "Use a negative value to not apply lateral diffusion to MEKE.", & - units="m2 s-1", default=-1.0) + units="m2 s-1", default=-1.0, scale=US%m_to_L**2*US%T_to_s) call get_param(param_file, mdl, "MEKE_K4", CS%MEKE_K4, & "A lateral bi-harmonic diffusivity of MEKE. "//& "Use a negative value to not apply bi-harmonic diffusion to MEKE.", & - units="m4 s-1", default=-1.0) + units="m4 s-1", default=-1.0, scale=US%m_to_L**4*US%T_to_s) call get_param(param_file, mdl, "MEKE_DTSCALE", CS%MEKE_dtScale, & "A scaling factor to accelerate the time evolution of MEKE.", & units="nondim", default=1.0) @@ -1026,7 +1046,7 @@ logical function MEKE_init(Time, G, US, param_file, diag, CS, MEKE, restart_CS) units="nondim", default=1.0) 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) + "calculate the bottom drag.", units="m s-1", default=0.0, scale=US%m_s_to_L_T) 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.) @@ -1072,7 +1092,7 @@ logical function MEKE_init(Time, G, US, param_file, diag, CS, MEKE, restart_CS) call get_param(param_file, mdl, "MEKE_FIXED_MIXING_LENGTH", CS%Lfixed, & "If positive, is a fixed length contribution to the expression "//& "for mixing length used in MEKE-derived diffusivity.", & - units="m", default=0.0) + units="m", default=0.0, scale=US%m_to_L) call get_param(param_file, mdl, "MEKE_ALPHA_DEFORM", CS%aDeform, & "If positive, is a coefficient weighting the deformation scale "//& "in the expression for mixing length used in MEKE-derived diffusivity.", & @@ -1161,7 +1181,7 @@ logical function MEKE_init(Time, G, US, param_file, diag, CS, MEKE, restart_CS) CS%id_src = register_diag_field('ocean_model', 'MEKE_src', diag%axesT1, Time, & 'MEKE energy source', 'm2 s-3') CS%id_decay = register_diag_field('ocean_model', 'MEKE_decay', diag%axesT1, Time, & - 'MEKE decay rate', 's-1') + 'MEKE decay rate', 's-1', conversion=US%s_to_T) CS%id_GM_src = register_diag_field('ocean_model', 'MEKE_GM_src', diag%axesT1, Time, & 'MEKE energy available from thickness mixing', 'W m-2', conversion=US%L_to_m**2*US%s_to_T**3) if (.not. associated(MEKE%GM_src)) CS%id_GM_src = -1 @@ -1172,11 +1192,11 @@ logical function MEKE_init(Time, G, US, param_file, diag, CS, MEKE, restart_CS) 'MEKE energy lost to GME backscatter', 'W m-2', conversion=US%L_to_m**2*US%s_to_T**3) if (.not. associated(MEKE%GME_snk)) CS%id_GME_snk = -1 CS%id_Le = register_diag_field('ocean_model', 'MEKE_Le', diag%axesT1, Time, & - 'Eddy mixing length used in the MEKE derived eddy diffusivity', 'm') + 'Eddy mixing length used in the MEKE derived eddy diffusivity', 'm', conversion=US%L_to_m) CS%id_Lrhines = register_diag_field('ocean_model', 'MEKE_Lrhines', diag%axesT1, Time, & - 'Rhines length scale used in the MEKE derived eddy diffusivity', 'm') + 'Rhines length scale used in the MEKE derived eddy diffusivity', 'm', conversion=US%L_to_m) CS%id_Leady = register_diag_field('ocean_model', 'MEKE_Leady', diag%axesT1, Time, & - 'Eady length scale used in the MEKE derived eddy diffusivity', 'm') + 'Eady length scale used in the MEKE derived eddy diffusivity', 'm', conversion=US%L_to_m) CS%id_gamma_b = register_diag_field('ocean_model', 'MEKE_gamma_b', diag%axesT1, Time, & 'Ratio of bottom-projected eddy velocity to column-mean eddy velocity', 'nondim') CS%id_gamma_t = register_diag_field('ocean_model', 'MEKE_gamma_t', diag%axesT1, Time, & @@ -1184,9 +1204,9 @@ logical function MEKE_init(Time, G, US, param_file, diag, CS, MEKE, restart_CS) if (CS%kh_flux_enabled) then CS%id_KhMEKE_u = register_diag_field('ocean_model', 'KHMEKE_u', diag%axesCu1, Time, & - 'Zonal diffusivity of MEKE', 'm2 s-1') + 'Zonal diffusivity of MEKE', 'm2 s-1', conversion=US%L_to_m**2*US%s_to_T) CS%id_KhMEKE_v = register_diag_field('ocean_model', 'KHMEKE_v', diag%axesCv1, Time, & - 'Meridional diffusivity of MEKE', 'm2 s-1') + 'Meridional diffusivity of MEKE', 'm2 s-1', conversion=US%L_to_m**2*US%s_to_T) endif CS%id_clock_pass = cpu_clock_id('(Ocean continuity halo updates)', grain=CLOCK_ROUTINE) From 133b03fafa20741990efe52cad076a46be35473d Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Thu, 8 Aug 2019 05:50:41 -0400 Subject: [PATCH 170/297] +Rescaled G%dF_dx & G%dF_dy to units of [T-1 L-1] Rescaled the units of G%dF_dx & G%dF_dy to [T-1 L-1] for more complete dimensional consistency testing. All answers are bitwise identical. --- src/core/MOM_grid.F90 | 4 ++-- src/framework/MOM_dyn_horgrid.F90 | 4 ++-- src/initialization/MOM_fixed_initialization.F90 | 4 ++-- src/initialization/MOM_shared_initialization.F90 | 9 +++++---- src/parameterizations/lateral/MOM_MEKE.F90 | 8 ++++---- src/parameterizations/lateral/MOM_hor_visc.F90 | 4 ++-- .../lateral/MOM_lateral_mixing_coeffs.F90 | 8 ++++---- 7 files changed, 21 insertions(+), 20 deletions(-) diff --git a/src/core/MOM_grid.F90 b/src/core/MOM_grid.F90 index e7048cb2d3..1a2d03bd44 100644 --- a/src/core/MOM_grid.F90 +++ b/src/core/MOM_grid.F90 @@ -152,8 +152,8 @@ module MOM_grid real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEMB_PTR_) :: & CoriolisBu !< The Coriolis parameter at corner points [T-1 ~> s-1]. real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: & - df_dx, & !< Derivative d/dx f (Coriolis parameter) at h-points [T-1 m-1 ~> s-1 m-1]. - df_dy !< Derivative d/dy f (Coriolis parameter) at h-points [T-1 m-1 ~> s-1 m-1]. + df_dx, & !< Derivative d/dx f (Coriolis parameter) at h-points [T-1 L-1 ~> s-1 m-1]. + df_dy !< Derivative d/dy f (Coriolis parameter) at h-points [T-1 L-1 ~> s-1 m-1]. real :: g_Earth !< The gravitational acceleration [m2 Z-1 s-2 ~> m s-2]. ! These variables are global sums that are useful for 1-d diagnostics and should not be rescaled. diff --git a/src/framework/MOM_dyn_horgrid.F90 b/src/framework/MOM_dyn_horgrid.F90 index 1a1e9cbf43..ef74a12c9d 100644 --- a/src/framework/MOM_dyn_horgrid.F90 +++ b/src/framework/MOM_dyn_horgrid.F90 @@ -151,8 +151,8 @@ module MOM_dyn_horgrid real, allocatable, dimension(:,:) :: & CoriolisBu !< The Coriolis parameter at corner points [T-1 ~> s-1]. real, allocatable, dimension(:,:) :: & - df_dx, & !< Derivative d/dx f (Coriolis parameter) at h-points [T-1 m-1 ~> s-1 m-1]. - df_dy !< Derivative d/dy f (Coriolis parameter) at h-points [T-1 m-1 ~> s-1 m-1]. + df_dx, & !< Derivative d/dx f (Coriolis parameter) at h-points [T-1 L-1 ~> s-1 m-1]. + df_dy !< Derivative d/dy f (Coriolis parameter) at h-points [T-1 L-1 ~> s-1 m-1]. ! These variables are global sums that are useful for 1-d diagnostics and should not be rescaled. real :: areaT_global !< Global sum of h-cell area [m2] diff --git a/src/initialization/MOM_fixed_initialization.F90 b/src/initialization/MOM_fixed_initialization.F90 index 0ee72e9bb0..8ed9a0a4c7 100644 --- a/src/initialization/MOM_fixed_initialization.F90 +++ b/src/initialization/MOM_fixed_initialization.F90 @@ -152,8 +152,8 @@ subroutine MOM_initialize_fixed(G, US, OBC, PF, write_geom, output_dir) call MOM_calculate_grad_Coriolis(G%dF_dx, G%dF_dy, G, US=US) if (debug) then call qchksum(G%CoriolisBu, "MOM_initialize_fixed: f ", G%HI, scale=US%s_to_T) - call hchksum(G%dF_dx, "MOM_initialize_fixed: dF_dx ", G%HI, scale=US%s_to_T) - call hchksum(G%dF_dy, "MOM_initialize_fixed: dF_dy ", G%HI, scale=US%s_to_T) + call hchksum(G%dF_dx, "MOM_initialize_fixed: dF_dx ", G%HI, scale=US%m_to_L*US%s_to_T) + call hchksum(G%dF_dy, "MOM_initialize_fixed: dF_dy ", G%HI, scale=US%m_to_L*US%s_to_T) endif call initialize_grid_rotation_angle(G, PF) diff --git a/src/initialization/MOM_shared_initialization.F90 b/src/initialization/MOM_shared_initialization.F90 index 1dac4295b8..3d0fe6f1ed 100644 --- a/src/initialization/MOM_shared_initialization.F90 +++ b/src/initialization/MOM_shared_initialization.F90 @@ -90,9 +90,9 @@ end subroutine MOM_initialize_rotation subroutine MOM_calculate_grad_Coriolis(dF_dx, dF_dy, G, US) type(dyn_horgrid_type), intent(inout) :: G !< The dynamic horizontal grid type real, dimension(G%isd:G%ied,G%jsd:G%jed), & - intent(out) :: dF_dx !< x-component of grad f [T-1 m-1 ~> s-1 m-1] + intent(out) :: dF_dx !< x-component of grad f [T-1 L-1 ~> s-1 m-1] real, dimension(G%isd:G%ied,G%jsd:G%jed), & - intent(out) :: dF_dy !< y-component of grad f [T-1 m-1 ~> s-1 m-1] + intent(out) :: dF_dy !< y-component of grad f [T-1 L-1 ~> s-1 m-1] type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type ! Local variables integer :: i,j @@ -111,12 +111,13 @@ subroutine MOM_calculate_grad_Coriolis(dF_dx, dF_dy, G, US) do j=G%jsc, G%jec ; do i=G%isc, G%iec f1 = 0.5*( G%CoriolisBu(I,J) + G%CoriolisBu(I,J-1) ) f2 = 0.5*( G%CoriolisBu(I-1,J) + G%CoriolisBu(I-1,J-1) ) - dF_dx(i,j) = m_to_L*G%IdxT(i,j) * ( f1 - f2 ) + dF_dx(i,j) = G%IdxT(i,j) * ( f1 - f2 ) f1 = 0.5*( G%CoriolisBu(I,J) + G%CoriolisBu(I-1,J) ) f2 = 0.5*( G%CoriolisBu(I,J-1) + G%CoriolisBu(I-1,J-1) ) - dF_dy(i,j) = m_to_L*G%IdyT(i,j) * ( f1 - f2 ) + dF_dy(i,j) = G%IdyT(i,j) * ( f1 - f2 ) enddo ; enddo call pass_vector(dF_dx, dF_dy, G%Domain, stagger=AGRID) + end subroutine MOM_calculate_grad_Coriolis !> Return the global maximum ocean bottom depth in the same units as the input depth. diff --git a/src/parameterizations/lateral/MOM_MEKE.F90 b/src/parameterizations/lateral/MOM_MEKE.F90 index aa0242b8fc..915290d90a 100644 --- a/src/parameterizations/lateral/MOM_MEKE.F90 +++ b/src/parameterizations/lateral/MOM_MEKE.F90 @@ -701,8 +701,8 @@ subroutine MEKE_equilibrium(CS, MEKE, G, GV, US, SN_u, SN_v, drag_rate_visc, I_m (G%bathyT(i,j)-G%bathyT(i,j-1)) * G%IdxCu(i,J-1) & / max(G%bathyT(i,j),G%bathyT(i,j-1), GV%H_subroundoff) ) endif - beta = sqrt((US%L_to_m*G%dF_dx(i,j) - beta_topo_x)**2 + & - (US%L_to_m*G%dF_dy(i,j) - beta_topo_y)**2 ) + beta = sqrt((G%dF_dx(i,j) - beta_topo_x)**2 + & + (G%dF_dy(i,j) - beta_topo_y)**2 ) I_H = US%L_to_m*GV%Rho0 * I_mass(i,j) @@ -848,8 +848,8 @@ subroutine MEKE_lengthScales(CS, MEKE, G, GV, US, SN_u, SN_v, & (G%bathyT(i,j)-G%bathyT(i,j-1)) * G%IdxCu(i,J-1) & / max(G%bathyT(i,j),G%bathyT(i,j-1), GV%H_subroundoff) ) endif - beta = sqrt((US%L_to_m*G%dF_dx(i,j) - beta_topo_x)**2 + & - (US%L_to_m*G%dF_dy(i,j) - beta_topo_y)**2 ) + beta = sqrt((G%dF_dx(i,j) - beta_topo_x)**2 + & + (G%dF_dy(i,j) - beta_topo_y)**2 ) else beta = 0. diff --git a/src/parameterizations/lateral/MOM_hor_visc.F90 b/src/parameterizations/lateral/MOM_hor_visc.F90 index 65b120c62e..66aa64987a 100644 --- a/src/parameterizations/lateral/MOM_hor_visc.F90 +++ b/src/parameterizations/lateral/MOM_hor_visc.F90 @@ -253,7 +253,7 @@ subroutine horizontal_viscosity(u_in, v_in, h, diffu, diffv, MEKE, VarMix, G, GV FrictWorkIntz, & ! depth integrated energy dissipated by lateral friction [kg m-2 L2 T-3 ~> 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] - ! beta_h, & ! Gradient of planetary vorticity at h-points [m-1 s-1] + ! beta_h, & ! Gradient of planetary vorticity at h-points [L-1 T-1 ~> m-1 s-1] grad_vort_mag_h, & ! Magnitude of vorticity gradient at h-points [L-1 T-1 ~> m-1 s-1] grad_vort_mag_h_2d, & ! Magnitude of 2d vorticity gradient at h-points [L-1 T-1 ~> m-1 s-1] grad_div_mag_h, & ! Magnitude of divergence gradient at h-points [L-1 T-1 ~> m-1 s-1] @@ -277,7 +277,7 @@ subroutine horizontal_viscosity(u_in, v_in, h, diffu, diffv, MEKE, VarMix, G, GV vort_xy, & ! Vertical vorticity (dv/dx - du/dy) including metric terms [T-1 ~> 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] - ! beta_q, & ! Gradient of planetary vorticity at q-points [m-1 s-1] + ! beta_q, & ! Gradient of planetary vorticity at q-points [L-1 T-1 ~> m-1 s-1] grad_vort_mag_q, & ! Magnitude of vorticity gradient at q-points [L-1 T-1 ~> m-1 s-1] grad_vort_mag_q_2d, & ! Magnitude of 2d vorticity gradient at q-points [L-1 T-1 ~> m-1 s-1] grad_div_mag_q, & ! Magnitude of divergence gradient at q-points [L-1 T-1 ~> m-1 s-1] diff --git a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 index 58bc2776e0..00112c3d15 100644 --- a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 +++ b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 @@ -831,8 +831,8 @@ subroutine calc_QG_Leith_viscosity(CS, G, GV, US, h, k, div_xx_dx, div_xx_dy, vo grad_div_mag_u(I,j) = US%m_to_L*US%s_to_T*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 - 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) ) + beta_u(I,j) = US%m_to_L*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 @@ -847,8 +847,8 @@ subroutine calc_QG_Leith_viscosity(CS, G, GV, US, h, k, div_xx_dx, div_xx_dy, vo grad_div_mag_v(i,J) = US%m_to_L*US%s_to_T*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) ) + beta_v(i,J) = US%m_to_L*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 From a7e832c45498ba6ad4699426af197073c32b1ff8 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Thu, 8 Aug 2019 07:57:41 -0400 Subject: [PATCH 171/297] Rescaled variables in MOM_mixedlayer_restrat.F90 Rescaled multiple internal variables in MOM_mixedlayer_restrat.F90 for more complete dimensional consistency testing. All answers are bitwise identical. --- .../lateral/MOM_mixed_layer_restrat.F90 | 207 +++++++++--------- 1 file changed, 106 insertions(+), 101 deletions(-) diff --git a/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 b/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 index 4e1b257c31..37ce9f0b79 100644 --- a/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 +++ b/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 @@ -41,16 +41,16 @@ module MOM_mixed_layer_restrat !! [nondim]. This increases with grid spacing^2, up to something !! of order 500. real :: ml_restrat_coef2 !< As for ml_restrat_coef but using the slow filtered MLD [nondim]. - real :: front_length !< If non-zero, is the frontal-length scale [m] used to calculate the + real :: front_length !< If non-zero, is the frontal-length scale [L ~> m] used to calculate the !! upscaling of buoyancy gradients that is otherwise represented !! by the parameter FOX_KEMPER_ML_RESTRAT_COEF. If MLE_FRONT_LENGTH is !! non-zero, it is recommended to set FOX_KEMPER_ML_RESTRAT_COEF=1.0. logical :: MLE_use_PBL_MLD !< If true, use the MLD provided by the PBL parameterization. !! if false, MLE will calculate a MLD based on a density difference !! based on the parameter MLE_DENSITY_DIFF. - real :: MLE_MLD_decay_time !< Time-scale to use in a running-mean when MLD is retreating [s]. - real :: MLE_MLD_decay_time2 !< Time-scale to use in a running-mean when filtered MLD is retreating [s]. - real :: MLE_density_diff !< Density difference used in detecting mixed-layer depth [kgm-3]. + real :: MLE_MLD_decay_time !< Time-scale to use in a running-mean when MLD is retreating [T ~> s]. + real :: MLE_MLD_decay_time2 !< Time-scale to use in a running-mean when filtered MLD is retreating [T ~> s]. + real :: MLE_density_diff !< Density difference used in detecting mixed-layer depth [kg m-3]. real :: MLE_tail_dh !< Fraction by which to extend the mixed-layer restratification !! depth used for a smoother stream function at the base of !! the mixed-layer [nondim]. @@ -109,15 +109,15 @@ subroutine mixedlayer_restrat(h, uhtr, vhtr, tv, forces, dt, MLD, VarMix, G, GV, "Module must be initialized before it is used.") if (GV%nkml>0) then - call mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, dt, G, GV, US, CS) + call mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, US%s_to_T*dt, G, GV, US, CS) else - call mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD, VarMix, G, GV, US, CS) + call mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, US%s_to_T*dt, MLD, VarMix, G, GV, US, CS) endif end subroutine mixedlayer_restrat !> Calculates a restratifying flow in the mixed layer. -subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, VarMix, G, GV, US, CS) +subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt_in_T, MLD_in, VarMix, G, GV, US, CS) ! Arguments type(ocean_grid_type), intent(inout) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure @@ -129,36 +129,36 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var !! [H L2 ~> m3 or kg] type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamic variables structure type(mech_forcing), intent(in) :: forces !< A structure with the driving mechanical forces - real, intent(in) :: dt !< Time increment [s] + real, intent(in) :: dt_in_T !< Time increment [T ~> s] real, dimension(:,:), pointer :: MLD_in !< Mixed layer depth provided by the !! PBL scheme [m] (not H) type(VarMix_CS), pointer :: VarMix !< Container for derived fields type(mixedlayer_restrat_CS), pointer :: CS !< Module control structure ! Local variables - real :: uhml(SZIB_(G),SZJ_(G),SZK_(G)) ! zonal mixed layer transport [H m2 s-1 ~> m3 s-1 or kg s-1] - real :: vhml(SZI_(G),SZJB_(G),SZK_(G)) ! merid mixed layer transport [H m2 s-1 ~> m3 s-1 or kg s-1] + real :: uhml(SZIB_(G),SZJ_(G),SZK_(G)) ! zonal mixed layer transport [H L2 T-1 ~> m3 s-1 or kg s-1] + real :: vhml(SZI_(G),SZJB_(G),SZK_(G)) ! merid mixed layer transport [H L2 T-1 ~> m3 s-1 or kg s-1] real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: & h_avail ! The volume available for diffusion out of each face of each - ! sublayer of the mixed layer, divided by dt [H m2 s-1 ~> m3 s-1 or kg s-1]. + ! sublayer of the mixed layer, divided by dt [H L2 T-1 ~> m3 s-1 or kg s-1]. real, dimension(SZI_(G),SZJ_(G)) :: & MLD_fast, & ! Mixed layer depth actually used in MLE restratification parameterization [H ~> m or kg m-2] htot_fast, & ! The sum of the thicknesses of layers in the mixed layer [H ~> m or kg m-2] - Rml_av_fast, & ! g_Rho0 times the average mixed layer density [m s-2] + Rml_av_fast, & ! g_Rho0 times the average mixed layer density [L2 Z-1 T-2 ~> m s-2] MLD_slow, & ! Mixed layer depth actually used in MLE restratification parameterization [H ~> m or kg m-2] htot_slow, & ! The sum of the thicknesses of layers in the mixed layer [H ~> m or kg m-2] - Rml_av_slow ! g_Rho0 times the average mixed layer density [m s-2] - real :: g_Rho0 ! G_Earth/Rho0 [m5 Z-1 s-2 kg-1 ~> m4 s-2 kg-1] + Rml_av_slow ! g_Rho0 times the average mixed layer density [L2 Z-1 T-2 ~> m s-2] + real :: g_Rho0 ! G_Earth/Rho0 [m3 L2 Z-1 T-2 kg-1 ~> m4 s-2 kg-1] real :: rho_ml(SZI_(G)) ! Potential density relative to the surface [kg m-3] real :: p0(SZI_(G)) ! A pressure of 0 [Pa] real :: h_vel ! htot interpolated onto velocity points [Z ~> m] (not H). - real :: absf ! absolute value of f, interpolated to velocity points [s-1] - real :: u_star ! surface friction velocity, interpolated to velocity points [Z s-1 ~> m s-1]. - real :: mom_mixrate ! rate at which momentum is homogenized within mixed layer [s-1] - real :: timescale ! mixing growth timescale [s] + real :: absf ! absolute value of f, interpolated to velocity points [T-1 ~> s-1] + real :: u_star ! surface friction velocity, interpolated to velocity points [Z T-1 ~> m s-1]. + real :: mom_mixrate ! rate at which momentum is homogenized within mixed layer [T-1 ~> s-1] + real :: timescale ! mixing growth timescale [T ~> s] real :: h_neglect ! tiny thickness usually lost in roundoff so can be neglected [H ~> m or kg m-2] real :: dz_neglect ! A tiny thickness that is usually lost in roundoff so can be neglected [Z ~> m] - real :: I4dt ! 1/(4 dt) [s-1] + real :: I4dt ! 1/(4 dt) [T-1 ~> s-1] real :: Ihtot,Ihtot_slow! Inverses of the total mixed layer thickness [H-1 ~> m-1 or m2 kg-1] real :: a(SZK_(G)) ! A non-dimensional value relating the overall flux ! magnitudes (uDml & vDml) to the realized flux in a @@ -166,11 +166,11 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var ! the mixed layer must be 0. real :: b(SZK_(G)) ! As for a(k) but for the slow-filtered MLD real :: uDml(SZIB_(G)) ! The zonal and meridional volume fluxes in the upper - real :: vDml(SZI_(G)) ! half of the mixed layer [H m2 s-1 ~> m3 s-1 or kg s-1]. + real :: vDml(SZI_(G)) ! half of the mixed layer [H L2 T-1 ~> m3 s-1 or kg s-1]. real :: uDml_slow(SZIB_(G)) ! The zonal and meridional volume fluxes in the upper - real :: vDml_slow(SZI_(G)) ! half of the mixed layer [H m2 s-1 ~> m3 s-1 or kg s-1]. + real :: vDml_slow(SZI_(G)) ! half of the mixed layer [H L2 T-1 ~> m3 s-1 or kg s-1]. real :: utimescale_diag(SZIB_(G),SZJ_(G)) ! restratification timescales in the zonal and - real :: vtimescale_diag(SZI_(G),SZJB_(G)) ! meridional directions [s], stored in 2-D arrays + real :: vtimescale_diag(SZI_(G),SZJB_(G)) ! meridional directions [T ~> s], stored in 2-D arrays ! for diagnostic purposes. real :: uDml_diag(SZIB_(G),SZJ_(G)), vDml_diag(SZI_(G),SZJB_(G)) integer :: i, j, k, is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz @@ -179,7 +179,8 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var real, dimension(SZI_(G)) :: pRef_MLD ! A reference pressure for calculating the mixed layer densities [Pa]. real, dimension(SZI_(G)) :: rhoAtK, rho1, d1, pRef_N2 ! Used for N2 real :: aFac, bFac, ddRho - real :: hAtVel, zpa, zpb, dh, res_scaling_fac, I_l_f + real :: hAtVel, zpa, zpb, dh, res_scaling_fac + real :: I_LFront ! The inverse of the frontal length scale [L-1 ~> m-1] logical :: proper_averaging, line_is_empty, keep_going, res_upscale real :: PSI, PSI1, z, BOTTOP, XP, DD ! For the following statement functions @@ -246,8 +247,8 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var call hchksum(CS%MLD_filtered,'mixed_layer_restrat: MLD_filtered',G%HI,haloshift=1,scale=GV%H_to_m) call hchksum(MLD_in,'mixed_layer_restrat: MLD in',G%HI,haloshift=1) endif - aFac = CS%MLE_MLD_decay_time / ( dt + CS%MLE_MLD_decay_time ) - bFac = dt / ( dt + CS%MLE_MLD_decay_time ) + aFac = CS%MLE_MLD_decay_time / ( dt_in_T + CS%MLE_MLD_decay_time ) + bFac = dt_in_T / ( dt_in_T + CS%MLE_MLD_decay_time ) do j = js-1, je+1 ; do i = is-1, ie+1 ! Expression bFac*MLD_fast(i,j) + aFac*CS%MLD_filtered(i,j) is the time-filtered ! (running mean) of MLD. The max() allows the "running mean" to be reset @@ -263,8 +264,8 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var call hchksum(CS%MLD_filtered_slow,'mixed_layer_restrat: MLD_filtered_slow',G%HI,haloshift=1,scale=GV%H_to_m) call hchksum(MLD_fast,'mixed_layer_restrat: MLD fast',G%HI,haloshift=1,scale=GV%H_to_m) endif - aFac = CS%MLE_MLD_decay_time2 / ( dt + CS%MLE_MLD_decay_time2 ) - bFac = dt / ( dt + CS%MLE_MLD_decay_time2 ) + aFac = CS%MLE_MLD_decay_time2 / ( dt_in_T + CS%MLE_MLD_decay_time2 ) + bFac = dt_in_T / ( dt_in_T + CS%MLE_MLD_decay_time2 ) do j = js-1, je+1 ; do i = is-1, ie+1 ! Expression bFac*MLD_fast(i,j) + aFac*CS%MLD_filtered(i,j) is the time-filtered ! (running mean) of MLD. The max() allows the "running mean" to be reset @@ -280,14 +281,14 @@ 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*US%L_to_m**2*US%s_to_T**2 / GV%Rho0 + I4dt = 0.25 / (dt_in_T) + g_Rho0 = GV%g_Earth / 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 if (CS%front_length>0.) then res_upscale = .true. - I_l_f = 1./CS%front_length + I_LFront = 1. / CS%front_length else res_upscale = .false. endif @@ -296,7 +297,7 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var !$OMP parallel default(none) shared(is,ie,js,je,G,GV,US,htot_fast,Rml_av_fast,tv,p0,h,h_avail,& !$OMP h_neglect,g_Rho0,I4dt,CS,uhml,uhtr,dt,vhml,vhtr, & !$OMP utimescale_diag,vtimescale_diag,forces,dz_neglect, & -!$OMP htot_slow,MLD_slow,Rml_av_slow,VarMix,I_l_f, & +!$OMP htot_slow,MLD_slow,Rml_av_slow,VarMix,I_LFront, & !$OMP res_upscale, & !$OMP nz,MLD_fast,uDml_diag,vDml_diag,proper_averaging) & !$OMP private(rho_ml,h_vel,u_star,absf,mom_mixrate,timescale, & @@ -312,7 +313,7 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var keep_going = .true. do k=1,nz do i=is-1,ie+1 - h_avail(i,j,k) = max(I4dt*US%L_to_m**2*G%areaT(i,j)*(h(i,j,k)-GV%Angstrom_H),0.0) + h_avail(i,j,k) = max(I4dt*G%areaT(i,j)*(h(i,j,k)-GV%Angstrom_H),0.0) enddo if (keep_going) then call calculate_density(tv%T(:,j,k),tv%S(:,j,k),p0,rho_ml(:),is-1,ie-is+3,tv%eqn_of_state) @@ -343,10 +344,11 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var enddo 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*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) + 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*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*US%L_to_m**2*US%s_to_T**2) endif ! TO DO: @@ -356,11 +358,11 @@ 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 = 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))) + u_star = 0.5*(forces%ustar(i,j) + forces%ustar(i+1,j)) + absf = 0.5*(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 = & - ( sqrt( 0.5 * ( (US%L_to_m*G%dxCu(I,j))**2 + (US%L_to_m*G%dyCu(I,j))**2 ) ) * I_l_f ) & + ( sqrt( 0.5 * ( G%dxCu(I,j)**2 + G%dyCu(I,j)**2 ) ) * I_LFront ) & * min( 1., 0.5*( VarMix%Rd_dx_h(i,j) + VarMix%Rd_dx_h(i+1,j) ) ) ! peak ML visc: u_star * 0.41 * (h_ml*u_star)/(absf*h_ml + 4.0*u_star) @@ -372,8 +374,8 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var timescale = 0.0625 * (absf + 2.0*mom_mixrate) / (absf**2 + mom_mixrate**2) timescale = timescale * CS%ml_restrat_coef if (res_upscale) timescale = timescale * res_scaling_fac - uDml(I) = timescale * G%mask2dCu(I,j)*US%L_to_m*G%dyCu(I,j)* & - US%m_to_L*G%IdxCu(I,j)*(Rml_av_fast(i+1,j)-Rml_av_fast(i,j)) * (h_vel**2 * GV%Z_to_H) + uDml(I) = timescale * G%mask2dCu(I,j)*G%dyCu(I,j)*G%IdxCu(I,j) * & + (Rml_av_fast(i+1,j)-Rml_av_fast(i,j)) * (h_vel**2 * GV%Z_to_H) ! As above but using the slow filtered MLD h_vel = 0.5*((htot_slow(i,j) + htot_slow(i+1,j)) + h_neglect) * GV%H_to_Z mom_mixrate = (0.41*9.8696)*u_star**2 / & @@ -381,8 +383,8 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var timescale = 0.0625 * (absf + 2.0*mom_mixrate) / (absf**2 + mom_mixrate**2) timescale = timescale * CS%ml_restrat_coef2 if (res_upscale) timescale = timescale * res_scaling_fac - uDml_slow(I) = timescale * G%mask2dCu(I,j)*US%L_to_m*G%dyCu(I,j)* & - US%m_to_L*G%IdxCu(I,j)*(Rml_av_slow(i+1,j)-Rml_av_slow(i,j)) * (h_vel**2 * GV%Z_to_H) + uDml_slow(I) = timescale * G%mask2dCu(I,j)*G%dyCu(I,j)*G%IdxCu(I,j) * & + (Rml_av_slow(i+1,j)-Rml_av_slow(i,j)) * (h_vel**2 * GV%Z_to_H) if (uDml(I) + uDml_slow(I) == 0.) then do k=1,nz ; uhml(I,j,k) = 0.0 ; enddo @@ -421,7 +423,7 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var enddo do k=1,nz uhml(I,j,k) = a(k)*uDml(I) + b(k)*uDml_slow(I) - uhtr(I,j,k) = uhtr(I,j,k) + US%m_to_L**2*uhml(I,j,k)*dt + uhtr(I,j,k) = uhtr(I,j,k) + uhml(I,j,k)*dt_in_T enddo endif @@ -432,11 +434,11 @@ 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 = 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))) + u_star = 0.5*(forces%ustar(i,j) + forces%ustar(i,j+1)) + absf = 0.5*(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 = & - ( sqrt( 0.5 * ( (US%L_to_m*G%dxCv(i,J))**2 + (US%L_to_m*G%dyCv(i,J))**2 ) ) * I_l_f ) & + ( sqrt( 0.5 * ( (G%dxCv(i,J))**2 + (G%dyCv(i,J))**2 ) ) * I_LFront ) & * min( 1., 0.5*( VarMix%Rd_dx_h(i,j) + VarMix%Rd_dx_h(i,j+1) ) ) ! peak ML visc: u_star * 0.41 * (h_ml*u_star)/(absf*h_ml + 4.0*u_star) @@ -448,8 +450,8 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var timescale = 0.0625 * (absf + 2.0*mom_mixrate) / (absf**2 + mom_mixrate**2) timescale = timescale * CS%ml_restrat_coef if (res_upscale) timescale = timescale * res_scaling_fac - vDml(i) = timescale * G%mask2dCv(i,J)*US%L_to_m*G%dxCv(i,J)* & - US%m_to_L*G%IdyCv(i,J)*(Rml_av_fast(i,j+1)-Rml_av_fast(i,j)) * (h_vel**2 * GV%Z_to_H) + vDml(i) = timescale * G%mask2dCv(i,J)*G%dxCv(i,J)*G%IdyCv(i,J) * & + (Rml_av_fast(i,j+1)-Rml_av_fast(i,j)) * (h_vel**2 * GV%Z_to_H) ! As above but using the slow filtered MLD h_vel = 0.5*((htot_slow(i,j) + htot_slow(i,j+1)) + h_neglect) * GV%H_to_Z mom_mixrate = (0.41*9.8696)*u_star**2 / & @@ -457,8 +459,8 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var timescale = 0.0625 * (absf + 2.0*mom_mixrate) / (absf**2 + mom_mixrate**2) timescale = timescale * CS%ml_restrat_coef2 if (res_upscale) timescale = timescale * res_scaling_fac - vDml_slow(i) = timescale * G%mask2dCv(i,J)*US%L_to_m*G%dxCv(i,J)* & - US%m_to_L*G%IdyCv(i,J)*(Rml_av_slow(i,j+1)-Rml_av_slow(i,j)) * (h_vel**2 * GV%Z_to_H) + vDml_slow(i) = timescale * G%mask2dCv(i,J)*G%dxCv(i,J)*G%IdyCv(i,J) * & + (Rml_av_slow(i,j+1)-Rml_av_slow(i,j)) * (h_vel**2 * GV%Z_to_H) if (vDml(i) + vDml_slow(i) == 0.) then do k=1,nz ; vhml(i,J,k) = 0.0 ; enddo @@ -497,7 +499,7 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var enddo do k=1,nz vhml(i,J,k) = a(k)*vDml(i) + b(k)*vDml_slow(i) - vhtr(i,J,k) = vhtr(i,J,k) + US%m_to_L**2*vhml(i,J,k)*dt + vhtr(i,J,k) = vhtr(i,J,k) + vhml(i,J,k)*dt_in_T enddo endif @@ -507,7 +509,7 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var !$OMP do do j=js,je ; do k=1,nz ; do i=is,ie - h(i,j,k) = h(i,j,k) - dt*US%m_to_L**2*G%IareaT(i,j) * & + h(i,j,k) = h(i,j,k) - dt_in_T*G%IareaT(i,j) * & ((uhml(I,j,k) - uhml(I-1,j,k)) + (vhml(i,J,k) - vhml(i,J-1,k))) enddo ; enddo ; enddo !$OMP end parallel @@ -526,14 +528,14 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var if (CS%id_uml > 0) then do J=js,je ; do i=is-1,ie h_vel = 0.5*((htot_fast(i,j) + htot_fast(i+1,j)) + h_neglect) - uDml_diag(I,j) = uDml_diag(I,j) / (0.01*h_vel) * US%m_to_L*G%IdyCu(I,j) * (PSI(0.)-PSI(-.01)) + uDml_diag(I,j) = uDml_diag(I,j) / (0.01*h_vel) * G%IdyCu(I,j) * (PSI(0.)-PSI(-.01)) enddo ; enddo call post_data(CS%id_uml, uDml_diag, CS%diag) endif if (CS%id_vml > 0) then do J=js-1,je ; do i=is,ie h_vel = 0.5*((htot_fast(i,j) + htot_fast(i,j+1)) + h_neglect) - vDml_diag(i,J) = vDml_diag(i,J) / (0.01*h_vel) * US%m_to_L*G%IdxCv(i,J) * (PSI(0.)-PSI(-.01)) + vDml_diag(i,J) = vDml_diag(i,J) / (0.01*h_vel) * G%IdxCv(i,J) * (PSI(0.)-PSI(-.01)) enddo ; enddo call post_data(CS%id_vml, vDml_diag, CS%diag) endif @@ -547,7 +549,7 @@ end subroutine mixedlayer_restrat_general !> Calculates a restratifying flow assuming a 2-layer bulk mixed layer. -subroutine mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, dt, G, GV, US, CS) +subroutine mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, dt_in_T, 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(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type @@ -558,29 +560,29 @@ subroutine mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, dt, G, GV, US, CS) !! [H L2 ~> m3 or kg] type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamic variables structure type(mech_forcing), intent(in) :: forces !< A structure with the driving mechanical forces - real, intent(in) :: dt !< Time increment [s] + real, intent(in) :: dt_in_T !< Time increment [T ~> s] type(mixedlayer_restrat_CS), pointer :: CS !< Module control structure ! Local variables - real :: uhml(SZIB_(G),SZJ_(G),SZK_(G)) ! zonal mixed layer transport [H m2 s-1 ~> m3 s-1 or kg s-1] - real :: vhml(SZI_(G),SZJB_(G),SZK_(G)) ! merid mixed layer transport [H m2 s-1 ~> m3 s-1 or kg s-1] + real :: uhml(SZIB_(G),SZJ_(G),SZK_(G)) ! zonal mixed layer transport [H L2 T-1 ~> m3 s-1 or kg s-1] + real :: vhml(SZI_(G),SZJB_(G),SZK_(G)) ! merid mixed layer transport [H L2 T-1 ~> m3 s-1 or kg s-1] real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: & h_avail ! The volume available for diffusion out of each face of each - ! sublayer of the mixed layer, divided by dt [H m2 s-1 ~> m3 s-1 or kg s-1]. + ! sublayer of the mixed layer, divided by dt [H L2 T-1 ~> m3 s-1 or kg s-1]. real, dimension(SZI_(G),SZJ_(G)) :: & htot, & ! The sum of the thicknesses of layers in the mixed layer [H ~> m or kg m-2] - Rml_av ! g_Rho0 times the average mixed layer density [m s-2] - real :: g_Rho0 ! G_Earth/Rho0 [m5 Z-1 s-2 kg-1 ~> m4 s-2 kg-1] + Rml_av ! g_Rho0 times the average mixed layer density [L2 Z-1 T-2 ~> m s-2] + real :: g_Rho0 ! G_Earth/Rho0 [m3 L2 Z-1 T-2 kg-1 ~> m4 s-2 kg-1] real :: Rho0(SZI_(G)) ! Potential density relative to the surface [kg m-3] real :: p0(SZI_(G)) ! A pressure of 0 [Pa] real :: h_vel ! htot interpolated onto velocity points [Z ~> m]. (The units are not H.) - real :: absf ! absolute value of f, interpolated to velocity points [s-1] - real :: u_star ! surface friction velocity, interpolated to velocity points [Z s-1 ~> m s-1]. - real :: mom_mixrate ! rate at which momentum is homogenized within mixed layer [s-1] - real :: timescale ! mixing growth timescale [s] + real :: absf ! absolute value of f, interpolated to velocity points [T-1 ~> s-1] + real :: u_star ! surface friction velocity, interpolated to velocity points [Z T-1 ~> m s-1]. + real :: mom_mixrate ! rate at which momentum is homogenized within mixed layer [T-1 ~> s-1] + real :: timescale ! mixing growth timescale [T ~> s] real :: h_neglect ! tiny thickness usually lost in roundoff and can be neglected [H ~> m or kg m-2] real :: dz_neglect ! tiny thickness that usually lost in roundoff and can be neglected [Z ~> m] - real :: I4dt ! 1/(4 dt) + real :: I4dt ! 1/(4 dt) [T-1 ~> s-1] real :: I2htot ! Twice the total mixed layer thickness at velocity points [H ~> m or kg m-2] real :: z_topx2 ! depth of the top of a layer at velocity points [H ~> m or kg m-2] real :: hx2 ! layer thickness at velocity points [H ~> m or kg m-2] @@ -589,10 +591,10 @@ subroutine mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, dt, G, GV, US, CS) ! layer. The vertical sum of a() through the pieces of ! the mixed layer must be 0. real :: uDml(SZIB_(G)) ! The zonal and meridional volume fluxes in the upper - real :: vDml(SZI_(G)) ! half of the mixed layer [H m2 s-1 ~> m3 s-1 or kg s-1]. + real :: vDml(SZI_(G)) ! half of the mixed layer [H L2 T-1 ~> m3 s-1 or kg s-1]. real :: utimescale_diag(SZIB_(G),SZJ_(G)) ! The restratification timescales real :: vtimescale_diag(SZI_(G),SZJB_(G)) ! in the zonal and meridional - ! directions [s], stored in 2-D + ! directions [T ~> s], stored in 2-D ! arrays for diagnostic purposes. real :: uDml_diag(SZIB_(G),SZJ_(G)), vDml_diag(SZI_(G),SZJB_(G)) logical :: use_EOS ! If true, density is calculated from T & S using an equation of state. @@ -606,8 +608,8 @@ subroutine mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, dt, G, GV, US, CS) if ((nkml<2) .or. (CS%ml_restrat_coef<=0.0)) return uDml(:) = 0.0 ; vDml(:) = 0.0 - I4dt = 0.25 / dt - g_Rho0 = GV%g_Earth*US%L_to_m**2*US%s_to_T**2 / GV%Rho0 + I4dt = 0.25 / (dt_in_T) + g_Rho0 = GV%g_Earth / GV%Rho0 use_EOS = associated(tv%eqn_of_state) h_neglect = GV%H_subroundoff dz_neglect = GV%H_subroundoff*GV%H_to_Z @@ -635,7 +637,7 @@ subroutine mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, dt, G, GV, US, CS) do i=is-1,ie+1 Rml_av(i,j) = Rml_av(i,j) + h(i,j,k)*Rho0(i) htot(i,j) = htot(i,j) + h(i,j,k) - h_avail(i,j,k) = max(I4dt*US%L_to_m**2*G%areaT(i,j)*(h(i,j,k)-GV%Angstrom_H),0.0) + h_avail(i,j,k) = max(I4dt*G%areaT(i,j)*(h(i,j,k)-GV%Angstrom_H),0.0) enddo enddo @@ -653,8 +655,8 @@ 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 = 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))) + u_star = 0.5*(forces%ustar(i,j) + forces%ustar(i+1,j)) + absf = 0.5*(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 ! 0.41 is the von Karmen constant, 9.8696 = pi^2. @@ -663,10 +665,10 @@ subroutine mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, dt, G, GV, US, CS) timescale = 0.0625 * (absf + 2.0*mom_mixrate) / (absf**2 + mom_mixrate**2) timescale = timescale * CS%ml_restrat_coef -! timescale = timescale*(2?)*(L_def/L_MLI)*min(EKE/MKE,1.0 + (US%L_to_m*G%dyCv(i,j))**2/L_def**2)) +! timescale = timescale*(2?)*(L_def/L_MLI) * min(EKE/MKE,1.0 + (G%dyCv(i,j)/L_def)**2) - uDml(I) = timescale * G%mask2dCu(I,j)*US%L_to_m*G%dyCu(I,j)* & - US%m_to_L*G%IdxCu(I,j)*(Rml_av(i+1,j)-Rml_av(i,j)) * (h_vel**2 * GV%Z_to_H) + uDml(I) = timescale * G%mask2dCu(I,j)*G%dyCu(I,j)*G%IdxCu(I,j) * & + (Rml_av(i+1,j)-Rml_av(i,j)) * (h_vel**2 * GV%Z_to_H) if (uDml(I) == 0) then do k=1,nkml ; uhml(I,j,k) = 0.0 ; enddo @@ -687,7 +689,7 @@ subroutine mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, dt, G, GV, US, CS) enddo do k=1,nkml uhml(I,j,k) = a(k)*uDml(I) - uhtr(I,j,k) = uhtr(I,j,k) + US%m_to_L**2*uhml(I,j,k)*dt + uhtr(I,j,k) = uhtr(I,j,k) + uhml(I,j,k)*dt_in_T enddo endif @@ -700,8 +702,8 @@ 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 = 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))) + u_star = 0.5*(forces%ustar(i,j) + forces%ustar(i,j+1)) + absf = 0.5*(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 ! 0.41 is the von Karmen constant, 9.8696 = pi^2. @@ -710,16 +712,16 @@ subroutine mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, dt, G, GV, US, CS) timescale = 0.0625 * (absf + 2.0*mom_mixrate) / (absf**2 + mom_mixrate**2) timescale = timescale * CS%ml_restrat_coef -! timescale = timescale*(2?)*(L_def/L_MLI)*min(EKE/MKE,1.0 + (US%L_to_m*G%dyCv(i,j))**2/L_def**2)) +! timescale = timescale*(2?)*(L_def/L_MLI) * min(EKE/MKE,1.0 + (G%dyCv(i,j)/L_def)**2) - vDml(i) = timescale * G%mask2dCv(i,J)*US%L_to_m*G%dxCv(i,J)* & - US%m_to_L*G%IdyCv(i,J)*(Rml_av(i,j+1)-Rml_av(i,j)) * (h_vel**2 * GV%Z_to_H) + vDml(i) = timescale * G%mask2dCv(i,J)*G%dxCv(i,J)*G%IdyCv(i,J) * & + (Rml_av(i,j+1)-Rml_av(i,j)) * (h_vel**2 * GV%Z_to_H) if (vDml(i) == 0) then do k=1,nkml ; vhml(i,J,k) = 0.0 ; enddo else I2htot = 1.0 / (htot(i,j) + htot(i,j+1) + h_neglect) z_topx2 = 0.0 - ! a(k) relates the sublayer transport to uDml with a linear profile. + ! a(k) relates the sublayer transport to vDml with a linear profile. ! The sum of a(k) through the mixed layers must be 0. do k=1,nkml hx2 = (h(i,j,k) + h(i,j+1,k) + h_neglect) @@ -733,7 +735,7 @@ subroutine mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, dt, G, GV, US, CS) enddo do k=1,nkml vhml(i,J,k) = a(k)*vDml(i) - vhtr(i,J,k) = vhtr(i,J,k) + US%m_to_L**2*vhml(i,J,k)*dt + vhtr(i,J,k) = vhtr(i,J,k) + vhml(i,J,k)*dt_in_T enddo endif @@ -743,7 +745,7 @@ subroutine mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, dt, G, GV, US, CS) !$OMP do do j=js,je ; do k=1,nkml ; do i=is,ie - h(i,j,k) = h(i,j,k) - dt*US%m_to_L**2*G%IareaT(i,j) * & + h(i,j,k) = h(i,j,k) - dt_in_T*G%IareaT(i,j) * & ((uhml(I,j,k) - uhml(I-1,j,k)) + (vhml(i,J,k) - vhml(i,J-1,k))) enddo ; enddo ; enddo !$OMP end parallel @@ -807,12 +809,11 @@ logical function mixedlayer_restrat_init(Time, G, GV, US, param_file, diag, CS, if (.not. mixedlayer_restrat_init) return if (.not.associated(CS)) then - call MOM_error(FATAL, "mixedlayer_restrat_init called without an "// & - "associated control structure.") + call MOM_error(FATAL, "mixedlayer_restrat_init called without an associated control structure.") endif ! Nonsense values to cause problems when these parameters are not used - CS%MLE_MLD_decay_time = -9.e9 + CS%MLE_MLD_decay_time = -9.e9*US%s_to_T CS%MLE_density_diff = -9.e9 CS%MLE_tail_dh = -9.e9 CS%MLE_use_PBL_MLD = .false. @@ -839,7 +840,7 @@ logical function mixedlayer_restrat_init(Time, G, GV, US, param_file, diag, CS, "upscaling of buoyancy gradients that is otherwise represented "//& "by the parameter FOX_KEMPER_ML_RESTRAT_COEF. If MLE_FRONT_LENGTH is "//& "non-zero, it is recommended to set FOX_KEMPER_ML_RESTRAT_COEF=1.0.",& - units="m", default=0.0) + units="m", default=0.0, scale=US%m_to_L) call get_param(param_file, mdl, "MLE_USE_PBL_MLD", CS%MLE_use_PBL_MLD, & "If true, the MLE parameterization will use the mixed-layer "//& "depth provided by the active PBL parameterization. If false, "//& @@ -849,12 +850,12 @@ logical function mixedlayer_restrat_init(Time, G, GV, US, param_file, diag, CS, "The time-scale for a running-mean filter applied to the mixed-layer "//& "depth used in the MLE restratification parameterization. When "//& "the MLD deepens below the current running-mean the running-mean "//& - "is instantaneously set to the current MLD.", units="s", default=0.) + "is instantaneously set to the current MLD.", units="s", default=0., scale=US%s_to_T) call get_param(param_file, mdl, "MLE_MLD_DECAY_TIME2", CS%MLE_MLD_decay_time2, & "The time-scale for a running-mean filter applied to the filtered "//& "mixed-layer depth used in a second MLE restratification parameterization. "//& "When the MLD deepens below the current running-mean the running-mean "//& - "is instantaneously set to the current MLD.", units="s", default=0.) + "is instantaneously set to the current MLD.", units="s", default=0., scale=US%s_to_T) if (.not. CS%MLE_use_PBL_MLD) then call get_param(param_file, mdl, "MLE_DENSITY_DIFF", CS%MLE_density_diff, & "Density difference used to detect the mixed-layer "//& @@ -876,8 +877,8 @@ logical function mixedlayer_restrat_init(Time, G, GV, US, param_file, diag, CS, CS%diag => diag - if (GV%Boussinesq) then ; flux_to_kg_per_s = GV%Rho0 - else ; flux_to_kg_per_s = 1. ; endif + if (GV%Boussinesq) then ; flux_to_kg_per_s = GV%Rho0*US%L_to_m**2*US%s_to_T + else ; flux_to_kg_per_s = US%L_to_m**2*US%s_to_T ; endif CS%id_uhml = register_diag_field('ocean_model', 'uhml', diag%axesCuL, Time, & 'Zonal Thickness Flux to Restratify Mixed Layer', 'kg s-1', conversion=flux_to_kg_per_s, & @@ -886,22 +887,26 @@ logical function mixedlayer_restrat_init(Time, G, GV, US, param_file, diag, CS, 'Meridional Thickness Flux to Restratify Mixed Layer', 'kg s-1', conversion=flux_to_kg_per_s, & x_cell_method='sum', v_extensive=.true.) CS%id_urestrat_time = register_diag_field('ocean_model', 'MLu_restrat_time', diag%axesCu1, Time, & - 'Mixed Layer Zonal Restratification Timescale', 's') + 'Mixed Layer Zonal Restratification Timescale', 's', conversion=US%T_to_s) CS%id_vrestrat_time = register_diag_field('ocean_model', 'MLv_restrat_time', diag%axesCv1, Time, & - 'Mixed Layer Meridional Restratification Timescale', 's') + 'Mixed Layer Meridional Restratification Timescale', 's', conversion=US%T_to_s) CS%id_MLD = register_diag_field('ocean_model', 'MLD_restrat', diag%axesT1, Time, & 'Mixed Layer Depth as used in the mixed-layer restratification parameterization', 'm') CS%id_Rml = register_diag_field('ocean_model', 'ML_buoy_restrat', diag%axesT1, Time, & 'Mixed Layer Buoyancy as used in the mixed-layer restratification parameterization', & - 'm s2', conversion=US%m_to_Z) + 'm s2', conversion=US%m_to_Z*US%L_to_m**2*US%s_to_T**2) CS%id_uDml = register_diag_field('ocean_model', 'udml_restrat', diag%axesCu1, Time, & - 'Transport stream function amplitude for zonal restratification of mixed layer', 'm3 s-1') + 'Transport stream function amplitude for zonal restratification of mixed layer', & + 'm3 s-1', conversion=GV%H_to_m*US%L_to_m**2*US%s_to_T) CS%id_vDml = register_diag_field('ocean_model', 'vdml_restrat', diag%axesCv1, Time, & - 'Transport stream function amplitude for meridional restratification of mixed layer', 'm3 s-1') + 'Transport stream function amplitude for meridional restratification of mixed layer', & + 'm3 s-1', conversion=GV%H_to_m*US%L_to_m**2*US%s_to_T) CS%id_uml = register_diag_field('ocean_model', 'uml_restrat', diag%axesCu1, Time, & - 'Surface zonal velocity component of mixed layer restratification', 'm s-1') + 'Surface zonal velocity component of mixed layer restratification', & + 'm s-1', conversion=US%L_T_to_m_s) CS%id_vml = register_diag_field('ocean_model', 'vml_restrat', diag%axesCv1, Time, & - 'Surface meridional velocity component of mixed layer restratification', 'm s-1') + 'Surface meridional velocity component of mixed layer restratification', & + 'm s-1', conversion=US%L_T_to_m_s) ! Rescale variables from restart files if the internal dimensional scalings have changed. if (CS%MLE_MLD_decay_time>0. .or. CS%MLE_MLD_decay_time2>0.) then From c9f0b2a4324028a61e86f863ddca77a7b37bbe2d Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Thu, 8 Aug 2019 17:02:03 -0400 Subject: [PATCH 172/297] Rescaled variables in MOM_thickness_diffuse.F90 Rescaled multiple internal variables in MOM_thickness_diffuse.F90 for more complete dimensional consistency testing. All answers are bitwise identical. --- .../lateral/MOM_thickness_diffuse.F90 | 481 +++++++++--------- 1 file changed, 246 insertions(+), 235 deletions(-) diff --git a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 index 1878072e52..8fa5beb918 100644 --- a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 +++ b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 @@ -35,14 +35,14 @@ module MOM_thickness_diffuse !> Control structure for thickness diffusion type, public :: thickness_diffuse_CS ; private - real :: Khth !< Background interface depth diffusivity [m2 s-1] + real :: Khth !< Background interface depth diffusivity [L2 T-1 ~> m2 s-1] real :: Khth_Slope_Cff !< Slope dependence coefficient of Khth [m2 s-1] real :: max_Khth_CFL !< Maximum value of the diffusive CFL for thickness diffusion - real :: Khth_Min !< Minimum value of Khth [m2 s-1] - real :: Khth_Max !< Maximum value of Khth [m2 s-1], or 0 for no max + real :: Khth_Min !< Minimum value of Khth [L2 T-1 ~> m2 s-1] + real :: Khth_Max !< Maximum value of Khth [L2 T-1 ~> m2 s-1], or 0 for no max real :: slope_max !< Slopes steeper than slope_max are limited in some way [nondim]. real :: kappa_smooth !< Vertical diffusivity used to interpolate more - !! sensible values of T & S into thin layers [Z2 s-1 ~> m2 s-1]. + !! sensible values of T & S into thin layers [Z2 T-1 ~> m2 s-1]. logical :: thickness_diffuse !< If true, interfaces heights are diffused. logical :: use_FGNV_streamfn !< If true, use the streamfunction formulation of !! Ferrari et al., 2010, which effectively emphasizes @@ -52,12 +52,12 @@ module MOM_thickness_diffuse real :: FGNV_c_min !< A minimum wave speed used in the Ferrari et al., 2010, !! streamfunction formulation [m s-1]. real :: N2_floor !< A floor for Brunt-Vasaila frequency in the Ferrari et al., 2010, - !! streamfunction formulation [s-2]. + !! streamfunction formulation [T-2 ~> s-2]. logical :: detangle_interfaces !< If true, add 3-d structured interface height !! diffusivities to horizontally smooth jagged layers. real :: detangle_time !< If detangle_interfaces is true, this is the !! timescale over which maximally jagged grid-scale - !! thickness variations are suppressed [s]. This must be + !! thickness variations are suppressed [T ~> s]. This must be !! longer than DT, or 0 (the default) to use DT. integer :: nkml !< number of layers within mixed layer logical :: debug !< write verbose checksums for debugging purposes @@ -68,7 +68,7 @@ module MOM_thickness_diffuse real :: MEKE_GEOMETRIC_alpha!< The nondimensional coefficient governing the efficiency of !! the GEOMETRIC thickness difussion [nondim] real :: MEKE_GEOMETRIC_epsilon !< Minimum Eady growth rate for the GEOMETRIC thickness - !! diffusivity [s-1]. + !! diffusivity [T-1 ~> s-1]. logical :: Use_KH_in_MEKE !< If true, uses the thickness diffusivity calculated here to diffuse MEKE. logical :: GM_src_alt !< If true, use the GM energy conversion form S^2*N^2*kappa rather !! than the streamfunction for the GM source term. @@ -78,8 +78,8 @@ module MOM_thickness_diffuse real, pointer :: diagSlopeY(:,:,:) => NULL() !< Diagnostic: zonal neutral slope [nondim] real, dimension(:,:,:), pointer :: & - KH_u_GME => NULL(), & !< interface height diffusivities in u-columns (m2 s-1) - KH_v_GME => NULL() !< interface height diffusivities in v-columns (m2 s-1) + KH_u_GME => NULL(), & !< interface height diffusivities in u-columns [m2 s-1] + KH_v_GME => NULL() !< interface height diffusivities in v-columns [m2 s-1] !>@{ !! Diagnostic identifier @@ -114,40 +114,41 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp ! Local variables real :: e(SZI_(G), SZJ_(G), SZK_(G)+1) ! heights of interfaces, relative to mean ! sea level [Z ~> m], positive up. - real :: uhD(SZIB_(G), SZJ_(G), SZK_(G)) ! Diffusive u*h fluxes [m2 H s-1 ~> m3 s-1 or kg s-1] - real :: vhD(SZI_(G), SZJB_(G), SZK_(G)) ! Diffusive v*h fluxes [m2 H s-1 ~> m3 s-1 or kg s-1] + real :: uhD(SZIB_(G), SZJ_(G), SZK_(G)) ! Diffusive u*h fluxes [L2 H T-1 ~> m3 s-1 or kg s-1] + real :: vhD(SZI_(G), SZJB_(G), SZK_(G)) ! Diffusive v*h fluxes [L2 H T-1 ~> m3 s-1 or kg s-1] real, dimension(SZIB_(G), SZJ_(G), SZK_(G)+1) :: & - KH_u, & ! interface height diffusivities in u-columns [m2 s-1] + KH_u, & ! interface height diffusivities in u-columns [L2 T-1 ~> m2 s-1] int_slope_u ! A nondimensional ratio from 0 to 1 that gives the relative ! weighting of the interface slopes to that calculated also ! using density gradients at u points. The physically correct ! slopes occur at 0, while 1 is used for numerical closures. real, dimension(SZI_(G), SZJB_(G), SZK_(G)+1) :: & - KH_v, & ! interface height diffusivities in v-columns [m2 s-1] + KH_v, & ! interface height diffusivities in v-columns [L2 T-1 ~> m2 s-1] int_slope_v ! A nondimensional ratio from 0 to 1 that gives the relative ! weighting of the interface slopes to that calculated also ! using density gradients at v points. The physically correct ! slopes occur at 0, while 1 is used for numerical closures. real, dimension(SZI_(G), SZJ_(G), SZK_(G)) :: & - KH_t ! diagnosed diffusivity at tracer points [m2 s-1] + KH_t ! diagnosed diffusivity at tracer points [L2 T-1 ~> m2 s-1] real, dimension(SZIB_(G), SZJ_(G)) :: & - KH_u_CFL ! The maximum stable interface height diffusivity at u grid points [m2 s-1] + KH_u_CFL ! The maximum stable interface height diffusivity at u grid points [L2 T-1 ~> m2 s-1] real, dimension(SZI_(G), SZJB_(G)) :: & - KH_v_CFL ! The maximum stable interface height diffusivity at v grid points [m2 s-1] + KH_v_CFL ! The maximum stable interface height diffusivity at v grid points [L2 T-1 ~> m2 s-1] real :: Khth_Loc_u(SZIB_(G), SZJ_(G)) - real :: Khth_Loc(SZIB_(G), SZJB_(G)) ! locally calculated thickness diffusivity [m2 s-1] + real :: Khth_Loc(SZIB_(G), SZJB_(G)) ! locally calculated thickness diffusivity [L2 T-1 ~> m2 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, dimension(:,:), pointer :: cg1 => null() !< Wave speed [m s-1] + real :: dt_in_T ! Time increment [T ~> s] logical :: use_VarMix, Resoln_scaled, use_stored_slopes, khth_use_ebt_struct, use_Visbeck logical :: use_QG_Leith integer :: i, j, k, is, ie, js, je, nz real :: hu(SZI_(G), SZJ_(G)) ! u-thickness [H ~> m or kg m-2] real :: hv(SZI_(G), SZJ_(G)) ! v-thickness [H ~> m or kg m-2] - real :: KH_u_lay(SZI_(G), SZJ_(G)) ! layer ave thickness diffusivities [m2 s-1] - real :: KH_v_lay(SZI_(G), SZJ_(G)) ! layer ave thickness diffusivities [m2 s-1] + real :: KH_u_lay(SZI_(G), SZJ_(G)) ! layer ave thickness diffusivities [L2 T-1 ~> m2 s-1] + real :: KH_v_lay(SZI_(G), SZJ_(G)) ! layer ave thickness diffusivities [L2 T-1 ~> m2 s-1] if (.not. associated(CS)) call MOM_error(FATAL, "MOM_thickness_diffuse:"// & "Module must be initialized before it is used.") @@ -157,6 +158,7 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke h_neglect = GV%H_subroundoff + dt_in_T = US%s_to_T*dt if (associated(MEKE)) then if (associated(MEKE%GM_src)) then @@ -183,12 +185,12 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp !$OMP parallel do default(none) shared(is,ie,js,je,KH_u_CFL,dt,G,CS) do j=js,je ; do I=is-1,ie KH_u_CFL(I,j) = (0.25*CS%max_Khth_CFL) / & - (dt*US%m_to_L**2*(G%IdxCu(I,j)*G%IdxCu(I,j) + G%IdyCu(I,j)*G%IdyCu(I,j))) + (dt_in_T * (G%IdxCu(I,j)*G%IdxCu(I,j) + G%IdyCu(I,j)*G%IdyCu(I,j))) enddo ; enddo !$OMP parallel do default(none) shared(is,ie,js,je,KH_v_CFL,dt,G,CS) do j=js-1,je ; do I=is,ie KH_v_CFL(i,J) = (0.25*CS%max_Khth_CFL) / & - (dt*US%m_to_L**2*(G%IdxCv(i,J)*G%IdxCv(i,J) + G%IdyCv(i,J)*G%IdyCv(i,J))) + (dt_in_T * (G%IdxCv(i,J)*G%IdxCv(i,J) + G%IdyCv(i,J)*G%IdyCv(i,J))) enddo ; enddo ! Calculates interface heights, e, in [Z ~> m]. @@ -201,14 +203,15 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp !$OMP int_slope_v,khth_use_ebt_struct) !$OMP do do j=js,je; do I=is-1,ie - Khth_Loc_u(I,j) = CS%Khth + Khth_loc_u(I,j) = CS%Khth enddo ; enddo if (use_VarMix) then !$OMP do if (use_Visbeck) then do j=js,je ; do I=is-1,ie - Khth_Loc_u(I,j) = Khth_Loc_u(I,j) + CS%KHTH_Slope_Cff*VarMix%L2u(I,j)*VarMix%SN_u(I,j) + Khth_loc_u(I,j) = Khth_loc_u(I,j) + & + CS%KHTH_Slope_Cff*US%m_to_L**2*VarMix%L2u(I,j) * US%T_to_s*VarMix%SN_u(I,j) enddo ; enddo endif endif @@ -217,13 +220,13 @@ 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 * & - US%L_T_to_m_s**2*0.5*(MEKE%MEKE(i,j)+MEKE%MEKE(i+1,j)) / & - (VarMix%SN_u(I,j) + CS%MEKE_GEOMETRIC_epsilon) + 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)) / & + (US%T_to_s*VarMix%SN_u(I,j) + CS%MEKE_GEOMETRIC_epsilon) enddo ; enddo else do j=js,je ; do I=is-1,ie - Khth_Loc_u(I,j) = Khth_Loc_u(I,j) + MEKE%KhTh_fac*US%L_to_m**2*US%s_to_T*sqrt(MEKE%Kh(i,j)*MEKE%Kh(i+1,j)) + Khth_loc_u(I,j) = Khth_loc_u(I,j) + MEKE%KhTh_fac*sqrt(MEKE%Kh(i,j)*MEKE%Kh(i+1,j)) enddo ; enddo endif endif ; endif @@ -231,24 +234,24 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp if (Resoln_scaled) then !$OMP do do j=js,je; do I=is-1,ie - Khth_Loc_u(I,j) = Khth_Loc_u(I,j) * VarMix%Res_fn_u(I,j) + Khth_loc_u(I,j) = Khth_loc_u(I,j) * VarMix%Res_fn_u(I,j) enddo ; enddo endif if (CS%Khth_Max > 0) then !$OMP do do j=js,je; do I=is-1,ie - Khth_Loc_u(I,j) = max(CS%Khth_min, min(Khth_Loc_u(I,j),CS%Khth_Max)) + Khth_loc_u(I,j) = max(CS%Khth_Min, min(Khth_loc_u(I,j), CS%Khth_Max)) enddo ; enddo else !$OMP do do j=js,je; do I=is-1,ie - Khth_Loc_u(I,j) = max(CS%Khth_min, Khth_Loc_u(I,j)) + Khth_loc_u(I,j) = max(CS%Khth_Min, Khth_loc_u(I,j)) enddo ; enddo endif !$OMP do do j=js,je; do I=is-1,ie - KH_u(I,j,1) = min(KH_u_CFL(I,j), Khth_Loc_u(I,j)) + KH_u(I,j,1) = min(KH_u_CFL(I,j), Khth_loc_u(I,j)) enddo ; enddo if (khth_use_ebt_struct) then @@ -267,7 +270,7 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp !$OMP do if (use_QG_Leith) then do k=1,nz ; do j=js,je ; do I=is-1,ie - KH_u(I,j,k) = VarMix%KH_u_QG(I,j,k) + KH_u(I,j,k) = US%m_to_L**2*US%T_to_s*VarMix%KH_u_QG(I,j,k) enddo ; enddo ; enddo endif endif @@ -275,20 +278,20 @@ 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,je ; do I=is-1,ie - CS%KH_u_GME(I,j,k) = KH_u(I,j,k) + CS%KH_u_GME(I,j,k) = US%L_to_m**2*US%s_to_T*KH_u(I,j,k) enddo ; enddo ; enddo endif !$OMP do do J=js-1,je ; do i=is,ie - Khth_Loc(i,j) = CS%Khth + Khth_loc(i,j) = CS%Khth enddo ; enddo if (use_VarMix) then !$OMP do if (use_Visbeck) then do J=js-1,je ; do i=is,ie - Khth_Loc(i,j) = Khth_Loc(i,j) + CS%KHTH_Slope_Cff*VarMix%L2v(i,J)*VarMix%SN_v(i,J) + Khth_loc(i,j) = Khth_loc(i,j) + CS%KHTH_Slope_Cff*US%m_to_L**2*VarMix%L2v(i,J)*US%T_to_s*VarMix%SN_v(i,J) enddo ; enddo endif endif @@ -296,13 +299,13 @@ 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 * & - US%L_T_to_m_s**2*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)) / & + (US%T_to_s*VarMix%SN_v(i,J) + CS%MEKE_GEOMETRIC_epsilon) enddo ; enddo else do J=js-1,je ; do i=is,ie - Khth_Loc(i,j) = Khth_Loc(i,j) + MEKE%KhTh_fac*US%L_to_m**2*US%s_to_T*sqrt(MEKE%Kh(i,j)*MEKE%Kh(i,j+1)) + Khth_loc(i,j) = Khth_loc(i,j) + MEKE%KhTh_fac*sqrt(MEKE%Kh(i,j)*MEKE%Kh(i,j+1)) enddo ; enddo endif endif ; endif @@ -310,26 +313,26 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp if (Resoln_scaled) then !$OMP do do J=js-1,je ; do i=is,ie - Khth_Loc(i,j) = Khth_Loc(i,j) * VarMix%Res_fn_v(i,J) + Khth_loc(i,j) = Khth_loc(i,j) * VarMix%Res_fn_v(i,J) enddo ; enddo endif if (CS%Khth_Max > 0) then !$OMP do do J=js-1,je ; do i=is,ie - Khth_Loc(i,j) = max(CS%Khth_min, min(Khth_Loc(i,j),CS%Khth_Max)) + Khth_loc(i,j) = max(CS%Khth_Min, min(Khth_loc(i,j), CS%Khth_Max)) enddo ; enddo else !$OMP do do J=js-1,je ; do i=is,ie - Khth_Loc(i,j) = max(CS%Khth_min, Khth_Loc(i,j)) + Khth_loc(i,j) = max(CS%Khth_Min, Khth_loc(i,j)) enddo ; enddo endif if (CS%max_Khth_CFL > 0.0) then !$OMP do do J=js-1,je ; do i=is,ie - KH_v(i,J,1) = min(KH_v_CFL(i,J), Khth_Loc(i,j)) + KH_v(i,J,1) = min(KH_v_CFL(i,J), Khth_loc(i,j)) enddo ; enddo endif @@ -349,7 +352,7 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp !$OMP do if (use_QG_Leith) then do k=1,nz ; do J=js-1,je ; do i=is,ie - KH_v(i,J,k) = VarMix%KH_v_QG(i,J,k) + KH_v(i,J,k) = US%m_to_L**2*US%T_to_s*VarMix%KH_v_QG(i,J,k) enddo ; enddo ; enddo endif endif @@ -357,7 +360,7 @@ 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) + CS%KH_v_GME(i,J,k) = US%L_to_m**2*US%s_to_T*KH_v(i,J,k) enddo ; enddo ; enddo endif @@ -365,8 +368,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,je ; do I=is,ie - MEKE%Kh(i,j) = CS%MEKE_GEOMETRIC_alpha * US%s_to_T*MEKE%MEKE(i,j) / & - (0.25*(VarMix%SN_u(I,j)+VarMix%SN_u(I-1,j)+VarMix%SN_v(i,J)+VarMix%SN_v(i,J-1)) + & + !### This will not give bitwise rotational symmetry. Add parentheses. + MEKE%Kh(i,j) = CS%MEKE_GEOMETRIC_alpha * MEKE%MEKE(i,j) / & + (0.25*US%T_to_s*(VarMix%SN_u(I,j)+VarMix%SN_u(I-1,j)+VarMix%SN_v(i,J)+VarMix%SN_v(i,J-1)) + & CS%MEKE_GEOMETRIC_epsilon) enddo ; enddo endif @@ -380,12 +384,12 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp !$OMP end parallel if (CS%detangle_interfaces) then - call add_detangling_Kh(h, e, Kh_u, Kh_v, KH_u_CFL, KH_v_CFL, tv, dt, G, GV, US, & + call add_detangling_Kh(h, e, Kh_u, Kh_v, KH_u_CFL, KH_v_CFL, tv, dt_in_T, G, GV, US, & CS, int_slope_u, int_slope_v) endif if (CS%debug) then - call uvchksum("Kh_[uv]", Kh_u, Kh_v, G%HI,haloshift=0) + call uvchksum("Kh_[uv]", Kh_u, Kh_v, G%HI, haloshift=0, scale=US%L_to_m**2*US%s_to_T) call uvchksum("int_slope_[uv]", int_slope_u, int_slope_v, G%HI, haloshift=0) call hchksum(h, "thickness_diffuse_1 h", G%HI, haloshift=1, scale=GV%H_to_m) call hchksum(e, "thickness_diffuse_1 e", G%HI, haloshift=1, scale=US%Z_to_m) @@ -401,10 +405,10 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp ! Calculate uhD, vhD from h, e, KH_u, KH_v, tv%T/S if (use_stored_slopes) then - call thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV, US, MEKE, CS, & + call thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt_in_T, G, GV, US, MEKE, CS, & int_slope_u, int_slope_v, VarMix%slope_x, VarMix%slope_y) else - call thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV, US, MEKE, CS, & + call thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt_in_T, G, GV, US, MEKE, CS, & int_slope_u, int_slope_v) endif @@ -448,7 +452,7 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp enddo ; enddo ! diagnose diffusivity at T-point do j=js,je ; do i=is,ie - KH_t(i,j,k) = ((hu(I-1,j)*KH_u_lay(i-1,j)+hu(I,j)*KH_u_lay(I,j)) & + Kh_t(i,j,k) = ((hu(I-1,j)*KH_u_lay(i-1,j)+hu(I,j)*KH_u_lay(I,j)) & +(hv(i,J-1)*KH_v_lay(i,J-1)+hv(i,J)*KH_v_lay(i,J))) & / (hu(I-1,j)+hu(I,j)+hv(i,J-1)+hv(i,J)+h_neglect) enddo ; enddo @@ -458,7 +462,7 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp MEKE%Kh_diff(:,:) = 0.0 do k=1,nz do j=js,je ; do i=is,ie - MEKE%Kh_diff(i,j) = MEKE%Kh_diff(i,j) + US%m_to_L**2*US%T_to_s*KH_t(i,j,k) * h(i,j,k) + MEKE%Kh_diff(i,j) = MEKE%Kh_diff(i,j) + Kh_t(i,j,k) * h(i,j,k) enddo; enddo enddo @@ -476,15 +480,15 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp !$OMP parallel do default(none) shared(is,ie,js,je,nz,uhtr,uhD,dt,vhtr,CDp,vhD,h,G,GV) do k=1,nz do j=js,je ; do I=is-1,ie - uhtr(I,j,k) = uhtr(I,j,k) + US%m_to_L**2*uhD(I,j,k)*dt - if (associated(CDp%uhGM)) CDp%uhGM(I,j,k) = uhD(I,j,k) + uhtr(I,j,k) = uhtr(I,j,k) + uhD(I,j,k) * dt_in_T + if (associated(CDp%uhGM)) CDp%uhGM(I,j,k) = US%L_to_m**2*US%s_to_T*uhD(I,j,k) enddo ; enddo do J=js-1,je ; do i=is,ie - vhtr(i,J,k) = vhtr(i,J,k) + US%m_to_L**2*vhD(i,J,k)*dt - if (associated(CDp%vhGM)) CDp%vhGM(i,J,k) = vhD(i,J,k) + vhtr(i,J,k) = vhtr(i,J,k) + vhD(i,J,k) * dt_in_T + if (associated(CDp%vhGM)) CDp%vhGM(i,J,k) = US%L_to_m**2*US%s_to_T*vhD(i,J,k) enddo ; enddo do j=js,je ; do i=is,ie - h(i,j,k) = h(i,j,k) - dt * US%m_to_L**2*G%IareaT(i,j) * & + h(i,j,k) = h(i,j,k) - dt_in_T * G%IareaT(i,j) * & ((uhD(I,j,k) - uhD(I-1,j,k)) + (vhD(i,J,k) - vhD(i,J-1,k))) if (h(i,j,k) < GV%Angstrom_H) h(i,j,k) = GV%Angstrom_H enddo ; enddo @@ -497,7 +501,7 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp if (CS%debug) then call uvchksum("thickness_diffuse [uv]hD", uhD, vhD, & - G%HI, haloshift=0, scale=GV%H_to_m) + G%HI, haloshift=0, scale=GV%H_to_m*US%L_to_m**2*US%s_to_T) call uvchksum("thickness_diffuse [uv]htr", uhtr, vhtr, & G%HI, haloshift=0, scale=US%L_to_m**2*GV%H_to_m) call hchksum(h, "thickness_diffuse h", G%HI, haloshift=0, scale=GV%H_to_m) @@ -508,7 +512,7 @@ end subroutine thickness_diffuse !> Calculates parameterized layer transports for use in the continuity equation. !! Fluxes are limited to give positive definite thicknesses. !! Called by thickness_diffuse(). -subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV, US, MEKE, & +subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt_in_T, G, GV, US, MEKE, & CS, int_slope_u, int_slope_v, slope_x, slope_y) type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure @@ -516,16 +520,16 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV 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)+1), intent(in) :: e !< Interface positions [Z ~> m] real, dimension(SZIB_(G),SZJ_(G),SZK_(G)+1), intent(in) :: Kh_u !< Thickness diffusivity on interfaces - !! at u points [m2 s-1] + !! at u points [L2 T-1 ~> m2 s-1] real, dimension(SZI_(G),SZJB_(G),SZK_(G)+1), intent(in) :: Kh_v !< Thickness diffusivity on interfaces !! at v points [m2 s-1] type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamics structure real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(out) :: uhD !< Zonal mass fluxes - !! [H m2 s-1 ~> m3 s-1 or kg s-1] + !! [H L2 T-1 ~> m3 s-1 or kg s-1] real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(out) :: vhD !< Meridional mass fluxes - !! [H m2 s-1 ~> m3 s-1 or kg s-1] + !! [H L2 T-1 ~> m3 s-1 or kg s-1] real, dimension(:,:), pointer :: cg1 !< Wave speed [m s-1] - real, intent(in) :: dt !< Time increment [s] + real, intent(in) :: dt_in_T !< Time increment [T ~> s] 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 @@ -547,28 +551,28 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV Rho, & ! Density itself [kg m-3], when a nonlinear equation of state is ! not in use. h_avail, & ! The mass available for diffusion out of each face, divided - ! by dt [H m2 s-1 ~> m3 s-1 or kg s-1]. + ! by dt [H L2 T-1 ~> m3 s-1 or kg s-1]. h_frac ! The fraction of the mass in the column above the bottom ! interface of a layer that is within a layer [nondim]. 0 m s-2], ! used for calculating PE release real, dimension(SZIB_(G), SZJ_(G), SZK_(G)+1) :: & Slope_x_PE, & ! 3D array of neutral slopes at u-points, set equal to Slope (below, nondim) - hN2_x_PE ! thickness in m times Brunt-Vaisala freqeuncy at u-points [m s-2] + hN2_x_PE ! thickness in m times Brunt-Vaisala freqeuncy at u-points [L2 Z-1 T-2 ~> m s-2], ! used for calculating PE release real, dimension(SZI_(G), SZJ_(G), SZK_(G)+1) :: & pres, & ! The pressure at an interface [Pa]. - h_avail_rsum ! The running sum of h_avail above an interface [H m2 s-1 ~> m3 s-1 or kg s-1]. + h_avail_rsum ! The running sum of h_avail above an interface [H L2 T-1 ~> m3 s-1 or kg s-1]. real, dimension(SZIB_(G)) :: & drho_dT_u, & ! The derivative of density with temperature at u points [kg m-3 degC-1] drho_dS_u ! The derivative of density with salinity at u points [kg m-3 ppt-1]. real, dimension(SZI_(G)) :: & drho_dT_v, & ! The derivative of density with temperature at v points [kg m-3 degC-1] drho_dS_v ! The derivative of density with salinity at v points [kg m-3 ppt-1]. - real :: uhtot(SZIB_(G), SZJ_(G)) ! The vertical sum of uhD [H m2 s-1 ~> m3 s-1 or kg s-1]. - real :: vhtot(SZI_(G), SZJB_(G)) ! The vertical sum of vhD [H m2 s-1 ~> m3 s-1 or kg s-1]. + real :: uhtot(SZIB_(G), SZJ_(G)) ! The vertical sum of uhD [H L2 T-1 ~> m3 s-1 or kg s-1]. + real :: vhtot(SZI_(G), SZJB_(G)) ! The vertical sum of vhD [H L2 T-1 ~> m3 s-1 or kg s-1]. real, dimension(SZIB_(G)) :: & T_u, & ! Temperature on the interface at the u-point [degC]. S_u, & ! Salinity on the interface at the u-point [ppt]. @@ -580,9 +584,9 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV real :: Work_u(SZIB_(G), SZJ_(G)) ! The work being done by the thickness real :: Work_v(SZI_(G), SZJB_(G)) ! diffusion integrated over a cell [W]. real :: Work_h ! The work averaged over an h-cell [W m-2]. - real :: PE_release_h ! The amount of potential energy released by GM, averaged over an h-cell [m3 s-3]. + real :: PE_release_h ! The amount of potential energy released by GM averaged over an h-cell [L4 Z-1 T-3 ~> m3 s-3] ! The calculation is equal to h * S^2 * N^2 * kappa_GM. - real :: I4dt ! 1 / 4 dt [s-1]. + real :: I4dt ! 1 / 4 dt [T-1 ~> s-1]. real :: drdiA, drdiB ! Along layer zonal- and meridional- potential density real :: drdjA, drdjB ! gradients in the layers above (A) and below(B) the ! interface times the grid spacing [kg m-3]. @@ -597,26 +601,26 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV real :: haA, haB, haL, haR ! Arithmetic mean thicknesses [H ~> m or kg m-2]. real :: dzaL, dzaR ! Temporary thicknesses [Z ~> m]. real :: wtA, wtB, wtL, wtR ! Unscaled weights, with various units. - real :: drdx, drdy ! Zonal and meridional density gradients [kg m-4]. + real :: drdx, drdy ! Zonal and meridional density gradients [kg m-3 L-1 ~> kg m-4]. real :: drdz ! Vertical density gradient [kg m-3 Z-1 ~> kg m-4]. real :: h_harm ! Harmonic mean layer thickness [H ~> m or kg m-2]. - real :: c2_h_u(SZIB_(G), SZK_(G)+1) ! Wave speed squared divided by h at u-points [m2 Z-1 s-2 ~> m s-2]. - real :: c2_h_v(SZI_(G), SZK_(G)+1) ! Wave speed squared divided by h at v-points [m2 Z-1 s-2 ~> m s-2]. - real :: hN2_u(SZIB_(G), SZK_(G)+1) ! Thickness in m times N2 at interfaces above u-points [m2 Z-1 s-2 ~> m s-2]. - real :: hN2_v(SZI_(G), SZK_(G)+1) ! Thickness in m times N2 at interfaces above v-points [m2 Z-1 s-2 ~> m s-2]. + real :: c2_h_u(SZIB_(G), SZK_(G)+1) ! Wave speed squared divided by h at u-points [L2 Z-1 T-2 ~> m s-2]. + real :: c2_h_v(SZI_(G), SZK_(G)+1) ! Wave speed squared divided by h at v-points [L2 Z-1 T-2 ~> m s-2]. + real :: hN2_u(SZIB_(G), SZK_(G)+1) ! Thickness in m times N2 at interfaces above u-points [L2 Z-1 T-2 ~> m s-2]. + real :: hN2_v(SZI_(G), SZK_(G)+1) ! Thickness in m times N2 at interfaces above v-points [L2 Z-1 T-2 ~> m s-2]. real :: Sfn_est ! A preliminary estimate (before limiting) of the overturning - ! streamfunction [Z m2 s-1 ~> m3 s-1]. - real :: Sfn_unlim_u(SZIB_(G), SZK_(G)+1) ! Streamfunction for u-points [Z m2 s-1 ~> m3 s-1]. - real :: Sfn_unlim_v(SZI_(G), SZK_(G)+1) ! Streamfunction for v-points [Z m2 s-1 ~> m3 s-1]. + ! streamfunction [Z L2 T-1 ~> m3 s-1]. + real :: Sfn_unlim_u(SZIB_(G), SZK_(G)+1) ! Streamfunction for u-points [Z L2 T-1 ~> m3 s-1]. + real :: Sfn_unlim_v(SZI_(G), SZK_(G)+1) ! Streamfunction for v-points [Z L2 T-1 ~> m3 s-1]. real :: slope2_Ratio_u(SZIB_(G), SZK_(G)+1) ! The ratio of the slope squared to slope_max squared. real :: slope2_Ratio_v(SZI_(G), SZK_(G)+1) ! The ratio of the slope squared to slope_max squared. - real :: Sfn_in_h ! The overturning streamfunction [H m2 s-1 ~> m3 s-1 or kg s-1] (note that + real :: Sfn_in_h ! The overturning streamfunction [H L2 T-1 ~> m3 s-1 or kg s-1] (note that ! the units are different from other Sfn vars). real :: Sfn_safe ! The streamfunction that goes linearly back to 0 at the surface. This is a - ! good thing to use when the slope is so large as to be meaningless [Z m2 s-1 ~> m3 s-1]. + ! good thing to use when the slope is so large as to be meaningless [Z L2 T-1 ~> m3 s-1]. real :: Slope ! The slope of density surfaces, calculated in a way ! that is always between -1 and 1, nondimensional. - real :: mag_grad2 ! The squared magnitude of the 3-d density gradient [kg2 m-8]. + real :: mag_grad2 ! The squared magnitude of the 3-d density gradient [kg2 m-6 L-2 ~> kg2 m-8]. real :: I_slope_max2 ! The inverse of slope_max squared, nondimensional. 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]. @@ -624,14 +628,14 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV real :: dz_neglect ! A thickness [Z ~> m], that is so small it is usually lost ! in roundoff and can be neglected [Z ~> m]. real :: G_scale ! The gravitational acceleration times some unit conversion - ! factors [m3 Z-1 H-1 s-2 ~> m s-2 or m4 kg-1 s-2]. + ! factors [m3 T Z-1 H-1 s-3 ~> m s-2 or m4 kg-1 s-2]. logical :: use_EOS ! If true, density is calculated from T & S using an ! equation of state. logical :: find_work ! If true, find the change in energy due to the fluxes. integer :: nk_linear ! The number of layers over which the streamfunction goes to 0. - real :: G_rho0 ! g/Rho0 [m5 Z-1 s-2 ~> m4 s-2]. + real :: G_rho0 ! g/Rho0 [L2 m3 Z-1 T-2 ~> m4 s-2]. real :: N2_floor ! A floor for N2 to avoid degeneracy in the elliptic solver - ! times unit conversion factors [s-2 m2 Z-2 ~> s-2] + ! times unit conversion factors [T-2 L2 Z-2 ~> s-2] real, dimension(SZIB_(G), SZJ_(G), SZK_(G)+1) :: diag_sfn_x, diag_sfn_unlim_x ! Diagnostics real, dimension(SZI_(G), SZJB_(G), SZK_(G)+1) :: diag_sfn_y, diag_sfn_unlim_y ! Diagnostics logical :: present_int_slope_u, present_int_slope_v @@ -640,13 +644,13 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV integer :: i, j, k is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke ; IsdB = G%IsdB - I4dt = 0.25 / dt + I4dt = 0.25 / (dt_in_T) I_slope_max2 = 1.0 / (CS%slope_max**2) - G_scale = GV%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**3 * 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*US%L_to_m**2*US%s_to_T**2 / GV%Rho0 - N2_floor = CS%N2_floor*US%Z_to_m**2 + G_rho0 = GV%g_Earth / GV%Rho0 + N2_floor = CS%N2_floor*US%Z_to_L**2 use_EOS = associated(tv%eqn_of_state) present_int_slope_u = PRESENT(int_slope_u) @@ -666,7 +670,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, larger_h_denom=.true.) + call vert_fill_TS(h, tv%T, tv%S, CS%kappa_smooth*dt_in_T, T, S, G, GV, 1, larger_h_denom=.true.) endif if (CS%use_FGNV_streamfn .and. .not. associated(cg1)) call MOM_error(FATAL, & @@ -681,7 +685,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV h_avail_rsum(i,j,1) = 0.0 pres(i,j,1) = 0.0 ! ### This should be atmospheric pressure. - h_avail(i,j,1) = max(I4dt*US%L_to_m**2*G%areaT(i,j)*(h(i,j,1)-GV%Angstrom_H),0.0) + h_avail(i,j,1) = max(I4dt*G%areaT(i,j)*(h(i,j,1)-GV%Angstrom_H),0.0) h_avail_rsum(i,j,2) = h_avail(i,j,1) h_frac(i,j,1) = 1.0 pres(i,j,2) = pres(i,j,1) + GV%H_to_Pa*h(i,j,1) @@ -689,7 +693,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV !$OMP do do j=js-1,je+1 do k=2,nz ; do i=is-1,ie+1 - h_avail(i,j,k) = max(I4dt*US%L_to_m**2*G%areaT(i,j)*(h(i,j,k)-GV%Angstrom_H),0.0) + h_avail(i,j,k) = max(I4dt*G%areaT(i,j)*(h(i,j,k)-GV%Angstrom_H),0.0) h_avail_rsum(i,j,k+1) = h_avail_rsum(i,j,k) + h_avail(i,j,k) h_frac(i,j,k) = 0.0 ; if (h_avail(i,j,k) > 0.0) & h_frac(i,j,k) = h_avail(i,j,k) / h_avail_rsum(i,j,k+1) @@ -804,11 +808,11 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV wtA = hg2A*haB ; wtB = hg2B*haA ! This is the gradient of density along geopotentials. drdx = ((wtA * drdiA + wtB * drdiB) / (wtA + wtB) - & - drdz * (e(i,j,K)-e(i+1,j,K))) * US%m_to_L*G%IdxCu(I,j) + drdz * (e(i,j,K)-e(i+1,j,K))) * G%IdxCu(I,j) ! This estimate of slope is accurate for small slopes, but bounded ! to be between -1 and 1. - mag_grad2 = drdx**2 + (US%m_to_Z*drdz)**2 + mag_grad2 = drdx**2 + (US%L_to_Z*drdz)**2 if (mag_grad2 > 0.0) then Slope = drdx / sqrt(mag_grad2) slope2_Ratio_u(I,K) = Slope**2 * I_slope_max2 @@ -822,16 +826,16 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV ! that ignore density gradients along layers. if (present_int_slope_u) then Slope = (1.0 - int_slope_u(I,j,K)) * Slope + & - int_slope_u(I,j,K) * US%Z_to_m*((e(i+1,j,K)-e(i,j,K)) * US%m_to_L*G%IdxCu(I,j)) + int_slope_u(I,j,K) * US%Z_to_L*((e(i+1,j,K)-e(i,j,K)) * G%IdxCu(I,j)) slope2_Ratio_u(I,K) = (1.0 - int_slope_u(I,j,K)) * slope2_Ratio_u(I,K) endif Slope_x_PE(I,j,k) = MIN(Slope,CS%slope_max) - hN2_x_PE(I,j,k) = hN2_u(I,K) * US%m_to_Z + hN2_x_PE(I,j,k) = hN2_u(I,K) if (CS%id_slope_x > 0) CS%diagSlopeX(I,j,k) = Slope ! Estimate the streamfunction at each interface [m3 s-1]. - Sfn_unlim_u(I,K) = -((KH_u(I,j,K)*US%L_to_m*G%dy_Cu(I,j))*US%m_to_Z*Slope) + Sfn_unlim_u(I,K) = -((KH_u(I,j,K)*G%dy_Cu(I,j))*US%L_to_Z*Slope) ! Avoid moving dense water upslope from below the level of ! the bottom on the receiving side. @@ -857,11 +861,11 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV if (present_slope_x) then Slope = slope_x(I,j,k) else - Slope = US%Z_to_m*((e(i,j,K)-e(i+1,j,K))*US%m_to_L*G%IdxCu(I,j)) * G%mask2dCu(I,j) + Slope = US%Z_to_L*((e(i,j,K)-e(i+1,j,K))*G%IdxCu(I,j)) * G%mask2dCu(I,j) endif if (CS%id_slope_x > 0) CS%diagSlopeX(I,j,k) = Slope - Sfn_unlim_u(I,K) = ((KH_u(I,j,K)*US%L_to_m*G%dy_Cu(I,j))*US%m_to_Z*Slope) - hN2_u(I,K) = US%L_to_m**2*US%s_to_T**2*GV%g_prime(K) + Sfn_unlim_u(I,K) = ((KH_u(I,j,K)*G%dy_Cu(I,j))*US%L_to_Z*Slope) + hN2_u(I,K) = GV%g_prime(K) endif ! if (use_EOS) else ! if (k > nk_linear) hN2_u(I,K) = N2_floor * dz_neglect @@ -875,7 +879,8 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV do k=1,nz ; do I=is-1,ie ; if (G%mask2dCu(I,j)>0.) then h_harm = max( h_neglect, & 2. * h(i,j,k) * h(i+1,j,k) / ( ( h(i,j,k) + h(i+1,j,k) ) + h_neglect ) ) - c2_h_u(I,k) = CS%FGNV_scale * ( 0.5*( cg1(i,j) + cg1(i+1,j) ) )**2 / (GV%H_to_Z*h_harm) + c2_h_u(I,k) = CS%FGNV_scale * & + ( 0.5*US%m_s_to_L_T*( cg1(i,j) + cg1(i+1,j) ) )**2 / (GV%H_to_Z*h_harm) endif ; enddo ; enddo ! Solve an elliptic equation for the streamfunction following Ferrari et al., 2010. @@ -909,11 +914,11 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV ! Make sure that there is enough mass above to allow the streamfunction ! to satisfy the boundary condition of 0 at the surface. - Sfn_in_h = min(max(Sfn_est * GV%Z_to_H, -h_avail_rsum(i,j,K)), h_avail_rsum(i+1,j,K)) + Sfn_in_H = min(max(Sfn_est * GV%Z_to_H, -h_avail_rsum(i,j,K)), h_avail_rsum(i+1,j,K)) ! The actual transport is limited by the mass available in the two ! neighboring grid cells. - uhD(I,j,k) = max(min((Sfn_in_h - uhtot(I,j)), h_avail(i,j,k)), & + uhD(I,j,k) = max(min((Sfn_in_H - uhtot(I,j)), h_avail(i,j,k)), & -h_avail(i+1,j,k)) if (CS%id_sfn_x>0) diag_sfn_x(I,j,K) = diag_sfn_x(I,j,K+1) + uhD(I,j,k) @@ -1053,11 +1058,11 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV wtA = hg2A*haB ; wtB = hg2B*haA ! This is the gradient of density along geopotentials. drdy = ((wtA * drdjA + wtB * drdjB) / (wtA + wtB) - & - drdz * (e(i,j,K)-e(i,j+1,K))) * US%m_to_L*G%IdyCv(i,J) + drdz * (e(i,j,K)-e(i,j+1,K))) * G%IdyCv(i,J) ! This estimate of slope is accurate for small slopes, but bounded ! to be between -1 and 1. - mag_grad2 = drdy**2 + (US%m_to_Z*drdz)**2 + mag_grad2 = drdy**2 + (US%L_to_Z*drdz)**2 if (mag_grad2 > 0.0) then Slope = drdy / sqrt(mag_grad2) slope2_Ratio_v(i,K) = Slope**2 * I_slope_max2 @@ -1071,16 +1076,16 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV ! that ignore density gradients along layers. if (present_int_slope_v) then Slope = (1.0 - int_slope_v(i,J,K)) * Slope + & - int_slope_v(i,J,K) * US%Z_to_m*((e(i,j+1,K)-e(i,j,K)) * US%m_to_L*G%IdyCv(i,J)) + int_slope_v(i,J,K) * US%Z_to_L*((e(i,j+1,K)-e(i,j,K)) * G%IdyCv(i,J)) slope2_Ratio_v(i,K) = (1.0 - int_slope_v(i,J,K)) * slope2_Ratio_v(i,K) endif Slope_y_PE(i,J,k) = MIN(Slope,CS%slope_max) - hN2_y_PE(i,J,k) = hN2_v(i,K) * US%m_to_Z + hN2_y_PE(i,J,k) = hN2_v(i,K) if (CS%id_slope_y > 0) CS%diagSlopeY(I,j,k) = Slope ! Estimate the streamfunction at each interface [m3 s-1]. - Sfn_unlim_v(i,K) = -((KH_v(i,J,K)*US%L_to_m*G%dx_Cv(i,J))*US%m_to_Z*Slope) + Sfn_unlim_v(i,K) = -((KH_v(i,J,K)*G%dx_Cv(i,J))*US%L_to_Z*Slope) ! Avoid moving dense water upslope from below the level of ! the bottom on the receiving side. @@ -1106,11 +1111,11 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV if (present_slope_y) then Slope = slope_y(i,J,k) else - Slope = US%Z_to_m*((e(i,j,K)-e(i,j+1,K))*US%m_to_L*G%IdyCv(i,J)) * G%mask2dCv(i,J) + Slope = US%Z_to_L*((e(i,j,K)-e(i,j+1,K))*G%IdyCv(i,J)) * G%mask2dCv(i,J) endif if (CS%id_slope_y > 0) CS%diagSlopeY(I,j,k) = Slope - Sfn_unlim_v(i,K) = ((KH_v(i,J,K)*US%L_to_m*G%dx_Cv(i,J))*US%m_to_Z*Slope) - hN2_v(i,K) = US%L_to_m**2*US%s_to_T**2*GV%g_prime(K) + Sfn_unlim_v(i,K) = ((KH_v(i,J,K)*G%dx_Cv(i,J))*US%L_to_Z*Slope) + hN2_v(i,K) = GV%g_prime(K) endif ! if (use_EOS) else ! if (k > nk_linear) hN2_v(i,K) = N2_floor * dz_neglect @@ -1124,7 +1129,8 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV do k=1,nz ; do i=is,ie ; if (G%mask2dCv(i,J)>0.) then h_harm = max( h_neglect, & 2. * h(i,j,k) * h(i,j+1,k) / ( ( h(i,j,k) + h(i,j+1,k) ) + h_neglect ) ) - c2_h_v(i,k) = CS%FGNV_scale * ( 0.5*( cg1(i,j) + cg1(i,j+1) ) )**2 / (GV%H_to_Z*h_harm) + c2_h_v(i,k) = CS%FGNV_scale * & + ( 0.5*US%m_s_to_L_T*( cg1(i,j) + cg1(i,j+1) ) )**2 / (GV%H_to_Z*h_harm) endif ; enddo ; enddo ! Solve an elliptic equation for the streamfunction following Ferrari et al., 2010. @@ -1158,12 +1164,11 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV ! Make sure that there is enough mass above to allow the streamfunction ! to satisfy the boundary condition of 0 at the surface. - Sfn_in_h = min(max(Sfn_est * GV%Z_to_H, -h_avail_rsum(i,j,K)), h_avail_rsum(i,j+1,K)) + Sfn_in_H = min(max(Sfn_est * GV%Z_to_H, -h_avail_rsum(i,j,K)), h_avail_rsum(i,j+1,K)) ! The actual transport is limited by the mass available in the two ! neighboring grid cells. - vhD(i,J,k) = max(min((Sfn_in_h - vhtot(i,J)), h_avail(i,j,k)), & - -h_avail(i,j+1,k)) + vhD(i,J,k) = max(min((Sfn_in_H - vhtot(i,J)), h_avail(i,j,k)), -h_avail(i,j+1,k)) if (CS%id_sfn_y>0) diag_sfn_y(i,J,K) = diag_sfn_y(i,J,K+1) + vhD(i,J,k) ! sfn_y(i,J,K) = max(min(Sfn_in_h, vhtot(i,J)+h_avail(i,j,k)), & @@ -1269,16 +1274,16 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV !if (find_work) then ; do j=js,je ; do i=is,ie ; do k=nz,1,-1 if (find_work) then ; do j=js,je ; do i=is,ie ! Note that the units of Work_v and Work_u are W, while Work_h is W m-2. - Work_h = 0.5 * US%m_to_L**2*G%IareaT(i,j) * & + Work_h = 0.5 * G%IareaT(i,j) * & ((Work_u(I-1,j) + Work_u(I,j)) + (Work_v(i,J-1) + Work_v(i,J))) - PE_release_h = -0.25*(Kh_u(I,j,k)*(Slope_x_PE(I,j,k)**2) * hN2_x_PE(I,j,k) + & - Kh_u(I-1,j,k)*(Slope_x_PE(I-1,j,k)**2) * hN2_x_PE(I-1,j,k) + & - Kh_v(i,J,k)*(Slope_y_PE(i,J,k)**2) * hN2_y_PE(i,J,k) + & - Kh_v(i,J-1,k)*(Slope_y_PE(i,J-1,k)**2) * hN2_y_PE(i,J-1,k)) + PE_release_h = -0.25*(KH_u(I,j,k)*(Slope_x_PE(I,j,k)**2) * hN2_x_PE(I,j,k) + & + Kh_u(I-1,j,k)*(Slope_x_PE(I-1,j,k)**2) * hN2_x_PE(I-1,j,k) + & + Kh_v(i,J,k)*(Slope_y_PE(i,J,k)**2) * hN2_y_PE(i,J,k) + & + Kh_v(i,J-1,k)*(Slope_y_PE(i,J-1,k)**2) * hN2_y_PE(i,J-1,k)) if (associated(CS%GMwork)) CS%GMwork(i,j) = Work_h if (associated(MEKE)) then ; if (associated(MEKE%GM_src)) then if (CS%GM_src_alt) then - MEKE%GM_src(i,j) = MEKE%GM_src(i,j) + US%m_to_L**2*US%T_to_s**3*PE_release_h + MEKE%GM_src(i,j) = MEKE%GM_src(i,j) + US%L_to_m**2*US%m_to_Z*PE_release_h else MEKE%GM_src(i,j) = MEKE%GM_src(i,j) + US%m_to_L**2*US%T_to_s**3*Work_h endif @@ -1300,7 +1305,7 @@ subroutine streamfn_solver(nk, c2_h, hN2, sfn) integer, intent(in) :: nk !< Number of layers real, dimension(nk), intent(in) :: c2_h !< Wave speed squared over thickness in layers [m s-2] real, dimension(nk+1), intent(in) :: hN2 !< Thickness times N2 at interfaces [m s-2] - real, dimension(nk+1), intent(inout) :: sfn !< Streamfunction [Z m2 s-1 ~> m3 s-1] or arbitrary units + real, dimension(nk+1), intent(inout) :: sfn !< Streamfunction [Z L2 T-1 ~> m3 s-1] or arbitrary units !! On entry, equals diffusivity times slope. !! On exit, equals the streamfunction. ! Local variables @@ -1329,7 +1334,7 @@ subroutine streamfn_solver(nk, c2_h, hN2, sfn) end subroutine streamfn_solver !> Modifies thickness diffusivities to untangle layer structures -subroutine add_detangling_Kh(h, e, Kh_u, Kh_v, KH_u_CFL, KH_v_CFL, tv, dt, G, GV, US, CS, & +subroutine add_detangling_Kh(h, e, Kh_u, Kh_v, KH_u_CFL, KH_v_CFL, tv, dt_in_T, G, GV, US, CS, & int_slope_u, int_slope_v) type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure @@ -1337,15 +1342,15 @@ subroutine add_detangling_Kh(h, e, Kh_u, Kh_v, KH_u_CFL, KH_v_CFL, tv, dt, G, GV 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)+1), intent(in) :: e !< Interface positions [Z ~> m] real, dimension(SZIB_(G),SZJ_(G),SZK_(G)+1), intent(inout) :: Kh_u !< Thickness diffusivity on interfaces - !! at u points [m2 s-1] + !! at u points [L2 T-1 ~> m2 s-1] real, dimension(SZI_(G),SZJB_(G),SZK_(G)+1), intent(inout) :: Kh_v !< Thickness diffusivity on interfaces - !! at v points [m2 s-1] + !! at v points [L2 T-1 ~> m2 s-1] real, dimension(SZIB_(G),SZJ_(G)), intent(in) :: Kh_u_CFL !< Maximum stable thickness diffusivity - !! at u points [m2 s-1] + !! at u points [L2 T-1 ~> m2 s-1] real, dimension(SZI_(G),SZJB_(G)), intent(in) :: Kh_v_CFL !< Maximum stable thickness diffusivity - !! at v points [m2 s-1] + !! at v points [L2 T-1 ~> m2 s-1] type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamics structure - real, intent(in) :: dt !< Time increment [s] + real, intent(in) :: dt_in_T !< Time increment [T ~> 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 @@ -1361,10 +1366,10 @@ subroutine add_detangling_Kh(h, e, Kh_u, Kh_v, KH_u_CFL, KH_v_CFL, tv, dt, G, GV ! region where the detangling is applied [H ~> m or kg m-2]. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)) :: & Kh_lay_u ! The tentative interface height diffusivity for each layer at - ! u points [m2 s-1]. + ! u points [L2 T-1 ~> m2 s-1]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)) :: & Kh_lay_v ! The tentative interface height diffusivity for each layer at - ! v points [m2 s-1]. + ! v points [L2 T-1 ~> m2 s-1]. real, dimension(SZI_(G),SZJ_(G)) :: & de_bot ! The distances from the bottom of the region where the ! detangling is applied [H ~> m or kg m-2]. @@ -1377,44 +1382,44 @@ subroutine add_detangling_Kh(h, e, Kh_u, Kh_v, KH_u_CFL, KH_v_CFL, tv, dt, G, GV ! normalized by the arithmetic mean thickness. real :: Kh_scale ! A ratio by which Kh_u_CFL is scaled for maximally jagged ! layers [nondim]. - real :: Kh_det ! The detangling diffusivity [m2 s-1]. +! real :: Kh_det ! The detangling diffusivity [m2 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 :: I_sl ! The absolute value of the larger in magnitude of the slopes - ! above and below. + ! above and below [L Z-1 ~> nondim]. real :: Rsl ! The ratio of the smaller magnitude slope to the larger ! magnitude one [nondim]. 0 <= Rsl <1. real :: IRsl ! The (limited) inverse of Rsl [nondim]. 1 < IRsl <= 1e9. real :: dH ! The thickness gradient divided by the damping timescale ! and the ratio of the face length to the adjacent cell - ! areas for comparability with the diffusivities [m2 s-1]. - real :: adH ! The absolute value of dH [m2 s-1]. + ! areas for comparability with the diffusivities [L Z T-1 ~> m2 s-1]. + real :: adH ! The absolute value of dH [L Z T-1 ~> m2 s-1]. real :: sign ! 1 or -1, with the same sign as the layer thickness gradient. - real :: sl_K ! The sign-corrected slope of the interface above [nondim]. - real :: sl_Kp1 ! The sign-corrected slope of the interface below [nondim]. - real :: I_sl_K ! The (limited) inverse of sl_K [nondim]. - real :: I_sl_Kp1 ! The (limited) inverse of sl_Kp1 [nondim]. - real :: I_4t ! A quarter of a unit conversion factor divided by - ! the damping timescale [s-1]. + real :: sl_K ! The sign-corrected slope of the interface above [Z L-1 ~> nondim]. + real :: sl_Kp1 ! The sign-corrected slope of the interface below [Z L-1 ~> nondim]. + real :: I_sl_K ! The (limited) inverse of sl_K [L Z-1 ~> nondim]. + real :: I_sl_Kp1 ! The (limited) inverse of sl_Kp1 [L Z-1 ~> nondim]. + real :: I_4t ! A quarter of a flux scaling factor divided by + ! the damping timescale [T-1 ~> s-1]. real :: Fn_R ! A function of Rsl, such that Rsl < Fn_R < 1. real :: denom, I_denom ! A denominator and its inverse, various units. - real :: Kh_min ! A local floor on the diffusivity [m2 s-1]. - real :: Kh_max ! A local ceiling on the diffusivity [m2 s-1]. + ! real :: Kh_min ! A local floor on the diffusivity [m2 s-1]. + real :: Kh_max ! A local ceiling on the diffusivity [L2 T-1 ~> m2 s-1]. real :: wt1, wt2 ! Nondimensional weights. ! Variables used only in testing code. ! real, dimension(SZK_(G)) :: uh_here ! real, dimension(SZK_(G)+1) :: Sfn - real :: dKh ! An increment in the diffusivity [m2 s-1]. + real :: dKh ! An increment in the diffusivity [L2 T-1 ~> m2 s-1]. real, dimension(SZIB_(G),SZK_(G)+1) :: & - Kh_bg, & ! The background (floor) value of Kh [m2 s-1]. - Kh, & ! The tentative value of Kh [m2 s-1]. - Kh_detangle, & ! The detangling diffusivity that could be used [m2 s-1]. + Kh_bg, & ! The background (floor) value of Kh [L2 T-1 ~> m2 s-1]. + Kh, & ! The tentative value of Kh [L2 T-1 ~> m2 s-1]. + Kh_detangle, & ! The detangling diffusivity that could be used [L2 T-1 ~> m2 s-1]. Kh_min_max_p, & ! The smallest ceiling that can be placed on Kh(I,K) - ! based on the value of Kh(I,K+1) [m2 s-1]. + ! based on the value of Kh(I,K+1) [L2 T-1 ~> m2 s-1]. Kh_min_max_m, & ! The smallest ceiling that can be placed on Kh(I,K) - ! based on the value of Kh(I,K-1) [m2 s-1]. + ! based on the value of Kh(I,K-1) [L2 T-1 ~> m2 s-1]. ! The following are variables that define the relationships between ! successive values of Kh. ! Search for Kh that satisfy... @@ -1423,15 +1428,15 @@ subroutine add_detangling_Kh(h, e, Kh_u, Kh_v, KH_u_CFL, KH_v_CFL, tv, dt, G, GV ! Kh(I,K) <= Kh_max_m(I,K)*Kh(I,K-1) + Kh0_max_m(I,K) ! Kh(I,K) <= Kh_max_p(I,K)*Kh(I,K+1) + Kh0_max_p(I,K) Kh_min_m , & ! See above [nondim]. - Kh0_min_m , & ! See above [m2 s-1]. + Kh0_min_m , & ! See above [L2 T-1 ~> m2 s-1]. Kh_max_m , & ! See above [nondim]. - Kh0_max_m, & ! See above [m2 s-1]. + Kh0_max_m, & ! See above [L2 T-1 ~> m2 s-1]. Kh_min_p , & ! See above [nondim]. - Kh0_min_p , & ! See above [m2 s-1]. + Kh0_min_p , & ! See above [L2 T-1 ~> m2 s-1]. Kh_max_p , & ! See above [nondim]. - Kh0_max_p ! See above [m2 s-1]. + Kh0_max_p ! See above [L2 T-1 ~> m2 s-1]. real, dimension(SZIB_(G)) :: & - Kh_max_max ! The maximum diffusivity permitted in a column. + Kh_max_max ! The maximum diffusivity permitted in a column [L2 T-1 ~> m2 s-1].. logical, dimension(SZIB_(G)) :: & do_i ! If true, work on a column. integer :: i, j, k, n, ish, jsh, is, ie, js, je, nz, k_top @@ -1443,7 +1448,7 @@ subroutine add_detangling_Kh(h, e, Kh_u, Kh_v, KH_u_CFL, KH_v_CFL, tv, dt, G, GV ! distributing the diffusivities more effectively (with wt1 & wt2), but this ! means that the additions to a single interface can be up to twice as large. Kh_scale = 0.5 - if (CS%detangle_time > dt) Kh_scale = 0.5 * dt / CS%detangle_time + if (CS%detangle_time > dt_in_T) Kh_scale = 0.5 * dt_in_T / CS%detangle_time do j=js-1,je+1 ; do i=is-1,ie+1 de_top(i,j,k_top) = 0.0 ; de_bot(i,j) = 0.0 @@ -1474,7 +1479,7 @@ subroutine add_detangling_Kh(h, e, Kh_u, Kh_v, KH_u_CFL, KH_v_CFL, tv, dt, G, GV h1 = max( h(i,j,k), h2 - min(de_bot(i,j), de_top(i,j,k)) ) endif jag_Rat = (h2 - h1)**2 / (h2 + h1 + h_neglect)**2 - Kh_lay_u(I,j,k) = (Kh_scale * Kh_u_CFL(I,j)) * jag_Rat**2 + KH_lay_u(I,j,k) = (Kh_scale * KH_u_CFL(I,j)) * jag_Rat**2 endif ; enddo ; enddo do J=js-1,je ; do i=is,ie ; if (G%mask2dCv(i,J) > 0.0) then @@ -1486,13 +1491,13 @@ subroutine add_detangling_Kh(h, e, Kh_u, Kh_v, KH_u_CFL, KH_v_CFL, tv, dt, G, GV h1 = max( h(i,j,k), h2 - min(de_bot(i,j), de_top(i,j,k)) ) endif jag_Rat = (h2 - h1)**2 / (h2 + h1 + h_neglect)**2 - Kh_lay_v(i,J,k) = (Kh_scale * Kh_v_CFL(i,J)) * jag_Rat**2 + KH_lay_v(i,J,k) = (Kh_scale * KH_v_CFL(i,J)) * jag_Rat**2 endif ; enddo ; enddo enddo ! Limit the diffusivities - I_4t = US%Z_to_m*Kh_scale / (4.0*dt) + I_4t = Kh_scale / (4.0 * dt_in_T) do n=1,2 if (n==1) then ; jsh = js ; ish = is-1 @@ -1504,19 +1509,19 @@ subroutine add_detangling_Kh(h, e, Kh_u, Kh_v, KH_u_CFL, KH_v_CFL, tv, dt, G, GV if (n==1) then ! This is a u-column. do i=ish,ie do_i(I) = (G%mask2dCu(I,j) > 0.0) - Kh_max_max(I) = Kh_u_CFL(I,j) + Kh_Max_max(I) = KH_u_CFL(I,j) enddo do K=1,nz+1 ; do i=ish,ie - Kh_bg(I,K) = Kh_u(I,j,K) ; Kh(I,K) = Kh_bg(I,K) + Kh_bg(I,K) = KH_u(I,j,K) ; Kh(I,K) = Kh_bg(I,K) Kh_min_max_p(I,K) = Kh_bg(I,K) ; Kh_min_max_m(I,K) = Kh_bg(I,K) Kh_detangle(I,K) = 0.0 enddo ; enddo else ! This is a v-column. do i=ish,ie - do_i(i) = (G%mask2dCv(i,J) > 0.0) ; Kh_max_max(I) = Kh_v_CFL(i,J) + do_i(i) = (G%mask2dCv(i,J) > 0.0) ; Kh_Max_max(I) = KH_v_CFL(i,J) enddo do K=1,nz+1 ; do i=ish,ie - Kh_bg(I,K) = Kh_v(I,j,K) ; Kh(I,K) = Kh_bg(I,K) + Kh_bg(I,K) = KH_v(I,j,K) ; Kh(I,K) = Kh_bg(I,K) Kh_min_max_p(I,K) = Kh_bg(I,K) ; Kh_min_max_m(I,K) = Kh_bg(I,K) Kh_detangle(I,K) = 0.0 enddo ; enddo @@ -1526,7 +1531,7 @@ subroutine add_detangling_Kh(h, e, Kh_u, Kh_v, KH_u_CFL, KH_v_CFL, tv, dt, G, GV do k=k_top,nz ; do i=ish,ie ; if (do_i(i)) then if (n==1) then ! This is a u-column. dH = 0.0 - denom = US%m_to_L * ((G%IareaT(i+1,j) + G%IareaT(i,j)) * G%dy_Cu(I,j)) + denom = ((G%IareaT(i+1,j) + G%IareaT(i,j)) * G%dy_Cu(I,j)) ! This expression uses differences in e in place of h for better ! consistency with the slopes. if (denom > 0.0) & @@ -1535,9 +1540,9 @@ subroutine add_detangling_Kh(h, e, Kh_u, Kh_v, KH_u_CFL, KH_v_CFL, tv, dt, G, GV ! dH = I_4t * (h(i+1,j,k) - h(i,j,k)) / denom adH = abs(dH) - sign = 1.0*US%Z_to_m ; if (dH < 0) sign = -1.0*US%Z_to_m - sl_K = sign * (e(i+1,j,K)-e(i,j,K)) * US%m_to_L*G%IdxCu(I,j) - sl_Kp1 = sign * (e(i+1,j,K+1)-e(i,j,K+1)) * US%m_to_L*G%IdxCu(I,j) + sign = 1.0 ; if (dH < 0) sign = -1.0 + sl_K = sign * (e(i+1,j,K)-e(i,j,K)) * G%IdxCu(I,j) + sl_Kp1 = sign * (e(i+1,j,K+1)-e(i,j,K+1)) * G%IdxCu(I,j) ! Add the incremental diffusivites to the surrounding interfaces. ! Adding more to the more steeply sloping layers (as below) makes @@ -1547,20 +1552,20 @@ subroutine add_detangling_Kh(h, e, Kh_u, Kh_v, KH_u_CFL, KH_v_CFL, tv, dt, G, GV if (denom > 0.0) then wt1 = sl_K**2 / denom ; wt2 = sl_Kp1**2 / denom endif - Kh_detangle(I,K) = Kh_detangle(I,K) + wt1*Kh_lay_u(I,j,k) - Kh_detangle(I,K+1) = Kh_detangle(I,K+1) + wt2*Kh_lay_u(I,j,k) + Kh_detangle(I,K) = Kh_detangle(I,K) + wt1*KH_lay_u(I,j,k) + Kh_detangle(I,K+1) = Kh_detangle(I,K+1) + wt2*KH_lay_u(I,j,k) else ! This is a v-column. dH = 0.0 - denom = US%m_to_L * ((G%IareaT(i,j+1) + G%IareaT(i,j)) * G%dx_Cv(I,j)) + denom = ((G%IareaT(i,j+1) + G%IareaT(i,j)) * G%dx_Cv(I,j)) if (denom > 0.0) & dH = I_4t * ((e(i,j+1,K) - e(i,j+1,K+1)) - & (e(i,j,K) - e(i,j,K+1))) / denom ! dH = I_4t * (h(i,j+1,k) - h(i,j,k)) / denom adH = abs(dH) - sign = 1.0*US%Z_to_m ; if (dH < 0) sign = -1.0*US%Z_to_m - sl_K = sign * (e(i,j+1,K)-e(i,j,K)) * US%m_to_L*G%IdyCv(i,J) - sl_Kp1 = sign * (e(i,j+1,K+1)-e(i,j,K+1)) * US%m_to_L*G%IdyCv(i,J) + sign = 1.0 ; if (dH < 0) sign = -1.0 + sl_K = sign * (e(i,j+1,K)-e(i,j,K)) * G%IdyCv(i,J) + sl_Kp1 = sign * (e(i,j+1,K+1)-e(i,j,K+1)) * G%IdyCv(i,J) ! Add the incremental diffusviites to the surrounding interfaces. ! Adding more to the more steeply sloping layers (as below) makes @@ -1570,8 +1575,8 @@ subroutine add_detangling_Kh(h, e, Kh_u, Kh_v, KH_u_CFL, KH_v_CFL, tv, dt, G, GV if (denom > 0.0) then wt1 = sl_K**2 / denom ; wt2 = sl_Kp1**2 / denom endif - Kh_detangle(I,K) = Kh_detangle(I,K) + wt1*Kh_lay_v(i,J,k) - Kh_detangle(I,K+1) = Kh_detangle(I,K+1) + wt2*Kh_lay_v(i,J,k) + Kh_detangle(I,K) = Kh_detangle(I,K) + wt1*KH_lay_v(i,J,k) + Kh_detangle(I,K+1) = Kh_detangle(I,K+1) + wt2*KH_lay_v(i,J,k) endif if (adH == 0.0) then @@ -1594,15 +1599,15 @@ subroutine add_detangling_Kh(h, e, Kh_u, Kh_v, KH_u_CFL, KH_v_CFL, tv, dt, G, GV Fn_R = Rsl if (Kh_max_max(I) > 0) & - Fn_R = min(sqrt(Rsl), Rsl + (adH * I_sl) / Kh_max_max(I)) + Fn_R = min(sqrt(Rsl), Rsl + (adH * I_sl) / (Kh_Max_max(I))) Kh_min_m(I,K+1) = Fn_R ; Kh0_min_m(I,K+1) = 0.0 Kh_max_m(I,K+1) = Rsl ; Kh0_max_m(I,K+1) = adH * I_sl Kh_min_p(I,K) = IRsl ; Kh0_min_p(I,K) = -adH * (I_sl*IRsl) Kh_max_p(I,K) = 1.0/(Fn_R + 1.0e-30) ; Kh0_max_p(I,K) = 0.0 elseif (sl_Kp1 < 0.0) then ! Opposite (nonzero) signs of slopes. - I_sl_K = 1e18 ; if (sl_K > 1e-18) I_sl_K = 1.0 / sl_K - I_sl_Kp1 = 1e18 ; if (-sl_Kp1 > 1e-18) I_sl_Kp1 = -1.0 / sl_Kp1 + I_sl_K = 1e18*US%Z_to_L ; if (sl_K > 1e-18*US%L_to_Z) I_sl_K = 1.0 / sl_K + I_sl_Kp1 = 1e18*US%Z_to_L ; if (-sl_Kp1 > 1e-18*US%L_to_Z) I_sl_Kp1 = -1.0 / sl_Kp1 Kh_min_m(I,K+1) = 0.0 ; Kh0_min_m(I,K+1) = 0.0 Kh_max_m(I,K+1) = - sl_K*I_sl_Kp1 ; Kh0_max_m(I,K+1) = adH*I_sl_Kp1 @@ -1611,9 +1616,9 @@ subroutine add_detangling_Kh(h, e, Kh_u, Kh_v, KH_u_CFL, KH_v_CFL, tv, dt, G, GV ! This limit does not use the slope weighting so that potentially ! sharp gradients in diffusivities are not forced to occur. - Kh_max = adH / (sl_K - sl_Kp1) - Kh_min_max_p(I,K) = max(Kh_min_max_p(I,K), Kh_max) - Kh_min_max_m(I,K+1) = max(Kh_min_max_m(I,K+1), Kh_max) + Kh_Max = adH / (sl_K - sl_Kp1) + Kh_min_max_p(I,K) = max(Kh_min_max_p(I,K), Kh_Max) + Kh_min_max_m(I,K+1) = max(Kh_min_max_m(I,K+1), Kh_Max) else ! Both slopes are of the same sign as dH. I_sl = 1.0 / sl_K Rsl = sl_Kp1 * I_sl ! 0 <= Rsl < 1 @@ -1622,7 +1627,7 @@ subroutine add_detangling_Kh(h, e, Kh_u, Kh_v, KH_u_CFL, KH_v_CFL, tv, dt, G, GV ! Rsl <= Fn_R <= 1 Fn_R = Rsl if (Kh_max_max(I) > 0) & - Fn_R = min(sqrt(Rsl), Rsl + (adH * I_sl) / Kh_max_max(I)) + Fn_R = min(sqrt(Rsl), Rsl + (adH * I_sl) / Kh_Max_max(I)) Kh_min_m(I,K+1) = IRsl ; Kh0_min_m(I,K+1) = -adH * (I_sl*IRsl) Kh_max_m(I,K+1) = 1.0/(Fn_R + 1.0e-30) ; Kh0_max_m(I,K+1) = 0.0 @@ -1661,16 +1666,16 @@ subroutine add_detangling_Kh(h, e, Kh_u, Kh_v, KH_u_CFL, KH_v_CFL, tv, dt, G, GV do K=nz,k_top+1,-1 ; do i=ish,ie ; if (do_i(i)) then Kh(I,k) = max(Kh(I,K), min(Kh_min_p(I,K)*Kh(I,K+1) + Kh0_min_p(I,K), Kh(I,K+1))) - Kh_max = max(Kh_min_max_p(I,K), Kh_max_p(I,K)*Kh(I,K+1) + Kh0_max_p(I,K)) - Kh(I,k) = min(Kh(I,k), Kh_max) + Kh_Max = max(Kh_min_max_p(I,K), Kh_max_p(I,K)*Kh(I,K+1) + Kh0_max_p(I,K)) + Kh(I,k) = min(Kh(I,k), Kh_Max) endif ; enddo ; enddo ! I-loop & k-loop ! All non-zero min constraints on one diffusivity are max constraints on ! another layer, so the min constraints can now be discounted. ! Decrease the diffusivities to satisfy the max constraints. do K=k_top+1,nz ; do i=ish,ie ; if (do_i(i)) then - Kh_max = max(Kh_min_max_m(I,K), Kh_max_m(I,K)*Kh(I,K-1) + Kh0_max_m(I,K)) - if (Kh(I,k) > Kh_max) Kh(I,k) = Kh_Max + Kh_Max = max(Kh_min_max_m(I,K), Kh_max_m(I,K)*Kh(I,K-1) + Kh0_max_m(I,K)) + if (Kh(I,k) > Kh_Max) Kh(I,k) = Kh_Max endif ; enddo ; enddo ! i- and K-loops ! This code tests the solutions... @@ -1681,37 +1686,35 @@ subroutine add_detangling_Kh(h, e, Kh_u, Kh_v, KH_u_CFL, KH_v_CFL, tv, dt, G, GV ! if (n==1) then ! u-point. ! if ((h(i+1,j,k) - h(i,j,k)) * & ! ((e(i+1,j,K)-e(i+1,j,K+1)) - (e(i,j,K)-e(i,j,K+1))) > 0.0) then -! Sfn(K) = -Kh(i,K) * (e(i+1,j,K)-e(i,j,K)) * US%m_to_L*G%IdxCu(I,j) -! Sfn(K+1) = -Kh(i,K+1) * (e(i+1,j,K+1)-e(i,j,K+1)) * US%m_to_L*G%IdxCu(I,j) -! uh_here(k) = (Sfn(K) - Sfn(K+1))*US%L_to_m*G%dy_Cu(I,j) -! if (abs(uh_here(k))*min(US%m_to_L**2*G%IareaT(i,j), US%m_to_L**2*G%IareaT(i+1,j)) > & +! Sfn(K) = -Kh(i,K) * (e(i+1,j,K)-e(i,j,K)) * G%IdxCu(I,j) +! Sfn(K+1) = -Kh(i,K+1) * (e(i+1,j,K+1)-e(i,j,K+1)) * G%IdxCu(I,j) +! uh_here(k) = (Sfn(K) - Sfn(K+1))*G%dy_Cu(I,j) +! if (abs(uh_here(k)) * min(G%IareaT(i,j), G%IareaT(i+1,j)) > & ! (1e-10*GV%m_to_H)) then ! if (uh_here(k) * (h(i+1,j,k) - h(i,j,k)) > 0.0) then -! call MOM_error(WARNING, & -! "Corrective u-transport is up the thickness gradient.", .true.) +! call MOM_error(WARNING, "Corrective u-transport is up the thickness gradient.", .true.) ! endif -! if (((h(i,j,k) - 4.0*dt*US%m_to_L**2*G%IareaT(i,j)*uh_here(k)) - & -! (h(i+1,j,k) + 4.0*dt*US%m_to_L**2*G%IareaT(i+1,j)*uh_here(k))) * & +! if (((h(i,j,k) - 4.0*dt*G%IareaT(i,j)*uh_here(k)) - & +! (h(i+1,j,k) + 4.0*dt*G%IareaT(i+1,j)*uh_here(k))) * & ! (h(i,j,k) - h(i+1,j,k)) < 0.0) then -! call MOM_error(WARNING, & -! "Corrective u-transport is too large.", .true.) +! call MOM_error(WARNING, "Corrective u-transport is too large.", .true.) ! endif ! endif ! endif ! else ! v-point ! if ((h(i,j+1,k) - h(i,j,k)) * & ! ((e(i,j+1,K)-e(i,j+1,K+1)) - (e(i,j,K)-e(i,j,K+1))) > 0.0) then -! Sfn(K) = -Kh(i,K) * (e(i,j+1,K)-e(i,j,K)) * US%m_to_L*G%IdyCv(i,J) -! Sfn(K+1) = -Kh(i,K+1) * (e(i,j+1,K+1)-e(i,j,K+1)) * US%m_to_L*G%IdyCv(i,J) -! uh_here(k) = (Sfn(K) - Sfn(K+1))*US%L_to_m*G%dx_Cv(i,J) -! if (abs(uh_here(K))*min(US%m_to_L**2*G%IareaT(i,j), US%m_to_L**2*G%IareaT(i,j+1)) > & +! Sfn(K) = -Kh(i,K) * (e(i,j+1,K)-e(i,j,K)) * G%IdyCv(i,J) +! Sfn(K+1) = -Kh(i,K+1) * (e(i,j+1,K+1)-e(i,j,K+1)) * G%IdyCv(i,J) +! uh_here(k) = (Sfn(K) - Sfn(K+1))*G%dx_Cv(i,J) +! if (abs(uh_here(K)) * min(G%IareaT(i,j), G%IareaT(i,j+1)) > & ! (1e-10*GV%m_to_H)) then ! if (uh_here(K) * (h(i,j+1,k) - h(i,j,k)) > 0.0) then ! call MOM_error(WARNING, & ! "Corrective v-transport is up the thickness gradient.", .true.) ! endif -! if (((h(i,j,k) - 4.0*dt*US%m_to_L**2*G%IareaT(i,j)*uh_here(K)) - & -! (h(i,j+1,k) + 4.0*dt*US%m_to_L**2*G%IareaT(i,j+1)*uh_here(K))) * & +! if (((h(i,j,k) - 4.0*dt*G%IareaT(i,j)*uh_here(K)) - & +! (h(i,j+1,k) + 4.0*dt*G%IareaT(i,j+1)*uh_here(K))) * & ! (h(i,j,k) - h(i,j+1,k)) < 0.0) then ! call MOM_error(WARNING, & ! "Corrective v-transport is too large.", .true.) @@ -1719,25 +1722,25 @@ subroutine add_detangling_Kh(h, e, Kh_u, Kh_v, KH_u_CFL, KH_v_CFL, tv, dt, G, GV ! endif ! endif ! endif ! u- or v- selection. -! ! de_dx(I,K) = (e(i+1,j,K)-e(i,j,K)) * US%m_to_L*G%IdxCu(I,j) +! ! de_dx(I,K) = (e(i+1,j,K)-e(i,j,K)) * G%IdxCu(I,j) ! endif ! enddo ! enddo if (n==1) then ! This is a u-column. do K=k_top+1,nz ; do i=ish,ie - if (Kh(I,K) > Kh_u(I,j,K)) then - dKh = (Kh(I,K) - Kh_u(I,j,K)) + if (Kh(I,K) > KH_u(I,j,K)) then + dKh = (Kh(I,K) - KH_u(I,j,K)) int_slope_u(I,j,K) = dKh / Kh(I,K) - Kh_u(I,j,K) = Kh(I,K) + KH_u(I,j,K) = Kh(I,K) endif enddo ; enddo else ! This is a v-column. do K=k_top+1,nz ; do i=ish,ie - if (Kh(i,K) > Kh_v(i,J,K)) then - dKh = Kh(i,K) - Kh_v(i,J,K) + if (Kh(i,K) > KH_v(i,J,K)) then + dKh = Kh(i,K) - KH_v(i,J,K) int_slope_v(i,J,K) = dKh / Kh(i,K) - Kh_v(i,J,K) = Kh(i,K) + KH_v(i,J,K) = Kh(i,K) endif enddo ; enddo endif @@ -1761,7 +1764,8 @@ subroutine thickness_diffuse_init(Time, G, GV, US, param_file, diag, CDp, CS) ! This include declares and sets the variable "version". #include "version_variable.h" character(len=40) :: mdl = "MOM_thickness_diffuse" ! This module's name. - real :: omega, strat_floor, flux_to_kg_per_s + real :: omega ! The Earth's rotation rate [T-1 ~> s-1] + real :: strat_floor if (associated(CS)) then call MOM_error(WARNING, & @@ -1778,17 +1782,17 @@ subroutine thickness_diffuse_init(Time, G, GV, US, param_file, diag, CDp, CS) "coefficient of KHTH.", default=.false.) call get_param(param_file, mdl, "KHTH", CS%Khth, & "The background horizontal thickness diffusivity.", & - units = "m2 s-1", default=0.0) + default=0.0, units="m2 s-1", scale=US%m_to_L**2*US%T_to_s) call get_param(param_file, mdl, "KHTH_SLOPE_CFF", CS%KHTH_Slope_Cff, & "The nondimensional coefficient in the Visbeck formula "//& "for the interface depth diffusivity", units="nondim", & default=0.0) call get_param(param_file, mdl, "KHTH_MIN", CS%KHTH_Min, & "The minimum horizontal thickness diffusivity.", & - units = "m2 s-1", default=0.0) + default=0.0, units="m2 s-1", scale=US%m_to_L**2*US%T_to_s) call get_param(param_file, mdl, "KHTH_MAX", CS%KHTH_Max, & "The maximum horizontal thickness diffusivity.", & - units = "m2 s-1", default=0.0) + default=0.0, units="m2 s-1", scale=US%m_to_L**2*US%T_to_s) call get_param(param_file, mdl, "KHTH_MAX_CFL", CS%max_Khth_CFL, & "The maximum value of the local diffusive CFL ratio that "//& "is permitted for the thickness diffusivity. 1.0 is the "//& @@ -1810,14 +1814,14 @@ subroutine thickness_diffuse_init(Time, G, GV, US, param_file, diag, CDp, CS) call get_param(param_file, mdl, "DETANGLE_TIMESCALE", CS%detangle_time, & "A timescale over which maximally jagged grid-scale "//& "thickness variations are suppressed. This must be "//& - "longer than DT, or 0 to use DT.", units = "s", default=0.0) + "longer than DT, or 0 to use DT.", units="s", default=0.0, scale=US%s_to_T) call get_param(param_file, mdl, "KHTH_SLOPE_MAX", CS%slope_max, & "A slope beyond which the calculated isopycnal slope is "//& "not reliable and is scaled away.", units="nondim", default=0.01) 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) + default=1.0e-6, scale=US%m_to_Z**2*US%T_to_s) call get_param(param_file, mdl, "KHTH_USE_FGNV_STREAMFUNCTION", CS%use_FGNV_streamfn, & "If true, use the streamfunction formulation of "//& "Ferrari et al., 2010, which effectively emphasizes "//& @@ -1836,9 +1840,9 @@ subroutine thickness_diffuse_init(Time, G, GV, US, param_file, diag, CDp, CS) "streamfunction formulation, expressed as a fraction of planetary "//& "rotation, OMEGA. This should be tiny but non-zero to avoid degeneracy.", & default=1.e-15, units="nondim", do_not_log=.not.CS%use_FGNV_streamfn) - call get_param(param_file, mdl, "OMEGA",omega, & - "The rotation rate of the earth.", units="s-1", & - default=7.2921e-5, do_not_log=.not.CS%use_FGNV_streamfn) + call get_param(param_file, mdl, "OMEGA", omega, & + "The rotation rate of the earth.", & + default=7.2921e-5, units="s-1", scale=US%T_to_s, do_not_log=.not.CS%use_FGNV_streamfn) if (CS%use_FGNV_streamfn) CS%N2_floor = (strat_floor*omega)**2 call get_param(param_file, mdl, "DEBUG", CS%debug, & "If true, write out verbose debugging data.", & @@ -1854,7 +1858,7 @@ subroutine thickness_diffuse_init(Time, G, GV, US, param_file, diag, CDp, CS) call get_param(param_file, mdl, "MEKE_GEOMETRIC_EPSILON", CS%MEKE_GEOMETRIC_epsilon, & "Minimum Eady growth rate used in the calculation of \n"//& - "GEOMETRIC thickness diffusivity.", units="s-1", default=1.0e-7) + "GEOMETRIC thickness diffusivity.", units="s-1", default=1.0e-7, scale=US%T_to_s) call get_param(param_file, mdl, "MEKE_GEOMETRIC_ALPHA", CS%MEKE_GEOMETRIC_alpha, & "The nondimensional coefficient governing the efficiency of the GEOMETRIC \n"//& @@ -1874,16 +1878,15 @@ subroutine thickness_diffuse_init(Time, G, GV, US, param_file, diag, CDp, CS) call safe_alloc_ptr(CS%KH_v_GME,G%isd,G%ied,G%JsdB,G%JedB,G%ke+1) endif - if (GV%Boussinesq) then ; flux_to_kg_per_s = GV%Rho0 - else ; flux_to_kg_per_s = 1. ; endif - CS%id_uhGM = register_diag_field('ocean_model', 'uhGM', diag%axesCuL, Time, & - 'Time Mean Diffusive Zonal Thickness Flux', 'kg s-1', & - y_cell_method='sum', v_extensive=.true., conversion=flux_to_kg_per_s) + 'Time Mean Diffusive Zonal Thickness Flux', & + 'kg s-1', conversion=GV%H_to_kg_m2*US%L_to_m**2*US%s_to_T, & + y_cell_method='sum', v_extensive=.true.) if (CS%id_uhGM > 0) call safe_alloc_ptr(CDp%uhGM,G%IsdB,G%IedB,G%jsd,G%jed,G%ke) CS%id_vhGM = register_diag_field('ocean_model', 'vhGM', diag%axesCvL, Time, & - 'Time Mean Diffusive Meridional Thickness Flux', 'kg s-1', & - x_cell_method='sum', v_extensive=.true., conversion=flux_to_kg_per_s) + 'Time Mean Diffusive Meridional Thickness Flux', & + 'kg s-1', conversion=GV%H_to_kg_m2*US%L_to_m**2*US%s_to_T, & + x_cell_method='sum', v_extensive=.true.) if (CS%id_vhGM > 0) call safe_alloc_ptr(CDp%vhGM,G%isd,G%ied,G%JsdB,G%JedB,G%ke) CS%id_GMwork = register_diag_field('ocean_model', 'GMwork', diag%axesT1, Time, & @@ -1894,22 +1897,28 @@ subroutine thickness_diffuse_init(Time, G, GV, US, param_file, diag, CDp, CS) if (CS%id_GMwork > 0) call safe_alloc_ptr(CS%GMwork,G%isd,G%ied,G%jsd,G%jed) CS%id_KH_u = register_diag_field('ocean_model', 'KHTH_u', diag%axesCui, Time, & - 'Parameterized mesoscale eddy advection diffusivity at U-point', 'm2 s-1') + 'Parameterized mesoscale eddy advection diffusivity at U-point', & + 'm2 s-1', conversion=US%L_to_m**2*US%s_to_T) CS%id_KH_v = register_diag_field('ocean_model', 'KHTH_v', diag%axesCvi, Time, & - 'Parameterized mesoscale eddy advection diffusivity at V-point', 'm2 s-1') + 'Parameterized mesoscale eddy advection diffusivity at V-point', & + 'm2 s-1', conversion=US%L_to_m**2*US%s_to_T) CS%id_KH_t = register_diag_field('ocean_model', 'KHTH_t', diag%axesTL, Time, & - 'Ocean Tracer Diffusivity due to Parameterized Mesoscale Advection', 'm2 s-1',& + 'Ocean Tracer Diffusivity due to Parameterized Mesoscale Advection', & + 'm2 s-1', conversion=US%L_to_m**2*US%s_to_T, & cmor_field_name='diftrblo', & cmor_long_name='Ocean Tracer Diffusivity due to Parameterized Mesoscale Advection', & cmor_units='m2 s-1', & cmor_standard_name='ocean_tracer_diffusivity_due_to_parameterized_mesoscale_advection') CS%id_KH_u1 = register_diag_field('ocean_model', 'KHTH_u1', diag%axesCu1, Time, & - 'Parameterized mesoscale eddy advection diffusivity at U-points (2-D)', 'm2 s-1') + 'Parameterized mesoscale eddy advection diffusivity at U-points (2-D)', & + 'm2 s-1', conversion=US%L_to_m**2*US%s_to_T) CS%id_KH_v1 = register_diag_field('ocean_model', 'KHTH_v1', diag%axesCv1, Time, & - 'Parameterized mesoscale eddy advection diffusivity at V-points (2-D)', 'm2 s-1') + 'Parameterized mesoscale eddy advection diffusivity at V-points (2-D)', & + 'm2 s-1', conversion=US%L_to_m**2*US%s_to_T) CS%id_KH_t1 = register_diag_field('ocean_model', 'KHTH_t1', diag%axesT1, Time,& - 'Parameterized mesoscale eddy advection diffusivity at T-points (2-D)', 'm2 s-1') + 'Parameterized mesoscale eddy advection diffusivity at T-points (2-D)', & + 'm2 s-1', conversion=US%L_to_m**2*US%s_to_T) CS%id_slope_x = register_diag_field('ocean_model', 'neutral_slope_x', diag%axesCui, Time, & 'Zonal slope of neutral surface', 'nondim') @@ -1918,15 +1927,17 @@ subroutine thickness_diffuse_init(Time, G, GV, US, param_file, diag, CDp, CS) 'Meridional slope of neutral surface', 'nondim') if (CS%id_slope_y > 0) call safe_alloc_ptr(CS%diagSlopeY,G%isd,G%ied,G%JsdB,G%JedB,G%ke+1) CS%id_sfn_x = register_diag_field('ocean_model', 'GM_sfn_x', diag%axesCui, Time, & - 'Parameterized Zonal Overturning Streamfunction', 'm3 s-1') + 'Parameterized Zonal Overturning Streamfunction', & + 'm3 s-1', conversion=GV%H_to_m*US%L_to_m**2*US%s_to_T) CS%id_sfn_y = register_diag_field('ocean_model', 'GM_sfn_y', diag%axesCvi, Time, & - 'Parameterized Meridional Overturning Streamfunction', 'm3 s-1') + 'Parameterized Meridional Overturning Streamfunction', & + 'm3 s-1', conversion=GV%H_to_m*US%L_to_m**2*US%s_to_T) CS%id_sfn_unlim_x = register_diag_field('ocean_model', 'GM_sfn_unlim_x', diag%axesCui, Time, & 'Parameterized Zonal Overturning Streamfunction before limiting/smoothing', & - 'm3 s-1', conversion=US%Z_to_m) + 'm3 s-1', conversion=US%Z_to_m*US%L_to_m**2*US%s_to_T) CS%id_sfn_unlim_y = register_diag_field('ocean_model', 'GM_sfn_unlim_y', diag%axesCvi, Time, & 'Parameterized Meridional Overturning Streamfunction before limiting/smoothing', & - 'm3 s-1', conversion=US%Z_to_m) + 'm3 s-1', conversion=US%Z_to_m*US%L_to_m**2*US%s_to_T) end subroutine thickness_diffuse_init From 4031ab9cab02d0b66de52e043d27870e9df98f37 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Fri, 9 Aug 2019 05:09:21 -0400 Subject: [PATCH 173/297] +Rescaled VarMix%L2u & VarMix%L2v to units of [L2] Rescaled the units of VarMix%L2u and VarMix%L2v to [L2] for more complete dimensional consistency testing. All answers are bitwise identical. --- .../lateral/MOM_lateral_mixing_coeffs.F90 | 18 ++++++++++-------- .../lateral/MOM_thickness_diffuse.F90 | 4 ++-- src/tracer/MOM_tracer_hor_diff.F90 | 4 ++-- 3 files changed, 14 insertions(+), 12 deletions(-) diff --git a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 index 00112c3d15..d263db1a28 100644 --- a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 +++ b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 @@ -53,8 +53,8 @@ module MOM_lateral_mixing_coeffs real, dimension(:,:), pointer :: & SN_u => NULL(), & !< S*N at u-points [s-1] SN_v => NULL(), & !< S*N at v-points [s-1] - L2u => NULL(), & !< Length scale^2 at u-points [m2] - L2v => NULL(), & !< Length scale^2 at v-points [m2] + L2u => NULL(), & !< Length scale^2 at u-points [L2 ~> m2] + L2v => NULL(), & !< Length scale^2 at v-points [L2 ~> 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 [nondim]. @@ -1026,20 +1026,22 @@ subroutine VarMix_init(Time, G, GV, US, param_file, diag, CS) allocate(CS%L2v(isd:ied,JsdB:JedB)) ; CS%L2v(:,:) = 0.0 if (CS%Visbeck_L_scale<0) then do j=js,je ; do I=is-1,Ieq - CS%L2u(I,j) = CS%Visbeck_L_scale**2 * US%L_to_m**2*G%areaCu(I,j) + CS%L2u(I,j) = CS%Visbeck_L_scale**2 * G%areaCu(I,j) enddo; enddo do J=js-1,Jeq ; do i=is,ie - CS%L2v(i,J) = CS%Visbeck_L_scale**2 * US%L_to_m**2*G%areaCv(i,J) + CS%L2v(i,J) = CS%Visbeck_L_scale**2 * G%areaCv(i,J) enddo; enddo else - CS%L2u(:,:) = CS%Visbeck_L_scale**2 - CS%L2v(:,:) = CS%Visbeck_L_scale**2 + CS%L2u(:,:) = US%m_to_L**2*CS%Visbeck_L_scale**2 + CS%L2v(:,:) = US%m_to_L**2*CS%Visbeck_L_scale**2 endif CS%id_L2u = register_diag_field('ocean_model', 'L2u', diag%axesCu1, Time, & - 'Length scale squared for mixing coefficient, at u-points', 'm2') + 'Length scale squared for mixing coefficient, at u-points', & + 'm2', conversion=US%L_to_m**2) CS%id_L2v = register_diag_field('ocean_model', 'L2v', diag%axesCv1, Time, & - 'Length scale squared for mixing coefficient, at v-points', 'm2') + 'Length scale squared for mixing coefficient, at v-points', & + 'm2', conversion=US%L_to_m**2) endif if (CS%use_stored_slopes) then diff --git a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 index 8fa5beb918..e160602be1 100644 --- a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 +++ b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 @@ -211,7 +211,7 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp if (use_Visbeck) then do j=js,je ; do I=is-1,ie Khth_loc_u(I,j) = Khth_loc_u(I,j) + & - CS%KHTH_Slope_Cff*US%m_to_L**2*VarMix%L2u(I,j) * US%T_to_s*VarMix%SN_u(I,j) + CS%KHTH_Slope_Cff*VarMix%L2u(I,j) * US%T_to_s*VarMix%SN_u(I,j) enddo ; enddo endif endif @@ -291,7 +291,7 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp !$OMP do if (use_Visbeck) then do J=js-1,je ; do i=is,ie - Khth_loc(i,j) = Khth_loc(i,j) + CS%KHTH_Slope_Cff*US%m_to_L**2*VarMix%L2v(i,J)*US%T_to_s*VarMix%SN_v(i,J) + Khth_loc(i,j) = Khth_loc(i,j) + CS%KHTH_Slope_Cff*VarMix%L2v(i,J)*US%T_to_s*VarMix%SN_v(i,J) enddo ; enddo endif endif diff --git a/src/tracer/MOM_tracer_hor_diff.F90 b/src/tracer/MOM_tracer_hor_diff.F90 index a61af65ee9..58d64b6de4 100644 --- a/src/tracer/MOM_tracer_hor_diff.F90 +++ b/src/tracer/MOM_tracer_hor_diff.F90 @@ -210,7 +210,7 @@ subroutine tracer_hordiff(h, dt, MEKE, VarMix, G, GV, US, CS, Reg, tv, do_online !$OMP parallel do default(shared) private(Kh_loc,Rd_dx) do j=js,je ; do I=is-1,ie Kh_loc = CS%KhTr - if (use_Eady) Kh_loc = Kh_loc + CS%KhTr_Slope_Cff*VarMix%L2u(I,j)*VarMix%SN_u(I,j) + if (use_Eady) Kh_loc = Kh_loc + CS%KhTr_Slope_Cff*US%L_to_m**2*VarMix%L2u(I,j)*VarMix%SN_u(I,j) if (associated(MEKE%Kh)) & Kh_Loc = Kh_Loc + MEKE%KhTr_fac*US%L_to_m**2*US%s_to_T*sqrt(MEKE%Kh(i,j)*MEKE%Kh(i+1,j)) if (CS%KhTr_max > 0.) Kh_loc = min(Kh_loc, CS%KhTr_max) @@ -227,7 +227,7 @@ subroutine tracer_hordiff(h, dt, MEKE, VarMix, G, GV, US, CS, Reg, tv, do_online !$OMP parallel do default(shared) private(Kh_loc,Rd_dx) do J=js-1,je ; do i=is,ie Kh_loc = CS%KhTr - if (use_Eady) Kh_loc = Kh_loc + CS%KhTr_Slope_Cff*VarMix%L2v(i,J)*VarMix%SN_v(i,J) + if (use_Eady) Kh_loc = Kh_loc + CS%KhTr_Slope_Cff*US%L_to_m**2*VarMix%L2v(i,J)*VarMix%SN_v(i,J) if (associated(MEKE%Kh)) & Kh_Loc = Kh_Loc + MEKE%KhTr_fac*US%L_to_m**2*US%s_to_T*sqrt(MEKE%Kh(i,j)*MEKE%Kh(i,j+1)) if (CS%KhTr_max > 0.) Kh_loc = min(Kh_loc, CS%KhTr_max) From b4fa597aa5be153f0018efc184cc54e1a1895941 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Fri, 9 Aug 2019 06:10:02 -0400 Subject: [PATCH 174/297] +Rescaled VarMix%SN_u and VarMix%SN_v to [T-1] Rescaled the units of VarMix%SN_u and VarMix%SN_v to [T-1] for more complete dimensional consistency testing. All answers are bitwise identical. --- src/parameterizations/lateral/MOM_MEKE.F90 | 18 +++++----- .../lateral/MOM_lateral_mixing_coeffs.F90 | 33 ++++++++++--------- .../lateral/MOM_thickness_diffuse.F90 | 10 +++--- src/tracer/MOM_tracer_hor_diff.F90 | 4 +-- 4 files changed, 33 insertions(+), 32 deletions(-) diff --git a/src/parameterizations/lateral/MOM_MEKE.F90 b/src/parameterizations/lateral/MOM_MEKE.F90 index 915290d90a..9f43034564 100644 --- a/src/parameterizations/lateral/MOM_MEKE.F90 +++ b/src/parameterizations/lateral/MOM_MEKE.F90 @@ -104,8 +104,8 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness [H ~> m or kg m-2]. - real, dimension(SZIB_(G),SZJ_(G)), intent(inout) :: SN_u !< Eady growth rate at u-points [s-1]. - real, dimension(SZI_(G),SZJB_(G)), intent(inout) :: SN_v !< Eady growth rate at v-points [s-1]. + real, dimension(SZIB_(G),SZJ_(G)), intent(in) :: SN_u !< Eady growth rate at u-points [T-1 ~> s-1]. + real, dimension(SZI_(G),SZJB_(G)), intent(in) :: SN_v !< Eady growth rate at v-points [T-1 ~> s-1]. type(vertvisc_type), intent(in) :: visc !< The vertical viscosity type. real, intent(in) :: dt !< Model(baroclinic) time-step [s]. type(MEKE_CS), pointer :: CS !< MEKE control structure. @@ -189,7 +189,7 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h if (associated(MEKE%GM_src)) & call hchksum(MEKE%GM_src, 'MEKE GM_src', G%HI, scale=US%L_to_m**2*US%s_to_T**3) if (associated(MEKE%MEKE)) call hchksum(MEKE%MEKE, 'MEKE MEKE', G%HI, scale=US%L_T_to_m_s**2) - call uvchksum("MEKE SN_[uv]", SN_u, SN_v, G%HI) + call uvchksum("MEKE SN_[uv]", SN_u, SN_v, G%HI, scale=US%s_to_T) call uvchksum("MEKE h[uv]", hu, hv, G%HI, haloshift=1, scale=GV%H_to_m) endif @@ -642,8 +642,8 @@ subroutine MEKE_equilibrium(CS, MEKE, G, GV, US, SN_u, SN_v, drag_rate_visc, I_m type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(MEKE_CS), pointer :: CS !< MEKE control structure. type(MEKE_type), pointer :: MEKE !< A structure with MEKE data. - real, dimension(SZIB_(G),SZJ_(G)), intent(in) :: SN_u !< Eady growth rate at u-points [s-1]. - real, dimension(SZI_(G),SZJB_(G)), intent(in) :: SN_v !< Eady growth rate at v-points [s-1]. + real, dimension(SZIB_(G),SZJ_(G)), intent(in) :: SN_u !< Eady growth rate at u-points [T-1 ~> s-1]. + real, dimension(SZI_(G),SZJB_(G)), intent(in) :: SN_v !< Eady growth rate at v-points [T-1 ~> s-1]. real, dimension(SZI_(G),SZJ_(G)), intent(in) :: drag_rate_visc !< Mean flow velocity contribution !! to the MEKE drag rate [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJ_(G)), intent(in) :: I_mass !< Inverse of column mass [m2 kg-1]. @@ -678,7 +678,7 @@ subroutine MEKE_equilibrium(CS, MEKE, G, GV, US, SN_u, SN_v, drag_rate_visc, I_m do j=js,je ; do i=is,ie ! SN = 0.25*max( (SN_u(I,j) + SN_u(I-1,j)) + (SN_v(i,J) + SN_v(i,J-1)), 0.) ! This avoids extremes values in equilibrium solution due to bad values in SN_u, SN_v - SN = US%T_to_s * min(SN_u(I,j), SN_u(I-1,j), SN_v(i,J), SN_v(i,J-1)) + SN = min(SN_u(I,j), SN_u(I-1,j), SN_v(i,J), SN_v(i,J-1)) FatH = 0.25*((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 @@ -801,8 +801,8 @@ subroutine MEKE_lengthScales(CS, MEKE, G, GV, US, SN_u, SN_v, & type(ocean_grid_type), intent(inout) :: 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 - real, dimension(SZIB_(G),SZJ_(G)), intent(in) :: SN_u !< Eady growth rate at u-points [s-1]. - real, dimension(SZI_(G),SZJB_(G)), intent(in) :: SN_v !< Eady growth rate at v-points [s-1]. + real, dimension(SZIB_(G),SZJ_(G)), intent(in) :: SN_u !< Eady growth rate at u-points [T-1 ~> s-1]. + real, dimension(SZI_(G),SZJB_(G)), intent(in) :: SN_v !< Eady growth rate at v-points [T-1 ~> s-1]. real, dimension(SZI_(G),SZJ_(G)), intent(in) :: EKE !< Eddy kinetic energy [L2 T-2 ~> m2 s-2]. real, dimension(SZI_(G),SZJ_(G)), intent(out) :: bottomFac2 !< gamma_b^2 real, dimension(SZI_(G),SZJ_(G)), intent(out) :: barotrFac2 !< gamma_t^2 @@ -821,7 +821,7 @@ subroutine MEKE_lengthScales(CS, MEKE, G, GV, US, SN_u, SN_v, & do j=js,je ; do i=is,ie if (.not.CS%use_old_lscale) then if (CS%aEady > 0.) then - SN = 0.25 * US%T_to_s*( (SN_u(I,j) + SN_u(I-1,j)) + (SN_v(i,J) + SN_v(i,J-1)) ) + SN = 0.25 * ( (SN_u(I,j) + SN_u(I-1,j)) + (SN_v(i,J) + SN_v(i,J-1)) ) else SN = 0. endif diff --git a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 index d263db1a28..89d7ecc92d 100644 --- a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 +++ b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 @@ -51,11 +51,11 @@ module MOM_lateral_mixing_coeffs logical :: calculate_Eady_growth_rate !< If true, calculate all the Eady growth rate. !! This parameter is set depending on other parameters. real, dimension(:,:), pointer :: & - SN_u => NULL(), & !< S*N at u-points [s-1] - SN_v => NULL(), & !< S*N at v-points [s-1] - L2u => NULL(), & !< Length scale^2 at u-points [L2 ~> m2] - L2v => NULL(), & !< Length scale^2 at v-points [L2 ~> m2] - cg1 => NULL(), & !< The first baroclinic gravity wave speed [m s-1]. + SN_u => NULL(), & !< S*N at u-points [T-1 ~> s-1] + SN_v => NULL(), & !< S*N at v-points [T-1 ~> s-1] + L2u => NULL(), & !< Length scale^2 at u-points [L2 ~> m2] + L2v => NULL(), & !< Length scale^2 at v-points [L2 ~> 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 [nondim]. Res_fn_q => NULL(), & !< Non-dimensional function of the ratio the first baroclinic @@ -418,7 +418,7 @@ subroutine calc_slope_functions(h, tv, dt, G, GV, US, CS) if (CS%use_stored_slopes) then call calc_isoneutral_slopes(G, GV, US, h, e, tv, dt*CS%kappa_smooth, & CS%slope_x, CS%slope_y, N2_u, N2_v, 1) - call calc_Visbeck_coeffs(h, CS%slope_x, CS%slope_y, N2_u, N2_v, G, GV, CS) + call calc_Visbeck_coeffs(h, CS%slope_x, CS%slope_y, N2_u, N2_v, G, GV, US, CS) ! call calc_slope_functions_using_just_e(h, G, CS, e, .false.) else !call calc_isoneutral_slopes(G, GV, h, e, tv, dt*CS%kappa_smooth, CS%slope_x, CS%slope_y) @@ -438,7 +438,7 @@ subroutine calc_slope_functions(h, tv, dt, G, GV, US, CS) end subroutine calc_slope_functions !> Calculates factors used when setting diffusivity coefficients similar to Visbeck et al. -subroutine calc_Visbeck_coeffs(h, slope_x, slope_y, N2_u, N2_v, G, GV, CS) +subroutine calc_Visbeck_coeffs(h, slope_x, slope_y, N2_u, N2_v, G, GV, US, CS) type(ocean_grid_type), intent(inout) :: 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] @@ -446,6 +446,7 @@ subroutine calc_Visbeck_coeffs(h, slope_x, slope_y, N2_u, N2_v, G, GV, CS) real, dimension(SZIB_(G),SZJ_(G),SZK_(G)+1), intent(in) :: N2_u !< Brunt-Vaisala frequency at u-points [s-2] real, dimension(SZI_(G),SZJB_(G),SZK_(G)+1), intent(in) :: slope_y !< Meridional isoneutral slope real, dimension(SZI_(G),SZJB_(G),SZK_(G)+1), intent(in) :: N2_v !< Brunt-Vaisala frequency at v-points [s-2] + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(VarMix_CS), pointer :: CS !< Variable mixing coefficients ! Local variables @@ -504,7 +505,7 @@ subroutine calc_Visbeck_coeffs(h, slope_x, slope_y, N2_u, N2_v, G, GV, CS) 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 + CS%SN_u(I,j) = CS%SN_u(I,j) + US%T_to_s*sqrt( S2*N2 )*H_geom S2_u(I,j) = S2_u(I,j) + S2*H_geom H_u(I) = H_u(I) + H_geom enddo ; enddo @@ -540,7 +541,7 @@ subroutine calc_Visbeck_coeffs(h, slope_x, slope_y, N2_u, N2_v, G, GV, CS) 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 + CS%SN_v(i,J) = CS%SN_v(i,J) + US%T_to_s*sqrt( S2*N2 )*H_geom S2_v(i,J) = S2_v(i,J) + S2*H_geom H_v(i) = H_v(i) + H_geom enddo ; enddo @@ -563,7 +564,7 @@ subroutine calc_Visbeck_coeffs(h, slope_x, slope_y, N2_u, N2_v, G, GV, CS) if (CS%debug) then call uvchksum("calc_Visbeck_coeffs slope_[xy]", slope_x, slope_y, G%HI, haloshift=1) call uvchksum("calc_Visbeck_coeffs N2_u, N2_v", N2_u, N2_v, G%HI) - call uvchksum("calc_Visbeck_coeffs SN_[uv]", CS%SN_u, CS%SN_v, G%HI) + call uvchksum("calc_Visbeck_coeffs SN_[uv]", CS%SN_u, CS%SN_v, G%HI, scale=US%s_to_T) endif end subroutine calc_Visbeck_coeffs @@ -671,14 +672,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) + S2N2_u_local(I,j,k) + CS%SN_u(I,j) = CS%SN_u(I,j) + US%T_to_s*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) * US%s_to_T * sqrt( CS%SN_u(I,j) / & + CS%SN_u(I,j) = G%mask2dCu(I,j) * sqrt( US%s_to_T*CS%SN_u(I,j) / & (max(G%bathyT(I,j), G%bathyT(I+1,j))) ) else CS%SN_u(I,j) = 0.0 @@ -689,13 +690,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) + S2N2_v_local(i,J,k) + CS%SN_v(i,J) = CS%SN_v(i,J) + US%T_to_s*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) * US%s_to_T * sqrt( CS%SN_v(i,J) / & + CS%SN_v(i,J) = G%mask2dCv(i,J) * sqrt( US%s_to_T*CS%SN_v(i,J) / & (max(G%bathyT(i,J), G%bathyT(i,J+1))) ) else CS%SN_v(I,j) = 0.0 @@ -1008,9 +1009,9 @@ subroutine VarMix_init(Time, G, GV, US, param_file, diag, CS) allocate(CS%SN_u(IsdB:IedB,jsd:jed)) ; CS%SN_u(:,:) = 0.0 allocate(CS%SN_v(isd:ied,JsdB:JedB)) ; CS%SN_v(:,:) = 0.0 CS%id_SN_u = register_diag_field('ocean_model', 'SN_u', diag%axesCu1, Time, & - 'Inverse eddy time-scale, S*N, at u-points', 's-1') + 'Inverse eddy time-scale, S*N, at u-points', 's-1', conversion=US%s_to_T) CS%id_SN_v = register_diag_field('ocean_model', 'SN_v', diag%axesCv1, Time, & - 'Inverse eddy time-scale, S*N, at v-points', 's-1') + 'Inverse eddy time-scale, S*N, at v-points', 's-1', conversion=US%s_to_T) call get_param(param_file, mdl, "VARMIX_KTOP", CS%VarMix_Ktop, & "The layer number at which to start vertical integration "//& "of S*N for purposes of finding the Eady growth rate.", & diff --git a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 index e160602be1..7c8ea4d79c 100644 --- a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 +++ b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 @@ -211,7 +211,7 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp if (use_Visbeck) then do j=js,je ; do I=is-1,ie Khth_loc_u(I,j) = Khth_loc_u(I,j) + & - CS%KHTH_Slope_Cff*VarMix%L2u(I,j) * US%T_to_s*VarMix%SN_u(I,j) + CS%KHTH_Slope_Cff*VarMix%L2u(I,j) * VarMix%SN_u(I,j) enddo ; enddo endif endif @@ -222,7 +222,7 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp 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)) / & - (US%T_to_s*VarMix%SN_u(I,j) + CS%MEKE_GEOMETRIC_epsilon) + (VarMix%SN_u(I,j) + CS%MEKE_GEOMETRIC_epsilon) enddo ; enddo else do j=js,je ; do I=is-1,ie @@ -291,7 +291,7 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp !$OMP do if (use_Visbeck) then do J=js-1,je ; do i=is,ie - Khth_loc(i,j) = Khth_loc(i,j) + CS%KHTH_Slope_Cff*VarMix%L2v(i,J)*US%T_to_s*VarMix%SN_v(i,J) + Khth_loc(i,j) = Khth_loc(i,j) + CS%KHTH_Slope_Cff*VarMix%L2v(i,J)*VarMix%SN_v(i,J) enddo ; enddo endif endif @@ -301,7 +301,7 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp 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)) / & - (US%T_to_s*VarMix%SN_v(i,J) + CS%MEKE_GEOMETRIC_epsilon) + (VarMix%SN_v(i,J) + CS%MEKE_GEOMETRIC_epsilon) enddo ; enddo else do J=js-1,je ; do i=is,ie @@ -370,7 +370,7 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp do j=js,je ; do I=is,ie !### This will not give bitwise rotational symmetry. Add parentheses. MEKE%Kh(i,j) = CS%MEKE_GEOMETRIC_alpha * MEKE%MEKE(i,j) / & - (0.25*US%T_to_s*(VarMix%SN_u(I,j)+VarMix%SN_u(I-1,j)+VarMix%SN_v(i,J)+VarMix%SN_v(i,J-1)) + & + (0.25*(VarMix%SN_u(I,j)+VarMix%SN_u(I-1,j)+VarMix%SN_v(i,J)+VarMix%SN_v(i,J-1)) + & CS%MEKE_GEOMETRIC_epsilon) enddo ; enddo endif diff --git a/src/tracer/MOM_tracer_hor_diff.F90 b/src/tracer/MOM_tracer_hor_diff.F90 index 58d64b6de4..7ca336bd91 100644 --- a/src/tracer/MOM_tracer_hor_diff.F90 +++ b/src/tracer/MOM_tracer_hor_diff.F90 @@ -210,7 +210,7 @@ subroutine tracer_hordiff(h, dt, MEKE, VarMix, G, GV, US, CS, Reg, tv, do_online !$OMP parallel do default(shared) private(Kh_loc,Rd_dx) do j=js,je ; do I=is-1,ie Kh_loc = CS%KhTr - if (use_Eady) Kh_loc = Kh_loc + CS%KhTr_Slope_Cff*US%L_to_m**2*VarMix%L2u(I,j)*VarMix%SN_u(I,j) + if (use_Eady) Kh_loc = Kh_loc + CS%KhTr_Slope_Cff*US%L_to_m**2*VarMix%L2u(I,j)*US%s_to_T*VarMix%SN_u(I,j) if (associated(MEKE%Kh)) & Kh_Loc = Kh_Loc + MEKE%KhTr_fac*US%L_to_m**2*US%s_to_T*sqrt(MEKE%Kh(i,j)*MEKE%Kh(i+1,j)) if (CS%KhTr_max > 0.) Kh_loc = min(Kh_loc, CS%KhTr_max) @@ -227,7 +227,7 @@ subroutine tracer_hordiff(h, dt, MEKE, VarMix, G, GV, US, CS, Reg, tv, do_online !$OMP parallel do default(shared) private(Kh_loc,Rd_dx) do J=js-1,je ; do i=is,ie Kh_loc = CS%KhTr - if (use_Eady) Kh_loc = Kh_loc + CS%KhTr_Slope_Cff*US%L_to_m**2*VarMix%L2v(i,J)*VarMix%SN_v(i,J) + if (use_Eady) Kh_loc = Kh_loc + CS%KhTr_Slope_Cff*US%L_to_m**2*VarMix%L2v(i,J)*US%s_to_T*VarMix%SN_v(i,J) if (associated(MEKE%Kh)) & Kh_Loc = Kh_Loc + MEKE%KhTr_fac*US%L_to_m**2*US%s_to_T*sqrt(MEKE%Kh(i,j)*MEKE%Kh(i,j+1)) if (CS%KhTr_max > 0.) Kh_loc = min(Kh_loc, CS%KhTr_max) From 8067dfa75ed1124bce29fe1f7dd3d7293093848f Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Fri, 9 Aug 2019 07:00:42 -0400 Subject: [PATCH 175/297] +Rescaled VarMix%cg1 to units of [L T-1] Rescaled the units of VarMix%cg1 to [L T-1] and the units of VarMix%Kh_u_QG and VarMix%Kh_v_QG to [L2 T-1] for more complete dimensional consistency testing. All answers are bitwise identical. --- .../lateral/MOM_lateral_mixing_coeffs.F90 | 72 ++++++++++--------- .../lateral/MOM_thickness_diffuse.F90 | 12 ++-- 2 files changed, 43 insertions(+), 41 deletions(-) diff --git a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 index 89d7ecc92d..c3feb9c4b4 100644 --- a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 +++ b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 @@ -55,7 +55,7 @@ module MOM_lateral_mixing_coeffs SN_v => NULL(), & !< S*N at v-points [T-1 ~> s-1] L2u => NULL(), & !< Length scale^2 at u-points [L2 ~> m2] L2v => NULL(), & !< Length scale^2 at v-points [L2 ~> m2] - cg1 => NULL(), & !< The first baroclinic gravity wave speed [m s-1]. + cg1 => NULL(), & !< The first baroclinic gravity wave speed [L T-1 ~> 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 [nondim]. Res_fn_q => NULL(), & !< Non-dimensional function of the ratio the first baroclinic @@ -95,10 +95,10 @@ module MOM_lateral_mixing_coeffs Laplac3_const_v !< Laplacian metric-dependent constants [nondim] real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_,NKMEM_) :: & - KH_u_QG !< QG Leith GM coefficient at u-points [m2 s-1] + KH_u_QG !< QG Leith GM coefficient at u-points [L2 T-1 ~> m2 s-1] real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_,NKMEM_) :: & - KH_v_QG !< QG Leith GM coefficient at v-points [m2 s-1] + KH_v_QG !< QG Leith GM coefficient at v-points [L2 T-1 ~> m2 s-1] ! Parameters logical :: use_Visbeck !< Use Visbeck formulation for thickness diffusivity @@ -187,6 +187,10 @@ subroutine calc_resoln_function(h, tv, G, GV, US, CS) call wave_speed(h, tv, G, GV, US, CS%cg1, CS%wave_speed_CSp) endif + do j=js,je ; do i=is,ie + CS%cg1(i,j) = US%m_s_to_L_T*CS%cg1(i,j) + enddo ; enddo + call create_group_pass(CS%pass_cg1, CS%cg1, G%Domain) call do_group_pass(CS%pass_cg1, G%Domain) endif @@ -196,13 +200,11 @@ subroutine calc_resoln_function(h, tv, G, GV, US, CS) if (CS%calculate_rd_dx) then if (.not. associated(CS%Rd_dx_h)) call MOM_error(FATAL, & "calc_resoln_function: %Rd_dx_h is not associated with calculate_rd_dx.") -!$OMP parallel default(none) shared(is,ie,js,je,CS) -!$OMP do + !$OMP parallel do default(shared) do j=js-1,je+1 ; do i=is-1,ie+1 - 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))) + CS%Rd_dx_h(i,j) = US%L_to_m*CS%cg1(i,j) / & + (sqrt(CS%f2_dx2_h(i,j) + US%L_to_m*CS%cg1(i,j)*CS%beta_dx2_h(i,j))) enddo ; enddo -!$OMP end parallel if (query_averaging_enabled(CS%diag)) then if (CS%id_Rd_dx > 0) call post_data(CS%id_Rd_dx, CS%Rd_dx_h, CS%diag) endif @@ -243,8 +245,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) + 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 + dx_term = CS%f2_dx2_h(i,j) + US%L_to_m*CS%cg1(i,j)*CS%beta_dx2_h(i,j) + if ((CS%Res_coef_visc * US%L_to_m*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 @@ -252,7 +254,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 = US%T_to_s * 0.25 * ((CS%cg1(i,j) + CS%cg1(i+1,j+1)) + & + cg1_q = US%L_to_m * 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 @@ -264,12 +266,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) + 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) + dx_term = CS%f2_dx2_h(i,j) + US%L_to_m*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%L_to_m*CS%cg1(i,j))**2) enddo ; enddo !$OMP do do J=js-1,Jeq ; do I=is-1,Ieq - cg1_q = US%T_to_s * 0.25 * ((CS%cg1(i,j) + CS%cg1(i+1,j+1)) + & + cg1_q = US%L_to_m * 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) @@ -278,13 +280,13 @@ 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 = (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 + dx_term = (US%s_to_T**2*CS%f2_dx2_h(i,j) + US%s_to_T*US%L_T_to_m_s*CS%cg1(i,j)*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) + (dx_term + (CS%Res_coef_visc * US%L_T_to_m_s*CS%cg1(i,j))**CS%Res_fn_power_visc) 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 = 0.25 * US%L_T_to_m_s*((CS%cg1(i,j) + CS%cg1(i+1,j+1)) + & (CS%cg1(i+1,j) + CS%cg1(i,j+1))) 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 / & @@ -294,13 +296,13 @@ subroutine calc_resoln_function(h, tv, G, GV, US, CS) !$OMP do do j=js-1,je+1 ; do i=is-1,ie+1 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 + US%L_to_m*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) + (dx_term + (CS%Res_coef_visc * US%L_T_to_m_s*CS%cg1(i,j))**CS%Res_fn_power_visc) 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 = 0.25 * US%L_T_to_m_s*((CS%cg1(i,j) + CS%cg1(i+1,j+1)) + & (CS%cg1(i+1,j) + CS%cg1(i,j+1))) 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 @@ -320,7 +322,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 * US%T_to_s * (CS%cg1(i,j) + CS%cg1(i+1,j)) + cg1_u = 0.5 * US%L_to_m * (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 @@ -330,7 +332,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 * US%T_to_s * (CS%cg1(i,j) + CS%cg1(i,j+1)) + cg1_v = 0.5 * US%L_to_m * (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 @@ -341,13 +343,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 * US%T_to_s * (CS%cg1(i,j) + CS%cg1(i+1,j)) + cg1_u = 0.5 * US%L_to_m * (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 * US%T_to_s * (CS%cg1(i,j) + CS%cg1(i,j+1)) + cg1_v = 0.5 * US%L_to_m * (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 @@ -355,14 +357,14 @@ subroutine calc_resoln_function(h, tv, G, GV, US, CS) power_2 = CS%Res_fn_power_khth / 2 !$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%L_T_to_m_s * (CS%cg1(i,j) + CS%cg1(i+1,j)) 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)) + cg1_v = 0.5 * US%L_T_to_m_s * (CS%cg1(i,j) + CS%cg1(i,j+1)) 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) @@ -370,7 +372,7 @@ subroutine calc_resoln_function(h, tv, G, GV, US, CS) else !$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%L_T_to_m_s * (CS%cg1(i,j) + CS%cg1(i+1,j)) 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 / & @@ -378,7 +380,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%L_T_to_m_s * (CS%cg1(i,j) + CS%cg1(i,j+1)) 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 / & @@ -834,10 +836,10 @@ subroutine calc_QG_Leith_viscosity(CS, G, GV, US, h, k, div_xx_dx, div_xx_dy, vo if (CS%use_beta_in_QG_Leith) then beta_u(I,j) = US%m_to_L*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%KH_u_QG(I,j,k) = US%m_to_L**2*US%T_to_s*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%KH_u_QG(I,j,k) = US%m_to_L**2*US%T_to_s*(grad_vort_mag_u(I,j) + grad_div_mag_u(I,j)) & * CS%Laplac3_const_u(I,j) * inv_PI3 endif enddo ; enddo @@ -850,10 +852,10 @@ subroutine calc_QG_Leith_viscosity(CS, G, GV, US, h, k, div_xx_dx, div_xx_dy, vo if (CS%use_beta_in_QG_Leith) then beta_v(i,J) = US%m_to_L*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%KH_v_QG(i,J,k) = US%m_to_L**2*US%T_to_s*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%KH_v_QG(i,J,k) = US%m_to_L**2*US%T_to_s*(grad_vort_mag_v(i,J) + grad_div_mag_v(i,J)) & * CS%Laplac3_const_v(i,J) * inv_PI3 endif enddo ; enddo @@ -1181,7 +1183,7 @@ subroutine VarMix_init(Time, G, GV, US, param_file, diag, CS) if (CS%calculate_cg1) then in_use = .true. - allocate(CS%cg1(isd:ied,jsd:jed)); CS%cg1(:,:) = 0.0 + allocate(CS%cg1(isd:ied,jsd:jed)) ; CS%cg1(:,:) = 0.0 call wave_speed_init(CS%wave_speed_CSp, use_ebt_mode=CS%Resoln_use_ebt, mono_N2_depth=N2_filter_depth) endif @@ -1206,9 +1208,9 @@ subroutine VarMix_init(Time, G, GV, US, param_file, diag, CS) ! register diagnostics CS%id_KH_u_QG = register_diag_field('ocean_model', 'KH_u_QG', diag%axesCuL, Time, & - 'Horizontal viscosity from Leith QG, at u-points', 'm2 s-1') + 'Horizontal viscosity from Leith QG, at u-points', 'm2 s-1', conversion=US%L_to_m**2*US%s_to_T) CS%id_KH_v_QG = register_diag_field('ocean_model', 'KH_v_QG', diag%axesCvL, Time, & - 'Horizontal viscosity from Leith QG, at v-points', 'm2 s-1') + 'Horizontal viscosity from Leith QG, at v-points', 'm2 s-1', conversion=US%L_to_m**2*US%s_to_T) do j=Jsq,Jeq+1 ; do I=is-1,Ieq ! Static factors in the Leith schemes diff --git a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 index 7c8ea4d79c..0213ccb319 100644 --- a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 +++ b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 @@ -140,7 +140,7 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp real :: Khth_Loc(SZIB_(G), SZJB_(G)) ! locally calculated thickness diffusivity [L2 T-1 ~> m2 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, dimension(:,:), pointer :: cg1 => null() !< Wave speed [m s-1] + real, dimension(:,:), pointer :: cg1 => null() !< Wave speed [L T-1 ~> m s-1] real :: dt_in_T ! Time increment [T ~> s] logical :: use_VarMix, Resoln_scaled, use_stored_slopes, khth_use_ebt_struct, use_Visbeck logical :: use_QG_Leith @@ -270,7 +270,7 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp !$OMP do if (use_QG_Leith) then do k=1,nz ; do j=js,je ; do I=is-1,ie - KH_u(I,j,k) = US%m_to_L**2*US%T_to_s*VarMix%KH_u_QG(I,j,k) + KH_u(I,j,k) = VarMix%KH_u_QG(I,j,k) enddo ; enddo ; enddo endif endif @@ -352,7 +352,7 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp !$OMP do if (use_QG_Leith) then do k=1,nz ; do J=js-1,je ; do i=is,ie - KH_v(i,J,k) = US%m_to_L**2*US%T_to_s*VarMix%KH_v_QG(i,J,k) + KH_v(i,J,k) = VarMix%KH_v_QG(i,J,k) enddo ; enddo ; enddo endif endif @@ -528,7 +528,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt_in_T, !! [H L2 T-1 ~> m3 s-1 or kg s-1] real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(out) :: vhD !< Meridional mass fluxes !! [H L2 T-1 ~> m3 s-1 or kg s-1] - real, dimension(:,:), pointer :: cg1 !< Wave speed [m s-1] + real, dimension(:,:), pointer :: cg1 !< Wave speed [L T-1 ~> m s-1] real, intent(in) :: dt_in_T !< Time increment [T ~> s] type(MEKE_type), pointer :: MEKE !< MEKE control structure type(thickness_diffuse_CS), pointer :: CS !< Control structure for thickness diffusion @@ -880,7 +880,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt_in_T, h_harm = max( h_neglect, & 2. * h(i,j,k) * h(i+1,j,k) / ( ( h(i,j,k) + h(i+1,j,k) ) + h_neglect ) ) c2_h_u(I,k) = CS%FGNV_scale * & - ( 0.5*US%m_s_to_L_T*( cg1(i,j) + cg1(i+1,j) ) )**2 / (GV%H_to_Z*h_harm) + ( 0.5*( cg1(i,j) + cg1(i+1,j) ) )**2 / (GV%H_to_Z*h_harm) endif ; enddo ; enddo ! Solve an elliptic equation for the streamfunction following Ferrari et al., 2010. @@ -1130,7 +1130,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt_in_T, h_harm = max( h_neglect, & 2. * h(i,j,k) * h(i,j+1,k) / ( ( h(i,j,k) + h(i,j+1,k) ) + h_neglect ) ) c2_h_v(i,k) = CS%FGNV_scale * & - ( 0.5*US%m_s_to_L_T*( cg1(i,j) + cg1(i,j+1) ) )**2 / (GV%H_to_Z*h_harm) + ( 0.5*( cg1(i,j) + cg1(i,j+1) ) )**2 / (GV%H_to_Z*h_harm) endif ; enddo ; enddo ! Solve an elliptic equation for the streamfunction following Ferrari et al., 2010. From e026e6e830b7cd5fc4d493c61b5a02a97af308a2 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Fri, 9 Aug 2019 16:16:28 -0400 Subject: [PATCH 176/297] Rescaled variables in MOM_lateral_mixing_coeffs.F90 Rescaled multiple internal variables in MOM_lateral_mixing_coeffs.F90 for more complete dimensional consistency testing. All answers are bitwise identical. --- .../lateral/MOM_lateral_mixing_coeffs.F90 | 232 +++++++++--------- 1 file changed, 115 insertions(+), 117 deletions(-) diff --git a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 index c3feb9c4b4..fa8d135b9b 100644 --- a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 +++ b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 @@ -65,34 +65,35 @@ module MOM_lateral_mixing_coeffs Res_fn_v => NULL(), & !< Non-dimensional function of the ratio the first baroclinic !! 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 [m T-1 ~> m s-1]. + !! times the grid spacing squared at h points [L 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 [m T-1 ~> m s-1]. + !! times the grid spacing squared at q points [L 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 [m T-1 ~> m s-1]. + !! times the grid spacing squared at u points [L 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 [m T-1 ~> m s-1]. + !! times the grid spacing squared at v points [L T-1 ~> m s-1]. f2_dx2_h => NULL(), & !< The Coriolis parameter squared times the grid - !! spacing squared at h [m2 T-2 ~> m2 s-2]. + !! spacing squared at h [L2 T-2 ~> m2 s-2]. f2_dx2_q => NULL(), & !< The Coriolis parameter squared times the grid - !! spacing squared at q [m2 T-2 ~> m2 s-2]. + !! spacing squared at q [L2 T-2 ~> m2 s-2]. f2_dx2_u => NULL(), & !< The Coriolis parameter squared times the grid - !! spacing squared at u [m2 T-2 ~> m2 s-2]. + !! spacing squared at u [L2 T-2 ~> m2 s-2]. f2_dx2_v => NULL(), & !< The Coriolis parameter squared times the grid - !! spacing squared at v [m2 T-2 ~> m2 s-2]. + !! spacing squared at v [L2 T-2 ~> m2 s-2]. Rd_dx_h => NULL() !< Deformation radius over grid spacing [nondim] real, dimension(:,:,:), pointer :: & slope_x => NULL(), & !< Zonal isopycnal slope [nondim] slope_y => NULL(), & !< Meridional isopycnal slope [nondim] + !### These are posted as diagnostics but are never set. N2_u => NULL(), & !< Brunt-Vaisala frequency at u-points [s-2] N2_v => NULL(), & !< Brunt-Vaisala frequency at v-points [s-2] ebt_struct => NULL() !< Vertical structure function to scale diffusivities with [nondim] real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_) :: & - Laplac3_const_u !< Laplacian metric-dependent constants [nondim] + Laplac3_const_u !< Laplacian metric-dependent constants [L3 ~> m3] real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_) :: & - Laplac3_const_v !< Laplacian metric-dependent constants [nondim] + Laplac3_const_v !< Laplacian metric-dependent constants [L3 ~> m3] real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_,NKMEM_) :: & KH_u_QG !< QG Leith GM coefficient at u-points [L2 T-1 ~> m2 s-1] @@ -202,8 +203,8 @@ subroutine calc_resoln_function(h, tv, G, GV, US, CS) "calc_resoln_function: %Rd_dx_h is not associated with calculate_rd_dx.") !$OMP parallel do default(shared) do j=js-1,je+1 ; do i=is-1,ie+1 - CS%Rd_dx_h(i,j) = US%L_to_m*CS%cg1(i,j) / & - (sqrt(CS%f2_dx2_h(i,j) + US%L_to_m*CS%cg1(i,j)*CS%beta_dx2_h(i,j))) + 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))) enddo ; enddo if (query_averaging_enabled(CS%diag)) then if (CS%id_Rd_dx > 0) call post_data(CS%id_Rd_dx, CS%Rd_dx_h, CS%diag) @@ -245,8 +246,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) + US%L_to_m*CS%cg1(i,j)*CS%beta_dx2_h(i,j) - if ((CS%Res_coef_visc * US%L_to_m*CS%cg1(i,j))**2 > dx_term) then + 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 CS%Res_fn_h(i,j) = 0.0 else CS%Res_fn_h(i,j) = 1.0 @@ -254,8 +255,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 = US%L_to_m * 0.25 * ((CS%cg1(i,j) + CS%cg1(i+1,j+1)) + & - (CS%cg1(i+1,j) + CS%cg1(i,j+1))) + 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) if ((CS%Res_coef_visc * cg1_q)**2 > dx_term) then CS%Res_fn_q(I,J) = 0.0 @@ -266,13 +266,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) + US%L_to_m*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%L_to_m*CS%cg1(i,j))**2) + 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) enddo ; enddo !$OMP do do J=js-1,Jeq ; do I=is-1,Ieq - cg1_q = US%L_to_m * 0.25 * ((CS%cg1(i,j) + CS%cg1(i+1,j+1)) + & - (CS%cg1(i+1,j) + CS%cg1(i,j+1))) + 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) CS%Res_fn_q(I,J) = dx_term / (dx_term + (CS%Res_coef_visc * cg1_q)**2) enddo ; enddo @@ -280,34 +279,32 @@ 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 = (US%s_to_T**2*CS%f2_dx2_h(i,j) + US%s_to_T*US%L_T_to_m_s*CS%cg1(i,j)*CS%beta_dx2_h(i,j))**power_2 + dx_term = (US%L_T_to_m_s**2*(CS%f2_dx2_h(i,j) + CS%cg1(i,j)*CS%beta_dx2_h(i,j)))**power_2 CS%Res_fn_h(i,j) = dx_term / & (dx_term + (CS%Res_coef_visc * US%L_T_to_m_s*CS%cg1(i,j))**CS%Res_fn_power_visc) enddo ; enddo !$OMP do do J=js-1,Jeq ; do I=is-1,Ieq - cg1_q = 0.25 * US%L_T_to_m_s*((CS%cg1(i,j) + CS%cg1(i+1,j+1)) + & - (CS%cg1(i+1,j) + CS%cg1(i,j+1))) - 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 + 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 = (US%L_T_to_m_s**2*(CS%f2_dx2_q(I,J) + cg1_q * 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) + (dx_term + (CS%Res_coef_visc * US%L_T_to_m_s*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 = (US%s_to_T*sqrt(CS%f2_dx2_h(i,j) + & - US%L_to_m*CS%cg1(i,j)*CS%beta_dx2_h(i,j)))**CS%Res_fn_power_visc + dx_term = (US%L_T_to_m_s*sqrt(CS%f2_dx2_h(i,j) + & + 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 * US%L_T_to_m_s*CS%cg1(i,j))**CS%Res_fn_power_visc) enddo ; enddo !$OMP do do J=js-1,Jeq ; do I=is-1,Ieq - cg1_q = 0.25 * US%L_T_to_m_s*((CS%cg1(i,j) + CS%cg1(i+1,j+1)) + & - (CS%cg1(i+1,j) + CS%cg1(i,j+1))) - 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 + 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 = (US%L_T_to_m_s*sqrt(CS%f2_dx2_q(I,J) + & + 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) + (dx_term + (CS%Res_coef_visc * US%L_T_to_m_s*cg1_q)**CS%Res_fn_power_visc) enddo ; enddo endif @@ -322,7 +319,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 * US%L_to_m * (CS%cg1(i,j) + CS%cg1(i+1,j)) + 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) if ((CS%Res_coef_khth * cg1_u)**2 > dx_term) then CS%Res_fn_u(I,j) = 0.0 @@ -332,7 +329,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 * US%L_to_m * (CS%cg1(i,j) + CS%cg1(i,j+1)) + 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) if ((CS%Res_coef_khth * cg1_v)**2 > dx_term) then CS%Res_fn_v(i,J) = 0.0 @@ -343,13 +340,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 * US%L_to_m * (CS%cg1(i,j) + CS%cg1(i+1,j)) + 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) 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 * US%L_to_m * (CS%cg1(i,j) + CS%cg1(i,j+1)) + 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) CS%Res_fn_v(i,J) = dx_term / (dx_term + (CS%Res_coef_khth * cg1_v)**2) enddo ; enddo @@ -357,34 +354,34 @@ subroutine calc_resoln_function(h, tv, G, GV, US, CS) power_2 = CS%Res_fn_power_khth / 2 !$OMP do do j=js,je ; do I=is-1,Ieq - cg1_u = 0.5 * US%L_T_to_m_s * (CS%cg1(i,j) + CS%cg1(i+1,j)) - 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 + cg1_u = 0.5 * (CS%cg1(i,j) + CS%cg1(i+1,j)) + dx_term = (US%L_T_to_m_s**2 * (CS%f2_dx2_u(I,j) + cg1_u * 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) + (dx_term + (CS%Res_coef_khth * US%L_T_to_m_s*cg1_u)**CS%Res_fn_power_khth) enddo ; enddo !$OMP do do J=js-1,Jeq ; do i=is,ie - cg1_v = 0.5 * US%L_T_to_m_s * (CS%cg1(i,j) + CS%cg1(i,j+1)) - 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 + cg1_v = 0.5 * (CS%cg1(i,j) + CS%cg1(i,j+1)) + dx_term = (US%L_T_to_m_s**2 * (CS%f2_dx2_v(i,J) + cg1_v * 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) + (dx_term + (CS%Res_coef_khth * US%L_T_to_m_s*cg1_v)**CS%Res_fn_power_khth) enddo ; enddo else !$OMP do do j=js,je ; do I=is-1,Ieq - cg1_u = 0.5 * US%L_T_to_m_s * (CS%cg1(i,j) + CS%cg1(i+1,j)) - 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 + cg1_u = 0.5 * (CS%cg1(i,j) + CS%cg1(i+1,j)) + dx_term = (US%L_T_to_m_s*sqrt(CS%f2_dx2_u(I,j) + & + 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) + (dx_term + (CS%Res_coef_khth * US%L_T_to_m_s*cg1_u)**CS%Res_fn_power_khth) enddo ; enddo !$OMP do do J=js-1,Jeq ; do i=is,ie - cg1_v = 0.5 * US%L_T_to_m_s * (CS%cg1(i,j) + CS%cg1(i,j+1)) - 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 + cg1_v = 0.5 * (CS%cg1(i,j) + CS%cg1(i,j+1)) + dx_term = (US%L_T_to_m_s*sqrt(CS%f2_dx2_v(i,J) + & + 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) + (dx_term + (CS%Res_coef_khth * US%L_T_to_m_s*cg1_v)**CS%Res_fn_power_khth) enddo ; enddo endif endif @@ -453,7 +450,7 @@ subroutine calc_Visbeck_coeffs(h, slope_x, slope_y, N2_u, N2_v, G, GV, US, CS) ! Local variables real :: S2 ! Interface slope squared [nondim] - real :: N2 ! Brunt-Vaisala frequency [s-1] + real :: N2 ! Positive Brunt-Vaisala frequency or zero [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]. integer :: is, ie, js, je, nz @@ -592,8 +589,6 @@ subroutine calc_slope_functions_using_just_e(h, G, GV, US, CS, e, calculate_slop 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 - ! units for lateral distances. 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 @@ -613,7 +608,6 @@ subroutine calc_slope_functions_using_just_e(h, G, GV, US, CS, e, calculate_slop one_meter = 1.0 * GV%m_to_H h_neglect = GV%H_subroundoff H_cutoff = real(2*nz) * (GV%Angstrom_H + h_neglect) - Z_to_L = US%Z_to_m ! To set the length scale based on the deformation radius, use wave_speed to ! calculate the first-mode gravity wave speed and then blend the equatorial @@ -625,12 +619,12 @@ subroutine calc_slope_functions_using_just_e(h, G, GV, US, CS, e, calculate_slop if (calculate_slopes) then ! Calculate the interface slopes E_x and E_y and u- and v- points respectively do j=js-1,je+1 ; do I=is-1,ie - E_x(I,j) = Z_to_L*(e(i+1,j,K)-e(i,j,K))*US%m_to_L*G%IdxCu(I,j) + E_x(I,j) = US%Z_to_L*(e(i+1,j,K)-e(i,j,K))*G%IdxCu(I,j) ! Mask slopes where interface intersects topography if (min(h(I,j,k),h(I+1,j,k)) < H_cutoff) E_x(I,j) = 0. enddo ; enddo do J=js-1,je ; do i=is-1,ie+1 - E_y(i,J) = Z_to_L*(e(i,j+1,K)-e(i,j,K))*US%m_to_L*G%IdyCv(i,J) + E_y(i,J) = US%Z_to_L*(e(i,j+1,K)-e(i,j,K))*G%IdyCv(i,J) ! Mask slopes where interface intersects topography if (min(h(i,J,k),h(i,J+1,k)) < H_cutoff) E_y(I,j) = 0. enddo ; enddo @@ -674,14 +668,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) + US%T_to_s*S2N2_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( US%s_to_T*CS%SN_u(I,j) / & + CS%SN_u(I,j) = G%mask2dCu(I,j) * sqrt( CS%SN_u(I,j) / & (max(G%bathyT(I,j), G%bathyT(I+1,j))) ) else CS%SN_u(I,j) = 0.0 @@ -692,13 +686,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) + US%T_to_s*S2N2_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( US%s_to_T*CS%SN_v(i,J) / & + CS%SN_v(i,J) = G%mask2dCv(i,J) * sqrt( CS%SN_v(i,J) / & (max(G%bathyT(i,J), G%bathyT(i,J+1))) ) else CS%SN_v(I,j) = 0.0 @@ -744,16 +738,16 @@ subroutine calc_QG_Leith_viscosity(CS, G, GV, US, h, k, div_xx_dx, div_xx_dy, vo ! div_xx_dy, & ! y-derivative of horizontal divergence (d/dy(du/dx + dv/dy)) [L-1 T-1 ~> 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] + beta_v, & ! Beta at v-points [T-1 L-1 ~> s-1 m-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)) [L-1 T-1 ~> m-1 s-1] ! div_xx_dx, & ! x-derivative of horizontal divergence (d/dx(du/dx + dv/dy)) [L-1 T-1 ~> m-1 s-1] - dslopex_dz, & ! z-derivative of x-slope at u-points [m-1] + dslopex_dz, & ! z-derivative of x-slope at u-points [Z-1 ~> m-1] h_at_u, & ! Thickness at u-points [H ~> m or kg m-2] - beta_u, & ! Beta at u-points [m-1 s-1] + beta_u, & ! Beta at u-points [T-1 L-1 ~> s-1 m-1] grad_vort_mag_u, & ! mag. of vort. grad. at u-points [s-1 m-1] grad_div_mag_u ! mag. of div. grad. at u-points [s-1 m-1] ! real, dimension(SZI_(G),SZJ_(G)) :: div_xx ! Estimate of horizontal divergence at h-points [s-1] @@ -785,7 +779,7 @@ subroutine calc_QG_Leith_viscosity(CS, G, GV, US, h, k, div_xx_dx, div_xx_dy, vo h_at_slope_below = 2. * ( 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) ) * ( h(i,j,k+1) + h(i+1,j,k+1) ) & + ( h(i,j,k+1) * h(i+1,j,k+1) ) * ( h(i,j,k) + h(i+1,j,k) ) + GV%H_subroundoff ) - Ih = 1./ ( ( h_at_slope_above + h_at_slope_below + GV%H_subroundoff ) * GV%H_to_m ) + Ih = 1./ ( ( h_at_slope_above + h_at_slope_below + GV%H_subroundoff ) * GV%H_to_Z ) 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 @@ -798,7 +792,7 @@ subroutine calc_QG_Leith_viscosity(CS, G, GV, US, h, k, div_xx_dx, div_xx_dy, vo h_at_slope_below = 2. * ( 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) ) * ( h(i,j,k+1) + h(i,j+1,k+1) ) & + ( h(i,j,k+1) * h(i,j+1,k+1) ) * ( h(i,j,k) + h(i,j+1,k) ) + GV%H_subroundoff ) - Ih = 1./ ( ( h_at_slope_above + h_at_slope_below + GV%H_subroundoff ) * GV%H_to_m ) + Ih = 1./ ( ( h_at_slope_above + h_at_slope_below + GV%H_subroundoff ) * GV%H_to_Z ) dslopey_dz(i,J) = 2. * ( CS%slope_y(i,j,k) - CS%slope_y(i,j,k+1) ) * Ih h_at_v(i,J) = 2. * ( h_at_slope_above * h_at_slope_below ) * Ih enddo ; enddo @@ -806,7 +800,7 @@ subroutine calc_QG_Leith_viscosity(CS, G, GV, US, h, k, div_xx_dx, div_xx_dy, vo !### 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 * US%L_to_m * & + vort_xy_dx(i,J) = vort_xy_dx(i,J) - f * US%L_to_Z * & ( ( h_at_u(I,j) * dslopex_dz(I,j) + h_at_u(I-1,j+1) * dslopex_dz(I-1,j+1) ) & + ( h_at_u(I-1,j) * dslopex_dz(I-1,j) + h_at_u(I,j+1) * dslopex_dz(I,j+1) ) ) / & ( ( 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) @@ -816,7 +810,7 @@ subroutine calc_QG_Leith_viscosity(CS, G, GV, US, h, k, div_xx_dx, div_xx_dy, vo 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 * US%L_to_m * & + vort_xy_dy(I,j) = vort_xy_dx(I,j) - f * US%L_to_Z * & ( ( 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) ) ) / & ( ( h_at_v(i,J) + h_at_v(i+1,J-1) ) + ( h_at_v(i,J-1) + h_at_v(i+1,J) ) + GV%H_subroundoff) @@ -829,34 +823,38 @@ subroutine calc_QG_Leith_viscosity(CS, G, GV, US, h, k, div_xx_dx, div_xx_dy, vo if (CS%use_QG_Leith_GM) then do j=js,je ; do I=is-1,Ieq - grad_vort_mag_u(I,j) = US%m_to_L*US%s_to_T*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) = US%m_to_L*US%s_to_T*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) + !### These expressions are not rotationally symmetric. Add parentheses and regroup, as in: + ! 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-1)) + + ! (vort_xy_dx(i+1,J) + vort_xy_dx(i,J-1))))**2 ) + 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 - beta_u(I,j) = US%m_to_L*sqrt( (0.5*(G%dF_dx(i,j)+G%dF_dx(i+1,j))**2) + & + 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) = US%m_to_L**2*US%T_to_s*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 + CS%KH_u_QG(I,j,k) = MIN(grad_vort_mag_u(I,j) + grad_div_mag_u(I,j), 3.0*beta_u(I,j)) * & + CS%Laplac3_const_u(I,j) * inv_PI3 else - CS%KH_u_QG(I,j,k) = US%m_to_L**2*US%T_to_s*(grad_vort_mag_u(I,j) + grad_div_mag_u(I,j)) & - * CS%Laplac3_const_u(I,j) * inv_PI3 + 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) = US%m_to_L*US%s_to_T*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) = US%m_to_L*US%s_to_T*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) + !### These expressions are not rotationally symmetric. Add parentheses and regroup. + 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) = US%m_to_L*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) = US%m_to_L**2*US%T_to_s*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 + 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) = US%m_to_L**2*US%T_to_s*(grad_vort_mag_v(i,J) + grad_div_mag_v(i,J)) & - * CS%Laplac3_const_v(i,J) * inv_PI3 + 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 @@ -886,8 +884,8 @@ subroutine VarMix_init(Time, G, GV, US, param_file, diag, CS) 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 - real :: grid_sp_u2, grid_sp_u3 - real :: grid_sp_v2, grid_sp_v3 ! Intermediate quantities for Leith metrics + real :: grid_sp_u2, grid_sp_v2 ! Intermediate quantities for Leith metrics [L2 ~> m2] + real :: grid_sp_u3, grid_sp_v3 ! Intermediate quantities for Leith metrics [L3 ~> m3] ! This include declares and sets the variable "version". #include "version_variable.h" character(len=40) :: mdl = "MOM_lateral_mixing_coeffs" ! This module's name. @@ -1125,35 +1123,35 @@ 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%L_to_m**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 * US%L_to_m**2*((G%dxBu(I,J))**2 + (G%dyBu(I,J))**2) * (sqrt(0.5 * & - ( (((G%CoriolisBu(I,J)-G%CoriolisBu(I-1,J)) * US%m_to_L*G%IdxCv(i,J))**2 + & - ((G%CoriolisBu(I+1,J)-G%CoriolisBu(I,J)) * US%m_to_L*G%IdxCv(i+1,J))**2) + & - (((G%CoriolisBu(I,J)-G%CoriolisBu(I,J-1)) * US%m_to_L*G%IdyCu(I,j))**2 + & - ((G%CoriolisBu(I,J+1)-G%CoriolisBu(I,J)) * US%m_to_L*G%IdyCu(I,j+1))**2) ) )) + 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 + & + ((G%CoriolisBu(I,J+1)-G%CoriolisBu(I,J)) * G%IdyCu(I,j+1))**2) ) )) enddo ; enddo do j=js,je ; do I=is-1,Ieq - CS%f2_dx2_u(I,j) = ((US%L_to_m*G%dxCu(I,j))**2 + (US%L_to_m*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 * ((US%L_to_m*G%dxCu(I,j))**2 + (US%L_to_m*G%dyCu(I,j))**2) * (sqrt( & - 0.25*( (((G%CoriolisBu(I,J-1)-G%CoriolisBu(I-1,J-1)) * US%m_to_L*G%IdxCv(i,J-1))**2 + & - ((G%CoriolisBu(I+1,J)-G%CoriolisBu(I,J)) * US%m_to_L*G%IdxCv(i+1,J))**2) + & - (((G%CoriolisBu(I+1,J-1)-G%CoriolisBu(I,J-1)) * US%m_to_L*G%IdxCv(i+1,J-1))**2 + & - ((G%CoriolisBu(I,J)-G%CoriolisBu(I-1,J)) * US%m_to_L*G%IdxCv(i,J))**2) ) + & - ((G%CoriolisBu(I,J)-G%CoriolisBu(I,J-1)) * US%m_to_L*G%IdyCu(I,j))**2 )) + 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 + & + ((G%CoriolisBu(I,J)-G%CoriolisBu(I-1,J)) * G%IdxCv(i,J))**2) ) + & + ((G%CoriolisBu(I,J)-G%CoriolisBu(I,J-1)) * G%IdyCu(I,j))**2 )) enddo ; enddo do J=js-1,Jeq ; do i=is,ie - CS%f2_dx2_v(i,J) = ((US%L_to_m*G%dxCv(i,J))**2 + (US%L_to_m*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 * ((US%L_to_m*G%dxCv(i,J))**2 + (US%L_to_m*G%dyCv(i,J))**2) * (sqrt( & - ((G%CoriolisBu(I,J)-G%CoriolisBu(I-1,J)) * US%m_to_L*G%IdxCv(i,J))**2 + & - 0.25*( (((G%CoriolisBu(I,J)-G%CoriolisBu(I,J-1)) * US%m_to_L*G%IdyCu(I,j))**2 + & - ((G%CoriolisBu(I-1,J+1)-G%CoriolisBu(I-1,J)) * US%m_to_L*G%IdyCu(I-1,j+1))**2) + & - (((G%CoriolisBu(I,J+1)-G%CoriolisBu(I,J)) * US%m_to_L*G%IdyCu(I,j+1))**2 + & - ((G%CoriolisBu(I-1,J)-G%CoriolisBu(I-1,J-1)) * US%m_to_L*G%IdyCu(I-1,j))**2) ) )) + 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) + & + (((G%CoriolisBu(I,J+1)-G%CoriolisBu(I,J)) * G%IdyCu(I,j+1))**2 + & + ((G%CoriolisBu(I-1,J)-G%CoriolisBu(I-1,J-1)) * G%IdyCu(I-1,j))**2) ) )) enddo ; enddo endif @@ -1169,15 +1167,15 @@ 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%L_to_m*G%dxT(i,j))**2 + (US%L_to_m*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 * ((US%L_to_m*G%dxT(i,j))**2 + (US%L_to_m*G%dyT(i,j))**2) * (sqrt(0.5 * & - ( (((G%CoriolisBu(I,J)-G%CoriolisBu(I-1,J)) * US%m_to_L*G%IdxCv(i,J))**2 + & - ((G%CoriolisBu(I,J-1)-G%CoriolisBu(I-1,J-1)) * US%m_to_L*G%IdxCv(i,J-1))**2) + & - (((G%CoriolisBu(I,J)-G%CoriolisBu(I,J-1)) * US%m_to_L*G%IdyCu(I,j))**2 + & - ((G%CoriolisBu(I-1,J)-G%CoriolisBu(I-1,J-1)) * US%m_to_L*G%IdyCu(I-1,j))**2) ) )) + 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 + & + ((G%CoriolisBu(I-1,J)-G%CoriolisBu(I-1,J-1)) * G%IdyCu(I-1,j))**2) ) )) enddo ; enddo endif @@ -1214,14 +1212,14 @@ subroutine VarMix_init(Time, G, GV, US, param_file, diag, CS) do j=Jsq,Jeq+1 ; do I=is-1,Ieq ! Static factors in the Leith schemes - grid_sp_u2 = US%L_to_m*G%dyCu(I,j)*US%L_to_m*G%dxCu(I,j) - grid_sp_u3 = grid_sp_u2*sqrt(grid_sp_u2) + grid_sp_u2 = G%dyCu(I,j)*G%dxCu(I,j) + grid_sp_u3 = sqrt(grid_sp_u2) CS%Laplac3_const_u(I,j) = Leith_Lap_const * grid_sp_u3 enddo ; enddo do j=js-1,Jeq ; do I=Isq,Ieq+1 ! Static factors in the Leith schemes !### The second factor here is wrong. It should be G%dxCv(i,J). - grid_sp_v2 = US%L_to_m*G%dyCv(i,J)*US%L_to_m*G%dxCu(i,J) + grid_sp_v2 = G%dyCv(i,J)*G%dxCu(i,J) grid_sp_v3 = grid_sp_v2*sqrt(grid_sp_v2) CS%Laplac3_const_v(i,J) = Leith_Lap_const * grid_sp_v3 enddo ; enddo From a4ffe033ba6be65ba03c5d1eff45cfecab96e1d8 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Fri, 9 Aug 2019 19:10:12 -0400 Subject: [PATCH 177/297] +Rescaled isoneutral & along layer tracer diffusion Rescaled variables used in isoneutral & along layer tracer diffusion for more complete dimensional consistency testing, including changing the units of the Coef_x and Coef_y arguments to neutral_diffusion to [L2]. This change also requires the addition of unit_scale_type argument to tracer_hor_diff_init. All answers are bitwise identical. --- src/core/MOM.F90 | 2 +- src/tracer/MOM_neutral_diffusion.F90 | 8 +- src/tracer/MOM_tracer_hor_diff.F90 | 141 ++++++++++++++------------- 3 files changed, 79 insertions(+), 72 deletions(-) diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index bde797c654..9f87cc45ed 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -2352,7 +2352,7 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & endif call tracer_advect_init(Time, G, param_file, diag, CS%tracer_adv_CSp) - call tracer_hor_diff_init(Time, G, param_file, diag, CS%tv%eqn_of_state, & + call tracer_hor_diff_init(Time, G, US, param_file, diag, CS%tv%eqn_of_state, & CS%tracer_diff_CSp) call lock_tracer_registry(CS%tracer_Reg) diff --git a/src/tracer/MOM_neutral_diffusion.F90 b/src/tracer/MOM_neutral_diffusion.F90 index f1f6191c74..a13eace934 100644 --- a/src/tracer/MOM_neutral_diffusion.F90 +++ b/src/tracer/MOM_neutral_diffusion.F90 @@ -412,8 +412,8 @@ subroutine neutral_diffusion(G, GV, h, Coef_x, Coef_y, dt, Reg, US, CS) type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness [H ~> m or kg m-2] - real, dimension(SZIB_(G),SZJ_(G)), intent(in) :: Coef_x !< dt * Kh * dy / dx at u-points [m2] - real, dimension(SZI_(G),SZJB_(G)), intent(in) :: Coef_y !< dt * Kh * dx / dy at v-points [m2] + real, dimension(SZIB_(G),SZJ_(G)), intent(in) :: Coef_x !< dt * Kh * dy / dx at u-points [L2 ~> m2] + real, dimension(SZI_(G),SZJB_(G)), intent(in) :: Coef_y !< dt * Kh * dx / dy at v-points [L2 ~> m2] real, intent(in) :: dt !< Tracer time step * I_numitts !! (I_numitts in tracer_hordiff) type(tracer_registry_type), pointer :: Reg !< Tracer registry @@ -497,12 +497,12 @@ subroutine neutral_diffusion(G, GV, h, Coef_x, Coef_y, dt, Reg, US, CS) enddo do k = 1, GV%ke tracer%t(i,j,k) = tracer%t(i,j,k) + dTracer(k) * & - ( US%m_to_L**2*G%IareaT(i,j) / ( h(i,j,k) + GV%H_subroundoff ) ) + ( G%IareaT(i,j) / ( h(i,j,k) + GV%H_subroundoff ) ) enddo if (tracer%id_dfxy_conc > 0 .or. tracer%id_dfxy_cont > 0 .or. tracer%id_dfxy_cont_2d > 0 ) then do k = 1, GV%ke - tendency(i,j,k) = dTracer(k) * US%m_to_L**2*G%IareaT(i,j) * Idt + tendency(i,j,k) = dTracer(k) * G%IareaT(i,j) * Idt enddo endif diff --git a/src/tracer/MOM_tracer_hor_diff.F90 b/src/tracer/MOM_tracer_hor_diff.F90 index 7ca336bd91..098a647ec8 100644 --- a/src/tracer/MOM_tracer_hor_diff.F90 +++ b/src/tracer/MOM_tracer_hor_diff.F90 @@ -103,8 +103,8 @@ subroutine tracer_hordiff(h, dt, MEKE, VarMix, G, GV, US, CS, Reg, tv, do_online type(MEKE_type), pointer :: MEKE !< MEKE type type(VarMix_CS), pointer :: VarMix !< Variable mixing type type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure - type(tracer_hor_diff_CS), pointer :: CS !< module control structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + type(tracer_hor_diff_CS), pointer :: CS !< module control structure type(tracer_registry_type), pointer :: Reg !< registered tracers type(thermo_var_ptrs), intent(in) :: tv !< A structure containing pointers to any available !! thermodynamic fields, including potential temp and @@ -125,25 +125,25 @@ subroutine tracer_hordiff(h, dt, MEKE, VarMix, G, GV, US, CS, Reg, tv, do_online real, dimension(SZI_(G),SZJ_(G)) :: & Ihdxdy, & ! The inverse of the volume or mass of fluid in a layer in a - ! grid cell [H-1 m-2 ~> m-3 or kg-1]. - Kh_h, & ! The tracer diffusivity averaged to tracer points [m2 s-1]. + ! grid cell [H-1 L-2 ~> m-3 or kg-1]. + Kh_h, & ! The tracer diffusivity averaged to tracer points [L2 T-1 ~> m2 s-1]. CFL, & ! A diffusive CFL number for each cell [nondim]. dTr ! The change in a tracer's concentration, in units of concentration [Conc]. real, dimension(SZIB_(G),SZJ_(G)) :: & khdt_x, & ! The value of Khtr*dt times the open face width divided by - ! the distance between adjacent tracer points [m2]. + ! the distance between adjacent tracer points [L2 ~> m2]. Coef_x, & ! The coefficients relating zonal tracer differences - ! to time-integrated fluxes [H m2 ~> m3 or kg]. - Kh_u ! Tracer mixing coefficient at u-points [m2 s-1]. + ! to time-integrated fluxes [H L2 ~> m3 or kg]. + Kh_u ! Tracer mixing coefficient at u-points [L2 T-1 ~> m2 s-1]. real, dimension(SZI_(G),SZJB_(G)) :: & khdt_y, & ! The value of Khtr*dt times the open face width divided by - ! the distance between adjacent tracer points [m2]. + ! the distance between adjacent tracer points [L2]. Coef_y, & ! The coefficients relating meridional tracer differences - ! to time-integrated fluxes [H m2 ~> m3 or kg]. - Kh_v ! Tracer mixing coefficient at u-points [m2 s-1]. + ! to time-integrated fluxes [H L2 ~> m3 or kg]. + Kh_v ! Tracer mixing coefficient at u-points [L2 T-1 ~> m2 s-1]. - real :: khdt_max ! The local limiting value of khdt_x or khdt_y [m2]. + real :: khdt_max ! The local limiting value of khdt_x or khdt_y [L2 ~> m2]. real :: max_CFL ! The global maximum of the diffusive CFL number. logical :: use_VarMix, Resoln_scaled, do_online, use_Eady integer :: S_idx, T_idx ! Indices for temperature and salinity if needed @@ -154,7 +154,8 @@ subroutine tracer_hordiff(h, dt, MEKE, VarMix, G, GV, US, CS, Reg, tv, do_online real :: Idt ! The inverse of the time step [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 :: Kh_loc ! The local value of Kh [m2 s-1]. + real :: Kh_loc ! The local value of Kh [L2 T-1 ~> m2 s-1]. + real :: dt_in_T ! The timestep [T ~> s] real :: Res_Fn ! The local value of the resolution function [nondim]. real :: Rd_dx ! The local value of deformation radius over grid-spacing [nondim]. real :: normalize ! normalization used for diagnostic Kh_h; diffusivity averaged to h-points. @@ -175,6 +176,7 @@ subroutine tracer_hordiff(h, dt, MEKE, VarMix, G, GV, US, CS, Reg, tv, do_online call cpu_clock_begin(id_clock_diffuse) ntr = Reg%ntr + dt_in_T = US%s_to_T*dt Idt = 1.0/dt h_neglect = GV%H_subroundoff @@ -210,16 +212,16 @@ subroutine tracer_hordiff(h, dt, MEKE, VarMix, G, GV, US, CS, Reg, tv, do_online !$OMP parallel do default(shared) private(Kh_loc,Rd_dx) do j=js,je ; do I=is-1,ie Kh_loc = CS%KhTr - if (use_Eady) Kh_loc = Kh_loc + CS%KhTr_Slope_Cff*US%L_to_m**2*VarMix%L2u(I,j)*US%s_to_T*VarMix%SN_u(I,j) + if (use_Eady) Kh_loc = Kh_loc + CS%KhTr_Slope_Cff*VarMix%L2u(I,j)*VarMix%SN_u(I,j) if (associated(MEKE%Kh)) & - Kh_Loc = Kh_Loc + MEKE%KhTr_fac*US%L_to_m**2*US%s_to_T*sqrt(MEKE%Kh(i,j)*MEKE%Kh(i+1,j)) + Kh_loc = Kh_loc + MEKE%KhTr_fac*sqrt(MEKE%Kh(i,j)*MEKE%Kh(i+1,j)) if (CS%KhTr_max > 0.) Kh_loc = min(Kh_loc, CS%KhTr_max) if (Resoln_scaled) & - Kh_Loc = Kh_Loc * 0.5*(VarMix%Res_fn_h(i,j) + VarMix%Res_fn_h(i+1,j)) + Kh_loc = Kh_loc * 0.5*(VarMix%Res_fn_h(i,j) + VarMix%Res_fn_h(i+1,j)) Kh_u(I,j) = max(Kh_loc, CS%KhTr_min) if (CS%KhTr_passivity_coeff>0.) then ! Apply passivity Rd_dx=0.5*( VarMix%Rd_dx_h(i,j)+VarMix%Rd_dx_h(i+1,j) ) ! Rd/dx at u-points - Kh_loc=Kh_u(I,j)*max( CS%KhTr_passivity_min, CS%KhTr_passivity_coeff*Rd_dx ) + Kh_loc = Kh_u(I,j)*max( CS%KhTr_passivity_min, CS%KhTr_passivity_coeff*Rd_dx ) if (CS%KhTr_max > 0.) Kh_loc = min(Kh_loc, CS%KhTr_max) ! Re-apply max Kh_u(I,j) = max(Kh_loc, CS%KhTr_min) ! Re-apply min endif @@ -227,16 +229,16 @@ subroutine tracer_hordiff(h, dt, MEKE, VarMix, G, GV, US, CS, Reg, tv, do_online !$OMP parallel do default(shared) private(Kh_loc,Rd_dx) do J=js-1,je ; do i=is,ie Kh_loc = CS%KhTr - if (use_Eady) Kh_loc = Kh_loc + CS%KhTr_Slope_Cff*US%L_to_m**2*VarMix%L2v(i,J)*US%s_to_T*VarMix%SN_v(i,J) + if (use_Eady) Kh_loc = Kh_loc + CS%KhTr_Slope_Cff*VarMix%L2v(i,J)*VarMix%SN_v(i,J) if (associated(MEKE%Kh)) & - Kh_Loc = Kh_Loc + MEKE%KhTr_fac*US%L_to_m**2*US%s_to_T*sqrt(MEKE%Kh(i,j)*MEKE%Kh(i,j+1)) + Kh_loc = Kh_loc + MEKE%KhTr_fac*sqrt(MEKE%Kh(i,j)*MEKE%Kh(i,j+1)) if (CS%KhTr_max > 0.) Kh_loc = min(Kh_loc, CS%KhTr_max) if (Resoln_scaled) & - Kh_Loc = Kh_Loc * 0.5*(VarMix%Res_fn_h(i,j) + VarMix%Res_fn_h(i,j+1)) + Kh_loc = Kh_loc * 0.5*(VarMix%Res_fn_h(i,j) + VarMix%Res_fn_h(i,j+1)) Kh_v(i,J) = max(Kh_loc, CS%KhTr_min) if (CS%KhTr_passivity_coeff>0.) then ! Apply passivity - Rd_dx=0.5*( VarMix%Rd_dx_h(i,j)+VarMix%Rd_dx_h(i,j+1) ) ! Rd/dx at v-points - Kh_loc=Kh_v(I,j)*max( CS%KhTr_passivity_min, CS%KhTr_passivity_coeff*Rd_dx ) + Rd_dx = 0.5*( VarMix%Rd_dx_h(i,j)+VarMix%Rd_dx_h(i,j+1) ) ! Rd/dx at v-points + Kh_loc = Kh_v(i,J)*max( CS%KhTr_passivity_min, CS%KhTr_passivity_coeff*Rd_dx ) if (CS%KhTr_max > 0.) Kh_loc = min(Kh_loc, CS%KhTr_max) ! Re-apply max Kh_v(i,J) = max(Kh_loc, CS%KhTr_min) ! Re-apply min endif @@ -244,48 +246,48 @@ subroutine tracer_hordiff(h, dt, MEKE, VarMix, G, GV, US, CS, Reg, tv, do_online !$OMP parallel do default(shared) do j=js,je ; do I=is-1,ie - khdt_x(I,j) = dt*(Kh_u(I,j)*(G%dy_Cu(I,j)*G%IdxCu(I,j))) + khdt_x(I,j) = dt_in_T*(Kh_u(I,j)*(G%dy_Cu(I,j)*G%IdxCu(I,j))) enddo ; enddo !$OMP parallel do default(shared) do J=js-1,je ; do i=is,ie - khdt_y(i,J) = dt*(Kh_v(i,J)*(G%dx_Cv(i,J)*G%IdyCv(i,J))) + khdt_y(i,J) = dt_in_T*(Kh_v(i,J)*(G%dx_Cv(i,J)*G%IdyCv(i,J))) enddo ; enddo elseif (Resoln_scaled) then !$OMP parallel do default(shared) private(Res_fn) do j=js,je ; do I=is-1,ie Res_fn = 0.5 * (VarMix%Res_fn_h(i,j) + VarMix%Res_fn_h(i+1,j)) Kh_u(I,j) = max(CS%KhTr * Res_fn, CS%KhTr_min) - khdt_x(I,j) = dt*(CS%KhTr*(G%dy_Cu(I,j)*G%IdxCu(I,j))) * Res_fn + khdt_x(I,j) = dt_in_T*(CS%KhTr*(G%dy_Cu(I,j)*G%IdxCu(I,j))) * Res_fn enddo ; enddo !$OMP parallel do default(shared) private(Res_fn) do J=js-1,je ; do i=is,ie Res_fn = 0.5*(VarMix%Res_fn_h(i,j) + VarMix%Res_fn_h(i,j+1)) Kh_v(i,J) = max(CS%KhTr * Res_fn, CS%KhTr_min) - khdt_y(i,J) = dt*(CS%KhTr*(G%dx_Cv(i,J)*G%IdyCv(i,J))) * Res_fn + khdt_y(i,J) = dt_in_T*(CS%KhTr*(G%dx_Cv(i,J)*G%IdyCv(i,J))) * Res_fn enddo ; enddo else ! Use a simple constant diffusivity. if (CS%id_KhTr_u > 0) then !$OMP parallel do default(shared) do j=js,je ; do I=is-1,ie Kh_u(I,j) = CS%KhTr - khdt_x(I,j) = dt*(CS%KhTr*(G%dy_Cu(I,j)*G%IdxCu(I,j))) + khdt_x(I,j) = dt_in_T*(CS%KhTr*(G%dy_Cu(I,j)*G%IdxCu(I,j))) enddo ; enddo else !$OMP parallel do default(shared) do j=js,je ; do I=is-1,ie - khdt_x(I,j) = dt*(CS%KhTr*(G%dy_Cu(I,j)*G%IdxCu(I,j))) + khdt_x(I,j) = dt_in_T*(CS%KhTr*(G%dy_Cu(I,j)*G%IdxCu(I,j))) enddo ; enddo endif if (CS%id_KhTr_v > 0) then !$OMP parallel do default(shared) do J=js-1,je ; do i=is,ie Kh_v(i,J) = CS%KhTr - khdt_y(i,J) = dt*(CS%KhTr*(G%dx_Cv(i,J)*G%IdyCv(i,J))) + khdt_y(i,J) = dt_in_T*(CS%KhTr*(G%dx_Cv(i,J)*G%IdyCv(i,J))) enddo ; enddo else !$OMP parallel do default(shared) do J=js-1,je ; do i=is,ie - khdt_y(i,J) = dt*(CS%KhTr*(G%dx_Cv(i,J)*G%IdyCv(i,J))) + khdt_y(i,J) = dt_in_T*(CS%KhTr*(G%dx_Cv(i,J)*G%IdyCv(i,J))) enddo ; enddo endif endif ! VarMix @@ -294,34 +296,34 @@ subroutine tracer_hordiff(h, dt, MEKE, VarMix, G, GV, US, CS, Reg, tv, do_online if ((CS%id_KhTr_u > 0) .or. (CS%id_KhTr_h > 0)) then !$OMP parallel do default(shared) private(khdt_max) do j=js,je ; do I=is-1,ie - khdt_max = 0.125*CS%max_diff_CFL * US%L_to_m**2*min(G%areaT(i,j), G%areaT(i+1,j)) + khdt_max = 0.125*CS%max_diff_CFL * min(G%areaT(i,j), G%areaT(i+1,j)) if (khdt_x(I,j) > khdt_max) then khdt_x(I,j) = khdt_max if (dt*(G%dy_Cu(I,j)*G%IdxCu(I,j)) > 0.0) & - Kh_u(I,j) = khdt_x(I,j) / (dt*(G%dy_Cu(I,j)*G%IdxCu(I,j))) + Kh_u(I,j) = khdt_x(I,j) / (dt_in_T*(G%dy_Cu(I,j)*G%IdxCu(I,j))) endif enddo ; enddo else !$OMP parallel do default(shared) private(khdt_max) do j=js,je ; do I=is-1,ie - khdt_max = 0.125*CS%max_diff_CFL * US%L_to_m**2*min(G%areaT(i,j), G%areaT(i+1,j)) + khdt_max = 0.125*CS%max_diff_CFL * min(G%areaT(i,j), G%areaT(i+1,j)) khdt_x(I,j) = min(khdt_x(I,j), khdt_max) enddo ; enddo endif if ((CS%id_KhTr_v > 0) .or. (CS%id_KhTr_h > 0)) then !$OMP parallel do default(shared) private(khdt_max) do J=js-1,je ; do i=is,ie - khdt_max = 0.125*CS%max_diff_CFL * US%L_to_m**2*min(G%areaT(i,j), G%areaT(i,j+1)) + khdt_max = 0.125*CS%max_diff_CFL * min(G%areaT(i,j), G%areaT(i,j+1)) if (khdt_y(i,J) > khdt_max) then khdt_y(i,J) = khdt_max if (dt*(G%dx_Cv(i,J)*G%IdyCv(i,J)) > 0.0) & - Kh_v(i,J) = khdt_y(i,J) / (dt*(G%dx_Cv(i,J)*G%IdyCv(i,J))) + Kh_v(i,J) = khdt_y(i,J) / (dt_in_T*(G%dx_Cv(i,J)*G%IdyCv(i,J))) endif enddo ; enddo else !$OMP parallel do default(shared) private(khdt_max) do J=js-1,je ; do i=is,ie - khdt_max = 0.125*CS%max_diff_CFL * US%L_to_m**2*min(G%areaT(i,j), G%areaT(i,j+1)) + khdt_max = 0.125*CS%max_diff_CFL * min(G%areaT(i,j), G%areaT(i,j+1)) khdt_y(i,J) = min(khdt_y(i,J), khdt_max) enddo ; enddo endif @@ -330,13 +332,13 @@ subroutine tracer_hordiff(h, dt, MEKE, VarMix, G, GV, US, CS, Reg, tv, do_online else ! .not. do_online !$OMP parallel do default(shared) do j=js,je ; do I=is-1,ie - khdt_x(I,j) = read_khdt_x(I,j) + khdt_x(I,j) = US%m_to_L**2*read_khdt_x(I,j) enddo ; enddo !$OMP parallel do default(shared) do J=js-1,je ; do i=is,ie - khdt_y(i,J) = read_khdt_y(i,J) + khdt_y(i,J) = US%m_to_L**2*read_khdt_y(i,J) enddo ; enddo - call pass_vector(khdt_x,khdt_y,G%Domain) + call pass_vector(khdt_x, khdt_y, G%Domain) endif ! do_online if (CS%check_diffusive_CFL) then @@ -344,7 +346,7 @@ subroutine tracer_hordiff(h, dt, MEKE, VarMix, G, GV, US, CS, Reg, tv, do_online max_CFL = 0.0 do j=js,je ; do i=is,ie CFL(i,j) = 2.0*((khdt_x(I-1,j) + khdt_x(I,j)) + & - (khdt_y(i,J-1) + khdt_y(i,J))) * US%m_to_L**2*G%IareaT(i,j) + (khdt_y(i,J-1) + khdt_y(i,J))) * G%IareaT(i,j) if (max_CFL < CFL(i,j)) max_CFL = CFL(i,j) enddo ; enddo call cpu_clock_begin(id_clock_sync) @@ -434,7 +436,7 @@ subroutine tracer_hordiff(h, dt, MEKE, VarMix, G, GV, US, CS, Reg, tv, do_online enddo do i=is,ie - Ihdxdy(i,j) = US%m_to_L**2*G%IareaT(i,j) / (h(i,j,k)+h_neglect) + Ihdxdy(i,j) = G%IareaT(i,j) / (h(i,j,k)+h_neglect) enddo enddo @@ -447,19 +449,19 @@ subroutine tracer_hordiff(h, dt, MEKE, VarMix, G, GV, US, CS, Reg, tv, do_online Coef_y(i,J) * (Reg%Tr(m)%t(i,j,k) - Reg%Tr(m)%t(i,j+1,k)))) enddo ; enddo if (associated(Reg%Tr(m)%df_x)) then ; do j=js,je ; do I=G%IscB,G%IecB - Reg%Tr(m)%df_x(I,j,k) = Reg%Tr(m)%df_x(I,j,k) + Coef_x(I,j) * & + Reg%Tr(m)%df_x(I,j,k) = Reg%Tr(m)%df_x(I,j,k) + US%L_to_m**2*Coef_x(I,j) * & (Reg%Tr(m)%t(i,j,k) - Reg%Tr(m)%t(i+1,j,k))*Idt enddo ; enddo ; endif if (associated(Reg%Tr(m)%df_y)) then ; do J=G%JscB,G%JecB ; do i=is,ie - Reg%Tr(m)%df_y(i,J,k) = Reg%Tr(m)%df_y(i,J,k) + Coef_y(i,J) * & + Reg%Tr(m)%df_y(i,J,k) = Reg%Tr(m)%df_y(i,J,k) + US%L_to_m**2*Coef_y(i,J) * & (Reg%Tr(m)%t(i,j,k) - Reg%Tr(m)%t(i,j+1,k))*Idt enddo ; enddo ; endif if (associated(Reg%Tr(m)%df2d_x)) then ; do j=js,je ; do I=G%IscB,G%IecB - Reg%Tr(m)%df2d_x(I,j) = Reg%Tr(m)%df2d_x(I,j) + Coef_x(I,j) * & + Reg%Tr(m)%df2d_x(I,j) = Reg%Tr(m)%df2d_x(I,j) + US%L_to_m**2*Coef_x(I,j) * & (Reg%Tr(m)%t(i,j,k) - Reg%Tr(m)%t(i+1,j,k))*Idt enddo ; enddo ; endif if (associated(Reg%Tr(m)%df2d_y)) then ; do J=G%JscB,G%JecB ; do i=is,ie - Reg%Tr(m)%df2d_y(i,J) = Reg%Tr(m)%df2d_y(i,J) + Coef_y(i,J) * & + Reg%Tr(m)%df2d_y(i,J) = Reg%Tr(m)%df2d_y(i,J) + US%L_to_m**2*Coef_y(i,J) * & (Reg%Tr(m)%t(i,j,k) - Reg%Tr(m)%t(i,j+1,k))*Idt enddo ; enddo ; endif do j=js,je ; do i=is,ie @@ -520,10 +522,10 @@ subroutine tracer_hordiff(h, dt, MEKE, VarMix, G, GV, US, CS, Reg, tv, do_online if (CS%debug) then call uvchksum("After tracer diffusion khdt_[xy]", khdt_x, khdt_y, & - G%HI, haloshift=0, symmetric=.true.) + G%HI, haloshift=0, symmetric=.true., scale=US%L_to_m**2) if (CS%use_neutral_diffusion) then call uvchksum("After tracer diffusion Coef_[xy]", Coef_x, Coef_y, & - G%HI, haloshift=0, symmetric=.true.) + G%HI, haloshift=0, symmetric=.true., scale=US%L_to_m**2) endif endif @@ -546,8 +548,12 @@ subroutine tracer_epipycnal_ML_diff(h, dt, Tr, ntr, khdt_epi_x, khdt_epi_y, G, & real, intent(in) :: dt !< time step type(tracer_type), intent(inout) :: Tr(:) !< tracer array integer, intent(in) :: ntr !< number of tracers - real, dimension(SZIB_(G),SZJ_(G)), intent(in) :: khdt_epi_x !< needs a comment - real, dimension(SZI_(G),SZJB_(G)), intent(in) :: khdt_epi_y !< needs a comment + real, dimension(SZIB_(G),SZJ_(G)), intent(in) :: khdt_epi_x !< Zonal epipycnal diffusivity times + !! a time step and the ratio of the open face width over + !! the distance between adjacent tracer points [L2 ~> m2] + real, dimension(SZI_(G),SZJB_(G)), intent(in) :: khdt_epi_y !< Meridional epipycnal diffusivity times + !! a time step and the ratio of the open face width over + !! the distance between adjacent tracer points [L2 ~> m2] type(tracer_hor_diff_CS), intent(inout) :: CS !< module control structure type(thermo_var_ptrs), intent(in) :: tv !< thermodynamic structure integer, intent(in) :: num_itts !< number of iterations (usually=1) @@ -576,7 +582,7 @@ subroutine tracer_epipycnal_ML_diff(h, dt, Tr, ntr, khdt_epi_x, khdt_epi_y, G, & k0b_Rv, k0a_Rv ! in each pair of mixing at v-faces. real, dimension(SZI_(G), SZJ_(G), SZK_(G)) :: & - tr_flux_conv ! The flux convergence of tracers [conc H m2 ~> conc m3 or conc kg] + tr_flux_conv ! The flux convergence of tracers [conc H L2 ~> conc m3 or conc kg] real, dimension(SZI_(G), SZJ_(G), SZK_(G)) :: Tr_flux_3d, Tr_adj_vert_L, Tr_adj_vert_R real, dimension(SZI_(G), SZK_(G), SZJ_(G)) :: & @@ -620,12 +626,12 @@ subroutine tracer_epipycnal_ML_diff(h, dt, Tr, ntr, khdt_epi_x, khdt_epi_y, G, & real :: Tr_Ra, Tr_Rb ! associated with a pairing [Conc] real :: Tr_av_L ! The average tracer concentrations on the left and right real :: Tr_av_R ! sides of a pairing [Conc]. - real :: Tr_flux ! The tracer flux from left to right in a pair [conc H m2 ~> conc m3 or conc kg]. + real :: Tr_flux ! The tracer flux from left to right in a pair [conc H L2 ~> conc m3 or conc kg]. real :: Tr_adj_vert ! A downward vertical adjustment to Tr_flux between the - ! two cells that make up one side of the pairing [conc H m2 ~> conc m3 or conc kg]. + ! two cells that make up one side of the pairing [conc H L2 ~> conc m3 or conc kg]. real :: h_L, h_R ! Thicknesses to the left and right [H ~> m or kg m-2]. real :: wt_a, wt_b ! Fractional weights of layers above and below [nondim]. - real :: vol ! A cell volume or mass [H m2 ~> m3 or kg]. + real :: vol ! A cell volume or mass [H L2 ~> m3 or kg]. logical, dimension(SZK_(G)) :: & left_set, & ! If true, the left or right point determines the density of right_set ! of the trio. If densities are exactly equal, both are true. @@ -1129,7 +1135,7 @@ subroutine tracer_epipycnal_ML_diff(h, dt, Tr, ntr, khdt_epi_x, khdt_epi_y, G, & else Tr_adj_vert = 0.0 wt_b = deep_wt_Lu(j)%p(I,k) ; wt_a = 1.0 - wt_b - vol = hP_Lu(j)%p(I,k) * G%US%L_to_m**2*G%areaT(i,j) + vol = hP_Lu(j)%p(I,k) * G%areaT(i,j) ! Ensure that the tracer flux does not drive the tracer values ! outside of the range Tr_min_face <= Tr <= Tr_max_face, or if it @@ -1164,7 +1170,7 @@ subroutine tracer_epipycnal_ML_diff(h, dt, Tr, ntr, khdt_epi_x, khdt_epi_y, G, & else Tr_adj_vert = 0.0 wt_b = deep_wt_Ru(j)%p(I,k) ; wt_a = 1.0 - wt_b - vol = hP_Ru(j)%p(I,k) * G%US%L_to_m**2*G%areaT(i+1,j) + vol = hP_Ru(j)%p(I,k) * G%areaT(i+1,j) ! Ensure that the tracer flux does not drive the tracer values ! outside of the range Tr_min_face <= Tr <= Tr_max_face, or if it @@ -1266,7 +1272,7 @@ subroutine tracer_epipycnal_ML_diff(h, dt, Tr, ntr, khdt_epi_x, khdt_epi_y, G, & if (deep_wt_Lv(J)%p(i,k) < 1.0) then Tr_adj_vert = 0.0 wt_b = deep_wt_Lv(J)%p(i,k) ; wt_a = 1.0 - wt_b - vol = hP_Lv(J)%p(i,k) * G%US%L_to_m**2*G%areaT(i,j) + vol = hP_Lv(J)%p(i,k) * G%areaT(i,j) ! Ensure that the tracer flux does not drive the tracer values ! outside of the range Tr_min_face <= Tr <= Tr_max_face. @@ -1293,7 +1299,7 @@ subroutine tracer_epipycnal_ML_diff(h, dt, Tr, ntr, khdt_epi_x, khdt_epi_y, G, & if (deep_wt_Rv(J)%p(i,k) < 1.0) then Tr_adj_vert = 0.0 wt_b = deep_wt_Rv(J)%p(i,k) ; wt_a = 1.0 - wt_b - vol = hP_Rv(J)%p(i,k) * G%US%L_to_m**2*G%areaT(i,j+1) + vol = hP_Rv(J)%p(i,k) * G%areaT(i,j+1) ! Ensure that the tracer flux does not drive the tracer values ! outside of the range Tr_min_face <= Tr <= Tr_max_face. @@ -1336,7 +1342,7 @@ subroutine tracer_epipycnal_ML_diff(h, dt, Tr, ntr, khdt_epi_x, khdt_epi_y, G, & tr_flux_conv(i,j,kLb) = tr_flux_conv(i,j,kLb) - (wt_b*Tr_flux_3d(i,j,k) - Tr_adj_vert_L(i,j,k)) endif if (deep_wt_Rv(J)%p(i,k) >= 1.0) then - tr_flux_conv(i,j+1,kRb) = tr_flux_conv(i,j+1,kRb) + tr_flux_3d(i,j,k) + tr_flux_conv(i,j+1,kRb) = tr_flux_conv(i,j+1,kRb) + Tr_flux_3d(i,j,k) else kRa = k0a_Rv(J)%p(i,k) wt_b = deep_wt_Rv(J)%p(i,k) ; wt_a = 1.0 - wt_b @@ -1351,7 +1357,7 @@ subroutine tracer_epipycnal_ML_diff(h, dt, Tr, ntr, khdt_epi_x, khdt_epi_y, G, & do k=1,PEmax_kRho ; do j=js,je ; do i=is,ie if ((G%mask2dT(i,j) > 0.5) .and. (h(i,j,k) > 0.0)) then Tr(m)%t(i,j,k) = Tr(m)%t(i,j,k) + tr_flux_conv(i,j,k) / & - (h(i,j,k)*G%US%L_to_m**2*G%areaT(i,j)) + (h(i,j,k)*G%areaT(i,j)) tr_flux_conv(i,j,k) = 0.0 endif enddo ; enddo ; enddo @@ -1377,9 +1383,10 @@ end subroutine tracer_epipycnal_ML_diff !> Initialize lateral tracer diffusion module -subroutine tracer_hor_diff_init(Time, G, param_file, diag, EOS, CS) +subroutine tracer_hor_diff_init(Time, G, US, param_file, diag, EOS, CS) type(time_type), target, intent(in) :: Time !< current model time type(ocean_grid_type), intent(in) :: G !< ocean grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(diag_ctrl), target, intent(inout) :: diag !< diagnostic control type(EOS_type), target, intent(in) :: EOS !< Equation of state CS type(param_file_type), intent(in) :: param_file !< parameter file @@ -1403,7 +1410,7 @@ subroutine tracer_hor_diff_init(Time, G, param_file, diag, EOS, CS) call log_version(param_file, mdl, version, "") call get_param(param_file, mdl, "KHTR", CS%KhTr, & "The background along-isopycnal tracer diffusivity.", & - units="m2 s-1", default=0.0) + units="m2 s-1", default=0.0, scale=US%m_to_L**2*US%T_to_s) call get_param(param_file, mdl, "KHTR_SLOPE_CFF", CS%KhTr_Slope_Cff, & "The scaling coefficient for along-isopycnal tracer "//& "diffusivity using a shear-based (Visbeck-like) "//& @@ -1411,10 +1418,10 @@ subroutine tracer_hor_diff_init(Time, G, param_file, diag, EOS, CS) units="nondim", default=0.0) call get_param(param_file, mdl, "KHTR_MIN", CS%KhTr_Min, & "The minimum along-isopycnal tracer diffusivity.", & - units="m2 s-1", default=0.0) + units="m2 s-1", default=0.0, scale=US%m_to_L**2*US%T_to_s) call get_param(param_file, mdl, "KHTR_MAX", CS%KhTr_Max, & "The maximum along-isopycnal tracer diffusivity.", & - units="m2 s-1", default=0.0) + units="m2 s-1", default=0.0, scale=US%m_to_L**2*US%T_to_s) call get_param(param_file, mdl, "KHTR_PASSIVITY_COEFF", CS%KhTr_passivity_coeff, & "The coefficient that scales deformation radius over "//& "grid-spacing in passivity, where passivity is the ratio "//& @@ -1465,19 +1472,19 @@ subroutine tracer_hor_diff_init(Time, G, param_file, diag, EOS, CS) CS%id_CFL = -1 CS%id_KhTr_u = register_diag_field('ocean_model', 'KHTR_u', diag%axesCu1, Time, & - 'Epipycnal tracer diffusivity at zonal faces of tracer cell', 'm2 s-1') + 'Epipycnal tracer diffusivity at zonal faces of tracer cell', 'm2 s-1', conversion=US%L_to_m**2*US%s_to_T) CS%id_KhTr_v = register_diag_field('ocean_model', 'KHTR_v', diag%axesCv1, Time, & - 'Epipycnal tracer diffusivity at meridional faces of tracer cell', 'm2 s-1') - CS%id_KhTr_h = register_diag_field('ocean_model', 'KHTR_h', diag%axesT1, Time,& - 'Epipycnal tracer diffusivity at tracer cell center', 'm2 s-1', & + 'Epipycnal tracer diffusivity at meridional faces of tracer cell', 'm2 s-1', conversion=US%L_to_m**2*US%s_to_T) + CS%id_KhTr_h = register_diag_field('ocean_model', 'KHTR_h', diag%axesT1, Time, & + 'Epipycnal tracer diffusivity at tracer cell center', 'm2 s-1', conversion=US%L_to_m**2*US%s_to_T, & cmor_field_name='diftrelo', & cmor_standard_name= 'ocean_tracer_epineutral_laplacian_diffusivity', & cmor_long_name = 'Ocean Tracer Epineutral Laplacian Diffusivity') CS%id_khdt_x = register_diag_field('ocean_model', 'KHDT_x', diag%axesCu1, Time, & - 'Epipycnal tracer diffusivity operator at zonal faces of tracer cell', 'm2') + 'Epipycnal tracer diffusivity operator at zonal faces of tracer cell', 'm2', conversion=US%L_to_m**2) CS%id_khdt_y = register_diag_field('ocean_model', 'KHDT_y', diag%axesCv1, Time, & - 'Epipycnal tracer diffusivity operator at meridional faces of tracer cell', 'm2') + 'Epipycnal tracer diffusivity operator at meridional faces of tracer cell', 'm2', conversion=US%L_to_m**2) if (CS%check_diffusive_CFL) then CS%id_CFL = register_diag_field('ocean_model', 'CFL_lateral_diff', diag%axesT1, Time,& 'Grid CFL number for lateral/neutral tracer diffusion', 'nondim') From 90bbde24cf3a6fb5844a482a3cd40ac59a9c9fe2 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sat, 10 Aug 2019 05:56:36 -0400 Subject: [PATCH 178/297] Correct rescaling diffu and diffv across restarts Corrected for changes in the rescaling of diffu and diffv across restarts. All answers are bitwise identical. --- src/core/MOM_dynamics_split_RK2.F90 | 17 ++++++++++++++++- 1 file changed, 16 insertions(+), 1 deletion(-) diff --git a/src/core/MOM_dynamics_split_RK2.F90 b/src/core/MOM_dynamics_split_RK2.F90 index 193062ac42..7a81fab535 100644 --- a/src/core/MOM_dynamics_split_RK2.F90 +++ b/src/core/MOM_dynamics_split_RK2.F90 @@ -1011,6 +1011,8 @@ subroutine initialize_dyn_split_RK2(u, v, h, uh, vh, eta, Time, G, GV, US, param ! 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 :: accel_rescale ! A rescaling factor for accelerations from the representation in + ! a restart file to the internal representation in this run. real :: H_convert type(group_pass_type) :: pass_av_h_uvh logical :: use_tides, debug_truncations @@ -1146,10 +1148,23 @@ subroutine initialize_dyn_split_RK2(u, v, h, uh, vh, eta, Time, G, GV, US, param CS%tides_CSp) if (.not. query_initialized(CS%diffu,"diffu",restart_CS) .or. & - .not. query_initialized(CS%diffv,"diffv",restart_CS)) & + .not. query_initialized(CS%diffv,"diffv",restart_CS)) then call horizontal_viscosity(u, v, h, CS%diffu, CS%diffv, MEKE, VarMix, & G, GV, US, CS%hor_visc_CSp, & OBC=CS%OBC, BT=CS%barotropic_CSp) + else + if ( (US%s_to_T_restart * US%m_to_L_restart /= 0.0) .and. & + (US%m_to_L * US%s_to_T_restart**2 /= US%m_to_L_restart * US%s_to_T**2) ) then + accel_rescale = (US%m_to_L * US%s_to_T_restart**2) / (US%m_to_L_restart * US%s_to_T**2) + do k=1,nz ; do j=js,je ; do I=G%IscB,G%IecB + CS%diffu(I,j,k) = accel_rescale * CS%diffu(I,j,k) + enddo ; enddo ; enddo + do k=1,nz ; do J=G%JscB,G%JecB ; do i=is,ie + CS%diffv(i,J,k) = accel_rescale * CS%diffv(i,J,k) + enddo ; enddo ; enddo + endif + endif + if (.not. query_initialized(CS%u_av,"u2", restart_CS) .or. & .not. query_initialized(CS%u_av,"v2", restart_CS)) then CS%u_av(:,:,:) = u(:,:,:) From cdbd580eb18fb12edfc2171cefa48e3269f477ae Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sat, 10 Aug 2019 06:00:21 -0400 Subject: [PATCH 179/297] +Return N2_u from calc_isoneutral_slopes in [T-2] Rescaled the units of N2_u and N2_v returned from calc_isoneutral_slopes to [T-2]. Also simplified some rescaling factors in calc_isoneutral_slopes and MOM_lateral_mixing_coeffs. Also noted that the diagnostics CS%N2_u and CS%N2_v do not appear to be set. All answers are bitwise identical. --- src/core/MOM_isopycnal_slopes.F90 | 25 +++++----- .../lateral/MOM_lateral_mixing_coeffs.F90 | 50 ++++++++++--------- 2 files changed, 39 insertions(+), 36 deletions(-) diff --git a/src/core/MOM_isopycnal_slopes.F90 b/src/core/MOM_isopycnal_slopes.F90 index 18c47b3e90..30a2a451a8 100644 --- a/src/core/MOM_isopycnal_slopes.F90 +++ b/src/core/MOM_isopycnal_slopes.F90 @@ -39,10 +39,10 @@ subroutine calc_isoneutral_slopes(G, GV, US, h, e, tv, dt_kappa_smooth, & real, dimension(SZI_(G),SZJB_(G),SZK_(G)+1), intent(inout) :: slope_y !< Isopycnal slope in j-direction [nondim] real, dimension(SZIB_(G),SZJ_(G),SZK_(G)+1), & optional, intent(inout) :: N2_u !< Brunt-Vaisala frequency squared at - !! interfaces between u-points [s-2] + !! interfaces between u-points [T-2 ~> s-2] real, dimension(SZI_(G),SZJB_(G),SZK_(G)+1), & optional, intent(inout) :: N2_v !< Brunt-Vaisala frequency squared at - !! interfaces between u-points [s-2] + !! interfaces between u-points [[T-2 ~> s-2] integer, optional, intent(in) :: halo !< Halo width over which to compute ! real, optional, intent(in) :: eta_to_m !< The conversion factor from the units @@ -79,19 +79,18 @@ subroutine calc_isoneutral_slopes(G, GV, US, h, e, tv, dt_kappa_smooth, & real :: haA, haB, haL, haR ! Arithmetic mean thicknesses [H ~> m or kg m-2]. real :: dzaL, dzaR ! Temporary thicknesses in eta units [Z ~> m]. real :: wtA, wtB, wtL, wtR ! Unscaled weights, with various units. - real :: drdx, drdy ! Zonal and meridional density gradients [kg m-4]. + real :: drdx, drdy ! Zonal and meridional density gradients [kg m-3 L-1 ~> kg m-4]. real :: drdz ! Vertical density gradient [kg m-3 Z-1 ~> kg m-4]. real :: Slope ! The slope of density surfaces, calculated in a way ! that is always between -1 and 1. - real :: mag_grad2 ! The squared magnitude of the 3-d density gradient [kg2 m-8]. + real :: mag_grad2 ! The squared magnitude of the 3-d density gradient [kg2 m-6 L-2 ~> kg2 m-8]. real :: slope2_Ratio ! The ratio of the slope squared to slope_max squared. 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 :: dz_neglect ! A change in interface heighs that is so small it is usually lost ! in roundoff and can be neglected [Z ~> m]. - logical :: use_EOS ! If true, density is calculated from T & S using an - ! equation of state. + logical :: use_EOS ! If true, density is calculated from T & S using an equation of state. real :: G_Rho0, N2, dzN2, H_x(SZIB_(G)), H_y(SZI_(G)) real :: Z_to_L ! A conversion factor between from units for e to the ! units for lateral distances. @@ -111,9 +110,9 @@ subroutine calc_isoneutral_slopes(G, GV, US, h, e, tv, dt_kappa_smooth, & nz = G%ke ; IsdB = G%IsdB h_neglect = GV%H_subroundoff ; h_neglect2 = h_neglect**2 - Z_to_L = US%Z_to_m ; H_to_Z = GV%H_to_Z + Z_to_L = US%Z_to_L ; H_to_Z = GV%H_to_Z ! if (present(eta_to_m)) then - ! Z_to_L = eta_to_m ; H_to_Z = GV%H_to_m / eta_to_m + ! Z_to_L = eta_to_m*US%m_to_L ; H_to_Z = GV%H_to_m / eta_to_m ! endif L_to_Z = 1.0 / Z_to_L dz_neglect = GV%H_subroundoff * H_to_Z @@ -122,7 +121,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%g_Earth) / GV%Rho0 + G_Rho0 = (US%L_to_Z*L_to_Z*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. @@ -223,7 +222,7 @@ subroutine calc_isoneutral_slopes(G, GV, US, h, e, tv, dt_kappa_smooth, & ! ((hg2L/haL) + (hg2R/haR)) ! This is the gradient of density along geopotentials. drdx = ((wtA * drdiA + wtB * drdiB) / (wtA + wtB) - & - drdz * (e(i,j,K)-e(i+1,j,K))) * US%m_to_L*G%IdxCu(I,j) + drdz * (e(i,j,K)-e(i+1,j,K))) * G%IdxCu(I,j) ! This estimate of slope is accurate for small slopes, but bounded ! to be between -1 and 1. @@ -237,7 +236,7 @@ subroutine calc_isoneutral_slopes(G, GV, US, h, e, tv, dt_kappa_smooth, & if (present_N2_u) N2_u(I,j,k) = G_Rho0 * drdz * G%mask2dCu(I,j) ! Square of Brunt-Vaisala frequency [s-2] else ! With .not.use_EOS, the layers are constant density. - slope_x(I,j,K) = (Z_to_L*(e(i,j,K)-e(i+1,j,K))) * US%m_to_L*G%IdxCu(I,j) + slope_x(I,j,K) = (Z_to_L*(e(i,j,K)-e(i+1,j,K))) * G%IdxCu(I,j) endif enddo ! I @@ -307,7 +306,7 @@ subroutine calc_isoneutral_slopes(G, GV, US, h, e, tv, dt_kappa_smooth, & ! ((hg2L/haL) + (hg2R/haR)) ! This is the gradient of density along geopotentials. drdy = ((wtA * drdjA + wtB * drdjB) / (wtA + wtB) - & - drdz * (e(i,j,K)-e(i,j+1,K))) * US%m_to_L*G%IdyCv(i,J) + drdz * (e(i,j,K)-e(i,j+1,K))) * G%IdyCv(i,J) ! This estimate of slope is accurate for small slopes, but bounded ! to be between -1 and 1. @@ -321,7 +320,7 @@ subroutine calc_isoneutral_slopes(G, GV, US, h, e, tv, dt_kappa_smooth, & if (present_N2_v) N2_v(i,J,k) = G_Rho0 * drdz * G%mask2dCv(i,J) ! Square of Brunt-Vaisala frequency [s-2] else ! With .not.use_EOS, the layers are constant density. - slope_y(i,J,K) = (Z_to_L*(e(i,j,K)-e(i,j+1,K))) * US%m_to_L*G%IdyCv(i,J) + slope_y(i,J,K) = (Z_to_L*(e(i,j,K)-e(i,j+1,K))) * G%IdyCv(i,J) endif enddo ! i diff --git a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 index fa8d135b9b..1582b23615 100644 --- a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 +++ b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 @@ -111,7 +111,7 @@ module MOM_lateral_mixing_coeffs real :: Res_coef_visc !< A non-dimensional number that determines the function !! of resolution, used for lateral viscosity, as: !! F = 1 / (1 + (Res_coef_visc*Ld/dx)^Res_fn_power) - real :: kappa_smooth !< A diffusivity for smoothing T/S in vanished layers [m2 s-1] + real :: kappa_smooth !< A diffusivity for smoothing T/S in vanished layers [Z2 T-1 ~> m2 s-1] integer :: Res_fn_power_khth !< The power of dx/Ld in the KhTh resolution function. Any !! positive integer power may be used, but even powers !! and especially 2 are coded to be more efficient. @@ -156,10 +156,10 @@ subroutine calc_resoln_function(h, tv, G, GV, US, CS) ! Local variables ! 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] + real :: cg1_q ! The gravity wave speed interpolated to q points [L T-1 ~> m s-1] or [m s-1]. + real :: cg1_u ! The gravity wave speed interpolated to u points [L T-1 ~> m s-1] or [m s-1]. + real :: cg1_v ! The gravity wave speed interpolated to v points [L T-1 ~> m s-1] or [m s-1]. + real :: dx_term ! A term in the denominator [L2 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 @@ -406,7 +406,7 @@ subroutine calc_slope_functions(h, tv, dt, G, GV, US, CS) ! Local variables real, dimension(SZI_(G), SZJ_(G), SZK_(G)+1) :: & e ! The interface heights relative to mean sea level [Z ~> m]. - real, dimension(SZIB_(G), SZJ_(G), SZK_(G)+1) :: N2_u ! Square of Brunt-Vaisala freq at u-points [s-2] + real, dimension(SZIB_(G), SZJ_(G), SZK_(G)+1) :: N2_u ! Square of Brunt-Vaisala freq at u-points [T-2 ~> s-2] real, dimension(SZI_(G), SZJB_(G), SZK_(G)+1) :: N2_v ! Square of Brunt-Vaisala freq at v-points [s-2] if (.not. associated(CS)) call MOM_error(FATAL, "MOM_lateral_mixing_coeffs.F90, calc_slope_functions:"//& @@ -415,7 +415,7 @@ subroutine calc_slope_functions(h, tv, dt, G, GV, US, CS) if (CS%calculate_Eady_growth_rate) then call find_eta(h, tv, G, GV, US, e, halo_size=2) if (CS%use_stored_slopes) then - call calc_isoneutral_slopes(G, GV, US, h, e, tv, dt*CS%kappa_smooth, & + call calc_isoneutral_slopes(G, GV, US, h, e, tv, US%s_to_T*dt*CS%kappa_smooth, & CS%slope_x, CS%slope_y, N2_u, N2_v, 1) call calc_Visbeck_coeffs(h, CS%slope_x, CS%slope_y, N2_u, N2_v, G, GV, US, CS) ! call calc_slope_functions_using_just_e(h, G, CS, e, .false.) @@ -430,6 +430,8 @@ subroutine calc_slope_functions(h, tv, dt, G, GV, US, CS) if (CS%id_SN_v > 0) call post_data(CS%id_SN_v, CS%SN_v, CS%diag) if (CS%id_L2u > 0) call post_data(CS%id_L2u, CS%L2u, CS%diag) if (CS%id_L2v > 0) call post_data(CS%id_L2v, CS%L2v, CS%diag) + !### I do not believe that CS%N2_u and CS%N2_v are ever set, but because the contents + ! of CS are public, they might be set somewhere outside of this module. if (CS%id_N2_u > 0) call post_data(CS%id_N2_u, CS%N2_u, CS%diag) if (CS%id_N2_v > 0) call post_data(CS%id_N2_v, CS%N2_v, CS%diag) endif @@ -442,15 +444,17 @@ subroutine calc_Visbeck_coeffs(h, slope_x, slope_y, N2_u, N2_v, G, GV, US, CS) 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] real, dimension(SZIB_(G),SZJ_(G),SZK_(G)+1), intent(in) :: slope_x !< Zonal isoneutral slope - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)+1), intent(in) :: N2_u !< Brunt-Vaisala frequency at u-points [s-2] + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)+1), intent(in) :: N2_u !< Buoyancy (Brunt-Vaisala) frequency + !! at u-points [T-2 ~> s-2] real, dimension(SZI_(G),SZJB_(G),SZK_(G)+1), intent(in) :: slope_y !< Meridional isoneutral slope - real, dimension(SZI_(G),SZJB_(G),SZK_(G)+1), intent(in) :: N2_v !< Brunt-Vaisala frequency at v-points [s-2] + real, dimension(SZI_(G),SZJB_(G),SZK_(G)+1), intent(in) :: N2_v !< Buoyancy (Brunt-Vaisala) frequency + !! at v-points [T-2 ~> s-2] type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(VarMix_CS), pointer :: CS !< Variable mixing coefficients ! Local variables real :: S2 ! Interface slope squared [nondim] - real :: N2 ! Positive Brunt-Vaisala frequency or zero [s-2] + real :: N2 ! Positive buoyancy frequency or zero [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]. integer :: is, ie, js, je, nz @@ -504,7 +508,7 @@ subroutine calc_Visbeck_coeffs(h, slope_x, slope_y, N2_u, N2_v, G, GV, US, CS) 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) + US%T_to_s*sqrt( S2*N2 )*H_geom + 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 H_u(I) = H_u(I) + H_geom enddo ; enddo @@ -540,7 +544,7 @@ subroutine calc_Visbeck_coeffs(h, slope_x, slope_y, N2_u, N2_v, G, GV, US, CS) 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) + US%T_to_s*sqrt( S2*N2 )*H_geom + 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 H_v(i) = H_v(i) + H_geom enddo ; enddo @@ -562,7 +566,7 @@ subroutine calc_Visbeck_coeffs(h, slope_x, slope_y, N2_u, N2_v, G, GV, US, CS) if (CS%debug) then call uvchksum("calc_Visbeck_coeffs slope_[xy]", slope_x, slope_y, G%HI, haloshift=1) - call uvchksum("calc_Visbeck_coeffs N2_u, N2_v", N2_u, N2_v, G%HI) + call uvchksum("calc_Visbeck_coeffs N2_u, N2_v", N2_u, N2_v, G%HI, scale=US%s_to_T**2) call uvchksum("calc_Visbeck_coeffs SN_[uv]", CS%SN_u, CS%SN_v, G%HI, scale=US%s_to_T) endif @@ -707,14 +711,14 @@ subroutine calc_QG_Leith_viscosity(CS, G, GV, US, h, k, div_xx_dx, div_xx_dy, vo type(VarMix_CS), pointer :: CS !< Variable mixing coefficients type(ocean_grid_type), intent(in) :: G !< Ocean 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(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type ! 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 + real, dimension(SZIB_(G),SZJ_(G)), intent(in) :: div_xx_dx !< x-derivative of horizontal divergence !! (d/dx(du/dx + dv/dy)) [L-1 T-1 ~> m-1 s-1] - real, dimension(SZI_(G),SZJB_(G)), intent(in) :: div_xx_dy !< y-derivative of horizontal divergence + real, dimension(SZI_(G),SZJB_(G)), intent(in) :: div_xx_dy !< y-derivative of horizontal divergence !! (d/dy(du/dx + dv/dy)) [L-1 T-1 ~> 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)) [L-1 T-1 ~> m-1 s-1] @@ -736,11 +740,11 @@ subroutine calc_QG_Leith_viscosity(CS, G, GV, US, h, k, div_xx_dx, div_xx_dy, vo real, dimension(SZI_(G),SZJB_(G)) :: & ! vort_xy_dx, & ! x-derivative of vertical vorticity (d/dx(dv/dx - du/dy)) [L-1 T-1 ~> m-1 s-1] ! div_xx_dy, & ! y-derivative of horizontal divergence (d/dy(du/dx + dv/dy)) [L-1 T-1 ~> m-1 s-1] - dslopey_dz, & ! z-derivative of y-slope at v-points [m-1] + dslopey_dz, & ! z-derivative of y-slope at v-points [Z-1 ~> m-1] h_at_v, & ! Thickness at v-points [H ~> m or kg m-2] beta_v, & ! Beta at v-points [T-1 L-1 ~> s-1 m-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] + grad_vort_mag_v, & ! Magnitude of vorticity gradient at v-points [T-1 L-1 ~> s-1 m-1] + grad_div_mag_v ! Magnitude of divergence gradient at v-points [T-1 L-1 ~> s-1 m-1] real, dimension(SZIB_(G),SZJ_(G)) :: & ! vort_xy_dy, & ! y-derivative of vertical vorticity (d/dy(dv/dx - du/dy)) [L-1 T-1 ~> m-1 s-1] @@ -748,8 +752,8 @@ subroutine calc_QG_Leith_viscosity(CS, G, GV, US, h, k, div_xx_dx, div_xx_dy, vo dslopex_dz, & ! z-derivative of x-slope at u-points [Z-1 ~> m-1] h_at_u, & ! Thickness at u-points [H ~> m or kg m-2] beta_u, & ! Beta at u-points [T-1 L-1 ~> s-1 m-1] - grad_vort_mag_u, & ! mag. of vort. grad. at u-points [s-1 m-1] - grad_div_mag_u ! mag. of div. grad. at u-points [s-1 m-1] + grad_vort_mag_u, & ! Magnitude of vorticity gradient at u-points [T-1 L-1 ~> s-1 m-1] + grad_div_mag_u ! Magnitude of divergence gradient at u-points [T-1 L-1 ~> s-1 m-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 @@ -850,7 +854,7 @@ subroutine calc_QG_Leith_viscosity(CS, G, GV, US, h, k, div_xx_dx, div_xx_dy, vo 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%KH_v_QG(i,J,k) = MIN(grad_vort_mag_v(i,J) + grad_div_mag_v(i,J), 3.0*beta_v(i,J)) * & 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)) * & @@ -1001,7 +1005,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.", & - units="m2 s-1", default=1.0e-6, scale=US%m_to_Z**2) + units="m2 s-1", default=1.0e-6, scale=US%m_to_Z**2*US%T_to_s) endif if (CS%calculate_Eady_growth_rate) then From d1267c97f58df70ac33dae2aa85637616343f485 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sat, 10 Aug 2019 08:06:21 -0400 Subject: [PATCH 180/297] Rescaled variables in MOM_CoriolisAdv.F90 Applied dimensional rescaling to numerous internal variables in MOM_CoriolisAdv.F90 for expanded dimensional consistency testing and to prepare for velocities to passed in with units of [L T-1]. All answers are bitwise identical. --- src/core/MOM_CoriolisAdv.F90 | 136 +++++++++++++++++++---------------- 1 file changed, 74 insertions(+), 62 deletions(-) diff --git a/src/core/MOM_CoriolisAdv.F90 b/src/core/MOM_CoriolisAdv.F90 index 9d27542e75..ed16010f39 100644 --- a/src/core/MOM_CoriolisAdv.F90 +++ b/src/core/MOM_CoriolisAdv.F90 @@ -108,11 +108,11 @@ module MOM_CoriolisAdv contains !> Calculates the Coriolis and momentum advection contributions to the acceleration. -subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS) +subroutine CorAdCalc(u_in, v_in, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS) type(ocean_grid_type), intent(in) :: G !< Ocen grid structure type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: u !< Zonal velocity [m s-1] - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: v !< Meridional velocity [m s-1] + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: u_in !< Zonal velocity [m s-1] + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: v_in !< Meridional velocity [m s-1] real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness [H ~> m or kg m-2] real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: uh !< Zonal transport u*h*dy !! [H L2 T-1 ~> m3 s-1 or kg s-1] @@ -127,11 +127,15 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS) type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(CoriolisAdv_CS), pointer :: CS !< Control structure for MOM_CoriolisAdv + !### Temporary variables that will be removed later. + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)) :: u !< The zonal velocity [L T-1 ~> m s-1]. + real, dimension(SZI_(G),SZJB_(G),SZK_(G)) :: v !< The meridional velocity [L T-1 ~> m s-1]. + ! Local variables real, dimension(SZIB_(G),SZJB_(G)) :: & q, & ! Layer potential vorticity [H-1 T-1 ~> m-1 s-1 or m2 kg-1 s-1]. Ih_q, & ! The inverse of thickness interpolated to q points [H-1 ~> m-1 or m2 kg-1]. - Area_q ! The sum of the ocean areas at the 4 adjacent thickness points [m2]. + Area_q ! The sum of the ocean areas at the 4 adjacent thickness points [L2 ~> m2]. real, dimension(SZIB_(G),SZJ_(G)) :: & a, b, c, d ! a, b, c, & d are combinations of the potential vorticities @@ -140,18 +144,18 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS) ! and use the indexing of the corresponding u point. real, dimension(SZI_(G),SZJ_(G)) :: & - Area_h, & ! The ocean area at h points [m2]. Area_h is used to find the + Area_h, & ! The ocean area at h points [L2 ~> m2]. Area_h is used to find the ! average thickness in the denominator of q. 0 for land points. - KE ! Kinetic energy per unit mass [m2 s-2], KE = (u^2 + v^2)/2. + KE ! Kinetic energy per unit mass [L2 T-2 ~> m2 s-2], KE = (u^2 + v^2)/2. real, dimension(SZIB_(G),SZJ_(G)) :: & hArea_u, & ! The cell area weighted thickness interpolated to u points - ! times the effective areas [H m2 ~> m3 or kg]. + ! times the effective areas [H L2 ~> m3 or kg]. KEx, & ! The zonal gradient of Kinetic energy per unit mass [L T-2 ~> m s-2], ! KEx = d/dx KE. uh_center ! Transport based on arithmetic mean h at u-points [H L2 T-1 ~> m3 s-1 or kg s-1] real, dimension(SZI_(G),SZJB_(G)) :: & hArea_v, & ! The cell area weighted thickness interpolated to v points - ! times the effective areas [H m2 ~> m3 or kg]. + ! times the effective areas [H L2 ~> m3 or kg]. KEy, & ! The meridonal gradient of Kinetic energy per unit mass [L T-2 ~> m s-2], ! KEy = d/dy KE. vh_center ! Transport based on arithmetic mean h at v-points [H L2 T-1 ~> m3 s-1 or kg s-1] @@ -162,7 +166,7 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS) ep_u, ep_v ! Additional pseudo-Coriolis terms in the Arakawa and Lamb ! discretization [H-1 s-1 ~> m-1 s-1 or m2 kg-1 s-1]. real, dimension(SZIB_(G),SZJB_(G)) :: & - dvdx,dudy, &! Contributions to the circulation around q-points [m2 s-1] + dvdx, dudy, & ! Contributions to the circulation around q-points [L2 T-1 ~> m2 s-1] abs_vort, & ! Absolute vorticity at q-points [T-1 ~> s-1]. q2, & ! Relative vorticity over thickness [H-1 T-1 ~> m-1 s-1 or m2 kg-1 s-1]. max_fvq, & ! The maximum of the adjacent values of (-u) times absolute vorticity [L T-2 ~> m s-2]. @@ -183,11 +187,11 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS) real :: Ih ! Inverse of thickness [H-1 ~> m-1 or m2 kg-1]. real :: max_Ihq, min_Ihq ! The maximum and minimum of the nearby Ihq [H-1 ~> m-1 or m2 kg-1]. real :: hArea_q ! The sum of area times thickness of the cells - ! surrounding a q point [H m2 ~> m3 or kg]. + ! surrounding a q point [H L2 ~> m3 or kg]. 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 :: temp1, temp2 ! Temporary variables [L2 T-2 ~> m2 s-2]. - real, parameter :: eps_vel=1.0e-10 ! A tiny, positive velocity [m s-1]. + real :: eps_vel ! A tiny, positive velocity [L T-1 ~> m s-1]. real :: uhc, vhc ! Centered estimates of uh and vh [H L2 T-1 ~> m3 s-1 or kg s-1]. real :: uhm, vhm ! The input estimates of uh and vh [H L2 T-1 ~> m3 s-1 or kg s-1]. @@ -220,11 +224,12 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS) is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB ; nz = G%ke h_neglect = GV%H_subroundoff + eps_vel = 1.0e-10*US%m_s_to_L_T h_tiny = GV%Angstrom_H ! Perhaps this should be set to h_neglect instead. !$OMP parallel do default(private) shared(Isq,Ieq,Jsq,Jeq,G,Area_h) do j=Jsq-1,Jeq+2 ; do I=Isq-1,Ieq+2 - Area_h(i,j) = G%mask2dT(i,j) * US%L_to_m**2*G%areaT(i,j) + Area_h(i,j) = G%mask2dT(i,j) * G%areaT(i,j) enddo ; enddo if (associated(OBC)) then ; do n=1,OBC%number_of_segments if (.not. OBC%segment(n)%on_pe) cycle @@ -256,14 +261,24 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS) !$OMP parallel do default(private) shared(u,v,h,uh,vh,CAu,CAv,G,CS,AD,Area_h,Area_q,& !$OMP RV,PV,is,ie,js,je,Isq,Ieq,Jsq,Jeq,nz,h_neglect,h_tiny,OBC) do k=1,nz + + !## This is temporary code until the input velocities have been dimensionally rescaled. + do j=Jsq-1,Jeq+2 ; do I=Isq-2,Ieq+2 + u(I,j,k) = US%m_s_to_L_T*u_in(I,j,k) + enddo ; enddo + do j=Jsq-2,Jeq+2 ; do i=Isq-1,Ieq+2 + v(i,J,k) = US%m_s_to_L_T*v_in(i,J,k) + enddo ; enddo + + ! Here the second order accurate layer potential vorticities, q, ! are calculated. hq is second order accurate in space. Relative ! vorticity is second order accurate everywhere with free slip b.c.s, ! but only first order accurate at boundaries with no slip b.c.s. ! First calculate the contributions to the circulation around the q-point. do J=Jsq-1,Jeq+1 ; do I=Isq-1,Ieq+1 - dvdx(I,J) = v(i+1,J,k)*US%L_to_m*G%dyCv(i+1,J) - v(i,J,k)*US%L_to_m*G%dyCv(i,J) - dudy(I,J) = u(I,j+1,k)*US%L_to_m*G%dxCu(I,j+1) - u(I,j,k)*US%L_to_m*G%dxCu(I,j) + dvdx(I,J) = (v(i+1,J,k)*G%dyCv(i+1,J) - v(i,J,k)*G%dyCv(i,J)) + dudy(I,J) = (u(I,j+1,k)*G%dxCu(I,j+1) - u(I,j,k)*G%dxCu(I,j)) enddo ; enddo do J=Jsq-1,Jeq+1 ; do i=Isq-1,Ieq+2 hArea_v(i,J) = 0.5*(Area_h(i,j) * h(i,j,k) + Area_h(i,j+1) * h(i,j+1,k)) @@ -273,10 +288,10 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS) enddo ; enddo if (CS%Coriolis_En_Dis) then do j=Jsq,Jeq+1 ; do I=is-1,ie - uh_center(I,j) = 0.5 * (G%dy_Cu(I,j) * US%m_s_to_L_T*u(I,j,k)) * (h(i,j,k) + h(i+1,j,k)) + uh_center(I,j) = 0.5 * (G%dy_Cu(I,j) * u(I,j,k)) * (h(i,j,k) + h(i+1,j,k)) enddo ; enddo do J=js-1,je ; do i=Isq,Ieq+1 - vh_center(i,J) = 0.5 * (G%dx_Cv(i,J) * US%m_s_to_L_T*v(i,J,k)) * (h(i,j,k) + h(i,j+1,k)) + vh_center(i,J) = 0.5 * (G%dx_Cv(i,J) * v(i,J,k)) * (h(i,j,k) + h(i,j+1,k)) enddo ; enddo endif @@ -294,16 +309,16 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS) enddo ; endif if (OBC%computed_vorticity) then ; do I=OBC%segment(n)%HI%IsdB,OBC%segment(n)%HI%IedB if (OBC%segment(n)%direction == OBC_DIRECTION_N) then - dudy(I,J) = 2.0*(OBC%segment(n)%tangential_vel(I,J,k) - u(I,j,k))*US%L_to_m*G%dxCu(I,j) + dudy(I,J) = 2.0*(US%m_s_to_L_T*OBC%segment(n)%tangential_vel(I,J,k) - u(I,j,k))*G%dxCu(I,j) else ! (OBC%segment(n)%direction == OBC_DIRECTION_S) - dudy(I,J) = 2.0*(u(I,j+1,k) - OBC%segment(n)%tangential_vel(I,J,k))*US%L_to_m*G%dxCu(I,j+1) + dudy(I,J) = 2.0*(u(I,j+1,k) - US%m_s_to_L_T*OBC%segment(n)%tangential_vel(I,J,k))*G%dxCu(I,j+1) endif enddo ; endif if (OBC%specified_vorticity) then ; do I=OBC%segment(n)%HI%IsdB,OBC%segment(n)%HI%IedB if (OBC%segment(n)%direction == OBC_DIRECTION_N) then - dudy(I,J) = US%L_to_m**2*OBC%segment(n)%tangential_grad(I,J,k)*G%dxCu(I,j)*G%dyBu(I,J) + dudy(I,J) = US%T_to_s*OBC%segment(n)%tangential_grad(I,J,k)*G%dxCu(I,j)*G%dyBu(I,J) else ! (OBC%segment(n)%direction == OBC_DIRECTION_S) - dudy(I,J) = US%L_to_m**2*OBC%segment(n)%tangential_grad(I,J,k)*G%dxCu(I,j+1)*G%dyBu(I,J) + dudy(I,J) = US%T_to_s*OBC%segment(n)%tangential_grad(I,J,k)*G%dxCu(I,j+1)*G%dyBu(I,J) endif enddo ; endif @@ -319,9 +334,9 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS) if (CS%Coriolis_En_Dis) then do i = max(Isq-1,OBC%segment(n)%HI%isd), min(Ieq+2,OBC%segment(n)%HI%ied) if (OBC%segment(n)%direction == OBC_DIRECTION_N) then - vh_center(i,J) = G%dx_Cv(i,J) * US%m_s_to_L_T*v(i,J,k) * h(i,j,k) + vh_center(i,J) = G%dx_Cv(i,J) * v(i,J,k) * h(i,j,k) else ! (OBC%segment(n)%direction == OBC_DIRECTION_S) - vh_center(i,J) = G%dx_Cv(i,J) * US%m_s_to_L_T*v(i,J,k) * h(i,j+1,k) + vh_center(i,J) = G%dx_Cv(i,J) * v(i,J,k) * h(i,j+1,k) endif enddo endif @@ -334,16 +349,16 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS) enddo ; endif if (OBC%computed_vorticity) then ; do J=OBC%segment(n)%HI%JsdB,OBC%segment(n)%HI%JedB if (OBC%segment(n)%direction == OBC_DIRECTION_E) then - dvdx(I,J) = 2.0*(OBC%segment(n)%tangential_vel(I,J,k) - v(i,J,k))*US%L_to_m*G%dyCv(i,J) + dvdx(I,J) = 2.0*(US%m_s_to_L_T*OBC%segment(n)%tangential_vel(I,J,k) - v(i,J,k))*G%dyCv(i,J) else ! (OBC%segment(n)%direction == OBC_DIRECTION_W) - dvdx(I,J) = 2.0*(v(i+1,J,k) - OBC%segment(n)%tangential_vel(I,J,k))*US%L_to_m*G%dyCv(i+1,J) + dvdx(I,J) = 2.0*(v(i+1,J,k) - US%m_s_to_L_T*OBC%segment(n)%tangential_vel(I,J,k))*G%dyCv(i+1,J) endif enddo ; endif if (OBC%specified_vorticity) then ; do J=OBC%segment(n)%HI%JsdB,OBC%segment(n)%HI%JedB if (OBC%segment(n)%direction == OBC_DIRECTION_E) then - dvdx(I,J) = US%L_to_m**2*OBC%segment(n)%tangential_grad(I,J,k)*G%dyCv(i,J)*G%dxBu(I,J) + dvdx(I,J) = US%T_to_s*OBC%segment(n)%tangential_grad(I,J,k)*G%dyCv(i,J)*G%dxBu(I,J) else ! (OBC%segment(n)%direction == OBC_DIRECTION_W) - dvdx(I,J) = US%L_to_m**2*OBC%segment(n)%tangential_grad(I,J,k)*G%dyCv(i+1,J)*G%dxBu(I,J) + dvdx(I,J) = US%T_to_s*OBC%segment(n)%tangential_grad(I,J,k)*G%dyCv(i+1,J)*G%dxBu(I,J) endif enddo ; endif @@ -358,9 +373,9 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS) if (CS%Coriolis_En_Dis) then do j = max(Jsq-1,OBC%segment(n)%HI%jsd), min(Jeq+2,OBC%segment(n)%HI%jed) if (OBC%segment(n)%direction == OBC_DIRECTION_E) then - uh_center(I,j) = G%dy_Cu(I,j) * US%m_s_to_L_T*u(I,j,k) * h(i,j,k) + uh_center(I,j) = G%dy_Cu(I,j) * u(I,j,k) * h(i,j,k) else ! (OBC%segment(n)%direction == OBC_DIRECTION_W) - uh_center(I,j) = G%dy_Cu(I,j) * US%m_s_to_L_T*u(I,j,k) * h(i+1,j,k) + uh_center(I,j) = G%dy_Cu(I,j) * u(I,j,k) * h(i+1,j,k) endif enddo endif @@ -406,11 +421,9 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS) do J=Jsq-1,Jeq+1 ; do I=Isq-1,Ieq+1 if (CS%no_slip ) then - relative_vorticity = (2.0-G%mask2dBu(I,J)) * US%T_to_s*(dvdx(I,J) - dudy(I,J)) * & - US%m_to_L**2*G%IareaBu(I,J) + relative_vorticity = (2.0-G%mask2dBu(I,J)) * (dvdx(I,J) - dudy(I,J)) * G%IareaBu(I,J) else - relative_vorticity = G%mask2dBu(I,J) * US%T_to_s*(dvdx(I,J) - dudy(I,J)) * & - US%m_to_L**2*G%IareaBu(I,J) + relative_vorticity = G%mask2dBu(I,J) * (dvdx(I,J) - dudy(I,J)) * G%IareaBu(I,J) endif absolute_vorticity = G%CoriolisBu(I,J) + relative_vorticity Ih = 0.0 @@ -423,10 +436,10 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS) Ih_q(I,J) = Ih if (CS%bound_Coriolis) then - fv1 = absolute_vorticity * US%m_s_to_L_T*v(i+1,J,k) - fv2 = absolute_vorticity * US%m_s_to_L_T*v(i,J,k) - fu1 = -absolute_vorticity * US%m_s_to_L_T*u(I,j+1,k) - fu2 = -absolute_vorticity * US%m_s_to_L_T*u(I,j,k) + fv1 = absolute_vorticity * v(i+1,J,k) + fv2 = absolute_vorticity * v(i,J,k) + fu1 = -absolute_vorticity * u(I,j+1,k) + fu2 = -absolute_vorticity * u(I,j,k) if (fv1 > fv2) then max_fvq(I,J) = fv1 ; min_fvq(I,J) = fv2 else @@ -618,16 +631,16 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS) ! Note: Heffs are in lieu of h_at_v that should be returned by the ! continuity solver. AJA do j=js,je ; do I=Isq,Ieq - Heff1 = abs(vh(i,J,k) * G%IdxCv(i,J)) / (US%m_s_to_L_T*(eps_vel+abs(v(i,J,k)))) + Heff1 = abs(vh(i,J,k) * G%IdxCv(i,J)) / (eps_vel+abs(v(i,J,k))) Heff1 = max(Heff1, min(h(i,j,k),h(i,j+1,k))) Heff1 = min(Heff1, max(h(i,j,k),h(i,j+1,k))) - Heff2 = abs(vh(i,J-1,k) * G%IdxCv(i,J-1)) / (US%m_s_to_L_T*(eps_vel+abs(v(i,J-1,k)))) + Heff2 = abs(vh(i,J-1,k) * G%IdxCv(i,J-1)) / (eps_vel+abs(v(i,J-1,k))) Heff2 = max(Heff2, min(h(i,j-1,k),h(i,j,k))) Heff2 = min(Heff2, max(h(i,j-1,k),h(i,j,k))) - Heff3 = abs(vh(i+1,J,k) * G%IdxCv(i+1,J)) / (US%m_s_to_L_T*(eps_vel+abs(v(i+1,J,k)))) + Heff3 = abs(vh(i+1,J,k) * G%IdxCv(i+1,J)) / (eps_vel+abs(v(i+1,J,k))) Heff3 = max(Heff3, min(h(i+1,j,k),h(i+1,j+1,k))) Heff3 = min(Heff3, max(h(i+1,j,k),h(i+1,j+1,k))) - Heff4 = abs(vh(i+1,J-1,k) * G%IdxCv(i+1,J-1)) / (US%m_s_to_L_T*(eps_vel+abs(v(i+1,J-1,k)))) + Heff4 = abs(vh(i+1,J-1,k) * G%IdxCv(i+1,J-1)) / (eps_vel+abs(v(i+1,J-1,k))) Heff4 = max(Heff4, min(h(i+1,j-1,k),h(i+1,j,k))) Heff4 = min(Heff4, max(h(i+1,j-1,k),h(i+1,j,k))) if (CS%PV_Adv_Scheme == PV_ADV_CENTERED) then @@ -724,16 +737,16 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS) ! Note: Heffs are in lieu of h_at_u that should be returned by the ! continuity solver. AJA do J=Jsq,Jeq ; do i=is,ie - Heff1 = abs(uh(I,j,k) * G%IdyCu(I,j)) / (US%m_s_to_L_T*(eps_vel+abs(u(I,j,k)))) + Heff1 = abs(uh(I,j,k) * G%IdyCu(I,j)) / (eps_vel+abs(u(I,j,k))) Heff1 = max(Heff1, min(h(i,j,k),h(i+1,j,k))) Heff1 = min(Heff1, max(h(i,j,k),h(i+1,j,k))) - Heff2 = abs(uh(I-1,j,k) * G%IdyCu(I-1,j)) / (US%m_s_to_L_T*(eps_vel+abs(u(I-1,j,k)))) + Heff2 = abs(uh(I-1,j,k) * G%IdyCu(I-1,j)) / (eps_vel+abs(u(I-1,j,k))) Heff2 = max(Heff2, min(h(i-1,j,k),h(i,j,k))) Heff2 = min(Heff2, max(h(i-1,j,k),h(i,j,k))) - Heff3 = abs(uh(I,j+1,k) * G%IdyCu(I,j+1)) / (US%m_s_to_L_T*(eps_vel+abs(u(I,j+1,k)))) + Heff3 = abs(uh(I,j+1,k) * G%IdyCu(I,j+1)) / (eps_vel+abs(u(I,j+1,k))) Heff3 = max(Heff3, min(h(i,j+1,k),h(i+1,j+1,k))) Heff3 = min(Heff3, max(h(i,j+1,k),h(i+1,j+1,k))) - Heff4 = abs(uh(I-1,j+1,k) * G%IdyCu(I-1,j+1)) / (US%m_s_to_L_T*(eps_vel+abs(u(I-1,j+1,k)))) + Heff4 = abs(uh(I-1,j+1,k) * G%IdyCu(I-1,j+1)) / (eps_vel+abs(u(I-1,j+1,k))) Heff4 = max(Heff4, min(h(i-1,j+1,k),h(i,j+1,k))) Heff4 = min(Heff4, max(h(i-1,j+1,k),h(i,j+1,k))) if (CS%PV_Adv_Scheme == PV_ADV_CENTERED) then @@ -835,10 +848,10 @@ end subroutine CorAdCalc !> Calculates the acceleration due to the gradient of kinetic energy. subroutine gradKE(u, v, h, KE, KEx, KEy, k, OBC, G, US, CS) type(ocean_grid_type), intent(in) :: G !< Ocen grid structure - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: u !< Zonal velocity [m s-1] - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: v !< Meridional velocity [m s-1] + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: u !< Zonal velocity [L T-1 ~> m s-1] + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: v !< Meridional velocity [L T-1 ~> m s-1] 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) ), intent(out) :: KE !< Kinetic energy per unit mass [m2 s-2] + real, dimension(SZI_(G) ,SZJ_(G) ), intent(out) :: KE !< Kinetic energy per unit mass [L2 T-2 ~> m2 s-2] real, dimension(SZIB_(G),SZJ_(G) ), intent(out) :: KEx !< Zonal acceleration due to kinetic !! energy gradient [L T-2 ~> m s-2] real, dimension(SZI_(G) ,SZJB_(G)), intent(out) :: KEy !< Meridional acceleration due to kinetic @@ -848,9 +861,9 @@ subroutine gradKE(u, v, h, KE, KEx, KEy, k, OBC, G, US, CS) type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(CoriolisAdv_CS), pointer :: CS !< Control structure for MOM_CoriolisAdv ! Local variables - real :: um, up, vm, vp ! Temporary variables [m s-1]. - real :: um2, up2, vm2, vp2 ! Temporary variables [m2 s-2]. - real :: um2a, up2a, vm2a, vp2a ! Temporary variables [m4 s-2]. + real :: um, up, vm, vp ! Temporary variables [L T-1 ~> m s-1]. + real :: um2, up2, vm2, vp2 ! Temporary variables [L2 T-2 ~> m2 s-2]. + real :: um2a, up2a, vm2a, vp2a ! Temporary variables [L4 T-2 ~> m4 s-2]. integer :: i, j, is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz, n is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke @@ -863,11 +876,10 @@ subroutine gradKE(u, v, h, KE, KEx, KEy, k, OBC, G, US, CS) ! identified in Arakawa & Lamb 1982 as important for KE conservation. It ! also includes the possibility of partially-blocked tracer cell faces. do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - KE(i,j) = ( ( US%L_to_m**2*G%areaCu( I ,j)*(u( I ,j,k)*u( I ,j,k)) & - +US%L_to_m**2*G%areaCu(I-1,j)*(u(I-1,j,k)*u(I-1,j,k)) ) & - +( US%L_to_m**2*G%areaCv(i, J )*(v(i, J ,k)*v(i, J ,k)) & - +US%L_to_m**2*G%areaCv(i,J-1)*(v(i,J-1,k)*v(i,J-1,k)) ) & - )*0.25*US%m_to_L**2*G%IareaT(i,j) + KE(i,j) = ( ( G%areaCu( I ,j)*(u( I ,j,k)*u( I ,j,k)) + & + G%areaCu(I-1,j)*(u(I-1,j,k)*u(I-1,j,k)) ) + & + ( G%areaCv(i, J )*(v(i, J ,k)*v(i, J ,k)) + & + G%areaCv(i,J-1)*(v(i,J-1,k)*v(i,J-1,k)) ) )*0.25*G%IareaT(i,j) enddo ; enddo elseif (CS%KE_Scheme == KE_SIMPLE_GUDONOV) then ! The following discretization of KE is based on the one-dimensinal Gudonov @@ -883,22 +895,22 @@ subroutine gradKE(u, v, h, KE, KEx, KEy, k, OBC, G, US, CS) ! The following discretization of KE is based on the one-dimensinal Gudonov ! scheme but has been adapted to take horizontal grid factors into account do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - up = 0.5*( u(I-1,j,k) + ABS( u(I-1,j,k) ) ) ; up2a = up*up*US%L_to_m**2*G%areaCu(I-1,j) - um = 0.5*( u( I ,j,k) - ABS( u( I ,j,k) ) ) ; um2a = um*um*US%L_to_m**2*G%areaCu( I ,j) - vp = 0.5*( v(i,J-1,k) + ABS( v(i,J-1,k) ) ) ; vp2a = vp*vp*US%L_to_m**2*G%areaCv(i,J-1) - vm = 0.5*( v(i, J ,k) - ABS( v(i, J ,k) ) ) ; vm2a = vm*vm*US%L_to_m**2*G%areaCv(i, J ) - KE(i,j) = ( max(um2a,up2a) + max(vm2a,vp2a) )*0.5*US%m_to_L**2*G%IareaT(i,j) + up = 0.5*( u(I-1,j,k) + ABS( u(I-1,j,k) ) ) ; up2a = up*up*G%areaCu(I-1,j) + um = 0.5*( u( I ,j,k) - ABS( u( I ,j,k) ) ) ; um2a = um*um*G%areaCu( I ,j) + vp = 0.5*( v(i,J-1,k) + ABS( v(i,J-1,k) ) ) ; vp2a = vp*vp*G%areaCv(i,J-1) + vm = 0.5*( v(i, J ,k) - ABS( v(i, J ,k) ) ) ; vm2a = vm*vm*G%areaCv(i, J ) + KE(i,j) = ( max(um2a,up2a) + max(vm2a,vp2a) )*0.5*G%IareaT(i,j) enddo ; enddo endif ! Term - d(KE)/dx. do j=js,je ; do I=Isq,Ieq - KEx(I,j) = US%m_s_to_L_T**2*(KE(i+1,j) - KE(i,j)) * G%IdxCu(I,j) + KEx(I,j) = (KE(i+1,j) - KE(i,j)) * G%IdxCu(I,j) enddo ; enddo ! Term - d(KE)/dy. do J=Jsq,Jeq ; do i=is,ie - KEy(i,J) = US%m_s_to_L_T**2*(KE(i,j+1) - KE(i,j)) * G%IdyCv(i,J) + KEy(i,J) = (KE(i,j+1) - KE(i,j)) * G%IdyCv(i,J) enddo ; enddo if (associated(OBC)) then From d8208887ab5201ad0e1e8a657feff4727979dc00 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sat, 10 Aug 2019 10:19:14 -0400 Subject: [PATCH 181/297] +Rescaled OBC%segment%normal_vel to units of [L T-1] Rescaled the units of the normal_vel, tangential_vel and related elements of the OBC_segment type to [T-1 L-1] for more complete dimensional consistency testing. All answers are bitwise identical, but the units of 5 variables in a transparent type have been rescaled. --- src/core/MOM_CoriolisAdv.F90 | 8 +-- src/core/MOM_barotropic.F90 | 4 +- src/core/MOM_continuity_PPM.F90 | 11 +-- src/core/MOM_dynamics_split_RK2.F90 | 4 +- src/core/MOM_open_boundary.F90 | 71 ++++++++++--------- .../lateral/MOM_hor_visc.F90 | 8 +-- .../vertical/MOM_vert_friction.F90 | 4 +- src/user/DOME_initialization.F90 | 2 +- src/user/Kelvin_initialization.F90 | 22 +++--- src/user/dyed_channel_initialization.F90 | 4 +- src/user/shelfwave_initialization.F90 | 4 +- src/user/supercritical_initialization.F90 | 4 +- src/user/tidal_bay_initialization.F90 | 2 +- 13 files changed, 75 insertions(+), 73 deletions(-) diff --git a/src/core/MOM_CoriolisAdv.F90 b/src/core/MOM_CoriolisAdv.F90 index ed16010f39..e734b1a00d 100644 --- a/src/core/MOM_CoriolisAdv.F90 +++ b/src/core/MOM_CoriolisAdv.F90 @@ -309,9 +309,9 @@ subroutine CorAdCalc(u_in, v_in, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS) enddo ; endif if (OBC%computed_vorticity) then ; do I=OBC%segment(n)%HI%IsdB,OBC%segment(n)%HI%IedB if (OBC%segment(n)%direction == OBC_DIRECTION_N) then - dudy(I,J) = 2.0*(US%m_s_to_L_T*OBC%segment(n)%tangential_vel(I,J,k) - u(I,j,k))*G%dxCu(I,j) + dudy(I,J) = 2.0*(OBC%segment(n)%tangential_vel(I,J,k) - u(I,j,k))*G%dxCu(I,j) else ! (OBC%segment(n)%direction == OBC_DIRECTION_S) - dudy(I,J) = 2.0*(u(I,j+1,k) - US%m_s_to_L_T*OBC%segment(n)%tangential_vel(I,J,k))*G%dxCu(I,j+1) + dudy(I,J) = 2.0*(u(I,j+1,k) - OBC%segment(n)%tangential_vel(I,J,k))*G%dxCu(I,j+1) endif enddo ; endif if (OBC%specified_vorticity) then ; do I=OBC%segment(n)%HI%IsdB,OBC%segment(n)%HI%IedB @@ -349,9 +349,9 @@ subroutine CorAdCalc(u_in, v_in, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS) enddo ; endif if (OBC%computed_vorticity) then ; do J=OBC%segment(n)%HI%JsdB,OBC%segment(n)%HI%JedB if (OBC%segment(n)%direction == OBC_DIRECTION_E) then - dvdx(I,J) = 2.0*(US%m_s_to_L_T*OBC%segment(n)%tangential_vel(I,J,k) - v(i,J,k))*G%dyCv(i,J) + dvdx(I,J) = 2.0*(OBC%segment(n)%tangential_vel(I,J,k) - v(i,J,k))*G%dyCv(i,J) else ! (OBC%segment(n)%direction == OBC_DIRECTION_W) - dvdx(I,J) = 2.0*(v(i+1,J,k) - US%m_s_to_L_T*OBC%segment(n)%tangential_vel(I,J,k))*G%dyCv(i+1,J) + dvdx(I,J) = 2.0*(v(i+1,J,k) - OBC%segment(n)%tangential_vel(I,J,k))*G%dyCv(i+1,J) endif enddo ; endif if (OBC%specified_vorticity) then ; do J=OBC%segment(n)%HI%JsdB,OBC%segment(n)%HI%JedB diff --git a/src/core/MOM_barotropic.F90 b/src/core/MOM_barotropic.F90 index 6438efc816..0e2e022e48 100644 --- a/src/core/MOM_barotropic.F90 +++ b/src/core/MOM_barotropic.F90 @@ -2657,7 +2657,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) = US%m_s_to_L_T*segment%normal_vel_bt(I,j) + BT_OBC%ubt_outer(I,j) = segment%normal_vel_bt(I,j) BT_OBC%eta_outer_u(I,j) = segment%eta(I,j) enddo ; enddo endif @@ -2709,7 +2709,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) = US%m_s_to_L_T*segment%normal_vel_bt(i,J) + BT_OBC%vbt_outer(i,J) = segment%normal_vel_bt(i,J) BT_OBC%eta_outer_v(i,J) = segment%eta(i,J) enddo ; enddo endif diff --git a/src/core/MOM_continuity_PPM.F90 b/src/core/MOM_continuity_PPM.F90 index 979edadcb0..63e7366a55 100644 --- a/src/core/MOM_continuity_PPM.F90 +++ b/src/core/MOM_continuity_PPM.F90 @@ -426,7 +426,7 @@ subroutine zonal_mass_flux(u, h_in, uh, dt_in_T, G, GV, US, CS, LB, uhbt, OBC, & do I=ish-1,ieh ; u_cor(I,j,k) = u(I,j,k) + du(I) * visc_rem(I,k) ; enddo if (local_specified_BC) then ; do I=ish-1,ieh if (OBC%segment(OBC%segnum_u(I,j))%specified) & - u_cor(I,j,k) = US%m_s_to_L_T*OBC%segment(OBC%segnum_u(I,j))%normal_vel(I,j,k) + u_cor(I,j,k) = OBC%segment(OBC%segnum_u(I,j))%normal_vel(I,j,k) enddo ; endif enddo ; endif ! u-corrected @@ -444,8 +444,9 @@ subroutine zonal_mass_flux(u, h_in, uh, dt_in_T, G, GV, US, CS, LB, uhbt, OBC, & do k=1,nz ; do I=ish-1,ieh ; if (do_I(I)) then if ((abs(OBC%segment(OBC%segnum_u(I,j))%normal_vel(I,j,k)) > 0.0) .and. & (OBC%segment(OBC%segnum_u(I,j))%specified)) & - FAuI(I) = FAuI(I) + US%m_to_L*OBC%segment(OBC%segnum_u(I,j))%normal_trans(I,j,k) / & - OBC%segment(OBC%segnum_u(I,j))%normal_vel(I,j,k) + FAuI(I) = FAuI(I) + US%m_to_L**2*US%T_to_s * & + OBC%segment(OBC%segnum_u(I,j))%normal_trans(I,j,k) / & + 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) @@ -1222,7 +1223,7 @@ subroutine meridional_mass_flux(v, h_in, vh, dt_in_T, G, GV, US, CS, LB, vhbt, O do i=ish,ieh ; v_cor(i,J,k) = v(i,J,k) + dv(i) * visc_rem(i,k) ; enddo if (local_specified_BC) then ; do i=ish,ieh if (OBC%segment(OBC%segnum_v(i,J))%specified) & - v_cor(i,J,k) = US%m_s_to_L_T*OBC%segment(OBC%segnum_v(i,J))%normal_vel(i,J,k) + v_cor(i,J,k) = OBC%segment(OBC%segnum_v(i,J))%normal_vel(i,J,k) enddo ; endif enddo ; endif ! v-corrected endif @@ -1239,7 +1240,7 @@ subroutine meridional_mass_flux(v, h_in, vh, dt_in_T, G, GV, US, CS, LB, vhbt, O do k=1,nz ; do i=ish,ieh ; if (do_I(i)) then if ((abs(OBC%segment(OBC%segnum_v(i,J))%normal_vel(i,J,k)) > 0.0) .and. & (OBC%segment(OBC%segnum_v(i,J))%specified)) & - FAvi(i) = FAvi(i) + US%m_to_L * & + FAvi(i) = FAvi(i) + US%m_to_L**2*US%T_to_s * & OBC%segment(OBC%segnum_v(i,J))%normal_trans(i,J,k) / & OBC%segment(OBC%segnum_v(i,J))%normal_vel(i,J,k) endif ; enddo ; enddo diff --git a/src/core/MOM_dynamics_split_RK2.F90 b/src/core/MOM_dynamics_split_RK2.F90 index 7a81fab535..4440e2fe72 100644 --- a/src/core/MOM_dynamics_split_RK2.F90 +++ b/src/core/MOM_dynamics_split_RK2.F90 @@ -619,7 +619,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & if (CS%debug) & call uvchksum("Pre OBC avg [uv]", u_av, v_av, G%HI, haloshift=1, symmetric=sym) - call radiation_open_bdry_conds(CS%OBC, u_av, u_old_rad_OBC, v_av, v_old_rad_OBC, G, dt_pred) + call radiation_open_bdry_conds(CS%OBC, u_av, u_old_rad_OBC, v_av, v_old_rad_OBC, G, US, dt_pred) if (CS%debug) & call uvchksum("Post OBC avg [uv]", u_av, v_av, G%HI, haloshift=1, symmetric=sym) @@ -826,7 +826,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & endif if (associated(CS%OBC)) then - call radiation_open_bdry_conds(CS%OBC, u, u_old_rad_OBC, v, v_old_rad_OBC, G, dt) + call radiation_open_bdry_conds(CS%OBC, u, u_old_rad_OBC, v, v_old_rad_OBC, G, US, dt) endif ! h_av = (h_in + h_out)/2 . Going in to this line, h_av = h_in. diff --git a/src/core/MOM_open_boundary.F90 b/src/core/MOM_open_boundary.F90 index 5689d48231..4e64342c2d 100644 --- a/src/core/MOM_open_boundary.F90 +++ b/src/core/MOM_open_boundary.F90 @@ -145,15 +145,15 @@ module MOM_open_boundary real, pointer, dimension(:,:) :: Htot=>NULL() !< The total column thickness [m] at OBC-points. real, pointer, dimension(:,:,:) :: h=>NULL() !< The cell thickness [m] at OBC-points. real, pointer, dimension(:,:,:) :: normal_vel=>NULL() !< The layer velocity normal to the OB - !! segment [m s-1]. + !! segment [L T-1 ~> m s-1]. real, pointer, dimension(:,:,:) :: tangential_vel=>NULL() !< The layer velocity tangential to the - !! OB segment [m s-1]. + !! OB segment [L T-1 ~> m s-1]. real, pointer, dimension(:,:,:) :: tangential_grad=>NULL() !< The gradient of the velocity tangential !! to the OB segment [m s-1]. real, pointer, dimension(:,:,:) :: normal_trans=>NULL() !< The layer transport normal to the OB !! segment [m3 s-1]. real, pointer, dimension(:,:) :: normal_vel_bt=>NULL() !< The barotropic velocity normal to - !! the OB segment [m s-1]. + !! the OB segment [L T-1 ~> m s-1]. real, pointer, dimension(:,:) :: eta=>NULL() !< The sea-surface elevation along the segment [m]. real, pointer, dimension(:,:,:) :: grad_normal=>NULL() !< The gradient of the normal flow along the !! segment [s-1] @@ -168,9 +168,9 @@ module MOM_open_boundary real, pointer, dimension(:,:,:) :: cff_normal=>NULL() !< The denominator for oblique radiation !! for normal velocity real, pointer, dimension(:,:,:) :: nudged_normal_vel=>NULL() !< The layer velocity normal to the OB segment - !! that values should be nudged towards [m s-1]. + !! that values should be nudged towards [L T-1 ~> m s-1]. real, pointer, dimension(:,:,:) :: nudged_tangential_vel=>NULL() !< The layer velocity tangential to the OB segment - !! that values should be nudged towards [m s-1]. + !! that values should be nudged towards [L T-1 ~> m s-1]. real, pointer, dimension(:,:,:) :: nudged_tangential_grad=>NULL() !< The layer dvdx or dudy towards which nudging !! can occur [s-1]. type(segment_tracer_registry_type), pointer :: tr_Reg=> NULL()!< A pointer to the tracer registry for the segment. @@ -1520,7 +1520,7 @@ subroutine open_boundary_impose_land_mask(OBC, G, areaCu, areaCv, US) end subroutine open_boundary_impose_land_mask !> Apply radiation conditions to 3D u,v at open boundaries -subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) +subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, US, dt) type(ocean_grid_type), intent(inout) :: G !< Ocean grid structure type(ocean_OBC_type), pointer :: OBC !< Open boundary control structure real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: u_new !< On exit, new u values on open boundaries @@ -1531,6 +1531,7 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) !! On entry, the old time-level v but !! including barotropic accelerations. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: v_old !< Original unadjusted v + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, intent(in) :: dt !< Appropriate timestep ! Local variables real :: dhdt, dhdx, dhdy, gamma_u, gamma_v, gamma_2 @@ -1616,7 +1617,7 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) ! The new boundary value is interpolated between future interior ! value, u_new(I-1) and past boundary value but with barotropic ! accelerations, u_new(I). - segment%normal_vel(I,j,k) = (u_new(I,j,k) + rx_avg*u_new(I-1,j,k)) / (1.0+rx_avg) + segment%normal_vel(I,j,k) = US%m_s_to_L_T*(u_new(I,j,k) + rx_avg*u_new(I-1,j,k)) / (1.0+rx_avg) ! Copy restart fields into 3-d arrays. This is an inefficient and temporary issues ! implemented as a work-around to limitations in restart capability OBC%rx_normal(I,j,k) = segment%rx_normal(I,j,k) @@ -1640,7 +1641,7 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) segment%rx_normal(I,j,k) = rx_avg segment%ry_normal(i,J,k) = ry_avg segment%cff_normal(i,J,k) = cff_avg - segment%normal_vel(I,j,k) = ((cff_avg*u_new(I,j,k) + rx_avg*u_new(I-1,j,k)) - & + segment%normal_vel(I,j,k) = US%m_s_to_L_T*((cff_avg*u_new(I,j,k) + rx_avg*u_new(I-1,j,k)) - & (max(ry_avg,0.0)*segment%grad_normal(J-1,2,k) + min(ry_avg,0.0)*segment%grad_normal(J,2,k))) / & (cff_avg + rx_avg) ! Copy restart fields into 3-d arrays. This is an inefficient and temporary issues @@ -1649,7 +1650,7 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) OBC%ry_normal(i,J,k) = segment%ry_normal(i,J,k) OBC%cff_normal(I,j,k) = segment%cff_normal(I,j,k) elseif (segment%gradient) then - segment%normal_vel(I,j,k) = u_new(I-1,j,k) + segment%normal_vel(I,j,k) = US%m_s_to_L_T*u_new(I-1,j,k) endif if ((segment%radiation .or. segment%oblique) .and. segment%nudged) then ! dhdt gets set to 0 on inflow in oblique case @@ -1676,7 +1677,7 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) if (segment%radiation_tan) then do k=1,nz ; do J=segment%HI%JsdB,segment%HI%JedB rx_avg = rx_tangential(I,J,k) - segment%tangential_vel(I,J,k) = (v_new(I,J,k) + rx_avg*v_new(I-1,J,k)) / (1.0+rx_avg) + segment%tangential_vel(I,J,k) = US%m_s_to_L_T*(v_new(I,J,k) + rx_avg*v_new(I-1,J,k)) / (1.0+rx_avg) enddo ; enddo endif if (segment%nudged_tan) then @@ -1748,7 +1749,7 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) rx_avg = rx_tangential(I,J,k) ry_avg = ry_tangential(I,J,k) cff_avg = cff_tangential(I,J,k) - segment%tangential_vel(I,J,k) = ((cff_avg*v_new(i,J,k) + rx_avg*v_new(i-1,J,k)) - & + segment%tangential_vel(I,J,k) = US%m_s_to_L_T*((cff_avg*v_new(i,J,k) + rx_avg*v_new(i-1,J,k)) - & (max(ry_avg,0.0)*segment%grad_tan(j,2,k) + min(ry_avg,0.0)*segment%grad_tan(j+1,2,k))) / & (cff_avg + rx_avg) enddo ; enddo @@ -1812,7 +1813,7 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) ! The new boundary value is interpolated between future interior ! value, u_new(I+1) and past boundary value but with barotropic ! accelerations, u_new(I). - segment%normal_vel(I,j,k) = (u_new(I,j,k) + rx_avg*u_new(I+1,j,k)) / (1.0+rx_avg) + segment%normal_vel(I,j,k) = US%m_s_to_L_T*(u_new(I,j,k) + rx_avg*u_new(I+1,j,k)) / (1.0+rx_avg) ! Copy restart fields into 3-d arrays. This is an inefficient and temporary issues ! implemented as a work-around to limitations in restart capability OBC%rx_normal(I,j,k) = segment%rx_normal(I,j,k) @@ -1836,7 +1837,7 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) segment%rx_normal(I,j,k) = rx_avg segment%ry_normal(i,J,k) = ry_avg segment%cff_normal(i,J,k) = cff_avg - segment%normal_vel(I,j,k) = ((cff_avg*u_new(I,j,k) + rx_avg*u_new(I+1,j,k)) - & + segment%normal_vel(I,j,k) = US%m_s_to_L_T*((cff_avg*u_new(I,j,k) + rx_avg*u_new(I+1,j,k)) - & (max(ry_avg,0.0)*segment%grad_normal(J-1,2,k) + min(ry_avg,0.0)*segment%grad_normal(J,2,k))) / & (cff_avg + rx_avg) ! Copy restart fields into 3-d arrays. This is an inefficient and temporary issues @@ -1845,7 +1846,7 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) OBC%ry_normal(i,J,k) = segment%ry_normal(i,J,k) OBC%cff_normal(I,j,k) = segment%cff_normal(I,j,k) elseif (segment%gradient) then - segment%normal_vel(I,j,k) = u_new(I+1,j,k) + segment%normal_vel(I,j,k) = US%m_s_to_L_T*u_new(I+1,j,k) endif if ((segment%radiation .or. segment%oblique) .and. segment%nudged) then ! dhdt gets set to 0. on inflow in oblique case @@ -1872,7 +1873,7 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) if (segment%radiation_tan) then do k=1,nz ; do J=segment%HI%JsdB,segment%HI%JedB rx_avg = rx_tangential(I,J,k) - segment%tangential_vel(I,J,k) = (v_new(i+1,J,k) + rx_avg*v_new(i+2,J,k)) / (1.0+rx_avg) + segment%tangential_vel(I,J,k) = US%m_s_to_L_T*(v_new(i+1,J,k) + rx_avg*v_new(i+2,J,k)) / (1.0+rx_avg) enddo ; enddo endif if (segment%nudged_tan) then @@ -1944,7 +1945,7 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) rx_avg = rx_tangential(I,J,k) ry_avg = ry_tangential(I,J,k) cff_avg = cff_tangential(I,J,k) - segment%tangential_vel(I,J,k) = ((cff_avg*v_new(i+1,J,k) + rx_avg*v_new(i+2,J,k)) - & + segment%tangential_vel(I,J,k) = US%m_s_to_L_T*((cff_avg*v_new(i+1,J,k) + rx_avg*v_new(i+2,J,k)) - & (max(ry_avg,0.0)*segment%grad_tan(j,2,k) + min(ry_avg,0.0)*segment%grad_tan(j+1,2,k))) / & (cff_avg + rx_avg) enddo ; enddo @@ -2008,7 +2009,7 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) ! The new boundary value is interpolated between future interior ! value, v_new(J-1) and past boundary value but with barotropic ! accelerations, v_new(J). - segment%normal_vel(i,J,k) = (v_new(i,J,k) + ry_avg*v_new(i,J-1,k)) / (1.0+ry_avg) + segment%normal_vel(i,J,k) = US%m_s_to_L_T*(v_new(i,J,k) + ry_avg*v_new(i,J-1,k)) / (1.0+ry_avg) ! Copy restart fields into 3-d arrays. This is an inefficient and temporary issues ! implemented as a work-around to limitations in restart capability OBC%ry_normal(i,J,k) = segment%ry_normal(i,J,k) @@ -2033,7 +2034,7 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) segment%rx_normal(I,j,k) = rx_avg segment%ry_normal(i,J,k) = ry_avg segment%cff_normal(i,J,k) = cff_avg - segment%normal_vel(i,J,k) = ((cff_avg*v_new(i,J,k) + ry_avg*v_new(i,J-1,k)) - & + segment%normal_vel(i,J,k) = US%m_s_to_L_T*((cff_avg*v_new(i,J,k) + ry_avg*v_new(i,J-1,k)) - & (max(rx_avg,0.0)*segment%grad_normal(I-1,2,k) + min(rx_avg,0.0)*segment%grad_normal(I,2,k))) / & (cff_avg + ry_avg) ! Copy restart fields into 3-d arrays. This is an inefficient and temporary issues @@ -2042,7 +2043,7 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) OBC%ry_normal(i,J,k) = segment%ry_normal(i,J,k) OBC%cff_normal(i,J,k) = segment%cff_normal(i,J,k) elseif (segment%gradient) then - segment%normal_vel(i,J,k) = v_new(i,J-1,k) + segment%normal_vel(i,J,k) = US%m_s_to_L_T*v_new(i,J-1,k) endif if ((segment%radiation .or. segment%oblique) .and. segment%nudged) then ! dhdt gets set to 0 on inflow in oblique case @@ -2069,7 +2070,7 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) if (segment%radiation_tan) then do k=1,nz ; do I=segment%HI%IsdB,segment%HI%IedB rx_avg = rx_tangential(I,J,k) - segment%tangential_vel(I,J,k) = (u_new(I,j,k) + rx_avg*u_new(I,j-1,k)) / (1.0+rx_avg) + segment%tangential_vel(I,J,k) = US%m_s_to_L_T*(u_new(I,j,k) + rx_avg*u_new(I,j-1,k)) / (1.0+rx_avg) enddo ; enddo endif if (segment%nudged_tan) then @@ -2141,7 +2142,7 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) rx_avg = rx_tangential(I,J,k) ry_avg = ry_tangential(I,J,k) cff_avg = cff_tangential(I,J,k) - segment%tangential_vel(I,J,k) = ((cff_avg*u_new(I,j,k) + rx_avg*u_new(I,j-1,k)) - & + segment%tangential_vel(I,J,k) = US%m_s_to_L_T*((cff_avg*u_new(I,j,k) + rx_avg*u_new(I,j-1,k)) - & (max(ry_avg,0.0)*segment%grad_tan(i,2,k) + min(ry_avg,0.0)*segment%grad_tan(i+1,2,k))) / & (cff_avg + rx_avg) enddo ; enddo @@ -2205,7 +2206,7 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) ! The new boundary value is interpolated between future interior ! value, v_new(J+1) and past boundary value but with barotropic ! accelerations, v_new(J). - segment%normal_vel(i,J,k) = (v_new(i,J,k) + ry_avg*v_new(i,J+1,k)) / (1.0+ry_avg) + segment%normal_vel(i,J,k) = US%m_s_to_L_T*(v_new(i,J,k) + ry_avg*v_new(i,J+1,k)) / (1.0+ry_avg) ! Copy restart fields into 3-d arrays. This is an inefficient and temporary issues ! implemented as a work-around to limitations in restart capability OBC%ry_normal(i,J,k) = segment%ry_normal(i,J,k) @@ -2229,7 +2230,7 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) segment%rx_normal(I,j,k) = rx_avg segment%ry_normal(i,J,k) = ry_avg segment%cff_normal(i,J,k) = cff_avg - segment%normal_vel(i,J,k) = ((cff_avg*v_new(i,J,k) + ry_avg*v_new(i,J+1,k)) - & + segment%normal_vel(i,J,k) = US%m_s_to_L_T*((cff_avg*v_new(i,J,k) + ry_avg*v_new(i,J+1,k)) - & (max(rx_avg,0.0)*segment%grad_normal(I-1,2,k) + min(rx_avg,0.0)*segment%grad_normal(I,2,k))) / & (cff_avg + ry_avg) ! Copy restart fields into 3-d arrays. This is an inefficient and temporary issues @@ -2238,7 +2239,7 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) OBC%ry_normal(i,J,k) = segment%ry_normal(i,J,k) OBC%cff_normal(i,J,k) = segment%cff_normal(i,J,k) elseif (segment%gradient) then - segment%normal_vel(i,J,k) = v_new(i,J+1,k) + segment%normal_vel(i,J,k) = US%m_s_to_L_T*v_new(i,J+1,k) endif if ((segment%radiation .or. segment%oblique) .and. segment%nudged) then ! dhdt gets set to 0 on inflow in oblique case @@ -2265,7 +2266,7 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) if (segment%radiation_tan) then do k=1,nz ; do I=segment%HI%IsdB,segment%HI%IedB rx_avg = rx_tangential(I,J,k) - segment%tangential_vel(I,J,k) = (u_new(I,j+1,k) + rx_avg*u_new(I,j+2,k)) / (1.0+rx_avg) + segment%tangential_vel(I,J,k) = US%m_s_to_L_T*(u_new(I,j+1,k) + rx_avg*u_new(I,j+2,k)) / (1.0+rx_avg) enddo ; enddo endif if (segment%nudged_tan) then @@ -2337,7 +2338,7 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) rx_avg = rx_tangential(I,J,k) ry_avg = ry_tangential(I,J,k) cff_avg = cff_tangential(I,J,k) - segment%tangential_vel(I,J,k) = ((cff_avg*u_new(I,j+1,k) + rx_avg*u_new(I,j+2,k)) - & + segment%tangential_vel(I,J,k) = US%m_s_to_L_T*((cff_avg*u_new(I,j+1,k) + rx_avg*u_new(I,j+2,k)) - & (max(ry_avg,0.0)*segment%grad_tan(i,2,k) + min(ry_avg,0.0)*segment%grad_tan(i+1,2,k))) / & (cff_avg + rx_avg) enddo ; enddo @@ -2416,12 +2417,12 @@ subroutine open_boundary_apply_normal_flow(OBC, G, u, v) if (segment%is_E_or_W) then I=segment%HI%IsdB do k=1,G%ke ; do j=segment%HI%jsd,segment%HI%jed - u(I,j,k) = segment%normal_vel(I,j,k) + u(I,j,k) = G%US%L_T_to_m_s*segment%normal_vel(I,j,k) enddo ; enddo elseif (segment%is_N_or_S) then J=segment%HI%JsdB do k=1,G%ke ; do i=segment%HI%isd,segment%HI%ied - v(i,J,k) = segment%normal_vel(i,J,k) + v(i,J,k) = G%US%L_T_to_m_s*segment%normal_vel(i,J,k) enddo ; enddo endif endif @@ -2921,7 +2922,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] @@ -3283,12 +3284,12 @@ subroutine update_OBC_segment_data(G, GV, US, OBC, tv, h, Time) do j=js_obc+1,je_obc normal_trans_bt(I,j) = 0.0 do k=1,G%ke - segment%normal_vel(I,j,k) = segment%field(m)%buffer_dst(I,j,k) + segment%normal_vel(I,j,k) = US%m_s_to_L_T*segment%field(m)%buffer_dst(I,j,k) segment%normal_trans(I,j,k) = segment%field(m)%buffer_dst(I,j,k)*segment%h(I,j,k) * & US%L_to_m*G%dyCu(I,j) normal_trans_bt(I,j) = normal_trans_bt(I,j)+segment%normal_trans(I,j,k) enddo - segment%normal_vel_bt(I,j) = normal_trans_bt(I,j)/(max(segment%Htot(I,j),1.e-12) * & + segment%normal_vel_bt(I,j) = US%m_s_to_L_T*normal_trans_bt(I,j)/(max(segment%Htot(I,j),1.e-12) * & US%L_to_m*G%dyCu(I,j)) if (associated(segment%nudged_normal_vel)) segment%nudged_normal_vel(I,j,:) = segment%normal_vel(I,j,:) enddo @@ -3297,12 +3298,12 @@ subroutine update_OBC_segment_data(G, GV, US, OBC, tv, h, Time) do i=is_obc+1,ie_obc normal_trans_bt(i,J) = 0.0 do k=1,G%ke - segment%normal_vel(i,J,k) = segment%field(m)%buffer_dst(i,J,k) + segment%normal_vel(i,J,k) = US%m_s_to_L_T*segment%field(m)%buffer_dst(i,J,k) segment%normal_trans(i,J,k) = segment%field(m)%buffer_dst(i,J,k)*segment%h(i,J,k) * & US%L_to_m*G%dxCv(i,J) normal_trans_bt(i,J) = normal_trans_bt(i,J)+segment%normal_trans(i,J,k) enddo - segment%normal_vel_bt(i,J) = normal_trans_bt(i,J)/(max(segment%Htot(i,J),1.e-12) * & + segment%normal_vel_bt(i,J) = US%m_s_to_L_T*normal_trans_bt(i,J)/(max(segment%Htot(i,J),1.e-12) * & US%L_to_m*G%dxCv(i,J)) if (associated(segment%nudged_normal_vel)) segment%nudged_normal_vel(i,J,:) = segment%normal_vel(i,J,:) enddo @@ -3311,7 +3312,7 @@ subroutine update_OBC_segment_data(G, GV, US, OBC, tv, h, Time) I=is_obc do J=js_obc,je_obc do k=1,G%ke - segment%tangential_vel(I,J,k) = segment%field(m)%buffer_dst(I,J,k) + segment%tangential_vel(I,J,k) = US%m_s_to_L_T*segment%field(m)%buffer_dst(I,J,k) enddo if (associated(segment%nudged_tangential_vel)) & segment%nudged_tangential_vel(I,J,:) = segment%tangential_vel(I,J,:) @@ -3321,7 +3322,7 @@ subroutine update_OBC_segment_data(G, GV, US, OBC, tv, h, Time) J=js_obc do I=is_obc,ie_obc do k=1,G%ke - segment%tangential_vel(I,J,k) = segment%field(m)%buffer_dst(I,J,k) + segment%tangential_vel(I,J,k) = US%m_s_to_L_T*segment%field(m)%buffer_dst(I,J,k) enddo if (associated(segment%nudged_tangential_vel)) & segment%nudged_tangential_vel(I,J,:) = segment%tangential_vel(I,J,:) diff --git a/src/parameterizations/lateral/MOM_hor_visc.F90 b/src/parameterizations/lateral/MOM_hor_visc.F90 index 66aa64987a..4da86902b3 100644 --- a/src/parameterizations/lateral/MOM_hor_visc.F90 +++ b/src/parameterizations/lateral/MOM_hor_visc.F90 @@ -589,10 +589,10 @@ subroutine horizontal_viscosity(u_in, v_in, h, diffu, diffv, MEKE, VarMix, G, GV elseif (OBC%computed_strain) then if (OBC%segment(n)%direction == OBC_DIRECTION_N) then dudy(I,J) = 2.0*CS%DX_dyBu(I,J)* & - (US%m_s_to_L_T*OBC%segment(n)%tangential_vel(I,J,k) - u(I,j,k))*G%IdxCu(I,j) + (OBC%segment(n)%tangential_vel(I,J,k) - u(I,j,k))*G%IdxCu(I,j) else dudy(I,J) = 2.0*CS%DX_dyBu(I,J)* & - (u(I,j+1,k) - US%m_s_to_L_T*OBC%segment(n)%tangential_vel(I,J,k))*G%IdxCu(I,j+1) + (u(I,j+1,k) - OBC%segment(n)%tangential_vel(I,J,k))*G%IdxCu(I,j+1) endif elseif (OBC%specified_strain) then if (OBC%segment(n)%direction == OBC_DIRECTION_N) then @@ -611,10 +611,10 @@ subroutine horizontal_viscosity(u_in, v_in, h, diffu, diffv, MEKE, VarMix, G, GV elseif (OBC%computed_strain) then if (OBC%segment(n)%direction == OBC_DIRECTION_E) then dvdx(I,J) = 2.0*CS%DY_dxBu(I,J)* & - (US%m_s_to_L_T*OBC%segment(n)%tangential_vel(I,J,k) - v(i,J,k))*G%IdyCv(i,J) + (OBC%segment(n)%tangential_vel(I,J,k) - v(i,J,k))*G%IdyCv(i,J) else dvdx(I,J) = 2.0*CS%DY_dxBu(I,J)* & - (v(i+1,J,k) - US%m_s_to_L_T*OBC%segment(n)%tangential_vel(I,J,k))*G%IdyCv(i+1,J) + (v(i+1,J,k) - OBC%segment(n)%tangential_vel(I,J,k))*G%IdyCv(i+1,J) endif elseif (OBC%specified_strain) then if (OBC%segment(n)%direction == OBC_DIRECTION_E) then diff --git a/src/parameterizations/vertical/MOM_vert_friction.F90 b/src/parameterizations/vertical/MOM_vert_friction.F90 index 930fcbdc6b..b0b2a88688 100644 --- a/src/parameterizations/vertical/MOM_vert_friction.F90 +++ b/src/parameterizations/vertical/MOM_vert_friction.F90 @@ -427,12 +427,12 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, US, CS, & if (OBC%segment(n)%is_N_or_S) then J = OBC%segment(n)%HI%JsdB do k=1,nz ; do i=OBC%segment(n)%HI%isd,OBC%segment(n)%HI%ied - v(i,J,k) = OBC%segment(n)%normal_vel(i,J,k) + v(i,J,k) = US%L_T_to_m_s*OBC%segment(n)%normal_vel(i,J,k) enddo ; enddo elseif (OBC%segment(n)%is_E_or_W) then I = OBC%segment(n)%HI%IsdB do k=1,nz ; do j=OBC%segment(n)%HI%jsd,OBC%segment(n)%HI%jed - u(I,j,k) = OBC%segment(n)%normal_vel(I,j,k) + u(I,j,k) = US%L_T_to_m_s*OBC%segment(n)%normal_vel(I,j,k) enddo ; enddo endif endif diff --git a/src/user/DOME_initialization.F90 b/src/user/DOME_initialization.F90 index 73d2f7905b..bf643536fc 100644 --- a/src/user/DOME_initialization.F90 +++ b/src/user/DOME_initialization.F90 @@ -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 = -US%L_T_to_m_s*sqrt(D_edge*g_prime_tot)*log((2.0 + Ri_trans*(1.0 + 2.0*rc)) / & + v_k = -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/Kelvin_initialization.F90 b/src/user/Kelvin_initialization.F90 index 0b1eba8d0f..9956756559 100644 --- a/src/user/Kelvin_initialization.F90 +++ b/src/user/Kelvin_initialization.F90 @@ -256,7 +256,7 @@ subroutine Kelvin_set_OBC_data(OBC, CS, G, GV, US, h, Time) 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 / & + segment%normal_vel_bt(I,j) = (val2 * (val1 * cff * cosa / & (0.5 * (G%bathyT(i+1,j) + G%bathyT(i,j)))) ) else ! Not rotated yet @@ -264,16 +264,16 @@ subroutine Kelvin_set_OBC_data(OBC, CS, G, GV, US, h, Time) segment%normal_vel_bt(I,j) = 0.0 if (segment%nudged) then do k=1,nz - segment%nudged_normal_vel(I,j,k) = fac * lambda / CS%F_0 * & + segment%nudged_normal_vel(I,j,k) = US%m_s_to_L_T * fac * lambda / CS%F_0 * & exp(- lambda * y) * cos(PI * CS%mode * (k - 0.5) / nz) * & cos(omega * time_sec) enddo elseif (segment%specified) then do k=1,nz - segment%normal_vel(I,j,k) = fac * lambda / CS%F_0 * & + segment%normal_vel(I,j,k) = US%m_s_to_L_T * fac * lambda / CS%F_0 * & exp(- lambda * y) * cos(PI * CS%mode * (k - 0.5) / nz) * & cos(omega * time_sec) - segment%normal_trans(I,j,k) = segment%normal_vel(I,j,k) * & + segment%normal_trans(I,j,k) = US%L_T_to_m_s*segment%normal_vel(I,j,k) * & h(i+1,j,k) * G%US%L_to_m*G%dyCu(I,j) enddo endif @@ -288,14 +288,14 @@ subroutine Kelvin_set_OBC_data(OBC, CS, G, GV, US, h, Time) 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 / & + segment%tangential_vel(I,J,k) = (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%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) / & + segment%tangential_vel(I,J,k) = (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 @@ -322,14 +322,14 @@ subroutine Kelvin_set_OBC_data(OBC, CS, G, GV, US, h, Time) segment%normal_vel_bt(i,J) = 0.0 if (segment%nudged) then do k=1,nz - segment%nudged_normal_vel(i,J,k) = fac * lambda / CS%F_0 * & + segment%nudged_normal_vel(i,J,k) = US%m_s_to_L_T*fac * lambda / CS%F_0 * & exp(- lambda * y) * cos(PI * CS%mode * (k - 0.5) / nz) * cosa enddo elseif (segment%specified) then do k=1,nz - segment%normal_vel(i,J,k) = fac * lambda / CS%F_0 * & + segment%normal_vel(i,J,k) = US%m_s_to_L_T*fac * lambda / CS%F_0 * & exp(- lambda * y) * cos(PI * CS%mode * (k - 0.5) / nz) * cosa - segment%normal_trans(i,J,k) = segment%normal_vel(i,J,k) * & + segment%normal_trans(i,J,k) = US%L_T_to_m_s*segment%normal_vel(i,J,k) * & h(i,j+1,k) * G%US%L_to_m*G%dxCv(i,J) enddo endif @@ -344,14 +344,14 @@ subroutine Kelvin_set_OBC_data(OBC, CS, G, GV, US, h, Time) 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 / & + segment%tangential_vel(I,J,k) = (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%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) / & + segment%tangential_vel(I,J,k) = ((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 diff --git a/src/user/dyed_channel_initialization.F90 b/src/user/dyed_channel_initialization.F90 index 72dfc309e5..5e784ad57e 100644 --- a/src/user/dyed_channel_initialization.F90 +++ b/src/user/dyed_channel_initialization.F90 @@ -169,7 +169,7 @@ subroutine dyed_channel_update_flow(OBC, CS, G, Time) do k=1,G%ke do j=jsd,jed ; do I=IsdB,IedB if (segment%specified .or. segment%nudged) then - segment%normal_vel(I,j,k) = flow + segment%normal_vel(I,j,k) = G%US%m_s_to_L_T*flow endif if (segment%specified) then segment%normal_trans(I,j,k) = flow * G%US%L_to_m*G%dyCu(I,j) @@ -177,7 +177,7 @@ subroutine dyed_channel_update_flow(OBC, CS, G, Time) enddo ; enddo enddo do j=jsd,jed ; do I=IsdB,IedB - segment%normal_vel_bt(I,j) = flow + segment%normal_vel_bt(I,j) = G%US%m_s_to_L_T*flow enddo ; enddo else isd = segment%HI%isd ; ied = segment%HI%ied diff --git a/src/user/shelfwave_initialization.F90 b/src/user/shelfwave_initialization.F90 index cd80514bea..928c8ae223 100644 --- a/src/user/shelfwave_initialization.F90 +++ b/src/user/shelfwave_initialization.F90 @@ -170,9 +170,9 @@ subroutine shelfwave_set_OBC_data(OBC, CS, G, h, Time) cos_wt = cos(ll*x - omega*time_sec) sin_ky = sin(kk * y) cos_ky = cos(kk * y) - segment%normal_vel_bt(I,j) = my_amp * exp(- alpha * y) * cos_wt * & + segment%normal_vel_bt(I,j) = G%US%m_s_to_L_T*my_amp * exp(- alpha * y) * cos_wt * & (alpha * sin_ky + kk * cos_ky) -! segment%tangential_vel_bt(I,j) = my_amp * ll * exp(- alpha * y) * sin_wt * sin_ky +! segment%tangential_vel_bt(I,j) = G%US%m_s_to_L_T*my_amp * ll * exp(- alpha * y) * sin_wt * sin_ky ! segment%vorticity_bt(I,j) = my_amp * exp(- alpha * y) * cos_wt * sin_ky& ! (ll*ll + kk*kk + alpha*alpha) enddo ; enddo diff --git a/src/user/supercritical_initialization.F90 b/src/user/supercritical_initialization.F90 index 0f204b6c6e..6d69fbb2b6 100644 --- a/src/user/supercritical_initialization.F90 +++ b/src/user/supercritical_initialization.F90 @@ -55,7 +55,7 @@ subroutine supercritical_set_OBC_data(OBC, G, param_file) do k=1,G%ke do j=jsd,jed ; do I=IsdB,IedB if (segment%specified .or. segment%nudged) then - segment%normal_vel(I,j,k) = zonal_flow + segment%normal_vel(I,j,k) = G%US%m_s_to_L_T*zonal_flow endif if (segment%specified) then segment%normal_trans(I,j,k) = zonal_flow * G%US%L_to_m*G%dyCu(I,j) @@ -63,7 +63,7 @@ subroutine supercritical_set_OBC_data(OBC, G, param_file) enddo ; enddo enddo do j=jsd,jed ; do I=IsdB,IedB - segment%normal_vel_bt(I,j) = zonal_flow + segment%normal_vel_bt(I,j) = G%US%m_s_to_L_T*zonal_flow enddo ; enddo else isd = segment%HI%isd ; ied = segment%HI%ied diff --git a/src/user/tidal_bay_initialization.F90 b/src/user/tidal_bay_initialization.F90 index d84da56f4b..67999fff40 100644 --- a/src/user/tidal_bay_initialization.F90 +++ b/src/user/tidal_bay_initialization.F90 @@ -110,7 +110,7 @@ subroutine tidal_bay_set_OBC_data(OBC, CS, G, h, Time) if (.not. segment%on_pe) cycle - segment%normal_vel_bt(:,:) = my_flux/total_area + segment%normal_vel_bt(:,:) = G%US%m_s_to_L_T*my_flux/total_area segment%eta(:,:) = cff enddo ! end segment loop From 6f5f24f2a2e429aaca00c77ed51f84aa2dff4f59 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sat, 10 Aug 2019 11:57:29 -0400 Subject: [PATCH 182/297] Rescaled OBC%segment%normal_trans to units of [H L2 T-1] Rescaled the units of the normal_trans element of the OBC_segment type to [T-1 L-1] for more complete dimensional consistency testing. Also simplified some expressions in dyed_channel_update_flow, supercritical_set_OBC_data and DOME_set_OBC_data. All answers are bitwise identical, but the units of an element in a transparent type has been rescaled. --- src/core/MOM_barotropic.F90 | 4 ++-- src/core/MOM_continuity_PPM.F90 | 18 ++++++++--------- src/core/MOM_open_boundary.F90 | 24 +++++++++++------------ src/user/DOME_initialization.F90 | 4 ++-- src/user/Kelvin_initialization.F90 | 6 ++---- src/user/dyed_channel_initialization.F90 | 10 +++++----- src/user/supercritical_initialization.F90 | 10 +++++----- 7 files changed, 35 insertions(+), 41 deletions(-) diff --git a/src/core/MOM_barotropic.F90 b/src/core/MOM_barotropic.F90 index 0e2e022e48..b83e0c34da 100644 --- a/src/core/MOM_barotropic.F90 +++ b/src/core/MOM_barotropic.F90 @@ -2622,7 +2622,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) + US%T_to_s*US%m_to_L**2*segment%normal_trans(I,j,k) + BT_OBC%uhbt(I,j) = BT_OBC%uhbt(I,j) + segment%normal_trans(I,j,k) enddo ; enddo ; enddo endif enddo @@ -2674,7 +2674,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) + US%T_to_s*US%m_to_L**2*segment%normal_trans(i,J,k) + BT_OBC%vhbt(i,J) = BT_OBC%vhbt(i,J) + segment%normal_trans(i,J,k) enddo ; enddo ; enddo endif enddo diff --git a/src/core/MOM_continuity_PPM.F90 b/src/core/MOM_continuity_PPM.F90 index 63e7366a55..3a6021e6b5 100644 --- a/src/core/MOM_continuity_PPM.F90 +++ b/src/core/MOM_continuity_PPM.F90 @@ -319,7 +319,7 @@ subroutine zonal_mass_flux(u, h_in, uh, dt_in_T, G, GV, US, CS, LB, uhbt, OBC, & if (local_specified_BC) then do I=ish-1,ieh if (OBC%segment(OBC%segnum_u(I,j))%specified) & - uh(I,j,k) = US%m_to_L**2*US%T_to_s*OBC%segment(OBC%segnum_u(I,j))%normal_trans(I,j,k) + uh(I,j,k) = OBC%segment(OBC%segnum_u(I,j))%normal_trans(I,j,k) enddo endif enddo @@ -391,8 +391,8 @@ subroutine zonal_mass_flux(u, h_in, uh, dt_in_T, G, GV, US, CS, LB, uhbt, OBC, & else do k=1,nz ; do I=ish-1,ieh if (CS%vol_CFL) then - dx_W = ratio_max(G%areaT(i,j), US%L_to_m*G%dy_Cu(I,j), 1000.0*US%L_to_m*G%dxT(i,j)) - dx_E = ratio_max(G%areaT(i+1,j), US%L_to_m*G%dy_Cu(I,j), 1000.0*US%L_to_m*G%dxT(i+1,j)) + dx_W = ratio_max(G%areaT(i,j), G%dy_Cu(I,j), 1000.0*G%dxT(i,j)) + dx_E = ratio_max(G%areaT(i+1,j), G%dy_Cu(I,j), 1000.0*G%dxT(i+1,j)) else ; dx_W = G%dxT(i,j) ; dx_E = G%dxT(i+1,j) ; endif du_max_CFL(I) = MIN(du_max_CFL(I), dx_W*CFL_dt - u(I,j,k)) @@ -444,9 +444,8 @@ subroutine zonal_mass_flux(u, h_in, uh, dt_in_T, G, GV, US, CS, LB, uhbt, OBC, & do k=1,nz ; do I=ish-1,ieh ; if (do_I(I)) then if ((abs(OBC%segment(OBC%segnum_u(I,j))%normal_vel(I,j,k)) > 0.0) .and. & (OBC%segment(OBC%segnum_u(I,j))%specified)) & - FAuI(I) = FAuI(I) + US%m_to_L**2*US%T_to_s * & - OBC%segment(OBC%segnum_u(I,j))%normal_trans(I,j,k) / & - OBC%segment(OBC%segnum_u(I,j))%normal_vel(I,j,k) + FAuI(I) = FAuI(I) + OBC%segment(OBC%segnum_u(I,j))%normal_trans(I,j,k) / & + 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) @@ -1120,7 +1119,7 @@ subroutine meridional_mass_flux(v, h_in, vh, dt_in_T, G, GV, US, CS, LB, vhbt, O if (local_specified_BC) then do i=ish,ieh if (OBC%segment(OBC%segnum_v(i,J))%specified) & - vh(i,J,k) = US%m_to_L**2*US%T_to_s*OBC%segment(OBC%segnum_v(i,J))%normal_trans(i,J,k) + vh(i,J,k) = OBC%segment(OBC%segnum_v(i,J))%normal_trans(i,J,k) enddo endif enddo ! k-loop @@ -1240,9 +1239,8 @@ subroutine meridional_mass_flux(v, h_in, vh, dt_in_T, G, GV, US, CS, LB, vhbt, O do k=1,nz ; do i=ish,ieh ; if (do_I(i)) then if ((abs(OBC%segment(OBC%segnum_v(i,J))%normal_vel(i,J,k)) > 0.0) .and. & (OBC%segment(OBC%segnum_v(i,J))%specified)) & - FAvi(i) = FAvi(i) + US%m_to_L**2*US%T_to_s * & - OBC%segment(OBC%segnum_v(i,J))%normal_trans(i,J,k) / & - OBC%segment(OBC%segnum_v(i,J))%normal_vel(i,J,k) + FAvi(i) = FAvi(i) + OBC%segment(OBC%segnum_v(i,J))%normal_trans(i,J,k) / & + 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) diff --git a/src/core/MOM_open_boundary.F90 b/src/core/MOM_open_boundary.F90 index 4e64342c2d..622cf75de0 100644 --- a/src/core/MOM_open_boundary.F90 +++ b/src/core/MOM_open_boundary.F90 @@ -142,8 +142,8 @@ module MOM_open_boundary logical :: salt_segment_data_exists !< true if salinity data arrays are present real, pointer, dimension(:,:) :: Cg=>NULL() !< The external gravity wave speed [m s-1] !! at OBC-points. - real, pointer, dimension(:,:) :: Htot=>NULL() !< The total column thickness [m] at OBC-points. - real, pointer, dimension(:,:,:) :: h=>NULL() !< The cell thickness [m] at OBC-points. + real, pointer, dimension(:,:) :: Htot=>NULL() !< The total column thickness [H ~> m or kg m-2] at OBC-points. + real, pointer, dimension(:,:,:) :: h=>NULL() !< The cell thickness [H ~> m or kg m-2] at OBC-points. real, pointer, dimension(:,:,:) :: normal_vel=>NULL() !< The layer velocity normal to the OB !! segment [L T-1 ~> m s-1]. real, pointer, dimension(:,:,:) :: tangential_vel=>NULL() !< The layer velocity tangential to the @@ -151,7 +151,7 @@ module MOM_open_boundary real, pointer, dimension(:,:,:) :: tangential_grad=>NULL() !< The gradient of the velocity tangential !! to the OB segment [m s-1]. real, pointer, dimension(:,:,:) :: normal_trans=>NULL() !< The layer transport normal to the OB - !! segment [m3 s-1]. + !! segment [H L2 T-1 ~> m3 s-1]. real, pointer, dimension(:,:) :: normal_vel_bt=>NULL() !< The barotropic velocity normal to !! the OB segment [L T-1 ~> m s-1]. real, pointer, dimension(:,:) :: eta=>NULL() !< The sea-surface elevation along the segment [m]. @@ -3285,12 +3285,11 @@ subroutine update_OBC_segment_data(G, GV, US, OBC, tv, h, Time) normal_trans_bt(I,j) = 0.0 do k=1,G%ke segment%normal_vel(I,j,k) = US%m_s_to_L_T*segment%field(m)%buffer_dst(I,j,k) - segment%normal_trans(I,j,k) = segment%field(m)%buffer_dst(I,j,k)*segment%h(I,j,k) * & - US%L_to_m*G%dyCu(I,j) - normal_trans_bt(I,j) = normal_trans_bt(I,j)+segment%normal_trans(I,j,k) + segment%normal_trans(I,j,k) = US%m_s_to_L_T*segment%field(m)%buffer_dst(I,j,k)*segment%h(I,j,k) * & + G%dyCu(I,j) + normal_trans_bt(I,j) = normal_trans_bt(I,j) + segment%normal_trans(I,j,k) enddo - segment%normal_vel_bt(I,j) = US%m_s_to_L_T*normal_trans_bt(I,j)/(max(segment%Htot(I,j),1.e-12) * & - US%L_to_m*G%dyCu(I,j)) + segment%normal_vel_bt(I,j) = normal_trans_bt(I,j) / (max(segment%Htot(I,j),1.e-12) * G%dyCu(I,j)) if (associated(segment%nudged_normal_vel)) segment%nudged_normal_vel(I,j,:) = segment%normal_vel(I,j,:) enddo elseif (trim(segment%field(m)%name) == 'V' .and. segment%is_N_or_S) then @@ -3299,12 +3298,11 @@ subroutine update_OBC_segment_data(G, GV, US, OBC, tv, h, Time) normal_trans_bt(i,J) = 0.0 do k=1,G%ke segment%normal_vel(i,J,k) = US%m_s_to_L_T*segment%field(m)%buffer_dst(i,J,k) - segment%normal_trans(i,J,k) = segment%field(m)%buffer_dst(i,J,k)*segment%h(i,J,k) * & - US%L_to_m*G%dxCv(i,J) - normal_trans_bt(i,J) = normal_trans_bt(i,J)+segment%normal_trans(i,J,k) + segment%normal_trans(i,J,k) = US%m_s_to_L_T*segment%field(m)%buffer_dst(i,J,k)*segment%h(i,J,k) * & + G%dxCv(i,J) + normal_trans_bt(i,J) = normal_trans_bt(i,J) + segment%normal_trans(i,J,k) enddo - segment%normal_vel_bt(i,J) = US%m_s_to_L_T*normal_trans_bt(i,J)/(max(segment%Htot(i,J),1.e-12) * & - US%L_to_m*G%dxCv(i,J)) + segment%normal_vel_bt(i,J) = normal_trans_bt(i,J) / (max(segment%Htot(i,J),1.e-12) * G%dxCv(i,J)) if (associated(segment%nudged_normal_vel)) segment%nudged_normal_vel(i,J,:) = segment%normal_vel(i,J,:) enddo elseif (trim(segment%field(m)%name) == 'V' .and. segment%is_E_or_W .and. & diff --git a/src/user/DOME_initialization.F90 b/src/user/DOME_initialization.F90 index bf643536fc..7a2a6bfd90 100644 --- a/src/user/DOME_initialization.F90 +++ b/src/user/DOME_initialization.F90 @@ -269,7 +269,7 @@ subroutine DOME_set_OBC_data(OBC, tv, G, GV, US, param_file, tr_Reg) ! inner edge of the inflow. 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. + ! thickness D_edge, in the same units as lat [m]. real :: Ri_trans ! The shear Richardson number in the transition ! region of the specified shear profile. character(len=40) :: mdl = "DOME_set_OBC_data" ! This subroutine's name. @@ -292,7 +292,7 @@ subroutine DOME_set_OBC_data(OBC, tv, G, GV, US, param_file, tr_Reg) 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 + tr_0 = (-D_edge*sqrt(D_edge*g_prime_tot)*0.5e3*US%m_to_L*Def_Rad) * GV%Z_to_H if (OBC%number_of_segments /= 1) then call MOM_error(WARNING, 'Error in DOME OBC segment setup', .true.) diff --git a/src/user/Kelvin_initialization.F90 b/src/user/Kelvin_initialization.F90 index 9956756559..c211341493 100644 --- a/src/user/Kelvin_initialization.F90 +++ b/src/user/Kelvin_initialization.F90 @@ -273,8 +273,7 @@ subroutine Kelvin_set_OBC_data(OBC, CS, G, GV, US, h, Time) segment%normal_vel(I,j,k) = US%m_s_to_L_T * fac * lambda / CS%F_0 * & exp(- lambda * y) * cos(PI * CS%mode * (k - 0.5) / nz) * & cos(omega * time_sec) - segment%normal_trans(I,j,k) = US%L_T_to_m_s*segment%normal_vel(I,j,k) * & - h(i+1,j,k) * G%US%L_to_m*G%dyCu(I,j) + segment%normal_trans(I,j,k) = segment%normal_vel(I,j,k) * h(i+1,j,k) * G%dyCu(I,j) enddo endif endif @@ -329,8 +328,7 @@ subroutine Kelvin_set_OBC_data(OBC, CS, G, GV, US, h, Time) do k=1,nz segment%normal_vel(i,J,k) = US%m_s_to_L_T*fac * lambda / CS%F_0 * & exp(- lambda * y) * cos(PI * CS%mode * (k - 0.5) / nz) * cosa - segment%normal_trans(i,J,k) = US%L_T_to_m_s*segment%normal_vel(i,J,k) * & - h(i,j+1,k) * G%US%L_to_m*G%dxCv(i,J) + segment%normal_trans(i,J,k) = segment%normal_vel(i,J,k) * h(i,j+1,k) * G%dxCv(i,J) enddo endif endif diff --git a/src/user/dyed_channel_initialization.F90 b/src/user/dyed_channel_initialization.F90 index 5e784ad57e..da4751b3fa 100644 --- a/src/user/dyed_channel_initialization.F90 +++ b/src/user/dyed_channel_initialization.F90 @@ -162,22 +162,22 @@ subroutine dyed_channel_update_flow(OBC, CS, G, Time) jsd = segment%HI%jsd ; jed = segment%HI%jed IsdB = segment%HI%IsdB ; IedB = segment%HI%IedB if (CS%frequency == 0.0) then - flow = CS%zonal_flow + flow = G%US%m_s_to_L_T*CS%zonal_flow else - flow = CS%zonal_flow + CS%tidal_amp * cos(2 * PI * CS%frequency * time_sec) + flow = G%US%m_s_to_L_T*CS%zonal_flow + CS%tidal_amp * cos(2 * PI * CS%frequency * time_sec) endif do k=1,G%ke do j=jsd,jed ; do I=IsdB,IedB if (segment%specified .or. segment%nudged) then - segment%normal_vel(I,j,k) = G%US%m_s_to_L_T*flow + segment%normal_vel(I,j,k) = flow endif if (segment%specified) then - segment%normal_trans(I,j,k) = flow * G%US%L_to_m*G%dyCu(I,j) + segment%normal_trans(I,j,k) = flow * G%dyCu(I,j) endif enddo ; enddo enddo do j=jsd,jed ; do I=IsdB,IedB - segment%normal_vel_bt(I,j) = G%US%m_s_to_L_T*flow + segment%normal_vel_bt(I,j) = flow enddo ; enddo else isd = segment%HI%isd ; ied = segment%HI%ied diff --git a/src/user/supercritical_initialization.F90 b/src/user/supercritical_initialization.F90 index 6d69fbb2b6..19aacab72d 100644 --- a/src/user/supercritical_initialization.F90 +++ b/src/user/supercritical_initialization.F90 @@ -31,7 +31,7 @@ subroutine supercritical_set_OBC_data(OBC, G, param_file) type(param_file_type), intent(in) :: param_file !< Parameter file structure ! Local variables character(len=40) :: mdl = "supercritical_set_OBC_data" ! This subroutine's name. - real :: zonal_flow + real :: zonal_flow ! Inflow speed [L T-1 ~> m s-1] integer :: i, j, k, l integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB type(OBC_segment_type), pointer :: segment => NULL() ! pointer to segment type list @@ -41,7 +41,7 @@ subroutine supercritical_set_OBC_data(OBC, G, param_file) call get_param(param_file, mdl, "SUPERCRITICAL_ZONAL_FLOW", zonal_flow, & "Constant zonal flow imposed at upstream open boundary.", & - units="m/s", default=8.57) + units="m/s", default=8.57, scale=G%US%m_s_to_L_T) do l=1, OBC%number_of_segments segment => OBC%segment(l) @@ -55,15 +55,15 @@ subroutine supercritical_set_OBC_data(OBC, G, param_file) do k=1,G%ke do j=jsd,jed ; do I=IsdB,IedB if (segment%specified .or. segment%nudged) then - segment%normal_vel(I,j,k) = G%US%m_s_to_L_T*zonal_flow + segment%normal_vel(I,j,k) = zonal_flow endif if (segment%specified) then - segment%normal_trans(I,j,k) = zonal_flow * G%US%L_to_m*G%dyCu(I,j) + segment%normal_trans(I,j,k) = zonal_flow * G%dyCu(I,j) endif enddo ; enddo enddo do j=jsd,jed ; do I=IsdB,IedB - segment%normal_vel_bt(I,j) = G%US%m_s_to_L_T*zonal_flow + segment%normal_vel_bt(I,j) = zonal_flow enddo ; enddo else isd = segment%HI%isd ; ied = segment%HI%ied From b84e8cadcd0e9758f444ce2a0a1a7cd0673ecb21 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sat, 10 Aug 2019 16:21:23 -0400 Subject: [PATCH 183/297] +Rescaled OBC%segment%tangential_grad to [T-1] Rescaled the units of the tangential_grad element of the OBC_segment type to [T-1] for more complete dimensional consistency testing. All answers are bitwise identical, but the units of an element in a transparent type has been rescaled. --- src/core/MOM_CoriolisAdv.F90 | 8 +-- src/core/MOM_open_boundary.F90 | 56 +++++++++++-------- .../lateral/MOM_hor_visc.F90 | 8 +-- 3 files changed, 40 insertions(+), 32 deletions(-) diff --git a/src/core/MOM_CoriolisAdv.F90 b/src/core/MOM_CoriolisAdv.F90 index e734b1a00d..e57850e82c 100644 --- a/src/core/MOM_CoriolisAdv.F90 +++ b/src/core/MOM_CoriolisAdv.F90 @@ -316,9 +316,9 @@ subroutine CorAdCalc(u_in, v_in, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS) enddo ; endif if (OBC%specified_vorticity) then ; do I=OBC%segment(n)%HI%IsdB,OBC%segment(n)%HI%IedB if (OBC%segment(n)%direction == OBC_DIRECTION_N) then - dudy(I,J) = US%T_to_s*OBC%segment(n)%tangential_grad(I,J,k)*G%dxCu(I,j)*G%dyBu(I,J) + dudy(I,J) = OBC%segment(n)%tangential_grad(I,J,k)*G%dxCu(I,j)*G%dyBu(I,J) else ! (OBC%segment(n)%direction == OBC_DIRECTION_S) - dudy(I,J) = US%T_to_s*OBC%segment(n)%tangential_grad(I,J,k)*G%dxCu(I,j+1)*G%dyBu(I,J) + dudy(I,J) = OBC%segment(n)%tangential_grad(I,J,k)*G%dxCu(I,j+1)*G%dyBu(I,J) endif enddo ; endif @@ -356,9 +356,9 @@ subroutine CorAdCalc(u_in, v_in, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS) enddo ; endif if (OBC%specified_vorticity) then ; do J=OBC%segment(n)%HI%JsdB,OBC%segment(n)%HI%JedB if (OBC%segment(n)%direction == OBC_DIRECTION_E) then - dvdx(I,J) = US%T_to_s*OBC%segment(n)%tangential_grad(I,J,k)*G%dyCv(i,J)*G%dxBu(I,J) + dvdx(I,J) = OBC%segment(n)%tangential_grad(I,J,k)*G%dyCv(i,J)*G%dxBu(I,J) else ! (OBC%segment(n)%direction == OBC_DIRECTION_W) - dvdx(I,J) = US%T_to_s*OBC%segment(n)%tangential_grad(I,J,k)*G%dyCv(i+1,J)*G%dxBu(I,J) + dvdx(I,J) = OBC%segment(n)%tangential_grad(I,J,k)*G%dyCv(i+1,J)*G%dxBu(I,J) endif enddo ; endif diff --git a/src/core/MOM_open_boundary.F90 b/src/core/MOM_open_boundary.F90 index 622cf75de0..b7b21d312d 100644 --- a/src/core/MOM_open_boundary.F90 +++ b/src/core/MOM_open_boundary.F90 @@ -149,7 +149,7 @@ module MOM_open_boundary real, pointer, dimension(:,:,:) :: tangential_vel=>NULL() !< The layer velocity tangential to the !! OB segment [L T-1 ~> m s-1]. real, pointer, dimension(:,:,:) :: tangential_grad=>NULL() !< The gradient of the velocity tangential - !! to the OB segment [m s-1]. + !! to the OB segment [T-1 ~> s-1]. real, pointer, dimension(:,:,:) :: normal_trans=>NULL() !< The layer transport normal to the OB !! segment [H L2 T-1 ~> m3 s-1]. real, pointer, dimension(:,:) :: normal_vel_bt=>NULL() !< The barotropic velocity normal to @@ -172,7 +172,7 @@ module MOM_open_boundary real, pointer, dimension(:,:,:) :: nudged_tangential_vel=>NULL() !< The layer velocity tangential to the OB segment !! that values should be nudged towards [L T-1 ~> m s-1]. real, pointer, dimension(:,:,:) :: nudged_tangential_grad=>NULL() !< The layer dvdx or dudy towards which nudging - !! can occur [s-1]. + !! can occur [T-1 ~> s-1]. type(segment_tracer_registry_type), pointer :: tr_Reg=> NULL()!< A pointer to the tracer registry for the segment. type(hor_index_type) :: HI !< Horizontal index ranges real :: Tr_InvLscale3_out !< An effective inverse length scale cubed [m-3] @@ -1707,8 +1707,8 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, US, dt) ! else ! rx_avg = 0.0 ! endif - segment%tangential_grad(I,J,k) = ((v_new(i,J,k) - v_new(i-1,J,k))*G%US%m_to_L*G%IdxBu(I-1,J) + & - rx_avg*(v_new(i-1,J,k) - v_new(i-2,J,k))*G%US%m_to_L*G%IdxBu(I-2,J)) / (1.0+rx_avg) + segment%tangential_grad(I,J,k) = US%m_s_to_L_T*((v_new(i,J,k) - v_new(i-1,J,k))*G%IdxBu(I-1,J) + & + rx_avg*(v_new(i-1,J,k) - v_new(i-2,J,k))*G%IdxBu(I-2,J)) / (1.0+rx_avg) enddo ; enddo endif if (segment%nudged_grad) then @@ -1774,9 +1774,11 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, US, dt) rx_avg = rx_tangential(I,J,k) ry_avg = ry_tangential(I,J,k) cff_avg = cff_tangential(I,J,k) - segment%tangential_grad(I,J,k) = ((cff_avg*(v_new(i,J,k) - v_new(i-1,J,k))*G%US%m_to_L*G%IdxBu(I-1,J) & - + rx_avg*(v_new(i-1,J,k) - v_new(i-2,J,k))*G%US%m_to_L*G%IdxBu(I-2,J)) - & - (max(ry_avg,0.0)*segment%grad_gradient(J,2,k) + min(ry_avg,0.0)*segment%grad_gradient(J+1,2,k))) / & + segment%tangential_grad(I,J,k) = & + ((cff_avg*(v_new(i,J,k) - v_new(i-1,J,k))*US%m_s_to_L_T*G%IdxBu(I-1,J) & + + rx_avg*(v_new(i-1,J,k) - v_new(i-2,J,k))*US%m_s_to_L_T*G%IdxBu(I-2,J)) - & + US%T_to_s*(max(ry_avg,0.0)*segment%grad_gradient(J,2,k) + & + min(ry_avg,0.0)*segment%grad_gradient(J+1,2,k))) / & (cff_avg + rx_avg) enddo ; enddo endif @@ -1903,8 +1905,8 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, US, dt) ! else ! rx_avg = 0.0 ! endif - segment%tangential_grad(I,J,k) = ((v_new(i+2,J,k) - v_new(i+1,J,k))*G%US%m_to_L*G%IdxBu(I+1,J) + & - rx_avg*(v_new(i+3,J,k) - v_new(i+2,J,k))*G%US%m_to_L*G%IdxBu(I+2,J)) / (1.0+rx_avg) + segment%tangential_grad(I,J,k) = US%m_s_to_L_T*((v_new(i+2,J,k) - v_new(i+1,J,k))*G%IdxBu(I+1,J) + & + rx_avg*(v_new(i+3,J,k) - v_new(i+2,J,k))*G%IdxBu(I+2,J)) / (1.0+rx_avg) enddo ; enddo endif if (segment%nudged_grad) then @@ -1970,9 +1972,11 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, US, dt) rx_avg = rx_tangential(I,J,k) ry_avg = ry_tangential(I,J,k) cff_avg = cff_tangential(I,J,k) - segment%tangential_grad(I,J,k) = ((cff_avg*(v_new(i+2,J,k) - v_new(i+1,J,k))*G%US%m_to_L*G%IdxBu(I+1,J) & - + rx_avg*(v_new(i+3,J,k) - v_new(i+2,J,k))*G%US%m_to_L*G%IdxBu(I+2,J)) - & - (max(ry_avg,0.0)*segment%grad_gradient(J,2,k) + min(ry_avg,0.0)*segment%grad_gradient(J+1,2,k))) / & + segment%tangential_grad(I,J,k) = & + ((cff_avg*(v_new(i+2,J,k) - v_new(i+1,J,k))*US%m_s_to_L_T*G%IdxBu(I+1,J) & + + rx_avg*(v_new(i+3,J,k) - v_new(i+2,J,k))*US%m_s_to_L_T*G%IdxBu(I+2,J)) - & + US%T_to_s*(max(ry_avg,0.0)*segment%grad_gradient(J,2,k) + & + min(ry_avg,0.0)*segment%grad_gradient(J+1,2,k))) / & (cff_avg + rx_avg) enddo ; enddo endif @@ -2100,8 +2104,8 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, US, dt) ! else ! rx_avg = 0.0 ! endif - segment%tangential_grad(I,J,k) = ((u_new(I,j,k) - u_new(I,j-1,k))*G%US%m_to_L*G%IdyBu(I,J-1) + & - rx_avg*(u_new(I,j-1,k) - u_new(I,j-2,k))*G%US%m_to_L*G%IdyBu(I,J-2)) / (1.0+rx_avg) + segment%tangential_grad(I,J,k) = US%m_s_to_L_T*((u_new(I,j,k) - u_new(I,j-1,k))*G%IdyBu(I,J-1) + & + rx_avg*(u_new(I,j-1,k) - u_new(I,j-2,k))*G%IdyBu(I,J-2)) / (1.0+rx_avg) enddo ; enddo endif if (segment%nudged_grad) then @@ -2167,9 +2171,11 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, US, dt) rx_avg = rx_tangential(I,J,k) ry_avg = ry_tangential(I,J,k) cff_avg = cff_tangential(I,J,k) - segment%tangential_grad(I,J,k) = ((cff_avg*(u_new(I,j,k) - u_new(I,j-1,k))*G%US%m_to_L*G%IdyBu(I,J-1) & - + rx_avg*(u_new(I,j-1,k) - u_new(I,j-2,k))*G%US%m_to_L*G%IdyBu(I,J-2)) - & - (max(ry_avg,0.0)*segment%grad_gradient(I,2,k) + min(ry_avg,0.0)*segment%grad_gradient(I+1,2,k))) / & + segment%tangential_grad(I,J,k) = ( US%m_s_to_L_T* & + (cff_avg*(u_new(I,j,k) - u_new(I,j-1,k))*G%IdyBu(I,J-1) + & + rx_avg*(u_new(I,j-1,k) - u_new(I,j-2,k))*G%IdyBu(I,J-2)) - & + US%T_to_s*(max(ry_avg,0.0)*segment%grad_gradient(I,2,k) + & + min(ry_avg,0.0)*segment%grad_gradient(I+1,2,k))) / & (cff_avg + rx_avg) enddo ; enddo endif @@ -2296,8 +2302,8 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, US, dt) ! else ! rx_avg = 0.0 ! endif - segment%tangential_grad(I,J,k) = ((u_new(I,j+2,k) - u_new(I,j+1,k))*G%US%m_to_L*G%IdyBu(I,J+1) + & - rx_avg*(u_new(I,j+3,k) - u_new(I,j+2,k))*G%US%m_to_L*G%IdyBu(I,J+2)) / (1.0+rx_avg) + segment%tangential_grad(I,J,k) = US%m_s_to_L_T*((u_new(I,j+2,k) - u_new(I,j+1,k))*G%IdyBu(I,J+1) + & + rx_avg*(u_new(I,j+3,k) - u_new(I,j+2,k))*G%IdyBu(I,J+2)) / (1.0+rx_avg) enddo ; enddo endif if (segment%nudged_grad) then @@ -2363,9 +2369,11 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, US, dt) rx_avg = rx_tangential(I,J,k) ry_avg = ry_tangential(I,J,k) cff_avg = cff_tangential(I,J,k) - segment%tangential_grad(I,J,k) = ((cff_avg*(u_new(I,j+2,k) - u_new(I,j+1,k))*G%US%m_to_L*G%IdyBu(I,J+1) & - + rx_avg*(u_new(I,j+3,k) - u_new(I,j+2,k))*G%US%m_to_L*G%IdyBu(I,J+2)) - & - (max(ry_avg,0.0)*segment%grad_gradient(i,2,k) + min(ry_avg,0.0)*segment%grad_gradient(i+1,2,k))) / & + segment%tangential_grad(I,J,k) = (US%m_s_to_L_T * & + (cff_avg*(u_new(I,j+2,k) - u_new(I,j+1,k))*G%IdyBu(I,J+1) + & + rx_avg*(u_new(I,j+3,k) - u_new(I,j+2,k))*G%IdyBu(I,J+2)) - & + US%T_to_s*(max(ry_avg,0.0)*segment%grad_gradient(i,2,k) + & + min(ry_avg,0.0)*segment%grad_gradient(i+1,2,k))) / & (cff_avg + rx_avg) enddo ; enddo endif @@ -3330,7 +3338,7 @@ subroutine update_OBC_segment_data(G, GV, US, OBC, tv, h, Time) I=is_obc do J=js_obc,je_obc do k=1,G%ke - segment%tangential_grad(I,J,k) = segment%field(m)%buffer_dst(I,J,k) + segment%tangential_grad(I,J,k) = US%T_to_s*segment%field(m)%buffer_dst(I,J,k) enddo enddo elseif (trim(segment%field(m)%name) == 'DUDY' .and. segment%is_N_or_S .and. & @@ -3338,7 +3346,7 @@ subroutine update_OBC_segment_data(G, GV, US, OBC, tv, h, Time) J=js_obc do I=is_obc,ie_obc do k=1,G%ke - segment%tangential_grad(I,J,k) = segment%field(m)%buffer_dst(I,J,k) + segment%tangential_grad(I,J,k) = US%T_to_s*segment%field(m)%buffer_dst(I,J,k) enddo enddo endif diff --git a/src/parameterizations/lateral/MOM_hor_visc.F90 b/src/parameterizations/lateral/MOM_hor_visc.F90 index 4da86902b3..29b050b148 100644 --- a/src/parameterizations/lateral/MOM_hor_visc.F90 +++ b/src/parameterizations/lateral/MOM_hor_visc.F90 @@ -596,9 +596,9 @@ subroutine horizontal_viscosity(u_in, v_in, h, diffu, diffv, MEKE, VarMix, G, GV endif elseif (OBC%specified_strain) then if (OBC%segment(n)%direction == OBC_DIRECTION_N) then - dudy(I,J) = CS%DX_dyBu(I,J)*US%T_to_s*OBC%segment(n)%tangential_grad(I,J,k)*G%IdxCu(I,j)*G%dxBu(I,J) + dudy(I,J) = CS%DX_dyBu(I,J)*OBC%segment(n)%tangential_grad(I,J,k)*G%IdxCu(I,j)*G%dxBu(I,J) else - dudy(I,J) = CS%DX_dyBu(I,J)*US%T_to_s*OBC%segment(n)%tangential_grad(I,J,k)*G%IdxCu(I,j+1)*G%dxBu(I,J) + dudy(I,J) = CS%DX_dyBu(I,J)*OBC%segment(n)%tangential_grad(I,J,k)*G%IdxCu(I,j+1)*G%dxBu(I,J) endif endif enddo @@ -618,9 +618,9 @@ subroutine horizontal_viscosity(u_in, v_in, h, diffu, diffv, MEKE, VarMix, G, GV endif elseif (OBC%specified_strain) then if (OBC%segment(n)%direction == OBC_DIRECTION_E) then - dvdx(I,J) = CS%DY_dxBu(I,J)*US%T_to_s*OBC%segment(n)%tangential_grad(I,J,k)*G%IdyCv(i,J)*G%dxBu(I,J) + dvdx(I,J) = CS%DY_dxBu(I,J)*OBC%segment(n)%tangential_grad(I,J,k)*G%IdyCv(i,J)*G%dxBu(I,J) else - dvdx(I,J) = CS%DY_dxBu(I,J)*US%T_to_s*OBC%segment(n)%tangential_grad(I,J,k)*G%IdyCv(i+1,J)*G%dxBu(I,J) + dvdx(I,J) = CS%DY_dxBu(I,J)*OBC%segment(n)%tangential_grad(I,J,k)*G%IdyCv(i+1,J)*G%dxBu(I,J) endif endif enddo From c20db368cd27169d63bb3ad35cfa5e4244dd8a4c Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sat, 10 Aug 2019 17:42:24 -0400 Subject: [PATCH 184/297] +Rescaled OBC%segment%grad_gradient to [m s-1 L-1] Rescaled the units of the grad_gradient element of the OBC_segment type to [T-1] for more complete dimensional consistency testing. Also rearranged scaling arguments in MOM_open_boundary.F90. All answers are bitwise identical, but the units of an element in a transparent type has been rescaled. --- src/core/MOM_open_boundary.F90 | 137 ++++++++++++++++++--------------- 1 file changed, 73 insertions(+), 64 deletions(-) diff --git a/src/core/MOM_open_boundary.F90 b/src/core/MOM_open_boundary.F90 index b7b21d312d..93eb0005e5 100644 --- a/src/core/MOM_open_boundary.F90 +++ b/src/core/MOM_open_boundary.F90 @@ -160,7 +160,7 @@ module MOM_open_boundary real, pointer, dimension(:,:,:) :: grad_tan=>NULL() !< The gradient of the tangential flow along the !! segment [s-1] real, pointer, dimension(:,:,:) :: grad_gradient=>NULL() !< The gradient of the gradient of tangential flow along the - !! segment [m-1 s-1] + !! segment times a grid spacing [m s-1 L-1 ~> s-1] real, pointer, dimension(:,:,:) :: rx_normal=>NULL() !< The rx_old_u value for radiation coeff !! for normal velocity real, pointer, dimension(:,:,:) :: ry_normal=>NULL() !< The tangential value for radiation coeff @@ -1699,11 +1699,11 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, US, dt) do k=1,nz ; do J=Js_obc,Je_obc rx_avg = rx_tangential(I,J,k) ! if (G%mask2dCu(I-1,j) > 0.0 .and. G%mask2dCu(I-1,j+1) > 0.0) then -! rx_avg = 0.5*(u_new(I-1,j,k) + u_new(I-1,j+1,k))*dt*G%US%m_to_L*G%IdxBu(I-1,J) +! rx_avg = 0.5*US%m_s_to_L_T*(u_new(I-1,j,k) + u_new(I-1,j+1,k)) * US%s_to_T*dt * G%IdxBu(I-1,J) ! elseif (G%mask2dCu(I-1,j) > 0.0) then -! rx_avg = u_new(I-1,j,k)*dt*G%US%m_to_L*G%IdxBu(I-1,J) +! rx_avg = US%m_s_to_L_T*u_new(I-1,j,k) * US%s_to_T*dt * G%IdxBu(I-1,J) ! elseif (G%mask2dCu(I-1,j+1) > 0.0) then -! rx_avg = u_new(I-1,j+1,k)*dt*G%US%m_to_L*G%IdxBu(I-1,J) +! rx_avg = US%m_s_to_L_T*u_new(I-1,j+1,k) * US%s_to_T*dt * G%IdxBu(I-1,J) ! else ! rx_avg = 0.0 ! endif @@ -1774,12 +1774,12 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, US, dt) rx_avg = rx_tangential(I,J,k) ry_avg = ry_tangential(I,J,k) cff_avg = cff_tangential(I,J,k) - segment%tangential_grad(I,J,k) = & - ((cff_avg*(v_new(i,J,k) - v_new(i-1,J,k))*US%m_s_to_L_T*G%IdxBu(I-1,J) & - + rx_avg*(v_new(i-1,J,k) - v_new(i-2,J,k))*US%m_s_to_L_T*G%IdxBu(I-2,J)) - & - US%T_to_s*(max(ry_avg,0.0)*segment%grad_gradient(J,2,k) + & - min(ry_avg,0.0)*segment%grad_gradient(J+1,2,k))) / & - (cff_avg + rx_avg) + segment%tangential_grad(I,J,k) = US%m_s_to_L_T * & + ((cff_avg*(v_new(i,J,k) - v_new(i-1,J,k))*G%IdxBu(I-1,J) + & + rx_avg*(v_new(i-1,J,k) - v_new(i-2,J,k))*G%IdxBu(I-2,J)) - & + (max(ry_avg,0.0)*segment%grad_gradient(J,2,k) + & + min(ry_avg,0.0)*segment%grad_gradient(J+1,2,k)) ) / & + (cff_avg + rx_avg) enddo ; enddo endif if (segment%nudged_grad) then @@ -1897,11 +1897,11 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, US, dt) do k=1,nz ; do J=Js_obc,Je_obc rx_avg = rx_tangential(I,J,k) ! if (G%mask2dCu(I+1,j) > 0.0 .and. G%mask2dCu(I+1,j+1) > 0.0) then -! rx_avg = 0.5*(u_new(I+1,j,k) + u_new(I+1,j+1,k))*dt*G%US%m_to_L*G%IdxBu(I+1,J) +! rx_avg = 0.5*US%m_s_to_L_T*(u_new(I+1,j,k) + u_new(I+1,j+1,k)) * US%s_to_T*dt * G%IdxBu(I+1,J) ! elseif (G%mask2dCu(I+1,j) > 0.0) then -! rx_avg = u_new(I+1,j,k)*dt*G%US%m_to_L*G%IdxBu(I+1,J) +! rx_avg = US%m_s_to_L_T*u_new(I+1,j,k) * US%s_to_T*dt * G%IdxBu(I+1,J) ! elseif (G%mask2dCu(I+1,j+1) > 0.0) then -! rx_avg = u_new(I+1,j+1,k)*dt*G%US%m_to_L*G%IdxBu(I+1,J) +! rx_avg = US%m_s_to_L_T*u_new(I+1,j+1,k) * US%s_to_T*dt * G%IdxBu(I+1,J) ! else ! rx_avg = 0.0 ! endif @@ -1972,12 +1972,12 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, US, dt) rx_avg = rx_tangential(I,J,k) ry_avg = ry_tangential(I,J,k) cff_avg = cff_tangential(I,J,k) - segment%tangential_grad(I,J,k) = & - ((cff_avg*(v_new(i+2,J,k) - v_new(i+1,J,k))*US%m_s_to_L_T*G%IdxBu(I+1,J) & - + rx_avg*(v_new(i+3,J,k) - v_new(i+2,J,k))*US%m_s_to_L_T*G%IdxBu(I+2,J)) - & - US%T_to_s*(max(ry_avg,0.0)*segment%grad_gradient(J,2,k) + & - min(ry_avg,0.0)*segment%grad_gradient(J+1,2,k))) / & - (cff_avg + rx_avg) + segment%tangential_grad(I,J,k) = US%m_s_to_L_T * & + ((cff_avg*(v_new(i+2,J,k) - v_new(i+1,J,k))*G%IdxBu(I+1,J) + & + rx_avg*(v_new(i+3,J,k) - v_new(i+2,J,k))*G%IdxBu(I+2,J)) - & + (max(ry_avg,0.0)*segment%grad_gradient(J,2,k) + & + min(ry_avg,0.0)*segment%grad_gradient(J+1,2,k))) / & + (cff_avg + rx_avg) enddo ; enddo endif if (segment%nudged_grad) then @@ -2038,9 +2038,11 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, US, dt) segment%rx_normal(I,j,k) = rx_avg segment%ry_normal(i,J,k) = ry_avg segment%cff_normal(i,J,k) = cff_avg - segment%normal_vel(i,J,k) = US%m_s_to_L_T*((cff_avg*v_new(i,J,k) + ry_avg*v_new(i,J-1,k)) - & - (max(rx_avg,0.0)*segment%grad_normal(I-1,2,k) + min(rx_avg,0.0)*segment%grad_normal(I,2,k))) / & - (cff_avg + ry_avg) + segment%normal_vel(i,J,k) = US%m_s_to_L_T * & + ((cff_avg*v_new(i,J,k) + ry_avg*v_new(i,J-1,k)) - & + (max(rx_avg,0.0)*segment%grad_normal(I-1,2,k) +& + min(rx_avg,0.0)*segment%grad_normal(I,2,k))) / & + (cff_avg + ry_avg) ! Copy restart fields into 3-d arrays. This is an inefficient and temporary issues ! implemented as a work-around to limitations in restart capability OBC%rx_normal(I,j,k) = segment%rx_normal(I,j,k) @@ -2096,15 +2098,16 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, US, dt) do k=1,nz ; do I=Is_obc,Ie_obc rx_avg = rx_tangential(I,J,k) ! if (G%mask2dCv(i,J-1) > 0.0 .and. G%mask2dCv(i+1,J-1) > 0.0) then -! rx_avg = 0.5*(v_new(i,J-1,k) + v_new(i+1,J-1,k)*dt*G%US%m_to_L*G%IdyBu(I,J-1)) +! rx_avg = 0.5*US%m_s_to_L_T*(v_new(i,J-1,k) + v_new(i+1,J-1,k) * US%s_to_T*dt * G%IdyBu(I,J-1)) ! elseif (G%mask2dCv(i,J-1) > 0.0) then -! rx_avg = v_new(i,J-1,k)*dt*G%US%m_to_L*G%IdyBu(I,J-1) +! rx_avg = US%m_s_to_L_T*v_new(i,J-1,k) * US%s_to_T*dt *G%IdyBu(I,J-1) ! elseif (G%mask2dCv(i+1,J-1) > 0.0) then -! rx_avg = v_new(i+1,J-1,k)*dt*G%US%m_to_L*G%IdyBu(I,J-1) +! rx_avg = US%m_s_to_L_T*v_new(i+1,J-1,k) * US%s_to_T*dt *G%IdyBu(I,J-1) ! else ! rx_avg = 0.0 ! endif - segment%tangential_grad(I,J,k) = US%m_s_to_L_T*((u_new(I,j,k) - u_new(I,j-1,k))*G%IdyBu(I,J-1) + & + segment%tangential_grad(I,J,k) = US%m_s_to_L_T * & + ((u_new(I,j,k) - u_new(I,j-1,k))*G%IdyBu(I,J-1) + & rx_avg*(u_new(I,j-1,k) - u_new(I,j-2,k))*G%IdyBu(I,J-2)) / (1.0+rx_avg) enddo ; enddo endif @@ -2146,9 +2149,11 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, US, dt) rx_avg = rx_tangential(I,J,k) ry_avg = ry_tangential(I,J,k) cff_avg = cff_tangential(I,J,k) - segment%tangential_vel(I,J,k) = US%m_s_to_L_T*((cff_avg*u_new(I,j,k) + rx_avg*u_new(I,j-1,k)) - & - (max(ry_avg,0.0)*segment%grad_tan(i,2,k) + min(ry_avg,0.0)*segment%grad_tan(i+1,2,k))) / & - (cff_avg + rx_avg) + segment%tangential_vel(I,J,k) = US%m_s_to_L_T * & + ((cff_avg*u_new(I,j,k) + rx_avg*u_new(I,j-1,k)) - & + (max(ry_avg,0.0)*segment%grad_tan(i,2,k) + & + min(ry_avg,0.0)*segment%grad_tan(i+1,2,k))) / & + (cff_avg + rx_avg) enddo ; enddo endif if (segment%nudged_tan) then @@ -2171,12 +2176,12 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, US, dt) rx_avg = rx_tangential(I,J,k) ry_avg = ry_tangential(I,J,k) cff_avg = cff_tangential(I,J,k) - segment%tangential_grad(I,J,k) = ( US%m_s_to_L_T* & - (cff_avg*(u_new(I,j,k) - u_new(I,j-1,k))*G%IdyBu(I,J-1) + & - rx_avg*(u_new(I,j-1,k) - u_new(I,j-2,k))*G%IdyBu(I,J-2)) - & - US%T_to_s*(max(ry_avg,0.0)*segment%grad_gradient(I,2,k) + & - min(ry_avg,0.0)*segment%grad_gradient(I+1,2,k))) / & - (cff_avg + rx_avg) + segment%tangential_grad(I,J,k) = US%m_s_to_L_T * & + ((cff_avg*(u_new(I,j,k) - u_new(I,j-1,k))*G%IdyBu(I,J-1) + & + rx_avg*(u_new(I,j-1,k) - u_new(I,j-2,k))*G%IdyBu(I,J-2)) - & + (max(ry_avg,0.0)*segment%grad_gradient(I,2,k) + & + min(ry_avg,0.0)*segment%grad_gradient(I+1,2,k))) / & + (cff_avg + rx_avg) enddo ; enddo endif if (segment%nudged_grad) then @@ -2294,11 +2299,11 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, US, dt) do k=1,nz ; do I=Is_obc,Ie_obc rx_avg = rx_tangential(I,J,k) ! if (G%mask2dCv(i,J+1) > 0.0 .and. G%mask2dCv(i+1,J+1) > 0.0) then -! rx_avg = 0.5*(v_new(i,J+1,k) + v_new(i+1,J+1,k))*dt*G%US%m_to_L*G%IdyBu(I,J+1) +! rx_avg = 0.5*US%m_s_to_L_T*(v_new(i,J+1,k) + v_new(i+1,J+1,k)) * US%s_to_T*dt * G%IdyBu(I,J+1) ! elseif (G%mask2dCv(i,J+1) > 0.0) then -! rx_avg = v_new(i,J+1,k)*dt*G%US%m_to_L*G%IdyBu(I,J+1) +! rx_avg = US%m_s_to_L_T*v_new(i,J+1,k) * US%s_to_T*dt * G%IdyBu(I,J+1) ! elseif (G%mask2dCv(i+1,J+1) > 0.0) then -! rx_avg = v_new(i+1,J+1,k)*dt*G%US%m_to_L*G%IdyBu(I,J+1) +! rx_avg = US%m_s_to_L_T*v_new(i+1,J+1,k) * US%s_to_T*dt * G%IdyBu(I,J+1) ! else ! rx_avg = 0.0 ! endif @@ -2344,9 +2349,11 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, US, dt) rx_avg = rx_tangential(I,J,k) ry_avg = ry_tangential(I,J,k) cff_avg = cff_tangential(I,J,k) - segment%tangential_vel(I,J,k) = US%m_s_to_L_T*((cff_avg*u_new(I,j+1,k) + rx_avg*u_new(I,j+2,k)) - & - (max(ry_avg,0.0)*segment%grad_tan(i,2,k) + min(ry_avg,0.0)*segment%grad_tan(i+1,2,k))) / & - (cff_avg + rx_avg) + segment%tangential_vel(I,J,k) = US%m_s_to_L_T * & + ((cff_avg*u_new(I,j+1,k) + rx_avg*u_new(I,j+2,k)) - & + (max(ry_avg,0.0)*segment%grad_tan(i,2,k) + & + min(ry_avg,0.0)*segment%grad_tan(i+1,2,k)) ) / & + (cff_avg + rx_avg) enddo ; enddo endif if (segment%nudged_tan) then @@ -2359,7 +2366,7 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, US, dt) endif gamma_2 = dt / (tau + dt) segment%tangential_vel(I,J,k) = (1 - gamma_2) * segment%tangential_vel(I,J,k) + & - gamma_2 * segment%nudged_tangential_vel(I,J,k) + gamma_2 * segment%nudged_tangential_vel(I,J,k) enddo ; enddo endif if (segment%oblique_grad) then @@ -2369,12 +2376,12 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, US, dt) rx_avg = rx_tangential(I,J,k) ry_avg = ry_tangential(I,J,k) cff_avg = cff_tangential(I,J,k) - segment%tangential_grad(I,J,k) = (US%m_s_to_L_T * & - (cff_avg*(u_new(I,j+2,k) - u_new(I,j+1,k))*G%IdyBu(I,J+1) + & - rx_avg*(u_new(I,j+3,k) - u_new(I,j+2,k))*G%IdyBu(I,J+2)) - & - US%T_to_s*(max(ry_avg,0.0)*segment%grad_gradient(i,2,k) + & - min(ry_avg,0.0)*segment%grad_gradient(i+1,2,k))) / & - (cff_avg + rx_avg) + segment%tangential_grad(I,J,k) = US%m_s_to_L_T * & + ((cff_avg*(u_new(I,j+2,k) - u_new(I,j+1,k))*G%IdyBu(I,J+1) + & + rx_avg*(u_new(I,j+3,k) - u_new(I,j+2,k))*G%IdyBu(I,J+2)) - & + (max(ry_avg,0.0)*segment%grad_gradient(i,2,k) + & + min(ry_avg,0.0)*segment%grad_gradient(i+1,2,k))) / & + (cff_avg + rx_avg) enddo ; enddo endif if (segment%nudged_grad) then @@ -2500,10 +2507,10 @@ subroutine gradient_at_q_points(G, segment, uvel, vvel) if (segment%oblique_grad) then do k=1,G%ke do J=max(segment%HI%jsd, G%HI%jsd+1),min(segment%HI%jed, G%HI%jed-1) - segment%grad_gradient(j,1,k) = (((vvel(i-1,J,k) - vvel(i-2,J,k))*G%US%m_to_L*G%IdxBu(I-2,J)) - & - (vvel(i-1,J-1,k) - vvel(i-2,J-1,k))*G%US%m_to_L*G%IdxBu(I-2,J-1)) * G%mask2dCu(I-1,j) - segment%grad_gradient(j,2,k) = (((vvel(i,J,k) - vvel(i-1,J,k))*G%US%m_to_L*G%IdxBu(I-1,J)) - & - (vvel(i,J-1,k) - vvel(i-1,J-1,k))*G%US%m_to_L*G%IdxBu(I-1,J-1)) * G%mask2dCu(I,j) + segment%grad_gradient(j,1,k) = (((vvel(i-1,J,k) - vvel(i-2,J,k))*G%IdxBu(I-2,J)) - & + (vvel(i-1,J-1,k) - vvel(i-2,J-1,k))*G%IdxBu(I-2,J-1)) * G%mask2dCu(I-1,j) + segment%grad_gradient(j,2,k) = (((vvel(i,J,k) - vvel(i-1,J,k))*G%IdxBu(I-1,J)) - & + (vvel(i,J-1,k) - vvel(i-1,J-1,k))*G%IdxBu(I-1,J-1)) * G%mask2dCu(I,j) enddo enddo endif @@ -2526,10 +2533,10 @@ subroutine gradient_at_q_points(G, segment, uvel, vvel) if (segment%oblique_grad) then do k=1,G%ke do J=max(segment%HI%jsd, G%HI%jsd+1),min(segment%HI%jed, G%HI%jed-1) - segment%grad_gradient(j,1,k) = (((vvel(i+3,J,k) - vvel(i+2,J,k))*G%US%m_to_L*G%IdxBu(I+2,J)) - & - (vvel(i+3,J-1,k) - vvel(i+2,J-1,k))*G%US%m_to_L*G%IdxBu(I+2,J-1)) * G%mask2dCu(I+2,j) - segment%grad_gradient(j,2,k) = (((vvel(i+2,J,k) - vvel(i+1,J,k))*G%US%m_to_L*G%IdxBu(I+1,J)) - & - (vvel(i+2,J-1,k) - vvel(i+1,J-1,k))*G%US%m_to_L*G%IdxBu(I+1,J-1)) * G%mask2dCu(I+1,j) + segment%grad_gradient(j,1,k) = (((vvel(i+3,J,k) - vvel(i+2,J,k))*G%IdxBu(I+2,J)) - & + (vvel(i+3,J-1,k) - vvel(i+2,J-1,k))*G%IdxBu(I+2,J-1)) * G%mask2dCu(I+2,j) + segment%grad_gradient(j,2,k) = (((vvel(i+2,J,k) - vvel(i+1,J,k))*G%IdxBu(I+1,J)) - & + (vvel(i+2,J-1,k) - vvel(i+1,J-1,k))*G%IdxBu(I+1,J-1)) * G%mask2dCu(I+1,j) enddo enddo endif @@ -2554,10 +2561,11 @@ subroutine gradient_at_q_points(G, segment, uvel, vvel) if (segment%oblique_grad) then do k=1,G%ke do I=max(segment%HI%isd, G%HI%isd+1),min(segment%HI%ied, G%HI%ied-1) - segment%grad_gradient(i,1,k) = (((uvel(I,j-1,k) - uvel(I,j-2,k))*G%US%m_to_L*G%IdxBu(I,J-2)) - & - (uvel(I-1,j-1,k) - uvel(I-1,j-2,k))*G%US%m_to_L*G%IdxBu(I-1,J-2)) * G%mask2dCv(I,j-1) - segment%grad_gradient(i,2,k) = (((uvel(I,j,k) - uvel(I,j-1,k))*G%US%m_to_L*G%IdyBu(I,J-1)) - & - (uvel(I-1,j,k) - uvel(I-1,j-1,k))*G%US%m_to_L*G%IdyBu(I-1,J-1)) * G%mask2dCv(i,J) + !### The combination of differences in j and Idx here do not make sense to me. All should be Idy? + segment%grad_gradient(i,1,k) = (((uvel(I,j-1,k) - uvel(I,j-2,k))*G%IdxBu(I,J-2)) - & + (uvel(I-1,j-1,k) - uvel(I-1,j-2,k))*G%IdxBu(I-1,J-2)) * G%mask2dCv(I,j-1) + segment%grad_gradient(i,2,k) = (((uvel(I,j,k) - uvel(I,j-1,k))*G%IdyBu(I,J-1)) - & + (uvel(I-1,j,k) - uvel(I-1,j-1,k))*G%IdyBu(I-1,J-1)) * G%mask2dCv(i,J) enddo enddo endif @@ -2580,10 +2588,11 @@ subroutine gradient_at_q_points(G, segment, uvel, vvel) if (segment%oblique_grad) then do k=1,G%ke do I=max(segment%HI%isd, G%HI%isd+1),min(segment%HI%ied, G%HI%ied-1) - segment%grad_gradient(i,1,k) = (((uvel(I,j+3,k) - uvel(I,j+2,k))*G%US%m_to_L*G%IdxBu(I,J+2)) - & - (uvel(I-1,j+3,k) - uvel(I-1,j+2,k))*G%US%m_to_L*G%IdyBu(I-1,J+2)) * G%mask2dCv(i,J+2) - segment%grad_gradient(i,2,k) = (((uvel(I,j+2,k) - uvel(I,j+1,k))*G%US%m_to_L*G%IdxBu(I,J+1)) - & - (uvel(I-1,j+2,k) - uvel(I-1,j+1,k))*G%US%m_to_L*G%IdyBu(I-1,J+1)) * G%mask2dCv(i,J+1) + !### The combination of differences in j and Idx here do not make sense to me. All should be Idy? + segment%grad_gradient(i,1,k) = (((uvel(I,j+3,k) - uvel(I,j+2,k))*G%IdxBu(I,J+2)) - & + (uvel(I-1,j+3,k) - uvel(I-1,j+2,k))*G%IdyBu(I-1,J+2)) * G%mask2dCv(i,J+2) + segment%grad_gradient(i,2,k) = (((uvel(I,j+2,k) - uvel(I,j+1,k))*G%IdxBu(I,J+1)) - & + (uvel(I-1,j+2,k) - uvel(I-1,j+1,k))*G%IdyBu(I-1,J+1)) * G%mask2dCv(i,J+1) enddo enddo endif From ce21fd0d88cecfacdf9be87bece3c9209f24e2dc Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sat, 10 Aug 2019 19:47:58 -0400 Subject: [PATCH 185/297] Unit scaling term cleanup in set_viscous_BBL Rearranged and canceled out common unit scaling factors in set_viscous_BBL and set_viscous_ML, partly in preparation to rescale velocities. All answers are bitwise identical. --- .../vertical/MOM_set_viscosity.F90 | 58 ++++++++++--------- 1 file changed, 30 insertions(+), 28 deletions(-) diff --git a/src/parameterizations/vertical/MOM_set_viscosity.F90 b/src/parameterizations/vertical/MOM_set_viscosity.F90 index 8b4101eb62..26c0c41758 100644 --- a/src/parameterizations/vertical/MOM_set_viscosity.F90 +++ b/src/parameterizations/vertical/MOM_set_viscosity.F90 @@ -171,7 +171,7 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, symmetrize) ! Rho0 divided by G_Earth and the conversion ! from m to thickness units [H kg m-3 ~> kg m-2 or kg2 m-5]. real :: cdrag_sqrt_Z ! Square root of the drag coefficient, times a unit conversion - ! factor from lateral lengths to vertical depths [Z m-1 ~> 1]. + ! factor from lateral lengths to vertical depths [Z L-1 ~> 1]. real :: cdrag_sqrt ! Square root of the drag coefficient [nondim]. real :: oldfn ! The integrated energy required to ! entrain up to the bottom of the layer, @@ -231,9 +231,9 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, symmetrize) real :: Vol_quit ! The volume error below which to quit iterating [H ~> m or kg m-2]. real :: Vol_tol ! A volume error tolerance [H ~> m or kg m-2]. real :: L(SZK_(G)+1) ! The fraction of the full cell width that is open at - ! the depth of each interface, nondimensional. + ! the depth of each interface [nondim]. real :: L_direct ! The value of L above volume Vol_direct [nondim]. - real :: L_max, L_min ! Upper and lower bounds on the correct value for L. + real :: L_max, L_min ! Upper and lower bounds on the correct value for L [nondim]. real :: Vol_err_max ! The volume errors for the upper and lower bounds on real :: Vol_err_min ! the correct value for L [H ~> m or kg m-2]. real :: Vol_0 ! A deeper volume with known width L0 [H ~> m or kg m-2]. @@ -246,7 +246,7 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, symmetrize) 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 :: Cell_width ! The transverse width of the velocity cell [L ~> m]. real :: Rayleigh ! A nondimensional value that is multiplied by the layer's ! velocity magnitude to give the Rayleigh drag velocity, times ! a lateral to vertical distance conversion factor [Z L-1 ~> 1]. @@ -291,9 +291,9 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, symmetrize) use_BBL_EOS = associated(tv%eqn_of_state) .and. CS%BBL_use_EOS OBC => CS%OBC - U_bg_sq = CS%drag_bg_vel * CS%drag_bg_vel + U_bg_sq = US%L_T_to_m_s**2*CS%drag_bg_vel * CS%drag_bg_vel cdrag_sqrt = sqrt(CS%cdrag) - cdrag_sqrt_Z = US%m_to_Z * sqrt(CS%cdrag) + cdrag_sqrt_Z = US%L_to_Z * sqrt(CS%cdrag) K2 = max(nkmb+1, 2) ! With a linear drag law, the friction velocity is already known. @@ -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*US%T_to_s*hutot/hwtot + ustar(i) = cdrag_sqrt_Z*US%m_s_to_L_T*hutot/hwtot else - ustar(i) = cdrag_sqrt_Z*US%T_to_s*CS%drag_bg_vel + ustar(i) = cdrag_sqrt_Z*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*US%T_to_s*CS%drag_bg_vel ; enddo + do i=is,ie ; ustar(i) = cdrag_sqrt_Z*CS%drag_bg_vel ; enddo endif ! Not linear_drag if (use_BBL_EOS) then @@ -822,7 +822,7 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, symmetrize) endif ! Determine the drag contributing to the bottom boundary layer - ! and the Raleigh drag that acting on each layer. + ! and the Raleigh drag that acts on each layer. if (L(K) > L(K+1)) then if (vol_below < bbl_thick) then BBL_frac = (1.0-vol_below/bbl_thick)**2 @@ -831,12 +831,12 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, symmetrize) BBL_frac = 0.0 endif - if (m==1) then ; Cell_width = US%L_to_m*G%dy_Cu(I,j) - else ; Cell_width = US%L_to_m*G%dx_Cv(i,J) ; endif + if (m==1) then ; Cell_width = G%dy_Cu(I,j) + else ; Cell_width = G%dx_Cv(i,J) ; endif gam = 1.0 - L(K+1)/L(K) - Rayleigh = US%m_to_Z * CS%cdrag * (L(K)-L(K+1)) * (1.0-BBL_frac) * & + Rayleigh = US%L_to_Z * CS%cdrag * (L(K)-L(K+1)) * (1.0-BBL_frac) * & (12.0*CS%c_Smag*h_vel_pos) / (12.0*CS%c_Smag*h_vel_pos + & - GV%m_to_H * CS%cdrag * gam*(1.0-gam)*(1.0-1.5*gam) * L(K)**2 * Cell_width) + US%L_to_Z*GV%Z_to_H * CS%cdrag * gam*(1.0-gam)*(1.0-1.5*gam) * L(K)**2 * Cell_width) else ! This layer feels no drag. Rayleigh = 0.0 endif @@ -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*US%T_to_s*sqrt(u(I,j,k)*u(I,j,k) + & + visc%Ray_u(I,j,k) = Rayleigh*US%m_s_to_L_T*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*US%T_to_s*sqrt(v(i,J,k)*v(i,J,k) + & + visc%Ray_v(i,J,k) = Rayleigh*US%m_s_to_L_T*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 @@ -913,7 +913,7 @@ end subroutine set_viscous_BBL function set_v_at_u(v, h, G, i, j, k, mask2dCv, OBC) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - intent(in) :: v !< The meridional velocity [m s-1] + intent(in) :: v !< The meridional velocity [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] integer, intent(in) :: i !< The i-index of the u-location to work on. @@ -922,7 +922,8 @@ function set_v_at_u(v, h, G, i, j, k, mask2dCv, OBC) real, dimension(SZI_(G),SZJB_(G)),& intent(in) :: mask2dCv !< A multiplicative mask of the v-points type(ocean_OBC_type), pointer :: OBC !< A pointer to an open boundary condition structure - real :: set_v_at_u !< The retur value of v at u points [m s-1]. + real :: set_v_at_u !< The return value of v at u points points in the + !! same units as u, i.e. [L T-1 ~> m s-1] or other units. ! This subroutine finds a thickness-weighted value of v at the u-points. real :: hwt(0:1,-1:0) ! Masked weights used to average u onto v [H ~> m or kg m-2]. @@ -956,7 +957,7 @@ end function set_v_at_u function set_u_at_v(u, h, G, i, j, k, mask2dCu, OBC) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & - intent(in) :: u !< The zonal velocity [m s-1] + intent(in) :: u !< The zonal velocity [L T-1 ~> m s-1] or other units. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] integer, intent(in) :: i !< The i-index of the u-location to work on. @@ -965,7 +966,8 @@ function set_u_at_v(u, h, G, i, j, k, mask2dCu, OBC) real, dimension(SZIB_(G),SZJ_(G)), & intent(in) :: mask2dCu !< A multiplicative mask of the u-points type(ocean_OBC_type), pointer :: OBC !< A pointer to an open boundary condition structure - real :: set_u_at_v !< The return value of u at v points [m s-1]. + real :: set_u_at_v !< The return value of u at v points in the + !! same units as u, i.e. [L T-1 ~> m s-1] or other units. ! This subroutine finds a thickness-weighted value of u at the v-points. real :: hwt(-1:0,0:1) ! Masked weights used to average u onto v [H ~> m or kg m-2]. @@ -1091,7 +1093,7 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS, symmetri ! Rho0 divided by G_Earth and the conversion ! from m to thickness units [H kg m-3 ~> kg m-2 or kg2 m-5]. real :: cdrag_sqrt_Z ! Square root of the drag coefficient, times a unit conversion - ! factor from lateral lengths to vertical depths [Z m-1 ~> 1]. + ! factor from lateral lengths to vertical depths [Z L-1 ~> 1]. real :: cdrag_sqrt ! Square root of the drag coefficient [nondim]. real :: oldfn ! The integrated energy required to ! entrain up to the bottom of the layer, @@ -1132,9 +1134,9 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS, symmetri endif ; endif 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 + U_bg_sq = US%L_T_to_m_s**2*CS%drag_bg_vel * CS%drag_bg_vel cdrag_sqrt = sqrt(CS%cdrag) - cdrag_sqrt_Z = US%m_to_Z * sqrt(CS%cdrag) + cdrag_sqrt_Z = US%L_to_Z * sqrt(CS%cdrag) OBC => CS%OBC use_EOS = associated(tv%eqn_of_state) @@ -1336,9 +1338,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*US%T_to_s*hutot/hwtot + ustar(I) = cdrag_sqrt_Z * US%m_s_to_L_T*hutot/hwtot else - ustar(I) = cdrag_sqrt_Z*US%T_to_s*CS%drag_bg_vel + ustar(I) = cdrag_sqrt_Z * CS%drag_bg_vel endif if (use_EOS) then ; if (hwtot > 0.0) then @@ -1573,9 +1575,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*US%T_to_s*hutot/hwtot + ustar(i) = cdrag_sqrt_Z * US%m_s_to_L_T*hutot/hwtot else - ustar(i) = cdrag_sqrt_Z*US%T_to_s*CS%drag_bg_vel + ustar(i) = cdrag_sqrt_Z * CS%drag_bg_vel endif ; endif if (use_EOS) then ; if (hwtot > 0.0) then @@ -1922,7 +1924,7 @@ subroutine set_visc_init(Time, G, GV, US, param_file, diag, visc, CS, restart_CS "LINEAR_DRAG) or an unresolved velocity that is "//& "combined with the resolved velocity to estimate the "//& "velocity magnitude. DRAG_BG_VEL is only used when "//& - "BOTTOMDRAGLAW is defined.", units="m s-1", default=0.0) + "BOTTOMDRAGLAW is defined.", units="m s-1", default=0.0, scale=US%m_s_to_L_T) call get_param(param_file, mdl, "BBL_USE_EOS", CS%BBL_use_EOS, & "If true, use the equation of state in determining the "//& "properties of the bottom boundary layer. Otherwise use "//& From 32aa6d5ff098b1a9c0995b5e1b86478403838dfa Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sun, 11 Aug 2019 05:13:17 -0400 Subject: [PATCH 186/297] Simplified scaling terms in find_uv_at_h Canceled out corresponding dimensional scaling factors in the numerator and denominator of two expressions in find_uv_at_h. All answers are bitwise identical. --- .../vertical/MOM_diabatic_aux.F90 | 22 +++++++++---------- 1 file changed, 11 insertions(+), 11 deletions(-) diff --git a/src/parameterizations/vertical/MOM_diabatic_aux.F90 b/src/parameterizations/vertical/MOM_diabatic_aux.F90 index 6354ca8d71..96652a9f45 100644 --- a/src/parameterizations/vertical/MOM_diabatic_aux.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_aux.F90 @@ -582,7 +582,7 @@ subroutine find_uv_at_h(u, v, h, u_h, v_h, G, GV, US, ea, eb) real :: a_n(SZI_(G)), a_s(SZI_(G)) ! Fractional weights of the neighboring real :: a_e(SZI_(G)), a_w(SZI_(G)) ! velocity points, ~1/2 in the open ! ocean, nondimensional. - real :: s, Idenom + real :: sum_area, 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 = GV%ke @@ -598,20 +598,20 @@ subroutine find_uv_at_h(u, v, h, u_h, v_h, G, GV, US, ea, eb) !$OMP private(s,Idenom,a_w,a_e,a_s,a_n,b_denom_1,b1,d1,c1) do j=js,je do i=is,ie - s = US%L_to_m**2*G%areaCu(I-1,j)+US%L_to_m**2*G%areaCu(I,j) - if (s>0.0) then - Idenom = sqrt(0.5*US%m_to_L**2*G%IareaT(i,j)/s) - a_w(i) = US%L_to_m**2*G%areaCu(I-1,j)*Idenom - a_e(i) = US%L_to_m**2*G%areaCu(I,j)*Idenom + sum_area = G%areaCu(I-1,j) + G%areaCu(I,j) + if (sum_area>0.0) then + Idenom = sqrt(0.5*G%IareaT(i,j) / sum_area) + a_w(i) = G%areaCu(I-1,j) * Idenom + a_e(i) = G%areaCu(I,j) * Idenom else a_w(i) = 0.0 ; a_e(i) = 0.0 endif - s = US%L_to_m**2*G%areaCv(i,J-1)+US%L_to_m**2*G%areaCv(i,J) - if (s>0.0) then - Idenom = sqrt(0.5*US%m_to_L**2*G%IareaT(i,j)/s) - a_s(i) = US%L_to_m**2*G%areaCv(i,J-1)*Idenom - a_n(i) = US%L_to_m**2*G%areaCv(i,J)*Idenom + sum_area = G%areaCv(i,J-1) + G%areaCv(i,J) + if (sum_area>0.0) then + Idenom = sqrt(0.5*G%IareaT(i,j) / sum_area) + a_s(i) = G%areaCv(i,J-1) * Idenom + a_n(i) = G%areaCv(i,J) * Idenom else a_s(i) = 0.0 ; a_n(i) = 0.0 endif From 54db6d33fc480353cff5c5883294261e71168e20 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sun, 11 Aug 2019 10:51:18 -0400 Subject: [PATCH 187/297] Rescaled variables in MOM_internal_tides.F90 Applied dimensional rescaling to numerous internal variables in MOM_internal_tides.F90 for expanded dimensional consistency testing and to prepare for wave speeds to passed in with units of [L T-1]. All answers are bitwise identical. --- .../lateral/MOM_internal_tides.F90 | 294 +++++++++--------- 1 file changed, 140 insertions(+), 154 deletions(-) diff --git a/src/parameterizations/lateral/MOM_internal_tides.F90 b/src/parameterizations/lateral/MOM_internal_tides.F90 index 5a6837c1ad..918b0d142c 100644 --- a/src/parameterizations/lateral/MOM_internal_tides.F90 +++ b/src/parameterizations/lateral/MOM_internal_tides.F90 @@ -65,7 +65,7 @@ module MOM_internal_tides !! is possible (i.e. ridge cells) ! (could be in G control structure) real, allocatable, dimension(:,:,:,:) :: cp - !< horizontal phase speed [m s-1] + !< horizontal phase speed [L T-1 ~> m s-1] real, allocatable, dimension(:,:,:,:,:) :: TKE_leak_loss !< energy lost due to misc background processes [W m-2] real, allocatable, dimension(:,:,:,:,:) :: TKE_quad_loss @@ -74,7 +74,7 @@ module MOM_internal_tides !< energy lost due to wave breaking [W m-2] real, allocatable, dimension(:,:) :: TKE_itidal_loss_fixed !< fixed part of the energy lost due to small-scale drag - !! [kg Z-2 ~> kg m-2] here; will be multiplied by N and En to get into [W m-2] + !! [kg m L-2 Z-1 ~> kg m-2] here; will be multiplied by N and En to get into [W m-2] real, allocatable, dimension(:,:,:,:,:) :: TKE_itidal_loss !< energy lost due to small-scale wave drag [W m-2] real, allocatable, dimension(:,:) :: tot_leak_loss !< Energy loss rates due to misc bakground processes, @@ -106,7 +106,7 @@ module MOM_internal_tides !< The internal wave energy density as a function of (i,j,angle,frequency,mode) real, dimension(:,:,:), pointer :: En_restart => NULL() !< The internal wave energy density as a function of (i,j,angle); temporary for restart - real, allocatable, dimension(:) :: frequency !< The frequency of each band [s-1]. + real, allocatable, dimension(:) :: frequency !< The frequency of each band [T-1 ~> s-1]. type(diag_ctrl), pointer :: diag => NULL() !< A structure that is used to regulate the !! timing of diagnostic output. @@ -172,7 +172,8 @@ subroutine propagate_int_tide(h, tv, cn, TKE_itidal_input, vel_btTide, Nb, dt, & test real, dimension(SZI_(G),SZJ_(G),CS%nFreq,CS%nMode) :: & tot_En_mode, & ! energy summed over angles only - Ub, Umax ! near-bottom & max horizontal velocity of wave (modal) + Ub, & ! near-bottom horizontal velocity of wave (modal) [m s-1] + Umax ! Maximum horizontal velocity of wave (modal) [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJB_(G)) :: & flux_heat_y, & flux_prec_y @@ -183,9 +184,12 @@ subroutine propagate_int_tide(h, tv, cn, TKE_itidal_input, vel_btTide, Nb, dt, & drag_scale, & ! bottom drag scale, s-1 itidal_loss_mode, allprocesses_loss_mode ! energy loss rates for a given mode and frequency (summed over angles) - real :: frac_per_sector, f2, I_rho0, I_D_here, freq2, Kmag2 - real :: c_phase, loss_rate, Fr2_max - real, parameter :: cn_subRO = 1e-100 ! to prevent division by zero + real :: frac_per_sector, f2, I_rho0, I_D_here, Kmag2 + real :: freq2 ! The frequency squared [T-2 ~> s-2] + real :: c_phase ! The phase speed [m s-1] + real :: loss_rate, Fr2_max + real :: cn_subRO ! A tiny wave speed to prevent division by zero [L T-1 ~> m s-1] + real :: dt_in_T ! The timestep [T ~> s] real :: En_new, En_check ! for debugging real :: En_initial, Delta_E_check ! for debugging real :: TKE_Froude_loss_check, TKE_Froude_loss_tot ! for debugging @@ -198,6 +202,8 @@ subroutine propagate_int_tide(h, tv, cn, TKE_itidal_input, vel_btTide, Nb, dt, & is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed ; nAngle = CS%NAngle I_rho0 = 1.0 / GV%Rho0 + dt_in_T = US%s_to_T*dt + cn_subRO = 1e-100*US%m_s_to_L_T ! The hard-coded value here might need to increase. ! Set the wave speeds for the modes, using cg(n) ~ cg(1)/n.********************** ! This is wrong, of course, but it works reasonably in some cases. @@ -210,8 +216,8 @@ subroutine propagate_int_tide(h, tv, cn, TKE_itidal_input, vel_btTide, Nb, dt, & if (CS%energized_angle <= 0) then frac_per_sector = 1.0 / real(CS%nAngle * CS%nMode * CS%nFreq) do m=1,CS%nMode ; do fr=1,CS%nFreq ; do a=1,CS%nAngle ; do j=js,je ; do i=is,ie - f2 = 0.25*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)) + f2 = 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)) if (CS%frequency(fr)**2 > f2) & CS%En(i,j,a,fr,m) = CS%En(i,j,a,fr,m) + & dt*frac_per_sector*(1-CS%q_itides)*TKE_itidal_input(i,j) @@ -220,8 +226,8 @@ subroutine propagate_int_tide(h, tv, cn, TKE_itidal_input, vel_btTide, Nb, dt, & frac_per_sector = 1.0 / real(CS%nMode * CS%nFreq) a = CS%energized_angle do m=1,CS%nMode ; do fr=1,CS%nFreq ; do j=js,je ; do i=is,ie - f2 = 0.25*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)) + f2 = 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)) if (CS%frequency(fr)**2 > f2) & CS%En(i,j,a,fr,m) = CS%En(i,j,a,fr,m) + & dt*frac_per_sector**(1-CS%q_itides)*TKE_itidal_input(i,j) @@ -241,7 +247,8 @@ subroutine propagate_int_tide(h, tv, cn, TKE_itidal_input, vel_btTide, Nb, dt, & ! Apply half the refraction. do m=1,CS%nMode ; do fr=1,CS%nFreq - call refract(CS%En(:,:,:,fr,m), cn(:,:,m), CS%frequency(fr), 0.5*dt, G, US, CS%nAngle, CS%use_PPMang) + call refract(CS%En(:,:,:,fr,m), US%m_s_to_L_T*cn(:,:,m), CS%frequency(fr), 0.5*dt_in_T, & + G, US, CS%nAngle, CS%use_PPMang) enddo ; enddo ! Check for En<0 - for debugging, delete later @@ -267,7 +274,8 @@ subroutine propagate_int_tide(h, tv, cn, TKE_itidal_input, vel_btTide, Nb, dt, & ! Propagate the waves. do m=1,CS%NMode ; do fr=1,CS%Nfreq - call propagate(CS%En(:,:,:,fr,m), cn(:,:,m), CS%frequency(fr), dt, G, US, CS, CS%NAngle) + call propagate(CS%En(:,:,:,fr,m), US%m_s_to_L_T*cn(:,:,m), CS%frequency(fr), dt_in_T, & + G, US, CS, CS%NAngle) enddo ; enddo ! Check for En<0 - for debugging, delete later @@ -288,7 +296,8 @@ subroutine propagate_int_tide(h, tv, cn, TKE_itidal_input, vel_btTide, Nb, dt, & ! Apply the other half of the refraction. do m=1,CS%NMode ; do fr=1,CS%Nfreq - call refract(CS%En(:,:,:,fr,m), cn(:,:,m), CS%frequency(fr), 0.5*dt, G, US, CS%NAngle, CS%use_PPMang) + call refract(CS%En(:,:,:,fr,m), US%m_s_to_L_T*cn(:,:,m), CS%frequency(fr), 0.5*dt_in_T, & + G, US, CS%NAngle, CS%use_PPMang) enddo ; enddo ! Check for En<0 - for debugging, delete later @@ -378,14 +387,14 @@ subroutine propagate_int_tide(h, tv, cn, TKE_itidal_input, vel_btTide, Nb, dt, & if (CS%apply_wave_drag .or. CS%apply_Froude_drag) then do m=1,CS%NMode ; do fr=1,CS%Nfreq ! Calculate modal structure for given mode and frequency - call wave_structure(h, tv, G, GV, US, cn(:,:,m), m, CS%frequency(fr), & + call wave_structure(h, tv, G, GV, US, cn(:,:,m), m, US%s_to_T*CS%frequency(fr), & CS%wave_structure_CSp, tot_En_mode(:,:,fr,m), full_halos=.true.) ! Pick out near-bottom and max horizontal baroclinic velocity values at each point do j=jsd,jed ; do i=isd,ied id_g = i + G%idg_offset ; jd_g = j + G%jdg_offset ! for debugging nzm = CS%wave_structure_CSp%num_intfaces(i,j) - Ub(i,j,fr,m) = CS%wave_structure_CSp%Uavg_profile(i,j,nzm) - Umax(i,j,fr,m) = maxval(CS%wave_structure_CSp%Uavg_profile(i,j,1:nzm)) + Ub(i,j,fr,m) = US%m_s_to_L_T * CS%wave_structure_CSp%Uavg_profile(i,j,nzm) + Umax(i,j,fr,m) = US%m_s_to_L_T * maxval(CS%wave_structure_CSp%Uavg_profile(i,j,1:nzm)) enddo ; enddo ! i-loop, j-loop enddo ; enddo ! fr-loop, m-loop endif ! apply_wave or _Froude_drag (Ub or Umax needed) @@ -417,14 +426,14 @@ subroutine propagate_int_tide(h, tv, cn, TKE_itidal_input, vel_btTide, Nb, dt, & do j=jsd,jed ; do i=isd,ied id_g = i + G%idg_offset ; jd_g = j + G%jdg_offset ! for debugging ! Calculate horizontal phase velocity magnitudes - f2 = 0.25*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)) - Kmag2 = (freq2 - f2) / (cn(i,j,m)**2 + cn_subRO**2) + f2 = 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)) + Kmag2 = (freq2 - f2) / (US%m_s_to_L_T**2*cn(i,j,m)**2 + cn_subRO**2) c_phase = 0.0 if (Kmag2 > 0.0) then c_phase = sqrt(freq2/Kmag2) nzm = CS%wave_structure_CSp%num_intfaces(i,j) - Fr2_max = (Umax(i,j,fr,m)/c_phase)**2 + Fr2_max = (Umax(i,j,fr,m) / c_phase)**2 ! Dissipate energy if Fr>1; done here with an arbitrary time scale if (Fr2_max > 1.0) then En_initial = sum(CS%En(i,j,:,fr,m)) ! for debugging @@ -626,9 +635,9 @@ subroutine itidal_lowmode_loss(G, US, CS, Nb, Ub, En, TKE_loss_fixed, TKE_loss, intent(in) :: Nb !< Near-bottom stratification [s-1]. real, dimension(G%isd:G%ied,G%jsd:G%jed,CS%nFreq,CS%nMode), & intent(inout) :: Ub !< RMS (over one period) near-bottom horizontal - !! mode velocity [m s-1]. + !! mode velocity [L T-1 ~> m s-1]. real, dimension(G%isd:G%ied,G%jsd:G%jed), & - intent(in) :: TKE_loss_fixed !< Fixed part of energy loss [kg Z-2 ~> kg m-2] + intent(in) :: TKE_loss_fixed !< Fixed part of energy loss [kg m L-2 Z-1 ~> kg m-2] !! (rho*kappa*h^2). real, dimension(G%isd:G%ied,G%jsd:G%jed,CS%NAngle,CS%nFreq,CS%nMode), & intent(inout) :: En !< Energy density of the internal waves [J m-2]. @@ -666,7 +675,8 @@ subroutine itidal_lowmode_loss(G, US, CS, Nb, Ub, En, TKE_loss_fixed, TKE_loss, enddo ! Calculate TKE loss rate; units of [W m-2] here. - TKE_loss_tot = q_itides * US%Z_to_m**2 * TKE_loss_fixed(i,j) * Nb(i,j) * Ub(i,j,fr,m)**2 + TKE_loss_tot = q_itides * US%Z_to_m**3*US%s_to_T**3 * TKE_loss_fixed(i,j) * & + US%T_to_s*Nb(i,j) * Ub(i,j,fr,m)**2 ! Update energy remaining (this is a pseudo implicit calc) ! (E(t+1)-E(t))/dt = -TKE_loss(E(t+1)/E(t)), which goes to zero as E(t+1) goes to zero @@ -726,7 +736,7 @@ subroutine get_lowmode_loss(i,j,G,CS,mechanism,TKE_loss_sum) end subroutine get_lowmode_loss !> Implements refraction on the internal waves at a single frequency. -subroutine refract(En, cn, freq, dt, G, US, NAngle, use_PPMang) +subroutine refract(En, cn, freq, dt_in_T, G, US, NAngle, use_PPMang) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. integer, intent(in) :: NAngle !< The number of wave orientations in the !! discretized wave energy spectrum. @@ -735,9 +745,9 @@ subroutine refract(En, cn, freq, dt, G, US, NAngle, use_PPMang) !! function of space and angular resolution, !! [J m-2 radian-1]. real, dimension(G%isd:G%ied,G%jsd:G%jed), & - intent(in) :: cn !< Baroclinic mode speed [m s-1]. - real, intent(in) :: freq !< Wave frequency [s-1]. - real, intent(in) :: dt !< Time step [s]. + intent(in) :: cn !< Baroclinic mode speed [L T-1 ~> m s-1]. + real, intent(in) :: freq !< Wave frequency [T-1 ~> s-1]. + real, intent(in) :: dt_in_T !< Time step [T ~> s]. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type logical, intent(in) :: use_PPMang !< If true, use PPM for advection rather !! than upwind. @@ -753,15 +763,14 @@ subroutine refract(En, cn, freq, dt, G, US, NAngle, use_PPMang) Flux_E real, dimension(SZI_(G),SZJ_(G),1-stencil:NAngle+stencil) :: & CFL_ang - real :: f2 ! The squared Coriolis parameter [s-2]. - real :: favg ! The average Coriolis parameter at a point [s-1]. - real :: df2_dy, df2_dx ! The x- and y- gradients of the squared Coriolis parameter [s-2 m-1]. - real :: df_dy, df_dx ! The x- and y- gradients of the Coriolis parameter [s-1 m-1]. + real :: f2 ! The squared Coriolis parameter [T-2 ~> s-2]. + real :: favg ! The average Coriolis parameter at a point [T-1 ~> s-1]. + real :: df_dy, df_dx ! The x- and y- gradients of the Coriolis parameter [T-1 L-1 ~> s-1 m-1]. real :: dlnCn_dx ! The x-gradient of the wave speed divided by itself [m-1]. real :: dlnCn_dy ! The y-gradient of the wave speed divided by itself [m-1]. real :: Angle_size, dt_Angle_size, angle real :: Ifreq, Kmag2, I_Kmag - real, parameter :: cn_subRO = 1e-100 + real :: cn_subRO ! A tiny wave speed to prevent division by zero [L T-1 ~> m s-1] integer :: is, ie, js, je, asd, aed, na integer :: i, j, a @@ -769,9 +778,9 @@ subroutine refract(En, cn, freq, dt, G, US, NAngle, use_PPMang) asd = 1-stencil ; aed = NAngle+stencil Ifreq = 1.0 / freq - + cn_subRO = 1e-100*US%m_s_to_L_T ! The hard-coded value here might need to increase. Angle_size = (8.0*atan(1.0)) / (real(NAngle)) - dt_Angle_size = dt / Angle_size + dt_Angle_size = dt_in_T / Angle_size do A=asd,aed angle = (real(A) - 0.5) * Angle_size @@ -792,29 +801,21 @@ subroutine refract(En, cn, freq, dt, G, US, NAngle, use_PPMang) ! Do the refraction. do i=is,ie - f2 = 0.25*US%s_to_T**2 * ((G%CoriolisBu(I,J)**2 + G%CoriolisBu(I-1,J-1)**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)) - favg = 0.25*US%s_to_T*((G%CoriolisBu(I,J) + G%CoriolisBu(I-1,J-1)) + & - (G%CoriolisBu(I,J-1) + G%CoriolisBu(I-1,J))) - df2_dx = 0.5*US%m_to_L*US%s_to_T**2 * ((G%CoriolisBu(I,J)**2 + G%CoriolisBu(I,J-1)**2) - & - (G%CoriolisBu(I-1,J)**2 + G%CoriolisBu(I-1,J-1)**2)) * & - G%IdxT(i,j) - df_dx = 0.5*US%m_to_L*US%s_to_T*((G%CoriolisBu(I,J) + G%CoriolisBu(I,J-1)) - & - (G%CoriolisBu(I-1,J) + G%CoriolisBu(I-1,J-1))) * & - G%IdxT(i,j) - dlnCn_dx = 0.5*( US%m_to_L*G%IdxCu(I,j) * (cn(i+1,j) - cn(i,j)) / & + favg = 0.25*((G%CoriolisBu(I,J) + G%CoriolisBu(I-1,J-1)) + & + (G%CoriolisBu(I,J-1) + G%CoriolisBu(I-1,J))) + df_dx = 0.5*((G%CoriolisBu(I,J) + G%CoriolisBu(I,J-1)) - & + (G%CoriolisBu(I-1,J) + G%CoriolisBu(I-1,J-1))) * G%IdxT(i,j) + dlnCn_dx = 0.5*( G%IdxCu(I,j) * (cn(i+1,j) - cn(i,j)) / & (0.5*(cn(i+1,j) + cn(i,j)) + cn_subRO) + & - US%m_to_L*G%IdxCu(I-1,j) * (cn(i,j) - cn(i-1,j)) / & + G%IdxCu(I-1,j) * (cn(i,j) - cn(i-1,j)) / & (0.5*(cn(i,j) + cn(i-1,j)) + cn_subRO) ) - df2_dy = 0.5*US%m_to_L*US%s_to_T**2 * ((G%CoriolisBu(I,J)**2 + G%CoriolisBu(I-1,J)**2) - & - (G%CoriolisBu(I,J-1)**2 + G%CoriolisBu(I-1,J-1)**2)) * & - G%IdyT(i,j) - df_dy = 0.5*US%m_to_L*US%s_to_T*((G%CoriolisBu(I,J) + G%CoriolisBu(I-1,J)) - & - (G%CoriolisBu(I,J-1) + G%CoriolisBu(I-1,J-1))) * & - G%IdyT(i,j) - dlnCn_dy = 0.5*( US%m_to_L*G%IdyCv(i,J) * (cn(i,j+1) - cn(i,j)) / & + df_dy = 0.5*((G%CoriolisBu(I,J) + G%CoriolisBu(I-1,J)) - & + (G%CoriolisBu(I,J-1) + G%CoriolisBu(I-1,J-1))) * G%IdyT(i,j) + dlnCn_dy = 0.5*( G%IdyCv(i,J) * (cn(i,j+1) - cn(i,j)) / & (0.5*(cn(i,j+1) + cn(i,j)) + cn_subRO) + & - US%m_to_L*G%IdyCv(i,J-1) * (cn(i,j) - cn(i,j-1)) / & + G%IdyCv(i,J-1) * (cn(i,j) - cn(i,j-1)) / & (0.5*(cn(i,j) + cn(i,j-1)) + cn_subRO) ) Kmag2 = (freq**2 - f2) / (cn(i,j)**2 + cn_subRO**2) if (Kmag2 > 0.0) then @@ -829,8 +830,7 @@ subroutine refract(En, cn, freq, dt, G, US, NAngle, use_PPMang) ! Determine the energy fluxes in angular orientation space. do A=asd,aed ; do i=is,ie - CFL_ang(i,j,A) = (cos_angle(A) * Dl_Dt_Kmag(i) - sin_angle(A) * Dk_Dt_Kmag(i)) * & - dt_Angle_size + CFL_ang(i,j,A) = (cos_angle(A) * Dl_Dt_Kmag(i) - sin_angle(A) * Dk_Dt_Kmag(i)) * dt_Angle_size if (abs(CFL_ang(i,j,A)) > 1.0) then call MOM_error(WARNING, "refract: CFL exceeds 1.", .true.) if (CFL_ang(i,j,A) > 0.0) then ; CFL_ang(i,j,A) = 1.0 ; else ; CFL_ang(i,j,A) = -1.0 ; endif @@ -850,7 +850,7 @@ subroutine refract(En, cn, freq, dt, G, US, NAngle, use_PPMang) else ! Use PPM do i=is,ie - call PPM_angular_advect(En2d(i,:),CFL_ang(i,j,:),Flux_E(i,:),NAngle,dt,stencil) + call PPM_angular_advect(En2d(i,:),CFL_ang(i,j,:),Flux_E(i,:),NAngle,dt_in_T,stencil) enddo endif @@ -866,10 +866,10 @@ end subroutine refract !> This subroutine calculates the 1-d flux for advection in angular space using a monotonic !! piecewise parabolic scheme. This needs to be called from within i and j spatial loops. -subroutine PPM_angular_advect(En2d, CFL_ang, Flux_En, NAngle, dt, halo_ang) +subroutine PPM_angular_advect(En2d, CFL_ang, Flux_En, NAngle, dt_in_T, halo_ang) integer, intent(in) :: NAngle !< The number of wave orientations in the !! discretized wave energy spectrum. - real, intent(in) :: dt !< Time increment [s]. + real, intent(in) :: dt_in_T !< Time increment [T ~> s]. integer, intent(in) :: halo_ang !< The halo size in angular space real, dimension(1-halo_ang:NAngle+halo_ang), & intent(in) :: En2d !< The internal gravity wave energy density as a @@ -887,7 +887,7 @@ subroutine PPM_angular_advect(En2d, CFL_ang, Flux_En, NAngle, dt, halo_ang) integer :: a real :: aR, aL, dMx, dMn, Ep, Ec, Em, dA, mA, a6 - I_dt = 1 / dt + I_dt = 1 / dt_in_T Angle_size = (8.0*atan(1.0)) / (real(NAngle)) I_Angle_size = 1 / Angle_size Flux_En(:) = 0 @@ -916,7 +916,7 @@ subroutine PPM_angular_advect(En2d, CFL_ang, Flux_En, NAngle, dt, halo_ang) flux = u_ang*( aR + 0.5 * CFL_ang(A) * ( ( aL - aR ) + a6 * ( 1. - 2./3. * CFL_ang(A) ) ) ) !flux = u_ang*( aR - 0.5 * CFL_ang(A) * ( ( aR - aL ) - a6 * ( 1. - 2./3. * CFL_ang(A) ) ) ) ! CALCULATE AMOUNT FLUXED (Jm-2) - Flux_En(A) = dt * flux + Flux_En(A) = dt_in_T * flux !Flux_En(A) = (dt * I_Angle_size) * flux else ! Implementation of PPM-H3 @@ -940,14 +940,14 @@ subroutine PPM_angular_advect(En2d, CFL_ang, Flux_En, NAngle, dt, halo_ang) flux = u_ang*( aR + 0.5 * CFL_ang(A) * ( ( aL - aR ) + a6 * ( 1. - 2./3. * CFL_ang(A) ) ) ) !flux = u_ang*( aL + 0.5 * CFL_ang(A) * ( ( aR - aL ) + a6 * ( 1. - 2./3. * CFL_ang(A) ) ) ) ! CALCULATE AMOUNT FLUXED (Jm-2) - Flux_En(A) = dt * flux + Flux_En(A) = dt_in_T * flux !Flux_En(A) = (dt * I_Angle_size) * flux endif enddo end subroutine PPM_angular_advect !> Propagates internal waves at a single frequency. -subroutine propagate(En, cn, freq, dt, G, US, CS, NAngle) +subroutine propagate(En, cn, freq, dt_in_T, G, US, CS, NAngle) type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. integer, intent(in) :: NAngle !< The number of wave orientations in the !! discretized wave energy spectrum. @@ -956,28 +956,28 @@ subroutine propagate(En, cn, freq, dt, G, US, CS, NAngle) !! function of space and angular resolution, !! [J m-2 radian-1]. real, dimension(G%isd:G%ied,G%jsd:G%jed), & - intent(in) :: cn !< Baroclinic mode speed [m s-1]. - real, intent(in) :: freq !< Wave frequency [s-1]. - real, intent(in) :: dt !< Time step [s]. + intent(in) :: cn !< Baroclinic mode speed [L T-1 ~> m s-1]. + real, intent(in) :: freq !< Wave frequency [T-1 ~> s-1]. + real, intent(in) :: dt_in_T !< Time step [T ~> s]. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(int_tide_CS), pointer :: CS !< The control structure returned by a !! previous call to int_tide_init. ! Local variables real, dimension(G%IsdB:G%IedB,G%JsdB:G%JedB) :: & - speed ! The magnitude of the group velocity at the q points for corner adv [m s-1]. + speed ! The magnitude of the group velocity at the q points for corner adv [L T-1 ~> m s-1]. integer, parameter :: stencil = 2 real, dimension(SZIB_(G),SZJ_(G)) :: & - speed_x ! The magnitude of the group velocity at the Cu points [m s-1]. + speed_x ! The magnitude of the group velocity at the Cu points [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZJB_(G)) :: & - speed_y ! The magnitude of the group velocity at the Cv points [m s-1]. + speed_y ! The magnitude of the group velocity at the Cv points [L T-1 ~> m s-1]. real, dimension(0:NAngle) :: & cos_angle, sin_angle real, dimension(NAngle) :: & Cgx_av, Cgy_av, dCgx, dCgy real :: f2 ! The squared Coriolis parameter [s-2]. real :: Angle_size, I_Angle_size, angle - real :: Ifreq, freq2 - real, parameter :: cn_subRO = 1e-100 + real :: Ifreq ! The inverse of the frequency [T ~> s] + real :: freq2 ! The frequency squared [T-2 ~> s-2] type(loop_bounds_type) :: LB integer :: is, ie, js, je, asd, aed, na integer :: ish, ieh, jsh, jeh @@ -1010,14 +1010,14 @@ subroutine propagate(En, cn, freq, dt, G, US, CS, NAngle) ! Fix indexing here later speed(:,:) = 0 do J=jsh-1,jeh ; do I=ish-1,ieh - f2 = US%s_to_T**2 * G%CoriolisBu(I,J)**2 + f2 = G%CoriolisBu(I,J)**2 speed(I,J) = 0.25*(cn(i,j) + cn(i+1,j) + cn(i+1,j+1) + cn(i,j+1)) * & sqrt(max(freq2 - f2, 0.0)) * Ifreq enddo ; enddo do a=1,na ! Apply the propagation WITH CORNER ADVECTION/FINITE VOLUME APPROACH. LB%jsh = js ; LB%jeh = je ; LB%ish = is ; LB%ieh = ie - call propagate_corner_spread(En(:,:,a), a, NAngle, speed, dt, G, CS, LB) + call propagate_corner_spread(En(:,:,a), a, NAngle, speed, dt_in_T, G, CS, LB) enddo ! a-loop else ! IMPLEMENT PPM ADVECTION IN HORIZONTAL----------------------- @@ -1040,19 +1040,19 @@ subroutine propagate(En, cn, freq, dt, G, US, CS, NAngle) enddo do j=jsh,jeh ; do I=ish-1,ieh - f2 = 0.5*US%s_to_T**2 * (G%CoriolisBu(I,J)**2 + G%CoriolisBu(I,J-1)**2) + f2 = 0.5 * (G%CoriolisBu(I,J)**2 + G%CoriolisBu(I,J-1)**2) speed_x(I,j) = 0.5*(cn(i,j) + cn(i+1,j)) * G%mask2dCu(I,j) * & sqrt(max(freq2 - f2, 0.0)) * Ifreq enddo ; enddo do J=jsh-1,jeh ; do i=ish,ieh - f2 = 0.5*US%s_to_T**2 * (G%CoriolisBu(I,J)**2 + G%CoriolisBu(I-1,J)**2) + f2 = 0.5 * (G%CoriolisBu(I,J)**2 + G%CoriolisBu(I-1,J)**2) speed_y(i,J) = 0.5*(cn(i,j) + cn(i,j+1)) * G%mask2dCv(i,J) * & sqrt(max(freq2 - f2, 0.0)) * Ifreq enddo ; enddo ! Apply propagation in x-direction (reflection included) LB%jsh = jsh ; LB%jeh = jeh ; LB%ish = ish ; LB%ieh = ieh - call propagate_x(En(:,:,:), speed_x, Cgx_av(:), dCgx(:), dt, G, US, CS%nAngle, CS, LB) + call propagate_x(En(:,:,:), speed_x, Cgx_av(:), dCgx(:), dt_in_T, G, US, CS%nAngle, CS, LB) ! Check for energy conservation on computational domain (for debugging) !call sum_En(G,CS,En(:,:,:),'post-propagate_x') @@ -1063,29 +1063,29 @@ subroutine propagate(En, cn, freq, dt, G, US, CS, NAngle) ! Apply propagation in y-direction (reflection included) ! LB%jsh = js ; LB%jeh = je ; LB%ish = is ; LB%ieh = ie ! Use if no teleport LB%jsh = jsh ; LB%jeh = jeh ; LB%ish = ish ; LB%ieh = ieh - call propagate_y(En(:,:,:), speed_y, Cgy_av(:), dCgy(:), dt, G, US, CS%nAngle, CS, LB) + call propagate_y(En(:,:,:), speed_y, Cgy_av(:), dCgy(:), dt_in_T, G, US, CS%nAngle, CS, LB) ! Check for energy conservation on computational domain (for debugging) !call sum_En(G,CS,En(:,:,:),'post-propagate_y') - endif + end subroutine propagate !> This subroutine does first-order corner advection. It was written with the hopes !! of smoothing out the garden sprinkler effect, but is too numerically diffusive to !! be of much use as of yet. It is not yet compatible with reflection schemes (BDM). -subroutine propagate_corner_spread(En, energized_wedge, NAngle, speed, dt, G, CS, LB) +subroutine propagate_corner_spread(En, energized_wedge, NAngle, speed, dt_in_T, G, CS, LB) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. real, dimension(G%isd:G%ied,G%jsd:G%jed), & intent(inout) :: En !< The energy density integrated over an angular !! band [W m-2], intent in/out. real, dimension(G%IsdB:G%IedB,G%Jsd:G%Jed), & intent(in) :: speed !< The magnitude of the group velocity at the cell - !! corner points [m s-1]. + !! corner points [L T-1 ~> m s-1]. integer, intent(in) :: energized_wedge !< Index of current ray direction. integer, intent(in) :: NAngle !< The number of wave orientations in the !! discretized wave energy spectrum. - real, intent(in) :: dt !< Time increment [s]. + real, intent(in) :: dt_in_T !< Time increment [T ~> s]. type(int_tide_CS), pointer :: CS !< The control structure returned by a previous !! call to continuity_PPM_init. type(loop_bounds_type), intent(in) :: LB !< A structure with the active energy loop bounds. @@ -1123,12 +1123,16 @@ subroutine propagate_corner_spread(En, energized_wedge, NAngle, speed, dt, G, CS energized_angle = Angle_size * real(energized_wedge - 1) ! for a=1 aligned with x-axis !energized_angle = Angle_size * real(energized_wedge - 1) + 2.0*Angle_size ! !energized_angle = Angle_size * real(energized_wedge - 1) + 0.5*Angle_size ! - x = G%geoLonBu - y = G%geoLatBu - Idx = G%US%m_to_L*G%IdxBu ; dx = G%US%L_to_m*G%dxBu - Idy = G%US%m_to_L*G%IdyBu ; dy = G%US%L_to_m*G%dyBu + do J=jsh-1,jeh ; do I=ish-1,ieh + ! This will only work for a Cartesian grid for which G%geoLonBu is in the same units has dx. + ! This needs to be extensively revised to work for a general grid. + x(I,J) = G%US%m_to_L*G%geoLonBu(I,J) + y(I,J) = G%US%m_to_L*G%geoLatBu(I,J) + Idx(I,J) = G%IdxBu(I,J) ; dx(I,J) = G%dxBu(I,J) + Idy(I,J) = G%IdyBu(I,J) ; dy(I,J) = G%dyBu(I,J) + enddo ; enddo - do j=jsh,jeh; do i=ish,ieh + do j=jsh,jeh ; do i=ish,ieh do m=1,int(Nsubrays) theta = energized_angle - 0.5*Angle_size + real(m - 1)*Angle_size*I_Nsubwedges if (theta < 0.0) then @@ -1136,8 +1140,8 @@ subroutine propagate_corner_spread(En, energized_wedge, NAngle, speed, dt, G, CS elseif (theta > TwoPi) then theta = theta - TwoPi endif - cos_thetaDT = cos(theta)*dt - sin_thetaDT = sin(theta)*dt + cos_thetaDT = cos(theta)*dt_in_T + sin_thetaDT = sin(theta)*dt_in_T ! corner point coordinates of advected fluid parcel ---------- xg = x(I,J); yg = y(I,J) @@ -1335,7 +1339,7 @@ subroutine propagate_corner_spread(En, energized_wedge, NAngle, speed, dt, G, CS end subroutine propagate_corner_spread !> Propagates the internal wave energy in the logical x-direction. -subroutine propagate_x(En, speed_x, Cgx_av, dCgx, dt, G, US, Nangle, CS, LB) +subroutine propagate_x(En, speed_x, Cgx_av, dCgx, dt_in_T, G, US, Nangle, CS, LB) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. integer, intent(in) :: NAngle !< The number of wave orientations in the !! discretized wave energy spectrum. @@ -1344,11 +1348,11 @@ subroutine propagate_x(En, speed_x, Cgx_av, dCgx, dt, G, US, Nangle, CS, LB) !! band [J m-2], intent in/out. real, dimension(G%IsdB:G%IedB,G%jsd:G%jed), & intent(in) :: speed_x !< The magnitude of the group velocity at the - !! Cu points [m s-1]. + !! Cu points [L T-1 ~> m s-1]. real, dimension(Nangle), intent(in) :: Cgx_av !< The average x-projection in each angular band. real, dimension(Nangle), intent(in) :: dCgx !< The difference in x-projections between the !! edges of each angular band. - real, intent(in) :: dt !< Time increment [s]. + real, intent(in) :: dt_in_T !< Time increment [T ~> s]. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(int_tide_CS), pointer :: CS !< The control structure returned by a previous call !! to continuity_PPM_init. @@ -1382,25 +1386,19 @@ subroutine propagate_x(En, speed_x, Cgx_av, dCgx, dt, G, US, Nangle, CS, LB) cg_p(I) = speed_x(I,j) * (Cgx_av(a)) enddo call zonal_flux_En(cg_p, En(:,j,a), EnL(:,j), EnR(:,j), flux1, & - dt, G, US, j, ish, ieh, CS%vol_CFL) + dt_in_T, G, US, j, ish, ieh, CS%vol_CFL) do I=ish-1,ieh ; flux_x(I,j) = flux1(I); enddo enddo do j=jsh,jeh ; do i=ish,ieh - Fdt_m(i,j,a) = dt*flux_x(I-1,j) ! left face influx (J) - Fdt_p(i,j,a) = -dt*flux_x(I,j) ! right face influx (J) + Fdt_m(i,j,a) = dt_in_T*flux_x(I-1,j) ! left face influx (J) + Fdt_p(i,j,a) = -dt_in_T*flux_x(I,j) ! right face influx (J) enddo ; enddo - ! test with old (take out later) - !do j=LB%jsh,LB%jeh ; do i=LB%ish,LB%ieh - ! En(i,j,a) = En(i,j,a) - dt* US%m_to_L**2*G%IareaT(i,j) * (flux_x(I,j) - flux_x(I-1,j)) - !enddo ; enddo - enddo ! a-loop - ! Only reflect newly arrived energy; existing energy in incident wedge - ! is not reflected and will eventually propagate out of cell. - ! (only reflects if En > 0) + ! Only reflect newly arrived energy; existing energy in incident wedge is not reflected + ! and will eventually propagate out of cell. (Thid code only reflects if En > 0) call reflect(Fdt_m(:,:,:), Nangle, CS, G, LB) call teleport(Fdt_m(:,:,:), Nangle, CS, G, LB) call reflect(Fdt_p(:,:,:), Nangle, CS, G, LB) @@ -1408,18 +1406,15 @@ subroutine propagate_x(En, speed_x, Cgx_av, dCgx, dt, G, US, Nangle, CS, LB) ! Update reflected energy (Jm-2) do j=jsh,jeh ; do i=ish,ieh - !do a=1,CS%nAngle - ! if ((En(i,j,a) + US%m_to_L**2*G%IareaT(i,j)*(Fdt_m(i,j,a) + Fdt_p(i,j,a))) < 0.0) then ! for debugging + ! if ((En(i,j,a) + G%IareaT(i,j)*(Fdt_m(i,j,a) + Fdt_p(i,j,a))) < 0.0) & ! for debugging ! call MOM_error(FATAL, "propagate_x: OutFlux>Available") - ! endif - !enddo - En(i,j,:) = En(i,j,:) + US%m_to_L**2*G%IareaT(i,j)*(Fdt_m(i,j,:) + Fdt_p(i,j,:)) + En(i,j,:) = En(i,j,:) + G%IareaT(i,j)*(Fdt_m(i,j,:) + Fdt_p(i,j,:)) enddo ; enddo end subroutine propagate_x !> Propagates the internal wave energy in the logical y-direction. -subroutine propagate_y(En, speed_y, Cgy_av, dCgy, dt, G, US, Nangle, CS, LB) +subroutine propagate_y(En, speed_y, Cgy_av, dCgy, dt_in_T, G, US, Nangle, CS, LB) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. integer, intent(in) :: NAngle !< The number of wave orientations in the !! discretized wave energy spectrum. @@ -1428,11 +1423,11 @@ subroutine propagate_y(En, speed_y, Cgy_av, dCgy, dt, G, US, Nangle, CS, LB) !! band [J m-2], intent in/out. real, dimension(G%isd:G%ied,G%JsdB:G%JedB), & intent(in) :: speed_y !< The magnitude of the group velocity at the - !! Cv points [m s-1]. + !! Cv points [L T-1 ~> m s-1]. real, dimension(Nangle), intent(in) :: Cgy_av !< The average y-projection in each angular band. real, dimension(Nangle), intent(in) :: dCgy !< The difference in y-projections between the !! edges of each angular band. - real, intent(in) :: dt !< Time increment [s]. + real, intent(in) :: dt_in_T !< Time increment [T ~> s]. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(int_tide_CS), pointer :: CS !< The control structure returned by a previous call !! to continuity_PPM_init. @@ -1467,14 +1462,14 @@ subroutine propagate_y(En, speed_y, Cgy_av, dCgy, dt, G, US, Nangle, CS, LB) cg_p(i) = speed_y(i,J) * (Cgy_av(a)) enddo call merid_flux_En(cg_p, En(:,:,a), EnL(:,:), EnR(:,:), flux1, & - dt, G, US, J, ish, ieh, CS%vol_CFL) + dt_in_T, G, US, J, ish, ieh, CS%vol_CFL) do i=ish,ieh ; flux_y(i,J) = flux1(i); enddo enddo do j=jsh,jeh ; do i=ish,ieh - Fdt_m(i,j,a) = dt*flux_y(i,J-1) ! south face influx (J) - Fdt_p(i,j,a) = -dt*flux_y(i,J) ! north face influx (J) - !if ((En(i,j,a) + US%m_to_L**2*G%IareaT(i,j)*(Fdt_m(i,j,a) + Fdt_p(i,j,a))) < 0.0)then ! for debugging + Fdt_m(i,j,a) = dt_in_T*flux_y(i,J-1) ! south face influx (J) + Fdt_p(i,j,a) = -dt_in_T*flux_y(i,J) ! north face influx (J) + !if ((En(i,j,a) + G%IareaT(i,j)*(Fdt_m(i,j,a) + Fdt_p(i,j,a))) < 0.0) then ! for debugging ! call MOM_error(WARNING, "propagate_y: OutFlux>Available prior to reflection", .true.) ! write(mesg,*) "flux_y_south=",flux_y(i,J-1),"flux_y_north=",flux_y(i,J),"En=",En(i,j,a), & ! "cn_south=", speed_y(i,J-1) * (Cgy_av(a)), "cn_north=", speed_y(i,J) * (Cgy_av(a)) @@ -1482,45 +1477,36 @@ subroutine propagate_y(En, speed_y, Cgy_av, dCgy, dt, G, US, Nangle, CS, LB) !endif enddo ; enddo - ! test with old (take out later) - !do j=jsh,jeh ; do i=ish,ieh - ! En(i,j,a) = En(i,j,a) - dt* US%m_to_L**2*G%IareaT(i,j) * (flux_y(i,J) - flux_y(i,J-1)) - !enddo ; enddo - enddo ! a-loop - ! Only reflect newly arrived energy; existing energy in incident wedge - ! is not reflected and will eventually propagate out of cell. - ! (only reflects if En > 0) + ! Only reflect newly arrived energy; existing energy in incident wedge is not reflected + ! and will eventually propagate out of cell. (Thid code only reflects if En > 0) call reflect(Fdt_m(:,:,:), Nangle, CS, G, LB) call teleport(Fdt_m(:,:,:), Nangle, CS, G, LB) call reflect(Fdt_p(:,:,:), Nangle, CS, G, LB) call teleport(Fdt_p(:,:,:), Nangle, CS, G, LB) ! Update reflected energy (Jm-2) - do j=jsh,jeh ; do i=ish,ieh - !do a=1,CS%nAngle - ! if ((En(i,j,a) + US%m_to_L**2*G%IareaT(i,j)*(Fdt_m(i,j,a) + Fdt_p(i,j,a))) < 0.0)then ! for debugging + do a=1,Nangle ; do j=jsh,jeh ; do i=ish,ieh + ! if ((En(i,j,a) + G%IareaT(i,j)*(Fdt_m(i,j,a) + Fdt_p(i,j,a))) < 0.0) & ! for debugging ! call MOM_error(FATAL, "propagate_y: OutFlux>Available", .true.) - ! endif - !enddo - En(i,j,:) = En(i,j,:) + US%m_to_L**2*G%IareaT(i,j)*(Fdt_m(i,j,:) + Fdt_p(i,j,:)) - enddo ; enddo + En(i,j,a) = En(i,j,a) + G%IareaT(i,j)*(Fdt_m(i,j,a) + Fdt_p(i,j,a)) + enddo ; enddo ; enddo end subroutine propagate_y !> Evaluates the zonal mass or volume fluxes in a layer. subroutine zonal_flux_En(u, h, hL, hR, uh, dt, G, US, j, ish, ieh, vol_CFL) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. - real, dimension(SZIB_(G)), intent(in) :: u !< The zonal velocity [m s-1]. + real, dimension(SZIB_(G)), intent(in) :: u !< The zonal velocity [L T-1 ~> m s-1]. real, dimension(SZI_(G)), intent(in) :: h !< Energy density used to calculate the fluxes !! [J m-2]. real, dimension(SZI_(G)), intent(in) :: hL !< Left- Energy densities in the reconstruction !! [J m-2]. real, dimension(SZI_(G)), intent(in) :: hR !< Right- Energy densities in the reconstruction !! [J m-2]. - real, dimension(SZIB_(G)), intent(inout) :: uh !< The zonal energy transport [J s-1]. - real, intent(in) :: dt !< Time increment [s]. + real, dimension(SZIB_(G)), intent(inout) :: uh !< The zonal energy transport [L2 T-1 J m-2 ~> J s-1]. + real, intent(in) :: dt !< Time increment [T ~> s]. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type integer, intent(in) :: j !< The j-index to work on. integer, intent(in) :: ish !< The start i-index range to work on. @@ -1536,16 +1522,16 @@ subroutine zonal_flux_En(u, h, hL, hR, uh, dt, G, US, j, ish, ieh, vol_CFL) do I=ish-1,ieh ! Set new values of uh and duhdu. if (u(I) > 0.0) then - if (vol_CFL) then ; CFL = (u(I) * dt) * (G%dy_Cu(I,j) * US%m_to_L*G%IareaT(i,j)) - else ; CFL = u(I) * dt * US%m_to_L*G%IdxT(i,j) ; endif + if (vol_CFL) then ; CFL = (u(I) * dt) * (G%dy_Cu(I,j) * G%IareaT(i,j)) + else ; CFL = u(I) * dt * G%IdxT(i,j) ; endif curv_3 = (hL(i) + hR(i)) - 2.0*h(i) - uh(I) = US%L_to_m*G%dy_Cu(I,j) * u(I) * & + uh(I) = G%dy_Cu(I,j) * u(I) * & (hR(i) + CFL * (0.5*(hL(i) - hR(i)) + curv_3*(CFL - 1.5))) elseif (u(I) < 0.0) then - if (vol_CFL) then ; CFL = (-u(I) * dt) * (G%dy_Cu(I,j) * US%m_to_L*G%IareaT(i+1,j)) - else ; CFL = -u(I) * dt * US%m_to_L*G%IdxT(i+1,j) ; endif + if (vol_CFL) then ; CFL = (-u(I) * dt) * (G%dy_Cu(I,j) * G%IareaT(i+1,j)) + else ; CFL = -u(I) * dt * G%IdxT(i+1,j) ; endif curv_3 = (hL(i+1) + hR(i+1)) - 2.0*h(i+1) - uh(I) = US%L_to_m*G%dy_Cu(I,j) * u(I) * & + uh(I) = G%dy_Cu(I,j) * u(I) * & (hL(i+1) + CFL * (0.5*(hR(i+1)-hL(i+1)) + curv_3*(CFL - 1.5))) else uh(I) = 0.0 @@ -1556,15 +1542,15 @@ end subroutine zonal_flux_En !> Evaluates the meridional mass or volume fluxes in a layer. subroutine merid_flux_En(v, h, hL, hR, vh, dt, G, US, J, ish, ieh, vol_CFL) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. - real, dimension(SZI_(G)), intent(in) :: v !< The meridional velocity [m s-1]. + real, dimension(SZI_(G)), intent(in) :: v !< The meridional velocity [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZJ_(G)), intent(in) :: h !< Energy density used to calculate the !! fluxes [J m-2]. real, dimension(SZI_(G),SZJ_(G)), intent(in) :: hL !< Left- Energy densities in the !! reconstruction [J m-2]. real, dimension(SZI_(G),SZJ_(G)), intent(in) :: hR !< Right- Energy densities in the !! reconstruction [J m-2]. - real, dimension(SZI_(G)), intent(inout) :: vh !< The meridional energy transport [J s-1]. - real, intent(in) :: dt !< Time increment [s]. + real, dimension(SZI_(G)), intent(inout) :: vh !< The meridional energy transport [L2 T-1 J m-2 ~> J s-1]. + real, intent(in) :: dt !< Time increment [T ~> s]. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type integer, intent(in) :: J !< The j-index to work on. integer, intent(in) :: ish !< The start i-index range to work on. @@ -1580,16 +1566,16 @@ subroutine merid_flux_En(v, h, hL, hR, vh, dt, G, US, J, ish, ieh, vol_CFL) do i=ish,ieh if (v(i) > 0.0) then - if (vol_CFL) then ; CFL = (v(i) * dt) * (G%dx_Cv(i,J) * US%m_to_L*G%IareaT(i,j)) - else ; CFL = v(i) * dt * US%m_to_L*G%IdyT(i,j) ; endif + if (vol_CFL) then ; CFL = (v(i) * dt) * (G%dx_Cv(i,J) * G%IareaT(i,j)) + else ; CFL = v(i) * dt * G%IdyT(i,j) ; endif curv_3 = hL(i,j) + hR(i,j) - 2.0*h(i,j) - vh(i) = US%L_to_m*G%dx_Cv(i,J) * v(i) * ( hR(i,j) + CFL * & + vh(i) = G%dx_Cv(i,J) * v(i) * ( hR(i,j) + CFL * & (0.5*(hL(i,j) - hR(i,j)) + curv_3*(CFL - 1.5)) ) elseif (v(i) < 0.0) then - if (vol_CFL) then ; CFL = (-v(i) * dt) * (G%dx_Cv(i,J) * US%m_to_L*G%IareaT(i,j+1)) - else ; CFL = -v(i) * dt * US%m_to_L*G%IdyT(i,j+1) ; endif + if (vol_CFL) then ; CFL = (-v(i) * dt) * (G%dx_Cv(i,J) * G%IareaT(i,j+1)) + else ; CFL = -v(i) * dt * G%IdyT(i,j+1) ; endif curv_3 = hL(i,j+1) + hR(i,j+1) - 2.0*h(i,j+1) - vh(i) = US%L_to_m*G%dx_Cv(i,J) * v(i) * ( hL(i,j+1) + CFL * & + vh(i) = G%dx_Cv(i,J) * v(i) * ( hL(i,j+1) + CFL * & (0.5*(hR(i,j+1)-hL(i,j+1)) + curv_3*(CFL - 1.5)) ) else vh(i) = 0.0 @@ -2126,7 +2112,8 @@ subroutine internal_tides_init(Time, G, GV, US, param_file, diag, CS) ! array for temporary storage of flags ! of cells with double-reflecting ridges logical :: use_int_tides, use_temperature - integer :: num_angle, num_freq, num_mode, m, fr, period_1 + real :: period_1 ! The period of the gravest modeled mode [T ~> s] + integer :: num_angle, num_freq, num_mode, m, fr integer :: isd, ied, jsd, jed, a, id_ang, i, j type(axes_grp) :: axes_ang ! This include declares and sets the variable "version". @@ -2180,7 +2167,7 @@ subroutine internal_tides_init(Time, G, GV, US, param_file, diag, CS) ! Allocate and populate frequency array (each a multiple of first for now) allocate(CS%frequency(num_freq)) - call read_param(param_file, "FIRST_MODE_PERIOD", period_1); ! ADDED BDM + call get_param(param_file, mdl, "FIRST_MODE_PERIOD", period_1, units="s", scale=US%s_to_T) do fr=1,num_freq CS%frequency(fr) = (8.0*atan(1.0) * (real(fr)) / period_1) ! ADDED BDM enddo @@ -2284,7 +2271,7 @@ subroutine internal_tides_init(Time, G, GV, US, param_file, diag, CS) call get_param(param_file, mdl, "KAPPA_ITIDES", kappa_itides, & "A topographic wavenumber used with INT_TIDE_DISSIPATION. "//& "The default is 2pi/10 km, as in St.Laurent et al. 2002.", & - units="m-1", default=8.e-4*atan(1.0)) + units="m-1", default=8.e-4*atan(1.0), scale=US%L_to_m) call get_param(param_file, mdl, "KAPPA_H2_FACTOR", kappa_h2_factor, & "A scaling factor for the roughness amplitude with n"//& "INT_TIDE_DISSIPATION.", units="nondim", default=1.0) @@ -2319,8 +2306,7 @@ subroutine internal_tides_init(Time, G, GV, US, param_file, diag, CS) h2(i,j) = min(0.01*(G%bathyT(i,j))**2, h2(i,j)) ! Compute the fixed part; units are [kg m-2] here ! will be multiplied by N and En to get into [W m-2] - CS%TKE_itidal_loss_fixed(i,j) = 0.5*kappa_h2_factor*GV%Rho0*& - kappa_itides * h2(i,j) + CS%TKE_itidal_loss_fixed(i,j) = 0.5*kappa_h2_factor*GV%Rho0 * US%L_to_Z*kappa_itides * h2(i,j) enddo ; enddo deallocate(h2) @@ -2510,14 +2496,14 @@ subroutine internal_tides_init(Time, G, GV, US, param_file, diag, CS) write(var_name, '("Itide_Ub_freq",i1,"_mode",i1)') fr, m write(var_descript, '("Near-bottom horizonal velocity for frequency ",i1," mode ",i1)') fr, m CS%id_Ub_mode(fr,m) = register_diag_field('ocean_model', var_name, & - diag%axesT1, Time, var_descript, 'm s-1') + diag%axesT1, Time, var_descript, 'm s-1', conversion=US%L_T_to_m_s) call MOM_mesg("Registering "//trim(var_name)//", Described as: "//var_descript, 5) ! Register 2-D horizonal phase velocity for each freq and mode write(var_name, '("Itide_cp_freq",i1,"_mode",i1)') fr, m write(var_descript, '("Horizonal phase velocity for frequency ",i1," mode ",i1)') fr, m CS%id_cp_mode(fr,m) = register_diag_field('ocean_model', var_name, & - diag%axesT1, Time, var_descript, 'm s-1') + diag%axesT1, Time, var_descript, 'm s-1', conversion=US%L_T_to_m_s) call MOM_mesg("Registering "//trim(var_name)//", Described as: "//var_descript, 5) enddo ; enddo From 58cf1a949af92ee42f96aa940e1155a1fa5081bf Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sun, 11 Aug 2019 10:52:07 -0400 Subject: [PATCH 188/297] +Rescaled CDp%uhGM diagnostics to [H L2 T-1] Rescalded the CDp%uhGM and CDp%vhGM diagnostic arrays to units of [H L2 T-1] and added simplifying conversion factors to several diagnostics. Also the diffusivities returned by thickness_diffuse_get_KH are now being given in units of [L2 T-1]. All answers are bitwise identical. --- src/core/MOM_variables.F90 | 12 ++++----- src/diagnostics/MOM_diagnostics.F90 | 26 +++++++++---------- .../lateral/MOM_hor_visc.F90 | 4 +-- .../lateral/MOM_thickness_diffuse.F90 | 20 +++++++------- 4 files changed, 31 insertions(+), 31 deletions(-) diff --git a/src/core/MOM_variables.F90 b/src/core/MOM_variables.F90 index 5ee7cd9056..fc5118a448 100644 --- a/src/core/MOM_variables.F90 +++ b/src/core/MOM_variables.F90 @@ -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-1 T-1 ~> m s-2] - diffv => NULL(), & !< Meridional acceleration due to along isopycnal viscosity [m s-1 T-1 ~> m s-2] + diffu => NULL(), & !< Zonal acceleration due to along isopycnal viscosity [L T-2 ~> m s-2] + diffv => NULL(), & !< Meridional acceleration due to along isopycnal viscosity [L T-2 ~> m s-2] CAu => NULL(), & !< Zonal Coriolis and momentum advection accelerations [L T-2 ~> m s-2] CAv => NULL(), & !< Meridional Coriolis and momentum advection accelerations [L T-2 ~> m s-2] PFu => NULL(), & !< Zonal acceleration due to pressure forces [L T-2 ~> m s-2] @@ -186,10 +186,10 @@ module MOM_variables ! Each of the following fields has nz layers. real, pointer, dimension(:,:,:) :: & - uh => NULL(), & !< Resolved zonal layer thickness fluxes, [H m2 s-1 ~> m3 s-1 or kg s-1] - vh => NULL(), & !< Resolved meridional layer thickness fluxes, [H m2 s-1 ~> m3 s-1 or kg s-1] - uhGM => NULL(), & !< Isopycnal height diffusion induced zonal volume fluxes [H m2 s-1 ~> m3 s-1 or kg s-1] - vhGM => NULL() !< Isopycnal height diffusion induced meridional volume fluxes [H m2 s-1 ~> m3 s-1 or kg s-1] + uh => NULL(), & !< Resolved zonal layer thickness fluxes, [H L2 T-1 ~> m3 s-1 or kg s-1] + vh => NULL(), & !< Resolved meridional layer thickness fluxes, [H L2 T-1 ~> m3 s-1 or kg s-1] + uhGM => NULL(), & !< Isopycnal height diffusion induced zonal volume fluxes [H L2 T-1 ~> m3 s-1 or kg s-1] + vhGM => NULL() !< Isopycnal height diffusion induced meridional volume fluxes [H L2 T-1 ~> m3 s-1 or kg s-1] ! Each of the following fields is found at nz+1 interfaces. real, pointer :: diapyc_vel(:,:,:) => NULL() !< The net diapycnal velocity [H s-1 ~> m s-1 or kg m-2 s-1] diff --git a/src/diagnostics/MOM_diagnostics.F90 b/src/diagnostics/MOM_diagnostics.F90 index eef2955ee0..211e8d7741 100644 --- a/src/diagnostics/MOM_diagnostics.F90 +++ b/src/diagnostics/MOM_diagnostics.F90 @@ -506,13 +506,13 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & CS%uh_Rlay(I,j,k) = 0.0 enddo ; enddo do k=nkmb+1,nz ; do I=Isq,Ieq - CS%uh_Rlay(I,j,k) = US%L_to_m**2*US%s_to_T*uh(I,j,k) + CS%uh_Rlay(I,j,k) = uh(I,j,k) enddo ; enddo k_list = nz/2 do k=1,nkmb ; do I=Isq,Ieq call find_weights(GV%Rlay, 0.5*(Rcv(i,j,k)+Rcv(i+1,j,k)), k_list, nz, wt, wt_p) - CS%uh_Rlay(I,j,k_list) = CS%uh_Rlay(I,j,k_list) + US%L_to_m**2*US%s_to_T*uh(I,j,k)*wt - CS%uh_Rlay(I,j,k_list+1) = CS%uh_Rlay(I,j,k_list+1) + US%L_to_m**2*US%s_to_T*uh(I,j,k)*wt_p + CS%uh_Rlay(I,j,k_list) = CS%uh_Rlay(I,j,k_list) + uh(I,j,k)*wt + CS%uh_Rlay(I,j,k_list+1) = CS%uh_Rlay(I,j,k_list+1) + uh(I,j,k)*wt_p enddo ; enddo enddo @@ -528,12 +528,12 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & CS%vh_Rlay(i,J,k) = 0.0 enddo ; enddo do k=nkmb+1,nz ; do i=is,ie - CS%vh_Rlay(i,J,k) = US%L_to_m**2*US%s_to_T*vh(i,J,k) + CS%vh_Rlay(i,J,k) = vh(i,J,k) enddo ; enddo do k=1,nkmb ; do i=is,ie call find_weights(GV%Rlay, 0.5*(Rcv(i,j,k)+Rcv(i,j+1,k)), k_list, nz, wt, wt_p) - CS%vh_Rlay(i,J,k_list) = CS%vh_Rlay(i,J,k_list) + US%L_to_m**2*US%s_to_T*vh(i,J,k)*wt - CS%vh_Rlay(i,J,k_list+1) = CS%vh_Rlay(i,J,k_list+1) + US%L_to_m**2*US%s_to_T*vh(i,J,k)*wt_p + CS%vh_Rlay(i,J,k_list) = CS%vh_Rlay(i,J,k_list) + vh(i,J,k)*wt + CS%vh_Rlay(i,J,k_list+1) = CS%vh_Rlay(i,J,k_list+1) + vh(i,J,k)*wt_p enddo ; enddo enddo @@ -558,7 +558,7 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & enddo ; enddo enddo - if (CS%id_uh_Rlay > 0) call post_data(CS%id_uhGM_Rlay, CS%uhGM_Rlay, CS%diag) + if (CS%id_uhGM_Rlay > 0) call post_data(CS%id_uhGM_Rlay, CS%uhGM_Rlay, CS%diag) endif if (associated(CS%vhGM_Rlay) .and. associated(CDp%vhGM)) then @@ -1603,22 +1603,22 @@ subroutine MOM_diagnostics_init(MIS, ADp, CDp, Time, G, GV, US, param_file, diag CS%id_uh_Rlay = register_diag_field('ocean_model', 'uh_rho', diag%axesCuL, Time, & 'Zonal volume transport in pure potential density coordinates', flux_units, & - conversion=convert_H) + conversion=US%L_to_m**2*US%s_to_T*convert_H) if (CS%id_uh_Rlay>0) call safe_alloc_ptr(CS%uh_Rlay,IsdB,IedB,jsd,jed,nz) CS%id_vh_Rlay = register_diag_field('ocean_model', 'vh_rho', diag%axesCvL, Time, & 'Meridional volume transport in pure potential density coordinates', flux_units, & - conversion=convert_H) + conversion=US%L_to_m**2*US%s_to_T*convert_H) if (CS%id_vh_Rlay>0) call safe_alloc_ptr(CS%vh_Rlay,isd,ied,JsdB,JedB,nz) CS%id_uhGM_Rlay = register_diag_field('ocean_model', 'uhGM_rho', diag%axesCuL, Time, & - 'Zonal volume transport due to interface height diffusion in pure potential & - &density coordinates', flux_units, conversion=convert_H) + 'Zonal volume transport due to interface height diffusion in pure potential '//& + 'density coordinates', flux_units, conversion=US%L_to_m**2*US%s_to_T*convert_H) if (CS%id_uhGM_Rlay>0) call safe_alloc_ptr(CS%uhGM_Rlay,IsdB,IedB,jsd,jed,nz) CS%id_vhGM_Rlay = register_diag_field('ocean_model', 'vhGM_rho', diag%axesCvL, Time, & - 'Meridional volume transport due to interface height diffusion in pure & - &potential density coordinates', flux_units, conversion=convert_H) + 'Meridional volume transport due to interface height diffusion in pure potential '//& + 'density coordinates', flux_units, conversion=US%L_to_m**2*US%s_to_T*convert_H) if (CS%id_vhGM_Rlay>0) call safe_alloc_ptr(CS%vhGM_Rlay,isd,ied,JsdB,JedB,nz) !endif diff --git a/src/parameterizations/lateral/MOM_hor_visc.F90 b/src/parameterizations/lateral/MOM_hor_visc.F90 index 29b050b148..1fc98f111a 100644 --- a/src/parameterizations/lateral/MOM_hor_visc.F90 +++ b/src/parameterizations/lateral/MOM_hor_visc.F90 @@ -295,9 +295,9 @@ subroutine horizontal_viscosity(u_in, v_in, h, diffu, diffv, MEKE, VarMix, G, GV ! 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] + ! KH_u_GME !< interface height diffusivities in u-columns [L2 T-1 ~> m2 s-1] ! real, dimension(SZI_(G),SZJB_(G),SZK_(G)+1) :: & - ! KH_v_GME !< interface height diffusivities in v-columns [m2 s-1] + ! KH_v_GME !< interface height diffusivities in v-columns [L2 T-1 ~> m2 s-1] real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: & Ah_h, & ! biharmonic viscosity at thickness points [L4 T-1 ~> m4 s-1] Kh_h, & ! Laplacian viscosity at thickness points [L2 T-1 ~> m2 s-1] diff --git a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 index 0213ccb319..2b4cdfadee 100644 --- a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 +++ b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 @@ -78,8 +78,8 @@ module MOM_thickness_diffuse real, pointer :: diagSlopeY(:,:,:) => NULL() !< Diagnostic: zonal neutral slope [nondim] real, dimension(:,:,:), pointer :: & - KH_u_GME => NULL(), & !< interface height diffusivities in u-columns [m2 s-1] - KH_v_GME => NULL() !< interface height diffusivities in v-columns [m2 s-1] + KH_u_GME => NULL(), & !< interface height diffusivities in u-columns [L2 T-1 ~> m2 s-1] + KH_v_GME => NULL() !< interface height diffusivities in v-columns [L2 T-1 ~> m2 s-1] !>@{ !! Diagnostic identifier @@ -278,7 +278,7 @@ 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,je ; do I=is-1,ie - CS%KH_u_GME(I,j,k) = US%L_to_m**2*US%s_to_T*KH_u(I,j,k) + CS%KH_u_GME(I,j,k) = KH_u(I,j,k) enddo ; enddo ; enddo endif @@ -360,7 +360,7 @@ 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) = US%L_to_m**2*US%s_to_T*KH_v(i,J,k) + CS%KH_v_GME(i,J,k) = KH_v(i,J,k) enddo ; enddo ; enddo endif @@ -481,11 +481,11 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp do k=1,nz do j=js,je ; do I=is-1,ie uhtr(I,j,k) = uhtr(I,j,k) + uhD(I,j,k) * dt_in_T - if (associated(CDp%uhGM)) CDp%uhGM(I,j,k) = US%L_to_m**2*US%s_to_T*uhD(I,j,k) + if (associated(CDp%uhGM)) CDp%uhGM(I,j,k) = uhD(I,j,k) enddo ; enddo do J=js-1,je ; do i=is,ie vhtr(i,J,k) = vhtr(i,J,k) + vhD(i,J,k) * dt_in_T - if (associated(CDp%vhGM)) CDp%vhGM(i,J,k) = US%L_to_m**2*US%s_to_T*vhD(i,J,k) + if (associated(CDp%vhGM)) CDp%vhGM(i,J,k) = vhD(i,J,k) enddo ; enddo do j=js,je ; do i=is,ie h(i,j,k) = h(i,j,k) - dt_in_T * G%IareaT(i,j) * & @@ -1946,10 +1946,10 @@ subroutine thickness_diffuse_get_KH(CS, KH_u_GME, KH_v_GME, G) type(thickness_diffuse_CS), pointer :: CS !< Control structure for !! this module type(ocean_grid_type), intent(in) :: G !< Grid structure - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)+1), intent(inout) :: KH_u_GME!< interface height - !! diffusivities in u-columns [m2 s-1] - real, dimension(SZI_(G),SZJB_(G),SZK_(G)+1), intent(inout) :: KH_v_GME!< interface height - !! diffusivities in v-columns [m2 s-1] + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)+1), intent(inout) :: KH_u_GME !< interface height + !! diffusivities at u-faces [L2 T-1 ~> m2 s-1] + real, dimension(SZI_(G),SZJB_(G),SZK_(G)+1), intent(inout) :: KH_v_GME !< interface height + !! diffusivities at v-faces [L2 T-1 ~> m2 s-1] ! Local variables integer :: i,j,k From 561cf9523604b29473cdacdf537dbd9c17830f35 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Mon, 12 Aug 2019 04:40:12 -0400 Subject: [PATCH 189/297] +Pass internal wave speeds in [L T-1] Chnaged wave_speeds, wave_structure and propagate_int_tide to pass the internal wave speeds in rescaled units of [L T-1] and pass frequency to wave_structure in [T-1]. All answers in the MOM6-examples test suite are bitwise identical, but the internal waves code is not being aggressively tested in this test suite. --- src/diagnostics/MOM_wave_speed.F90 | 12 +++++---- src/diagnostics/MOM_wave_structure.F90 | 25 ++++++++++--------- .../lateral/MOM_internal_tides.F90 | 13 +++++----- .../vertical/MOM_diabatic_driver.F90 | 4 +-- 4 files changed, 29 insertions(+), 25 deletions(-) diff --git a/src/diagnostics/MOM_wave_speed.F90 b/src/diagnostics/MOM_wave_speed.F90 index 5c7dabeed9..f8fc9b7cf9 100644 --- a/src/diagnostics/MOM_wave_speed.F90 +++ b/src/diagnostics/MOM_wave_speed.F90 @@ -522,7 +522,7 @@ subroutine wave_speeds(h, tv, G, GV, US, nmodes, cn, CS, full_halos) 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 !< Thermodynamic variables integer, intent(in) :: nmodes !< Number of modes - real, dimension(G%isd:G%ied,G%jsd:G%jed,nmodes), intent(out) :: cn !< Waves speeds [m s-1] + real, dimension(G%isd:G%ied,G%jsd:G%jed,nmodes), intent(out) :: cn !< Waves speeds [L T-1 ~> m s-1] type(wave_speed_CS), optional, pointer :: CS !< Control structure for MOM_wave_speed logical, optional, intent(in) :: full_halos !< If true, do the calculation !! over the entire computational domain. @@ -577,7 +577,8 @@ subroutine wave_speeds(h, tv, G, GV, US, nmodes, cn, CS, full_halos) integer :: kf(SZI_(G)) integer, parameter :: max_itt = 10 logical :: use_EOS ! If true, density is calculated from T & S using the equation of state. - real, dimension(SZK_(G)+1) :: z_int, N2 + real, dimension(SZK_(G)+1) :: z_int + ! real, dimension(SZK_(G)+1) :: N2 integer :: nsub ! number of subintervals used for root finding integer, parameter :: sub_it_max = 4 ! maximum number of times to subdivide interval @@ -778,12 +779,12 @@ subroutine wave_speeds(h, tv, G, GV, US, nmodes, cn, CS, full_halos) do K=2,kc Igl(K) = 1.0/(gprime(K)*Hc(k)) ; Igu(K) = 1.0/(gprime(K)*Hc(k-1)) z_int(K) = z_int(K-1) + Hc(k-1) - N2(K) = US%m_to_Z**2*gprime(K)/(0.5*(Hc(k)+Hc(k-1))) + ! N2(K) = US%m_to_Z**2*gprime(K)/(0.5*(Hc(k)+Hc(k-1))) speed2_tot = speed2_tot + gprime(K)*(Hc(k-1)+Hc(k)) enddo ! Set stratification for surface and bottom (setting equal to nearest interface for now) - N2(1) = N2(2) ; N2(kc+1) = N2(kc) - ! Calcualte depth at bottom + ! N2(1) = N2(2) ; N2(kc+1) = N2(kc) + ! Calculate depth at bottom z_int(kc+1) = z_int(kc)+Hc(kc) ! check that thicknesses sum to total depth if (abs(z_int(kc+1)-htot(i)) > 1.e-12*htot(i)) then @@ -940,6 +941,7 @@ subroutine wave_speeds(h, tv, G, GV, US, nmodes, cn, CS, full_halos) else cn(i,j,2:nmodes) = 0.0 ! else too small to worry about endif ! if nmodes>1 .and. kc>nmodes .and. c1>c1_thresh + do m=1,nmodes ; cn(i,j,m) = US%m_s_to_L_T*cn(i,j,m) ; enddo else cn(i,j,:) = 0.0 endif ! if more than 2 layers diff --git a/src/diagnostics/MOM_wave_structure.F90 b/src/diagnostics/MOM_wave_structure.F90 index 0b7155826a..796413b47c 100644 --- a/src/diagnostics/MOM_wave_structure.F90 +++ b/src/diagnostics/MOM_wave_structure.F90 @@ -96,9 +96,9 @@ subroutine wave_structure(h, tv, G, GV, US, cn, ModeNum, freq, CS, En, full_halo type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various !! thermodynamic variables. real, dimension(SZI_(G),SZJ_(G)), intent(in) :: cn !< The (non-rotational) mode internal - !! gravity wave speed [m s-1]. + !! gravity wave speed [L T-1 ~> m s-1]. integer, intent(in) :: ModeNum !< Mode number - real, intent(in) :: freq !< Intrinsic wave frequency [s-1]. + real, intent(in) :: freq !< Intrinsic wave frequency [T-1 ~> s-1]. type(wave_structure_CS), pointer :: CS !< The control structure returned by a !! previous call to wave_structure_init. real, dimension(SZI_(G),SZJ_(G)), & @@ -130,14 +130,14 @@ subroutine wave_structure(h, tv, G, GV, US, cn, ModeNum, freq, CS, En, full_halo real :: I_Hnew, drxh_sum real, parameter :: tol1 = 0.0001, tol2 = 0.001 real, pointer, dimension(:,:,:) :: T => NULL(), S => NULL() - real :: g_Rho0 ! G_Earth/Rho0 in m5 Z-1 s-2 kg-1. + real :: g_Rho0 ! G_Earth/Rho0 in [m5 Z-1 s-2 kg-1 ~> m4 s-2 kg-1]. real :: rescale, I_rescale integer :: kf(SZI_(G)) integer, parameter :: max_itt = 1 ! number of times to iterate in solving for eigenvector - real, parameter :: cg_subRO = 1e-100 ! a very small number + real :: cg_subRO ! A tiny wave speed to prevent division by zero [L T-1 ~> m s-1] real, parameter :: a_int = 0.5 ! value of normalized integral: \int(w_strct^2)dz = a_int real :: I_a_int ! inverse of a_int - real :: f2 ! squared Coriolis frequency + real :: f2 ! squared Coriolis frequency [T-2 ~> s-2] real :: Kmag2 ! magnitude of horizontal wave number squared logical :: use_EOS ! If true, density is calculated from T & S using an ! equation of state. @@ -179,6 +179,7 @@ subroutine wave_structure(h, tv, G, GV, US, cn, ModeNum, freq, CS, En, full_halo S => tv%S ; T => tv%T g_Rho0 = US%L_T_to_m_s**2 * GV%g_Earth /GV%Rho0 + cg_subRO = 1e-100*US%m_s_to_L_T ! The hard-coded value here might need to increase. use_EOS = associated(tv%eqn_of_state) H_to_pres = GV%Z_to_H*GV%H_to_Pa @@ -248,7 +249,7 @@ subroutine wave_structure(h, tv, G, GV, US, cn, ModeNum, freq, CS, En, full_halo !----------------------------------- if (G%mask2dT(i,j) > 0.5) then - lam = 1/(cn(i,j)**2) + lam = 1/(US%L_T_to_m_s**2 * cn(i,j)**2) ! Calculate drxh_sum if (use_EOS) then @@ -421,7 +422,7 @@ subroutine wave_structure(h, tv, G, GV, US, cn, ModeNum, freq, CS, En, full_halo do itt=1,max_itt call tridiag_solver(a_diag(1:kc-1),b_diag(1:kc-1),c_diag(1:kc-1), & -lam_z(1:kc-1),e_guess(1:kc-1),"TDMA_H",e_itt) - e_guess(1:kc-1) = e_itt(1:kc-1)/sqrt(sum(e_itt(1:kc-1)**2)) + e_guess(1:kc-1) = e_itt(1:kc-1) / sqrt(sum(e_itt(1:kc-1)**2)) enddo ! itt-loop w_strct(2:kc) = e_guess(1:kc-1) w_strct(1) = 0.0 ! rigid lid at surface @@ -459,10 +460,10 @@ subroutine wave_structure(h, tv, G, GV, US, cn, ModeNum, freq, CS, En, full_halo u_strct(nzm) = (w_strct(nzm-1)- w_strct(nzm))/dz(nzm-1) ! Calculate wavenumber magnitude - f2 = US%s_to_T**2 * G%CoriolisBu(I,J)**2 + f2 = G%CoriolisBu(I,J)**2 !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)) - Kmag2 = (freq**2 - f2) / (cn(i,j)**2 + cg_subRO**2) + Kmag2 = US%m_to_L**2 * (freq**2 - f2) / (cn(i,j)**2 + cg_subRO**2) ! Calculate terms in vertically integrated energy equation int_dwdz2 = 0.0 ; int_w2 = 0.0 ; int_N2w2 = 0.0 @@ -477,8 +478,8 @@ subroutine wave_structure(h, tv, G, GV, US, cn, ModeNum, freq, CS, En, full_halo ! Back-calculate amplitude from energy equation if (Kmag2 > 0.0) then - KE_term = 0.25*GV%Rho0*( (1+f2/freq**2)/Kmag2*int_dwdz2 + int_w2 ) - PE_term = 0.25*GV%Rho0*( int_N2w2/freq**2 ) + KE_term = 0.25*GV%Rho0*( ((1.0 + f2/freq**2) / Kmag2)*int_dwdz2 + int_w2 ) + PE_term = 0.25*GV%Rho0*( int_N2w2/(US%s_to_T*freq)**2 ) if (En(i,j) >= 0.0) then W0 = sqrt( En(i,j)/(KE_term + PE_term) ) else @@ -490,7 +491,7 @@ subroutine wave_structure(h, tv, G, GV, US, cn, ModeNum, freq, CS, En, full_halo W_profile = W0*w_strct dWdz_profile = W0*u_strct ! Calculate average magnitude of actual horizontal velocity over a period - Uavg_profile = abs(dWdz_profile) * sqrt((1+f2/freq**2)/(2.0*Kmag2)) + Uavg_profile = abs(dWdz_profile) * sqrt((1.0 + f2/freq**2) / (2.0*Kmag2)) else W_profile = 0.0 dWdz_profile = 0.0 diff --git a/src/parameterizations/lateral/MOM_internal_tides.F90 b/src/parameterizations/lateral/MOM_internal_tides.F90 index 918b0d142c..9014cb1dbb 100644 --- a/src/parameterizations/lateral/MOM_internal_tides.F90 +++ b/src/parameterizations/lateral/MOM_internal_tides.F90 @@ -166,7 +166,8 @@ subroutine propagate_int_tide(h, tv, cn, TKE_itidal_input, vel_btTide, Nb, dt, & type(int_tide_CS), pointer :: CS !< The control structure returned by a !! previous call to int_tide_init. real, dimension(SZI_(G),SZJ_(G),CS%nMode), & - intent(in) :: cn !< The internal wave speeds of each mode [m s-1]. + intent(in) :: cn !< The internal wave speeds of each + !! mode [L T-1 ~> m s-1]. ! Local variables real, dimension(SZI_(G),SZJ_(G),2) :: & test @@ -247,7 +248,7 @@ subroutine propagate_int_tide(h, tv, cn, TKE_itidal_input, vel_btTide, Nb, dt, & ! Apply half the refraction. do m=1,CS%nMode ; do fr=1,CS%nFreq - call refract(CS%En(:,:,:,fr,m), US%m_s_to_L_T*cn(:,:,m), CS%frequency(fr), 0.5*dt_in_T, & + call refract(CS%En(:,:,:,fr,m), cn(:,:,m), CS%frequency(fr), 0.5*dt_in_T, & G, US, CS%nAngle, CS%use_PPMang) enddo ; enddo @@ -274,7 +275,7 @@ subroutine propagate_int_tide(h, tv, cn, TKE_itidal_input, vel_btTide, Nb, dt, & ! Propagate the waves. do m=1,CS%NMode ; do fr=1,CS%Nfreq - call propagate(CS%En(:,:,:,fr,m), US%m_s_to_L_T*cn(:,:,m), CS%frequency(fr), dt_in_T, & + call propagate(CS%En(:,:,:,fr,m), cn(:,:,m), CS%frequency(fr), dt_in_T, & G, US, CS, CS%NAngle) enddo ; enddo @@ -296,7 +297,7 @@ subroutine propagate_int_tide(h, tv, cn, TKE_itidal_input, vel_btTide, Nb, dt, & ! Apply the other half of the refraction. do m=1,CS%NMode ; do fr=1,CS%Nfreq - call refract(CS%En(:,:,:,fr,m), US%m_s_to_L_T*cn(:,:,m), CS%frequency(fr), 0.5*dt_in_T, & + call refract(CS%En(:,:,:,fr,m), cn(:,:,m), CS%frequency(fr), 0.5*dt_in_T, & G, US, CS%NAngle, CS%use_PPMang) enddo ; enddo @@ -387,7 +388,7 @@ subroutine propagate_int_tide(h, tv, cn, TKE_itidal_input, vel_btTide, Nb, dt, & if (CS%apply_wave_drag .or. CS%apply_Froude_drag) then do m=1,CS%NMode ; do fr=1,CS%Nfreq ! Calculate modal structure for given mode and frequency - call wave_structure(h, tv, G, GV, US, cn(:,:,m), m, US%s_to_T*CS%frequency(fr), & + call wave_structure(h, tv, G, GV, US, cn(:,:,m), m, CS%frequency(fr), & CS%wave_structure_CSp, tot_En_mode(:,:,fr,m), full_halos=.true.) ! Pick out near-bottom and max horizontal baroclinic velocity values at each point do j=jsd,jed ; do i=isd,ied @@ -428,7 +429,7 @@ subroutine propagate_int_tide(h, tv, cn, TKE_itidal_input, vel_btTide, Nb, dt, & ! Calculate horizontal phase velocity magnitudes f2 = 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)) - Kmag2 = (freq2 - f2) / (US%m_s_to_L_T**2*cn(i,j,m)**2 + cn_subRO**2) + Kmag2 = (freq2 - f2) / (cn(i,j,m)**2 + cn_subRO**2) c_phase = 0.0 if (Kmag2 > 0.0) then c_phase = sqrt(freq2/Kmag2) diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index a0def608fd..95ec82349c 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -121,7 +121,7 @@ module MOM_diabatic_driver !! shear and ePBL diffusivities are used. integer :: nMode = 1 !< Number of baroclinic modes to consider real :: uniform_test_cg !< Uniform group velocity of internal tide - !! for testing internal tides [m s-1] (BDM) + !! for testing internal tides [L T-1 ~> m s-1] 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. @@ -3291,7 +3291,7 @@ subroutine diabatic_driver_init(Time, G, GV, US, param_file, useALEalgorithm, di "that will be calculated.", default=1, do_not_log=.true.) 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") + default=-1., units="m s-1", scale=US%m_s_to_L_T) endif call get_param(param_file, mdl, "MASSLESS_MATCH_TARGETS", & From 38ce6acd37de926ebbf4e007338938f64419f40b Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Mon, 12 Aug 2019 15:32:03 -0400 Subject: [PATCH 190/297] Rescaled variables in MOM_bulk_mixed_layer.F90 Applied dimensional rescaling to numerous internal variables in MOM_bulk_mixed_layer.F90 for expanded dimensional consistency testing and to prepare for velocities to passed in with units of [L T-1]. All answers are bitwise identical. --- .../vertical/MOM_bulk_mixed_layer.F90 | 182 +++++++++--------- 1 file changed, 95 insertions(+), 87 deletions(-) diff --git a/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 b/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 index 48287bb86c..9494e6aaf1 100644 --- a/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 +++ b/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 @@ -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 T-3 ~> m3 s-3] except as noted. + ! These are terms in the mixed layer TKE budget, all in [Z L2 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. @@ -247,8 +247,8 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt_in_T, ea, eb, G, GV, R0, & ! The potential density referenced to the surface [kg m-3]. Rcv ! The coordinate variable potential density [kg m-3]. real, dimension(SZI_(G),SZK_(GV)) :: & - u, & ! The zonal velocity [m s-1]. - v, & ! The meridional velocity [m s-1]. + u, & ! The zonal velocity [L T-1 ~> m s-1]. + v, & ! The meridional velocity [L T-1 ~> m s-1]. h_orig, & ! The original thickness [H ~> m or kg m-2]. d_eb, & ! The downward increase across a layer in the entrainment from ! below [H ~> m or kg m-2]. The sign convention is that positive values of @@ -263,9 +263,9 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt_in_T, ea, eb, G, GV, 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 T-2 ~> m3 s-2]. + ! time step [Z L2 T-2 ~> m3 s-2]. Conv_En, & ! The turbulent kinetic energy source due to mixing down to - ! the depth of free convection [Z m2 T-2 ~> m3 s-2]. + ! the depth of free convection [Z L2 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 @@ -277,7 +277,7 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt_in_T, ea, eb, G, GV, Stot, & ! The integrated salt of layers which are fully entrained ! [H ppt ~> m ppt or ppt kg m-2]. uhtot, & ! The depth integrated zonal and meridional velocities in the - vhtot, & ! mixed layer [H m s-1 ~> m2 s-1 or kg m-1 s-1]. + vhtot, & ! mixed layer [H L T-1 ~> m2 s-1 or kg m-1 s-1]. netMassInOut, & ! The net mass flux (if non-Boussinsq) or volume flux (if ! Boussinesq - i.e. the fresh water flux (P+R-E)) into the @@ -301,7 +301,7 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt_in_T, ea, eb, G, GV, dRcv_dS, & ! Partial derivative of the coordinate variable potential ! density in the mixed layer with salinity [kg m-3 ppt-1]. TKE_river ! The source of turbulent kinetic energy available for mixing - ! at rivermouths [Z m2 T-3 ~> m3 s-3]. + ! at rivermouths [Z L2 T-3 ~> m3 s-3]. real, dimension(max(CS%nsw,1),SZI_(G)) :: & Pen_SW_bnd ! The penetrating fraction of the shortwave heating integrated @@ -320,13 +320,13 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt_in_T, ea, eb, G, GV, real, dimension(SZI_(G)) :: & dKE_FC, & ! The change in mean kinetic energy due to free convection - ! [Z m2 T-2 ~> m3 s-2]. + ! [Z L2 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 T-2 ~> m3 s-2]. + ! adjustment [Z L2 T-2 ~> m3 s-2]. cTKE ! The turbulent kinetic energy source due to convective - ! adjustment [Z m2 T-2 ~> m3 s-2]. + ! adjustment [Z L2 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]. @@ -450,7 +450,7 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt_in_T, ea, eb, G, GV, 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) ; u(i,k) = u_3d(i,j,k) ; v(i,k) = v_3d(i,j,k) + h(i,k) = h_3d(i,j,k) ; u(i,k) = US%m_s_to_L_T*u_3d(i,j,k) ; v(i,k) = US%m_s_to_L_T*v_3d(i,j,k) 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) @@ -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%g_Earth*US%m_to_Z) * Irho0**2 + RmixConst = 0.5*CS%rivermix_depth * (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)) @@ -544,7 +544,7 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt_in_T, ea, eb, G, GV, R0(:,1:), Rcv(:,1:), eps, & dR0_dT, dRcv_dT, dR0_dS, dRcv_dS, & netMassInOut, netMassOut, Net_heat, Net_salt, & - nsw, Pen_SW_bnd, opacity_band, Conv_en, & + nsw, Pen_SW_bnd, opacity_band, Conv_En, & dKE_FC, j, ksort, G, GV, US, CS, tv, fluxes, dt_in_T, & aggregate_FW_forcing) @@ -573,7 +573,7 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt_in_T, ea, eb, G, GV, T(:,1:), Pen_SW_bnd, eps, ksort, htot, Ttot) if (CS%TKE_diagnostics) then ; do i=is,ie - CS%diag_TKE_mech_decay(i,j) = CS%diag_TKE_mech_decay(i,j) - Idt_diag*TKE(i) + CS%diag_TKE_mech_decay(i,j) = CS%diag_TKE_mech_decay(i,j) - Idt_diag * TKE(i) enddo ; endif if (id_clock_mech>0) call cpu_clock_end(id_clock_mech) @@ -808,9 +808,9 @@ subroutine convective_adjustment(h, u, v, R0, Rcv, T, S, eps, d_eb, & real, dimension(SZI_(G),SZK_(GV)), intent(inout) :: h !< Layer thickness [H ~> m or kg m-2]. !! The units of h are referred to as H below. real, dimension(SZI_(G),SZK_(GV)), intent(inout) :: u !< Zonal velocities interpolated to h - !! points, m s-1. + !! points [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZK_(GV)), intent(inout) :: v !< Zonal velocities interpolated to h - !! points, m s-1. + !! points [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZK_(GV)), intent(inout) :: T !< Layer temperatures [degC]. real, dimension(SZI_(G),SZK_(GV)), intent(inout) :: S !< Layer salinities [ppt]. real, dimension(SZI_(G),SZK_(GV)), intent(inout) :: R0 !< Potential density referenced to @@ -825,10 +825,10 @@ 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 T-2 ~> m3 s-2]. + !! adjustment [Z L2 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 T-2 ~> m3 s-2]. + !! [Z L2 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. @@ -853,19 +853,19 @@ subroutine convective_adjustment(h, u, v, R0, Rcv, T, S, eps, d_eb, & Stot, & ! The integrated salt of layers which are fully entrained ! [H ppt ~> m ppt or ppt kg m-2]. uhtot, & ! The depth integrated zonal and meridional velocities in - vhtot, & ! the mixed layer [H m s-1 ~> m2 s-1 or kg m-1 s-1]. + vhtot, & ! the mixed layer [H L T-1 ~> m2 s-1 or kg m-1 s-1]. KE_orig, & ! The total mean kinetic energy in the mixed layer before - ! convection, H m2 s-2. + ! convection, [H L2 T-2 ~> H m2 s-2]. h_orig_k1 ! The depth of layer k1 before convective adjustment [H ~> m or kg m-2]. real :: h_ent ! The thickness from a layer that is entrained [H ~> m or kg m-2]. 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 T-2 H-2 kg-1 ~> m4 s-2 kg-1 or m10 s-2 kg-3]. + ! in [L2 Z m3 T-3 H-2 kg-1 ~> m4 s-3 kg-1 or m10 s-3 kg-3]. 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%g_Earth * GV%H_to_Z**2) / (2.0 * GV%Rho0) + g_H2_2Rho0 = (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 @@ -915,7 +915,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 * US%T_to_s**2*(CS%bulk_Ri_convective * & + dKE_CA(i,k1) = dKE_CA(i,k1) + GV%H_to_Z * (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 +937,7 @@ subroutine mixedlayer_convection(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & R0_tot, Rcv_tot, u, v, T, S, R0, Rcv, eps, & dR0_dT, dRcv_dT, dR0_dS, dRcv_dS, & netMassInOut, netMassOut, Net_heat, Net_salt, & - nsw, Pen_SW_bnd, opacity_band, Conv_en, & + nsw, Pen_SW_bnd, opacity_band, Conv_En, & 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. @@ -955,17 +955,17 @@ subroutine mixedlayer_convection(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & real, dimension(SZI_(G)), intent(out) :: Stot !< The depth integrated mixed layer salinity !! [ppt H ~> ppt m or ppt kg m-2]. real, dimension(SZI_(G)), intent(out) :: uhtot !< The depth integrated mixed layer zonal - !! velocity, H m s-1. + !! velocity [H L T-1 ~> m2 s-1 or kg m-1 s-1]. real, dimension(SZI_(G)), intent(out) :: vhtot !< The integrated mixed layer meridional - !! velocity, H m s-1. + !! velocity [H L T-1 ~> m2 s-1 or kg m-1 s-1]. real, dimension(SZI_(G)), intent(out) :: R0_tot !< The integrated mixed layer potential density referenced !! to 0 pressure [H kg m-2 ~> kg m-1 or kg2 m-4]. real, dimension(SZI_(G)), intent(out) :: Rcv_tot !< The integrated mixed layer coordinate !! variable potential density [H kg m-2 ~> kg m-1 or kg2 m-4]. real, dimension(SZI_(G),SZK_(GV)), & - intent(in) :: u !< Zonal velocities interpolated to h points, m s-1. + intent(in) :: u !< Zonal velocities interpolated to h points [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZK_(GV)), & - intent(in) :: v !< Zonal velocities interpolated to h points, m s-1. + intent(in) :: v !< Zonal velocities interpolated to h points [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZK_(GV)), & intent(in) :: T !< Layer temperatures [degC]. real, dimension(SZI_(G),SZK_(GV)), & @@ -1004,10 +1004,10 @@ subroutine mixedlayer_convection(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & !! 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) :: Conv_En !< The buoyant turbulent kinetic energy source + !! due to free convection [Z L2 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 T-2 ~> m3 s-2]. + !! energy due to free convection [Z L2 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. @@ -1053,7 +1053,7 @@ 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 T-2 Z-1 H-2 kg-1 ~> m4 s-2 kg-1 or m10 s-2 kg-3]. + ! [L2 Z m3 T-3 H-2 kg-1 ~> m4 s-3 kg-1 or m10 s-3 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 @@ -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%g_Earth * GV%H_to_Z**2) / (2.0 * GV%Rho0) + g_H2_2Rho0 = (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 @@ -1286,12 +1286,14 @@ 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)))) * & - US%T_to_s**2*((uhtot(i)-u(i,k)*htot(i))**2 + (vhtot(i)-v(i,k)*htot(i))**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 d_eb(i,k) = d_eb(i,k) - h_ent uhtot(i) = u(i,k)*h_ent ; vhtot(i) = v(i,k)*h_ent + !### I think that the line above should instead be: + ! uhtot(i) = uhtot(i) + h_ent*u(i,k) ; vhtot(i) = vhtot(i) + h_ent*v(i,k) endif @@ -1317,25 +1319,25 @@ 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 T-2 ~> m3 s-2]. + !! due to free convection [Z L2 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 T-2 ~> m3 s-2]. + !! [Z L2 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 T-2 ~> m3 s-2]. + !! [Z L2 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 T-2 ~> m3 s-2]. + !! adjustment [Z L2 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 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 source of turbulent kinetic energy !! available for driving mixing at river mouths - !! [Z m2 T-3 ~> m3 s-3]. + !! [Z L2 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]. @@ -1351,13 +1353,13 @@ 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 T-2 ~> m3 s-2]. + real :: dKE_conv ! The change in mean kinetic energy due to all convection [Z L2 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 T-2 ~> m3 s-2]. + ! that release is positive [Z L2 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 T-2 ~> m3 s-2]. @@ -1366,7 +1368,7 @@ subroutine find_starting_TKE(htot, h_CA, fluxes, Conv_En, cTKE, dKE_FC, dKE_CA, 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 T-3 ~> m3 s-3]. + real :: wind_TKE_src ! The surface wind source of TKE [Z L2 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 @@ -1418,7 +1420,7 @@ subroutine find_starting_TKE(htot, h_CA, fluxes, Conv_En, cTKE, dKE_FC, dKE_CA, if (Conv_En(i) < 0.0) Conv_En(i) = 0.0 if (cTKE(i,1) > 0.0) then ; TKE_CA = cTKE(i,1) ; else ; TKE_CA = 0.0 ; endif if ((htot(i) >= h_CA(i)) .or. (TKE_CA == 0.0)) then - totEn_Z = US%m_to_Z**2 * (Conv_En(i) + TKE_CA) + totEn_Z = US%L_to_Z**2 * (Conv_En(i) + TKE_CA) if (totEn_Z > 0.0) then nstar_FC = CS%nstar * totEn_Z / (totEn_Z + 0.2 * & @@ -1430,14 +1432,14 @@ subroutine find_starting_TKE(htot, h_CA, fluxes, Conv_En, cTKE, dKE_FC, dKE_CA, else ! This reconstructs the Buoyancy flux within the topmost htot of water. if (Conv_En(i) > 0.0) then - totEn_Z = US%m_to_Z**2 * (Conv_En(i) + TKE_CA * (htot(i) / h_CA(i)) ) + totEn_Z = US%L_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_in_T * (absf*(htot(i)*GV%H_to_Z))**3 * totEn_Z)) else nstar_FC = CS%nstar endif - totEn_Z = US%m_to_Z**2 * (Conv_En(i) + TKE_CA) + totEn_Z = US%L_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_in_T * (absf*(h_CA(i)*GV%H_to_Z))**3 * totEn_Z)) @@ -1462,7 +1464,7 @@ 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_in_T*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_L**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 @@ -1470,7 +1472,7 @@ subroutine find_starting_TKE(htot, h_CA, fluxes, Conv_En, cTKE, dKE_FC, dKE_CA, 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_L**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 @@ -1508,17 +1510,17 @@ subroutine mechanical_entrainment(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & real, dimension(SZI_(G)), intent(inout) :: Stot !< The depth integrated mixed layer salinity !! [ppt H ~> ppt m or ppt kg m-2]. real, dimension(SZI_(G)), intent(inout) :: uhtot !< The depth integrated mixed layer zonal - !! velocity, H m s-1. + !! velocity [H L T-1 ~> m2 s-1 or kg m-1 s-1]. real, dimension(SZI_(G)), intent(inout) :: vhtot !< The integrated mixed layer meridional - !! velocity, H m s-1. + !! velocity [H L T-1 ~> m2 s-1 or kg m-1 s-1]. real, dimension(SZI_(G)), intent(inout) :: R0_tot !< The integrated mixed layer potential density !! referenced to 0 pressure [H kg m-3 ~> kg m-2 or kg2 m-5]. real, dimension(SZI_(G)), intent(inout) :: Rcv_tot !< The integrated mixed layer coordinate variable !! potential density [H kg m-3 ~> kg m-2 or kg2 m-5]. real, dimension(SZI_(G),SZK_(GV)), & - intent(in) :: u !< Zonal velocities interpolated to h points, m s-1. + intent(in) :: u !< Zonal velocities interpolated to h points [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZK_(GV)), & - intent(in) :: v !< Zonal velocities interpolated to h points, m s-1. + intent(in) :: v !< Zonal velocities interpolated to h points [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZK_(GV)), & intent(in) :: T !< Layer temperatures [degC]. real, dimension(SZI_(G),SZK_(GV)), & @@ -1575,22 +1577,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 T-2 H-1 kg-1 ~> m4 s-2 kg-1 or m7 s-2 kg-2]. + ! in [L2 m3 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 T-2 ~> m3 s-2]. + ! [Z L2 T-2 ~> m3 s-2]. real :: dRL ! Work required to mix water from the next layer - ! across the mixed layer [m2 T-2 ~> m2 s-2]. + ! across the mixed layer [L2 T-2 ~> L2 s-2]. real :: Pen_En_Contrib ! Penetrating SW contributions to the changes in - ! TKE, divided by layer thickness in m [m2 T2 ~> m2 s-2]. - real :: Cpen1 ! A temporary variable [m2 T-2 ~> m2 s-2]. + ! TKE, divided by layer thickness in m [L2 T2 ~> m2 s-2]. + real :: Cpen1 ! A temporary variable [L2 T-2 ~> m2 s-2]. real :: dMKE ! A temporary variable related to the release of mean - ! 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]. + ! kinetic energy [H Z L2 T-2 ~> m4 s-2 or kg m s-2] + real :: TKE_ent ! The TKE that remains if h_ent were entrained [Z L2 T-2 ~> m3 s-2]. real :: TKE_ent1 ! The TKE that would remain, without considering the - ! 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]. + ! release of mean kinetic energy [Z L2 T-2 ~> m3 s-2]. + real :: dTKE_dh ! The partial derivative of TKE with h_ent [Z L2 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 T-2 ~> m2 s-2]. + ! dTKE_dh [L2 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]. @@ -1609,7 +1611,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%g_Earth * GV%H_to_Z) / (2.0 * GV%Rho0) + g_H_2Rho0 = (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 @@ -1622,7 +1624,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 * US%T_to_s**2 * & + dMKE = (GV%H_to_Z * CS%bulk_Ri_ML) * 0.5 * & ((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. @@ -1677,7 +1679,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 @@ -1689,7 +1691,7 @@ subroutine mechanical_entrainment(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & TKE(i) = TKE_full_ent !### 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 + if (TKE(i) <= 0.0) TKE(i) = 1.0e-150*US%m_to_Z*US%m_s_to_L_T**2 else ! The layer is only partially entrained. The amount that will be ! entrained is determined iteratively. No further layers will be @@ -1748,7 +1750,7 @@ subroutine mechanical_entrainment(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & 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) + TKE_ent1 = exp_kh* TKE(i) - (h_ent*GV%H_to_Z)*(dRL*f1_kh + Pen_En_Contrib) EF4_val = EF4(htot(i)+h_neglect,h_ent,Idecay_len_TKE(i),dEF4_dh) HpE = htot(i)+h_ent MKE_rate = 1.0/(1.0 + (cMKE(1,i)*HpE + cMKE(2,i)*HpE**2)) @@ -1790,7 +1792,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 @@ -2291,7 +2293,7 @@ subroutine mixedlayer_detrain_2(h, T, S, R0, Rcv, RcvTgt, dt_in_T, dt_diag, d_ea ! 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 [kg H2 Z T-2 m-3 ~> J m-2 or J kg2 m-8]. + ! buffer layers [kg H2 Z T-2 L-2 m-1 ~> 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]. @@ -2330,8 +2332,8 @@ subroutine mixedlayer_detrain_2(h, T, S, R0, Rcv, RcvTgt, dt_in_T, dt_diag, d_ea ! [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 T-2 ~> m s-2]. - real :: Rho0xG ! Rho0 times G_Earth [kg m-1 Z-1 T-2 ~> kg m-2 s-2]. + real :: g_2 ! 1/2 g_Earth [L2 Z-1 T-2 ~> m s-2]. + real :: Rho0xG ! Rho0 times G_Earth [kg L2 m-3 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 T-1 ~> s-1 or m6 kg-2 s-1]. @@ -2340,7 +2342,7 @@ subroutine mixedlayer_detrain_2(h, T, S, R0, Rcv, RcvTgt, dt_in_T, dt_diag, d_ea 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 T-3 ~> kg m3 s-3 or kg3 m-3 s-3]. + real :: s1en ! A work variable [H2 L2 kg m-1 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. @@ -2359,8 +2361,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%g_Earth - Rho0xG = GV%Rho0 * US%L_to_m**2*GV%g_Earth + g_2 = 0.5 * GV%g_Earth + Rho0xG = GV%Rho0 * GV%g_Earth Idt_H2 = GV%H_to_Z**2 / dt_diag I2Rho0 = 0.5 / GV%Rho0 Angstrom = GV%Angstrom_H @@ -3146,10 +3148,10 @@ subroutine mixedlayer_detrain_1(h, T, S, R0, Rcv, RcvTgt, dt_in_T, dt_diag, d_ea 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 T-3 Z-1 H-2 kg-1 ~> m4 s-3 kg-1 or m10 s-3 kg-3]. + ! step [L2 Z m3 T-3 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 T-3 ~> m s-3 or m7 kg-2 s-3]. + ! conversion from H to Z divided by the diagnostic time step + ! [L2 Z H-2 T-3 ~> m s-3 or m7 kg-2 s-3]. logical :: splittable_BL(SZI_(G)), orthogonal_extrap real :: x1 @@ -3161,8 +3163,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%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) + 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) ! Move detrained water into the buffer layer. do k=1,CS%nkml @@ -3579,28 +3581,34 @@ 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*US%T_to_s**3) + Time, 'Wind-stirring source of mixed layer TKE', & + 'm3 s-3', conversion=US%Z_to_m*US%L_to_m**2*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*US%T_to_s**3) + Time, 'Mean kinetic energy source of mixed layer TKE', & + 'm3 s-3', conversion=US%Z_to_m*US%L_to_m**2*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*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) + 'm3 s-3', conversion=US%Z_to_m*US%L_to_m**2*US%T_to_s**3) 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*US%T_to_s**3) + Time, 'TKE consumed by mixing that deepens the mixed layer', & + 'm3 s-3', conversion=US%Z_to_m*US%L_to_m**2*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*US%T_to_s**3) + Time, 'Mechanical energy decay sink of mixed layer TKE', & + 'm3 s-3', conversion=US%Z_to_m*US%L_to_m**2*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*US%T_to_s**3) + Time, 'Convective energy decay sink of mixed layer TKE', & + 'm3 s-3', conversion=US%Z_to_m*US%L_to_m**2*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*US%T_to_s**3) + Time, 'Spurious source of mixed layer TKE from sigma2', & + 'm3 s-3', conversion=US%Z_to_m*US%L_to_m**2*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*US%T_to_s**3) + 'W m-2', conversion=US%Z_to_m*US%L_to_m**2*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*US%T_to_s**3) + 'W m-2', conversion=US%Z_to_m*US%L_to_m**2*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 8cf18977f6edf6d373be4ad86353ef530bcc5f0d Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Mon, 12 Aug 2019 18:24:34 -0400 Subject: [PATCH 191/297] Rescaled velocities in MOM_energetic_PBL.F90 Changed the units of internal velocity variables in MOM_energetic_PBL.F90 to [L T-1] to prepare for velocities to passed in with units of [L T-1]. All answers are bitwise identical. --- .../vertical/MOM_energetic_PBL.F90 | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/src/parameterizations/vertical/MOM_energetic_PBL.F90 b/src/parameterizations/vertical/MOM_energetic_PBL.F90 index 485ae1e942..6659adbd68 100644 --- a/src/parameterizations/vertical/MOM_energetic_PBL.F90 +++ b/src/parameterizations/vertical/MOM_energetic_PBL.F90 @@ -323,8 +323,8 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS 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]. + u_2d, & ! A 2-d slice of the zonal velocity [L T-1 ~> m s-1]. + v_2d ! A 2-d slice of the meridional velocity [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZK_(GV)+1) :: & Kd_2d ! A 2-d version of the diapycnal diffusivity [Z2 T-1 ~> m2 s-1]. real, dimension(SZK_(GV)) :: & @@ -334,8 +334,8 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS 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 [kg m-3 Z3 T-2 ~> J m-2]. - u, & ! The zonal velocity [m s-1]. - v ! The meridional velocity [m s-1]. + u, & ! The zonal velocity [L T-1 ~> m s-1]. + v ! The meridional velocity [L T-1 ~> m s-1]. real, dimension(SZK_(GV)+1) :: & Kd, & ! The diapycnal diffusivity [Z2 T-1 ~> m2 s-1]. mixvel, & ! A turbulent mixing veloxity [Z T-1 ~> m s-1]. @@ -404,7 +404,7 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS 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) + h_2d(i,k) = h_3d(i,j,k) ; u_2d(i,k) = US%m_s_to_L_T*u_3d(i,j,k) ; v_2d(i,k) = US%m_s_to_L_T*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) dSV_dT_2d(i,k) = dSV_dT(i,j,k) ; dSV_dS_2d(i,k) = dSV_dS(i,j,k) @@ -607,7 +607,7 @@ subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, abs ! 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 :: vhtot ! layers above [H L T-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]. @@ -1085,7 +1085,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 = (US%m_to_Z**3*US%T_to_s**2)*(GV%H_to_kg_m2 * CS%MKE_to_TKE_effic) * 0.5 * & + dMKE_max = (US%L_to_Z**2*US%m_to_Z*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 From a8c41f52987222e0d49d9da84f597a0e34ff3fec Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Mon, 12 Aug 2019 19:02:45 -0400 Subject: [PATCH 192/297] +Pass velocities to set_diffusivity in [L T-1] Passed the velocity arguments to set_diffusivity, calc_kappa_shear, calc_kappa_shear_vertex, add_drag_diffusivity, add_LOTW_BBL_diffusivity, set_BBL_TKE and calculate_CVMix_shear in rescaled units of [L T-1]. As a temporary step, array syntax is being used to rescale arguments directly in some subroutine calls, even though this practice is strongly discouraged in the MOM6 code standards. All answers are bitwise identical, but the rescaled units of multiple arguments in public interfaces have changed. --- .../vertical/MOM_CVMix_shear.F90 | 15 +++---- .../vertical/MOM_diabatic_driver.F90 | 17 ++++---- .../vertical/MOM_kappa_shear.F90 | 16 ++++---- .../vertical/MOM_set_diffusivity.F90 | 41 +++++++++---------- 4 files changed, 44 insertions(+), 45 deletions(-) diff --git a/src/parameterizations/vertical/MOM_CVMix_shear.F90 b/src/parameterizations/vertical/MOM_CVMix_shear.F90 index 6b6bf32bf7..3ab0567db1 100644 --- a/src/parameterizations/vertical/MOM_CVMix_shear.F90 +++ b/src/parameterizations/vertical/MOM_CVMix_shear.F90 @@ -59,17 +59,18 @@ module MOM_CVMix_shear subroutine calculate_CVMix_shear(u_H, v_H, h, tv, kd, kv, G, GV, US, CS ) type(ocean_grid_type), intent(in) :: G !< Grid structure. type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure. - type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: u_H !< Initial zonal velocity on T points [m s-1]. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: v_H !< Initial meridional velocity on T points [m s-1]. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: u_H !< Initial zonal velocity on T points [L T-1 ~> m s-1] + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: v_H !< Initial meridional velocity on T + !! points [L T-1 ~> m s-1] 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 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 T-1 ~> m2 s-1]. - type(CVMix_shear_cs), pointer :: CS !< The control structure returned by a previous call to - !! CVMix_shear_init. + type(CVMix_shear_cs), pointer :: CS !< The control structure returned by a previous + !! call to CVMix_shear_init. ! Local variables integer :: i, j, k, kk, km1 real :: GoRho ! Gravitational acceleration divided by density in MKS units [m4 s-2] @@ -118,8 +119,8 @@ subroutine calculate_CVMix_shear(u_H, v_H, h, tv, kd, kv, G, GV, US, CS ) do k = 1, G%ke km1 = max(1, k-1) kk = 2*(k-1) - DU = (u_h(i,j,k))-(u_h(i,j,km1)) - DV = (v_h(i,j,k))-(v_h(i,j,km1)) + DU = US%L_T_to_m_s*(u_h(i,j,k) - u_h(i,j,km1)) + DV = US%L_T_to_m_s*(v_h(i,j,k) - v_h(i,j,km1)) DRHO = (GoRho * (rho_1D(kk+1) - rho_1D(kk+2)) ) DZ = ((0.5*(h(i,j,km1) + h(i,j,k))+GV%H_subroundoff)*GV%H_to_m) N2 = DRHO/DZ diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index 95ec82349c..797e1beacc 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -324,7 +324,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & 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 set_BBL_TKE(US%m_s_to_L_T*u(:,:,:), US%m_s_to_L_T*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. @@ -609,8 +609,9 @@ 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_in_T, G, GV, US, & - CS%set_diff_CSp, Kd_lay, Kd_int) + call set_diffusivity(US%m_s_to_L_T*u(:,:,:), US%m_s_to_L_T*v(:,:,:), h, & + US%m_s_to_L_T*u_h(:,:,:), US%m_s_to_L_T*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)") @@ -1394,8 +1395,9 @@ 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_in_T, G, GV, US, & - CS%set_diff_CSp, Kd_lay, Kd_int) + call set_diffusivity(US%m_s_to_L_T*u(:,:,:), US%m_s_to_L_T*v(:,:,:), h, & + US%m_s_to_L_T*u_h(:,:,:), US%m_s_to_L_T*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)") @@ -2136,8 +2138,9 @@ 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_in_T, G, GV, US, & - CS%set_diff_CSp, Kd_lay, Kd_int) + call set_diffusivity(US%m_s_to_L_T*u(:,:,:), US%m_s_to_L_T*v(:,:,:), h, & + US%m_s_to_L_T*u_h(:,:,:), US%m_s_to_L_T*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)") diff --git a/src/parameterizations/vertical/MOM_kappa_shear.F90 b/src/parameterizations/vertical/MOM_kappa_shear.F90 index 547840732d..f5343f86e2 100644 --- a/src/parameterizations/vertical/MOM_kappa_shear.F90 +++ b/src/parameterizations/vertical/MOM_kappa_shear.F90 @@ -98,9 +98,9 @@ subroutine Calculate_kappa_shear(u_in, v_in, h, tv, p_surf, kappa_io, tke_io, & 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),SZJ_(G),SZK_(GV)), & - intent(in) :: u_in !< Initial zonal velocity [m s-1]. (Intent in) + intent(in) :: u_in !< Initial zonal velocity [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & - intent(in) :: v_in !< Initial meridional velocity [m s-1]. + intent(in) :: v_in !< Initial meridional velocity [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]. type(thermo_var_ptrs), intent(in) :: tv !< A structure containing pointers to any @@ -189,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)*US%m_s_to_L_T ; v_2d(i,k) = v_in(i,j,k)*US%m_s_to_L_T + u_2d(i,k) = u_in(i,j,k) ; v_2d(i,k) = v_in(i,j,k) 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) @@ -361,9 +361,9 @@ subroutine Calc_kappa_shear_vertex(u_in, v_in, h, T_in, S_in, tv, p_surf, kappa_ 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_(GV)), & - intent(in) :: u_in !< Initial zonal velocity [m s-1]. (Intent in) + intent(in) :: u_in !< Initial zonal velocity [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), & - intent(in) :: v_in !< Initial meridional velocity [m s-1]. + intent(in) :: v_in !< Initial meridional velocity [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & @@ -462,13 +462,11 @@ 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) = 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_2d(I,k) = (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) = 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_2d(I,k) = (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) diff --git a/src/parameterizations/vertical/MOM_set_diffusivity.F90 b/src/parameterizations/vertical/MOM_set_diffusivity.F90 index dee3422a7a..7d118bc00a 100644 --- a/src/parameterizations/vertical/MOM_set_diffusivity.F90 +++ b/src/parameterizations/vertical/MOM_set_diffusivity.F90 @@ -208,15 +208,15 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt_in_T, 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]. + intent(in) :: u !< The zonal velocity [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - intent(in) :: v !< The meridional velocity [m s-1]. + intent(in) :: v !< The meridional velocity [L T-1 ~> m s-1]. 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) :: u_h !< Zonal velocity interpolated to h points [m s-1]. + intent(in) :: u_h !< Zonal velocity interpolated to h points [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: v_h !< Meridional velocity interpolated to h points [m s-1]. + intent(in) :: v_h !< Meridional velocity interpolated to h points [L T-1 ~> m s-1]. type(thermo_var_ptrs), intent(inout) :: tv !< Structure with pointers to thermodynamic !! fields. Out is for tv%TempxPmE. type(forcing), intent(in) :: fluxes !< A structure of thermodynamic surface fluxes @@ -493,7 +493,7 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt_in_T, call add_LOTW_BBL_diffusivity(h, u, v, tv, fluxes, visc, j, N2_int, G, GV, US, CS, & Kd_lay, Kd_int, dd%Kd_BBL) else - call add_drag_diffusivity(h, u, v, tv, fluxes, visc, j, TKE_to_Kd, & + call add_drag_diffusivity(h, u, v, tv, fluxes, visc, j, TKE_to_Kd, & maxTKE, kb, G, GV, US, CS, Kd_lay, Kd_int, dd%Kd_BBL) endif endif @@ -530,8 +530,7 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt_in_T, enddo ! j-loop if (CS%debug) then - call hchksum(Kd_lay ,"Kd_lay", G%HI, haloshift=0, & - scale=US%Z2_T_to_m2_s) + 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%Z2_T_to_m2_s) @@ -1106,9 +1105,9 @@ subroutine add_drag_diffusivity(h, u, v, tv, fluxes, visc, j, TKE_to_Kd, & 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] + intent(in) :: u !< The zonal velocity [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - intent(in) :: v !< The meridional velocity [m s-1] + intent(in) :: v !< The meridional velocity [L T-1 ~> 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 !< Structure containing pointers to any available @@ -1262,8 +1261,7 @@ subroutine add_drag_diffusivity(h, u, v, tv, fluxes, visc, j, TKE_to_Kd, & else ; TKE_to_layer = 0.0 ; endif ! 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**2 * & + if (Rayleigh_drag) TKE_Ray = 0.5*CS%BBL_effic * US%L_to_Z**2 * 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) + & (G%areaCv(i,J-1) * visc%Ray_v(i,J-1,k) * v(i,J-1,k)**2 + & @@ -1342,9 +1340,9 @@ subroutine add_LOTW_BBL_diffusivity(h, u, v, tv, fluxes, visc, j, N2_int, & 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),SZK_(G)), & - intent(in) :: u !< u component of flow [m s-1] + intent(in) :: u !< u component of flow [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - intent(in) :: v !< v component of flow [m s-1] + intent(in) :: v !< v component of flow [L T-1 ~> m s-1] 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 !< Structure containing pointers to any available @@ -1443,8 +1441,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**2 * & - 0.5*CS%BBL_effic * G%IareaT(i,j) * & + 0.5*CS%BBL_effic * US%L_to_Z**2 * 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) + & (G%areaCv(i,J-1) * visc%Ray_v(i,J-1,k) * v(i,J-1,k)**2 + & @@ -1643,9 +1640,9 @@ subroutine set_BBL_TKE(u, v, h, fluxes, visc, G, GV, US, CS) 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] + intent(in) :: u !< The zonal velocity [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - intent(in) :: v !< The meridional velocity [m s-1] + intent(in) :: v !< The meridional velocity [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] type(forcing), intent(in) :: fluxes !< A structure of thermodynamic surface fluxes @@ -1661,15 +1658,15 @@ subroutine set_BBL_TKE(u, v, h, fluxes, visc, G, GV, US, CS) ! integrated thickness in the BBL [Z ~> m]. real, dimension(SZIB_(G)) :: & - uhtot, & ! running integral of u in the BBL [Z m s-1 ~> m2 s-1] + uhtot, & ! running integral of u in the BBL [Z L T-1 ~> m2 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] + u2_bbl ! square of the mean zonal velocity in the BBL [L2 T-2 ~> m2 s-2] - real :: vhtot(SZI_(G)) ! running integral of v in the BBL [Z m s-1 ~> m2 s-1] + real :: vhtot(SZI_(G)) ! running integral of v in the BBL [Z L T-1 ~> m2 s-1] real, dimension(SZI_(G),SZJB_(G)) :: & vstar, & ! ustar at at v-points [Z T-1 ~> m s-1]. - v2_bbl ! square of average meridional velocity in BBL [m2 s-2] + v2_bbl ! square of average meridional velocity in BBL [L2 T-2 ~> m2 s-2] real :: cdrag_sqrt ! square root of the drag coefficient [nondim] real :: hvel ! thickness at velocity points [Z ~> m]. @@ -1764,7 +1761,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**2 * US%m_to_Z**2 * & + visc%TKE_BBL(i,j) = US%L_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 55aeaef5e42589402ad8db63e52704981f7de5bf Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Mon, 12 Aug 2019 19:40:18 -0400 Subject: [PATCH 193/297] +Pass velocities to bulkmixedlayer in [L T-1] Passed the velocity arguments to bulkmixedlayer, energetic_PBL, and KPP_compute_BLD in rescaled units of [L T-1]. As a temporary step, array syntax is being used to rescale arguments directly in some subroutine calls, even though this practice is strongly discouraged in the MOM6 code standards. All answers are bitwise identical, but the rescaled units of multiple arguments in public interfaces have changed. --- .../vertical/MOM_CVMix_KPP.F90 | 28 +++++++++---------- .../vertical/MOM_bulk_mixed_layer.F90 | 6 ++-- .../vertical/MOM_diabatic_driver.F90 | 19 +++++++------ .../vertical/MOM_energetic_PBL.F90 | 6 ++-- 4 files changed, 31 insertions(+), 28 deletions(-) diff --git a/src/parameterizations/vertical/MOM_CVMix_KPP.F90 b/src/parameterizations/vertical/MOM_CVMix_KPP.F90 index 6a9a23c057..2ff0b3efe1 100644 --- a/src/parameterizations/vertical/MOM_CVMix_KPP.F90 +++ b/src/parameterizations/vertical/MOM_CVMix_KPP.F90 @@ -890,8 +890,8 @@ subroutine KPP_compute_BLD(CS, G, GV, US, h, Temp, Salt, u, v, EOS, uStar, buoyF 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),SZK_(G)), intent(in) :: Temp !< potential/cons temp [degC] real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: Salt !< Salinity [ppt] - 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] + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: u !< Velocity i-component [L T-1 ~> m s-1] + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: v !< Velocity j-component [L T-1 ~> 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 [L2 T-3 ~> m2 s-3] @@ -965,8 +965,8 @@ subroutine KPP_compute_BLD(CS, G, GV, US, h, Temp, Salt, u, v, EOS, uStar, buoyF if (G%mask2dT(i,j)==0.) cycle do k=1,G%ke - U_H(k) = 0.5 * (U(i,j,k)+U(i-1,j,k)) - V_H(k) = 0.5 * (V(i,j,k)+V(i,j-1,k)) + U_H(k) = 0.5 * US%L_T_to_m_s*(u(i,j,k)+u(i-1,j,k)) + V_H(k) = 0.5 * US%L_T_to_m_s*(v(i,j,k)+v(i,j-1,k)) enddo ! things independent of position within the column @@ -1023,8 +1023,8 @@ subroutine KPP_compute_BLD(CS, G, GV, US, h, Temp, Salt, u, v, EOS, uStar, buoyF ! surface averaged fields surfHtemp = surfHtemp + Temp(i,j,ktmp) * delH surfHsalt = surfHsalt + Salt(i,j,ktmp) * delH - surfHu = surfHu + 0.5*(u(i,j,ktmp)+u(i-1,j,ktmp)) * delH - surfHv = surfHv + 0.5*(v(i,j,ktmp)+v(i,j-1,ktmp)) * delH + surfHu = surfHu + 0.5*US%L_T_to_m_s*(u(i,j,ktmp)+u(i-1,j,ktmp)) * delH + surfHv = surfHv + 0.5*US%L_T_to_m_s*(v(i,j,ktmp)+v(i,j-1,ktmp)) * delH if (CS%Stokes_Mixing) then surfHus = surfHus + 0.5*(WAVES%US_x(i,j,ktmp)+WAVES%US_x(i-1,j,ktmp)) * delH surfHvs = surfHvs + 0.5*(WAVES%US_y(i,j,ktmp)+WAVES%US_y(i,j-1,ktmp)) * delH @@ -1041,8 +1041,8 @@ subroutine KPP_compute_BLD(CS, G, GV, US, h, Temp, Salt, u, v, EOS, uStar, buoyF ! vertical shear between present layer and ! surface layer averaged surfU,surfV. ! C-grid average to get Uk and Vk on T-points. - Uk = 0.5*(u(i,j,k)+u(i-1,j,k)) - surfU - Vk = 0.5*(v(i,j,k)+v(i,j-1,k)) - surfV + Uk = 0.5*US%L_T_to_m_s*(u(i,j,k)+u(i-1,j,k)) - surfU + Vk = 0.5*US%L_T_to_m_s*(v(i,j,k)+v(i,j-1,k)) - surfV if (CS%Stokes_Mixing) then ! If momentum is mixed down the Stokes drift gradient, then @@ -1217,15 +1217,15 @@ subroutine KPP_compute_BLD(CS, G, GV, US, h, Temp, Salt, u, v, EOS, uStar, buoyF ! hTot = h(i,j,1) ! surfTemp = Temp(i,j,1) ; surfHtemp = surfTemp * hTot ! surfSalt = Salt(i,j,1) ; surfHsalt = surfSalt * hTot - ! surfU = 0.5*(u(i,j,1)+u(i-1,j,1)) ; surfHu = surfU * hTot - ! surfV = 0.5*(v(i,j,1)+v(i,j-1,1)) ; surfHv = surfV * hTot + ! surfU = 0.5*US%L_T_to_m_s*(u(i,j,1)+u(i-1,j,1)) ; surfHu = surfU * hTot + ! surfV = 0.5*US%L_T_to_m_s*(v(i,j,1)+v(i,j-1,1)) ; surfHv = surfV * hTot ! pRef = 0.0 ! do k = 2, G%ke ! ! Recalculate differences with surface layer - ! Uk = 0.5*(u(i,j,k)+u(i-1,j,k)) - surfU - ! Vk = 0.5*(v(i,j,k)+v(i,j-1,k)) - surfV + ! Uk = 0.5*US%L_T_to_m_s*(u(i,j,k)+u(i-1,j,k)) - surfU + ! Vk = 0.5*US%L_T_to_m_s*(v(i,j,k)+v(i,j-1,k)) - surfV ! deltaU2(k) = Uk**2 + Vk**2 ! pRef = pRef + GV%H_to_Pa * h(i,j,k) ! call calculate_density(surfTemp, surfSalt, pRef, rho1, EOS) @@ -1238,8 +1238,8 @@ subroutine KPP_compute_BLD(CS, G, GV, US, h, Temp, Salt, u, v, EOS, uStar, buoyF ! hTot = hTot + delH ! surfHtemp = surfHtemp + Temp(i,j,k) * delH ; surfTemp = surfHtemp / hTot ! surfHsalt = surfHsalt + Salt(i,j,k) * delH ; surfSalt = surfHsalt / hTot - ! surfHu = surfHu + 0.5*(u(i,j,k)+u(i-1,j,k)) * delH ; surfU = surfHu / hTot - ! surfHv = surfHv + 0.5*(v(i,j,k)+v(i,j-1,k)) * delH ; surfV = surfHv / hTot + ! surfHu = surfHu + 0.5*US%L_T_to_m_s*(u(i,j,k)+u(i-1,j,k)) * delH ; surfU = surfHu / hTot + ! surfHv = surfHv + 0.5*US%L_T_to_m_s*(v(i,j,k)+v(i,j-1,k)) * delH ; surfV = surfHv / hTot ! endif ! enddo diff --git a/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 b/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 index 9494e6aaf1..cbf42d2b8b 100644 --- a/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 +++ b/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 @@ -193,10 +193,10 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt_in_T, ea, eb, G, GV, intent(inout) :: h_3d !< Layer thickness [H ~> m or kg m-2]. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: u_3d !< Zonal velocities interpolated to h points - !! [m s-1]. + !! [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: v_3d !< Zonal velocities interpolated to h points - !! [m s-1]. + !! [L T-1 ~> m s-1]. type(thermo_var_ptrs), intent(inout) :: tv !< A structure containing pointers to any !! available thermodynamic fields. Absent !! fields have NULL ptrs. @@ -450,7 +450,7 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt_in_T, ea, eb, G, GV, 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) ; u(i,k) = US%m_s_to_L_T*u_3d(i,j,k) ; v(i,k) = US%m_s_to_L_T*v_3d(i,j,k) + h(i,k) = h_3d(i,j,k) ; u(i,k) = u_3d(i,j,k) ; v(i,k) = v_3d(i,j,k) 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) diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index 797e1beacc..fc126b94a2 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -665,7 +665,8 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim 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, & + call KPP_compute_BLD(CS%KPP_CSp, G, GV, US, h, tv%T, tv%S, & + US%m_s_to_L_T*u(:,:,:), US%m_s_to_L_T*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, & @@ -844,7 +845,7 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim endif call find_uv_at_h(u, v, h, u_h, v_h, G, GV, US) - call energetic_PBL(h, u_h, v_h, tv, fluxes, dt_in_T, Kd_ePBL, G, GV, US, & + call energetic_PBL(h, US%m_s_to_L_T*u_h(:,:,:), US%m_s_to_L_T*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 @@ -1450,7 +1451,8 @@ subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, 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, & + call KPP_compute_BLD(CS%KPP_CSp, G, GV, US, h, tv%T, tv%S, & + US%m_s_to_L_T*u(:,:,:), US%m_s_to_L_T*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, & @@ -1575,7 +1577,7 @@ subroutine diabatic_ALE(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, US) - call energetic_PBL(h, u_h, v_h, tv, fluxes, dt_in_T, Kd_ePBL, G, GV, US, & + call energetic_PBL(h, US%m_s_to_L_T*u_h(:,:,:), US%m_s_to_L_T*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 @@ -2084,7 +2086,7 @@ 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_in_T*CS%ML_mix_first, & + call bulkmixedlayer(h, US%m_s_to_L_T*u_h(:,:,:), US%m_s_to_L_T*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_in_T, last_call=.false.) if (CS%salt_reject_below_ML) & @@ -2092,7 +2094,7 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e 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_in_T, eaml, ebml, & + call bulkmixedlayer(h, US%m_s_to_L_T*u_h(:,:,:), US%m_s_to_L_T*v_h(:,:,:), tv, fluxes, dt_in_T, eaml, ebml, & G, GV, US, CS%bulkmixedlayer_CSp, CS%optics, & Hml, CS%aggregate_FW_forcing, dt_in_T, last_call=.true.) endif @@ -2185,7 +2187,8 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e 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, & + call KPP_compute_BLD(CS%KPP_CSp, G, GV, US, h, tv%T, tv%S, & + US%m_s_to_L_T*u(:,:,:), US%m_s_to_L_T*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, & @@ -2478,7 +2481,7 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e 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, & + call bulkmixedlayer(h, US%m_s_to_L_T*u_h(:,:,:), US%m_s_to_L_T*v_h(:,:,:), tv, fluxes, dt_mix, ea, eb, & G, GV, US, CS%bulkmixedlayer_CSp, CS%optics, & Hml, CS%aggregate_FW_forcing, dt_in_T, last_call=.true.) diff --git a/src/parameterizations/vertical/MOM_energetic_PBL.F90 b/src/parameterizations/vertical/MOM_energetic_PBL.F90 index 6659adbd68..b486e1e2ca 100644 --- a/src/parameterizations/vertical/MOM_energetic_PBL.F90 +++ b/src/parameterizations/vertical/MOM_energetic_PBL.F90 @@ -247,10 +247,10 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS intent(inout) :: h_3d !< Layer thicknesses [H ~> m or kg m-2]. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: u_3d !< Zonal velocities interpolated to h points - !! [m s-1]. + !! [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: v_3d !< Zonal velocities interpolated to h points - !! [m s-1]. + !! [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: dSV_dT !< The partial derivative of in-situ specific !! volume with potential temperature @@ -404,7 +404,7 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS 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) = US%m_s_to_L_T*u_3d(i,j,k) ; v_2d(i,k) = US%m_s_to_L_T*v_3d(i,j,k) + 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) dSV_dT_2d(i,k) = dSV_dT(i,j,k) ; dSV_dS_2d(i,k) = dSV_dS(i,j,k) From e8c84a66eb34fbdb0515e19480d9d792fde609c1 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 13 Aug 2019 05:42:43 -0400 Subject: [PATCH 194/297] +Added thickness rescaling in MOM_state_stats Added dimensional rescaling of the volumes in MOM_state_stats so that the reported statistics are invariant across rescaling, and so that sum_across_PEs can use fixed-point arithmetic without changing answers. This change required the addition of verticalGrid_type and unit_scale_type arguments to MOM_state_stats. Also added an optional unit_scale_type argument to MOM_state_chksum_3arg. All answers are bitwise identical. --- src/core/MOM_checksum_packages.F90 | 87 +++++++++++++++++------------- 1 file changed, 50 insertions(+), 37 deletions(-) diff --git a/src/core/MOM_checksum_packages.F90 b/src/core/MOM_checksum_packages.F90 index 795885e817..36d69a8179 100644 --- a/src/core/MOM_checksum_packages.F90 +++ b/src/core/MOM_checksum_packages.F90 @@ -59,7 +59,7 @@ subroutine MOM_state_chksum_5arg(mesg, u, v, h, uh, vh, G, GV, US, haloshift, sy type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type integer, optional, intent(in) :: haloshift !< The width of halos to check (default 0). logical, optional, intent(in) :: symmetric !< If true, do checksums on the fully symmetric - !! computationoal domain. + !! computational domain. integer :: is, ie, js, je, nz, hs logical :: sym @@ -79,30 +79,34 @@ end subroutine MOM_state_chksum_5arg ! ============================================================================= !> Write out chksums for the model's basic state variables. -subroutine MOM_state_chksum_3arg(mesg, u, v, h, G, GV, haloshift, 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. - type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. +subroutine MOM_state_chksum_3arg(mesg, u, v, h, G, GV, US, haloshift, 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. + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & - intent(in) :: u !< Zonal velocity [m s-1]. + intent(in) :: u !< Zonal velocity [L T-1 ~> m s-1] or [m s-1]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - intent(in) :: v !< Meridional velocity [m s-1]. + intent(in) :: v !< Meridional velocity [L T-1 ~> m s-1] or [m s-1].. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]. - integer, optional, intent(in) :: haloshift !< The width of halos to check (default 0). - logical, optional, intent(in) :: symmetric !< If true, do checksums on the fully symmetric - !! computationoal domain. - + intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]. + type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type, which is + !! used to rescale u and v if present. + integer, optional, intent(in) :: haloshift !< The width of halos to check (default 0). + logical, optional, intent(in) :: symmetric !< If true, do checksums on the fully + !! symmetric computational domain. + real :: L_T_to_m_s ! A rescaling factor for velocities [m T s-1 L-1 ~> nondim] or [nondim] integer :: is, ie, js, je, nz, hs logical :: sym + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke + L_T_to_m_s = 1.0 ; if (present(US)) L_T_to_m_s = US%L_T_to_m_s ! Note that for the chksum calls to be useful for reproducing across PE ! counts, there must be no redundant points, so all variables use is..ie ! and js...je as their extent. hs=1; if (present(haloshift)) hs=haloshift sym=.false.; if (present(symmetric)) sym=symmetric - call uvchksum(mesg//" u", u, v, G%HI,haloshift=hs, symmetric=sym) + call uvchksum(mesg//" u", u, v, G%HI, haloshift=hs, symmetric=sym, scale=L_T_to_m_s) call hchksum(h, mesg//" h",G%HI, haloshift=hs, scale=GV%H_to_m) end subroutine MOM_state_chksum_3arg @@ -138,7 +142,7 @@ subroutine MOM_surface_chksum(mesg, sfc, G, haloshift, symmetric) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. integer, optional, intent(in) :: haloshift !< The width of halos to check (default 0). logical, optional, intent(in) :: symmetric !< If true, do checksums on the fully symmetric - !! computationoal domain. + !! computational domain. integer :: hs logical :: sym @@ -195,7 +199,7 @@ subroutine MOM_accel_chksum(mesg, CAu, CAv, PFu, PFv, diffu, diffv, G, GV, US, p optional, intent(in) :: v_accel_bt !< The meridional acceleration from terms in !! the barotropic solver [L T-2 ~> m s-2]. logical, optional, intent(in) :: symmetric !< If true, do checksums on the fully symmetric - !! computationoal domain. + !! computational domain. integer :: is, ie, js, je, nz logical :: sym @@ -219,47 +223,56 @@ end subroutine MOM_accel_chksum ! ============================================================================= !> Monitor and write out statistics for the model's state variables. -subroutine MOM_state_stats(mesg, u, v, h, Temp, Salt, G, allowChange, permitDiminishing) +subroutine MOM_state_stats(mesg, u, v, h, Temp, Salt, G, GV, US, allowChange, permitDiminishing) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. character(len=*), intent(in) :: mesg !< A message that appears on the chksum lines. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & - intent(in) :: u !< The zonal velocity [m s-1]. + intent(in) :: u !< The zonal velocity [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - intent(in) :: v !< The meridional velocity [m s-1]. + intent(in) :: v !< The meridional velocity [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]. real, pointer, dimension(:,:,:), & intent(in) :: Temp !< Temperature [degC]. real, pointer, dimension(:,:,:), & intent(in) :: Salt !< Salinity [ppt]. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type logical, optional, intent(in) :: allowChange !< do not flag an error !! if the statistics change. - logical, optional, intent(in) :: permitDiminishing !< do not flag error - !!if the extrema are diminishing. + logical, optional, intent(in) :: permitDiminishing !< do not flag error if the + !! extrema are diminishing. + ! Local variables - integer :: is, ie, js, je, nz, i, j, k - real :: Vol, dV, Area, h_minimum + real :: Vol, dV ! The total ocean volume and its change [m3] (unscaled to permit reproducing sum). + real :: Area ! The total ocean surface area [m2] (unscaled to permit reproducing sum). + real :: h_minimum ! The minimum layer thicknesses [H ~> m or kg m-2] + logical :: do_TS ! If true, evaluate statistics for temperature and salinity type(stats) :: T, S, delT, delS - type(stats), save :: oldT, oldS ! NOTE: save data is not normally allowed but - logical, save :: firstCall = .true. ! we use it for debugging purposes here on the - logical :: do_TS - real, save :: oldVol ! assumption we will not turn this on with threads + + ! NOTE: save data is not normally allowed but we use it for debugging purposes here on the + ! assumption we will not turn this on with threads + type(stats), save :: oldT, oldS + logical, save :: firstCall = .true. + real, save :: oldVol ! The previous total ocean volume [m3] + character(len=80) :: lMsg - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke + integer :: is, ie, js, je, nz, i, j, k + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke do_TS = associated(Temp) .and. associated(Salt) ! First collect local stats Area = 0. ; Vol = 0. do j = js, je ; do i = is, ie - Area = Area + G%US%L_to_m**2*G%areaT(i,j) + Area = Area + US%L_to_m**2*G%areaT(i,j) enddo ; enddo T%minimum = 1.E34 ; T%maximum = -1.E34 ; T%average = 0. S%minimum = 1.E34 ; S%maximum = -1.E34 ; S%average = 0. - h_minimum = 1.E34 + h_minimum = 1.E34*GV%m_to_H do k = 1, nz ; do j = js, je ; do i = is, ie if (G%mask2dT(i,j)>0.) then - dV = G%US%L_to_m**2*G%areaT(i,j)*h(i,j,k) ; Vol = Vol + dV + dV = US%L_to_m**2*G%areaT(i,j)*GV%H_to_m*h(i,j,k) ; Vol = Vol + dV if (do_TS .and. h(i,j,k)>0.) then T%minimum = min( T%minimum, Temp(i,j,k) ) ; T%maximum = max( T%maximum, Temp(i,j,k) ) T%average = T%average + dV*Temp(i,j,k) @@ -282,7 +295,7 @@ subroutine MOM_state_stats(mesg, u, v, h, Temp, Salt, G, allowChange, permitDimi delT%average = T%average - oldT%average delS%minimum = S%minimum - oldS%minimum ; delS%maximum = S%maximum - oldS%maximum delS%average = S%average - oldS%average - write(lMsg(1:80),'(2(a,es12.4))') 'Mean thickness =',Vol/Area,' frac. delta=',dV/Vol + write(lMsg(1:80),'(2(a,es12.4))') 'Mean thickness =', Vol/Area,' frac. delta=',dV/Vol call MOM_mesg(lMsg//trim(mesg)) if (do_TS) then write(lMsg(1:80),'(a,3es12.4)') 'Temp min/mean/max =',T%minimum,T%average,T%maximum @@ -295,12 +308,12 @@ subroutine MOM_state_stats(mesg, u, v, h, Temp, Salt, G, allowChange, permitDimi call MOM_mesg(lMsg//trim(mesg)) endif else - write(lMsg(1:80),'(a,es12.4)') 'Mean thickness =',Vol/Area + write(lMsg(1:80),'(a,es12.4)') 'Mean thickness =', Vol/Area call MOM_mesg(lMsg//trim(mesg)) if (do_TS) then - write(lMsg(1:80),'(a,3es12.4)') 'Temp min/mean/max =',T%minimum,T%average,T%maximum + write(lMsg(1:80),'(a,3es12.4)') 'Temp min/mean/max =', T%minimum, T%average, T%maximum call MOM_mesg(lMsg//trim(mesg)) - write(lMsg(1:80),'(a,3es12.4)') 'Salt min/mean/max =',S%minimum,S%average,S%maximum + write(lMsg(1:80),'(a,3es12.4)') 'Salt min/mean/max =', S%minimum, S%average, S%maximum call MOM_mesg(lMsg//trim(mesg)) endif endif @@ -312,10 +325,10 @@ subroutine MOM_state_stats(mesg, u, v, h, Temp, Salt, G, allowChange, permitDimi if (do_TS .and. T%minimum<-5.0) then do j = js, je ; do i = is, ie if (minval(Temp(i,j,:)) == T%minimum) then - write(0,'(a,2f12.5)') 'x,y=',G%geoLonT(i,j),G%geoLatT(i,j) + write(0,'(a,2f12.5)') 'x,y=', G%geoLonT(i,j), G%geoLatT(i,j) write(0,'(a3,3a12)') 'k','h','Temp','Salt' do k = 1, nz - write(0,'(i3,3es12.4)') k,h(i,j,k),Temp(i,j,k),Salt(i,j,k) + write(0,'(i3,3es12.4)') k, h(i,j,k), Temp(i,j,k), Salt(i,j,k) enddo stop 'Extremum detected' endif @@ -328,7 +341,7 @@ subroutine MOM_state_stats(mesg, u, v, h, Temp, Salt, G, allowChange, permitDimi write(0,'(a,2f12.5)') 'x,y=',G%geoLonT(i,j),G%geoLatT(i,j) write(0,'(a3,3a12)') 'k','h','Temp','Salt' do k = 1, nz - write(0,'(i3,3es12.4)') k,h(i,j,k),Temp(i,j,k),Salt(i,j,k) + write(0,'(i3,3es12.4)') k, h(i,j,k), Temp(i,j,k), Salt(i,j,k) enddo stop 'Negative thickness detected' endif From a2cbca6853f4bdd0e2ee81f5f0790fba7dccd3f9 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 13 Aug 2019 05:43:51 -0400 Subject: [PATCH 195/297] +Pass velocities to diabatic in [L T-1] Passed the velocity arguments to diabatic and set_int_tide_input in rescaled units of [L T-1]. All answers are bitwise identical, but the rescaled units of several arguments in public interfaces have changed. --- src/core/MOM.F90 | 16 ++ .../vertical/MOM_diabatic_driver.F90 | 184 +++++++++--------- .../vertical/MOM_internal_tide_input.F90 | 4 +- 3 files changed, 107 insertions(+), 97 deletions(-) diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index 9f87cc45ed..13dcc7dcce 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -1186,9 +1186,25 @@ subroutine step_MOM_thermo(CS, G, GV, US, u, v, h, tv, fluxes, dtdia, & endif call cpu_clock_begin(id_clock_diabatic) + !### This will be removed later. + do k=1,nz ; do j=G%jsd,G%jed ; do I=G%IsdB,G%IedB + u(I,j,k) = US%m_s_to_L_T*u(I,j,k) + enddo ; enddo ; enddo + do k=1,nz ; do J=G%JsdB,G%JedB ; do i=G%isd,G%ied + v(i,J,k) = US%m_s_to_L_T*v(i,J,k) + enddo ; enddo ; enddo + 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. + + !### This will be removed later. + do k=1,nz ; do j=G%jsd,G%jed ; do I=G%IsdB,G%IedB + u(I,j,k) = US%L_T_to_m_s*u(I,j,k) + enddo ; enddo ; enddo + do k=1,nz ; do J=G%JsdB,G%JedB ; do i=G%isd,G%ied + v(i,J,k) = US%L_T_to_m_s*v(i,J,k) + enddo ; enddo ; enddo call cpu_clock_end(id_clock_diabatic) if (showCallTree) call callTree_waypoint("finished diabatic (step_MOM_thermo)") diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index fc126b94a2..52dfe4f845 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -259,8 +259,8 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & 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(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: u !< zonal velocity [L T-1 ~> m s-1] + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: v !< meridional velocity [L T-1 ~> 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 @@ -315,16 +315,16 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & 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_state_chksum("Start of diabatic ", u, v, h, G, GV, US, 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%debugConservation) call MOM_state_stats('Start of diabatic', u, v, h, tv%T, tv%S, G, GV, US) 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(US%m_s_to_L_T*u(:,:,:), US%m_s_to_L_T*v(:,:,:), h, fluxes, visc, G, GV, US, CS%set_diff_CSp) + 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. @@ -352,7 +352,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & 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%debugConservation) call MOM_state_stats('1st make_frazil', u, v, h, tv%T, tv%S, G, GV, US) if (CS%use_int_tides) then @@ -371,7 +371,6 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & 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) @@ -384,7 +383,6 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & 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) @@ -414,7 +412,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & 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) + if (CS%debugConservation) call MOM_state_stats('2nd make_frazil', u, v, h, tv%T, tv%S, G, GV, US) call disable_averaging(CS%diag) endif ! endif for frazil @@ -438,7 +436,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & endif call disable_averaging(CS%diag) - if (CS%debugConservation) call MOM_state_stats('leaving diabatic', u, v, h, tv%T, tv%S, G) + if (CS%debugConservation) call MOM_state_stats('leaving diabatic', u, v, h, tv%T, tv%S, G, GV, US) end subroutine diabatic @@ -451,8 +449,8 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim 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(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: u !< zonal velocity [L T-1 ~> m s-1] + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: v !< meridional velocity [L T-1 ~> 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 @@ -489,7 +487,7 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim 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] + v_h ! entrainment [L T-1 ~> m s-1] 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 @@ -578,7 +576,7 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim 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) + if (CS%debugConservation) call MOM_state_stats('geothermal', u, v, h, tv%T, tv%S, G, GV, US) endif ! Whenever thickness changes let the diag manager know, target grids @@ -591,7 +589,7 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim if (associated(CS%optics)) & 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) + if (CS%debug) call MOM_state_chksum("before find_uv_at_h", u, v, h, G, GV, US, haloshift=0) if (CS%use_kappa_shear .or. CS%use_CVMix_shear) then if (CS%use_geothermal) then @@ -609,8 +607,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(US%m_s_to_L_T*u(:,:,:), US%m_s_to_L_T*v(:,:,:), h, & - US%m_s_to_L_T*u_h(:,:,:), US%m_s_to_L_T*v_h(:,:,:), tv, fluxes, CS%optics, & + 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)") @@ -639,7 +636,7 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim endif if (CS%debug) then - call MOM_state_chksum("after set_diffusivity ", u, v, h, G, GV, haloshift=0) + call MOM_state_chksum("after set_diffusivity ", u, v, h, G, GV, US, 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) @@ -665,8 +662,7 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim 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, & - US%m_s_to_L_T*u(:,:,:), US%m_s_to_L_T*v(:,:,:), tv%eqn_of_state, & + 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, & @@ -703,7 +699,7 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim 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_state_chksum("after KPP", u, v, h, G, GV, US, 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%Z2_T_to_m2_s) @@ -727,10 +723,10 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim 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%debugConservation) call MOM_state_stats('KPP_applyNonLocalTransport', u, v, h, tv%T, tv%S, G, GV, US) if (CS%debug) then - call MOM_state_chksum("after KPP_applyNLT ", u, v, h, G, GV, haloshift=0) + call MOM_state_chksum("after KPP_applyNLT ", u, v, h, G, GV, US, haloshift=0) call MOM_forcing_chksum("after KPP_applyNLT ", fluxes, G, US, haloshift=0) call MOM_thermovar_chksum("after KPP_applyNLT ", tv, G) endif @@ -746,7 +742,7 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim 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) + if (CS%debugConservation) call MOM_state_stats('differential_diffuse_T_S', u, v, h, tv%T, tv%S, G, GV, US) ! increment heat and salt diffusivity. ! CS%useKPP==.true. already has extra_T and extra_S included @@ -806,7 +802,7 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim 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 MOM_state_chksum("after calc_entrain ", u, v, h, G, GV, US, haloshift=0) 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 @@ -845,8 +841,8 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim endif call find_uv_at_h(u, v, h, u_h, v_h, G, GV, US) - call energetic_PBL(h, US%m_s_to_L_T*u_h(:,:,:), US%m_s_to_L_T*v_h(:,:,:), tv, fluxes, dt_in_T, Kd_ePBL, G, GV, US, & - CS%energetic_PBL_CSp, dSV_dT, dSV_dS, cTKE, SkinBuoyFlux, waves=waves) + 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 call energetic_PBL_get_MLD(CS%energetic_PBL_CSp, Hml(:,:), G, US) @@ -914,10 +910,10 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim 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) + call MOM_state_chksum("after applyBoundaryFluxes ", u, v, h, G, GV, US, 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) + if (CS%debugConservation) call MOM_state_stats('applyBoundaryFluxes', u, v, h, tv%T, tv%S, G, GV, US) ! Update h according to divergence of the difference between ! ea and eb. We keep a record of the original h in hold. @@ -948,12 +944,12 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim endif if (CS%debug) then - call MOM_state_chksum("after negative check ", u, v, h, G, GV, haloshift=0) + call MOM_state_chksum("after negative check ", u, v, h, G, GV, US, 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) + if (CS%debugConservation) call MOM_state_stats('h=ea-eb', u, v, h, tv%T, tv%S, G, GV, US) ! calculate change in temperature & salinity due to dia-coordinate surface diffusion if (associated(tv%T)) then @@ -1038,10 +1034,10 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim 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%debugConservation) call MOM_state_stats('triDiagTS', u, v, h, tv%T, tv%S, G, GV, US) if (CS%debug) then - call MOM_state_chksum("after mixed layer ", u, v, h, G, GV, haloshift=0) + call MOM_state_chksum("after mixed layer ", u, v, h, G, GV, US, haloshift=0) call MOM_thermovar_chksum("after mixed layer ", tv, G) endif @@ -1192,7 +1188,7 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim 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_state_chksum("apply_sponge ", u, v, h, G, GV, US, haloshift=0) call MOM_thermovar_chksum("apply_sponge ", tv, G) endif endif ! CS%use_sponge @@ -1236,8 +1232,8 @@ subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, 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(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: u !< zonal velocity [L T-1 ~> m s-1] + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: v !< meridional velocity [L T-1 ~> 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 @@ -1274,7 +1270,7 @@ subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, 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] + v_h ! entrainment [L T-1 ~> m s-1] 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 @@ -1365,7 +1361,7 @@ subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, 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) + if (CS%debugConservation) call MOM_state_stats('geothermal', u, v, h, tv%T, tv%S, G, GV, US) endif ! Whenever thickness changes let the diag manager know, target grids @@ -1378,7 +1374,7 @@ subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, if (associated(CS%optics)) & 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) + if (CS%debug) call MOM_state_chksum("before find_uv_at_h", u, v, h, G, GV, US, haloshift=0) if (CS%use_kappa_shear .or. CS%use_CVMix_shear) then if (CS%use_geothermal) then @@ -1396,14 +1392,13 @@ 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(US%m_s_to_L_T*u(:,:,:), US%m_s_to_L_T*v(:,:,:), h, & - US%m_s_to_L_T*u_h(:,:,:), US%m_s_to_L_T*v_h(:,:,:), tv, fluxes, CS%optics, & + 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)") if (CS%debug) then - call MOM_state_chksum("after set_diffusivity ", u, v, h, G, GV, haloshift=0) + call MOM_state_chksum("after set_diffusivity ", u, v, h, G, GV, US, 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) @@ -1451,8 +1446,7 @@ subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, 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, & - US%m_s_to_L_T*u(:,:,:), US%m_s_to_L_T*v(:,:,:), tv%eqn_of_state, & + 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, & @@ -1470,7 +1464,7 @@ subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, 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_state_chksum("after KPP", u, v, h, G, GV, US, 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%Z2_T_to_m2_s) @@ -1494,10 +1488,10 @@ subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, 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%debugConservation) call MOM_state_stats('KPP_applyNonLocalTransport', u, v, h, tv%T, tv%S, G, GV, US) if (CS%debug) then - call MOM_state_chksum("after KPP_applyNLT ", u, v, h, G, GV, haloshift=0) + call MOM_state_chksum("after KPP_applyNLT ", u, v, h, G, GV, US, haloshift=0) call MOM_forcing_chksum("after KPP_applyNLT ", fluxes, G, US, haloshift=0) call MOM_thermovar_chksum("after KPP_applyNLT ", tv, G) endif @@ -1513,7 +1507,7 @@ subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, 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) + if (CS%debugConservation) call MOM_state_stats('differential_diffuse_T_S', u, v, h, tv%T, tv%S, G, GV, US) ! increment heat and salt diffusivity. ! CS%useKPP==.true. already has extra_T and extra_S included @@ -1563,7 +1557,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, & - optics_nbands(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 @@ -1577,8 +1571,8 @@ subroutine diabatic_ALE(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, US) - call energetic_PBL(h, US%m_s_to_L_T*u_h(:,:,:), US%m_s_to_L_T*v_h(:,:,:), tv, fluxes, dt_in_T, Kd_ePBL, G, GV, US, & - CS%energetic_PBL_CSp, dSV_dT, dSV_dS, cTKE, SkinBuoyFlux, waves=waves) + 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 call energetic_PBL_get_MLD(CS%energetic_PBL_CSp, Hml(:,:), G, US) @@ -1634,13 +1628,13 @@ subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, 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) + call MOM_state_chksum("after applyBoundaryFluxes ", u, v, h, G, GV, US, 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) + if (CS%debugConservation) call MOM_state_stats('applyBoundaryFluxes', u, v, h, tv%T, tv%S, G, GV, US) 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) + if (CS%debugConservation) call MOM_state_stats('h=ea-eb', u, v, h, tv%T, tv%S, G, GV, US) ! calculate change in temperature & salinity due to dia-coordinate surface diffusion if (associated(tv%T)) then @@ -1722,10 +1716,10 @@ subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, 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%debugConservation) call MOM_state_stats('triDiagTS', u, v, h, tv%T, tv%S, G, GV, US) if (CS%debug) then - call MOM_state_chksum("after mixed layer ", u, v, h, G, GV, haloshift=0) + call MOM_state_chksum("after mixed layer ", u, v, h, G, GV, US, haloshift=0) call MOM_thermovar_chksum("after mixed layer ", tv, G) endif @@ -1863,7 +1857,7 @@ subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, 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_state_chksum("apply_sponge ", u, v, h, G, GV, US, haloshift=0) call MOM_thermovar_chksum("apply_sponge ", tv, G) endif endif ! CS%use_sponge @@ -1917,8 +1911,8 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e 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(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: u !< zonal velocity [L T-1 ~> m s-1] + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: v !< meridional velocity [L T-1 ~> 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 @@ -1950,7 +1944,7 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e 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] + v_h ! entrainment [L T-1 ~> m s-1] 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 @@ -2018,6 +2012,7 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e 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 [T ~> s] real :: Idt ! The inverse time step [s-1] + real :: Idt_accel ! The inverse time step times rescaling factors [m T L-1 s-2 ~> 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. @@ -2057,7 +2052,7 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e 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) + if (CS%debugConservation) call MOM_state_stats('geothermal', u, v, h, tv%T, tv%S, G, GV, US) endif ! Whenever thickness changes let the diag manager know, target grids @@ -2086,7 +2081,7 @@ 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, US%m_s_to_L_T*u_h(:,:,:), US%m_s_to_L_T*v_h(:,:,:), tv, fluxes, dt_in_T*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_in_T, last_call=.false.) if (CS%salt_reject_below_ML) & @@ -2094,7 +2089,7 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e 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, US%m_s_to_L_T*u_h(:,:,:), US%m_s_to_L_T*v_h(:,:,:), tv, fluxes, dt_in_T, 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_in_T, last_call=.true.) endif @@ -2109,16 +2104,16 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e call adjust_salt(h, tv, G, GV, CS%diabatic_aux_CSp) call cpu_clock_end(id_clock_mixedlayer) if (CS%debug) then - call MOM_state_chksum("After mixedlayer ", u, v, h, G, GV, haloshift=0) + call MOM_state_chksum("After mixedlayer ", u, v, h, G, GV, US, haloshift=0) call MOM_forcing_chksum("After mixedlayer", fluxes, G, US, haloshift=0) endif if (showCallTree) call callTree_waypoint("done with 1st bulkmixedlayer (diabatic)") - if (CS%debugConservation) call MOM_state_stats('1st bulkmixedlayer', u, v, h, tv%T, tv%S, G) + if (CS%debugConservation) call MOM_state_stats('1st bulkmixedlayer', u, v, h, tv%T, tv%S, G, GV, US) endif endif if (CS%debug) & - call MOM_state_chksum("before find_uv_at_h", u, v, h, G, GV, haloshift=0) + call MOM_state_chksum("before find_uv_at_h", u, v, h, G, GV, US, 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, US, eaml, ebml) @@ -2140,14 +2135,13 @@ 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(US%m_s_to_L_T*u(:,:,:), US%m_s_to_L_T*v(:,:,:), h, & - US%m_s_to_L_T*u_h(:,:,:), US%m_s_to_L_T*v_h(:,:,:), tv, fluxes, CS%optics, & + 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)") if (CS%debug) then - call MOM_state_chksum("after set_diffusivity ", u, v, h, G, GV, haloshift=0) + call MOM_state_chksum("after set_diffusivity ", u, v, h, G, GV, US, 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) @@ -2187,8 +2181,7 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e enddo ; enddo ; enddo endif - call KPP_compute_BLD(CS%KPP_CSp, G, GV, US, h, tv%T, tv%S, & - US%m_s_to_L_T*u(:,:,:), US%m_s_to_L_T*v(:,:,:), tv%eqn_of_state, & + 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, & @@ -2223,7 +2216,7 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e 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_state_chksum("after KPP", u, v, h, G, GV, US, 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) @@ -2256,10 +2249,10 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e 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%debugConservation) call MOM_state_stats('KPP_applyNonLocalTransport', u, v, h, tv%T, tv%S, G, GV, US) if (CS%debug) then - call MOM_state_chksum("after KPP_applyNLT ", u, v, h, G, GV, haloshift=0) + call MOM_state_chksum("after KPP_applyNLT ", u, v, h, G, GV, US, haloshift=0) call MOM_forcing_chksum("after KPP_applyNLT ", fluxes, G, US, haloshift=0) call MOM_thermovar_chksum("after KPP_applyNLT ", tv, G) endif @@ -2273,7 +2266,7 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e 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) + if (CS%debugConservation) call MOM_state_stats('differential_diffuse_T_S', u, v, h, tv%T, tv%S, G, GV, US) ! increment heat and salt diffusivity. ! CS%useKPP==.true. already has extra_T and extra_S included @@ -2303,7 +2296,7 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e 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 MOM_state_chksum("after calc_entrain ", u, v, h, G, GV, US, 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 @@ -2352,12 +2345,12 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e 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_state_chksum("after negative check ", u, v, h, G, GV, US, 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) + if (CS%debugConservation) call MOM_state_stats('h=ea-eb', u, v, h, tv%T, tv%S, G, GV, US) ! Here, T and S are updated according to ea and eb. ! If using the bulk mixed layer, T and S are also updated @@ -2449,7 +2442,7 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e call cpu_clock_end(id_clock_tridiag) endif ! endif for associated(T) - if (CS%debugConservation) call MOM_state_stats('BML tridiag', u, v, h, tv%T, tv%S, G) + if (CS%debugConservation) call MOM_state_stats('BML tridiag', u, v, h, tv%T, tv%S, G, GV, US) if ((CS%ML_mix_first > 0.0) .or. CS%use_geothermal) then ! The mixed layer code has already been called, but there is some needed @@ -2476,12 +2469,12 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e ! (5) Possibly splits the buffer layer into two isopycnal layers. call find_uv_at_h(u, v, hold, u_h, v_h, G, GV, US, ea, eb) - if (CS%debug) call MOM_state_chksum("find_uv_at_h1 ", u, v, h, G, GV, haloshift=0) + if (CS%debug) call MOM_state_chksum("find_uv_at_h1 ", u, v, h, G, GV, US, haloshift=0) 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, US%m_s_to_L_T*u_h(:,:,:), US%m_s_to_L_T*v_h(:,:,:), tv, fluxes, dt_mix, ea, eb, & + 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_in_T, last_call=.true.) @@ -2500,7 +2493,7 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e call cpu_clock_end(id_clock_mixedlayer) if (showCallTree) call callTree_waypoint("done with 2nd bulkmixedlayer (diabatic)") - if (CS%debugConservation) call MOM_state_stats('2nd bulkmixedlayer', u, v, h, tv%T, tv%S, G) + if (CS%debugConservation) call MOM_state_stats('2nd bulkmixedlayer', u, v, h, tv%T, tv%S, G, GV, US) endif else ! following block for when NOT using BULKMIXEDLAYER @@ -2550,12 +2543,12 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e 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%debugConservation) call MOM_state_stats('triDiagTS', u, v, h, tv%T, tv%S, G, GV, US) endif ! endif for the BULKMIXEDLAYER block if (CS%debug) then - call MOM_state_chksum("after mixed layer ", u, v, h, G, GV, haloshift=0) + call MOM_state_chksum("after mixed layer ", u, v, h, G, GV, US, 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) @@ -2565,7 +2558,7 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e 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) + if (CS%debugConservation) call MOM_state_stats('regularize_layers', u, v, h, tv%T, tv%S, G, GV, US) ! Whenever thickness changes let the diag manager know, as the ! target grids for vertical remapping may need to be regenerated. @@ -2702,7 +2695,7 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e 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) + call MOM_state_chksum("apply_sponge ", u, v, h, G, GV, US, haloshift=0) call MOM_thermovar_chksum("apply_sponge ", tv, G) endif endif ! CS%use_sponge @@ -2769,12 +2762,13 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e ! 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 MOM_state_chksum("before u/v tridiag ", u, v, h, G, GV, US, 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) + Idt_accel = US%L_T_to_m_s / dt !$OMP parallel do default(shared) private(hval,b1,d1,c1,eaval) do j=js,je do I=Isq,Ieq @@ -2796,16 +2790,16 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e 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 + ADp%du_dt_dia(I,j,k) = (u(I,j,k) - ADp%du_dt_dia(I,j,k)) * Idt_accel 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 + ADp%du_dt_dia(I,j,nz) = (u(I,j,nz)-ADp%du_dt_dia(I,j,nz)) * Idt_accel enddo endif enddo if (CS%debug) then - call MOM_state_chksum("aft 1st loop tridiag ", u, v, h, G, GV, haloshift=0) + call MOM_state_chksum("aft 1st loop tridiag ", u, v, h, G, GV, US, haloshift=0) endif !$OMP parallel do default(shared) private(hval,b1,d1,c1,eaval) do J=Jsq,Jeq @@ -2828,17 +2822,17 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e 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 + ADp%dv_dt_dia(i,J,k) = (v(i,J,k) - ADp%dv_dt_dia(i,J,k)) * Idt_accel 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 + ADp%dv_dt_dia(i,J,nz) = (v(i,J,nz)-ADp%dv_dt_dia(i,J,nz)) * Idt_accel 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) + call MOM_state_chksum("after u/v tridiag ", u, v, h, G, GV, US, haloshift=0) endif call disable_averaging(CS%diag) @@ -3441,9 +3435,9 @@ subroutine diabatic_driver_init(Time, G, GV, US, param_file, useALEalgorithm, di ! diagnostics for values prior to diabatic and prior to ALE CS%id_u_predia = register_diag_field('ocean_model', 'u_predia', diag%axesCuL, Time, & - 'Zonal velocity before diabatic forcing', 'm s-1') + 'Zonal velocity before diabatic forcing', 'm s-1', conversion=US%L_T_to_m_s) CS%id_v_predia = register_diag_field('ocean_model', 'v_predia', diag%axesCvL, Time, & - 'Meridional velocity before diabatic forcing', 'm s-1') + 'Meridional velocity before diabatic forcing', 'm s-1', conversion=US%L_T_to_m_s) CS%id_h_predia = register_diag_field('ocean_model', 'h_predia', diag%axesTL, Time, & 'Layer Thickness before diabatic forcing', thickness_units, v_extensive=.true.) CS%id_e_predia = register_diag_field('ocean_model', 'e_predia', diag%axesTi, Time, & diff --git a/src/parameterizations/vertical/MOM_internal_tide_input.F90 b/src/parameterizations/vertical/MOM_internal_tide_input.F90 index 2f51d22b91..79c1b744f0 100644 --- a/src/parameterizations/vertical/MOM_internal_tide_input.F90 +++ b/src/parameterizations/vertical/MOM_internal_tide_input.F90 @@ -75,8 +75,8 @@ subroutine set_int_tide_input(u, v, h, tv, fluxes, itide, dt, 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 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(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: u !< The zonal velocity [L T-1 ~> m s-1] + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: v !< The meridional velocity [L T-1 ~> 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 the !! thermodynamic fields From e35c52af1b93fa10e182a709755ed4aec00c9693 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 13 Aug 2019 09:04:08 -0400 Subject: [PATCH 196/297] +Added optional vel_scale argument to MOM_state_chksum_5arg Added an optional velocity rescaling argument, vel_scale, to MOM_state_chksum_5arg. All answers are bitwise identical. --- src/core/MOM.F90 | 12 ++++++------ src/core/MOM_checksum_packages.F90 | 18 +++++++++++------- src/core/MOM_dynamics_split_RK2.F90 | 18 +++++++++--------- src/core/MOM_dynamics_unsplit.F90 | 8 ++++---- src/core/MOM_dynamics_unsplit_RK2.F90 | 6 +++--- src/core/MOM_variables.F90 | 4 ++-- src/diagnostics/MOM_diagnostics.F90 | 4 ++-- .../vertical/MOM_diabatic_driver.F90 | 8 ++++---- 8 files changed, 41 insertions(+), 37 deletions(-) diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index 13dcc7dcce..20ccc33694 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -492,7 +492,7 @@ subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, CS, & call cpu_clock_begin(id_clock_other) if (CS%debug) then - call MOM_state_chksum("Beginning of step_MOM ", u, v, h, CS%uh, CS%vh, G, GV, US) + call MOM_state_chksum("Beginning of step_MOM ", u, v, h, CS%uh, CS%vh, G, GV, US, vel_scale=1.0) endif showCallTree = callTree_showQuery() @@ -598,7 +598,7 @@ subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, CS, & if (CS%debug) then if (cycle_start) & - call MOM_state_chksum("Before steps ", u, v, h, CS%uh, CS%vh, G, GV, US) + call MOM_state_chksum("Before steps ", u, v, h, CS%uh, CS%vh, G, GV, US, vel_scale=1.0) if (cycle_start) call check_redundant("Before steps ", u, v, G) if (do_dyn) call MOM_mech_forcing_chksum("Before steps", forces, G, US, haloshift=0) if (do_dyn) call check_redundant("Before steps ", forces%taux, forces%tauy, G) @@ -1179,7 +1179,7 @@ subroutine step_MOM_thermo(CS, G, GV, US, u, v, h, tv, fluxes, dtdia, & call hchksum(h,"Pre-diabatic h", G%HI, haloshift=1, scale=GV%H_to_m) call uvchksum("Pre-diabatic [uv]h", CS%uhtr, CS%vhtr, G%HI, & haloshift=0, scale=GV%H_to_m*US%L_to_m**2) - ! call MOM_state_chksum("Pre-diabatic ",u, v, h, CS%uhtr, CS%vhtr, G, GV) + ! call MOM_state_chksum("Pre-diabatic ", u, v, h, CS%uhtr, CS%vhtr, G, GV, vel_scale=1.0) call MOM_thermo_chksum("Pre-diabatic ", tv, G,haloshift=0) call check_redundant("Pre-diabatic ", u, v, G) call MOM_forcing_chksum("Pre-diabatic", fluxes, G, US, haloshift=0) @@ -1225,7 +1225,7 @@ subroutine step_MOM_thermo(CS, G, GV, US, u, v, h, tv, fluxes, dtdia, & call preAle_tracer_diagnostics(CS%tracer_Reg, G, GV) if (CS%debug) then - call MOM_state_chksum("Pre-ALE ", u, v, h, CS%uh, CS%vh, G, GV, US) + call MOM_state_chksum("Pre-ALE ", u, v, h, CS%uh, CS%vh, G, GV, US, vel_scale=1.0) call hchksum(tv%T,"Pre-ALE T", G%HI, haloshift=1) call hchksum(tv%S,"Pre-ALE S", G%HI, haloshift=1) call check_redundant("Pre-ALE ", u, v, G) @@ -1252,7 +1252,7 @@ subroutine step_MOM_thermo(CS, G, GV, US, u, v, h, tv, fluxes, dtdia, & call do_group_pass(pass_uv_T_S_h, G%Domain, clock=id_clock_pass) if (CS%debug .and. CS%use_ALE_algorithm) then - call MOM_state_chksum("Post-ALE ", u, v, h, CS%uh, CS%vh, G, GV, US) + call MOM_state_chksum("Post-ALE ", u, v, h, CS%uh, CS%vh, G, GV, US, vel_scale=1.0) call hchksum(tv%T, "Post-ALE T", G%HI, haloshift=1) call hchksum(tv%S, "Post-ALE S", G%HI, haloshift=1) call check_redundant("Post-ALE ", u, v, G) @@ -1272,7 +1272,7 @@ subroutine step_MOM_thermo(CS, G, GV, US, u, v, h, tv, fluxes, dtdia, & call uvchksum("Post-diabatic [uv]h", CS%uhtr, CS%vhtr, G%HI, & haloshift=0, scale=GV%H_to_m*US%L_to_m**2) ! call MOM_state_chksum("Post-diabatic ", u, v, & - ! h, CS%uhtr, CS%vhtr, G, GV, haloshift=1) + ! h, CS%uhtr, CS%vhtr, G, GV, haloshift=1, vel_scale=1.0) if (associated(tv%T)) call hchksum(tv%T, "Post-diabatic T", G%HI, haloshift=1) if (associated(tv%S)) call hchksum(tv%S, "Post-diabatic S", G%HI, haloshift=1) if (associated(tv%frazil)) call hchksum(tv%frazil, & diff --git a/src/core/MOM_checksum_packages.F90 b/src/core/MOM_checksum_packages.F90 index 36d69a8179..e8347881f7 100644 --- a/src/core/MOM_checksum_packages.F90 +++ b/src/core/MOM_checksum_packages.F90 @@ -39,15 +39,15 @@ module MOM_checksum_packages ! ============================================================================= !> Write out chksums for the model's basic state variables, including transports. -subroutine MOM_state_chksum_5arg(mesg, u, v, h, uh, vh, G, GV, US, haloshift, symmetric) +subroutine MOM_state_chksum_5arg(mesg, u, v, h, uh, vh, G, GV, US, haloshift, symmetric, vel_scale) 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. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & - intent(in) :: u !< The zonal velocity [m s-1]. + intent(in) :: u !< The zonal velocity [L T-1 ~> m s-1] or other units. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - intent(in) :: v !< The meridional velocity [m s-1]. + intent(in) :: v !< The meridional velocity [L T-1 ~> m s-1] or other units. 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)), & @@ -60,17 +60,21 @@ subroutine MOM_state_chksum_5arg(mesg, u, v, h, uh, vh, G, GV, US, haloshift, sy integer, optional, intent(in) :: haloshift !< The width of halos to check (default 0). logical, optional, intent(in) :: symmetric !< If true, do checksums on the fully symmetric !! computational domain. + real, optional, intent(in) :: vel_scale !< The scaling factor to convert velocities to [m s-1] - integer :: is, ie, js, je, nz, hs + real :: scale_vel ! The scaling factor to convert velocities to [m s-1] logical :: sym + integer :: is, ie, js, je, nz, hs is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke ! Note that for the chksum calls to be useful for reproducing across PE ! counts, there must be no redundant points, so all variables use is..ie ! and js...je as their extent. - hs=1; if (present(haloshift)) hs=haloshift - sym=.false.; if (present(symmetric)) sym=symmetric - call uvchksum(mesg//" [uv]", u, v, G%HI, haloshift=hs, symmetric=sym) + hs = 1 ; if (present(haloshift)) hs=haloshift + sym = .false. ; if (present(symmetric)) sym=symmetric + scale_vel = US%L_T_to_m_s ; if (present(vel_scale)) scale_vel = vel_scale + + call uvchksum(mesg//" [uv]", u, v, G%HI, haloshift=hs, symmetric=sym, scale=scale_vel) call hchksum(h, mesg//" h", G%HI, haloshift=hs, scale=GV%H_to_m) call uvchksum(mesg//" [uv]h", uh, vh, G%HI, haloshift=hs, & symmetric=sym, scale=GV%H_to_m*US%L_to_m**2*US%s_to_T) diff --git a/src/core/MOM_dynamics_split_RK2.F90 b/src/core/MOM_dynamics_split_RK2.F90 index 4440e2fe72..5cc361913b 100644 --- a/src/core/MOM_dynamics_split_RK2.F90 +++ b/src/core/MOM_dynamics_split_RK2.F90 @@ -355,7 +355,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & call updateCFLtruncationValue(Time_local, CS%vertvisc_CSp) if (CS%debug) then - call MOM_state_chksum("Start predictor ", u, v, h, uh, vh, G, GV, US, symmetric=sym) + call MOM_state_chksum("Start predictor ", u, v, h, uh, vh, G, GV, US, symmetric=sym, vel_scale=1.0) call check_redundant("Start predictor u ", u, v, G) call check_redundant("Start predictor uh ", uh, vh, G) endif @@ -568,11 +568,11 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & call hchksum(h, "Predictor 1 h", G%HI, haloshift=1, scale=GV%H_to_m) call uvchksum("Predictor 1 [uv]h", uh, vh, G%HI,haloshift=2, & symmetric=sym, scale=GV%H_to_m*US%L_to_m**2*US%s_to_T) -! call MOM_state_chksum("Predictor 1", up, vp, h, uh, vh, G, GV, US, haloshift=1) +! call MOM_state_chksum("Predictor 1", up, vp, h, uh, vh, G, GV, US, haloshift=1, vel_scale=1.0) call MOM_accel_chksum("Predictor accel", CS%CAu, CS%CAv, CS%PFu, CS%PFv, & 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, US, haloshift=2, & - symmetric=sym) + symmetric=sym, vel_scale=1.0) call check_redundant("Predictor 1 up", up, vp, G) call check_redundant("Predictor 1 uh", uh, vh, G) endif @@ -677,10 +677,10 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & endif if (CS%debug) then - call MOM_state_chksum("Predictor ", up, vp, hp, uh, vh, G, GV, US, symmetric=sym) + call MOM_state_chksum("Predictor ", up, vp, hp, uh, vh, G, GV, US, symmetric=sym, vel_scale=1.0) call uvchksum("Predictor avg [uv]", u_av, v_av, G%HI, haloshift=1, symmetric=sym) call hchksum(h_av, "Predictor avg h", G%HI, haloshift=0, scale=GV%H_to_m) - ! call MOM_state_chksum("Predictor avg ", u_av, v_av, h_av, uh, vh, G, GV, US) + ! call MOM_state_chksum("Predictor avg ", u_av, v_av, h_av, uh, vh, G, GV, US, vel_scale=1.0) call check_redundant("Predictor up ", up, vp, G) call check_redundant("Predictor uh ", uh, vh, G) endif @@ -772,7 +772,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & call hchksum(h, "Corrector 1 h", G%HI, haloshift=2, scale=GV%H_to_m) call uvchksum("Corrector 1 [uv]h", uh, vh, G%HI, haloshift=2, & symmetric=sym, scale=GV%H_to_m*US%L_to_m**2*US%s_to_T) - ! call MOM_state_chksum("Corrector 1", u, v, h, uh, vh, G, GV, US, haloshift=1) + ! call MOM_state_chksum("Corrector 1", u, v, h, uh, vh, G, GV, US, haloshift=1, vel_scale=1.0) call MOM_accel_chksum("Corrector accel", CS%CAu, CS%CAv, CS%PFu, CS%PFv, & CS%diffu, CS%diffv, G, GV, US, CS%pbce, CS%u_accel_bt, CS%v_accel_bt, & symmetric=sym) @@ -867,10 +867,10 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & if (CS%id_v_BT_accel > 0) call post_data(CS%id_v_BT_accel, CS%v_accel_bt, CS%diag) if (CS%debug) then - call MOM_state_chksum("Corrector ", u, v, h, uh, vh, G, GV, US, symmetric=sym) - call uvchksum("Corrector avg [uv]", u_av, v_av, G%HI,haloshift=1, symmetric=sym) + call MOM_state_chksum("Corrector ", u, v, h, uh, vh, G, GV, US, symmetric=sym, vel_scale=1.0) + call uvchksum("Corrector avg [uv]", u_av, v_av, G%HI, haloshift=1, symmetric=sym) call hchksum(h_av, "Corrector avg h", G%HI, haloshift=1, scale=GV%H_to_m) - ! call MOM_state_chksum("Corrector avg ", u_av, v_av, h_av, uh, vh, G, GV, US) + ! call MOM_state_chksum("Corrector avg ", u_av, v_av, h_av, uh, vh, G, GV, US, vel_scale=1.0) endif if (showCallTree) call callTree_leave("step_MOM_dyn_split_RK2()") diff --git a/src/core/MOM_dynamics_unsplit.F90 b/src/core/MOM_dynamics_unsplit.F90 index 286aa96c77..7d06f3efb7 100644 --- a/src/core/MOM_dynamics_unsplit.F90 +++ b/src/core/MOM_dynamics_unsplit.F90 @@ -249,7 +249,7 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & ! all of the fields except h. h is stepped separately. if (CS%debug) then - call MOM_state_chksum("Start First Predictor ", u, v, h, uh, vh, G, GV, US) + call MOM_state_chksum("Start First Predictor ", u, v, h, uh, vh, G, GV, US, vel_scale=1.0) endif ! diffu = horizontal viscosity terms (u,h) @@ -333,7 +333,7 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & call cpu_clock_end(id_clock_mom_update) if (CS%debug) then - call MOM_state_chksum("Predictor 1", up, vp, h_av, uh, vh, G, GV, US) + call MOM_state_chksum("Predictor 1", up, vp, h_av, uh, vh, G, GV, US, vel_scale=1.0) call MOM_accel_chksum("Predictor 1 accel", CS%CAu, CS%CAv, CS%PFu, CS%PFv,& CS%diffu, CS%diffv, G, GV, US) endif @@ -400,7 +400,7 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & call cpu_clock_end(id_clock_mom_update) if (CS%debug) then - call MOM_state_chksum("Predictor 2", upp, vpp, h_av, uh, vh, G, GV, US) + call MOM_state_chksum("Predictor 2", upp, vpp, h_av, uh, vh, G, GV, US, vel_scale=1.0) call MOM_accel_chksum("Predictor 2 accel", CS%CAu, CS%CAv, CS%PFu, CS%PFv,& CS%diffu, CS%diffv, G, GV, US) endif @@ -484,7 +484,7 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & call pass_vector(u, v, G%Domain, clock=id_clock_pass) if (CS%debug) then - call MOM_state_chksum("Corrector", u, v, h, uh, vh, G, GV, US) + call MOM_state_chksum("Corrector", u, v, h, uh, vh, G, GV, US, vel_scale=1.0) call MOM_accel_chksum("Corrector accel", CS%CAu, CS%CAv, CS%PFu, CS%PFv, & CS%diffu, CS%diffv, G, GV, US) endif diff --git a/src/core/MOM_dynamics_unsplit_RK2.F90 b/src/core/MOM_dynamics_unsplit_RK2.F90 index c3faabf8ba..afc2bf3a29 100644 --- a/src/core/MOM_dynamics_unsplit_RK2.F90 +++ b/src/core/MOM_dynamics_unsplit_RK2.F90 @@ -260,7 +260,7 @@ subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt, ! all of the fields except h. h is stepped separately. if (CS%debug) then - call MOM_state_chksum("Start Predictor ", u_in, v_in, h_in, uh, vh, G, GV, US) + call MOM_state_chksum("Start Predictor ", u_in, v_in, h_in, uh, vh, G, GV, US, vel_scale=1.0) endif ! diffu = horizontal viscosity terms (u,h) @@ -361,7 +361,7 @@ subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt, enddo ; enddo ; enddo if (CS%debug) & - call MOM_state_chksum("Predictor 1", up, vp, h_av, uh, vh, G, GV, US) + call MOM_state_chksum("Predictor 1", up, vp, h_av, uh, vh, G, GV, US, vel_scale=1.0) ! CAu = -(f+zeta(up))/h_av vh + d/dx KE(up) (function of up[n-1/2], h[n-1/2]) call cpu_clock_begin(id_clock_Cor) @@ -423,7 +423,7 @@ subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt, enddo if (CS%debug) then - call MOM_state_chksum("Corrector", u_in, v_in, h_in, uh, vh, G, GV, US) + call MOM_state_chksum("Corrector", u_in, v_in, h_in, uh, vh, G, GV, US, vel_scale=1.0) call MOM_accel_chksum("Corrector accel", CS%CAu, CS%CAv, CS%PFu, CS%PFv, & CS%diffu, CS%diffv, G, GV, US) endif diff --git a/src/core/MOM_variables.F90 b/src/core/MOM_variables.F90 index fc5118a448..33797198a5 100644 --- a/src/core/MOM_variables.F90 +++ b/src/core/MOM_variables.F90 @@ -164,8 +164,8 @@ module MOM_variables PFv => NULL(), & !< Meridional acceleration due to pressure forces [L T-2 ~> m s-2] du_dt_visc => NULL(), &!< Zonal acceleration due to vertical viscosity [m s-2] dv_dt_visc => NULL(), &!< Meridional acceleration due to vertical viscosity [m s-2] - du_dt_dia => NULL(), & !< Zonal acceleration due to diapycnal mixing [m s-2] - dv_dt_dia => NULL() !< Meridional acceleration due to diapycnal mixing [m s-2] + du_dt_dia => NULL(), & !< Zonal acceleration due to diapycnal mixing [L T-2 ~> m s-2] + dv_dt_dia => NULL() !< Meridional acceleration due to diapycnal mixing [L T-2 ~> m s-2] real, pointer, dimension(:,:,:) :: du_other => NULL() !< Zonal velocity changes due to any other processes that are !! not due to any explicit accelerations [m s-1]. diff --git a/src/diagnostics/MOM_diagnostics.F90 b/src/diagnostics/MOM_diagnostics.F90 index 211e8d7741..9662eb0985 100644 --- a/src/diagnostics/MOM_diagnostics.F90 +++ b/src/diagnostics/MOM_diagnostics.F90 @@ -1061,10 +1061,10 @@ subroutine calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, GV, US, CS if (associated(CS%KE_dia)) then do k=1,nz do j=js,je ; do I=Isq,Ieq - KE_u(I,j) = US%s_to_T*uh(I,j,k)*US%L_to_m*G%dxCu(I,j)*ADp%du_dt_dia(I,j,k) + KE_u(I,j) = US%L_T_to_m_s**2*US%s_to_T*uh(I,j,k)*G%dxCu(I,j)*ADp%du_dt_dia(I,j,k) enddo ; enddo do J=Jsq,Jeq ; do i=is,ie - KE_v(i,J) = US%s_to_T*vh(i,J,k)*US%L_to_m*G%dyCv(i,J)*ADp%dv_dt_dia(i,J,k) + KE_v(i,J) = US%L_T_to_m_s**2*US%s_to_T*vh(i,J,k)*G%dyCv(i,J)*ADp%dv_dt_dia(i,J,k) enddo ; enddo do j=js,je ; do i=is,ie KE_h(i,j) = CS%KE(i,j,k) * & diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index 52dfe4f845..0d977319e5 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -2012,7 +2012,7 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e 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 [T ~> s] real :: Idt ! The inverse time step [s-1] - real :: Idt_accel ! The inverse time step times rescaling factors [m T L-1 s-2 ~> s-1] + real :: Idt_accel ! The inverse time step times rescaling factors [T-1 ~> 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. @@ -2768,7 +2768,7 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e call hchksum(hold, "before u/v tridiag hold",G%HI, scale=GV%H_to_m) endif call cpu_clock_begin(id_clock_tridiag) - Idt_accel = US%L_T_to_m_s / dt + Idt_accel = 1.0 / dt_in_T !$OMP parallel do default(shared) private(hval,b1,d1,c1,eaval) do j=js,je do I=Isq,Ieq @@ -3375,9 +3375,9 @@ subroutine diabatic_driver_init(Time, G, GV, US, param_file, useALEalgorithm, di if (CS%id_wd > 0) call safe_alloc_ptr(CDp%diapyc_vel,isd,ied,jsd,jed,nz+1) CS%id_dudt_dia = register_diag_field('ocean_model','dudt_dia',diag%axesCuL,Time, & - 'Zonal Acceleration from Diapycnal Mixing', 'm s-2') + 'Zonal Acceleration from Diapycnal Mixing', 'm s-2', conversion=US%L_T2_to_m_s2) CS%id_dvdt_dia = register_diag_field('ocean_model','dvdt_dia',diag%axesCvL,Time, & - 'Meridional Acceleration from Diapycnal Mixing', 'm s-2') + 'Meridional Acceleration from Diapycnal Mixing', 'm s-2', conversion=US%L_T2_to_m_s2) if (CS%use_int_tides) then CS%id_cg1 = register_diag_field('ocean_model','cn1', diag%axesT1, & From 9fa6d390ced46022abff47e39d9be394468372da Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 13 Aug 2019 09:56:24 -0400 Subject: [PATCH 197/297] +Pass velocities to set_viscous_BBL in [L T-1] Passed the velocity arguments to set_viscous_BBL and ALE_main in rescaled units of [L T-1]. All answers are bitwise identical, but the rescaled units of several arguments in public interfaces have changed. --- src/ALE/MOM_ALE.F90 | 22 +++++----- src/core/MOM.F90 | 44 ++++++++++--------- .../vertical/MOM_set_viscosity.F90 | 18 ++++---- 3 files changed, 43 insertions(+), 41 deletions(-) diff --git a/src/ALE/MOM_ALE.F90 b/src/ALE/MOM_ALE.F90 index b9aedb7a1c..33b498a60a 100644 --- a/src/ALE/MOM_ALE.F90 +++ b/src/ALE/MOM_ALE.F90 @@ -307,8 +307,8 @@ subroutine ALE_main( G, GV, US, h, u, v, tv, Reg, CS, dt, frac_shelf_h) type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(inout) :: h !< Current 3D grid obtained after the !! last time step [H ~> m or kg m-2] - real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), intent(inout) :: u !< Zonal velocity field [m s-1] - real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), intent(inout) :: v !< Meridional velocity field [m s-1] + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), intent(inout) :: u !< Zonal velocity field [L T-1 ~> m s-1] + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), intent(inout) :: v !< Meridional velocity field [L T-1 ~> m s-1] type(thermo_var_ptrs), intent(inout) :: tv !< Thermodynamic variable structure type(tracer_registry_type), pointer :: Reg !< Tracer registry structure type(ALE_CS), pointer :: CS !< Regridding parameters and options @@ -639,16 +639,16 @@ subroutine ALE_regrid_accelerated(CS, G, GV, h, tv, n, u, v, Reg, dt, dzRegrid, type(ocean_grid_type), intent(inout) :: G !< Ocean grid type(verticalGrid_type), intent(in) :: GV !< Vertical grid real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & - intent(inout) :: h !< Original thicknesses + intent(inout) :: h !< Original thicknesses [H ~> m or kg-2] type(thermo_var_ptrs), intent(inout) :: tv !< Thermo vars (T/S/EOS) integer, intent(in) :: n !< Number of times to regrid real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), & - intent(inout) :: u !< Zonal velocity + intent(inout) :: u !< Zonal velocity [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), & - intent(inout) :: v !< Meridional velocity + intent(inout) :: v !< Meridional velocity [L T-1 ~> m s-1] type(tracer_registry_type), & optional, pointer :: Reg !< Tracer registry to remap onto new grid - real, optional, intent(in) :: dt !< Model timestep to provide a timescale for regridding + real, optional, intent(in) :: dt !< Model timestep to provide a timescale for regridding [s] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), & optional, intent(inout) :: dzRegrid !< Final change in interface positions logical, optional, intent(in) :: initial !< Whether we're being called from an initialization @@ -732,11 +732,11 @@ subroutine remap_all_state_vars(CS_remapping, CS_ALE, G, GV, h_old, h_new, Reg, optional, intent(in) :: dxInterface !< Change in interface position !! [H ~> m or kg-2] real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), & - optional, intent(inout) :: u !< Zonal velocity component [m s-1] + optional, intent(inout) :: u !< Zonal velocity [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), & - optional, intent(inout) :: v !< Meridional velocity component [m s-1] - logical, optional, intent(in) :: debug !< If true, show the call tree - real, optional, intent(in) :: dt !< time step for diagnostics + optional, intent(inout) :: v !< Meridional velocity [L T-1 ~> m s-1] + logical, optional, intent(in) :: debug !< If true, show the call tree + real, optional, intent(in) :: dt !< time step for diagnostics ! Local variables integer :: i, j, k, m integer :: nz, ntr @@ -900,7 +900,7 @@ subroutine ALE_remap_scalar(CS, G, GV, nk_src, h_src, s_src, h_dst, s_dst, all_c real, dimension(SZI_(G),SZJ_(G),nk_src), intent(in) :: h_src !< Level thickness of source grid !! [H ~> m or kg-2] real, dimension(SZI_(G),SZJ_(G),nk_src), intent(in) :: s_src !< Scalar on source grid - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)),intent(in) :: h_dst !< Level thickness of destination grid + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)),intent(in) :: h_dst !< Level thickness of destination grid !! [H ~> m or kg-2] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)),intent(inout) :: s_dst !< Scalar on destination grid logical, optional, intent(in) :: all_cells !< If false, only reconstruct for diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index 20ccc33694..89be275d70 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -940,7 +940,7 @@ subroutine step_MOM_dynamics(forces, p_surf_begin, p_surf_end, dt, dt_thermo, & Time_local + real_to_time(bbl_time_int-dt), CS%diag) ! Calculate the BBL properties and store them inside visc (u,h). call cpu_clock_begin(id_clock_BBL_visc) - call set_viscous_BBL(CS%u, CS%v, CS%h, CS%tv, CS%visc, G, GV, US, & + call set_viscous_BBL(US%m_s_to_L_T*CS%u(:,:,:), US%m_s_to_L_T*CS%v(:,:,:), CS%h, CS%tv, CS%visc, G, GV, US, & CS%set_visc_CSp, symmetrize=.true.) call cpu_clock_end(id_clock_BBL_visc) if (showCallTree) call callTree_wayPoint("done with set_viscous_BBL (step_MOM)") @@ -1155,6 +1155,14 @@ subroutine step_MOM_thermo(CS, G, GV, US, u, v, h, tv, fluxes, dtdia, & use_ice_shelf = .false. if (associated(fluxes%frac_shelf_h)) use_ice_shelf = .true. + !### This will be removed later. + do k=1,nz ; do j=G%jsd,G%jed ; do I=G%IsdB,G%IedB + u(I,j,k) = US%m_s_to_L_T*u(I,j,k) + enddo ; enddo ; enddo + do k=1,nz ; do J=G%JsdB,G%JedB ; do i=G%isd,G%ied + v(i,J,k) = US%m_s_to_L_T*v(i,J,k) + enddo ; enddo ; enddo + call enable_averaging(dtdia, Time_end_thermo, CS%diag) if (associated(CS%odaCS)) then @@ -1186,27 +1194,11 @@ subroutine step_MOM_thermo(CS, G, GV, US, u, v, h, tv, fluxes, dtdia, & endif call cpu_clock_begin(id_clock_diabatic) - !### This will be removed later. - do k=1,nz ; do j=G%jsd,G%jed ; do I=G%IsdB,G%IedB - u(I,j,k) = US%m_s_to_L_T*u(I,j,k) - enddo ; enddo ; enddo - do k=1,nz ; do J=G%JsdB,G%JedB ; do i=G%isd,G%ied - v(i,J,k) = US%m_s_to_L_T*v(i,J,k) - enddo ; enddo ; enddo 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. - !### This will be removed later. - do k=1,nz ; do j=G%jsd,G%jed ; do I=G%IsdB,G%IedB - u(I,j,k) = US%L_T_to_m_s*u(I,j,k) - enddo ; enddo ; enddo - do k=1,nz ; do J=G%JsdB,G%JedB ; do i=G%isd,G%ied - v(i,J,k) = US%L_T_to_m_s*v(i,J,k) - enddo ; enddo ; enddo - call cpu_clock_end(id_clock_diabatic) - if (showCallTree) call callTree_waypoint("finished diabatic (step_MOM_thermo)") ! Regridding/remapping is done here, at end of thermodynamics time step @@ -1225,7 +1217,7 @@ subroutine step_MOM_thermo(CS, G, GV, US, u, v, h, tv, fluxes, dtdia, & call preAle_tracer_diagnostics(CS%tracer_Reg, G, GV) if (CS%debug) then - call MOM_state_chksum("Pre-ALE ", u, v, h, CS%uh, CS%vh, G, GV, US, vel_scale=1.0) + call MOM_state_chksum("Pre-ALE ", u, v, h, CS%uh, CS%vh, G, GV, US) call hchksum(tv%T,"Pre-ALE T", G%HI, haloshift=1) call hchksum(tv%S,"Pre-ALE S", G%HI, haloshift=1) call check_redundant("Pre-ALE ", u, v, G) @@ -1252,7 +1244,7 @@ subroutine step_MOM_thermo(CS, G, GV, US, u, v, h, tv, fluxes, dtdia, & call do_group_pass(pass_uv_T_S_h, G%Domain, clock=id_clock_pass) if (CS%debug .and. CS%use_ALE_algorithm) then - call MOM_state_chksum("Post-ALE ", u, v, h, CS%uh, CS%vh, G, GV, US, vel_scale=1.0) + call MOM_state_chksum("Post-ALE ", u, v, h, CS%uh, CS%vh, G, GV, US) call hchksum(tv%T, "Post-ALE T", G%HI, haloshift=1) call hchksum(tv%S, "Post-ALE S", G%HI, haloshift=1) call check_redundant("Post-ALE ", u, v, G) @@ -1267,12 +1259,12 @@ subroutine step_MOM_thermo(CS, G, GV, US, u, v, h, tv, fluxes, dtdia, & call postALE_tracer_diagnostics(CS%tracer_Reg, G, GV, CS%diag, dtdia) if (CS%debug) then - call uvchksum("Post-diabatic u", u, v, G%HI, haloshift=2) + call uvchksum("Post-diabatic u", u, v, G%HI, haloshift=2, scale=US%L_T_to_m_s) call hchksum(h, "Post-diabatic h", G%HI, haloshift=1, scale=GV%H_to_m) call uvchksum("Post-diabatic [uv]h", CS%uhtr, CS%vhtr, G%HI, & haloshift=0, scale=GV%H_to_m*US%L_to_m**2) ! call MOM_state_chksum("Post-diabatic ", u, v, & - ! h, CS%uhtr, CS%vhtr, G, GV, haloshift=1, vel_scale=1.0) + ! h, CS%uhtr, CS%vhtr, G, GV, haloshift=1) if (associated(tv%T)) call hchksum(tv%T, "Post-diabatic T", G%HI, haloshift=1) if (associated(tv%S)) call hchksum(tv%S, "Post-diabatic S", G%HI, haloshift=1) if (associated(tv%frazil)) call hchksum(tv%frazil, & @@ -1283,6 +1275,8 @@ subroutine step_MOM_thermo(CS, G, GV, US, u, v, h, tv, fluxes, dtdia, & call check_redundant("Post-diabatic ", u, v, G) endif call disable_averaging(CS%diag) + + call cpu_clock_end(id_clock_diabatic) else ! complement of "if (.not.CS%adiabatic)" call cpu_clock_begin(id_clock_diabatic) @@ -1305,6 +1299,14 @@ subroutine step_MOM_thermo(CS, G, GV, US, u, v, h, tv, fluxes, dtdia, & call disable_averaging(CS%diag) + !### This will be removed later. + do k=1,nz ; do j=G%jsd,G%jed ; do I=G%IsdB,G%IedB + u(I,j,k) = US%L_T_to_m_s*u(I,j,k) + enddo ; enddo ; enddo + do k=1,nz ; do J=G%JsdB,G%JedB ; do i=G%isd,G%ied + v(i,J,k) = US%L_T_to_m_s*v(i,J,k) + enddo ; enddo ; enddo + if (showCallTree) call callTree_leave("step_MOM_thermo(), MOM.F90") end subroutine step_MOM_thermo diff --git a/src/parameterizations/vertical/MOM_set_viscosity.F90 b/src/parameterizations/vertical/MOM_set_viscosity.F90 index 26c0c41758..99e6d54683 100644 --- a/src/parameterizations/vertical/MOM_set_viscosity.F90 +++ b/src/parameterizations/vertical/MOM_set_viscosity.F90 @@ -111,9 +111,9 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, symmetrize) 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]. + intent(in) :: u !< The zonal velocity [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - intent(in) :: v !< The meridional velocity [m s-1]. + intent(in) :: v !< The meridional velocity [L T-1 ~> 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 @@ -191,12 +191,12 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, symmetrize) real :: hwtot ! Sum of the thicknesses used to calculate ! the near-bottom velocity magnitude [H ~> m or kg m-2]. real :: hutot ! Running sum of thicknesses times the - ! velocity magnitudes [H m s-1 ~> m2 s-1 or kg m-1 s-1]. + ! velocity magnitudes [H T T-1 ~> m2 s-1 or kg m-1 s-1]. real :: Thtot ! Running sum of thickness times temperature [degC H ~> degC m or degC kg m-2]. real :: Shtot ! Running sum of thickness times salinity [ppt H ~> ppt m or ppt kg m-2]. real :: hweight ! The thickness of a layer that is within Hbbl ! 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 :: v_at_u, u_at_v ! v at a u point or vice versa [L T-1 ~> m s-1]. real :: Rho0x400_G ! 400*Rho0/G_Earth, times unit conversion factors ! [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. @@ -282,7 +282,7 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, symmetrize) endif ; endif if (CS%debug) then - call uvchksum("Start set_viscous_BBL [uv]", u, v, G%HI, haloshift=1) + call uvchksum("Start set_viscous_BBL [uv]", u, v, G%HI, haloshift=1, scale=US%L_T_to_m_s) call hchksum(h,"Start set_viscous_BBL h", G%HI, haloshift=1, scale=GV%H_to_m) if (associated(tv%T)) call hchksum(tv%T, "Start set_viscous_BBL T", G%HI, haloshift=1) if (associated(tv%S)) call hchksum(tv%S, "Start set_viscous_BBL S", G%HI, haloshift=1) @@ -291,7 +291,7 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, symmetrize) use_BBL_EOS = associated(tv%eqn_of_state) .and. CS%BBL_use_EOS OBC => CS%OBC - U_bg_sq = US%L_T_to_m_s**2*CS%drag_bg_vel * CS%drag_bg_vel + U_bg_sq = CS%drag_bg_vel * CS%drag_bg_vel cdrag_sqrt = sqrt(CS%cdrag) cdrag_sqrt_Z = US%L_to_Z * sqrt(CS%cdrag) K2 = max(nkmb+1, 2) @@ -521,7 +521,7 @@ 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*US%m_s_to_L_T*hutot/hwtot + ustar(i) = cdrag_sqrt_Z*hutot/hwtot else ustar(i) = cdrag_sqrt_Z*CS%drag_bg_vel endif @@ -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*US%m_s_to_L_T*sqrt(u(I,j,k)*u(I,j,k) + & + visc%Ray_u(I,j,k) = Rayleigh*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*US%m_s_to_L_T*sqrt(v(i,J,k)*v(i,J,k) + & + visc%Ray_v(i,J,k) = Rayleigh*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 From 972f2cf0665fa7a668b9484942907cde9922bc12 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 13 Aug 2019 11:18:01 -0400 Subject: [PATCH 198/297] +Pass velocities to step_MOM_thermo in [L T-1] Passed the velocity arguments to step_MOM_thermo in rescaled units of [L T-1]. All answers are bitwise identical, but the rescaled units of several arguments in a public interface have changed. --- src/core/MOM.F90 | 52 +++++++++++++++++++++++++++++++----------------- 1 file changed, 34 insertions(+), 18 deletions(-) diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index 89be275d70..c45d017036 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -644,11 +644,27 @@ subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, CS, & end_time_thermo = Time_local + real_to_time(dtdia-dt) endif + !### This will be removed later. + do k=1,nz ; do j=G%jsd,G%jed ; do I=G%IsdB,G%IedB + u(I,j,k) = US%m_s_to_L_T*u(I,j,k) + enddo ; enddo ; enddo + do k=1,nz ; do J=G%JsdB,G%JedB ; do i=G%isd,G%ied + v(i,J,k) = US%m_s_to_L_T*v(i,J,k) + enddo ; enddo ; enddo + ! Apply diabatic forcing, do mixing, and regrid. call step_MOM_thermo(CS, G, GV, US, u, v, h, CS%tv, fluxes, dtdia, & end_time_thermo, .true., Waves=Waves) CS%time_in_thermo_cycle = CS%time_in_thermo_cycle + dtdia + !### This will be removed later. + do k=1,nz ; do j=G%jsd,G%jed ; do I=G%IsdB,G%IedB + u(I,j,k) = US%L_T_to_m_s*u(I,j,k) + enddo ; enddo ; enddo + do k=1,nz ; do J=G%JsdB,G%JedB ; do i=G%isd,G%ied + v(i,J,k) = US%L_T_to_m_s*v(i,J,k) + enddo ; enddo ; enddo + ! The diabatic processes are now ahead of the dynamics by dtdia. CS%t_dyn_rel_thermo = -dtdia if (showCallTree) call callTree_waypoint("finished diabatic_first (step_MOM)") @@ -743,11 +759,27 @@ subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, CS, & ! by the call to step_MOM_thermo, noting that they end at the same time. if (dtdia > dt) CS%Time = CS%Time - real_to_time(0.5*(dtdia-dt)) + !### This will be removed later. + do k=1,nz ; do j=G%jsd,G%jed ; do I=G%IsdB,G%IedB + u(I,j,k) = US%m_s_to_L_T*u(I,j,k) + enddo ; enddo ; enddo + do k=1,nz ; do J=G%JsdB,G%JedB ; do i=G%isd,G%ied + v(i,J,k) = US%m_s_to_L_T*v(i,J,k) + enddo ; enddo ; enddo + ! Apply diabatic forcing, do mixing, and regrid. call step_MOM_thermo(CS, G, GV, US, u, v, h, CS%tv, fluxes, dtdia, & Time_local, .false., Waves=Waves) CS%time_in_thermo_cycle = CS%time_in_thermo_cycle + dtdia + !### This will be removed later. + do k=1,nz ; do j=G%jsd,G%jed ; do I=G%IsdB,G%IedB + u(I,j,k) = US%L_T_to_m_s*u(I,j,k) + enddo ; enddo ; enddo + do k=1,nz ; do J=G%JsdB,G%JedB ; do i=G%isd,G%ied + v(i,J,k) = US%L_T_to_m_s*v(i,J,k) + enddo ; enddo ; enddo + if ((CS%t_dyn_rel_thermo==0.0) .and. .not.do_dyn) then ! The diabatic processes are now ahead of the dynamics by dtdia. CS%t_dyn_rel_thermo = -dtdia @@ -1127,9 +1159,9 @@ subroutine step_MOM_thermo(CS, G, GV, US, u, v, h, tv, fluxes, dtdia, & type(verticalGrid_type), intent(inout) :: 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] + intent(inout) :: u !< zonal velocity [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - intent(inout) :: v !< meridional velocity [m s-1] + intent(inout) :: v !< meridional velocity [L T-1 ~> m s-1] 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 !< A structure pointing to various thermodynamic variables @@ -1155,14 +1187,6 @@ subroutine step_MOM_thermo(CS, G, GV, US, u, v, h, tv, fluxes, dtdia, & use_ice_shelf = .false. if (associated(fluxes%frac_shelf_h)) use_ice_shelf = .true. - !### This will be removed later. - do k=1,nz ; do j=G%jsd,G%jed ; do I=G%IsdB,G%IedB - u(I,j,k) = US%m_s_to_L_T*u(I,j,k) - enddo ; enddo ; enddo - do k=1,nz ; do J=G%JsdB,G%JedB ; do i=G%isd,G%ied - v(i,J,k) = US%m_s_to_L_T*v(i,J,k) - enddo ; enddo ; enddo - call enable_averaging(dtdia, Time_end_thermo, CS%diag) if (associated(CS%odaCS)) then @@ -1299,14 +1323,6 @@ subroutine step_MOM_thermo(CS, G, GV, US, u, v, h, tv, fluxes, dtdia, & call disable_averaging(CS%diag) - !### This will be removed later. - do k=1,nz ; do j=G%jsd,G%jed ; do I=G%IsdB,G%IedB - u(I,j,k) = US%L_T_to_m_s*u(I,j,k) - enddo ; enddo ; enddo - do k=1,nz ; do J=G%JsdB,G%JedB ; do i=G%isd,G%ied - v(i,J,k) = US%L_T_to_m_s*v(i,J,k) - enddo ; enddo ; enddo - if (showCallTree) call callTree_leave("step_MOM_thermo(), MOM.F90") end subroutine step_MOM_thermo From ccdd50890d338c08b336fcf60526137efc637008 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 13 Aug 2019 13:51:13 -0400 Subject: [PATCH 199/297] +Pass velocities to continuity in [L T-1] Passed the velocity arguments to continuity in rescaled units of [L T-1]. As a temporary step, array syntax is being used to rescale arguments directly in some subroutine calls, even though this practice is strongly discouraged in the MOM6 code standards. All answers are bitwise identical, but the rescaled units of several arguments in a public interface have changed. --- src/core/MOM_continuity.F90 | 33 ++++----------------------- src/core/MOM_dynamics_split_RK2.F90 | 24 +++++++++++++++---- src/core/MOM_dynamics_unsplit.F90 | 8 ++++--- src/core/MOM_dynamics_unsplit_RK2.F90 | 7 +++--- 4 files changed, 33 insertions(+), 39 deletions(-) diff --git a/src/core/MOM_continuity.F90 b/src/core/MOM_continuity.F90 index 47dcf3d365..7e8d2d1843 100644 --- a/src/core/MOM_continuity.F90 +++ b/src/core/MOM_continuity.F90 @@ -44,9 +44,9 @@ subroutine continuity(u, v, hin, h, uh, vh, dt, G, GV, US, CS, uhbt, vhbt, OBC, type(ocean_grid_type), intent(inout) :: G !< Ocean grid structure. type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & - intent(in) :: u !< Zonal velocity [m s-1]. + intent(in) :: u !< Zonal velocity [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - intent(in) :: v !< Meridional velocity [m s-1]. + intent(in) :: v !< Meridional velocity [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(in) :: hin !< Initial layer thickness [H ~> m or kg m-2]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & @@ -80,23 +80,14 @@ subroutine continuity(u, v, hin, h, uh, vh, dt, G, GV, US, CS, uhbt, vhbt, OBC, !! Non-dimensional between 0 (at the bottom) and 1 (far above the bottom). real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & optional, intent(out) :: u_cor !< The zonal velocities that - !! give uhbt as the depth-integrated transport [m s-1]. + !! give uhbt as the depth-integrated transport [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & optional, intent(out) :: v_cor !< The meridional velocities that - !! give vhbt as the depth-integrated transport [m s-1]. + !! give vhbt as the depth-integrated transport [L T-1 ~> m s-1]. 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. - ! Local variables - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)) :: u_tmp ! Rescaled version of u [L T-1 ~> m s-1] - real, dimension(SZI_(G),SZJB_(G),SZK_(G)) :: v_tmp ! Rescaled version of V [L T-1 ~> m s-1] - integer :: is, ie, js, je, nz, stencil - integer :: i, j, k - - logical :: x_first - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke - if (present(visc_rem_u) .neqv. present(visc_rem_v)) call MOM_error(FATAL, & "MOM_continuity: Either both visc_rem_u and visc_rem_v or neither"// & " one must be present in call to continuity.") @@ -105,22 +96,8 @@ subroutine continuity(u, v, hin, h, uh, vh, dt, G, GV, US, CS, uhbt, vhbt, OBC, " one must be present in call to continuity.") if (CS%continuity_scheme == PPM_SCHEME) then - do k=1,GV%ke ; do j=G%jsd,G%jed ; do I=G%IsdB,G%IedB - u_tmp(I,j,k) = US%m_s_to_L_T * u(I,j,k) - enddo ; enddo ; enddo - do k=1,GV%ke ; do J=G%JsdB,G%JedB ; do i=G%isd,G%ied - v_tmp(i,J,k) = US%m_s_to_L_T * v(i,J,k) - enddo ; enddo ; enddo - - call continuity_PPM(u_tmp, v_tmp, hin, h, uh, vh, dt, G, GV, US, 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, BT_cont=BT_cont) - - if (present(u_cor)) then ; do k=1,GV%ke ; do j=G%jsd,G%jed ; do I=G%IsdB,G%IedB - u_cor(I,j,k) = US%L_T_to_m_s * u_cor(I,j,k) - enddo ; enddo ; enddo ; endif - if (present(v_cor)) then ; do k=1,GV%ke ; do J=G%JsdB,G%JedB ; do i=G%isd,G%ied - v_cor(i,J,k) = US%L_T_to_m_s * v_cor(i,J,k) - enddo ; enddo ; enddo ; endif else call MOM_error(FATAL, "continuity: Unrecognized value of continuity_scheme") endif diff --git a/src/core/MOM_dynamics_split_RK2.F90 b/src/core/MOM_dynamics_split_RK2.F90 index 5cc361913b..834ebeb3c5 100644 --- a/src/core/MOM_dynamics_split_RK2.F90 +++ b/src/core/MOM_dynamics_split_RK2.F90 @@ -518,8 +518,8 @@ 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, 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 continuity(US%m_s_to_L_T*u, US%m_s_to_L_T*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) if (BT_cont_BT_thick) then call btcalc(h, G, GV, CS%barotropic_CSp, CS%BT_cont%h_u, CS%BT_cont%h_v, & @@ -606,9 +606,16 @@ 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, US, CS%continuity_CSp, & + call continuity(US%m_s_to_L_T*up, US%m_s_to_L_T*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) + !### Remove this later. + do k=1,GV%ke ; do j=G%jsd,G%jed ; do I=G%IsdB,G%IedB + u_av(I,j,k) = US%L_T_to_m_s * u_av(I,j,k) + enddo ; enddo ; enddo + do k=1,GV%ke ; do J=G%JsdB,G%JedB ; do i=G%isd,G%ied + v_av(i,J,k) = US%L_T_to_m_s * v_av(i,J,k) + enddo ; enddo ; enddo call cpu_clock_end(id_clock_continuity) if (showCallTree) call callTree_wayPoint("done with continuity (step_MOM_dyn_split_RK2)") @@ -810,8 +817,15 @@ 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, US, CS%continuity_CSp, & + call continuity(US%m_s_to_L_T*u, US%m_s_to_L_T*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) + !### Remove this later. + do k=1,GV%ke ; do j=G%jsd,G%jed ; do I=G%IsdB,G%IedB + u_av(I,j,k) = US%L_T_to_m_s * u_av(I,j,k) + enddo ; enddo ; enddo + do k=1,GV%ke ; do J=G%JsdB,G%JedB ; do i=G%isd,G%ied + v_av(i,J,k) = US%L_T_to_m_s * v_av(i,J,k) + enddo ; enddo ; enddo call cpu_clock_end(id_clock_continuity) call do_group_pass(CS%pass_h, G%Domain, clock=id_clock_pass) ! Whenever thickness changes let the diag manager know, target grids @@ -1175,7 +1189,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, US, CS%continuity_CSp, OBC=CS%OBC) + call continuity(US%m_s_to_L_T*u, US%m_s_to_L_T*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 7d06f3efb7..0b0b58212d 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, US, CS%continuity_CSp, OBC=CS%OBC) + call continuity(US%m_s_to_L_T*u, US%m_s_to_L_T*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) call pass_vector(uh, vh, G%Domain, clock=id_clock_pass) @@ -354,7 +354,8 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & ! uh = up * hp ! 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, US, CS%continuity_CSp, OBC=CS%OBC) + call continuity(US%m_s_to_L_T*up, US%m_s_to_L_T*vp, hp, h_av, uh, vh, (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) @@ -417,7 +418,8 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & ! uh = upp * hp ! 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, US, CS%continuity_CSp, OBC=CS%OBC) + call continuity(US%m_s_to_L_T*upp, US%m_s_to_L_T*vpp, hp, h, uh, vh, (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 afc2bf3a29..62c66cbb39 100644 --- a/src/core/MOM_dynamics_unsplit_RK2.F90 +++ b/src/core/MOM_dynamics_unsplit_RK2.F90 @@ -279,7 +279,8 @@ 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, US, CS%continuity_CSp, OBC=CS%OBC) + call continuity(US%m_s_to_L_T*u_in, US%m_s_to_L_T*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) call pass_vector(uh, vh, G%Domain, clock=id_clock_pass) @@ -350,7 +351,7 @@ subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt, ! uh = up[n-1/2] * h[n-1/2] ! 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, US, CS%continuity_CSp, OBC=CS%OBC) + call continuity(US%m_s_to_L_T*up, US%m_s_to_L_T*vp, h_in, hp, uh, vh, 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) @@ -407,7 +408,7 @@ subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt, ! uh = up[n] * h[n] (up[n] might be extrapolated to damp GWs) ! 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, US, CS%continuity_CSp, OBC=CS%OBC) + call continuity(US%m_s_to_L_T*up, US%m_s_to_L_T*vp, h_in, h_in, uh, vh,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) From a7e54908b717af5822f83f108ff2a6d3e4291760 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 13 Aug 2019 14:30:38 -0400 Subject: [PATCH 200/297] +Pass velocities to CorAdCalc in [L T-1] Passed the velocity arguments to CorAdCalc and horizontal_viscosity in rescaled units of [L T-1]. As a temporary step, array syntax is being used to rescale arguments directly in some subroutine calls, even though this practice is strongly discouraged in the MOM6 code standards. All answers are bitwise identical, but the rescaled units of several arguments in a public interface have changed. --- src/core/MOM_CoriolisAdv.F90 | 19 +- src/core/MOM_dynamics_split_RK2.F90 | 8 +- src/core/MOM_dynamics_split_RK2.F90.bad1 | 1319 +++++++++++++++++ src/core/MOM_dynamics_unsplit.F90 | 8 +- src/core/MOM_dynamics_unsplit_RK2.F90 | 6 +- .../lateral/MOM_hor_visc.F90 | 19 +- 6 files changed, 1336 insertions(+), 43 deletions(-) create mode 100644 src/core/MOM_dynamics_split_RK2.F90.bad1 diff --git a/src/core/MOM_CoriolisAdv.F90 b/src/core/MOM_CoriolisAdv.F90 index e57850e82c..e044ea5f6d 100644 --- a/src/core/MOM_CoriolisAdv.F90 +++ b/src/core/MOM_CoriolisAdv.F90 @@ -108,11 +108,11 @@ module MOM_CoriolisAdv contains !> Calculates the Coriolis and momentum advection contributions to the acceleration. -subroutine CorAdCalc(u_in, v_in, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS) +subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS) type(ocean_grid_type), intent(in) :: G !< Ocen grid structure type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: u_in !< Zonal velocity [m s-1] - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: v_in !< Meridional velocity [m s-1] + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: u !< Zonal velocity [L T-1 ~> m s-1] + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: v !< Meridional velocity [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness [H ~> m or kg m-2] real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: uh !< Zonal transport u*h*dy !! [H L2 T-1 ~> m3 s-1 or kg s-1] @@ -127,10 +127,6 @@ subroutine CorAdCalc(u_in, v_in, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS) type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(CoriolisAdv_CS), pointer :: CS !< Control structure for MOM_CoriolisAdv - !### Temporary variables that will be removed later. - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)) :: u !< The zonal velocity [L T-1 ~> m s-1]. - real, dimension(SZI_(G),SZJB_(G),SZK_(G)) :: v !< The meridional velocity [L T-1 ~> m s-1]. - ! Local variables real, dimension(SZIB_(G),SZJB_(G)) :: & q, & ! Layer potential vorticity [H-1 T-1 ~> m-1 s-1 or m2 kg-1 s-1]. @@ -262,15 +258,6 @@ subroutine CorAdCalc(u_in, v_in, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS) !$OMP RV,PV,is,ie,js,je,Isq,Ieq,Jsq,Jeq,nz,h_neglect,h_tiny,OBC) do k=1,nz - !## This is temporary code until the input velocities have been dimensionally rescaled. - do j=Jsq-1,Jeq+2 ; do I=Isq-2,Ieq+2 - u(I,j,k) = US%m_s_to_L_T*u_in(I,j,k) - enddo ; enddo - do j=Jsq-2,Jeq+2 ; do i=Isq-1,Ieq+2 - v(i,J,k) = US%m_s_to_L_T*v_in(i,J,k) - enddo ; enddo - - ! Here the second order accurate layer potential vorticities, q, ! are calculated. hq is second order accurate in space. Relative ! vorticity is second order accurate everywhere with free slip b.c.s, diff --git a/src/core/MOM_dynamics_split_RK2.F90 b/src/core/MOM_dynamics_split_RK2.F90 index 834ebeb3c5..12c2dfb386 100644 --- a/src/core/MOM_dynamics_split_RK2.F90 +++ b/src/core/MOM_dynamics_split_RK2.F90 @@ -439,7 +439,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & ! CAu = -(f+zeta_av)/h_av vh + d/dx KE_av call cpu_clock_begin(id_clock_Cor) - call CorAdCalc(u_av, v_av, h_av, uh, vh, CS%CAu, CS%CAv, CS%OBC, CS%ADp, & + call CorAdCalc(US%m_s_to_L_T*u_av, US%m_s_to_L_T*v_av, h_av, uh, vh, CS%CAu, CS%CAv, CS%OBC, CS%ADp, & G, Gv, US, CS%CoriolisAdv_CSp) call cpu_clock_end(id_clock_Cor) if (showCallTree) call callTree_wayPoint("done with CorAdCalc (step_MOM_dyn_split_RK2)") @@ -694,7 +694,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & ! diffu = horizontal viscosity terms (u_av) call cpu_clock_begin(id_clock_horvisc) - call horizontal_viscosity(u_av, v_av, h_av, CS%diffu, CS%diffv, & + call horizontal_viscosity(US%m_s_to_L_T*u_av, US%m_s_to_L_T*v_av, h_av, CS%diffu, CS%diffv, & MEKE, Varmix, G, GV, US, CS%hor_visc_CSp, & OBC=CS%OBC, BT=CS%barotropic_CSp) call cpu_clock_end(id_clock_horvisc) @@ -702,7 +702,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & ! CAu = -(f+zeta_av)/h_av vh + d/dx KE_av call cpu_clock_begin(id_clock_Cor) - call CorAdCalc(u_av, v_av, h_av, uh, vh, CS%CAu, CS%CAv, CS%OBC, CS%ADp, & + call CorAdCalc(US%m_s_to_L_T*u_av, US%m_s_to_L_T*v_av, h_av, uh, vh, CS%CAu, CS%CAv, CS%OBC, CS%ADp, & G, GV, US, CS%CoriolisAdv_CSp) call cpu_clock_end(id_clock_Cor) if (showCallTree) call callTree_wayPoint("done with CorAdCalc (step_MOM_dyn_split_RK2)") @@ -1163,7 +1163,7 @@ subroutine initialize_dyn_split_RK2(u, v, h, uh, vh, eta, Time, G, GV, US, param if (.not. query_initialized(CS%diffu,"diffu",restart_CS) .or. & .not. query_initialized(CS%diffv,"diffv",restart_CS)) then - call horizontal_viscosity(u, v, h, CS%diffu, CS%diffv, MEKE, VarMix, & + call horizontal_viscosity(US%m_s_to_L_T*u, US%m_s_to_L_T*v, h, CS%diffu, CS%diffv, MEKE, VarMix, & G, GV, US, CS%hor_visc_CSp, & OBC=CS%OBC, BT=CS%barotropic_CSp) else diff --git a/src/core/MOM_dynamics_split_RK2.F90.bad1 b/src/core/MOM_dynamics_split_RK2.F90.bad1 new file mode 100644 index 0000000000..8064680d90 --- /dev/null +++ b/src/core/MOM_dynamics_split_RK2.F90.bad1 @@ -0,0 +1,1319 @@ +!> Time step the adiabatic dynamic core of MOM using RK2 method. +module MOM_dynamics_split_RK2 + +! This file is part of MOM6. See LICENSE.md for the license. + +use MOM_variables, only : vertvisc_type, thermo_var_ptrs +use MOM_variables, only : BT_cont_type, alloc_bt_cont_type, dealloc_bt_cont_type +use MOM_variables, only : accel_diag_ptrs, ocean_internal_state, cont_diag_ptrs +use MOM_forcing_type, only : mech_forcing + +use MOM_checksum_packages, only : MOM_thermo_chksum, MOM_state_chksum, MOM_accel_chksum +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_diag_mediator, only : diag_mediator_init, enable_averaging +use MOM_diag_mediator, only : disable_averaging, post_data, safe_alloc_ptr +use MOM_diag_mediator, only : register_diag_field, register_static_field +use MOM_diag_mediator, only : set_diag_mediator_grid, diag_ctrl, diag_update_remap_grids +use MOM_domains, only : MOM_domains_init +use MOM_domains, only : To_South, To_West, To_All, CGRID_NE, SCALAR_PAIR +use MOM_domains, only : To_North, To_East, Omit_Corners +use MOM_domains, only : create_group_pass, do_group_pass, group_pass_type +use MOM_domains, only : start_group_pass, complete_group_pass, pass_var +use MOM_debugging, only : hchksum, uvchksum +use MOM_error_handler, only : MOM_error, MOM_mesg, FATAL, WARNING, is_root_pe +use MOM_error_handler, only : MOM_set_verbosity, 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_get_input, only : directories +use MOM_io, only : MOM_io_init, vardesc, var_desc +use MOM_restart, only : register_restart_field, query_initialized, save_restart +use MOM_restart, only : restart_init, is_new_run, MOM_restart_CS +use MOM_time_manager, only : time_type, time_type_to_real, operator(+) +use MOM_time_manager, only : operator(-), operator(>), operator(*), operator(/) + +use MOM_ALE, only : ALE_CS +use MOM_barotropic, only : barotropic_init, btstep, btcalc, bt_mass_source +use MOM_barotropic, only : register_barotropic_restarts, set_dtbt, barotropic_CS +use MOM_boundary_update, only : update_OBC_data, update_OBC_CS +use MOM_continuity, only : continuity, continuity_init, continuity_CS +use MOM_continuity, only : continuity_stencil +use MOM_CoriolisAdv, only : CorAdCalc, CoriolisAdv_init, CoriolisAdv_CS +use MOM_debugging, only : check_redundant +use MOM_grid, only : ocean_grid_type +use MOM_hor_index, only : hor_index_type +use MOM_hor_visc, only : horizontal_viscosity, hor_visc_init, hor_visc_CS +use MOM_interface_heights, only : find_eta +use MOM_lateral_mixing_coeffs, only : VarMix_CS +use MOM_MEKE_types, only : MEKE_type +use MOM_open_boundary, only : ocean_OBC_type, radiation_open_bdry_conds +use MOM_open_boundary, only : open_boundary_zero_normal_flow +use MOM_open_boundary, only : open_boundary_test_extern_h +use MOM_PressureForce, only : PressureForce, PressureForce_init, PressureForce_CS +use MOM_set_visc, only : set_viscous_ML, set_visc_CS +use MOM_thickness_diffuse, only : thickness_diffuse_CS +use MOM_tidal_forcing, only : tidal_forcing_init, tidal_forcing_CS +use MOM_unit_scaling, only : unit_scale_type +use MOM_vert_friction, only : vertvisc, vertvisc_coef, vertvisc_remnant +use MOM_vert_friction, only : vertvisc_limit_vel, vertvisc_init, vertvisc_CS +use MOM_vert_friction, only : updateCFLtruncationValue +use MOM_verticalGrid, only : verticalGrid_type, get_thickness_units +use MOM_verticalGrid, only : get_flux_units, get_tr_flux_units +use MOM_wave_interface, only: wave_parameters_CS + +implicit none ; private + +#include + +!> MOM_dynamics_split_RK2 module control structure +type, public :: MOM_dyn_split_RK2_CS ; private + real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_,NKMEM_) :: & + CAu, & !< CAu = f*v - u.grad(u) [L T-2 ~> m s-2] + PFu, & !< PFu = -dM/dx [L T-2 ~> m s-2] + diffu !< Zonal acceleration due to convergence of the along-isopycnal stress tensor [L T-2 ~> m s-2] + + real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_,NKMEM_) :: & + CAv, & !< CAv = -f*u - u.grad(v) [L T-2 ~> m s-2] + PFv, & !< PFv = -dM/dy [L T-2 ~> m s-2] + diffv !< Meridional acceleration due to convergence of the along-isopycnal stress tensor [L T-2 ~> m s-2] + + real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_,NKMEM_) :: visc_rem_u + !< Both the fraction of the zonal momentum originally in a + !! layer that remains after a time-step of viscosity, and the + !! fraction of a time-step worth of a barotropic acceleration + !! that a layer experiences after viscosity is applied. + !! Nondimensional between 0 (at the bottom) and 1 (far above). + real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_,NKMEM_) :: u_accel_bt + !< The zonal layer accelerations due to the difference between + !! the barotropic accelerations and the baroclinic accelerations + !! that were fed into the barotopic calculation [m s-2] + real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_,NKMEM_) :: visc_rem_v + !< Both the fraction of the meridional momentum originally in + !! a layer that remains after a time-step of viscosity, and the + !! fraction of a time-step worth of a barotropic acceleration + !! that a layer experiences after viscosity is applied. + !! Nondimensional between 0 (at the bottom) and 1 (far above). + real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_,NKMEM_) :: v_accel_bt + !< The meridional layer accelerations due to the difference between + !! the barotropic accelerations and the baroclinic accelerations + !! that were fed into the barotopic calculation [m s-2] + + ! The following variables are only used with the split time stepping scheme. + real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: eta !< Instantaneous free surface height (in Boussinesq + !! mode) or column mass anomaly (in non-Boussinesq + !! mode) [H ~> m or kg m-2] + real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_,NKMEM_) :: u_av !< layer x-velocity with vertical mean replaced by + !! time-mean barotropic velocity over a baroclinic + !! timestep [L T-1 ~> m s-1] + real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_,NKMEM_) :: v_av !< layer y-velocity with vertical mean replaced by + !! time-mean barotropic velocity over a baroclinic + !! timestep [L T-1 ~> m s-1] + real ALLOCABLE_, dimension(NIMEM_,NJMEM_,NKMEM_) :: h_av !< arithmetic mean of two successive layer + !! thicknesses [H ~> m or kg m-2] + real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: eta_PF !< instantaneous SSH used in calculating PFu and + !! PFv [H ~> m or kg m-2] + real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_) :: uhbt !< average x-volume or mass flux determined by the + !! barotropic solver [H L2 T-1 ~> m3 s-1 or kg s-1]. + !! uhbt is roughly equal to the vertical sum of uh. + real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_) :: vhbt !< average y-volume or mass flux determined by the + !! barotropic solver [H L2 T-1 ~> m3 s-1 or kg s-1]. + !! 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 [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] + type(BT_cont_type), pointer :: BT_cont => NULL() !< A structure with elements that describe the + !! effective summed open face areas as a function + !! of barotropic flow. + + ! This is to allow the previous, velocity-based coupling with between the + ! baroclinic and barotropic modes. + logical :: BT_use_layer_fluxes !< If true, use the summed layered fluxes plus + !! an adjustment due to a changed barotropic + !! velocity in the barotropic continuity equation. + logical :: split_bottom_stress !< If true, provide the bottom stress + !! calculated by the vertical viscosity to the + !! barotropic solver. + logical :: calc_dtbt !< If true, calculate the barotropic time-step + !! dynamically. + + real :: be !< A nondimensional number from 0.5 to 1 that controls + !! the backward weighting of the time stepping scheme. + real :: begw !< A nondimensional number from 0 to 1 that controls + !! the extent to which the treatment of gravity waves + !! is forward-backward (0) or simulated backward + !! Euler (1). 0 is almost always used. + logical :: debug !< If true, write verbose checksums for debugging purposes. + logical :: debug_OBC !< If true, do debugging calls for open boundary conditions. + + logical :: module_is_initialized = .false. !< Record whether this mouled has been initialzed. + + !>@{ Diagnostic IDs + integer :: id_uh = -1, id_vh = -1 + integer :: id_umo = -1, id_vmo = -1 + integer :: id_umo_2d = -1, id_vmo_2d = -1 + integer :: id_PFu = -1, id_PFv = -1 + integer :: id_CAu = -1, id_CAv = -1 + + ! Split scheme only. + integer :: id_uav = -1, id_vav = -1 + integer :: id_u_BT_accel = -1, id_v_BT_accel = -1 + !!@} + + type(diag_ctrl), pointer :: diag !< A structure that is used to regulate the + !! timing of diagnostic output. + type(accel_diag_ptrs), pointer :: ADp !< A structure pointing to the various + !! accelerations in the momentum equations, + !! which can later be used to calculate + !! derived diagnostics like energy budgets. + type(cont_diag_ptrs), pointer :: CDp !< A structure with pointers to various + !! terms in the continuity equations, + !! which can later be used to calculate + !! derived diagnostics like energy budgets. + + ! The remainder of the structure points to child subroutines' control structures. + !> A pointer to the horizontal viscosity control structure + type(hor_visc_CS), pointer :: hor_visc_CSp => NULL() + !> A pointer to the continuity control structure + type(continuity_CS), pointer :: continuity_CSp => NULL() + !> A pointer to the CoriolisAdv control structure + type(CoriolisAdv_CS), pointer :: CoriolisAdv_CSp => NULL() + !> A pointer to the PressureForce control structure + type(PressureForce_CS), pointer :: PressureForce_CSp => NULL() + !> A pointer to the barotropic stepping control structure + type(barotropic_CS), pointer :: barotropic_CSp => NULL() + !> A pointer to a structure containing interface height diffusivities + type(thickness_diffuse_CS), pointer :: thickness_diffuse_CSp => NULL() + !> A pointer to the vertical viscosity control structure + type(vertvisc_CS), pointer :: vertvisc_CSp => NULL() + !> A pointer to the set_visc control structure + type(set_visc_CS), pointer :: set_visc_CSp => NULL() + !> A pointer to the tidal forcing control structure + type(tidal_forcing_CS), pointer :: tides_CSp => NULL() + !> A pointer to the ALE control structure. + type(ALE_CS), pointer :: ALE_CSp => NULL() + + type(ocean_OBC_type), pointer :: OBC => NULL() !< A pointer to an open boundary + !! condition type that specifies whether, where, and what open boundary + !! conditions are used. If no open BCs are used, this pointer stays + !! nullified. Flather OBCs use open boundary_CS as well. + !> A pointer to the update_OBC control structure + type(update_OBC_CS), pointer :: update_OBC_CSp => NULL() + + type(group_pass_type) :: pass_eta !< Structure for group halo pass + type(group_pass_type) :: pass_visc_rem !< Structure for group halo pass + type(group_pass_type) :: pass_uvp !< Structure for group halo pass + type(group_pass_type) :: pass_hp_uv !< Structure for group halo pass + type(group_pass_type) :: pass_uv !< Structure for group halo pass + type(group_pass_type) :: pass_h !< Structure for group halo pass + type(group_pass_type) :: pass_av_uvh !< Structure for group halo pass + +end type MOM_dyn_split_RK2_CS + + +public step_MOM_dyn_split_RK2 +public register_restarts_dyn_split_RK2 +public initialize_dyn_split_RK2 +public end_dyn_split_RK2 + +!>@{ CPU time clock IDs +integer :: id_clock_Cor, id_clock_pres, id_clock_vertvisc +integer :: id_clock_horvisc, id_clock_mom_update +integer :: id_clock_continuity, id_clock_thick_diff +integer :: id_clock_btstep, id_clock_btcalc, id_clock_btforce +integer :: id_clock_pass, id_clock_pass_init +!!@} + +contains + +!> RK2 splitting for time stepping MOM adiabatic dynamics +subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & + Time_local, dt, forces, p_surf_begin, p_surf_end, & + uh, vh, uhtr, vhtr, eta_av, & + G, GV, US, CS, calc_dtbt, VarMix, MEKE, thickness_diffuse_CSp, 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)), & + target, intent(inout) :: u !< zonal velocity [m s-1] + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & + target, intent(inout) :: v !< merid velocity [m s-1] + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + intent(inout) :: h !< layer thickness [H ~> m or kg m-2] + type(thermo_var_ptrs), intent(in) :: tv !< thermodynamic type + type(vertvisc_type), intent(inout) :: visc !< vertical visc, bottom drag, and related + type(time_type), intent(in) :: Time_local !< model time at end of time step + real, intent(in) :: dt !< time step [s] + type(mech_forcing), intent(in) :: forces !< A structure with the driving mechanical forces + real, dimension(:,:), pointer :: p_surf_begin !< surf pressure at start of this dynamic + !! time step [Pa] + real, dimension(:,:), pointer :: p_surf_end !< surf pressure at end of this dynamic + !! time step [Pa] + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & + target, intent(inout) :: uh !< zonal volume/mass transport + !! [H L2 T-1 ~> m3 s-1 or kg s-1] + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & + target, intent(inout) :: vh !< merid volume/mass transport + !! [H L2 T-1 ~> m3 s-1 or kg s-1] + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & + intent(inout) :: uhtr !< accumulatated zonal volume/mass transport + !! since last tracer advection [H L2 ~> m3 or kg] + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & + intent(inout) :: vhtr !< accumulatated merid volume/mass transport + !! since last tracer advection [H L2 ~> m3 or kg] + real, dimension(SZI_(G),SZJ_(G)), intent(out) :: eta_av !< free surface height or column mass time + !! averaged over time step [H ~> m or kg m-2] + type(MOM_dyn_split_RK2_CS), pointer :: CS !< module control structure + logical, intent(in) :: calc_dtbt !< if true, recalculate barotropic time step + type(VarMix_CS), pointer :: VarMix !< specify the spatially varying viscosities + type(MEKE_type), pointer :: MEKE !< related to mesoscale eddy kinetic energy param + type(thickness_diffuse_CS), pointer :: thickness_diffuse_CSp!< Pointer to a structure containing + !! interface height diffusivities + type(wave_parameters_CS), optional, pointer :: Waves !< A pointer to a structure containing + !! fields related to the surface wave conditions + + ! local variables + real :: dt_pred ! The time step for the predictor part of the baroclinic time stepping. + + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)) :: up ! Predicted zonal velocity [m s-1]. + real, dimension(SZI_(G),SZJB_(G),SZK_(G)) :: vp ! Predicted meridional velocity [m s-1]. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: hp ! Predicted thickness [H ~> m or kg m-2]. + + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)) :: u_bc_accel + real, dimension(SZI_(G),SZJB_(G),SZK_(G)) :: v_bc_accel + ! u_bc_accel and v_bc_accel are the summed baroclinic accelerations of each + ! layer calculated by the non-barotropic part of the model [L T-2 ~> m s-2]. + + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), target :: uh_in + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), target :: vh_in + ! uh_in and vh_in are the zonal or meridional mass transports that would be + ! obtained using the initial velocities [H L2 T-1 ~> m3 s-1 or kg s-1]. + + real, dimension(SZIB_(G),SZJ_(G)) :: uhbt_out + real, dimension(SZI_(G),SZJB_(G)) :: vhbt_out + ! uhbt_out and vhbt_out are the vertically summed transports from the + ! barotropic solver based on its final velocities [H m2 s-1 ~> m3 s-1 or kg s-1]. + + real, dimension(SZI_(G),SZJ_(G)) :: eta_pred + ! eta_pred is the predictor value of the free surface height or column mass, + ! [H ~> m or kg m-2]. + + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), target :: u_adj + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), target :: v_adj + ! u_adj and v_adj are the zonal or meridional velocities after u and v + ! have been barotropically adjusted so the resulting transports match + ! uhbt_out and vhbt_out [m s-1]. + + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)) :: u_old_rad_OBC + real, dimension(SZI_(G),SZJB_(G),SZK_(G)) :: v_old_rad_OBC + ! u_old_rad_OBC and v_old_rad_OBC are the starting velocities, which are + ! saved for use in the Flather open boundary condition code [m s-1]. + + real :: Pa_to_eta ! A factor that converts pressures to the units of eta. + real, pointer, dimension(:,:) :: & + p_surf => NULL(), eta_PF_start => NULL(), & + taux_bot => NULL(), tauy_bot => NULL(), & + eta => NULL() + + real, pointer, dimension(:,:,:) :: & + uh_ptr => NULL(), u_ptr => NULL(), vh_ptr => NULL(), v_ptr => NULL(), & + u_init => NULL(), v_init => NULL(), & ! Pointers to u and v or u_adj and v_adj. + u_av, & ! The zonal velocity time-averaged over a time step [L T-1 ~> m s-1]. + v_av, & ! The meridional velocity time-averaged over a time step [L T-1 ~> m s-1]. + h_av ! The layer thickness time-averaged over a time step [H ~> m or kg m-2]. + real :: Idt + logical :: dyn_p_surf + logical :: BT_cont_BT_thick ! If true, use the BT_cont_type to estimate the + ! relative weightings of the layers in calculating + ! the barotropic accelerations. + !---For group halo pass + logical :: showCallTree, sym + + integer :: i, j, k, is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz + integer :: cont_stencil + 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 + u_av => CS%u_av ; v_av => CS%v_av ; h_av => CS%h_av ; eta => CS%eta + Idt = 1.0 / dt + + sym=.false.;if (G%Domain%symmetric) sym=.true. ! switch to include symmetric domain in checksums + + showCallTree = callTree_showQuery() + if (showCallTree) call callTree_enter("step_MOM_dyn_split_RK2(), MOM_dynamics_split_RK2.F90") + + !$OMP parallel do default(shared) + do k = 1, nz + do j=G%jsd,G%jed ; do i=G%isdB,G%iedB ; up(i,j,k) = 0.0 ; enddo ; enddo + do j=G%jsdB,G%jedB ; do i=G%isd,G%ied ; vp(i,j,k) = 0.0 ; enddo ; enddo + do j=G%jsd,G%jed ; do i=G%isd,G%ied ; hp(i,j,k) = h(i,j,k) ; enddo ; enddo + enddo + + ! Update CFL truncation value as function of time + call updateCFLtruncationValue(Time_local, CS%vertvisc_CSp) + + if (CS%debug) then + call MOM_state_chksum("Start predictor ", u, v, h, uh, vh, G, GV, US, symmetric=sym, vel_scale=1.0) + call check_redundant("Start predictor u ", u, v, G) + call check_redundant("Start predictor uh ", uh, vh, G) + endif + + dyn_p_surf = associated(p_surf_begin) .and. associated(p_surf_end) + if (dyn_p_surf) then + p_surf => p_surf_end + call safe_alloc_ptr(eta_PF_start,G%isd,G%ied,G%jsd,G%jed) + eta_PF_start(:,:) = 0.0 + else + p_surf => forces%p_surf + endif + + if (associated(CS%OBC)) then + if (CS%debug_OBC) call open_boundary_test_extern_h(G, CS%OBC, h) + + do k=1,nz ; do j=G%jsd,G%jed ; do I=G%IsdB,G%IedB + u_old_rad_OBC(I,j,k) = US%L_T_to_m_s*u_av(I,j,k) + enddo ; enddo ; enddo + do k=1,nz ; do J=G%JsdB,G%JedB ; do i=G%isd,G%ied + v_old_rad_OBC(i,J,k) = US%L_T_to_m_s*v_av(i,J,k) + enddo ; enddo ; enddo + endif + + BT_cont_BT_thick = .false. + if (associated(CS%BT_cont)) BT_cont_BT_thick = & + (allocated(CS%BT_cont%h_u) .and. allocated(CS%BT_cont%h_v)) + + if (CS%split_bottom_stress) then + taux_bot => CS%taux_bot ; tauy_bot => CS%tauy_bot + endif + + !--- begin set up for group halo pass + + cont_stencil = continuity_stencil(CS%continuity_CSp) + !### Apart from circle_OBCs halo for eta could be 1, but halo>=3 is required + !### to match circle_OBCs solutions. Why? + call cpu_clock_begin(id_clock_pass) + call create_group_pass(CS%pass_eta, eta, G%Domain) !### , halo=1) + call create_group_pass(CS%pass_visc_rem, CS%visc_rem_u, CS%visc_rem_v, G%Domain, & + To_All+SCALAR_PAIR, CGRID_NE, halo=max(1,cont_stencil)) + call create_group_pass(CS%pass_uvp, up, vp, G%Domain, halo=max(1,cont_stencil)) + call create_group_pass(CS%pass_hp_uv, hp, G%Domain, halo=2) + call create_group_pass(CS%pass_hp_uv, u_av, v_av, G%Domain, halo=2) + call create_group_pass(CS%pass_hp_uv, uh(:,:,:), vh(:,:,:), G%Domain, halo=2) + + call create_group_pass(CS%pass_uv, u, v, G%Domain, halo=max(2,cont_stencil)) + call create_group_pass(CS%pass_h, h, G%Domain, halo=max(2,cont_stencil)) + call create_group_pass(CS%pass_av_uvh, u_av, v_av, G%Domain, halo=2) + call create_group_pass(CS%pass_av_uvh, uh(:,:,:), vh(:,:,:), G%Domain, halo=2) + call cpu_clock_end(id_clock_pass) + !--- end set up for group halo pass + + +! PFu = d/dx M(h,T,S) +! pbce = dM/deta + if (CS%begw == 0.0) call enable_averaging(dt, Time_local, CS%diag) + call cpu_clock_begin(id_clock_pres) + call PressureForce(h, tv, CS%PFu, CS%PFv, G, GV, US, CS%PressureForce_CSp, & + CS%ALE_CSp, p_surf, CS%pbce, CS%eta_PF) + if (dyn_p_surf) then + Pa_to_eta = 1.0 / GV%H_to_Pa + !$OMP parallel do default(shared) + do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 + eta_PF_start(i,j) = CS%eta_PF(i,j) - Pa_to_eta * & + (p_surf_begin(i,j) - p_surf_end(i,j)) + enddo ; enddo + endif + call cpu_clock_end(id_clock_pres) + call disable_averaging(CS%diag) + if (showCallTree) call callTree_wayPoint("done with PressureForce (step_MOM_dyn_split_RK2)") + + if (associated(CS%OBC)) then; if (CS%OBC%update_OBC) then + call update_OBC_data(CS%OBC, G, GV, US, tv, h, CS%update_OBC_CSp, Time_local) + endif; endif + if (associated(CS%OBC) .and. CS%debug_OBC) & + call open_boundary_zero_normal_flow(CS%OBC, G, CS%PFu, CS%PFv) + + if (G%nonblocking_updates) & + call start_group_pass(CS%pass_eta, G%Domain, clock=id_clock_pass) + +! CAu = -(f+zeta_av)/h_av vh + d/dx KE_av + call cpu_clock_begin(id_clock_Cor) + call CorAdCalc(US%L_T_to_m_s*u_av, US%L_T_to_m_s*v_av, h_av, uh, vh, CS%CAu, CS%CAv, CS%OBC, CS%ADp, & + G, Gv, US, CS%CoriolisAdv_CSp) + call cpu_clock_end(id_clock_Cor) + if (showCallTree) call callTree_wayPoint("done with CorAdCalc (step_MOM_dyn_split_RK2)") + +! u_bc_accel = CAu + PFu + diffu(u[n-1]) + call cpu_clock_begin(id_clock_btforce) + !$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) + 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) + enddo ; enddo + enddo + if (associated(CS%OBC)) then + call open_boundary_zero_normal_flow(CS%OBC, G, u_bc_accel, v_bc_accel) + endif + call cpu_clock_end(id_clock_btforce) + + 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, 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) + call check_redundant("pre-btstep CS%diff ", CS%diffu, CS%diffv, G) + call check_redundant("pre-btstep u_bc_accel ", u_bc_accel, v_bc_accel, G) + endif + + call cpu_clock_begin(id_clock_vertvisc) + !$OMP parallel do default(shared) + do k=1,nz + do j=js,je ; do I=Isq,Ieq + up(I,j,k) = G%mask2dCu(I,j) * (u(I,j,k) + dt * US%L_T_to_m_s*US%s_to_T*u_bc_accel(I,j,k)) + enddo ; enddo + do J=Jsq,Jeq ; do i=is,ie + vp(i,J,k) = G%mask2dCv(i,J) * (v(i,J,k) + dt * US%L_T_to_m_s*US%s_to_T*v_bc_accel(i,J,k)) + enddo ; enddo + enddo + + call enable_averaging(dt, Time_local, CS%diag) + call set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, & + CS%set_visc_CSp) + call disable_averaging(CS%diag) + + if (CS%debug) then + 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, 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)") + + + call cpu_clock_begin(id_clock_pass) + if (G%nonblocking_updates) then + call complete_group_pass(CS%pass_eta, G%Domain) + call start_group_pass(CS%pass_visc_rem, G%Domain) + else + call do_group_pass(CS%pass_eta, G%Domain) + call do_group_pass(CS%pass_visc_rem, G%Domain) + endif + call cpu_clock_end(id_clock_pass) + + call cpu_clock_begin(id_clock_btcalc) + ! Calculate the relative layer weights for determining barotropic quantities. + if (.not.BT_cont_BT_thick) & + call btcalc(h, G, GV, CS%barotropic_CSp, OBC=CS%OBC) + call bt_mass_source(h, eta, .true., G, GV, CS%barotropic_CSp) + call cpu_clock_end(id_clock_btcalc) + + if (G%nonblocking_updates) & + call complete_group_pass(CS%pass_visc_rem, G%Domain, clock=id_clock_pass) + +! 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, 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) + if (BT_cont_BT_thick) then + call btcalc(h, G, GV, CS%barotropic_CSp, CS%BT_cont%h_u, CS%BT_cont%h_v, & + OBC=CS%OBC) + endif + if (showCallTree) call callTree_wayPoint("done with continuity[BT_cont] (step_MOM_dyn_split_RK2)") + endif + + if (CS%BT_use_layer_fluxes) then + uh_ptr => uh_in; vh_ptr => vh_in; u_ptr => u; v_ptr => v + endif + + u_init => u ; v_init => v + call cpu_clock_begin(id_clock_btstep) + if (calc_dtbt) call set_dtbt(G, GV, US, CS%barotropic_CSp, eta, CS%pbce) + if (showCallTree) call callTree_enter("btstep(), MOM_barotropic.F90") + ! This is the predictor step call to btstep. + call btstep(u, v, eta, dt, u_bc_accel, v_bc_accel, forces, CS%pbce, CS%eta_PF, & + US%L_T_to_m_s*u_av, US%L_T_to_m_s*v_av, CS%u_accel_bt, CS%v_accel_bt, eta_pred, CS%uhbt, CS%vhbt, & + G, GV, US, CS%barotropic_CSp, CS%visc_rem_u, CS%visc_rem_v, & + OBC=CS%OBC, BT_cont=CS%BT_cont, eta_PF_start=eta_PF_start, & + taux_bot=taux_bot, tauy_bot=tauy_bot, & + uh0=uh_ptr, vh0=vh_ptr, u_uh0=u_ptr, v_vh0=v_ptr) + if (showCallTree) call callTree_leave("btstep()") + call cpu_clock_end(id_clock_btstep) + +! up = u + dt_pred*( u_bc_accel + u_accel_bt ) + dt_pred = dt * CS%be + call cpu_clock_begin(id_clock_mom_update) + + !$OMP parallel do default(shared) + do k=1,nz + do J=Jsq,Jeq ; do i=is,ie + vp(i,J,k) = G%mask2dCv(i,J) * (v_init(i,J,k) + US%s_to_T*dt_pred * US%L_T_to_m_s* & + (v_bc_accel(i,J,k) + CS%v_accel_bt(i,J,k))) + enddo ; enddo + do j=js,je ; do I=Isq,Ieq + up(I,j,k) = G%mask2dCu(I,j) * (u_init(I,j,k) + US%s_to_T*dt_pred * US%L_T_to_m_s* & + (u_bc_accel(I,j,k) + CS%u_accel_bt(I,j,k))) + enddo ; enddo + enddo + call cpu_clock_end(id_clock_mom_update) + + if (CS%debug) then + call uvchksum("Predictor 1 [uv]", up, vp, G%HI, haloshift=0, symmetric=sym) + call hchksum(h, "Predictor 1 h", G%HI, haloshift=1, scale=GV%H_to_m) + call uvchksum("Predictor 1 [uv]h", uh, vh, G%HI,haloshift=2, & + symmetric=sym, scale=GV%H_to_m*US%L_to_m**2*US%s_to_T) +! call MOM_state_chksum("Predictor 1", up, vp, h, uh, vh, G, GV, US, haloshift=1, vel_scale=1.0) + call MOM_accel_chksum("Predictor accel", CS%CAu, CS%CAv, CS%PFu, CS%PFv, & + 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, US, haloshift=2, & + symmetric=sym, vel_scale=1.0) + call check_redundant("Predictor 1 up", up, vp, G) + call check_redundant("Predictor 1 uh", uh, vh, G) + endif + +! up <- up + dt_pred d/dz visc d/dz up +! u_av <- u_av + dt_pred d/dz visc d/dz u_av + call cpu_clock_begin(id_clock_vertvisc) + if (CS%debug) then + call uvchksum("0 before vertvisc: [uv]p", up, vp, G%HI,haloshift=0, symmetric=sym) + endif + call vertvisc_coef(up, vp, h, forces, visc, dt_pred, G, GV, US, CS%vertvisc_CSp, & + CS%OBC) + call vertvisc(up, vp, h, forces, visc, dt_pred, CS%OBC, CS%ADp, CS%CDp, G, & + GV, US, CS%vertvisc_CSp, CS%taux_bot, CS%tauy_bot, waves=waves) + if (showCallTree) call callTree_wayPoint("done with vertvisc (step_MOM_dyn_split_RK2)") + if (G%nonblocking_updates) then + call cpu_clock_end(id_clock_vertvisc) + 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, 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) + if (G%nonblocking_updates) then + call complete_group_pass(CS%pass_uvp, G%Domain, clock=id_clock_pass) + else + call do_group_pass(CS%pass_uvp, G%Domain, clock=id_clock_pass) + endif + + ! 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, 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) + if (showCallTree) call callTree_wayPoint("done with continuity (step_MOM_dyn_split_RK2)") + + call do_group_pass(CS%pass_hp_uv, G%Domain, clock=id_clock_pass) + + if (associated(CS%OBC)) then + + if (CS%debug) & + call uvchksum("Pre OBC avg [uv]", u_av, v_av, G%HI, haloshift=1, symmetric=sym, scale=US%L_T_to_m_s) + + !### Remove this later + u_av(:,:,:) = US%L_T_to_m_s*u_av(:,:,:) + v_av(:,:,:) = US%L_T_to_m_s*v_av(:,:,:) + call radiation_open_bdry_conds(CS%OBC, u_av, u_old_rad_OBC, v_av, v_old_rad_OBC, G, US, dt_pred) + !### Remove this later + u_av(:,:,:) = US%m_s_to_L_T*u_av(:,:,:) + v_av(:,:,:) = US%m_s_to_L_T*v_av(:,:,:) + + if (CS%debug) & + call uvchksum("Post OBC avg [uv]", u_av, v_av, G%HI, haloshift=1, symmetric=sym, scale=US%L_T_to_m_s) + + ! These should be done with a pass that excludes uh & vh. +! call do_group_pass(CS%pass_hp_uv, G%Domain, clock=id_clock_pass) + endif + + if (G%nonblocking_updates) then + call start_group_pass(CS%pass_av_uvh, G%Domain, clock=id_clock_pass) + endif + + ! h_av = (h + hp)/2 + !$OMP parallel do default(shared) + do k=1,nz ; do j=js-2,je+2 ; do i=is-2,ie+2 + h_av(i,j,k) = 0.5*(h(i,j,k) + hp(i,j,k)) + enddo ; enddo ; enddo + + ! The correction phase of the time step starts here. + call enable_averaging(dt, Time_local, CS%diag) + + ! Calculate a revised estimate of the free-surface height correction to be + ! used in the next call to btstep. This call is at this point so that + ! hp can be changed if CS%begw /= 0. + ! eta_cor = ... (hidden inside CS%barotropic_CSp) + call cpu_clock_begin(id_clock_btcalc) + call bt_mass_source(hp, eta_pred, .false., G, GV, CS%barotropic_CSp) + call cpu_clock_end(id_clock_btcalc) + + if (CS%begw /= 0.0) then + ! hp <- (1-begw)*h_in + begw*hp + ! Back up hp to the value it would have had after a time-step of + ! begw*dt. hp is not used again until recalculated by continuity. + !$OMP parallel do default(shared) + do k=1,nz ; do j=js-1,je+1 ; do i=is-1,ie+1 + hp(i,j,k) = (1.0-CS%begw)*h(i,j,k) + CS%begw*hp(i,j,k) + enddo ; enddo ; enddo + + ! PFu = d/dx M(hp,T,S) + ! pbce = dM/deta + call cpu_clock_begin(id_clock_pres) + call PressureForce(hp, tv, CS%PFu, CS%PFv, G, GV, US, CS%PressureForce_CSp, & + CS%ALE_CSp, p_surf, CS%pbce, CS%eta_PF) + call cpu_clock_end(id_clock_pres) + if (showCallTree) call callTree_wayPoint("done with PressureForce[hp=(1-b).h+b.h] (step_MOM_dyn_split_RK2)") + endif + + if (G%nonblocking_updates) & + call complete_group_pass(CS%pass_av_uvh, G%Domain, clock=id_clock_pass) + + if (BT_cont_BT_thick) then + call btcalc(h, G, GV, CS%barotropic_CSp, CS%BT_cont%h_u, CS%BT_cont%h_v, & + OBC=CS%OBC) + if (showCallTree) call callTree_wayPoint("done with btcalc[BT_cont_BT_thick] (step_MOM_dyn_split_RK2)") + endif + + if (CS%debug) then + call MOM_state_chksum("Predictor ", up, vp, hp, uh, vh, G, GV, US, symmetric=sym, vel_scale=1.0) + call uvchksum("Predictor avg [uv]", u_av, v_av, G%HI, haloshift=1, symmetric=sym, scale=US%L_T_to_m_s) + call hchksum(h_av, "Predictor avg h", G%HI, haloshift=0, scale=GV%H_to_m) + ! call MOM_state_chksum("Predictor avg ", u_av, v_av, h_av, uh, vh, G, GV, US,) + call check_redundant("Predictor up ", up, vp, G) + call check_redundant("Predictor uh ", uh, vh, G) + endif + +! diffu = horizontal viscosity terms (u_av) + call cpu_clock_begin(id_clock_horvisc) + call horizontal_viscosity(US%m_s_to_L_T*u_av, US%m_s_to_L_T*v_av, h_av, CS%diffu, CS%diffv, & + MEKE, Varmix, G, GV, US, CS%hor_visc_CSp, & + OBC=CS%OBC, BT=CS%barotropic_CSp) + call cpu_clock_end(id_clock_horvisc) + if (showCallTree) call callTree_wayPoint("done with horizontal_viscosity (step_MOM_dyn_split_RK2)") + +! CAu = -(f+zeta_av)/h_av vh + d/dx KE_av + call cpu_clock_begin(id_clock_Cor) + call CorAdCalc(US%m_s_to_L_T*u_av, US%m_s_to_L_T*v_av, h_av, uh, vh, CS%CAu, CS%CAv, CS%OBC, CS%ADp, & + G, GV, US, CS%CoriolisAdv_CSp) + call cpu_clock_end(id_clock_Cor) + if (showCallTree) call callTree_wayPoint("done with CorAdCalc (step_MOM_dyn_split_RK2)") + +! Calculate the momentum forcing terms for the barotropic equations. + +! u_bc_accel = CAu + PFu + diffu(u[n-1]) + call cpu_clock_begin(id_clock_btforce) + !$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) + 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) + enddo ; enddo + enddo + if (associated(CS%OBC)) then + call open_boundary_zero_normal_flow(CS%OBC, G, u_bc_accel, v_bc_accel) + endif + call cpu_clock_end(id_clock_btforce) + + 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, 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) + call check_redundant("corr pre-btstep CS%diff ", CS%diffu, CS%diffv, G) + call check_redundant("corr pre-btstep u_bc_accel ", u_bc_accel, v_bc_accel, G) + endif + + ! u_accel_bt = layer accelerations due to barotropic solver + ! pbce = dM/deta + call cpu_clock_begin(id_clock_btstep) + if (CS%BT_use_layer_fluxes) then + !### Remove this later + u_av(:,:,:) = US%L_T_to_m_s*u_av(:,:,:) ; v_av(:,:,:) = US%L_T_to_m_s*v_av(:,:,:) + uh_ptr => uh ; vh_ptr => vh ; u_ptr => u_av ; v_ptr => v_av + endif + + if (showCallTree) call callTree_enter("btstep(), MOM_barotropic.F90") + ! This is the corrector step call to btstep. + call btstep(u, v, eta, dt, u_bc_accel, v_bc_accel, forces, CS%pbce, & + CS%eta_PF, u_av, v_av, CS%u_accel_bt, CS%v_accel_bt, & + eta_pred, CS%uhbt, CS%vhbt, G, GV, US, CS%barotropic_CSp, & + CS%visc_rem_u, CS%visc_rem_v, etaav=eta_av, OBC=CS%OBC, & + BT_cont = CS%BT_cont, eta_PF_start=eta_PF_start, & + taux_bot=taux_bot, tauy_bot=tauy_bot, & + uh0=uh_ptr, vh0=vh_ptr, u_uh0=u_ptr, v_vh0=v_ptr) + do j=js,je ; do i=is,ie ; eta(i,j) = eta_pred(i,j) ; enddo ; enddo + call cpu_clock_end(id_clock_btstep) + if (showCallTree) call callTree_leave("btstep()") + + if (CS%BT_use_layer_fluxes) then + !### Remove this later + u_av(:,:,:) = US%m_s_to_L_T*u_av(:,:,:) ; v_av(:,:,:) = US%m_s_to_L_T*v_av(:,:,:) + endif + + if (CS%debug) then + call check_redundant("u_accel_bt ", CS%u_accel_bt, CS%v_accel_bt, G) + endif + + ! u = u + dt*( u_bc_accel + u_accel_bt ) + call cpu_clock_begin(id_clock_mom_update) + !$OMP parallel do default(shared) + do k=1,nz + do j=js,je ; do I=Isq,Ieq + u(I,j,k) = G%mask2dCu(I,j) * (u_init(I,j,k) + US%s_to_T*dt * US%L_T_to_m_s* & + (u_bc_accel(I,j,k) + CS%u_accel_bt(I,j,k))) + enddo ; enddo + do J=Jsq,Jeq ; do i=is,ie + v(i,J,k) = G%mask2dCv(i,J) * (v_init(i,J,k) + US%s_to_T*dt * US%L_T_to_m_s* & + (v_bc_accel(i,J,k) + CS%v_accel_bt(i,J,k))) + enddo ; enddo + enddo + call cpu_clock_end(id_clock_mom_update) + + if (CS%debug) then + call uvchksum("Corrector 1 [uv]", u, v, G%HI,haloshift=0, symmetric=sym) + call hchksum(h, "Corrector 1 h", G%HI, haloshift=2, scale=GV%H_to_m) + call uvchksum("Corrector 1 [uv]h", uh, vh, G%HI, haloshift=2, & + symmetric=sym, scale=GV%H_to_m*US%L_to_m**2*US%s_to_T) + ! call MOM_state_chksum("Corrector 1", u, v, h, uh, vh, G, GV, US, haloshift=1, vel_scale=1.0) + call MOM_accel_chksum("Corrector accel", CS%CAu, CS%CAv, CS%PFu, CS%PFv, & + CS%diffu, CS%diffv, G, GV, US, CS%pbce, CS%u_accel_bt, CS%v_accel_bt, & + symmetric=sym) + endif + + ! u <- u + dt d/dz visc d/dz u + ! u_av <- u_av + dt d/dz visc d/dz u_av + call cpu_clock_begin(id_clock_vertvisc) + call vertvisc_coef(u, v, h, forces, visc, dt, G, GV, US, CS%vertvisc_CSp, CS%OBC) + call vertvisc(u, v, h, forces, visc, dt, CS%OBC, CS%ADp, CS%CDp, G, GV, US, & + CS%vertvisc_CSp, CS%taux_bot, CS%tauy_bot,waves=waves) + if (G%nonblocking_updates) then + call cpu_clock_end(id_clock_vertvisc) + 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, US, CS%vertvisc_CSp) + call cpu_clock_end(id_clock_vertvisc) + if (showCallTree) call callTree_wayPoint("done with vertvisc (step_MOM_dyn_split_RK2)") + +! Later, h_av = (h_in + h_out)/2, but for now use h_av to store h_in. + !$OMP parallel do default(shared) + do k=1,nz ; do j=js-2,je+2 ; do i=is-2,ie+2 + h_av(i,j,k) = h(i,j,k) + enddo ; enddo ; enddo + + call do_group_pass(CS%pass_visc_rem, G%Domain, clock=id_clock_pass) + if (G%nonblocking_updates) then + call complete_group_pass(CS%pass_uv, G%Domain, clock=id_clock_pass) + else + call do_group_pass(CS%pass_uv, G%Domain, clock=id_clock_pass) + endif + + ! uh = u_av * h + ! 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, 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) + call do_group_pass(CS%pass_h, G%Domain, clock=id_clock_pass) + ! 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) + if (showCallTree) call callTree_wayPoint("done with continuity (step_MOM_dyn_split_RK2)") + + if (G%nonblocking_updates) then + call start_group_pass(CS%pass_av_uvh, G%Domain, clock=id_clock_pass) + else + call do_group_pass(CS%pass_av_uvh, G%domain, clock=id_clock_pass) + endif + + if (associated(CS%OBC)) then + call radiation_open_bdry_conds(CS%OBC, u, u_old_rad_OBC, v, v_old_rad_OBC, G, US, dt) + endif + +! h_av = (h_in + h_out)/2 . Going in to this line, h_av = h_in. + !$OMP parallel do default(shared) + do k=1,nz ; do j=js-2,je+2 ; do i=is-2,ie+2 + h_av(i,j,k) = 0.5*(h_av(i,j,k) + h(i,j,k)) + enddo ; enddo ; enddo + + if (G%nonblocking_updates) & + call complete_group_pass(CS%pass_av_uvh, G%Domain, clock=id_clock_pass) + + !$OMP parallel do default(shared) + do k=1,nz + do j=js-2,je+2 ; do I=Isq-2,Ieq+2 + uhtr(I,j,k) = uhtr(I,j,k) + uh(I,j,k)*US%s_to_T*dt + enddo ; enddo + do J=Jsq-2,Jeq+2 ; do i=is-2,ie+2 + vhtr(i,J,k) = vhtr(i,J,k) + vh(i,J,k)*US%s_to_T*dt + enddo ; enddo + enddo + + ! The time-averaged free surface height has already been set by the last + ! call to btstep. + + ! Here various terms used in to update the momentum equations are + ! offered for time averaging. + if (CS%id_PFu > 0) call post_data(CS%id_PFu, CS%PFu, CS%diag) + if (CS%id_PFv > 0) call post_data(CS%id_PFv, CS%PFv, CS%diag) + if (CS%id_CAu > 0) call post_data(CS%id_CAu, CS%CAu, CS%diag) + if (CS%id_CAv > 0) call post_data(CS%id_CAv, CS%CAv, CS%diag) + + ! Here the thickness fluxes are offered for time averaging. + if (CS%id_uh > 0) call post_data(CS%id_uh , uh, CS%diag) + if (CS%id_vh > 0) call post_data(CS%id_vh , vh, CS%diag) + if (CS%id_uav > 0) call post_data(CS%id_uav, u_av, CS%diag) + if (CS%id_vav > 0) call post_data(CS%id_vav, v_av, CS%diag) + if (CS%id_u_BT_accel > 0) call post_data(CS%id_u_BT_accel, CS%u_accel_bt, CS%diag) + if (CS%id_v_BT_accel > 0) call post_data(CS%id_v_BT_accel, CS%v_accel_bt, CS%diag) + + if (CS%debug) then + call MOM_state_chksum("Corrector ", u, v, h, uh, vh, G, GV, US, symmetric=sym, vel_scale=1.0) + call uvchksum("Corrector avg [uv]", u_av, v_av, G%HI, haloshift=1, symmetric=sym, scale=US%L_T_to_m_s) + call hchksum(h_av, "Corrector avg h", G%HI, haloshift=1, scale=GV%H_to_m) + ! call MOM_state_chksum("Corrector avg ", u_av, v_av, h_av, uh, vh, G, GV, US, vel_scale=1.0) + endif + + if (showCallTree) call callTree_leave("step_MOM_dyn_split_RK2()") + +end subroutine step_MOM_dyn_split_RK2 + +!> This subroutine sets up any auxiliary restart variables that are specific +!! to the unsplit time stepping scheme. All variables registered here should +!! have the ability to be recreated if they are not present in a restart file. +subroutine register_restarts_dyn_split_RK2(HI, GV, param_file, CS, restart_CS, uh, vh) + type(hor_index_type), intent(in) :: HI !< Horizontal index structure + type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure + type(param_file_type), intent(in) :: param_file !< parameter file + type(MOM_dyn_split_RK2_CS), pointer :: CS !< module control structure + type(MOM_restart_CS), pointer :: restart_CS !< restart control structure + real, dimension(SZIB_(HI),SZJ_(HI),SZK_(GV)), & + target, intent(inout) :: uh !< zonal volume/mass transport [H L2 T-1 ~> m3 s-1 or kg s-1] + real, dimension(SZI_(HI),SZJB_(HI),SZK_(GV)), & + target, intent(inout) :: vh !< merid volume/mass transport [H L2 T-1 ~> m3 s-1 or kg s-1] + + type(vardesc) :: vd + character(len=40) :: mdl = "MOM_dynamics_split_RK2" ! This module's name. + character(len=48) :: thickness_units, flux_units + + integer :: isd, ied, jsd, jed, nz, IsdB, IedB, JsdB, JedB + isd = HI%isd ; ied = HI%ied ; jsd = HI%jsd ; jed = HI%jed ; nz = GV%ke + IsdB = HI%IsdB ; IedB = HI%IedB ; JsdB = HI%JsdB ; JedB = HI%JedB + + ! This is where a control structure specific to this module would be allocated. + if (associated(CS)) then + call MOM_error(WARNING, "register_restarts_dyn_split_RK2 called with an associated "// & + "control structure.") + return + endif + allocate(CS) + + ALLOC_(CS%diffu(IsdB:IedB,jsd:jed,nz)) ; CS%diffu(:,:,:) = 0.0 + ALLOC_(CS%diffv(isd:ied,JsdB:JedB,nz)) ; CS%diffv(:,:,:) = 0.0 + ALLOC_(CS%CAu(IsdB:IedB,jsd:jed,nz)) ; CS%CAu(:,:,:) = 0.0 + ALLOC_(CS%CAv(isd:ied,JsdB:JedB,nz)) ; CS%CAv(:,:,:) = 0.0 + ALLOC_(CS%PFu(IsdB:IedB,jsd:jed,nz)) ; CS%PFu(:,:,:) = 0.0 + ALLOC_(CS%PFv(isd:ied,JsdB:JedB,nz)) ; CS%PFv(:,:,:) = 0.0 + + ALLOC_(CS%eta(isd:ied,jsd:jed)) ; CS%eta(:,:) = 0.0 + ALLOC_(CS%u_av(IsdB:IedB,jsd:jed,nz)) ; CS%u_av(:,:,:) = 0.0 + ALLOC_(CS%v_av(isd:ied,JsdB:JedB,nz)) ; CS%v_av(:,:,:) = 0.0 + ALLOC_(CS%h_av(isd:ied,jsd:jed,nz)) ; CS%h_av(:,:,:) = GV%Angstrom_H + + thickness_units = get_thickness_units(GV) + flux_units = get_flux_units(GV) + + if (GV%Boussinesq) then + vd = var_desc("sfc",thickness_units,"Free surface Height",'h','1') + else + vd = var_desc("p_bot",thickness_units,"Bottom Pressure",'h','1') + endif + call register_restart_field(CS%eta, vd, .false., restart_CS) + + vd = var_desc("u2","m s-1","Auxiliary Zonal velocity",'u','L') + call register_restart_field(CS%u_av, vd, .false., restart_CS) + + vd = var_desc("v2","m s-1","Auxiliary Meridional velocity",'v','L') + call register_restart_field(CS%v_av, vd, .false., restart_CS) + + vd = var_desc("h2",thickness_units,"Auxiliary Layer Thickness",'h','L') + call register_restart_field(CS%h_av, vd, .false., restart_CS) + + vd = var_desc("uh",flux_units,"Zonal thickness flux",'u','L') + call register_restart_field(uh, vd, .false., restart_CS) + + vd = var_desc("vh",flux_units,"Meridional thickness flux",'v','L') + call register_restart_field(vh, vd, .false., restart_CS) + + vd = var_desc("diffu","m s-2","Zonal horizontal viscous acceleration",'u','L') + call register_restart_field(CS%diffu, vd, .false., restart_CS) + + vd = var_desc("diffv","m s-2","Meridional horizontal viscous acceleration",'v','L') + call register_restart_field(CS%diffv, vd, .false., restart_CS) + + call register_barotropic_restarts(HI, GV, param_file, CS%barotropic_CSp, & + restart_CS) + +end subroutine register_restarts_dyn_split_RK2 + +!> This subroutine initializes all of the variables that are used by this +!! dynamic core, including diagnostics and the cpu clocks. +subroutine initialize_dyn_split_RK2(u, v, h, uh, vh, eta, Time, G, GV, US, param_file, & + diag, CS, restart_CS, dt, Accel_diag, Cont_diag, MIS, & + VarMix, MEKE, thickness_diffuse_CSp, & + OBC, update_OBC_CSp, ALE_CSp, setVisc_CSp, & + visc, dirs, ntrunc, calc_dtbt) + 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 !< merid velocity [m s-1] + real, dimension(SZI_(G),SZJ_(G),SZK_(G)) , intent(inout) :: h !< layer thickness [H ~> m or kg m-2] + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & + target, intent(inout) :: uh !< zonal volume/mass transport [H L2 T-1 ~> m3 s-1 or kg s-1] + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & + target, intent(inout) :: vh !< merid volume/mass transport [H L2 T-1 ~> m3 s-1 or kg s-1] + real, dimension(SZI_(G),SZJ_(G)), intent(inout) :: eta !< free surface height or column mass [H ~> m or kg m-2] + type(time_type), target, intent(in) :: Time !< current model time + type(param_file_type), intent(in) :: param_file !< parameter file for parsing + type(diag_ctrl), target, intent(inout) :: diag !< to control diagnostics + type(MOM_dyn_split_RK2_CS), pointer :: CS !< module control structure + type(MOM_restart_CS), pointer :: restart_CS !< restart control structure + real, intent(in) :: dt !< time step [s] + type(accel_diag_ptrs), target, intent(inout) :: Accel_diag !< points to momentum equation terms for + !! budget analysis + type(cont_diag_ptrs), target, intent(inout) :: Cont_diag !< points to terms in continuity equation + type(ocean_internal_state), intent(inout) :: MIS !< "MOM6 internal state" used to pass + !! diagnostic pointers + type(VarMix_CS), pointer :: VarMix !< points to spatially variable viscosities + type(MEKE_type), pointer :: MEKE !< points to mesoscale eddy kinetic energy fields +! type(Barotropic_CS), pointer :: Barotropic_CSp !< Pointer to the control structure for +! !! the barotropic module + type(thickness_diffuse_CS), pointer :: thickness_diffuse_CSp !< Pointer to the control structure + !! used for the isopycnal height diffusive transport. + type(ocean_OBC_type), pointer :: OBC !< points to OBC related fields + type(update_OBC_CS), pointer :: update_OBC_CSp !< points to OBC update related fields + type(ALE_CS), pointer :: ALE_CSp !< points to ALE control structure + type(set_visc_CS), pointer :: setVisc_CSp !< points to the set_visc control structure. + type(vertvisc_type), intent(inout) :: visc !< vertical viscosities, bottom drag, and related + type(directories), intent(in) :: dirs !< contains directory paths + integer, target, intent(inout) :: ntrunc !< A target for the variable that records + !! the number of times the velocity is + !! truncated (this should be 0). + logical, intent(out) :: calc_dtbt !< If true, recalculate the barotropic time step + + ! local variables + real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: h_tmp + character(len=40) :: mdl = "MOM_dynamics_split_RK2" ! This module's name. + character(len=48) :: thickness_units, flux_units, eta_rest_name + real :: H_rescale ! A rescaling factor for thicknesses 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 :: accel_rescale ! A rescaling factor for accelerations from the representation in + ! a restart file to the internal representation in this run. + real :: vel_rescale ! A rescaling factor for velocities from the representation in + ! a restart file to the internal representation in this run. + real :: H_convert + type(group_pass_type) :: pass_av_h_uvh + logical :: use_tides, debug_truncations + + integer :: i, j, k, is, ie, js, je, isd, ied, jsd, jed, nz + integer :: IsdB, IedB, JsdB, JedB + 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 + IsdB = G%IsdB ; IedB = G%IedB ; JsdB = G%JsdB ; JedB = G%JedB + + if (.not.associated(CS)) call MOM_error(FATAL, & + "initialize_dyn_split_RK2 called with an unassociated control structure.") + if (CS%module_is_initialized) then + call MOM_error(WARNING, "initialize_dyn_split_RK2 called with a control "// & + "structure that has already been initialized.") + return + endif + CS%module_is_initialized = .true. + + CS%diag => diag + + call get_param(param_file, mdl, "TIDES", use_tides, & + "If true, apply tidal momentum forcing.", default=.false.) + call get_param(param_file, mdl, "BE", CS%be, & + "If SPLIT is true, BE determines the relative weighting "//& + "of a 2nd-order Runga-Kutta baroclinic time stepping "//& + "scheme (0.5) and a backward Euler scheme (1) that is "//& + "used for the Coriolis and inertial terms. BE may be "//& + "from 0.5 to 1, but instability may occur near 0.5. "//& + "BE is also applicable if SPLIT is false and USE_RK2 "//& + "is true.", units="nondim", default=0.6) + call get_param(param_file, mdl, "BEGW", CS%begw, & + "If SPLIT is true, BEGW is a number from 0 to 1 that "//& + "controls the extent to which the treatment of gravity "//& + "waves is forward-backward (0) or simulated backward "//& + "Euler (1). 0 is almost always used. "//& + "If SPLIT is false and USE_RK2 is true, BEGW can be "//& + "between 0 and 0.5 to damp gravity waves.", & + units="nondim", default=0.0) + + call get_param(param_file, mdl, "SPLIT_BOTTOM_STRESS", CS%split_bottom_stress, & + "If true, provide the bottom stress calculated by the "//& + "vertical viscosity to the barotropic solver.", default=.false.) + call get_param(param_file, mdl, "BT_USE_LAYER_FLUXES", CS%BT_use_layer_fluxes, & + "If true, use the summed layered fluxes plus an "//& + "adjustment due to the change in the barotropic velocity "//& + "in the barotropic continuity equation.", default=.true.) + call get_param(param_file, mdl, "DEBUG", CS%debug, & + "If true, write out verbose debugging data.", & + default=.false., debuggingParam=.true.) + call get_param(param_file, mdl, "DEBUG_OBC", CS%debug_OBC, default=.false.) + call get_param(param_file, mdl, "DEBUG_TRUNCATIONS", debug_truncations, & + default=.false.) + + allocate(CS%taux_bot(IsdB:IedB,jsd:jed)) ; CS%taux_bot(:,:) = 0.0 + allocate(CS%tauy_bot(isd:ied,JsdB:JedB)) ; CS%tauy_bot(:,:) = 0.0 + + ALLOC_(CS%uhbt(IsdB:IedB,jsd:jed)) ; CS%uhbt(:,:) = 0.0 + ALLOC_(CS%vhbt(isd:ied,JsdB:JedB)) ; CS%vhbt(:,:) = 0.0 + ALLOC_(CS%visc_rem_u(IsdB:IedB,jsd:jed,nz)) ; CS%visc_rem_u(:,:,:) = 0.0 + ALLOC_(CS%visc_rem_v(isd:ied,JsdB:JedB,nz)) ; CS%visc_rem_v(:,:,:) = 0.0 + ALLOC_(CS%eta_PF(isd:ied,jsd:jed)) ; CS%eta_PF(:,:) = 0.0 + ALLOC_(CS%pbce(isd:ied,jsd:jed,nz)) ; CS%pbce(:,:,:) = 0.0 + + ALLOC_(CS%u_accel_bt(IsdB:IedB,jsd:jed,nz)) ; CS%u_accel_bt(:,:,:) = 0.0 + ALLOC_(CS%v_accel_bt(isd:ied,JsdB:JedB,nz)) ; CS%v_accel_bt(:,:,:) = 0.0 + + MIS%diffu => CS%diffu + MIS%diffv => CS%diffv + MIS%PFu => CS%PFu + MIS%PFv => CS%PFv + MIS%CAu => CS%CAu + MIS%CAv => CS%CAv + MIS%pbce => CS%pbce + MIS%u_accel_bt => CS%u_accel_bt + MIS%v_accel_bt => CS%v_accel_bt + MIS%u_av => CS%u_av + MIS%v_av => CS%v_av + + CS%ADp => Accel_diag + CS%CDp => Cont_diag + Accel_diag%diffu => CS%diffu + Accel_diag%diffv => CS%diffv + Accel_diag%PFu => CS%PFu + Accel_diag%PFv => CS%PFv + Accel_diag%CAu => CS%CAu + Accel_diag%CAv => CS%CAv + +! Accel_diag%pbce => CS%pbce +! Accel_diag%u_accel_bt => CS%u_accel_bt ; Accel_diag%v_accel_bt => CS%v_accel_bt +! Accel_diag%u_av => CS%u_av ; Accel_diag%v_av => CS%v_av + + call continuity_init(Time, G, GV, US, param_file, diag, CS%continuity_CSp) + call CoriolisAdv_init(Time, G, GV, US, param_file, diag, CS%ADp, CS%CoriolisAdv_CSp) + 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, 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, & + "initialize_dyn_split_RK2 called with setVisc_CSp unassociated.") + CS%set_visc_CSp => setVisc_CSp + call updateCFLtruncationValue(Time, CS%vertvisc_CSp, & + activate=is_new_run(restart_CS) ) + + if (associated(ALE_CSp)) CS%ALE_CSp => ALE_CSp + if (associated(OBC)) CS%OBC => OBC + if (associated(update_OBC_CSp)) CS%update_OBC_CSp => update_OBC_CSp + + eta_rest_name = "sfc" ; if (.not.GV%Boussinesq) eta_rest_name = "p_bot" + if (.not. query_initialized(CS%eta, trim(eta_rest_name), restart_CS)) then + ! Estimate eta based on the layer thicknesses - h. With the Boussinesq + ! approximation, eta is the free surface height anomaly, while without it + ! eta is the mass of ocean per unit area. eta always has the same + ! dimensions as h, either m or kg m-3. + ! CS%eta(:,:) = 0.0 already from initialization. + if (GV%Boussinesq) then + do j=js,je ; do i=is,ie ; CS%eta(i,j) = -GV%Z_to_H * G%bathyT(i,j) ; enddo ; enddo + endif + do k=1,nz ; do j=js,je ; do i=is,ie + CS%eta(i,j) = CS%eta(i,j) + h(i,j,k) + enddo ; enddo ; enddo + elseif ((GV%m_to_H_restart /= 0.0) .and. (GV%m_to_H_restart /= GV%m_to_H)) then + H_rescale = GV%m_to_H / GV%m_to_H_restart + do j=js,je ; do i=is,ie ; CS%eta(i,j) = H_rescale * CS%eta(i,j) ; enddo ; enddo + endif + ! Copy eta into an output array. + do j=js,je ; do i=is,ie ; eta(i,j) = CS%eta(i,j) ; enddo ; enddo + + call barotropic_init(u, v, h, CS%eta, Time, G, GV, US, param_file, diag, & + CS%barotropic_CSp, restart_CS, calc_dtbt, CS%BT_cont, & + CS%tides_CSp) + + if (.not. query_initialized(CS%diffu,"diffu",restart_CS) .or. & + .not. query_initialized(CS%diffv,"diffv",restart_CS)) then + call horizontal_viscosity(u, v, h, CS%diffu, CS%diffv, MEKE, VarMix, & + G, GV, US, CS%hor_visc_CSp, & + OBC=CS%OBC, BT=CS%barotropic_CSp) + elseif ( (US%s_to_T_restart * US%m_to_L_restart /= 0.0) .and. & + (US%m_to_L * US%s_to_T_restart**2 /= US%m_to_L_restart * US%s_to_T**2) ) then + accel_rescale = (US%m_to_L * US%s_to_T_restart**2) / (US%m_to_L_restart * US%s_to_T**2) + do k=1,nz ; do j=js,je ; do I=G%IscB,G%IecB + CS%diffu(I,j,k) = accel_rescale * CS%diffu(I,j,k) + enddo ; enddo ; enddo + do k=1,nz ; do J=G%JscB,G%JecB ; do i=is,ie + CS%diffv(i,J,k) = accel_rescale * CS%diffv(i,J,k) + enddo ; enddo ; enddo + endif + + if (.not. query_initialized(CS%u_av,"u2", restart_CS) .or. & + .not. query_initialized(CS%u_av,"v2", restart_CS)) then + CS%u_av(:,:,:) = US%m_s_to_L_T*u(:,:,:) + CS%v_av(:,:,:) = US%m_s_to_L_T*v(:,:,:) + 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 k=1,nz ; do j=js,je ; do I=G%IscB,G%IecB + CS%u_av(I,j,k) = vel_rescale * CS%u_av(I,j,k) + enddo ; enddo ; enddo + do k=1,nz ; do J=G%JscB,G%JecB ; do i=is,ie + CS%u_av(i,J,k) = vel_rescale * CS%u_av(i,J,k) + enddo ; enddo ; enddo + endif + + ! This call is just here to initialize uh and vh. + 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, 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 + if (.not. query_initialized(CS%h_av,"h2",restart_CS)) then + CS%h_av(:,:,:) = h(:,:,:) + elseif ((GV%m_to_H_restart /= 0.0) .and. (GV%m_to_H_restart /= GV%m_to_H)) then + H_rescale = GV%m_to_H / GV%m_to_H_restart + do k=1,nz ; do j=js,je ; do i=is,ie ; CS%h_av(i,j,k) = H_rescale * CS%h_av(i,j,k) ; enddo ; enddo ; enddo + endif + if ( (GV%m_to_H_restart * US%s_to_T_restart * US%m_to_L_restart /= 0.0) .and. & + ((GV%m_to_H * US%m_to_L**2 * US%s_to_T_restart) /= & + (GV%m_to_H_restart * US%m_to_L_restart**2 * US%s_to_T)) ) then + uH_rescale = (GV%m_to_H * US%m_to_L**2 * US%s_to_T_restart) / & + (GV%m_to_H_restart * US%m_to_L_restart**2 * US%s_to_T) + do k=1,nz ; do j=js,je ; do I=G%IscB,G%IecB ; uh(I,j,k) = uH_rescale * uh(I,j,k) ; enddo ; enddo ; enddo + do k=1,nz ; do J=G%JscB,G%JecB ; do i=is,ie ; vh(i,J,k) = uH_rescale * vh(i,J,k) ; enddo ; enddo ; enddo + endif + endif + + call cpu_clock_begin(id_clock_pass_init) + call create_group_pass(pass_av_h_uvh, CS%u_av, CS%v_av, G%Domain, halo=2) + call create_group_pass(pass_av_h_uvh, CS%h_av, G%Domain, halo=2) + call create_group_pass(pass_av_h_uvh, uh, vh, G%Domain, halo=2) + call do_group_pass(pass_av_h_uvh, G%Domain) + call cpu_clock_end(id_clock_pass_init) + + flux_units = get_flux_units(GV) + H_convert = GV%H_to_m ; if (.not.GV%Boussinesq) H_convert = GV%H_to_kg_m2 + CS%id_uh = register_diag_field('ocean_model', 'uh', diag%axesCuL, Time, & + 'Zonal Thickness Flux', flux_units, y_cell_method='sum', v_extensive=.true., & + conversion=H_convert*US%L_to_m**2*US%s_to_T) + CS%id_vh = register_diag_field('ocean_model', 'vh', diag%axesCvL, Time, & + 'Meridional Thickness Flux', flux_units, x_cell_method='sum', v_extensive=.true., & + conversion=H_convert*US%L_to_m**2*US%s_to_T) + + CS%id_CAu = register_diag_field('ocean_model', 'CAu', diag%axesCuL, Time, & + 'Zonal Coriolis and Advective Acceleration', 'm s-2', conversion=US%L_T2_to_m_s2) + CS%id_CAv = register_diag_field('ocean_model', 'CAv', diag%axesCvL, Time, & + 'Meridional Coriolis and Advective Acceleration', 'm s-2', conversion=US%L_T2_to_m_s2) + CS%id_PFu = register_diag_field('ocean_model', 'PFu', diag%axesCuL, Time, & + 'Zonal Pressure Force Acceleration', 'm s-2', conversion=US%L_T2_to_m_s2) + CS%id_PFv = register_diag_field('ocean_model', 'PFv', diag%axesCvL, Time, & + 'Meridional Pressure Force Acceleration', 'm s-2', conversion=US%L_T2_to_m_s2) + + CS%id_uav = register_diag_field('ocean_model', 'uav', diag%axesCuL, Time, & + 'Barotropic-step Averaged Zonal Velocity', 'm s-1') + CS%id_vav = register_diag_field('ocean_model', 'vav', diag%axesCvL, Time, & + 'Barotropic-step Averaged Meridional Velocity', 'm s-1') + + CS%id_u_BT_accel = register_diag_field('ocean_model', 'u_BT_accel', diag%axesCuL, Time, & + 'Barotropic Anomaly Zonal Acceleration', 'm s-2', conversion=US%L_T2_to_m_s2) + CS%id_v_BT_accel = register_diag_field('ocean_model', 'v_BT_accel', diag%axesCvL, Time, & + 'Barotropic Anomaly Meridional Acceleration', 'm s-2', conversion=US%L_T2_to_m_s2) + + id_clock_Cor = cpu_clock_id('(Ocean Coriolis & mom advection)', grain=CLOCK_MODULE) + id_clock_continuity = cpu_clock_id('(Ocean continuity equation)', grain=CLOCK_MODULE) + id_clock_pres = cpu_clock_id('(Ocean pressure force)', grain=CLOCK_MODULE) + id_clock_vertvisc = cpu_clock_id('(Ocean vertical viscosity)', grain=CLOCK_MODULE) + id_clock_horvisc = cpu_clock_id('(Ocean horizontal viscosity)', grain=CLOCK_MODULE) + id_clock_mom_update = cpu_clock_id('(Ocean momentum increments)', grain=CLOCK_MODULE) + id_clock_pass = cpu_clock_id('(Ocean message passing)', grain=CLOCK_MODULE) + id_clock_pass_init = cpu_clock_id('(Ocean init message passing)', grain=CLOCK_ROUTINE) + id_clock_btcalc = cpu_clock_id('(Ocean barotropic mode calc)', grain=CLOCK_MODULE) + id_clock_btstep = cpu_clock_id('(Ocean barotropic mode stepping)', grain=CLOCK_MODULE) + id_clock_btforce = cpu_clock_id('(Ocean barotropic forcing calc)', grain=CLOCK_MODULE) + +end subroutine initialize_dyn_split_RK2 + + +!> Close the dyn_split_RK2 module +subroutine end_dyn_split_RK2(CS) + type(MOM_dyn_split_RK2_CS), pointer :: CS !< module control structure + + DEALLOC_(CS%diffu) ; DEALLOC_(CS%diffv) + DEALLOC_(CS%CAu) ; DEALLOC_(CS%CAv) + DEALLOC_(CS%PFu) ; DEALLOC_(CS%PFv) + + if (associated(CS%taux_bot)) deallocate(CS%taux_bot) + if (associated(CS%tauy_bot)) deallocate(CS%tauy_bot) + DEALLOC_(CS%uhbt) ; DEALLOC_(CS%vhbt) + DEALLOC_(CS%u_accel_bt) ; DEALLOC_(CS%v_accel_bt) + DEALLOC_(CS%visc_rem_u) ; DEALLOC_(CS%visc_rem_v) + + DEALLOC_(CS%eta) ; DEALLOC_(CS%eta_PF) ; DEALLOC_(CS%pbce) + DEALLOC_(CS%h_av) ; DEALLOC_(CS%u_av) ; DEALLOC_(CS%v_av) + + call dealloc_BT_cont_type(CS%BT_cont) + + deallocate(CS) +end subroutine end_dyn_split_RK2 + + +!> \namespace mom_dynamics_split_rk2 +!! +!! This file time steps the adiabatic dynamic core by splitting +!! between baroclinic and barotropic modes. It uses a pseudo-second order +!! Runge-Kutta time stepping scheme for the baroclinic momentum +!! equation and a forward-backward coupling between the baroclinic +!! momentum and continuity equations. This split time-stepping +!! scheme is described in detail in Hallberg (JCP, 1997). Additional +!! issues related to exact tracer conservation and how to +!! ensure consistency between the barotropic and layered estimates +!! of the free surface height are described in Hallberg and +!! Adcroft (Ocean Modelling, 2009). This was the time stepping code +!! that is used for most GOLD applications, including GFDL's ESM2G +!! Earth system model, and all of the examples provided with the +!! MOM code (although several of these solutions are routinely +!! verified by comparison with the slower unsplit schemes). +!! +!! The subroutine step_MOM_dyn_split_RK2 actually does the time +!! stepping, while register_restarts_dyn_split_RK2 sets the fields +!! that are found in a full restart file with this scheme, and +!! initialize_dyn_split_RK2 initializes the cpu clocks that are +!! used in this module. For largely historical reasons, this module +!! does not have its own control structure, but shares the same +!! control structure with MOM.F90 and the other MOM_dynamics_... +!! modules. + +end module MOM_dynamics_split_RK2 diff --git a/src/core/MOM_dynamics_unsplit.F90 b/src/core/MOM_dynamics_unsplit.F90 index 0b0b58212d..ce39c5cf06 100644 --- a/src/core/MOM_dynamics_unsplit.F90 +++ b/src/core/MOM_dynamics_unsplit.F90 @@ -255,7 +255,7 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & ! diffu = horizontal viscosity terms (u,h) call enable_averaging(dt,Time_local, CS%diag) call cpu_clock_begin(id_clock_horvisc) - call horizontal_viscosity(u, v, h, CS%diffu, CS%diffv, MEKE, Varmix, & + call horizontal_viscosity(US%m_s_to_L_T*u, US%m_s_to_L_T*v, h, CS%diffu, CS%diffv, MEKE, Varmix, & G, GV, US, CS%hor_visc_CSp) call cpu_clock_end(id_clock_horvisc) call disable_averaging(CS%diag) @@ -299,7 +299,7 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & ! CAu = -(f+zeta)/h_av vh + d/dx KE call cpu_clock_begin(id_clock_Cor) - call CorAdCalc(u, v, h_av, uh, vh, CS%CAu, CS%CAv, CS%OBC, CS%ADp, & + call CorAdCalc(US%m_s_to_L_T*u, US%m_s_to_L_T*v, h_av, uh, vh, CS%CAu, CS%CAv, CS%OBC, CS%ADp, & G, GV, US, CS%CoriolisAdv_CSp) call cpu_clock_end(id_clock_Cor) @@ -367,7 +367,7 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & ! CAu = -(f+zeta(up))/h_av vh + d/dx KE(up) call cpu_clock_begin(id_clock_Cor) - call CorAdCalc(up, vp, h_av, uh, vh, CS%CAu, CS%CAv, CS%OBC, CS%ADp, & + call CorAdCalc(US%m_s_to_L_T*up, US%m_s_to_L_T*vp, h_av, uh, vh, CS%CAu, CS%CAv, CS%OBC, CS%ADp, & G, GV, US, CS%CoriolisAdv_CSp) call cpu_clock_end(id_clock_Cor) @@ -449,7 +449,7 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & ! CAu = -(f+zeta(upp))/h_av vh + d/dx KE(upp) call cpu_clock_begin(id_clock_Cor) - call CorAdCalc(upp, vpp, h_av, uh, vh, CS%CAu, CS%CAv, CS%OBC, CS%ADp, & + call CorAdCalc(US%m_s_to_L_T*upp, US%m_s_to_L_T*vpp, h_av, uh, vh, CS%CAu, CS%CAv, CS%OBC, CS%ADp, & G, GV, US, CS%CoriolisAdv_CSp) call cpu_clock_end(id_clock_Cor) diff --git a/src/core/MOM_dynamics_unsplit_RK2.F90 b/src/core/MOM_dynamics_unsplit_RK2.F90 index 62c66cbb39..ad0ba9774f 100644 --- a/src/core/MOM_dynamics_unsplit_RK2.F90 +++ b/src/core/MOM_dynamics_unsplit_RK2.F90 @@ -266,7 +266,7 @@ subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt, ! diffu = horizontal viscosity terms (u,h) call enable_averaging(dt,Time_local, CS%diag) call cpu_clock_begin(id_clock_horvisc) - call horizontal_viscosity(u_in, v_in, h_in, CS%diffu, CS%diffv, MEKE, VarMix, & + call horizontal_viscosity(US%m_s_to_L_T*u_in, US%m_s_to_L_T*v_in, h_in, CS%diffu, CS%diffv, MEKE, VarMix, & G, GV, US, CS%hor_visc_CSp) call cpu_clock_end(id_clock_horvisc) call disable_averaging(CS%diag) @@ -295,7 +295,7 @@ subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt, ! CAu = -(f+zeta)/h_av vh + d/dx KE (function of u[n-1] and uh[n-1]) call cpu_clock_begin(id_clock_Cor) - call CorAdCalc(u_in, v_in, h_av, uh, vh, CS%CAu, CS%CAv, CS%OBC, CS%ADp, & + call CorAdCalc(US%m_s_to_L_T*u_in, US%m_s_to_L_T*v_in, h_av, uh, vh, CS%CAu, CS%CAv, CS%OBC, CS%ADp, & G, GV, US, CS%CoriolisAdv_CSp) call cpu_clock_end(id_clock_Cor) @@ -366,7 +366,7 @@ subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt, ! CAu = -(f+zeta(up))/h_av vh + d/dx KE(up) (function of up[n-1/2], h[n-1/2]) call cpu_clock_begin(id_clock_Cor) - call CorAdCalc(up, vp, h_av, uh, vh, CS%CAu, CS%CAv, CS%OBC, CS%ADp, & + call CorAdCalc(US%m_s_to_L_T*up, US%m_s_to_L_T*vp, h_av, uh, vh, CS%CAu, CS%CAv, CS%OBC, CS%ADp, & G, GV, US, CS%CoriolisAdv_CSp) call cpu_clock_end(id_clock_Cor) if (associated(CS%OBC)) then diff --git a/src/parameterizations/lateral/MOM_hor_visc.F90 b/src/parameterizations/lateral/MOM_hor_visc.F90 index 1fc98f111a..d94ed1f178 100644 --- a/src/parameterizations/lateral/MOM_hor_visc.F90 +++ b/src/parameterizations/lateral/MOM_hor_visc.F90 @@ -197,14 +197,14 @@ module MOM_hor_visc !! u[is-2:ie+2,js-2:je+2] !! v[is-2:ie+2,js-2:je+2] !! h[is-1:ie+1,js-1:je+1] -subroutine horizontal_viscosity(u_in, v_in, h, diffu, diffv, MEKE, VarMix, G, GV, US, & +subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, & CS, OBC, BT) 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(SZIB_(G),SZJ_(G),SZK_(G)), & - intent(in) :: u_in !< The zonal velocity [m s-1]. + intent(in) :: u !< The zonal velocity [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - intent(in) :: v_in !< The meridional velocity [m s-1]. + intent(in) :: v !< The meridional velocity [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(inout) :: h !< Layer thicknesses [H ~> m or kg m-2]. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & @@ -224,10 +224,6 @@ subroutine horizontal_viscosity(u_in, v_in, h, diffu, diffv, MEKE, VarMix, G, GV type(barotropic_CS), optional, pointer :: BT !< Pointer to a structure containing !! barotropic velocities. - !### Temporary variables that will be removed later. - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)) :: u !< The zonal velocity [L T-1 ~> m s-1]. - real, dimension(SZI_(G),SZJB_(G),SZK_(G)) :: v !< The meridional velocity [L T-1 ~> m s-1]. - ! Local variables real, dimension(SZIB_(G),SZJ_(G)) :: & Del2u, & ! The u-compontent of the Laplacian of velocity [L-1 T-1 ~> m-1 s-1] @@ -526,15 +522,6 @@ subroutine horizontal_viscosity(u_in, v_in, h, diffu, diffv, MEKE, VarMix, G, GV !$OMP Shear_mag, h2uq, h2vq, hq, Kh_scale, hrat_min) do k=1,nz - ! This is temporary code until the input velocities have been dimensionally rescaled. - do j=Jsq-1,Jeq+2 ; do I=Isq-2,Ieq+2 - u(I,j,k) = US%m_s_to_L_T*u_in(I,j,k) - enddo ; enddo - do j=Jsq-2,Jeq+2 ; do i=Isq-1,Ieq+2 - v(i,J,k) = US%m_s_to_L_T*v_in(i,J,k) - enddo ; enddo - - ! The following are the forms of the horizontal tension and horizontal ! shearing strain advocated by Smagorinsky (1993) and discussed in ! Griffies and Hallberg (2000). From 9d5855378692fb5fb06baf89197d7b8e0bf91a7f Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 13 Aug 2019 16:32:18 -0400 Subject: [PATCH 201/297] +Pass velocities to btstep in [L T-1] Passed the velocity arguments to btstep and barotropic_init in rescaled units of [L T-1]. As a temporary step, array syntax is being used to rescale arguments directly in some subroutine calls, even though this practice is strongly discouraged in the MOM6 code standards. All answers are bitwise identical, but the rescaled units of several arguments in a public interface have changed. --- src/core/MOM_barotropic.F90 | 61 ++++++++++++++++------------- src/core/MOM_dynamics_split_RK2.F90 | 25 ++++++++---- 2 files changed, 51 insertions(+), 35 deletions(-) diff --git a/src/core/MOM_barotropic.F90 b/src/core/MOM_barotropic.F90 index b83e0c34da..b3b0b1925c 100644 --- a/src/core/MOM_barotropic.F90 +++ b/src/core/MOM_barotropic.F90 @@ -241,7 +241,7 @@ module MOM_barotropic real :: vel_underflow !< Velocity components smaller than vel_underflow !! are set to 0 [L T-1 ~> m s-1]. real :: maxvel !< Velocity components greater than maxvel are - !! truncated to maxvel [m s-1]. + !! truncated to maxvel [L T-1 ~> m s-1]. real :: CFL_trunc !< If clip_velocity is true, velocity components will !! be truncated when they are large enough that the !! corresponding CFL number exceeds this value, nondim. @@ -389,8 +389,10 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, 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 - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: U_in !< The initial (3-D) zonal velocity [m s-1]. - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: V_in !< The initial (3-D) meridional velocity [m s-1]. + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: U_in !< The initial (3-D) zonal + !! velocity [L T-1 ~> m s-1]. + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: V_in !< The initial (3-D) meridional + !! velocity [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZJ_(G)), intent(in) :: eta_in !< The initial barotropic free surface height !! anomaly or column mass anomaly [H ~> m or kg m-2]. real, intent(in) :: dt !< The time increment to integrate over. @@ -407,9 +409,10 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, !! eta_PF_start is provided [H ~> m or kg m-2]. !! Note: eta_in, pbce, and eta_PF_in must have up-to-date !! values in the first point of their halos. - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: U_Cor !< The (3-D) zonal-velocities used to - !! calculate the Coriolis terms in bc_accel_u [m s-1]. - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: V_Cor !< Ditto for meridonal bc_accel_v. + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: U_Cor !< The (3-D) zonal velocities used to + !! calculate the Coriolis terms in bc_accel_u [L T-1 ~> m s-1]. + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: V_Cor !< The (3-D) meridional velocities used to + !! calculate the Coriolis terms in bc_accel_u [L T-1 ~> m s-1]. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(out) :: accel_layer_u !< The zonal acceleration of each layer due !! to the barotropic calculation [L T-2 ~> m s-2]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(out) :: accel_layer_v !< The meridional acceleration of each layer @@ -446,10 +449,12 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, !! from ocean to the seafloor [Pa]. real, dimension(:,:,:), optional, pointer :: uh0 !< The zonal layer transports at reference !! velocities [H L2 T-1 ~> m3 s-1 or kg s-1]. - real, dimension(:,:,:), optional, pointer :: u_uh0 !< The velocities used to calculate uh0 [m s-1] + real, dimension(:,:,:), optional, pointer :: u_uh0 !< The velocities used to calculate + !! uh0 [L T-1 ~> m s-1] real, dimension(:,:,:), optional, pointer :: vh0 !< The zonal layer transports at reference !! velocities [H L2 T-1 ~> m3 s-1 or kg s-1]. - real, dimension(:,:,:), optional, pointer :: v_vh0 !< The velocities used to calculate vh0 [m s-1] + real, dimension(:,:,:), optional, pointer :: v_vh0 !< The velocities used to calculate + !! vh0 [L T-1 ~> m s-1] ! Local variables real :: ubt_Cor(SZIB_(G),SZJ_(G)) ! The barotropic velocities that had been @@ -615,7 +620,6 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, ! 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 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 [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]. @@ -914,11 +918,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) * US%m_s_to_L_T*U_Cor(I,j,k) + ubt_Cor(I,j) = ubt_Cor(I,j) + wt_u(I,j,k) * 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) * US%m_s_to_L_T*V_Cor(i,J,k) + vbt_Cor(i,J) = vbt_Cor(i,J) + wt_v(i,J,k) * V_Cor(i,J,k) enddo ; enddo ; enddo ! The gtot arrays are the effective layer-weighted reduced gravities for @@ -1026,23 +1030,23 @@ 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 uhbt(I,j) = uhbt(I,j) + 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) + ubt(I,j) = ubt(I,j) + wt_u(I,j,k) * 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) * US%m_s_to_L_T*v_vh0(i,J,k) + vbt(i,J) = vbt(i,J) + wt_v(i,J,k) * 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) * US%m_s_to_L_T*u_uh0(I,j,k) + ubt(I,j) = ubt(I,j) + CS%frhatu(I,j,k) * 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) * US%m_s_to_L_T*v_vh0(i,J,k) + vbt(i,J) = vbt(i,J) + CS%frhatv(i,J,k) * v_vh0(i,J,k) enddo ; enddo ; enddo endif if (use_BT_cont) then @@ -1104,11 +1108,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) * US%m_s_to_L_T*U_in(I,j,k) + ubt(I,j) = ubt(I,j) + wt_u(I,j,k) * 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) * US%m_s_to_L_T*V_in(i,J,k) + vbt(i,J) = vbt(i,J) + wt_v(i,J,k) * V_in(i,J,k) enddo ; enddo ; enddo !$OMP parallel do default(shared) do j=js,je ; do I=is-1,ie @@ -2377,16 +2381,17 @@ subroutine apply_velocity_OBCs(OBC, ubt, vbt, uhbt, vhbt, ubt_trans, vbt_trans, type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. 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(inout) :: ubt !< the zonal barotropic velocity [m s-1]. + real, dimension(SZIBW_(MS),SZJW_(MS)), intent(inout) :: ubt !< the zonal barotropic velocity [L T-1 ~> m s-1]. real, dimension(SZIBW_(MS),SZJW_(MS)), intent(inout) :: uhbt !< the zonal barotropic transport !! [H L2 T-1 ~> m3 s-1 or kg s-1]. - real, dimension(SZIBW_(MS),SZJW_(MS)), intent(inout) :: ubt_trans !< the zonal barotropic velocity used in + real, dimension(SZIBW_(MS),SZJW_(MS)), intent(inout) :: ubt_trans !< The zonal barotropic velocity used in !! 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) :: vbt !< The meridional barotropic velocity + !! [L T-1 ~> m s-1]. real, dimension(SZIW_(MS),SZJBW_(MS)), intent(inout) :: vhbt !< the meridional barotropic transport !! [H L2 T-1 ~> m3 s-1 or kg s-1]. real, dimension(SZIW_(MS),SZJBW_(MS)), intent(inout) :: vbt_trans !< the meridional BT velocity used in - !! transports [m s-1]. + !! transports [L T-1 ~> m s-1]. 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 @@ -3055,7 +3060,7 @@ function uhbt_to_ubt(uhbt, BTC, US, guess) result(ubt) 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]. + real :: ubt !< The result - The velocity that gives uhbt transport [L T-1 ~> m s-1]. ! Local variables real :: ubt_min, ubt_max, uhbt_err, derr_du @@ -3391,12 +3396,12 @@ subroutine adjust_local_BT_cont_types(ubt, uhbt, vbt, vhbt, BTCL_u, BTCL_v, & 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]. + intent(in) :: ubt !< The linearization zonal barotropic velocity [L T-1 ~> m s-1]. real, dimension(SZIBW_(MS),SZJW_(MS)), & intent(in) :: uhbt !< The linearization zonal barotropic transport !! [H L2 T-1 ~> m3 s-1 or kg s-1]. real, dimension(SZIW_(MS),SZJBW_(MS)), & - intent(in) :: vbt !< The linearization meridional barotropic velocity [m s-1]. + intent(in) :: vbt !< The linearization meridional barotropic velocity [L T-1 ~> m s-1]. real, dimension(SZIW_(MS),SZJBW_(MS)), & intent(in) :: vhbt !< The linearization meridional barotropic transport !! [H L2 T-1 ~> m3 s-1 or kg s-1]. @@ -3701,9 +3706,9 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, US, param_file, diag, CS, 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]. + intent(in) :: u !< The zonal velocity [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - intent(in) :: v !< The meridional velocity [m s-1]. + intent(in) :: v !< The meridional velocity [L T-1 ~> m s-1]. 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)), & @@ -4290,10 +4295,10 @@ 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) * US%m_s_to_L_T*u(I,j,k) + CS%ubtav(I,j) = CS%ubtav(I,j) + CS%frhatu(I,j,k) * 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) * US%m_s_to_L_T*v(i,J,k) + CS%vbtav(i,J) = CS%vbtav(i,J) + CS%frhatv(i,J,k) * 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 diff --git a/src/core/MOM_dynamics_split_RK2.F90 b/src/core/MOM_dynamics_split_RK2.F90 index 12c2dfb386..c5210ea081 100644 --- a/src/core/MOM_dynamics_split_RK2.F90 +++ b/src/core/MOM_dynamics_split_RK2.F90 @@ -529,7 +529,12 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & endif if (CS%BT_use_layer_fluxes) then - uh_ptr => uh_in; vh_ptr => vh_in; u_ptr => u; v_ptr => v + ! uh_ptr => uh_in; vh_ptr => vh_in; u_ptr => u; v_ptr => v + uh_ptr => uh_in; vh_ptr => vh_in + call safe_alloc_ptr(u_ptr, G%IsdB,G%IedB,G%jsd,G%jed,G%ke) + call safe_alloc_ptr(v_ptr, G%isd,G%ied,G%JsdB,G%JedB,G%ke) + u_ptr(:,:,:) = US%m_s_to_L_T*u(:,:,:) + v_ptr(:,:,:) = US%m_s_to_L_T*v(:,:,:) endif u_init => u ; v_init => v @@ -537,8 +542,8 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & if (calc_dtbt) call set_dtbt(G, GV, US, CS%barotropic_CSp, eta, CS%pbce) if (showCallTree) call callTree_enter("btstep(), MOM_barotropic.F90") ! This is the predictor step call to btstep. - call btstep(u, v, eta, dt, u_bc_accel, v_bc_accel, forces, CS%pbce, CS%eta_PF, & - u_av, v_av, CS%u_accel_bt, CS%v_accel_bt, eta_pred, CS%uhbt, CS%vhbt, & + call btstep(US%m_s_to_L_T*u, US%m_s_to_L_T*v, eta, dt, u_bc_accel, v_bc_accel, forces, CS%pbce, CS%eta_PF, & + US%m_s_to_L_T*u_av, US%m_s_to_L_T*v_av, CS%u_accel_bt, CS%v_accel_bt, eta_pred, CS%uhbt, CS%vhbt, & G, GV, US, CS%barotropic_CSp, CS%visc_rem_u, CS%visc_rem_v, & OBC=CS%OBC, BT_cont=CS%BT_cont, eta_PF_start=eta_PF_start, & taux_bot=taux_bot, tauy_bot=tauy_bot, & @@ -739,19 +744,25 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & ! pbce = dM/deta call cpu_clock_begin(id_clock_btstep) if (CS%BT_use_layer_fluxes) then - uh_ptr => uh ; vh_ptr => vh ; u_ptr => u_av ; v_ptr => v_av + uh_ptr => uh ; vh_ptr => vh ! ; u_ptr => u_av ; v_ptr => v_av + u_ptr(:,:,:) = US%m_s_to_L_T*u_av(:,:,:) + v_ptr(:,:,:) = US%m_s_to_L_T*v_av(:,:,:) endif if (showCallTree) call callTree_enter("btstep(), MOM_barotropic.F90") ! This is the corrector step call to btstep. - call btstep(u, v, eta, dt, u_bc_accel, v_bc_accel, forces, CS%pbce, & - CS%eta_PF, u_av, v_av, CS%u_accel_bt, CS%v_accel_bt, & + call btstep(US%m_s_to_L_T*u, US%m_s_to_L_T*v, eta, dt, u_bc_accel, v_bc_accel, forces, CS%pbce, & + CS%eta_PF, US%m_s_to_L_T*u_av, US%m_s_to_L_T*v_av, CS%u_accel_bt, CS%v_accel_bt, & eta_pred, CS%uhbt, CS%vhbt, G, GV, US, CS%barotropic_CSp, & CS%visc_rem_u, CS%visc_rem_v, etaav=eta_av, OBC=CS%OBC, & BT_cont = CS%BT_cont, eta_PF_start=eta_PF_start, & taux_bot=taux_bot, tauy_bot=tauy_bot, & uh0=uh_ptr, vh0=vh_ptr, u_uh0=u_ptr, v_vh0=v_ptr) do j=js,je ; do i=is,ie ; eta(i,j) = eta_pred(i,j) ; enddo ; enddo + + if (associated(u_ptr)) deallocate(u_ptr) + if (associated(v_ptr)) deallocate(v_ptr) + call cpu_clock_end(id_clock_btstep) if (showCallTree) call callTree_leave("btstep()") @@ -1157,7 +1168,7 @@ subroutine initialize_dyn_split_RK2(u, v, h, uh, vh, eta, Time, G, GV, US, param ! Copy eta into an output array. do j=js,je ; do i=is,ie ; eta(i,j) = CS%eta(i,j) ; enddo ; enddo - call barotropic_init(u, v, h, CS%eta, Time, G, GV, US, param_file, diag, & + call barotropic_init(US%m_s_to_L_T*u, US%m_s_to_L_T*v, h, CS%eta, Time, G, GV, US, param_file, diag, & CS%barotropic_CSp, restart_CS, calc_dtbt, CS%BT_cont, & CS%tides_CSp) From 64f691cfdf108d7fc84ab1700bdee2d373759f4f Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 13 Aug 2019 18:36:49 -0400 Subject: [PATCH 202/297] +Pass velocities to set_viscous_ML in [L T-1] Passed the velocity arguments to set_viscous_ML in rescaled units of [L T-1]. As a temporary step, array syntax is being used to rescale arguments directly in some subroutine calls, even though this practice is strongly discouraged in the MOM6 code standards. All answers are bitwise identical, but the rescaled units of several arguments in a public interface have changed. --- src/core/MOM_dynamics_split_RK2.F90 | 2 +- src/core/MOM_dynamics_unsplit.F90 | 2 +- src/core/MOM_dynamics_unsplit_RK2.F90 | 2 +- .../vertical/MOM_set_viscosity.F90 | 35 ++++++++++--------- 4 files changed, 21 insertions(+), 20 deletions(-) diff --git a/src/core/MOM_dynamics_split_RK2.F90 b/src/core/MOM_dynamics_split_RK2.F90 index c5210ea081..843aafaf44 100644 --- a/src/core/MOM_dynamics_split_RK2.F90 +++ b/src/core/MOM_dynamics_split_RK2.F90 @@ -482,7 +482,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & enddo call enable_averaging(dt, Time_local, CS%diag) - call set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, & + call set_viscous_ML(US%m_s_to_L_T*u, US%m_s_to_L_T*v, h, tv, forces, visc, dt, G, GV, US, & CS%set_visc_CSp) call disable_averaging(CS%diag) diff --git a/src/core/MOM_dynamics_unsplit.F90 b/src/core/MOM_dynamics_unsplit.F90 index ce39c5cf06..9460a74a4f 100644 --- a/src/core/MOM_dynamics_unsplit.F90 +++ b/src/core/MOM_dynamics_unsplit.F90 @@ -341,7 +341,7 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & ! up <- up + dt/2 d/dz visc d/dz up call cpu_clock_begin(id_clock_vertvisc) call enable_averaging(dt, Time_local, CS%diag) - call set_viscous_ML(u, v, h_av, tv, forces, visc, dt*0.5, G, GV, US, & + call set_viscous_ML(US%m_s_to_L_T*u, US%m_s_to_L_T*v, h_av, tv, forces, visc, dt*0.5, G, GV, US, & CS%set_visc_CSp) call disable_averaging(CS%diag) call vertvisc_coef(up, vp, h_av, forces, visc, dt*0.5, G, GV, US, & diff --git a/src/core/MOM_dynamics_unsplit_RK2.F90 b/src/core/MOM_dynamics_unsplit_RK2.F90 index ad0ba9774f..1694544eff 100644 --- a/src/core/MOM_dynamics_unsplit_RK2.F90 +++ b/src/core/MOM_dynamics_unsplit_RK2.F90 @@ -338,7 +338,7 @@ subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt, ! 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) call enable_averaging(dt, Time_local, CS%diag) - call set_viscous_ML(up, vp, h_av, tv, forces, visc, dt_pred, G, GV, US, & + call set_viscous_ML(US%m_s_to_L_T*up, US%m_s_to_L_T*vp, h_av, tv, forces, visc, dt_pred, G, GV, US, & CS%set_visc_CSp) call disable_averaging(CS%diag) call vertvisc_coef(up, vp, h_av, forces, visc, dt_pred, G, GV, US, & diff --git a/src/parameterizations/vertical/MOM_set_viscosity.F90 b/src/parameterizations/vertical/MOM_set_viscosity.F90 index 99e6d54683..92466266b8 100644 --- a/src/parameterizations/vertical/MOM_set_viscosity.F90 +++ b/src/parameterizations/vertical/MOM_set_viscosity.F90 @@ -47,7 +47,7 @@ module MOM_set_visc real :: c_Smag !< The Laplacian Smagorinsky coefficient for !! calculating the drag in channels. real :: drag_bg_vel !< An assumed unresolved background velocity for - !! calculating the bottom drag [m s-1]. + !! calculating the bottom drag [L T-1 ~> m s-1]. real :: BBL_thick_min !< The minimum bottom boundary layer thickness [H ~> m or kg m-2]. !! This might be Kv / (cdrag * drag_bg_vel) to give !! Kv as the minimum near-bottom viscosity. @@ -1007,9 +1007,9 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS, symmetri 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]. + intent(in) :: u !< The zonal velocity [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - intent(in) :: v !< The meridional velocity [m s-1]. + intent(in) :: v !< The meridional velocity [L T-1 ~> 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 @@ -1024,6 +1024,7 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS, symmetri logical, optional, intent(in) :: symmetrize !< If present and true, do extra calculations !! of those values in visc that would be !! calculated with symmetric memory. + ! Local variables real, dimension(SZIB_(G)) :: & htot, & ! The total depth of the layers being that are within the @@ -1036,7 +1037,7 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS, symmetri ! [H kg m-3 ~> kg m-2 or kg2 m-5]. Rhtot is only used if no ! equation of state is used. uhtot, & ! The depth integrated zonal and meridional velocities within - vhtot, & ! the surface mixed layer [H m s-1 ~> m2 s-1 or kg m-1 s-1]. + vhtot, & ! the surface mixed layer [H L T-1 ~> m2 s-1 or kg m-1 s-1]. Idecay_len_TKE, & ! The inverse of a turbulence decay length scale [H-1 ~> m-1 or m2 kg-1]. dR_dT, & ! Partial derivative of the density at the base of layer nkml ! (roughly the base of the mixed layer) with temperature [kg m-3 degC-1]. @@ -1066,7 +1067,7 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS, symmetri real :: hwtot ! Sum of the thicknesses used to calculate ! the near-bottom velocity magnitude [H ~> m or kg m-2]. real :: hutot ! Running sum of thicknesses times the - ! velocity magnitudes [H m s-1 ~> m2 s-1 or kg m-1 s-1]. + ! velocity magnitudes [H L T-1 ~> m2 s-1 or kg m-1 s-1]. real :: hweight ! The thickness of a layer that is within Hbbl ! of the bottom [H ~> m or kg m-2]. real :: tbl_thick_Z ! The thickness of the top boundary layer [Z ~> m]. @@ -1077,8 +1078,8 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS, symmetri real :: S_lay ! The layer salinity at velocity points [ppt]. real :: Rlay ! The layer potential density at velocity points [kg m-3]. real :: Rlb ! The potential density of the layer below [kg m-3]. - real :: v_at_u ! The meridonal velocity at a zonal velocity point [m s-1]. - real :: u_at_v ! The zonal velocity at a meridonal velocity point [m s-1]. + real :: v_at_u ! The meridonal velocity at a zonal velocity point [L T-1 ~> m s-1]. + real :: u_at_v ! The zonal velocity at a meridonal velocity point [L T-1 ~> 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 [L2 T-2 ~> m2 s-2]. @@ -1104,7 +1105,7 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS, symmetri ! the present layer [H ~> m or kg m-2]. real :: U_bg_sq ! The square of an assumed background velocity, for ! calculating the mean magnitude near the top for use in - ! the quadratic surface drag [m2 s-2]. + ! the quadratic surface drag [L2 T-2 ~> 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 [T-1 ~> s-1]. @@ -1134,7 +1135,7 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS, symmetri endif ; endif Rho0x400_G = 400.0*(GV%Rho0/(US%L_to_Z**2 * GV%g_Earth)) * GV%Z_to_H - U_bg_sq = US%L_T_to_m_s**2*CS%drag_bg_vel * CS%drag_bg_vel + U_bg_sq = CS%drag_bg_vel * CS%drag_bg_vel cdrag_sqrt = sqrt(CS%cdrag) cdrag_sqrt_Z = US%L_to_Z * sqrt(CS%cdrag) @@ -1204,8 +1205,8 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS, symmetri do_i(I) = .true. ; do_any = .true. k_massive(I) = nkml Thtot(I) = 0.0 ; Shtot(I) = 0.0 ; Rhtot(i) = 0.0 - uhtot(I) = dt_Rho0 * forces%taux(I,j) - vhtot(I) = 0.25 * dt_Rho0 * ((forces%tauy(i,J) + forces%tauy(i+1,J-1)) + & + uhtot(I) = US%m_s_to_L_T*dt_Rho0 * forces%taux(I,j) + vhtot(I) = 0.25 * US%m_s_to_L_T*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 @@ -1241,7 +1242,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 = US%m_s_to_L_T**2*((uhtot(I) - htot(I)*u(I,j,k))**2 + (vhtot(I) - htot(I)*v_at_u)**2) + Uh2 = ((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 @@ -1338,7 +1339,7 @@ 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 * US%m_s_to_L_T*hutot/hwtot + ustar(I) = cdrag_sqrt_Z * hutot/hwtot else ustar(I) = cdrag_sqrt_Z * CS%drag_bg_vel endif @@ -1439,8 +1440,8 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS, symmetri do_i(i) = .true. ; do_any = .true. k_massive(i) = nkml Thtot(i) = 0.0 ; Shtot(i) = 0.0 ; Rhtot(i) = 0.0 - vhtot(i) = dt_Rho0 * forces%tauy(i,J) - uhtot(i) = 0.25 * dt_Rho0 * ((forces%taux(I,j) + forces%taux(I-1,j+1)) + & + vhtot(i) = US%m_s_to_L_T*dt_Rho0 * forces%tauy(i,J) + uhtot(i) = 0.25 * US%m_s_to_L_T*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 @@ -1478,7 +1479,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 = US%m_s_to_L_T**2*((uhtot(I) - htot(I)*u_at_v)**2 + (vhtot(I) - htot(I)*v(i,J,k))**2) + Uh2 = ((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 @@ -1575,7 +1576,7 @@ 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 * US%m_s_to_L_T*hutot/hwtot + ustar(i) = cdrag_sqrt_Z * hutot/hwtot else ustar(i) = cdrag_sqrt_Z * CS%drag_bg_vel endif ; endif From b74e2d3d80b589be24c404a30b1e19f966ca2a5b Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Wed, 14 Aug 2019 06:25:01 -0400 Subject: [PATCH 203/297] +Pass velocities to vertvisc_coef in [L T-1] Passed the velocity arguments to vertvisc_coef in rescaled units of [L T-1]. As a temporary step, array syntax is being used to rescale arguments directly in some subroutine calls, even though this practice is strongly discouraged in the MOM6 code standards. All answers are bitwise identical, but the rescaled units of several arguments in a public interface have changed. --- src/core/MOM_dynamics_split_RK2.F90 | 6 +++--- src/core/MOM_dynamics_unsplit.F90 | 6 +++--- src/core/MOM_dynamics_unsplit_RK2.F90 | 6 +++--- src/parameterizations/vertical/MOM_vert_friction.F90 | 4 ++-- 4 files changed, 11 insertions(+), 11 deletions(-) diff --git a/src/core/MOM_dynamics_split_RK2.F90 b/src/core/MOM_dynamics_split_RK2.F90 index 843aafaf44..d8e6ad386b 100644 --- a/src/core/MOM_dynamics_split_RK2.F90 +++ b/src/core/MOM_dynamics_split_RK2.F90 @@ -489,7 +489,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & if (CS%debug) then 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_coef(US%m_s_to_L_T*up, US%m_s_to_L_T*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, 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)") @@ -588,7 +588,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & if (CS%debug) then call uvchksum("0 before vertvisc: [uv]p", up, vp, G%HI,haloshift=0, symmetric=sym) endif - call vertvisc_coef(up, vp, h, forces, visc, dt_pred, G, GV, US, CS%vertvisc_CSp, & + call vertvisc_coef(US%m_s_to_L_T*up, US%m_s_to_L_T*vp, h, forces, visc, dt_pred, G, GV, US, CS%vertvisc_CSp, & CS%OBC) call vertvisc(up, vp, h, forces, visc, dt_pred, CS%OBC, CS%ADp, CS%CDp, G, & GV, US, CS%vertvisc_CSp, CS%taux_bot, CS%tauy_bot, waves=waves) @@ -799,7 +799,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & ! u <- u + dt d/dz visc d/dz u ! u_av <- u_av + dt d/dz visc d/dz u_av call cpu_clock_begin(id_clock_vertvisc) - call vertvisc_coef(u, v, h, forces, visc, dt, G, GV, US, CS%vertvisc_CSp, CS%OBC) + call vertvisc_coef(US%m_s_to_L_T*u, US%m_s_to_L_T*v, h, forces, visc, dt, G, GV, US, CS%vertvisc_CSp, CS%OBC) call vertvisc(u, v, h, forces, visc, dt, CS%OBC, CS%ADp, CS%CDp, G, GV, US, & CS%vertvisc_CSp, CS%taux_bot, CS%tauy_bot,waves=waves) if (G%nonblocking_updates) then diff --git a/src/core/MOM_dynamics_unsplit.F90 b/src/core/MOM_dynamics_unsplit.F90 index 9460a74a4f..54471d53f2 100644 --- a/src/core/MOM_dynamics_unsplit.F90 +++ b/src/core/MOM_dynamics_unsplit.F90 @@ -344,7 +344,7 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & call set_viscous_ML(US%m_s_to_L_T*u, US%m_s_to_L_T*v, h_av, tv, forces, visc, dt*0.5, G, GV, US, & CS%set_visc_CSp) call disable_averaging(CS%diag) - call vertvisc_coef(up, vp, h_av, forces, visc, dt*0.5, G, GV, US, & + call vertvisc_coef(US%m_s_to_L_T*up, US%m_s_to_L_T*vp, h_av, forces, visc, dt*0.5, G, GV, US, & CS%vertvisc_CSp, CS%OBC) call vertvisc(up, vp, h_av, forces, visc, dt*0.5, CS%OBC, CS%ADp, CS%CDp, & G, GV, US, CS%vertvisc_CSp, Waves=Waves) @@ -408,7 +408,7 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & ! upp <- upp + dt/2 d/dz visc d/dz upp call cpu_clock_begin(id_clock_vertvisc) - call vertvisc_coef(upp, vpp, hp, forces, visc, dt*0.5, G, GV, US, & + call vertvisc_coef(US%m_s_to_L_T*upp, US%m_s_to_L_T*vpp, hp, forces, visc, dt*0.5, G, GV, US, & CS%vertvisc_CSp, CS%OBC) call vertvisc(upp, vpp, hp, forces, visc, dt*0.5, CS%OBC, CS%ADp, CS%CDp, & G, GV, US, CS%vertvisc_CSp, Waves=Waves) @@ -479,7 +479,7 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & ! u <- u + dt d/dz visc d/dz u call cpu_clock_begin(id_clock_vertvisc) - call vertvisc_coef(u, v, h_av, forces, visc, dt, G, GV, US, CS%vertvisc_CSp, CS%OBC) + call vertvisc_coef(US%m_s_to_L_T*u, US%m_s_to_L_T*v, h_av, forces, visc, dt, G, GV, US, CS%vertvisc_CSp, CS%OBC) call vertvisc(u, v, h_av, forces, visc, dt, CS%OBC, CS%ADp, CS%CDp, & G, GV, US, CS%vertvisc_CSp, CS%taux_bot, CS%tauy_bot, Waves=Waves) call cpu_clock_end(id_clock_vertvisc) diff --git a/src/core/MOM_dynamics_unsplit_RK2.F90 b/src/core/MOM_dynamics_unsplit_RK2.F90 index 1694544eff..5f37ab63c2 100644 --- a/src/core/MOM_dynamics_unsplit_RK2.F90 +++ b/src/core/MOM_dynamics_unsplit_RK2.F90 @@ -341,7 +341,7 @@ subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt, call set_viscous_ML(US%m_s_to_L_T*up, US%m_s_to_L_T*vp, h_av, tv, forces, visc, dt_pred, G, GV, US, & CS%set_visc_CSp) call disable_averaging(CS%diag) - call vertvisc_coef(up, vp, h_av, forces, visc, dt_pred, G, GV, US, & + call vertvisc_coef(US%m_s_to_L_T*up, US%m_s_to_L_T*vp, h_av, forces, visc, dt_pred, G, GV, US, & CS%vertvisc_CSp, CS%OBC) call vertvisc(up, vp, h_av, forces, visc, dt_pred, CS%OBC, CS%ADp, CS%CDp, & G, GV, US, CS%vertvisc_CSp) @@ -393,11 +393,11 @@ subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt, ! up[n] <- up* + dt d/dz visc d/dz up ! u[n] <- u*[n] + dt d/dz visc d/dz u[n] call cpu_clock_begin(id_clock_vertvisc) - call vertvisc_coef(up, vp, h_av, forces, visc, dt, G, GV, US, & + call vertvisc_coef(US%m_s_to_L_T*up, US%m_s_to_L_T*vp, h_av, forces, visc, dt, G, GV, US, & CS%vertvisc_CSp, CS%OBC) call vertvisc(up, vp, h_av, forces, visc, dt, CS%OBC, CS%ADp, CS%CDp, & G, GV, US, CS%vertvisc_CSp, CS%taux_bot, CS%tauy_bot) - call vertvisc_coef(u_in, v_in, h_av, forces, visc, dt, G, GV, US, & + call vertvisc_coef(US%m_s_to_L_T*u_in, US%m_s_to_L_T*v_in, h_av, forces, visc, dt, G, GV, US, & CS%vertvisc_CSp, CS%OBC) call vertvisc(u_in, v_in, h_av, forces, visc, dt, CS%OBC, CS%ADp, CS%CDp,& G, GV, US, CS%vertvisc_CSp, CS%taux_bot, CS%tauy_bot) diff --git a/src/parameterizations/vertical/MOM_vert_friction.F90 b/src/parameterizations/vertical/MOM_vert_friction.F90 index b0b2a88688..d517223f7d 100644 --- a/src/parameterizations/vertical/MOM_vert_friction.F90 +++ b/src/parameterizations/vertical/MOM_vert_friction.F90 @@ -568,9 +568,9 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, US, CS, OBC) 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_(GV)), & - intent(in) :: u !< Zonal velocity [m s-1] + intent(in) :: u !< Zonal velocity [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), & - intent(in) :: v !< Meridional velocity [m s-1] + intent(in) :: v !< Meridional velocity [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: h !< Layer thickness [H ~> m or kg m-2] type(mech_forcing), intent(in) :: forces !< A structure with the driving mechanical forces From e15389d1a201fd41715130ede7b020f6f3275136 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Wed, 14 Aug 2019 06:29:24 -0400 Subject: [PATCH 204/297] Code style modifications in wave_structure Made minor modifications in wave_structure to make it clear where array syntax is being used. Although the use of array syntax is discouraged in MOM6 with some specific exceptions, silent use of array syntax is strongly discouraged. All answers are bitwise identical. --- src/diagnostics/MOM_wave_structure.F90 | 28 ++++++++++++++------------ 1 file changed, 15 insertions(+), 13 deletions(-) diff --git a/src/diagnostics/MOM_wave_structure.F90 b/src/diagnostics/MOM_wave_structure.F90 index 796413b47c..ac28a8d012 100644 --- a/src/diagnostics/MOM_wave_structure.F90 +++ b/src/diagnostics/MOM_wave_structure.F90 @@ -131,7 +131,7 @@ subroutine wave_structure(h, tv, G, GV, US, cn, ModeNum, freq, CS, En, full_halo real, parameter :: tol1 = 0.0001, tol2 = 0.001 real, pointer, dimension(:,:,:) :: T => NULL(), S => NULL() real :: g_Rho0 ! G_Earth/Rho0 in [m5 Z-1 s-2 kg-1 ~> m4 s-2 kg-1]. - real :: rescale, I_rescale + ! real :: rescale, I_rescale integer :: kf(SZI_(G)) integer, parameter :: max_itt = 1 ! number of times to iterate in solving for eigenvector real :: cg_subRO ! A tiny wave speed to prevent division by zero [L T-1 ~> m s-1] @@ -183,7 +183,7 @@ subroutine wave_structure(h, tv, G, GV, US, cn, ModeNum, freq, CS, En, full_halo use_EOS = associated(tv%eqn_of_state) H_to_pres = GV%Z_to_H*GV%H_to_Pa - rescale = 1024.0**4 ; I_rescale = 1.0/rescale + ! rescale = 1024.0**4 ; I_rescale = 1.0/rescale min_h_frac = tol1 / real(nz) @@ -449,15 +449,15 @@ subroutine wave_structure(h, tv, G, GV, US, cn, ModeNum, freq, CS, En, full_halo enddo !### Some mathematical cancellations could occur in the next two lines. w2avg = w2avg / htot(i,j) - w_strct = w_strct / sqrt(htot(i,j)*w2avg*I_a_int) + w_strct(:) = w_strct(:) / sqrt(htot(i,j)*w2avg*I_a_int) ! Calculate vertical structure function of u (i.e. dw/dz) do K=2,nzm-1 u_strct(K) = 0.5*((w_strct(K-1) - w_strct(K) )/dz(k-1) + & - (w_strct(K) - w_strct(K+1))/dz(k)) + (w_strct(K) - w_strct(K+1))/dz(k)) enddo u_strct(1) = (w_strct(1) - w_strct(2) )/dz(1) - u_strct(nzm) = (w_strct(nzm-1)- w_strct(nzm))/dz(nzm-1) + u_strct(nzm) = (w_strct(nzm-1)- w_strct(nzm))/dz(nzm-1) ! Calculate wavenumber magnitude f2 = G%CoriolisBu(I,J)**2 @@ -467,8 +467,8 @@ subroutine wave_structure(h, tv, G, GV, US, cn, ModeNum, freq, CS, En, full_halo ! Calculate terms in vertically integrated energy equation int_dwdz2 = 0.0 ; int_w2 = 0.0 ; int_N2w2 = 0.0 - u_strct2 = u_strct(1:nzm)**2 - w_strct2 = w_strct(1:nzm)**2 + u_strct2(:) = u_strct(1:nzm)**2 + w_strct2(:) = w_strct(1:nzm)**2 ! vertical integration with Trapezoidal rule do k=1,nzm-1 int_dwdz2 = int_dwdz2 + 0.5*(u_strct2(K)+u_strct2(K+1))*dz(k) @@ -478,6 +478,7 @@ subroutine wave_structure(h, tv, G, GV, US, cn, ModeNum, freq, CS, En, full_halo ! Back-calculate amplitude from energy equation if (Kmag2 > 0.0) then + !### This should be simpified to use a single division. KE_term = 0.25*GV%Rho0*( ((1.0 + f2/freq**2) / Kmag2)*int_dwdz2 + int_w2 ) PE_term = 0.25*GV%Rho0*( int_N2w2/(US%s_to_T*freq)**2 ) if (En(i,j) >= 0.0) then @@ -488,14 +489,15 @@ subroutine wave_structure(h, tv, G, GV, US, cn, ModeNum, freq, CS, En, full_halo W0 = 0.0 endif ! Calculate actual vertical velocity profile and derivative - W_profile = W0*w_strct - dWdz_profile = W0*u_strct + W_profile(:) = W0*w_strct(:) + dWdz_profile(:) = W0*u_strct(:) ! Calculate average magnitude of actual horizontal velocity over a period - Uavg_profile = abs(dWdz_profile) * sqrt((1.0 + f2/freq**2) / (2.0*Kmag2)) + !### This should be simpified to use a single division. + Uavg_profile(:) = abs(dWdz_profile(:)) * sqrt((1.0 + f2/freq**2) / (2.0*Kmag2)) else - W_profile = 0.0 - dWdz_profile = 0.0 - Uavg_profile = 0.0 + W_profile(:) = 0.0 + dWdz_profile(:) = 0.0 + Uavg_profile(:) = 0.0 endif ! Store values in control structure From e90f16d2695f2aacb0d3563d595a9550cbf75787 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Wed, 14 Aug 2019 08:21:58 -0400 Subject: [PATCH 205/297] +Recast vertvisc to work with velocities in [L T-1] Recast vertvisc and vertvisc_limit_vel to work internally with velocities in units of [L T-1] and pass velocities to write_u_accel and write_v_accel in [L T-1]. All answers are bitwise identical, but the units of arguments to diagnostic routines have been changed. --- src/diagnostics/MOM_PointAccel.F90 | 99 +++++++------- .../vertical/MOM_vert_friction.F90 | 128 ++++++++++-------- 2 files changed, 126 insertions(+), 101 deletions(-) diff --git a/src/diagnostics/MOM_PointAccel.F90 b/src/diagnostics/MOM_PointAccel.F90 index 92292bb8e7..9983c70e01 100644 --- a/src/diagnostics/MOM_PointAccel.F90 +++ b/src/diagnostics/MOM_PointAccel.F90 @@ -47,8 +47,8 @@ module MOM_PointAccel ! that are used to step the physical model forward. They all use the same ! names as the variables they point to in MOM.F90 real, pointer, dimension(:,:,:) :: & - u_av => NULL(), & !< Time average u-velocity [m s-1]. - v_av => NULL(), & !< Time average velocity [m s-1]. + u_av => NULL(), & !< Time average u-velocity [L T-1 ~> m s-1]. + v_av => NULL(), & !< Time average velocity [L T-1 ~> m s-1]. u_prev => NULL(), & !< Previous u-velocity [m s-1]. v_prev => NULL(), & !< Previous v-velocity [m s-1]. T => NULL(), & !< Temperature [degC]. @@ -58,7 +58,7 @@ module MOM_PointAccel real, pointer, dimension(:,:,:) :: pbce => NULL() !< pbce times eta gives the baroclinic !! pressure anomaly in each layer due to free surface height anomalies !! [m2 s-2 H-1 ~> m s-2 or m4 kg-1 s-2]. - + real :: u_av_scale !< A scaling factor to convert u_av to m s-1. end type PointAccel_CS contains @@ -73,7 +73,7 @@ subroutine write_u_accel(I, j, um, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st 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) :: um !< The new zonal velocity [m s-1]. + intent(in) :: um !< The new zonal velocity [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(in) :: hin !< The layer thickness [H ~> m or kg m-2]. type(accel_diag_ptrs), intent(in) :: ADp !< A structure pointing to the various @@ -83,7 +83,7 @@ subroutine write_u_accel(I, j, um, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st real, intent(in) :: dt !< The ocean dynamics time step [s]. type(PointAccel_CS), pointer :: CS !< The control structure returned by a previous !! call to PointAccel_init. - real, intent(in) :: vel_rpt !< The velocity magnitude that triggers a report [m s-1]. + real, intent(in) :: vel_rpt !< The velocity magnitude that triggers a report [L T-1 ~> m s-1]. real, optional, intent(in) :: str !< The surface wind stress integrated over a time !! step divided by the Boussinesq density [m2 s-1]. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & @@ -132,14 +132,14 @@ subroutine write_u_accel(I, j, um, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st ! Determine which layers to write out accelerations for. do k=1,nz - if (((max(CS%u_av(I,j,k),um(I,j,k)) >= vel_rpt) .or. & - (min(CS%u_av(I,j,k),um(I,j,k)) <= -vel_rpt)) .and. & + if (((max(US%m_s_to_L_T*CS%u_av_scale*CS%u_av(I,j,k),um(I,j,k)) >= vel_rpt) .or. & + (min(US%m_s_to_L_T*CS%u_av_scale*CS%u_av(I,j,k),um(I,j,k)) <= -vel_rpt)) .and. & ((hin(i,j,k) + hin(i+1,j,k)) > 3.0*Angstrom)) exit enddo ks = k do k=nz,1,-1 - if (((max(CS%u_av(I,j,k), um(I,j,k)) >= vel_rpt) .or. & - (min(CS%u_av(I,j,k), um(I,j,k)) <= -vel_rpt)) .and. & + if (((max(US%m_s_to_L_T*CS%u_av_scale*CS%u_av(I,j,k), um(I,j,k)) >= vel_rpt) .or. & + (min(US%m_s_to_L_T*CS%u_av_scale*CS%u_av(I,j,k), um(I,j,k)) <= -vel_rpt)) .and. & ((hin(i,j,k) + hin(i+1,j,k)) > 3.0*Angstrom)) exit enddo ke = k @@ -163,29 +163,29 @@ subroutine write_u_accel(I, j, um, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st write(file,'(/,"Layers:",$)') do k=ks,ke ; if (do_k(k)) write(file,'(I10," ",$)') (k); enddo write(file,'(/,"u(m): ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (um(I,j,k)); enddo + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (US%L_T_to_m_s*um(I,j,k)); enddo if (prev_avail) then write(file,'(/,"u(mp): ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (CS%u_prev(I,j,k)); enddo endif write(file,'(/,"u(3): ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (CS%u_av(I,j,k)); enddo + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (CS%u_av_scale*CS%u_av(I,j,k)); enddo write(file,'(/,"CFL u: ",$)') do k=ks,ke ; if (do_k(k)) then - CFL = abs(US%m_to_L*um(I,j,k)) * dt * G%dy_Cu(I,j) + CFL = abs(um(I,j,k)) * US%s_to_T*dt * G%dy_Cu(I,j) if (um(I,j,k) < 0.0) then ; CFL = CFL * G%IareaT(i+1,j) else ; CFL = CFL * G%IareaT(i,j) ; endif write(file,'(ES10.3," ",$)') CFL endif ; enddo write(file,'(/,"CFL0 u:",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - abs(um(I,j,k)) * dt * US%m_to_L*G%IdxCu(I,j) ; enddo + abs(um(I,j,k)) * US%s_to_T*dt * G%IdxCu(I,j) ; enddo if (prev_avail) then write(file,'(/,"du: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - ((um(I,j,k)-CS%u_prev(I,j,k))); enddo + ((US%L_T_to_m_s*um(I,j,k)-CS%u_prev(I,j,k))); enddo endif write(file,'(/,"CAu: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (dt*US%L_T2_to_m_s2*ADp%CAu(I,j,k)); enddo @@ -207,7 +207,7 @@ subroutine write_u_accel(I, j, um, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st if (associated(ADp%du_dt_visc)) then write(file,'(/,"ubv: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - (um(I,j,k)-dt*ADp%du_dt_visc(I,j,k)); enddo + (US%L_T_to_m_s*um(I,j,k)-dt*ADp%du_dt_visc(I,j,k)); enddo write(file,'(/,"duv: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & (dt*ADp%du_dt_visc(I,j,k)); enddo @@ -285,10 +285,10 @@ subroutine write_u_accel(I, j, um, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st write(file,'(/,"vh--: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - (uh_scale*CDp%vh(i,J-1,k)*US%m_to_L*G%IdxCv(i,J-1)); enddo + (uh_scale*US%m_to_L*CDp%vh(i,J-1,k)*G%IdxCv(i,J-1)); enddo write(file,'(/," vhC--:",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - (0.5*CS%v_av(i,j-1,k)*h_scale*(hin(i,j-1,k) + hin(i,j,k))); enddo + (0.5*CS%u_av_scale*CS%v_av(i,j-1,k)*h_scale*(hin(i,j-1,k) + hin(i,j,k))); enddo if (prev_avail) then write(file,'(/," vhCp--:",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & @@ -297,10 +297,10 @@ subroutine write_u_accel(I, j, um, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st write(file,'(/,"vh-+: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - (uh_scale*CDp%vh(i,J,k)*US%m_to_L*G%IdxCv(i,J)); enddo + (uh_scale*US%m_to_L*CDp%vh(i,J,k)*G%IdxCv(i,J)); enddo write(file,'(/," vhC-+:",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - (0.5*CS%v_av(i,J,k)*h_scale*(hin(i,j,k) + hin(i,j+1,k))); enddo + (0.5*CS%u_av_scale*CS%v_av(i,J,k)*h_scale*(hin(i,j,k) + hin(i,j+1,k))); enddo if (prev_avail) then write(file,'(/," vhCp-+:",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & @@ -309,10 +309,10 @@ subroutine write_u_accel(I, j, um, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st write(file,'(/,"vh+-: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - (uh_scale*CDp%vh(i+1,J-1,k)*US%m_to_L*G%IdxCv(i+1,J-1)); enddo + (uh_scale*US%m_to_L*CDp%vh(i+1,J-1,k)*G%IdxCv(i+1,J-1)); enddo write(file,'(/," vhC+-:",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - (0.5*CS%v_av(i+1,J-1,k)*h_scale*(hin(i+1,j-1,k) + hin(i+1,j,k))); enddo + (0.5*CS%u_av_scale*CS%v_av(i+1,J-1,k)*h_scale*(hin(i+1,j-1,k) + hin(i+1,j,k))); enddo if (prev_avail) then write(file,'(/," vhCp+-:",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & @@ -321,14 +321,14 @@ subroutine write_u_accel(I, j, um, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st write(file,'(/,"vh++: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - (uh_scale*CDp%vh(i+1,J,k)*US%m_to_L*G%IdxCv(i+1,J)); enddo + (uh_scale*US%m_to_L*CDp%vh(i+1,J,k)*G%IdxCv(i+1,J)); enddo write(file,'(/," vhC++:",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - (0.5*CS%v_av(i+1,J,k)*h_scale*(hin(i+1,j,k) + hin(i+1,j+1,k))); enddo + (0.5*CS%u_av_scale*CS%v_av(i+1,J,k)*h_scale*(hin(i+1,j,k) + hin(i+1,j+1,k))); enddo if (prev_avail) then write(file,'(/," vhCp++:",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - (0.5*CS%v_av(i+1,J,k)*h_scale*(hin(i+1,j,k) + hin(i+1,j+1,k))); enddo + (0.5*CS%u_av_scale*CS%v_av(i+1,J,k)*h_scale*(hin(i+1,j,k) + hin(i+1,j+1,k))); enddo endif write(file,'(/,"D: ",2(ES10.3))') US%Z_to_m*G%bathyT(i,j),US%Z_to_m*G%bathyT(i+1,j) @@ -336,7 +336,7 @@ subroutine write_u_accel(I, j, um, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st ! From here on, the normalized accelerations are written. if (prev_avail) then do k=ks,ke - du = um(I,j,k)-CS%u_prev(I,j,k) + du = US%L_T_to_m_s*um(I,j,k)-CS%u_prev(I,j,k) if (abs(du) < 1.0e-6) du = 1.0e-6 Inorm(k) = 1.0 / du enddo @@ -346,7 +346,7 @@ subroutine write_u_accel(I, j, um, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st write(file,'(/,"du: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(F10.6," ",$)') & - ((um(I,j,k)-CS%u_prev(I,j,k))*Inorm(k)); enddo + ((US%L_T_to_m_s*um(I,j,k)-CS%u_prev(I,j,k))*Inorm(k)); enddo write(file,'(/,"CAu: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(F10.6," ",$)') & @@ -404,7 +404,7 @@ subroutine write_v_accel(i, J, vm, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st 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),SZJB_(G),SZK_(G)), & - intent(in) :: vm !< The new meridional velocity [m s-1]. + intent(in) :: vm !< The new meridional velocity [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(in) :: hin !< The layer thickness [H ~> m or kg m-2]. type(accel_diag_ptrs), intent(in) :: ADp !< A structure pointing to the various @@ -414,7 +414,7 @@ subroutine write_v_accel(i, J, vm, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st real, intent(in) :: dt !< The ocean dynamics time step [s]. type(PointAccel_CS), pointer :: CS !< The control structure returned by a previous !! call to PointAccel_init. - real, intent(in) :: vel_rpt !< The velocity magnitude that triggers a report [m s-1]. + real, intent(in) :: vel_rpt !< The velocity magnitude that triggers a report [L T-1 ~> m s-1]. real, optional, intent(in) :: str !< The surface wind stress integrated over a time !! step divided by the Boussinesq density [m2 s-1]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & @@ -462,14 +462,14 @@ subroutine write_v_accel(i, J, vm, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st prev_avail = (associated(CS%u_prev) .and. associated(CS%v_prev)) do k=1,nz - if (((max(CS%v_av(i,J,k), vm(i,J,k)) >= vel_rpt) .or. & - (min(CS%v_av(i,J,k), vm(i,J,k)) <= -vel_rpt)) .and. & + if (((max(US%m_s_to_L_T*CS%u_av_scale*CS%v_av(i,J,k), US%L_T_to_m_s*vm(i,J,k)) >= vel_rpt) .or. & + (min(US%m_s_to_L_T*CS%u_av_scale*CS%v_av(i,J,k), US%L_T_to_m_s*vm(i,J,k)) <= -vel_rpt)) .and. & ((hin(i,j,k) + hin(i,j+1,k)) > 3.0*Angstrom)) exit enddo ks = k do k=nz,1,-1 - if (((max(CS%v_av(i,J,k), vm(i,J,k)) >= vel_rpt) .or. & - (min(CS%v_av(i,J,k), vm(i,J,k)) <= -vel_rpt)) .and. & + if (((max(US%m_s_to_L_T*CS%u_av_scale*CS%v_av(i,J,k), US%L_T_to_m_s*vm(i,J,k)) >= vel_rpt) .or. & + (min(US%m_s_to_L_T*CS%u_av_scale*CS%v_av(i,J,k), US%L_T_to_m_s*vm(i,J,k)) <= -vel_rpt)) .and. & ((hin(i,j,k) + hin(i,j+1,k)) > 3.0*Angstrom)) exit enddo ke = k @@ -493,7 +493,7 @@ subroutine write_v_accel(i, J, vm, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st write(file,'(/,"Layers:",$)') do k=ks,ke ; if (do_k(k)) write(file,'(I10," ",$)') (k); enddo write(file,'(/,"v(m): ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (vm(i,J,k)); enddo + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (US%L_T_to_m_s*vm(i,J,k)); enddo if (prev_avail) then write(file,'(/,"v(mp): ",$)') @@ -501,22 +501,22 @@ subroutine write_v_accel(i, J, vm, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st endif write(file,'(/,"v(3): ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (CS%v_av(i,J,k)); enddo + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (CS%u_av_scale*CS%v_av(i,J,k)); enddo write(file,'(/,"CFL v: ",$)') do k=ks,ke ; if (do_k(k)) then - CFL = abs(US%m_to_L*vm(i,J,k)) * dt * G%dx_Cv(i,J) + CFL = abs(vm(i,J,k)) * US%s_to_T*dt * G%dx_Cv(i,J) if (vm(i,J,k) < 0.0) then ; CFL = CFL * G%IareaT(i,j+1) else ; CFL = CFL * G%IareaT(i,j) ; endif write(file,'(ES10.3," ",$)') CFL endif ; enddo write(file,'(/,"CFL0 v:",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - abs(vm(i,J,k)) * dt * US%m_to_L*G%IdyCv(i,J) ; enddo + abs(vm(i,J,k)) * US%s_to_T*dt * G%IdyCv(i,J) ; enddo if (prev_avail) then write(file,'(/,"dv: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - ((vm(i,J,k)-CS%v_prev(i,J,k))); enddo + ((US%L_T_to_m_s*vm(i,J,k)-CS%v_prev(i,J,k))); enddo endif write(file,'(/,"CAv: ",$)') @@ -541,7 +541,7 @@ subroutine write_v_accel(i, J, vm, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st if (associated(ADp%dv_dt_visc)) then write(file,'(/,"vbv: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - (vm(i,J,k)-dt*ADp%dv_dt_visc(i,J,k)); enddo + (US%L_T_to_m_s*vm(i,J,k)-dt*ADp%dv_dt_visc(i,J,k)); enddo write(file,'(/,"dvv: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & @@ -619,10 +619,10 @@ subroutine write_v_accel(i, J, vm, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st write(file,'(/,"uh--: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - (uh_scale*CDp%uh(I-1,j,k)*US%m_to_L*G%IdyCu(I-1,j)); enddo + (uh_scale*US%m_to_L*CDp%uh(I-1,j,k)*G%IdyCu(I-1,j)); enddo write(file,'(/," uhC--: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - (CS%u_av(I-1,j,k) * h_scale*0.5*(hin(i-1,j,k) + hin(i,j,k))); enddo + (CS%u_av_scale*CS%u_av(I-1,j,k) * h_scale*0.5*(hin(i-1,j,k) + hin(i,j,k))); enddo if (prev_avail) then write(file,'(/," uhCp--:",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & @@ -631,10 +631,10 @@ subroutine write_v_accel(i, J, vm, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st write(file,'(/,"uh-+: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - (uh_scale*CDp%uh(I-1,j+1,k)*US%m_to_L*G%IdyCu(I-1,j+1)); enddo + (uh_scale*US%m_to_L*CDp%uh(I-1,j+1,k)*G%IdyCu(I-1,j+1)); enddo write(file,'(/," uhC-+: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - (CS%u_av(I-1,j+1,k) * h_scale*0.5*(hin(i-1,j+1,k) + hin(i,j+1,k))); enddo + (CS%u_av_scale*CS%u_av(I-1,j+1,k) * h_scale*0.5*(hin(i-1,j+1,k) + hin(i,j+1,k))); enddo if (prev_avail) then write(file,'(/," uhCp-+:",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & @@ -643,10 +643,10 @@ subroutine write_v_accel(i, J, vm, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st write(file,'(/,"uh+-: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - (uh_scale*CDp%uh(I,j,k)*US%m_to_L*G%IdyCu(I,j)); enddo + (uh_scale*US%m_to_L*CDp%uh(I,j,k)*G%IdyCu(I,j)); enddo write(file,'(/," uhC+-: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - (CS%u_av(I,j,k) * h_scale*0.5*(hin(i,j,k) + hin(i+1,j,k))); enddo + (CS%u_av_scale*CS%u_av(I,j,k) * h_scale*0.5*(hin(i,j,k) + hin(i+1,j,k))); enddo if (prev_avail) then write(file,'(/," uhCp+-:",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & @@ -655,10 +655,10 @@ subroutine write_v_accel(i, J, vm, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st write(file,'(/,"uh++: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - (uh_scale*CDp%uh(I,j+1,k)*US%m_to_L*G%IdyCu(I,j+1)); enddo + (uh_scale*US%m_to_L*CDp%uh(I,j+1,k)*G%IdyCu(I,j+1)); enddo write(file,'(/," uhC++: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - (CS%u_av(I,j+1,k) * 0.5*h_scale*(hin(i,j+1,k) + hin(i+1,j+1,k))); enddo + (CS%u_av_scale*CS%u_av(I,j+1,k) * 0.5*h_scale*(hin(i,j+1,k) + hin(i+1,j+1,k))); enddo if (prev_avail) then write(file,'(/," uhCp++:",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & @@ -670,7 +670,7 @@ subroutine write_v_accel(i, J, vm, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st ! From here on, the normalized accelerations are written. if (prev_avail) then do k=ks,ke - dv = vm(i,J,k)-CS%v_prev(i,J,k) + dv = US%L_T_to_m_s*vm(i,J,k)-CS%v_prev(i,J,k) if (abs(dv) < 1.0e-6) dv = 1.0e-6 Inorm(k) = 1.0 / dv enddo @@ -679,7 +679,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,'(F10.6," ",$)') (1.0/Inorm(k)); enddo write(file,'(/,"dv: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(F10.6," ",$)') & - ((vm(i,J,k)-CS%v_prev(i,J,k))*Inorm(k)); enddo + ((US%L_T_to_m_s*vm(i,J,k)-CS%v_prev(i,J,k))*Inorm(k)); enddo write(file,'(/,"CAv: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(F10.6," ",$)') & (dt*US%L_T2_to_m_s2*ADp%CAv(i,J,k)*Inorm(k)); enddo @@ -755,6 +755,9 @@ subroutine PointAccel_init(MIS, Time, G, param_file, diag, dirs, CS) CS%u_av => MIS%u_av; if (.not.associated(MIS%u_av)) CS%u_av => MIS%u(:,:,:) CS%v_av => MIS%v_av; if (.not.associated(MIS%v_av)) CS%v_av => MIS%v(:,:,:) +! CS%u_av_scale = G%US%L_T_to_m_s ; if (.not.associated(MIS%u_av)) CS%u_av_scale = 1.0 + CS%u_av_scale = 1.0 + ! Read all relevant parameters and write them to the model log. call log_version(param_file, mdl, version, "") call get_param(param_file, mdl, "U_TRUNC_FILE", CS%u_trunc_file, & diff --git a/src/parameterizations/vertical/MOM_vert_friction.F90 b/src/parameterizations/vertical/MOM_vert_friction.F90 index d517223f7d..3cdc394675 100644 --- a/src/parameterizations/vertical/MOM_vert_friction.F90 +++ b/src/parameterizations/vertical/MOM_vert_friction.F90 @@ -46,9 +46,9 @@ module MOM_vert_friction real :: Kvbbl !< The vertical viscosity in the bottom boundary !! layer [Z2 T-1 ~> m2 s-1]. - real :: maxvel !< Velocity components greater than maxvel are truncated [m s-1]. + real :: maxvel !< Velocity components greater than maxvel are truncated [L T-1 ~> m s-1]. 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]. logical :: CFL_based_trunc !< If true, base truncations on CFL numbers, not !! absolute velocities. real :: CFL_trunc !< Velocity components will be truncated when they @@ -183,8 +183,9 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, US, CS, & real :: Hmix ! The mixed layer thickness over which stress ! is applied with direct_stress [H ~> m or kg m-2]. real :: I_Hmix ! The inverse of Hmix [H-1 ~> m-1 or m2 kg-1]. - real :: Idt ! The inverse of the time step [s-1]. - real :: dt_Rho0 ! The time step divided by the mean density [s m3 kg-1]. + real :: dt_in_T ! The timestep [T ~> s] + real :: Idt ! The inverse of the time step [T-1 ~> s-1]. + real :: dt_Rho0 ! The time step divided by the mean density [L s2 H m T-1 kg-1 ~> s m3 kg-1 or s]. 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 - [T H Z-1 ~> s or s kg m-3]. @@ -192,10 +193,10 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, US, CS, & ! in roundoff and can be neglected [H ~> m or kg m-2]. real :: stress ! The surface stress times the time step, divided - ! by the density [m2 s-1]. + ! by the density [H L T-1 ~> m2 s-1 or kg m-1 s-1]. real :: zDS, hfr, h_a ! Temporary variables used with direct_stress. real :: surface_stress(SZIB_(G))! The same as stress, unless the wind stress - ! stress is applied as a body force [m2 s-1]. + ! stress is applied as a body force [H L T-1 ~> m2 s-1 or kg m-1 s-1]. logical :: do_i(SZIB_(G)) logical :: DoStokesMixing @@ -207,15 +208,25 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, US, CS, & if (.not.associated(CS)) call MOM_error(FATAL,"MOM_vert_friction(visc): "// & "Module must be initialized before it is used.") + !### This is temporary and will be deleted when the units of the input velocities have changed. + do j=G%jsc,G%jec ; do k=1,nz ; do I=Isq,Ieq + u(I,j,k) = US%m_s_to_L_T*u(I,j,k) + enddo ; enddo ; enddo + do J=Jsq,Jeq ; do k=1,nz ; do i=is,ie + v(i,J,k) = US%m_s_to_L_T*v(i,J,k) + enddo ; enddo ; enddo + + if (CS%direct_stress) then Hmix = CS%Hmix_stress I_Hmix = 1.0 / Hmix endif - dt_Rho0 = dt/GV%H_to_kg_m2 - dt_Z_to_H = US%s_to_T*dt*GV%Z_to_H + dt_in_T = US%s_to_T*dt + dt_Rho0 = US%m_s_to_L_T*US%T_to_s * dt_in_T / GV%H_to_kg_m2 + dt_Z_to_H = dt_in_T*GV%Z_to_H Rho0 = GV%Rho0 h_neglect = GV%H_subroundoff - Idt = 1.0 / dt + Idt = 1.0 / dt_in_T !Check if Stokes mixing allowed if requested (present and associated) DoStokesMixing=.false. @@ -239,7 +250,7 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, US, CS, & ! When mixing down Eulerian current + Stokes drift add before calling solver if (DoStokesMixing) then ; do k=1,nz ; do I=Isq,Ieq - if (do_i(I)) u(I,j,k) = u(I,j,k) + Waves%Us_x(I,j,k) + if (do_i(I)) u(I,j,k) = u(I,j,k) + US%m_s_to_L_T*Waves%Us_x(I,j,k) enddo ; enddo ; endif if (associated(ADp%du_dt_visc)) then ; do k=1,nz ; do I=Isq,Ieq @@ -314,25 +325,25 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, US, CS, & endif ; enddo ; enddo ! i and k loops if (associated(ADp%du_dt_visc)) then ; do k=1,nz ; do I=Isq,Ieq - ADp%du_dt_visc(I,j,k) = (u(I,j,k) - ADp%du_dt_visc(I,j,k))*Idt + ADp%du_dt_visc(I,j,k) = US%L_T2_to_m_s2*(u(I,j,k) - ADp%du_dt_visc(I,j,k))*Idt enddo ; enddo ; endif if (associated(visc%taux_shelf)) then ; do I=Isq,Ieq - visc%taux_shelf(I,j) = -Rho0*US%s_to_T*CS%a1_shelf_u(I,j)*u(I,j,1) ! - u_shelf? + visc%taux_shelf(I,j) = -Rho0*US%L_T2_to_m_s2*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)*US%s_to_T*CS%a_u(I,j,nz+1)) + taux_bot(I,j) = US%L_T2_to_m_s2*Rho0 * (u(I,j,nz)*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 * (US%s_to_T*Ray(I,k)*u(I,j,k)) + taux_bot(I,j) = taux_bot(I,j) + US%L_T2_to_m_s2*Rho0 * (Ray(I,k)*u(I,j,k)) enddo ; enddo ; endif endif ! When mixing down Eulerian current + Stokes drift subtract after calling solver if (DoStokesMixing) then ; do k=1,nz ; do I=Isq,Ieq - if (do_i(I)) u(I,j,k) = u(I,j,k) - Waves%Us_x(I,j,k) + if (do_i(I)) u(I,j,k) = u(I,j,k) - US%m_s_to_L_T*Waves%Us_x(I,j,k) enddo ; enddo ; endif enddo ! end u-component j loop @@ -347,7 +358,7 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, US, CS, & ! When mixing down Eulerian current + Stokes drift add before calling solver if (DoStokesMixing) then ; do k=1,nz ; do i=is,ie - if (do_i(i)) v(i,j,k) = v(i,j,k) + Waves%Us_y(i,j,k) + if (do_i(i)) v(i,j,k) = v(i,j,k) + US%m_s_to_L_T*Waves%Us_y(i,j,k) enddo ; enddo ; endif if (associated(ADp%dv_dt_visc)) then ; do k=1,nz ; do i=is,ie @@ -395,25 +406,25 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, US, CS, & endif ; enddo ; enddo ! i and k loops if (associated(ADp%dv_dt_visc)) then ; do k=1,nz ; do i=is,ie - ADp%dv_dt_visc(i,J,k) = (v(i,J,k) - ADp%dv_dt_visc(i,J,k))*Idt + ADp%dv_dt_visc(i,J,k) = US%L_T2_to_m_s2*(v(i,J,k) - ADp%dv_dt_visc(i,J,k))*Idt enddo ; enddo ; endif if (associated(visc%tauy_shelf)) then ; do i=is,ie - visc%tauy_shelf(i,J) = -Rho0*US%s_to_T*CS%a1_shelf_v(i,J)*v(i,J,1) ! - v_shelf? + visc%tauy_shelf(i,J) = -Rho0*US%L_T2_to_m_s2*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)*US%s_to_T*CS%a_v(i,J,nz+1)) + tauy_bot(i,J) = Rho0 * (US%L_T2_to_m_s2*v(i,J,nz)*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 * (US%s_to_T*Ray(i,k)*v(i,J,k)) + tauy_bot(i,J) = tauy_bot(i,J) + Rho0 * (US%L_T2_to_m_s2*Ray(i,k)*v(i,J,k)) enddo ; enddo ; endif endif ! When mixing down Eulerian current + Stokes drift subtract after calling solver if (DoStokesMixing) then ; do k=1,nz ; do i=is,ie - if (do_i(i)) v(i,J,k) = v(i,J,k) - Waves%Us_y(i,J,k) + if (do_i(i)) v(i,J,k) = v(i,J,k) - US%m_s_to_L_T*Waves%Us_y(i,J,k) enddo ; enddo ; endif enddo ! end of v-component J loop @@ -427,18 +438,27 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, US, CS, & if (OBC%segment(n)%is_N_or_S) then J = OBC%segment(n)%HI%JsdB do k=1,nz ; do i=OBC%segment(n)%HI%isd,OBC%segment(n)%HI%ied - v(i,J,k) = US%L_T_to_m_s*OBC%segment(n)%normal_vel(i,J,k) + v(i,J,k) = OBC%segment(n)%normal_vel(i,J,k) enddo ; enddo elseif (OBC%segment(n)%is_E_or_W) then I = OBC%segment(n)%HI%IsdB do k=1,nz ; do j=OBC%segment(n)%HI%jsd,OBC%segment(n)%HI%jed - u(I,j,k) = US%L_T_to_m_s*OBC%segment(n)%normal_vel(I,j,k) + u(I,j,k) = OBC%segment(n)%normal_vel(I,j,k) enddo ; enddo endif endif enddo endif + + !### This is temporary and will be deleted when the units of the input velocities have changed. + do j=G%jsc,G%jec ; do k=1,nz ; do I=Isq,Ieq + u(I,j,k) = US%L_T_to_m_s*u(I,j,k) + enddo ; enddo ; enddo + do J=Jsq,Jeq ; do k=1,nz ; do i=is,ie + v(i,J,k) = US%L_T_to_m_s*v(i,J,k) + enddo ; enddo ; enddo + ! Offer diagnostic fields for averaging. if (CS%id_du_dt_visc > 0) & call post_data(CS%id_du_dt_visc, ADp%du_dt_visc, CS%diag) @@ -1353,9 +1373,9 @@ subroutine vertvisc_limit_vel(u, v, h, ADp, CDp, forces, visc, dt, G, GV, US, CS 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_(GV)), & - intent(inout) :: u !< Zonal velocity [m s-1] + intent(inout) :: u !< Zonal velocity [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), & - intent(inout) :: v !< Meridional velocity [m s-1] + intent(inout) :: v !< Meridional velocity [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: h !< Layer thickness [H ~> m or kg m-2] type(accel_diag_ptrs), intent(in) :: ADp !< Acceleration diagnostic pointers @@ -1368,13 +1388,14 @@ subroutine vertvisc_limit_vel(u, v, h, ADp, CDp, forces, visc, dt, G, GV, US, CS ! Local variables real :: maxvel ! Velocities components greater than maxvel - real :: truncvel ! are truncated to truncvel, both [m s-1]. + real :: truncvel ! are truncated to truncvel, both [L T-1 ~> m s-1]. + real :: dt_in_T ! The timestep [T ~> s] real :: CFL ! The local CFL number. real :: H_report ! A thickness below which not to report truncations. real :: dt_Rho0 ! The timestep divided by the Boussinesq density [s m3 kg-1]. - real :: vel_report(SZIB_(G),SZJB_(G)) - real :: u_old(SZIB_(G),SZJ_(G),SZK_(G)) - real :: v_old(SZI_(G),SZJB_(G),SZK_(G)) + real :: vel_report(SZIB_(G),SZJB_(G)) ! The velocity to report [L T-1 ~> m s-1] + real :: u_old(SZIB_(G),SZJ_(G),SZK_(G)) ! The previous u-velocity [L T-1 ~> m s-1] + real :: v_old(SZI_(G),SZJB_(G),SZK_(G)) ! The previous v-velocity [L T-1 ~> m s-1] logical :: trunc_any, dowrite(SZIB_(G),SZJB_(G)) integer :: i, j, k, is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke @@ -1383,6 +1404,7 @@ subroutine vertvisc_limit_vel(u, v, h, ADp, CDp, forces, visc, dt, G, GV, US, CS maxvel = CS%maxvel truncvel = 0.9*maxvel H_report = 6.0 * GV%Angstrom_H + dt_in_T = US%s_to_T*dt dt_Rho0 = dt / GV%Rho0 if (len_trim(CS%u_trunc_file) > 0) then @@ -1391,13 +1413,13 @@ subroutine vertvisc_limit_vel(u, v, h, ADp, CDp, forces, visc, dt, G, GV, US, CS trunc_any = .false. do I=Isq,Ieq ; dowrite(I,j) = .false. ; enddo if (CS%CFL_based_trunc) then - do I=Isq,Ieq ; vel_report(i,j) = 3.0e8 ; enddo ! Speed of light default. + do I=Isq,Ieq ; vel_report(i,j) = 3.0e8*US%m_s_to_L_T ; enddo ! Speed of light default. do k=1,nz ; do I=Isq,Ieq if (abs(u(I,j,k)) < CS%vel_underflow) u(I,j,k) = 0.0 if (u(I,j,k) < 0.0) then - CFL = (-US%m_s_to_L_T*u(I,j,k) * US%s_to_T*dt) * (G%dy_Cu(I,j) * G%IareaT(i+1,j)) + CFL = (-u(I,j,k) * dt_in_T) * (G%dy_Cu(I,j) * G%IareaT(i+1,j)) else - CFL = (US%m_s_to_L_T*u(I,j,k) * US%s_to_T*dt) * (G%dy_Cu(I,j) * G%IareaT(i,j)) + CFL = (u(I,j,k) * dt_in_T) * (G%dy_Cu(I,j) * G%IareaT(i,j)) endif if (CFL > CS%CFL_trunc) trunc_any = .true. if (CFL > CS%CFL_report) then @@ -1421,11 +1443,11 @@ subroutine vertvisc_limit_vel(u, v, h, ADp, CDp, forces, visc, dt, G, GV, US, CS if (trunc_any) then ; if (CS%CFL_based_trunc) then do k=1,nz ; do I=Isq,Ieq - if ((US%m_s_to_L_T*u(I,j,k) * (US%s_to_T*dt * G%dy_Cu(I,j))) * G%IareaT(i+1,j) < -CS%CFL_trunc) then - u(I,j,k) = US%L_T_to_m_s*(-0.9*CS%CFL_trunc) * (G%areaT(i+1,j) / (US%s_to_T*dt * G%dy_Cu(I,j))) + if ((u(I,j,k) * (dt_in_T * G%dy_Cu(I,j))) * G%IareaT(i+1,j) < -CS%CFL_trunc) then + u(I,j,k) = (-0.9*CS%CFL_trunc) * (G%areaT(i+1,j) / (dt_in_T * G%dy_Cu(I,j))) if (h(i,j,k) + h(i+1,j,k) > H_report) CS%ntrunc = CS%ntrunc + 1 - elseif ((US%m_s_to_L_T*u(I,j,k) * (US%s_to_T*dt * G%dy_Cu(I,j))) * G%IareaT(i,j) > CS%CFL_trunc) then - u(I,j,k) = US%L_T_to_m_s*(0.9*CS%CFL_trunc) * (G%areaT(i,j) / (US%s_to_T*dt * G%dy_Cu(I,j))) + elseif ((u(I,j,k) * (dt_in_T * G%dy_Cu(I,j))) * G%IareaT(i,j) > CS%CFL_trunc) then + u(I,j,k) = (0.9*CS%CFL_trunc) * (G%areaT(i,j) / (dt_in_T * G%dy_Cu(I,j))) if (h(i,j,k) + h(i+1,j,k) > H_report) CS%ntrunc = CS%ntrunc + 1 endif enddo ; enddo @@ -1441,11 +1463,11 @@ subroutine vertvisc_limit_vel(u, v, h, ADp, CDp, forces, visc, dt, G, GV, US, CS !$OMP parallel do default(none) shared(nz,js,je,Isq,Ieq,u,dt,G,CS,h,H_report) do k=1,nz ; do j=js,je ; do I=Isq,Ieq if (abs(u(I,j,k)) < CS%vel_underflow) then ; u(I,j,k) = 0.0 - elseif ((US%m_s_to_L_T*u(I,j,k) * (US%s_to_T*dt * G%dy_Cu(I,j))) * G%IareaT(i+1,j) < -CS%CFL_trunc) then - u(I,j,k) = US%L_T_to_m_s*(-0.9*CS%CFL_trunc) * (G%areaT(i+1,j) / (US%s_to_T*dt * G%dy_Cu(I,j))) + elseif ((u(I,j,k) * (dt_in_T * G%dy_Cu(I,j))) * G%IareaT(i+1,j) < -CS%CFL_trunc) then + u(I,j,k) = (-0.9*CS%CFL_trunc) * (G%areaT(i+1,j) / (dt_in_T * G%dy_Cu(I,j))) if (h(i,j,k) + h(i+1,j,k) > H_report) CS%ntrunc = CS%ntrunc + 1 - elseif ((US%m_s_to_L_T*u(I,j,k) * (US%s_to_T*dt * G%dy_Cu(I,j))) * G%IareaT(i,j) > CS%CFL_trunc) then - u(I,j,k) = US%L_T_to_m_s*(0.9*CS%CFL_trunc) * (G%areaT(i,j) / (US%s_to_T*dt * G%dy_Cu(I,j))) + elseif ((u(I,j,k) * (dt_in_T * G%dy_Cu(I,j))) * G%IareaT(i,j) > CS%CFL_trunc) then + u(I,j,k) = (0.9*CS%CFL_trunc) * (G%areaT(i,j) / (dt_in_T * G%dy_Cu(I,j))) if (h(i,j,k) + h(i+1,j,k) > H_report) CS%ntrunc = CS%ntrunc + 1 endif enddo ; enddo ; enddo @@ -1476,13 +1498,13 @@ subroutine vertvisc_limit_vel(u, v, h, ADp, CDp, forces, visc, dt, G, GV, US, CS trunc_any = .false. do i=is,ie ; dowrite(i,J) = .false. ; enddo if (CS%CFL_based_trunc) then - do i=is,ie ; vel_report(i,J) = 3.0e8 ; enddo ! Speed of light default. + do i=is,ie ; vel_report(i,J) = 3.0e8*US%m_s_to_L_T ; enddo ! Speed of light default. do k=1,nz ; do i=is,ie if (abs(v(i,J,k)) < CS%vel_underflow) v(i,J,k) = 0.0 if (v(i,J,k) < 0.0) then - CFL = (-US%m_s_to_L_T*v(i,J,k) * US%s_to_T*dt) * (G%dx_Cv(i,J) * G%IareaT(i,j+1)) + CFL = (-v(i,J,k) * dt_in_T) * (G%dx_Cv(i,J) * G%IareaT(i,j+1)) else - CFL = (US%m_s_to_L_T*v(i,J,k) * US%s_to_T*dt) * (G%dx_Cv(i,J) * G%IareaT(i,j)) + CFL = (v(i,J,k) * dt_in_T) * (G%dx_Cv(i,J) * G%IareaT(i,j)) endif if (CFL > CS%CFL_trunc) trunc_any = .true. if (CFL > CS%CFL_report) then @@ -1506,11 +1528,11 @@ subroutine vertvisc_limit_vel(u, v, h, ADp, CDp, forces, visc, dt, G, GV, US, CS if (trunc_any) then ; if (CS%CFL_based_trunc) then do k=1,nz; do i=is,ie - if ((US%m_s_to_L_T*v(i,J,k) * (US%s_to_T*dt * G%dx_Cv(i,J))) * G%IareaT(i,j+1) < -CS%CFL_trunc) then - v(i,J,k) = US%L_T_to_m_s*(-0.9*CS%CFL_trunc) * (G%areaT(i,j+1) / (US%s_to_T*dt * G%dx_Cv(i,J))) + if ((v(i,J,k) * (dt_in_T * G%dx_Cv(i,J))) * G%IareaT(i,j+1) < -CS%CFL_trunc) then + v(i,J,k) = (-0.9*CS%CFL_trunc) * (G%areaT(i,j+1) / (dt_in_T * G%dx_Cv(i,J))) if (h(i,j,k) + h(i,j+1,k) > H_report) CS%ntrunc = CS%ntrunc + 1 - elseif ((US%m_s_to_L_T*v(i,J,k) * (US%s_to_T*dt * G%dx_Cv(i,J))) * G%IareaT(i,j) > CS%CFL_trunc) then - v(i,J,k) = US%L_T_to_m_s*(0.9*CS%CFL_trunc) * (G%areaT(i,j) / (US%s_to_T*dt * G%dx_Cv(i,J))) + elseif ((v(i,J,k) * (dt_in_T * G%dx_Cv(i,J))) * G%IareaT(i,j) > CS%CFL_trunc) then + v(i,J,k) = (0.9*CS%CFL_trunc) * (G%areaT(i,j) / (dt_in_T * G%dx_Cv(i,J))) if (h(i,j,k) + h(i,j+1,k) > H_report) CS%ntrunc = CS%ntrunc + 1 endif enddo ; enddo @@ -1526,11 +1548,11 @@ subroutine vertvisc_limit_vel(u, v, h, ADp, CDp, forces, visc, dt, G, GV, US, CS !$OMP parallel do default(shared) do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie if (abs(v(i,J,k)) < CS%vel_underflow) then ; v(i,J,k) = 0.0 - elseif ((US%m_s_to_L_T*v(i,J,k) * (US%s_to_T*dt * G%dx_Cv(i,J))) * G%IareaT(i,j+1) < -CS%CFL_trunc) then - v(i,J,k) = US%L_T_to_m_s*(-0.9*CS%CFL_trunc) * (G%areaT(i,j+1) / (US%s_to_T*dt * G%dx_Cv(i,J))) + elseif ((v(i,J,k) * (dt_in_T * G%dx_Cv(i,J))) * G%IareaT(i,j+1) < -CS%CFL_trunc) then + v(i,J,k) = (-0.9*CS%CFL_trunc) * (G%areaT(i,j+1) / (dt_in_T * G%dx_Cv(i,J))) if (h(i,j,k) + h(i,j+1,k) > H_report) CS%ntrunc = CS%ntrunc + 1 - elseif ((US%m_s_to_L_T*v(i,J,k) * (US%s_to_T*dt * G%dx_Cv(i,J))) * G%IareaT(i,j) > CS%CFL_trunc) then - v(i,J,k) = US%L_T_to_m_s*(0.9*CS%CFL_trunc) * (G%areaT(i,j) / (US%s_to_T*dt * G%dx_Cv(i,J))) + elseif ((v(i,J,k) * (dt_in_T * G%dx_Cv(i,J))) * G%IareaT(i,j) > CS%CFL_trunc) then + v(i,J,k) = (0.9*CS%CFL_trunc) * (G%areaT(i,j) / (dt_in_T * G%dx_Cv(i,J))) if (h(i,j,k) + h(i,j+1,k) > H_report) CS%ntrunc = CS%ntrunc + 1 endif enddo ; enddo ; enddo @@ -1684,7 +1706,7 @@ subroutine vertvisc_init(MIS, Time, G, GV, US, param_file, diag, ADp, dirs, & "but LINEAR_DRAG is not.", units="m", fail_if_missing=.true., scale=GV%m_to_H) 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) call get_param(param_file, mdl, "CFL_BASED_TRUNCATIONS", CS%CFL_based_trunc, & "If true, base truncations on the CFL number, and not an "//& "absolute speed.", default=.true.) @@ -1728,7 +1750,7 @@ subroutine vertvisc_init(MIS, Time, G, GV, US, param_file, diag, ADp, dirs, & "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) ALLOC_(CS%a_u(IsdB:IedB,jsd:jed,nz+1)) ; CS%a_u(:,:,:) = 0.0 ALLOC_(CS%h_u(IsdB:IedB,jsd:jed,nz)) ; CS%h_u(:,:,:) = 0.0 From a0a46e83d96159c84607e513177ecb0e8793a941 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Wed, 14 Aug 2019 08:48:17 -0400 Subject: [PATCH 206/297] +Rescaled ADp%du_dt_visc to units of [L T-2] Rescaled ADp%du_dt_visc and ADp%dv_dt_visc to units of [L T-2]. All answers are bitwise identical but there are changes to the units of elements of a transparent type. --- src/core/MOM_variables.F90 | 4 ++-- src/diagnostics/MOM_PointAccel.F90 | 12 ++++++------ src/diagnostics/MOM_diagnostics.F90 | 4 ++-- 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 33797198a5..aeea2329b6 100644 --- a/src/core/MOM_variables.F90 +++ b/src/core/MOM_variables.F90 @@ -162,8 +162,8 @@ module MOM_variables CAv => NULL(), & !< Meridional Coriolis and momentum advection accelerations [L T-2 ~> m s-2] PFu => NULL(), & !< Zonal acceleration due to pressure forces [L T-2 ~> m s-2] PFv => NULL(), & !< Meridional acceleration due to pressure forces [L T-2 ~> m s-2] - du_dt_visc => NULL(), &!< Zonal acceleration due to vertical viscosity [m s-2] - dv_dt_visc => NULL(), &!< Meridional acceleration due to vertical viscosity [m s-2] + du_dt_visc => NULL(), &!< Zonal acceleration due to vertical viscosity [L T-2 ~> m s-2] + dv_dt_visc => NULL(), &!< Meridional acceleration due to vertical viscosity [L T-2 ~> m s-2] du_dt_dia => NULL(), & !< Zonal acceleration due to diapycnal mixing [L T-2 ~> m s-2] dv_dt_dia => NULL() !< Meridional acceleration due to diapycnal mixing [L T-2 ~> m s-2] real, pointer, dimension(:,:,:) :: du_other => NULL() diff --git a/src/diagnostics/MOM_PointAccel.F90 b/src/diagnostics/MOM_PointAccel.F90 index 9983c70e01..e78e6133f3 100644 --- a/src/diagnostics/MOM_PointAccel.F90 +++ b/src/diagnostics/MOM_PointAccel.F90 @@ -207,10 +207,10 @@ subroutine write_u_accel(I, j, um, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st if (associated(ADp%du_dt_visc)) then write(file,'(/,"ubv: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - (US%L_T_to_m_s*um(I,j,k)-dt*ADp%du_dt_visc(I,j,k)); enddo + US%L_T_to_m_s*(um(I,j,k) - US%s_to_T*dt*ADp%du_dt_visc(I,j,k)); enddo write(file,'(/,"duv: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - (dt*ADp%du_dt_visc(I,j,k)); enddo + (dt*US%L_T2_to_m_s2*ADp%du_dt_visc(I,j,k)); enddo endif if (associated(ADp%du_other)) then write(file,'(/,"du_other: ",$)') @@ -373,7 +373,7 @@ subroutine write_u_accel(I, j, um, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st if (associated(ADp%du_dt_visc)) then write(file,'(/,"duv: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(F10.6," ",$)') & - (dt*ADp%du_dt_visc(I,j,k))*Inorm(k); enddo + (dt*US%L_T2_to_m_s2*ADp%du_dt_visc(I,j,k))*Inorm(k); enddo endif if (associated(ADp%du_other)) then write(file,'(/,"du_other: ",$)') @@ -541,11 +541,11 @@ subroutine write_v_accel(i, J, vm, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st if (associated(ADp%dv_dt_visc)) then write(file,'(/,"vbv: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - (US%L_T_to_m_s*vm(i,J,k)-dt*ADp%dv_dt_visc(i,J,k)); enddo + US%L_T_to_m_s*(vm(i,J,k) - US%s_to_T*dt*ADp%dv_dt_visc(i,J,k)); enddo write(file,'(/,"dvv: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - (dt*ADp%dv_dt_visc(i,J,k)); enddo + (dt*US%L_T2_to_m_s2*ADp%dv_dt_visc(i,J,k)); enddo endif if (associated(ADp%dv_other)) then write(file,'(/,"dv_other: ",$)') @@ -703,7 +703,7 @@ subroutine write_v_accel(i, J, vm, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st if (associated(ADp%dv_dt_visc)) then write(file,'(/,"dvv: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(F10.6," ",$)') & - (dt*ADp%dv_dt_visc(i,J,k)*Inorm(k)); enddo + (dt*US%L_T2_to_m_s2*ADp%dv_dt_visc(i,J,k)*Inorm(k)); enddo endif if (associated(ADp%dv_other)) then write(file,'(/,"dv_other: ",$)') diff --git a/src/diagnostics/MOM_diagnostics.F90 b/src/diagnostics/MOM_diagnostics.F90 index 9662eb0985..b853ee668b 100644 --- a/src/diagnostics/MOM_diagnostics.F90 +++ b/src/diagnostics/MOM_diagnostics.F90 @@ -1025,10 +1025,10 @@ subroutine calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, GV, US, CS if (associated(CS%KE_visc)) then do k=1,nz do j=js,je ; do I=Isq,Ieq - KE_u(I,j) = US%s_to_T*uh(I,j,k)*US%L_to_m*G%dxCu(I,j)*ADp%du_dt_visc(I,j,k) + KE_u(I,j) = US%L_T_to_m_s**2*US%s_to_T*uh(I,j,k)*G%dxCu(I,j)*ADp%du_dt_visc(I,j,k) enddo ; enddo do J=Jsq,Jeq ; do i=is,ie - KE_v(i,J) = US%s_to_T*vh(i,J,k)*US%L_to_m*G%dyCv(i,J)*ADp%dv_dt_visc(i,J,k) + KE_v(i,J) = US%L_T_to_m_s**2*US%s_to_T*vh(i,J,k)*G%dyCv(i,J)*ADp%dv_dt_visc(i,J,k) enddo ; enddo if (.not.G%symmetric) & call do_group_pass(CS%pass_KE_uv, G%domain) diff --git a/src/parameterizations/vertical/MOM_vert_friction.F90 b/src/parameterizations/vertical/MOM_vert_friction.F90 index 3cdc394675..35f0bcb78d 100644 --- a/src/parameterizations/vertical/MOM_vert_friction.F90 +++ b/src/parameterizations/vertical/MOM_vert_friction.F90 @@ -325,7 +325,7 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, US, CS, & endif ; enddo ; enddo ! i and k loops if (associated(ADp%du_dt_visc)) then ; do k=1,nz ; do I=Isq,Ieq - ADp%du_dt_visc(I,j,k) = US%L_T2_to_m_s2*(u(I,j,k) - ADp%du_dt_visc(I,j,k))*Idt + ADp%du_dt_visc(I,j,k) = (u(I,j,k) - ADp%du_dt_visc(I,j,k))*Idt enddo ; enddo ; endif if (associated(visc%taux_shelf)) then ; do I=Isq,Ieq @@ -406,7 +406,7 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, US, CS, & endif ; enddo ; enddo ! i and k loops if (associated(ADp%dv_dt_visc)) then ; do k=1,nz ; do i=is,ie - ADp%dv_dt_visc(i,J,k) = US%L_T2_to_m_s2*(v(i,J,k) - ADp%dv_dt_visc(i,J,k))*Idt + ADp%dv_dt_visc(i,J,k) = (v(i,J,k) - ADp%dv_dt_visc(i,J,k))*Idt enddo ; enddo ; endif if (associated(visc%tauy_shelf)) then ; do i=is,ie @@ -1785,10 +1785,10 @@ subroutine vertvisc_init(MIS, Time, G, GV, US, param_file, diag, ADp, dirs, & 'Mixed Layer Thickness at Meridional Velocity Points for Viscosity', thickness_units) CS%id_du_dt_visc = register_diag_field('ocean_model', 'du_dt_visc', diag%axesCuL, & - Time, 'Zonal Acceleration from Vertical Viscosity', 'm s-2') + Time, 'Zonal Acceleration from Vertical Viscosity', 'm s-2', conversion=US%L_T2_to_m_s2) if (CS%id_du_dt_visc > 0) call safe_alloc_ptr(ADp%du_dt_visc,IsdB,IedB,jsd,jed,nz) CS%id_dv_dt_visc = register_diag_field('ocean_model', 'dv_dt_visc', diag%axesCvL, & - Time, 'Meridional Acceleration from Vertical Viscosity', 'm s-2') + Time, 'Meridional Acceleration from Vertical Viscosity', 'm s-2', conversion=US%L_T2_to_m_s2) if (CS%id_dv_dt_visc > 0) call safe_alloc_ptr(ADp%dv_dt_visc,isd,ied,JsdB,JedB,nz) CS%id_taux_bot = register_diag_field('ocean_model', 'taux_bot', diag%axesCu1, & From 887e36b3a816bb8480dcfd1af52cb2f2b9e45fa5 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Wed, 14 Aug 2019 09:21:21 -0400 Subject: [PATCH 207/297] +Pass velocities to vertvisc in [L T-1] Passed the velocity arguments to vertvisc in rescaled units of [L T-1]. All answers are bitwise identical, but the rescaled units of several arguments in a public interface have changed. --- src/core/MOM_dynamics_split_RK2.F90 | 28 + src/core/MOM_dynamics_split_RK2.F90.bad1 | 1319 ----------------- src/core/MOM_dynamics_unsplit.F90 | 42 + src/core/MOM_dynamics_unsplit_RK2.F90 | 42 + .../vertical/MOM_vert_friction.F90 | 22 +- 5 files changed, 114 insertions(+), 1339 deletions(-) delete mode 100644 src/core/MOM_dynamics_split_RK2.F90.bad1 diff --git a/src/core/MOM_dynamics_split_RK2.F90 b/src/core/MOM_dynamics_split_RK2.F90 index d8e6ad386b..8e1e996c2b 100644 --- a/src/core/MOM_dynamics_split_RK2.F90 +++ b/src/core/MOM_dynamics_split_RK2.F90 @@ -590,8 +590,22 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & endif call vertvisc_coef(US%m_s_to_L_T*up, US%m_s_to_L_T*vp, h, forces, visc, dt_pred, G, GV, US, CS%vertvisc_CSp, & CS%OBC) + !### This is temporary and will be deleted when the units of the input velocities have changed. + do j=G%jsc,G%jec ; do k=1,nz ; do I=Isq,Ieq + up(I,j,k) = US%m_s_to_L_T*up(I,j,k) + enddo ; enddo ; enddo + do J=Jsq,Jeq ; do k=1,nz ; do i=is,ie + vp(i,J,k) = US%m_s_to_L_T*vp(i,J,k) + enddo ; enddo ; enddo call vertvisc(up, vp, h, forces, visc, dt_pred, CS%OBC, CS%ADp, CS%CDp, G, & GV, US, CS%vertvisc_CSp, CS%taux_bot, CS%tauy_bot, waves=waves) + !### This is temporary and will be deleted when the units of the input velocities have changed. + do j=G%jsc,G%jec ; do k=1,nz ; do I=Isq,Ieq + up(I,j,k) = US%L_T_to_m_s*up(I,j,k) + enddo ; enddo ; enddo + do J=Jsq,Jeq ; do k=1,nz ; do i=is,ie + vp(i,J,k) = US%L_T_to_m_s*vp(i,J,k) + enddo ; enddo ; enddo if (showCallTree) call callTree_wayPoint("done with vertvisc (step_MOM_dyn_split_RK2)") if (G%nonblocking_updates) then call cpu_clock_end(id_clock_vertvisc) @@ -800,8 +814,22 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & ! u_av <- u_av + dt d/dz visc d/dz u_av call cpu_clock_begin(id_clock_vertvisc) call vertvisc_coef(US%m_s_to_L_T*u, US%m_s_to_L_T*v, h, forces, visc, dt, G, GV, US, CS%vertvisc_CSp, CS%OBC) + !### This is temporary and will be deleted when the units of the input velocities have changed. + do j=G%jsc,G%jec ; do k=1,nz ; do I=Isq,Ieq + u(I,j,k) = US%m_s_to_L_T*u(I,j,k) + enddo ; enddo ; enddo + do J=Jsq,Jeq ; do k=1,nz ; do i=is,ie + v(i,J,k) = US%m_s_to_L_T*v(i,J,k) + enddo ; enddo ; enddo call vertvisc(u, v, h, forces, visc, dt, CS%OBC, CS%ADp, CS%CDp, G, GV, US, & CS%vertvisc_CSp, CS%taux_bot, CS%tauy_bot,waves=waves) + !### This is temporary and will be deleted when the units of the input velocities have changed. + do j=G%jsc,G%jec ; do k=1,nz ; do I=Isq,Ieq + u(I,j,k) = US%L_T_to_m_s*u(I,j,k) + enddo ; enddo ; enddo + do J=Jsq,Jeq ; do k=1,nz ; do i=is,ie + v(i,J,k) = US%L_T_to_m_s*v(i,J,k) + enddo ; enddo ; enddo if (G%nonblocking_updates) then call cpu_clock_end(id_clock_vertvisc) call start_group_pass(CS%pass_uv, G%Domain, clock=id_clock_pass) diff --git a/src/core/MOM_dynamics_split_RK2.F90.bad1 b/src/core/MOM_dynamics_split_RK2.F90.bad1 deleted file mode 100644 index 8064680d90..0000000000 --- a/src/core/MOM_dynamics_split_RK2.F90.bad1 +++ /dev/null @@ -1,1319 +0,0 @@ -!> Time step the adiabatic dynamic core of MOM using RK2 method. -module MOM_dynamics_split_RK2 - -! This file is part of MOM6. See LICENSE.md for the license. - -use MOM_variables, only : vertvisc_type, thermo_var_ptrs -use MOM_variables, only : BT_cont_type, alloc_bt_cont_type, dealloc_bt_cont_type -use MOM_variables, only : accel_diag_ptrs, ocean_internal_state, cont_diag_ptrs -use MOM_forcing_type, only : mech_forcing - -use MOM_checksum_packages, only : MOM_thermo_chksum, MOM_state_chksum, MOM_accel_chksum -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_diag_mediator, only : diag_mediator_init, enable_averaging -use MOM_diag_mediator, only : disable_averaging, post_data, safe_alloc_ptr -use MOM_diag_mediator, only : register_diag_field, register_static_field -use MOM_diag_mediator, only : set_diag_mediator_grid, diag_ctrl, diag_update_remap_grids -use MOM_domains, only : MOM_domains_init -use MOM_domains, only : To_South, To_West, To_All, CGRID_NE, SCALAR_PAIR -use MOM_domains, only : To_North, To_East, Omit_Corners -use MOM_domains, only : create_group_pass, do_group_pass, group_pass_type -use MOM_domains, only : start_group_pass, complete_group_pass, pass_var -use MOM_debugging, only : hchksum, uvchksum -use MOM_error_handler, only : MOM_error, MOM_mesg, FATAL, WARNING, is_root_pe -use MOM_error_handler, only : MOM_set_verbosity, 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_get_input, only : directories -use MOM_io, only : MOM_io_init, vardesc, var_desc -use MOM_restart, only : register_restart_field, query_initialized, save_restart -use MOM_restart, only : restart_init, is_new_run, MOM_restart_CS -use MOM_time_manager, only : time_type, time_type_to_real, operator(+) -use MOM_time_manager, only : operator(-), operator(>), operator(*), operator(/) - -use MOM_ALE, only : ALE_CS -use MOM_barotropic, only : barotropic_init, btstep, btcalc, bt_mass_source -use MOM_barotropic, only : register_barotropic_restarts, set_dtbt, barotropic_CS -use MOM_boundary_update, only : update_OBC_data, update_OBC_CS -use MOM_continuity, only : continuity, continuity_init, continuity_CS -use MOM_continuity, only : continuity_stencil -use MOM_CoriolisAdv, only : CorAdCalc, CoriolisAdv_init, CoriolisAdv_CS -use MOM_debugging, only : check_redundant -use MOM_grid, only : ocean_grid_type -use MOM_hor_index, only : hor_index_type -use MOM_hor_visc, only : horizontal_viscosity, hor_visc_init, hor_visc_CS -use MOM_interface_heights, only : find_eta -use MOM_lateral_mixing_coeffs, only : VarMix_CS -use MOM_MEKE_types, only : MEKE_type -use MOM_open_boundary, only : ocean_OBC_type, radiation_open_bdry_conds -use MOM_open_boundary, only : open_boundary_zero_normal_flow -use MOM_open_boundary, only : open_boundary_test_extern_h -use MOM_PressureForce, only : PressureForce, PressureForce_init, PressureForce_CS -use MOM_set_visc, only : set_viscous_ML, set_visc_CS -use MOM_thickness_diffuse, only : thickness_diffuse_CS -use MOM_tidal_forcing, only : tidal_forcing_init, tidal_forcing_CS -use MOM_unit_scaling, only : unit_scale_type -use MOM_vert_friction, only : vertvisc, vertvisc_coef, vertvisc_remnant -use MOM_vert_friction, only : vertvisc_limit_vel, vertvisc_init, vertvisc_CS -use MOM_vert_friction, only : updateCFLtruncationValue -use MOM_verticalGrid, only : verticalGrid_type, get_thickness_units -use MOM_verticalGrid, only : get_flux_units, get_tr_flux_units -use MOM_wave_interface, only: wave_parameters_CS - -implicit none ; private - -#include - -!> MOM_dynamics_split_RK2 module control structure -type, public :: MOM_dyn_split_RK2_CS ; private - real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_,NKMEM_) :: & - CAu, & !< CAu = f*v - u.grad(u) [L T-2 ~> m s-2] - PFu, & !< PFu = -dM/dx [L T-2 ~> m s-2] - diffu !< Zonal acceleration due to convergence of the along-isopycnal stress tensor [L T-2 ~> m s-2] - - real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_,NKMEM_) :: & - CAv, & !< CAv = -f*u - u.grad(v) [L T-2 ~> m s-2] - PFv, & !< PFv = -dM/dy [L T-2 ~> m s-2] - diffv !< Meridional acceleration due to convergence of the along-isopycnal stress tensor [L T-2 ~> m s-2] - - real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_,NKMEM_) :: visc_rem_u - !< Both the fraction of the zonal momentum originally in a - !! layer that remains after a time-step of viscosity, and the - !! fraction of a time-step worth of a barotropic acceleration - !! that a layer experiences after viscosity is applied. - !! Nondimensional between 0 (at the bottom) and 1 (far above). - real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_,NKMEM_) :: u_accel_bt - !< The zonal layer accelerations due to the difference between - !! the barotropic accelerations and the baroclinic accelerations - !! that were fed into the barotopic calculation [m s-2] - real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_,NKMEM_) :: visc_rem_v - !< Both the fraction of the meridional momentum originally in - !! a layer that remains after a time-step of viscosity, and the - !! fraction of a time-step worth of a barotropic acceleration - !! that a layer experiences after viscosity is applied. - !! Nondimensional between 0 (at the bottom) and 1 (far above). - real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_,NKMEM_) :: v_accel_bt - !< The meridional layer accelerations due to the difference between - !! the barotropic accelerations and the baroclinic accelerations - !! that were fed into the barotopic calculation [m s-2] - - ! The following variables are only used with the split time stepping scheme. - real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: eta !< Instantaneous free surface height (in Boussinesq - !! mode) or column mass anomaly (in non-Boussinesq - !! mode) [H ~> m or kg m-2] - real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_,NKMEM_) :: u_av !< layer x-velocity with vertical mean replaced by - !! time-mean barotropic velocity over a baroclinic - !! timestep [L T-1 ~> m s-1] - real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_,NKMEM_) :: v_av !< layer y-velocity with vertical mean replaced by - !! time-mean barotropic velocity over a baroclinic - !! timestep [L T-1 ~> m s-1] - real ALLOCABLE_, dimension(NIMEM_,NJMEM_,NKMEM_) :: h_av !< arithmetic mean of two successive layer - !! thicknesses [H ~> m or kg m-2] - real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: eta_PF !< instantaneous SSH used in calculating PFu and - !! PFv [H ~> m or kg m-2] - real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_) :: uhbt !< average x-volume or mass flux determined by the - !! barotropic solver [H L2 T-1 ~> m3 s-1 or kg s-1]. - !! uhbt is roughly equal to the vertical sum of uh. - real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_) :: vhbt !< average y-volume or mass flux determined by the - !! barotropic solver [H L2 T-1 ~> m3 s-1 or kg s-1]. - !! 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 [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] - type(BT_cont_type), pointer :: BT_cont => NULL() !< A structure with elements that describe the - !! effective summed open face areas as a function - !! of barotropic flow. - - ! This is to allow the previous, velocity-based coupling with between the - ! baroclinic and barotropic modes. - logical :: BT_use_layer_fluxes !< If true, use the summed layered fluxes plus - !! an adjustment due to a changed barotropic - !! velocity in the barotropic continuity equation. - logical :: split_bottom_stress !< If true, provide the bottom stress - !! calculated by the vertical viscosity to the - !! barotropic solver. - logical :: calc_dtbt !< If true, calculate the barotropic time-step - !! dynamically. - - real :: be !< A nondimensional number from 0.5 to 1 that controls - !! the backward weighting of the time stepping scheme. - real :: begw !< A nondimensional number from 0 to 1 that controls - !! the extent to which the treatment of gravity waves - !! is forward-backward (0) or simulated backward - !! Euler (1). 0 is almost always used. - logical :: debug !< If true, write verbose checksums for debugging purposes. - logical :: debug_OBC !< If true, do debugging calls for open boundary conditions. - - logical :: module_is_initialized = .false. !< Record whether this mouled has been initialzed. - - !>@{ Diagnostic IDs - integer :: id_uh = -1, id_vh = -1 - integer :: id_umo = -1, id_vmo = -1 - integer :: id_umo_2d = -1, id_vmo_2d = -1 - integer :: id_PFu = -1, id_PFv = -1 - integer :: id_CAu = -1, id_CAv = -1 - - ! Split scheme only. - integer :: id_uav = -1, id_vav = -1 - integer :: id_u_BT_accel = -1, id_v_BT_accel = -1 - !!@} - - type(diag_ctrl), pointer :: diag !< A structure that is used to regulate the - !! timing of diagnostic output. - type(accel_diag_ptrs), pointer :: ADp !< A structure pointing to the various - !! accelerations in the momentum equations, - !! which can later be used to calculate - !! derived diagnostics like energy budgets. - type(cont_diag_ptrs), pointer :: CDp !< A structure with pointers to various - !! terms in the continuity equations, - !! which can later be used to calculate - !! derived diagnostics like energy budgets. - - ! The remainder of the structure points to child subroutines' control structures. - !> A pointer to the horizontal viscosity control structure - type(hor_visc_CS), pointer :: hor_visc_CSp => NULL() - !> A pointer to the continuity control structure - type(continuity_CS), pointer :: continuity_CSp => NULL() - !> A pointer to the CoriolisAdv control structure - type(CoriolisAdv_CS), pointer :: CoriolisAdv_CSp => NULL() - !> A pointer to the PressureForce control structure - type(PressureForce_CS), pointer :: PressureForce_CSp => NULL() - !> A pointer to the barotropic stepping control structure - type(barotropic_CS), pointer :: barotropic_CSp => NULL() - !> A pointer to a structure containing interface height diffusivities - type(thickness_diffuse_CS), pointer :: thickness_diffuse_CSp => NULL() - !> A pointer to the vertical viscosity control structure - type(vertvisc_CS), pointer :: vertvisc_CSp => NULL() - !> A pointer to the set_visc control structure - type(set_visc_CS), pointer :: set_visc_CSp => NULL() - !> A pointer to the tidal forcing control structure - type(tidal_forcing_CS), pointer :: tides_CSp => NULL() - !> A pointer to the ALE control structure. - type(ALE_CS), pointer :: ALE_CSp => NULL() - - type(ocean_OBC_type), pointer :: OBC => NULL() !< A pointer to an open boundary - !! condition type that specifies whether, where, and what open boundary - !! conditions are used. If no open BCs are used, this pointer stays - !! nullified. Flather OBCs use open boundary_CS as well. - !> A pointer to the update_OBC control structure - type(update_OBC_CS), pointer :: update_OBC_CSp => NULL() - - type(group_pass_type) :: pass_eta !< Structure for group halo pass - type(group_pass_type) :: pass_visc_rem !< Structure for group halo pass - type(group_pass_type) :: pass_uvp !< Structure for group halo pass - type(group_pass_type) :: pass_hp_uv !< Structure for group halo pass - type(group_pass_type) :: pass_uv !< Structure for group halo pass - type(group_pass_type) :: pass_h !< Structure for group halo pass - type(group_pass_type) :: pass_av_uvh !< Structure for group halo pass - -end type MOM_dyn_split_RK2_CS - - -public step_MOM_dyn_split_RK2 -public register_restarts_dyn_split_RK2 -public initialize_dyn_split_RK2 -public end_dyn_split_RK2 - -!>@{ CPU time clock IDs -integer :: id_clock_Cor, id_clock_pres, id_clock_vertvisc -integer :: id_clock_horvisc, id_clock_mom_update -integer :: id_clock_continuity, id_clock_thick_diff -integer :: id_clock_btstep, id_clock_btcalc, id_clock_btforce -integer :: id_clock_pass, id_clock_pass_init -!!@} - -contains - -!> RK2 splitting for time stepping MOM adiabatic dynamics -subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & - Time_local, dt, forces, p_surf_begin, p_surf_end, & - uh, vh, uhtr, vhtr, eta_av, & - G, GV, US, CS, calc_dtbt, VarMix, MEKE, thickness_diffuse_CSp, 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)), & - target, intent(inout) :: u !< zonal velocity [m s-1] - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - target, intent(inout) :: v !< merid velocity [m s-1] - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(inout) :: h !< layer thickness [H ~> m or kg m-2] - type(thermo_var_ptrs), intent(in) :: tv !< thermodynamic type - type(vertvisc_type), intent(inout) :: visc !< vertical visc, bottom drag, and related - type(time_type), intent(in) :: Time_local !< model time at end of time step - real, intent(in) :: dt !< time step [s] - type(mech_forcing), intent(in) :: forces !< A structure with the driving mechanical forces - real, dimension(:,:), pointer :: p_surf_begin !< surf pressure at start of this dynamic - !! time step [Pa] - real, dimension(:,:), pointer :: p_surf_end !< surf pressure at end of this dynamic - !! time step [Pa] - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & - target, intent(inout) :: uh !< zonal volume/mass transport - !! [H L2 T-1 ~> m3 s-1 or kg s-1] - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - target, intent(inout) :: vh !< merid volume/mass transport - !! [H L2 T-1 ~> m3 s-1 or kg s-1] - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & - intent(inout) :: uhtr !< accumulatated zonal volume/mass transport - !! since last tracer advection [H L2 ~> m3 or kg] - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - intent(inout) :: vhtr !< accumulatated merid volume/mass transport - !! since last tracer advection [H L2 ~> m3 or kg] - real, dimension(SZI_(G),SZJ_(G)), intent(out) :: eta_av !< free surface height or column mass time - !! averaged over time step [H ~> m or kg m-2] - type(MOM_dyn_split_RK2_CS), pointer :: CS !< module control structure - logical, intent(in) :: calc_dtbt !< if true, recalculate barotropic time step - type(VarMix_CS), pointer :: VarMix !< specify the spatially varying viscosities - type(MEKE_type), pointer :: MEKE !< related to mesoscale eddy kinetic energy param - type(thickness_diffuse_CS), pointer :: thickness_diffuse_CSp!< Pointer to a structure containing - !! interface height diffusivities - type(wave_parameters_CS), optional, pointer :: Waves !< A pointer to a structure containing - !! fields related to the surface wave conditions - - ! local variables - real :: dt_pred ! The time step for the predictor part of the baroclinic time stepping. - - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)) :: up ! Predicted zonal velocity [m s-1]. - real, dimension(SZI_(G),SZJB_(G),SZK_(G)) :: vp ! Predicted meridional velocity [m s-1]. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: hp ! Predicted thickness [H ~> m or kg m-2]. - - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)) :: u_bc_accel - real, dimension(SZI_(G),SZJB_(G),SZK_(G)) :: v_bc_accel - ! u_bc_accel and v_bc_accel are the summed baroclinic accelerations of each - ! layer calculated by the non-barotropic part of the model [L T-2 ~> m s-2]. - - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), target :: uh_in - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), target :: vh_in - ! uh_in and vh_in are the zonal or meridional mass transports that would be - ! obtained using the initial velocities [H L2 T-1 ~> m3 s-1 or kg s-1]. - - real, dimension(SZIB_(G),SZJ_(G)) :: uhbt_out - real, dimension(SZI_(G),SZJB_(G)) :: vhbt_out - ! uhbt_out and vhbt_out are the vertically summed transports from the - ! barotropic solver based on its final velocities [H m2 s-1 ~> m3 s-1 or kg s-1]. - - real, dimension(SZI_(G),SZJ_(G)) :: eta_pred - ! eta_pred is the predictor value of the free surface height or column mass, - ! [H ~> m or kg m-2]. - - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), target :: u_adj - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), target :: v_adj - ! u_adj and v_adj are the zonal or meridional velocities after u and v - ! have been barotropically adjusted so the resulting transports match - ! uhbt_out and vhbt_out [m s-1]. - - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)) :: u_old_rad_OBC - real, dimension(SZI_(G),SZJB_(G),SZK_(G)) :: v_old_rad_OBC - ! u_old_rad_OBC and v_old_rad_OBC are the starting velocities, which are - ! saved for use in the Flather open boundary condition code [m s-1]. - - real :: Pa_to_eta ! A factor that converts pressures to the units of eta. - real, pointer, dimension(:,:) :: & - p_surf => NULL(), eta_PF_start => NULL(), & - taux_bot => NULL(), tauy_bot => NULL(), & - eta => NULL() - - real, pointer, dimension(:,:,:) :: & - uh_ptr => NULL(), u_ptr => NULL(), vh_ptr => NULL(), v_ptr => NULL(), & - u_init => NULL(), v_init => NULL(), & ! Pointers to u and v or u_adj and v_adj. - u_av, & ! The zonal velocity time-averaged over a time step [L T-1 ~> m s-1]. - v_av, & ! The meridional velocity time-averaged over a time step [L T-1 ~> m s-1]. - h_av ! The layer thickness time-averaged over a time step [H ~> m or kg m-2]. - real :: Idt - logical :: dyn_p_surf - logical :: BT_cont_BT_thick ! If true, use the BT_cont_type to estimate the - ! relative weightings of the layers in calculating - ! the barotropic accelerations. - !---For group halo pass - logical :: showCallTree, sym - - integer :: i, j, k, is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz - integer :: cont_stencil - 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 - u_av => CS%u_av ; v_av => CS%v_av ; h_av => CS%h_av ; eta => CS%eta - Idt = 1.0 / dt - - sym=.false.;if (G%Domain%symmetric) sym=.true. ! switch to include symmetric domain in checksums - - showCallTree = callTree_showQuery() - if (showCallTree) call callTree_enter("step_MOM_dyn_split_RK2(), MOM_dynamics_split_RK2.F90") - - !$OMP parallel do default(shared) - do k = 1, nz - do j=G%jsd,G%jed ; do i=G%isdB,G%iedB ; up(i,j,k) = 0.0 ; enddo ; enddo - do j=G%jsdB,G%jedB ; do i=G%isd,G%ied ; vp(i,j,k) = 0.0 ; enddo ; enddo - do j=G%jsd,G%jed ; do i=G%isd,G%ied ; hp(i,j,k) = h(i,j,k) ; enddo ; enddo - enddo - - ! Update CFL truncation value as function of time - call updateCFLtruncationValue(Time_local, CS%vertvisc_CSp) - - if (CS%debug) then - call MOM_state_chksum("Start predictor ", u, v, h, uh, vh, G, GV, US, symmetric=sym, vel_scale=1.0) - call check_redundant("Start predictor u ", u, v, G) - call check_redundant("Start predictor uh ", uh, vh, G) - endif - - dyn_p_surf = associated(p_surf_begin) .and. associated(p_surf_end) - if (dyn_p_surf) then - p_surf => p_surf_end - call safe_alloc_ptr(eta_PF_start,G%isd,G%ied,G%jsd,G%jed) - eta_PF_start(:,:) = 0.0 - else - p_surf => forces%p_surf - endif - - if (associated(CS%OBC)) then - if (CS%debug_OBC) call open_boundary_test_extern_h(G, CS%OBC, h) - - do k=1,nz ; do j=G%jsd,G%jed ; do I=G%IsdB,G%IedB - u_old_rad_OBC(I,j,k) = US%L_T_to_m_s*u_av(I,j,k) - enddo ; enddo ; enddo - do k=1,nz ; do J=G%JsdB,G%JedB ; do i=G%isd,G%ied - v_old_rad_OBC(i,J,k) = US%L_T_to_m_s*v_av(i,J,k) - enddo ; enddo ; enddo - endif - - BT_cont_BT_thick = .false. - if (associated(CS%BT_cont)) BT_cont_BT_thick = & - (allocated(CS%BT_cont%h_u) .and. allocated(CS%BT_cont%h_v)) - - if (CS%split_bottom_stress) then - taux_bot => CS%taux_bot ; tauy_bot => CS%tauy_bot - endif - - !--- begin set up for group halo pass - - cont_stencil = continuity_stencil(CS%continuity_CSp) - !### Apart from circle_OBCs halo for eta could be 1, but halo>=3 is required - !### to match circle_OBCs solutions. Why? - call cpu_clock_begin(id_clock_pass) - call create_group_pass(CS%pass_eta, eta, G%Domain) !### , halo=1) - call create_group_pass(CS%pass_visc_rem, CS%visc_rem_u, CS%visc_rem_v, G%Domain, & - To_All+SCALAR_PAIR, CGRID_NE, halo=max(1,cont_stencil)) - call create_group_pass(CS%pass_uvp, up, vp, G%Domain, halo=max(1,cont_stencil)) - call create_group_pass(CS%pass_hp_uv, hp, G%Domain, halo=2) - call create_group_pass(CS%pass_hp_uv, u_av, v_av, G%Domain, halo=2) - call create_group_pass(CS%pass_hp_uv, uh(:,:,:), vh(:,:,:), G%Domain, halo=2) - - call create_group_pass(CS%pass_uv, u, v, G%Domain, halo=max(2,cont_stencil)) - call create_group_pass(CS%pass_h, h, G%Domain, halo=max(2,cont_stencil)) - call create_group_pass(CS%pass_av_uvh, u_av, v_av, G%Domain, halo=2) - call create_group_pass(CS%pass_av_uvh, uh(:,:,:), vh(:,:,:), G%Domain, halo=2) - call cpu_clock_end(id_clock_pass) - !--- end set up for group halo pass - - -! PFu = d/dx M(h,T,S) -! pbce = dM/deta - if (CS%begw == 0.0) call enable_averaging(dt, Time_local, CS%diag) - call cpu_clock_begin(id_clock_pres) - call PressureForce(h, tv, CS%PFu, CS%PFv, G, GV, US, CS%PressureForce_CSp, & - CS%ALE_CSp, p_surf, CS%pbce, CS%eta_PF) - if (dyn_p_surf) then - Pa_to_eta = 1.0 / GV%H_to_Pa - !$OMP parallel do default(shared) - do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - eta_PF_start(i,j) = CS%eta_PF(i,j) - Pa_to_eta * & - (p_surf_begin(i,j) - p_surf_end(i,j)) - enddo ; enddo - endif - call cpu_clock_end(id_clock_pres) - call disable_averaging(CS%diag) - if (showCallTree) call callTree_wayPoint("done with PressureForce (step_MOM_dyn_split_RK2)") - - if (associated(CS%OBC)) then; if (CS%OBC%update_OBC) then - call update_OBC_data(CS%OBC, G, GV, US, tv, h, CS%update_OBC_CSp, Time_local) - endif; endif - if (associated(CS%OBC) .and. CS%debug_OBC) & - call open_boundary_zero_normal_flow(CS%OBC, G, CS%PFu, CS%PFv) - - if (G%nonblocking_updates) & - call start_group_pass(CS%pass_eta, G%Domain, clock=id_clock_pass) - -! CAu = -(f+zeta_av)/h_av vh + d/dx KE_av - call cpu_clock_begin(id_clock_Cor) - call CorAdCalc(US%L_T_to_m_s*u_av, US%L_T_to_m_s*v_av, h_av, uh, vh, CS%CAu, CS%CAv, CS%OBC, CS%ADp, & - G, Gv, US, CS%CoriolisAdv_CSp) - call cpu_clock_end(id_clock_Cor) - if (showCallTree) call callTree_wayPoint("done with CorAdCalc (step_MOM_dyn_split_RK2)") - -! u_bc_accel = CAu + PFu + diffu(u[n-1]) - call cpu_clock_begin(id_clock_btforce) - !$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) - 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) - enddo ; enddo - enddo - if (associated(CS%OBC)) then - call open_boundary_zero_normal_flow(CS%OBC, G, u_bc_accel, v_bc_accel) - endif - call cpu_clock_end(id_clock_btforce) - - 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, 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) - call check_redundant("pre-btstep CS%diff ", CS%diffu, CS%diffv, G) - call check_redundant("pre-btstep u_bc_accel ", u_bc_accel, v_bc_accel, G) - endif - - call cpu_clock_begin(id_clock_vertvisc) - !$OMP parallel do default(shared) - do k=1,nz - do j=js,je ; do I=Isq,Ieq - up(I,j,k) = G%mask2dCu(I,j) * (u(I,j,k) + dt * US%L_T_to_m_s*US%s_to_T*u_bc_accel(I,j,k)) - enddo ; enddo - do J=Jsq,Jeq ; do i=is,ie - vp(i,J,k) = G%mask2dCv(i,J) * (v(i,J,k) + dt * US%L_T_to_m_s*US%s_to_T*v_bc_accel(i,J,k)) - enddo ; enddo - enddo - - call enable_averaging(dt, Time_local, CS%diag) - call set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, & - CS%set_visc_CSp) - call disable_averaging(CS%diag) - - if (CS%debug) then - 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, 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)") - - - call cpu_clock_begin(id_clock_pass) - if (G%nonblocking_updates) then - call complete_group_pass(CS%pass_eta, G%Domain) - call start_group_pass(CS%pass_visc_rem, G%Domain) - else - call do_group_pass(CS%pass_eta, G%Domain) - call do_group_pass(CS%pass_visc_rem, G%Domain) - endif - call cpu_clock_end(id_clock_pass) - - call cpu_clock_begin(id_clock_btcalc) - ! Calculate the relative layer weights for determining barotropic quantities. - if (.not.BT_cont_BT_thick) & - call btcalc(h, G, GV, CS%barotropic_CSp, OBC=CS%OBC) - call bt_mass_source(h, eta, .true., G, GV, CS%barotropic_CSp) - call cpu_clock_end(id_clock_btcalc) - - if (G%nonblocking_updates) & - call complete_group_pass(CS%pass_visc_rem, G%Domain, clock=id_clock_pass) - -! 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, 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) - if (BT_cont_BT_thick) then - call btcalc(h, G, GV, CS%barotropic_CSp, CS%BT_cont%h_u, CS%BT_cont%h_v, & - OBC=CS%OBC) - endif - if (showCallTree) call callTree_wayPoint("done with continuity[BT_cont] (step_MOM_dyn_split_RK2)") - endif - - if (CS%BT_use_layer_fluxes) then - uh_ptr => uh_in; vh_ptr => vh_in; u_ptr => u; v_ptr => v - endif - - u_init => u ; v_init => v - call cpu_clock_begin(id_clock_btstep) - if (calc_dtbt) call set_dtbt(G, GV, US, CS%barotropic_CSp, eta, CS%pbce) - if (showCallTree) call callTree_enter("btstep(), MOM_barotropic.F90") - ! This is the predictor step call to btstep. - call btstep(u, v, eta, dt, u_bc_accel, v_bc_accel, forces, CS%pbce, CS%eta_PF, & - US%L_T_to_m_s*u_av, US%L_T_to_m_s*v_av, CS%u_accel_bt, CS%v_accel_bt, eta_pred, CS%uhbt, CS%vhbt, & - G, GV, US, CS%barotropic_CSp, CS%visc_rem_u, CS%visc_rem_v, & - OBC=CS%OBC, BT_cont=CS%BT_cont, eta_PF_start=eta_PF_start, & - taux_bot=taux_bot, tauy_bot=tauy_bot, & - uh0=uh_ptr, vh0=vh_ptr, u_uh0=u_ptr, v_vh0=v_ptr) - if (showCallTree) call callTree_leave("btstep()") - call cpu_clock_end(id_clock_btstep) - -! up = u + dt_pred*( u_bc_accel + u_accel_bt ) - dt_pred = dt * CS%be - call cpu_clock_begin(id_clock_mom_update) - - !$OMP parallel do default(shared) - do k=1,nz - do J=Jsq,Jeq ; do i=is,ie - vp(i,J,k) = G%mask2dCv(i,J) * (v_init(i,J,k) + US%s_to_T*dt_pred * US%L_T_to_m_s* & - (v_bc_accel(i,J,k) + CS%v_accel_bt(i,J,k))) - enddo ; enddo - do j=js,je ; do I=Isq,Ieq - up(I,j,k) = G%mask2dCu(I,j) * (u_init(I,j,k) + US%s_to_T*dt_pred * US%L_T_to_m_s* & - (u_bc_accel(I,j,k) + CS%u_accel_bt(I,j,k))) - enddo ; enddo - enddo - call cpu_clock_end(id_clock_mom_update) - - if (CS%debug) then - call uvchksum("Predictor 1 [uv]", up, vp, G%HI, haloshift=0, symmetric=sym) - call hchksum(h, "Predictor 1 h", G%HI, haloshift=1, scale=GV%H_to_m) - call uvchksum("Predictor 1 [uv]h", uh, vh, G%HI,haloshift=2, & - symmetric=sym, scale=GV%H_to_m*US%L_to_m**2*US%s_to_T) -! call MOM_state_chksum("Predictor 1", up, vp, h, uh, vh, G, GV, US, haloshift=1, vel_scale=1.0) - call MOM_accel_chksum("Predictor accel", CS%CAu, CS%CAv, CS%PFu, CS%PFv, & - 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, US, haloshift=2, & - symmetric=sym, vel_scale=1.0) - call check_redundant("Predictor 1 up", up, vp, G) - call check_redundant("Predictor 1 uh", uh, vh, G) - endif - -! up <- up + dt_pred d/dz visc d/dz up -! u_av <- u_av + dt_pred d/dz visc d/dz u_av - call cpu_clock_begin(id_clock_vertvisc) - if (CS%debug) then - call uvchksum("0 before vertvisc: [uv]p", up, vp, G%HI,haloshift=0, symmetric=sym) - endif - call vertvisc_coef(up, vp, h, forces, visc, dt_pred, G, GV, US, CS%vertvisc_CSp, & - CS%OBC) - call vertvisc(up, vp, h, forces, visc, dt_pred, CS%OBC, CS%ADp, CS%CDp, G, & - GV, US, CS%vertvisc_CSp, CS%taux_bot, CS%tauy_bot, waves=waves) - if (showCallTree) call callTree_wayPoint("done with vertvisc (step_MOM_dyn_split_RK2)") - if (G%nonblocking_updates) then - call cpu_clock_end(id_clock_vertvisc) - 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, 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) - if (G%nonblocking_updates) then - call complete_group_pass(CS%pass_uvp, G%Domain, clock=id_clock_pass) - else - call do_group_pass(CS%pass_uvp, G%Domain, clock=id_clock_pass) - endif - - ! 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, 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) - if (showCallTree) call callTree_wayPoint("done with continuity (step_MOM_dyn_split_RK2)") - - call do_group_pass(CS%pass_hp_uv, G%Domain, clock=id_clock_pass) - - if (associated(CS%OBC)) then - - if (CS%debug) & - call uvchksum("Pre OBC avg [uv]", u_av, v_av, G%HI, haloshift=1, symmetric=sym, scale=US%L_T_to_m_s) - - !### Remove this later - u_av(:,:,:) = US%L_T_to_m_s*u_av(:,:,:) - v_av(:,:,:) = US%L_T_to_m_s*v_av(:,:,:) - call radiation_open_bdry_conds(CS%OBC, u_av, u_old_rad_OBC, v_av, v_old_rad_OBC, G, US, dt_pred) - !### Remove this later - u_av(:,:,:) = US%m_s_to_L_T*u_av(:,:,:) - v_av(:,:,:) = US%m_s_to_L_T*v_av(:,:,:) - - if (CS%debug) & - call uvchksum("Post OBC avg [uv]", u_av, v_av, G%HI, haloshift=1, symmetric=sym, scale=US%L_T_to_m_s) - - ! These should be done with a pass that excludes uh & vh. -! call do_group_pass(CS%pass_hp_uv, G%Domain, clock=id_clock_pass) - endif - - if (G%nonblocking_updates) then - call start_group_pass(CS%pass_av_uvh, G%Domain, clock=id_clock_pass) - endif - - ! h_av = (h + hp)/2 - !$OMP parallel do default(shared) - do k=1,nz ; do j=js-2,je+2 ; do i=is-2,ie+2 - h_av(i,j,k) = 0.5*(h(i,j,k) + hp(i,j,k)) - enddo ; enddo ; enddo - - ! The correction phase of the time step starts here. - call enable_averaging(dt, Time_local, CS%diag) - - ! Calculate a revised estimate of the free-surface height correction to be - ! used in the next call to btstep. This call is at this point so that - ! hp can be changed if CS%begw /= 0. - ! eta_cor = ... (hidden inside CS%barotropic_CSp) - call cpu_clock_begin(id_clock_btcalc) - call bt_mass_source(hp, eta_pred, .false., G, GV, CS%barotropic_CSp) - call cpu_clock_end(id_clock_btcalc) - - if (CS%begw /= 0.0) then - ! hp <- (1-begw)*h_in + begw*hp - ! Back up hp to the value it would have had after a time-step of - ! begw*dt. hp is not used again until recalculated by continuity. - !$OMP parallel do default(shared) - do k=1,nz ; do j=js-1,je+1 ; do i=is-1,ie+1 - hp(i,j,k) = (1.0-CS%begw)*h(i,j,k) + CS%begw*hp(i,j,k) - enddo ; enddo ; enddo - - ! PFu = d/dx M(hp,T,S) - ! pbce = dM/deta - call cpu_clock_begin(id_clock_pres) - call PressureForce(hp, tv, CS%PFu, CS%PFv, G, GV, US, CS%PressureForce_CSp, & - CS%ALE_CSp, p_surf, CS%pbce, CS%eta_PF) - call cpu_clock_end(id_clock_pres) - if (showCallTree) call callTree_wayPoint("done with PressureForce[hp=(1-b).h+b.h] (step_MOM_dyn_split_RK2)") - endif - - if (G%nonblocking_updates) & - call complete_group_pass(CS%pass_av_uvh, G%Domain, clock=id_clock_pass) - - if (BT_cont_BT_thick) then - call btcalc(h, G, GV, CS%barotropic_CSp, CS%BT_cont%h_u, CS%BT_cont%h_v, & - OBC=CS%OBC) - if (showCallTree) call callTree_wayPoint("done with btcalc[BT_cont_BT_thick] (step_MOM_dyn_split_RK2)") - endif - - if (CS%debug) then - call MOM_state_chksum("Predictor ", up, vp, hp, uh, vh, G, GV, US, symmetric=sym, vel_scale=1.0) - call uvchksum("Predictor avg [uv]", u_av, v_av, G%HI, haloshift=1, symmetric=sym, scale=US%L_T_to_m_s) - call hchksum(h_av, "Predictor avg h", G%HI, haloshift=0, scale=GV%H_to_m) - ! call MOM_state_chksum("Predictor avg ", u_av, v_av, h_av, uh, vh, G, GV, US,) - call check_redundant("Predictor up ", up, vp, G) - call check_redundant("Predictor uh ", uh, vh, G) - endif - -! diffu = horizontal viscosity terms (u_av) - call cpu_clock_begin(id_clock_horvisc) - call horizontal_viscosity(US%m_s_to_L_T*u_av, US%m_s_to_L_T*v_av, h_av, CS%diffu, CS%diffv, & - MEKE, Varmix, G, GV, US, CS%hor_visc_CSp, & - OBC=CS%OBC, BT=CS%barotropic_CSp) - call cpu_clock_end(id_clock_horvisc) - if (showCallTree) call callTree_wayPoint("done with horizontal_viscosity (step_MOM_dyn_split_RK2)") - -! CAu = -(f+zeta_av)/h_av vh + d/dx KE_av - call cpu_clock_begin(id_clock_Cor) - call CorAdCalc(US%m_s_to_L_T*u_av, US%m_s_to_L_T*v_av, h_av, uh, vh, CS%CAu, CS%CAv, CS%OBC, CS%ADp, & - G, GV, US, CS%CoriolisAdv_CSp) - call cpu_clock_end(id_clock_Cor) - if (showCallTree) call callTree_wayPoint("done with CorAdCalc (step_MOM_dyn_split_RK2)") - -! Calculate the momentum forcing terms for the barotropic equations. - -! u_bc_accel = CAu + PFu + diffu(u[n-1]) - call cpu_clock_begin(id_clock_btforce) - !$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) - 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) - enddo ; enddo - enddo - if (associated(CS%OBC)) then - call open_boundary_zero_normal_flow(CS%OBC, G, u_bc_accel, v_bc_accel) - endif - call cpu_clock_end(id_clock_btforce) - - 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, 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) - call check_redundant("corr pre-btstep CS%diff ", CS%diffu, CS%diffv, G) - call check_redundant("corr pre-btstep u_bc_accel ", u_bc_accel, v_bc_accel, G) - endif - - ! u_accel_bt = layer accelerations due to barotropic solver - ! pbce = dM/deta - call cpu_clock_begin(id_clock_btstep) - if (CS%BT_use_layer_fluxes) then - !### Remove this later - u_av(:,:,:) = US%L_T_to_m_s*u_av(:,:,:) ; v_av(:,:,:) = US%L_T_to_m_s*v_av(:,:,:) - uh_ptr => uh ; vh_ptr => vh ; u_ptr => u_av ; v_ptr => v_av - endif - - if (showCallTree) call callTree_enter("btstep(), MOM_barotropic.F90") - ! This is the corrector step call to btstep. - call btstep(u, v, eta, dt, u_bc_accel, v_bc_accel, forces, CS%pbce, & - CS%eta_PF, u_av, v_av, CS%u_accel_bt, CS%v_accel_bt, & - eta_pred, CS%uhbt, CS%vhbt, G, GV, US, CS%barotropic_CSp, & - CS%visc_rem_u, CS%visc_rem_v, etaav=eta_av, OBC=CS%OBC, & - BT_cont = CS%BT_cont, eta_PF_start=eta_PF_start, & - taux_bot=taux_bot, tauy_bot=tauy_bot, & - uh0=uh_ptr, vh0=vh_ptr, u_uh0=u_ptr, v_vh0=v_ptr) - do j=js,je ; do i=is,ie ; eta(i,j) = eta_pred(i,j) ; enddo ; enddo - call cpu_clock_end(id_clock_btstep) - if (showCallTree) call callTree_leave("btstep()") - - if (CS%BT_use_layer_fluxes) then - !### Remove this later - u_av(:,:,:) = US%m_s_to_L_T*u_av(:,:,:) ; v_av(:,:,:) = US%m_s_to_L_T*v_av(:,:,:) - endif - - if (CS%debug) then - call check_redundant("u_accel_bt ", CS%u_accel_bt, CS%v_accel_bt, G) - endif - - ! u = u + dt*( u_bc_accel + u_accel_bt ) - call cpu_clock_begin(id_clock_mom_update) - !$OMP parallel do default(shared) - do k=1,nz - do j=js,je ; do I=Isq,Ieq - u(I,j,k) = G%mask2dCu(I,j) * (u_init(I,j,k) + US%s_to_T*dt * US%L_T_to_m_s* & - (u_bc_accel(I,j,k) + CS%u_accel_bt(I,j,k))) - enddo ; enddo - do J=Jsq,Jeq ; do i=is,ie - v(i,J,k) = G%mask2dCv(i,J) * (v_init(i,J,k) + US%s_to_T*dt * US%L_T_to_m_s* & - (v_bc_accel(i,J,k) + CS%v_accel_bt(i,J,k))) - enddo ; enddo - enddo - call cpu_clock_end(id_clock_mom_update) - - if (CS%debug) then - call uvchksum("Corrector 1 [uv]", u, v, G%HI,haloshift=0, symmetric=sym) - call hchksum(h, "Corrector 1 h", G%HI, haloshift=2, scale=GV%H_to_m) - call uvchksum("Corrector 1 [uv]h", uh, vh, G%HI, haloshift=2, & - symmetric=sym, scale=GV%H_to_m*US%L_to_m**2*US%s_to_T) - ! call MOM_state_chksum("Corrector 1", u, v, h, uh, vh, G, GV, US, haloshift=1, vel_scale=1.0) - call MOM_accel_chksum("Corrector accel", CS%CAu, CS%CAv, CS%PFu, CS%PFv, & - CS%diffu, CS%diffv, G, GV, US, CS%pbce, CS%u_accel_bt, CS%v_accel_bt, & - symmetric=sym) - endif - - ! u <- u + dt d/dz visc d/dz u - ! u_av <- u_av + dt d/dz visc d/dz u_av - call cpu_clock_begin(id_clock_vertvisc) - call vertvisc_coef(u, v, h, forces, visc, dt, G, GV, US, CS%vertvisc_CSp, CS%OBC) - call vertvisc(u, v, h, forces, visc, dt, CS%OBC, CS%ADp, CS%CDp, G, GV, US, & - CS%vertvisc_CSp, CS%taux_bot, CS%tauy_bot,waves=waves) - if (G%nonblocking_updates) then - call cpu_clock_end(id_clock_vertvisc) - 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, US, CS%vertvisc_CSp) - call cpu_clock_end(id_clock_vertvisc) - if (showCallTree) call callTree_wayPoint("done with vertvisc (step_MOM_dyn_split_RK2)") - -! Later, h_av = (h_in + h_out)/2, but for now use h_av to store h_in. - !$OMP parallel do default(shared) - do k=1,nz ; do j=js-2,je+2 ; do i=is-2,ie+2 - h_av(i,j,k) = h(i,j,k) - enddo ; enddo ; enddo - - call do_group_pass(CS%pass_visc_rem, G%Domain, clock=id_clock_pass) - if (G%nonblocking_updates) then - call complete_group_pass(CS%pass_uv, G%Domain, clock=id_clock_pass) - else - call do_group_pass(CS%pass_uv, G%Domain, clock=id_clock_pass) - endif - - ! uh = u_av * h - ! 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, 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) - call do_group_pass(CS%pass_h, G%Domain, clock=id_clock_pass) - ! 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) - if (showCallTree) call callTree_wayPoint("done with continuity (step_MOM_dyn_split_RK2)") - - if (G%nonblocking_updates) then - call start_group_pass(CS%pass_av_uvh, G%Domain, clock=id_clock_pass) - else - call do_group_pass(CS%pass_av_uvh, G%domain, clock=id_clock_pass) - endif - - if (associated(CS%OBC)) then - call radiation_open_bdry_conds(CS%OBC, u, u_old_rad_OBC, v, v_old_rad_OBC, G, US, dt) - endif - -! h_av = (h_in + h_out)/2 . Going in to this line, h_av = h_in. - !$OMP parallel do default(shared) - do k=1,nz ; do j=js-2,je+2 ; do i=is-2,ie+2 - h_av(i,j,k) = 0.5*(h_av(i,j,k) + h(i,j,k)) - enddo ; enddo ; enddo - - if (G%nonblocking_updates) & - call complete_group_pass(CS%pass_av_uvh, G%Domain, clock=id_clock_pass) - - !$OMP parallel do default(shared) - do k=1,nz - do j=js-2,je+2 ; do I=Isq-2,Ieq+2 - uhtr(I,j,k) = uhtr(I,j,k) + uh(I,j,k)*US%s_to_T*dt - enddo ; enddo - do J=Jsq-2,Jeq+2 ; do i=is-2,ie+2 - vhtr(i,J,k) = vhtr(i,J,k) + vh(i,J,k)*US%s_to_T*dt - enddo ; enddo - enddo - - ! The time-averaged free surface height has already been set by the last - ! call to btstep. - - ! Here various terms used in to update the momentum equations are - ! offered for time averaging. - if (CS%id_PFu > 0) call post_data(CS%id_PFu, CS%PFu, CS%diag) - if (CS%id_PFv > 0) call post_data(CS%id_PFv, CS%PFv, CS%diag) - if (CS%id_CAu > 0) call post_data(CS%id_CAu, CS%CAu, CS%diag) - if (CS%id_CAv > 0) call post_data(CS%id_CAv, CS%CAv, CS%diag) - - ! Here the thickness fluxes are offered for time averaging. - if (CS%id_uh > 0) call post_data(CS%id_uh , uh, CS%diag) - if (CS%id_vh > 0) call post_data(CS%id_vh , vh, CS%diag) - if (CS%id_uav > 0) call post_data(CS%id_uav, u_av, CS%diag) - if (CS%id_vav > 0) call post_data(CS%id_vav, v_av, CS%diag) - if (CS%id_u_BT_accel > 0) call post_data(CS%id_u_BT_accel, CS%u_accel_bt, CS%diag) - if (CS%id_v_BT_accel > 0) call post_data(CS%id_v_BT_accel, CS%v_accel_bt, CS%diag) - - if (CS%debug) then - call MOM_state_chksum("Corrector ", u, v, h, uh, vh, G, GV, US, symmetric=sym, vel_scale=1.0) - call uvchksum("Corrector avg [uv]", u_av, v_av, G%HI, haloshift=1, symmetric=sym, scale=US%L_T_to_m_s) - call hchksum(h_av, "Corrector avg h", G%HI, haloshift=1, scale=GV%H_to_m) - ! call MOM_state_chksum("Corrector avg ", u_av, v_av, h_av, uh, vh, G, GV, US, vel_scale=1.0) - endif - - if (showCallTree) call callTree_leave("step_MOM_dyn_split_RK2()") - -end subroutine step_MOM_dyn_split_RK2 - -!> This subroutine sets up any auxiliary restart variables that are specific -!! to the unsplit time stepping scheme. All variables registered here should -!! have the ability to be recreated if they are not present in a restart file. -subroutine register_restarts_dyn_split_RK2(HI, GV, param_file, CS, restart_CS, uh, vh) - type(hor_index_type), intent(in) :: HI !< Horizontal index structure - type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure - type(param_file_type), intent(in) :: param_file !< parameter file - type(MOM_dyn_split_RK2_CS), pointer :: CS !< module control structure - type(MOM_restart_CS), pointer :: restart_CS !< restart control structure - real, dimension(SZIB_(HI),SZJ_(HI),SZK_(GV)), & - target, intent(inout) :: uh !< zonal volume/mass transport [H L2 T-1 ~> m3 s-1 or kg s-1] - real, dimension(SZI_(HI),SZJB_(HI),SZK_(GV)), & - target, intent(inout) :: vh !< merid volume/mass transport [H L2 T-1 ~> m3 s-1 or kg s-1] - - type(vardesc) :: vd - character(len=40) :: mdl = "MOM_dynamics_split_RK2" ! This module's name. - character(len=48) :: thickness_units, flux_units - - integer :: isd, ied, jsd, jed, nz, IsdB, IedB, JsdB, JedB - isd = HI%isd ; ied = HI%ied ; jsd = HI%jsd ; jed = HI%jed ; nz = GV%ke - IsdB = HI%IsdB ; IedB = HI%IedB ; JsdB = HI%JsdB ; JedB = HI%JedB - - ! This is where a control structure specific to this module would be allocated. - if (associated(CS)) then - call MOM_error(WARNING, "register_restarts_dyn_split_RK2 called with an associated "// & - "control structure.") - return - endif - allocate(CS) - - ALLOC_(CS%diffu(IsdB:IedB,jsd:jed,nz)) ; CS%diffu(:,:,:) = 0.0 - ALLOC_(CS%diffv(isd:ied,JsdB:JedB,nz)) ; CS%diffv(:,:,:) = 0.0 - ALLOC_(CS%CAu(IsdB:IedB,jsd:jed,nz)) ; CS%CAu(:,:,:) = 0.0 - ALLOC_(CS%CAv(isd:ied,JsdB:JedB,nz)) ; CS%CAv(:,:,:) = 0.0 - ALLOC_(CS%PFu(IsdB:IedB,jsd:jed,nz)) ; CS%PFu(:,:,:) = 0.0 - ALLOC_(CS%PFv(isd:ied,JsdB:JedB,nz)) ; CS%PFv(:,:,:) = 0.0 - - ALLOC_(CS%eta(isd:ied,jsd:jed)) ; CS%eta(:,:) = 0.0 - ALLOC_(CS%u_av(IsdB:IedB,jsd:jed,nz)) ; CS%u_av(:,:,:) = 0.0 - ALLOC_(CS%v_av(isd:ied,JsdB:JedB,nz)) ; CS%v_av(:,:,:) = 0.0 - ALLOC_(CS%h_av(isd:ied,jsd:jed,nz)) ; CS%h_av(:,:,:) = GV%Angstrom_H - - thickness_units = get_thickness_units(GV) - flux_units = get_flux_units(GV) - - if (GV%Boussinesq) then - vd = var_desc("sfc",thickness_units,"Free surface Height",'h','1') - else - vd = var_desc("p_bot",thickness_units,"Bottom Pressure",'h','1') - endif - call register_restart_field(CS%eta, vd, .false., restart_CS) - - vd = var_desc("u2","m s-1","Auxiliary Zonal velocity",'u','L') - call register_restart_field(CS%u_av, vd, .false., restart_CS) - - vd = var_desc("v2","m s-1","Auxiliary Meridional velocity",'v','L') - call register_restart_field(CS%v_av, vd, .false., restart_CS) - - vd = var_desc("h2",thickness_units,"Auxiliary Layer Thickness",'h','L') - call register_restart_field(CS%h_av, vd, .false., restart_CS) - - vd = var_desc("uh",flux_units,"Zonal thickness flux",'u','L') - call register_restart_field(uh, vd, .false., restart_CS) - - vd = var_desc("vh",flux_units,"Meridional thickness flux",'v','L') - call register_restart_field(vh, vd, .false., restart_CS) - - vd = var_desc("diffu","m s-2","Zonal horizontal viscous acceleration",'u','L') - call register_restart_field(CS%diffu, vd, .false., restart_CS) - - vd = var_desc("diffv","m s-2","Meridional horizontal viscous acceleration",'v','L') - call register_restart_field(CS%diffv, vd, .false., restart_CS) - - call register_barotropic_restarts(HI, GV, param_file, CS%barotropic_CSp, & - restart_CS) - -end subroutine register_restarts_dyn_split_RK2 - -!> This subroutine initializes all of the variables that are used by this -!! dynamic core, including diagnostics and the cpu clocks. -subroutine initialize_dyn_split_RK2(u, v, h, uh, vh, eta, Time, G, GV, US, param_file, & - diag, CS, restart_CS, dt, Accel_diag, Cont_diag, MIS, & - VarMix, MEKE, thickness_diffuse_CSp, & - OBC, update_OBC_CSp, ALE_CSp, setVisc_CSp, & - visc, dirs, ntrunc, calc_dtbt) - 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 !< merid velocity [m s-1] - real, dimension(SZI_(G),SZJ_(G),SZK_(G)) , intent(inout) :: h !< layer thickness [H ~> m or kg m-2] - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & - target, intent(inout) :: uh !< zonal volume/mass transport [H L2 T-1 ~> m3 s-1 or kg s-1] - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - target, intent(inout) :: vh !< merid volume/mass transport [H L2 T-1 ~> m3 s-1 or kg s-1] - real, dimension(SZI_(G),SZJ_(G)), intent(inout) :: eta !< free surface height or column mass [H ~> m or kg m-2] - type(time_type), target, intent(in) :: Time !< current model time - type(param_file_type), intent(in) :: param_file !< parameter file for parsing - type(diag_ctrl), target, intent(inout) :: diag !< to control diagnostics - type(MOM_dyn_split_RK2_CS), pointer :: CS !< module control structure - type(MOM_restart_CS), pointer :: restart_CS !< restart control structure - real, intent(in) :: dt !< time step [s] - type(accel_diag_ptrs), target, intent(inout) :: Accel_diag !< points to momentum equation terms for - !! budget analysis - type(cont_diag_ptrs), target, intent(inout) :: Cont_diag !< points to terms in continuity equation - type(ocean_internal_state), intent(inout) :: MIS !< "MOM6 internal state" used to pass - !! diagnostic pointers - type(VarMix_CS), pointer :: VarMix !< points to spatially variable viscosities - type(MEKE_type), pointer :: MEKE !< points to mesoscale eddy kinetic energy fields -! type(Barotropic_CS), pointer :: Barotropic_CSp !< Pointer to the control structure for -! !! the barotropic module - type(thickness_diffuse_CS), pointer :: thickness_diffuse_CSp !< Pointer to the control structure - !! used for the isopycnal height diffusive transport. - type(ocean_OBC_type), pointer :: OBC !< points to OBC related fields - type(update_OBC_CS), pointer :: update_OBC_CSp !< points to OBC update related fields - type(ALE_CS), pointer :: ALE_CSp !< points to ALE control structure - type(set_visc_CS), pointer :: setVisc_CSp !< points to the set_visc control structure. - type(vertvisc_type), intent(inout) :: visc !< vertical viscosities, bottom drag, and related - type(directories), intent(in) :: dirs !< contains directory paths - integer, target, intent(inout) :: ntrunc !< A target for the variable that records - !! the number of times the velocity is - !! truncated (this should be 0). - logical, intent(out) :: calc_dtbt !< If true, recalculate the barotropic time step - - ! local variables - real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: h_tmp - character(len=40) :: mdl = "MOM_dynamics_split_RK2" ! This module's name. - character(len=48) :: thickness_units, flux_units, eta_rest_name - real :: H_rescale ! A rescaling factor for thicknesses 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 :: accel_rescale ! A rescaling factor for accelerations from the representation in - ! a restart file to the internal representation in this run. - real :: vel_rescale ! A rescaling factor for velocities from the representation in - ! a restart file to the internal representation in this run. - real :: H_convert - type(group_pass_type) :: pass_av_h_uvh - logical :: use_tides, debug_truncations - - integer :: i, j, k, is, ie, js, je, isd, ied, jsd, jed, nz - integer :: IsdB, IedB, JsdB, JedB - 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 - IsdB = G%IsdB ; IedB = G%IedB ; JsdB = G%JsdB ; JedB = G%JedB - - if (.not.associated(CS)) call MOM_error(FATAL, & - "initialize_dyn_split_RK2 called with an unassociated control structure.") - if (CS%module_is_initialized) then - call MOM_error(WARNING, "initialize_dyn_split_RK2 called with a control "// & - "structure that has already been initialized.") - return - endif - CS%module_is_initialized = .true. - - CS%diag => diag - - call get_param(param_file, mdl, "TIDES", use_tides, & - "If true, apply tidal momentum forcing.", default=.false.) - call get_param(param_file, mdl, "BE", CS%be, & - "If SPLIT is true, BE determines the relative weighting "//& - "of a 2nd-order Runga-Kutta baroclinic time stepping "//& - "scheme (0.5) and a backward Euler scheme (1) that is "//& - "used for the Coriolis and inertial terms. BE may be "//& - "from 0.5 to 1, but instability may occur near 0.5. "//& - "BE is also applicable if SPLIT is false and USE_RK2 "//& - "is true.", units="nondim", default=0.6) - call get_param(param_file, mdl, "BEGW", CS%begw, & - "If SPLIT is true, BEGW is a number from 0 to 1 that "//& - "controls the extent to which the treatment of gravity "//& - "waves is forward-backward (0) or simulated backward "//& - "Euler (1). 0 is almost always used. "//& - "If SPLIT is false and USE_RK2 is true, BEGW can be "//& - "between 0 and 0.5 to damp gravity waves.", & - units="nondim", default=0.0) - - call get_param(param_file, mdl, "SPLIT_BOTTOM_STRESS", CS%split_bottom_stress, & - "If true, provide the bottom stress calculated by the "//& - "vertical viscosity to the barotropic solver.", default=.false.) - call get_param(param_file, mdl, "BT_USE_LAYER_FLUXES", CS%BT_use_layer_fluxes, & - "If true, use the summed layered fluxes plus an "//& - "adjustment due to the change in the barotropic velocity "//& - "in the barotropic continuity equation.", default=.true.) - call get_param(param_file, mdl, "DEBUG", CS%debug, & - "If true, write out verbose debugging data.", & - default=.false., debuggingParam=.true.) - call get_param(param_file, mdl, "DEBUG_OBC", CS%debug_OBC, default=.false.) - call get_param(param_file, mdl, "DEBUG_TRUNCATIONS", debug_truncations, & - default=.false.) - - allocate(CS%taux_bot(IsdB:IedB,jsd:jed)) ; CS%taux_bot(:,:) = 0.0 - allocate(CS%tauy_bot(isd:ied,JsdB:JedB)) ; CS%tauy_bot(:,:) = 0.0 - - ALLOC_(CS%uhbt(IsdB:IedB,jsd:jed)) ; CS%uhbt(:,:) = 0.0 - ALLOC_(CS%vhbt(isd:ied,JsdB:JedB)) ; CS%vhbt(:,:) = 0.0 - ALLOC_(CS%visc_rem_u(IsdB:IedB,jsd:jed,nz)) ; CS%visc_rem_u(:,:,:) = 0.0 - ALLOC_(CS%visc_rem_v(isd:ied,JsdB:JedB,nz)) ; CS%visc_rem_v(:,:,:) = 0.0 - ALLOC_(CS%eta_PF(isd:ied,jsd:jed)) ; CS%eta_PF(:,:) = 0.0 - ALLOC_(CS%pbce(isd:ied,jsd:jed,nz)) ; CS%pbce(:,:,:) = 0.0 - - ALLOC_(CS%u_accel_bt(IsdB:IedB,jsd:jed,nz)) ; CS%u_accel_bt(:,:,:) = 0.0 - ALLOC_(CS%v_accel_bt(isd:ied,JsdB:JedB,nz)) ; CS%v_accel_bt(:,:,:) = 0.0 - - MIS%diffu => CS%diffu - MIS%diffv => CS%diffv - MIS%PFu => CS%PFu - MIS%PFv => CS%PFv - MIS%CAu => CS%CAu - MIS%CAv => CS%CAv - MIS%pbce => CS%pbce - MIS%u_accel_bt => CS%u_accel_bt - MIS%v_accel_bt => CS%v_accel_bt - MIS%u_av => CS%u_av - MIS%v_av => CS%v_av - - CS%ADp => Accel_diag - CS%CDp => Cont_diag - Accel_diag%diffu => CS%diffu - Accel_diag%diffv => CS%diffv - Accel_diag%PFu => CS%PFu - Accel_diag%PFv => CS%PFv - Accel_diag%CAu => CS%CAu - Accel_diag%CAv => CS%CAv - -! Accel_diag%pbce => CS%pbce -! Accel_diag%u_accel_bt => CS%u_accel_bt ; Accel_diag%v_accel_bt => CS%v_accel_bt -! Accel_diag%u_av => CS%u_av ; Accel_diag%v_av => CS%v_av - - call continuity_init(Time, G, GV, US, param_file, diag, CS%continuity_CSp) - call CoriolisAdv_init(Time, G, GV, US, param_file, diag, CS%ADp, CS%CoriolisAdv_CSp) - 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, 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, & - "initialize_dyn_split_RK2 called with setVisc_CSp unassociated.") - CS%set_visc_CSp => setVisc_CSp - call updateCFLtruncationValue(Time, CS%vertvisc_CSp, & - activate=is_new_run(restart_CS) ) - - if (associated(ALE_CSp)) CS%ALE_CSp => ALE_CSp - if (associated(OBC)) CS%OBC => OBC - if (associated(update_OBC_CSp)) CS%update_OBC_CSp => update_OBC_CSp - - eta_rest_name = "sfc" ; if (.not.GV%Boussinesq) eta_rest_name = "p_bot" - if (.not. query_initialized(CS%eta, trim(eta_rest_name), restart_CS)) then - ! Estimate eta based on the layer thicknesses - h. With the Boussinesq - ! approximation, eta is the free surface height anomaly, while without it - ! eta is the mass of ocean per unit area. eta always has the same - ! dimensions as h, either m or kg m-3. - ! CS%eta(:,:) = 0.0 already from initialization. - if (GV%Boussinesq) then - do j=js,je ; do i=is,ie ; CS%eta(i,j) = -GV%Z_to_H * G%bathyT(i,j) ; enddo ; enddo - endif - do k=1,nz ; do j=js,je ; do i=is,ie - CS%eta(i,j) = CS%eta(i,j) + h(i,j,k) - enddo ; enddo ; enddo - elseif ((GV%m_to_H_restart /= 0.0) .and. (GV%m_to_H_restart /= GV%m_to_H)) then - H_rescale = GV%m_to_H / GV%m_to_H_restart - do j=js,je ; do i=is,ie ; CS%eta(i,j) = H_rescale * CS%eta(i,j) ; enddo ; enddo - endif - ! Copy eta into an output array. - do j=js,je ; do i=is,ie ; eta(i,j) = CS%eta(i,j) ; enddo ; enddo - - call barotropic_init(u, v, h, CS%eta, Time, G, GV, US, param_file, diag, & - CS%barotropic_CSp, restart_CS, calc_dtbt, CS%BT_cont, & - CS%tides_CSp) - - if (.not. query_initialized(CS%diffu,"diffu",restart_CS) .or. & - .not. query_initialized(CS%diffv,"diffv",restart_CS)) then - call horizontal_viscosity(u, v, h, CS%diffu, CS%diffv, MEKE, VarMix, & - G, GV, US, CS%hor_visc_CSp, & - OBC=CS%OBC, BT=CS%barotropic_CSp) - elseif ( (US%s_to_T_restart * US%m_to_L_restart /= 0.0) .and. & - (US%m_to_L * US%s_to_T_restart**2 /= US%m_to_L_restart * US%s_to_T**2) ) then - accel_rescale = (US%m_to_L * US%s_to_T_restart**2) / (US%m_to_L_restart * US%s_to_T**2) - do k=1,nz ; do j=js,je ; do I=G%IscB,G%IecB - CS%diffu(I,j,k) = accel_rescale * CS%diffu(I,j,k) - enddo ; enddo ; enddo - do k=1,nz ; do J=G%JscB,G%JecB ; do i=is,ie - CS%diffv(i,J,k) = accel_rescale * CS%diffv(i,J,k) - enddo ; enddo ; enddo - endif - - if (.not. query_initialized(CS%u_av,"u2", restart_CS) .or. & - .not. query_initialized(CS%u_av,"v2", restart_CS)) then - CS%u_av(:,:,:) = US%m_s_to_L_T*u(:,:,:) - CS%v_av(:,:,:) = US%m_s_to_L_T*v(:,:,:) - 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 k=1,nz ; do j=js,je ; do I=G%IscB,G%IecB - CS%u_av(I,j,k) = vel_rescale * CS%u_av(I,j,k) - enddo ; enddo ; enddo - do k=1,nz ; do J=G%JscB,G%JecB ; do i=is,ie - CS%u_av(i,J,k) = vel_rescale * CS%u_av(i,J,k) - enddo ; enddo ; enddo - endif - - ! This call is just here to initialize uh and vh. - 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, 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 - if (.not. query_initialized(CS%h_av,"h2",restart_CS)) then - CS%h_av(:,:,:) = h(:,:,:) - elseif ((GV%m_to_H_restart /= 0.0) .and. (GV%m_to_H_restart /= GV%m_to_H)) then - H_rescale = GV%m_to_H / GV%m_to_H_restart - do k=1,nz ; do j=js,je ; do i=is,ie ; CS%h_av(i,j,k) = H_rescale * CS%h_av(i,j,k) ; enddo ; enddo ; enddo - endif - if ( (GV%m_to_H_restart * US%s_to_T_restart * US%m_to_L_restart /= 0.0) .and. & - ((GV%m_to_H * US%m_to_L**2 * US%s_to_T_restart) /= & - (GV%m_to_H_restart * US%m_to_L_restart**2 * US%s_to_T)) ) then - uH_rescale = (GV%m_to_H * US%m_to_L**2 * US%s_to_T_restart) / & - (GV%m_to_H_restart * US%m_to_L_restart**2 * US%s_to_T) - do k=1,nz ; do j=js,je ; do I=G%IscB,G%IecB ; uh(I,j,k) = uH_rescale * uh(I,j,k) ; enddo ; enddo ; enddo - do k=1,nz ; do J=G%JscB,G%JecB ; do i=is,ie ; vh(i,J,k) = uH_rescale * vh(i,J,k) ; enddo ; enddo ; enddo - endif - endif - - call cpu_clock_begin(id_clock_pass_init) - call create_group_pass(pass_av_h_uvh, CS%u_av, CS%v_av, G%Domain, halo=2) - call create_group_pass(pass_av_h_uvh, CS%h_av, G%Domain, halo=2) - call create_group_pass(pass_av_h_uvh, uh, vh, G%Domain, halo=2) - call do_group_pass(pass_av_h_uvh, G%Domain) - call cpu_clock_end(id_clock_pass_init) - - flux_units = get_flux_units(GV) - H_convert = GV%H_to_m ; if (.not.GV%Boussinesq) H_convert = GV%H_to_kg_m2 - CS%id_uh = register_diag_field('ocean_model', 'uh', diag%axesCuL, Time, & - 'Zonal Thickness Flux', flux_units, y_cell_method='sum', v_extensive=.true., & - conversion=H_convert*US%L_to_m**2*US%s_to_T) - CS%id_vh = register_diag_field('ocean_model', 'vh', diag%axesCvL, Time, & - 'Meridional Thickness Flux', flux_units, x_cell_method='sum', v_extensive=.true., & - conversion=H_convert*US%L_to_m**2*US%s_to_T) - - CS%id_CAu = register_diag_field('ocean_model', 'CAu', diag%axesCuL, Time, & - 'Zonal Coriolis and Advective Acceleration', 'm s-2', conversion=US%L_T2_to_m_s2) - CS%id_CAv = register_diag_field('ocean_model', 'CAv', diag%axesCvL, Time, & - 'Meridional Coriolis and Advective Acceleration', 'm s-2', conversion=US%L_T2_to_m_s2) - CS%id_PFu = register_diag_field('ocean_model', 'PFu', diag%axesCuL, Time, & - 'Zonal Pressure Force Acceleration', 'm s-2', conversion=US%L_T2_to_m_s2) - CS%id_PFv = register_diag_field('ocean_model', 'PFv', diag%axesCvL, Time, & - 'Meridional Pressure Force Acceleration', 'm s-2', conversion=US%L_T2_to_m_s2) - - CS%id_uav = register_diag_field('ocean_model', 'uav', diag%axesCuL, Time, & - 'Barotropic-step Averaged Zonal Velocity', 'm s-1') - CS%id_vav = register_diag_field('ocean_model', 'vav', diag%axesCvL, Time, & - 'Barotropic-step Averaged Meridional Velocity', 'm s-1') - - CS%id_u_BT_accel = register_diag_field('ocean_model', 'u_BT_accel', diag%axesCuL, Time, & - 'Barotropic Anomaly Zonal Acceleration', 'm s-2', conversion=US%L_T2_to_m_s2) - CS%id_v_BT_accel = register_diag_field('ocean_model', 'v_BT_accel', diag%axesCvL, Time, & - 'Barotropic Anomaly Meridional Acceleration', 'm s-2', conversion=US%L_T2_to_m_s2) - - id_clock_Cor = cpu_clock_id('(Ocean Coriolis & mom advection)', grain=CLOCK_MODULE) - id_clock_continuity = cpu_clock_id('(Ocean continuity equation)', grain=CLOCK_MODULE) - id_clock_pres = cpu_clock_id('(Ocean pressure force)', grain=CLOCK_MODULE) - id_clock_vertvisc = cpu_clock_id('(Ocean vertical viscosity)', grain=CLOCK_MODULE) - id_clock_horvisc = cpu_clock_id('(Ocean horizontal viscosity)', grain=CLOCK_MODULE) - id_clock_mom_update = cpu_clock_id('(Ocean momentum increments)', grain=CLOCK_MODULE) - id_clock_pass = cpu_clock_id('(Ocean message passing)', grain=CLOCK_MODULE) - id_clock_pass_init = cpu_clock_id('(Ocean init message passing)', grain=CLOCK_ROUTINE) - id_clock_btcalc = cpu_clock_id('(Ocean barotropic mode calc)', grain=CLOCK_MODULE) - id_clock_btstep = cpu_clock_id('(Ocean barotropic mode stepping)', grain=CLOCK_MODULE) - id_clock_btforce = cpu_clock_id('(Ocean barotropic forcing calc)', grain=CLOCK_MODULE) - -end subroutine initialize_dyn_split_RK2 - - -!> Close the dyn_split_RK2 module -subroutine end_dyn_split_RK2(CS) - type(MOM_dyn_split_RK2_CS), pointer :: CS !< module control structure - - DEALLOC_(CS%diffu) ; DEALLOC_(CS%diffv) - DEALLOC_(CS%CAu) ; DEALLOC_(CS%CAv) - DEALLOC_(CS%PFu) ; DEALLOC_(CS%PFv) - - if (associated(CS%taux_bot)) deallocate(CS%taux_bot) - if (associated(CS%tauy_bot)) deallocate(CS%tauy_bot) - DEALLOC_(CS%uhbt) ; DEALLOC_(CS%vhbt) - DEALLOC_(CS%u_accel_bt) ; DEALLOC_(CS%v_accel_bt) - DEALLOC_(CS%visc_rem_u) ; DEALLOC_(CS%visc_rem_v) - - DEALLOC_(CS%eta) ; DEALLOC_(CS%eta_PF) ; DEALLOC_(CS%pbce) - DEALLOC_(CS%h_av) ; DEALLOC_(CS%u_av) ; DEALLOC_(CS%v_av) - - call dealloc_BT_cont_type(CS%BT_cont) - - deallocate(CS) -end subroutine end_dyn_split_RK2 - - -!> \namespace mom_dynamics_split_rk2 -!! -!! This file time steps the adiabatic dynamic core by splitting -!! between baroclinic and barotropic modes. It uses a pseudo-second order -!! Runge-Kutta time stepping scheme for the baroclinic momentum -!! equation and a forward-backward coupling between the baroclinic -!! momentum and continuity equations. This split time-stepping -!! scheme is described in detail in Hallberg (JCP, 1997). Additional -!! issues related to exact tracer conservation and how to -!! ensure consistency between the barotropic and layered estimates -!! of the free surface height are described in Hallberg and -!! Adcroft (Ocean Modelling, 2009). This was the time stepping code -!! that is used for most GOLD applications, including GFDL's ESM2G -!! Earth system model, and all of the examples provided with the -!! MOM code (although several of these solutions are routinely -!! verified by comparison with the slower unsplit schemes). -!! -!! The subroutine step_MOM_dyn_split_RK2 actually does the time -!! stepping, while register_restarts_dyn_split_RK2 sets the fields -!! that are found in a full restart file with this scheme, and -!! initialize_dyn_split_RK2 initializes the cpu clocks that are -!! used in this module. For largely historical reasons, this module -!! does not have its own control structure, but shares the same -!! control structure with MOM.F90 and the other MOM_dynamics_... -!! modules. - -end module MOM_dynamics_split_RK2 diff --git a/src/core/MOM_dynamics_unsplit.F90 b/src/core/MOM_dynamics_unsplit.F90 index 54471d53f2..611319c706 100644 --- a/src/core/MOM_dynamics_unsplit.F90 +++ b/src/core/MOM_dynamics_unsplit.F90 @@ -346,8 +346,22 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & call disable_averaging(CS%diag) call vertvisc_coef(US%m_s_to_L_T*up, US%m_s_to_L_T*vp, h_av, forces, visc, dt*0.5, G, GV, US, & CS%vertvisc_CSp, CS%OBC) + !### This is temporary and will be deleted when the units of the input velocities have changed. + do j=G%jsc,G%jec ; do k=1,nz ; do I=Isq,Ieq + up(I,j,k) = US%m_s_to_L_T*up(I,j,k) + enddo ; enddo ; enddo + do J=Jsq,Jeq ; do k=1,nz ; do i=is,ie + vp(i,J,k) = US%m_s_to_L_T*vp(i,J,k) + enddo ; enddo ; enddo call vertvisc(up, vp, h_av, forces, visc, dt*0.5, CS%OBC, CS%ADp, CS%CDp, & G, GV, US, CS%vertvisc_CSp, Waves=Waves) + !### This is temporary and will be deleted when the units of the input velocities have changed. + do j=G%jsc,G%jec ; do k=1,nz ; do I=Isq,Ieq + up(I,j,k) = US%L_T_to_m_s*up(I,j,k) + enddo ; enddo ; enddo + do J=Jsq,Jeq ; do k=1,nz ; do i=is,ie + vp(i,J,k) = US%L_T_to_m_s*vp(i,J,k) + enddo ; enddo ; enddo call cpu_clock_end(id_clock_vertvisc) call pass_vector(up, vp, G%Domain, clock=id_clock_pass) @@ -410,8 +424,22 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & call cpu_clock_begin(id_clock_vertvisc) call vertvisc_coef(US%m_s_to_L_T*upp, US%m_s_to_L_T*vpp, hp, forces, visc, dt*0.5, G, GV, US, & CS%vertvisc_CSp, CS%OBC) + !### This is temporary and will be deleted when the units of the input velocities have changed. + do j=G%jsc,G%jec ; do k=1,nz ; do I=Isq,Ieq + upp(I,j,k) = US%m_s_to_L_T*upp(I,j,k) + enddo ; enddo ; enddo + do J=Jsq,Jeq ; do k=1,nz ; do i=is,ie + vpp(i,J,k) = US%m_s_to_L_T*vpp(i,J,k) + enddo ; enddo ; enddo call vertvisc(upp, vpp, hp, forces, visc, dt*0.5, CS%OBC, CS%ADp, CS%CDp, & G, GV, US, CS%vertvisc_CSp, Waves=Waves) + !### This is temporary and will be deleted when the units of the input velocities have changed. + do j=G%jsc,G%jec ; do k=1,nz ; do I=Isq,Ieq + upp(I,j,k) = US%L_T_to_m_s*upp(I,j,k) + enddo ; enddo ; enddo + do J=Jsq,Jeq ; do k=1,nz ; do i=is,ie + vpp(i,J,k) = US%L_T_to_m_s*vpp(i,J,k) + enddo ; enddo ; enddo call cpu_clock_end(id_clock_vertvisc) call pass_vector(upp, vpp, G%Domain, clock=id_clock_pass) @@ -480,8 +508,22 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & ! u <- u + dt d/dz visc d/dz u call cpu_clock_begin(id_clock_vertvisc) call vertvisc_coef(US%m_s_to_L_T*u, US%m_s_to_L_T*v, h_av, forces, visc, dt, G, GV, US, CS%vertvisc_CSp, CS%OBC) + !### This is temporary and will be deleted when the units of the input velocities have changed. + do j=G%jsc,G%jec ; do k=1,nz ; do I=Isq,Ieq + u(I,j,k) = US%m_s_to_L_T*u(I,j,k) + enddo ; enddo ; enddo + do J=Jsq,Jeq ; do k=1,nz ; do i=is,ie + v(i,J,k) = US%m_s_to_L_T*v(i,J,k) + enddo ; enddo ; enddo call vertvisc(u, v, h_av, forces, visc, dt, CS%OBC, CS%ADp, CS%CDp, & G, GV, US, CS%vertvisc_CSp, CS%taux_bot, CS%tauy_bot, Waves=Waves) + !### This is temporary and will be deleted when the units of the input velocities have changed. + do j=G%jsc,G%jec ; do k=1,nz ; do I=Isq,Ieq + u(I,j,k) = US%L_T_to_m_s*u(I,j,k) + enddo ; enddo ; enddo + do J=Jsq,Jeq ; do k=1,nz ; do i=is,ie + v(i,J,k) = US%L_T_to_m_s*v(i,J,k) + enddo ; enddo ; enddo call cpu_clock_end(id_clock_vertvisc) call pass_vector(u, v, 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 5f37ab63c2..ddbdc84364 100644 --- a/src/core/MOM_dynamics_unsplit_RK2.F90 +++ b/src/core/MOM_dynamics_unsplit_RK2.F90 @@ -343,8 +343,22 @@ subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt, call disable_averaging(CS%diag) call vertvisc_coef(US%m_s_to_L_T*up, US%m_s_to_L_T*vp, h_av, forces, visc, dt_pred, G, GV, US, & CS%vertvisc_CSp, CS%OBC) + !### This is temporary and will be deleted when the units of the input velocities have changed. + do j=G%jsc,G%jec ; do k=1,nz ; do I=Isq,Ieq + up(I,j,k) = US%m_s_to_L_T*up(I,j,k) + enddo ; enddo ; enddo + do J=Jsq,Jeq ; do k=1,nz ; do i=is,ie + vp(i,J,k) = US%m_s_to_L_T*vp(i,J,k) + enddo ; enddo ; enddo call vertvisc(up, vp, h_av, forces, visc, dt_pred, CS%OBC, CS%ADp, CS%CDp, & G, GV, US, CS%vertvisc_CSp) + !### This is temporary and will be deleted when the units of the input velocities have changed. + do j=G%jsc,G%jec ; do k=1,nz ; do I=Isq,Ieq + up(I,j,k) = US%L_T_to_m_s*up(I,j,k) + enddo ; enddo ; enddo + do J=Jsq,Jeq ; do k=1,nz ; do i=is,ie + vp(i,J,k) = US%L_T_to_m_s*vp(i,J,k) + enddo ; enddo ; enddo call cpu_clock_end(id_clock_vertvisc) call pass_vector(up, vp, G%Domain, clock=id_clock_pass) @@ -395,12 +409,40 @@ subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt, call cpu_clock_begin(id_clock_vertvisc) call vertvisc_coef(US%m_s_to_L_T*up, US%m_s_to_L_T*vp, h_av, forces, visc, dt, G, GV, US, & CS%vertvisc_CSp, CS%OBC) + !### This is temporary and will be deleted when the units of the input velocities have changed. + do j=G%jsc,G%jec ; do k=1,nz ; do I=Isq,Ieq + up(I,j,k) = US%m_s_to_L_T*up(I,j,k) + enddo ; enddo ; enddo + do J=Jsq,Jeq ; do k=1,nz ; do i=is,ie + vp(i,J,k) = US%m_s_to_L_T*vp(i,J,k) + enddo ; enddo ; enddo call vertvisc(up, vp, h_av, forces, visc, dt, CS%OBC, CS%ADp, CS%CDp, & G, GV, US, CS%vertvisc_CSp, CS%taux_bot, CS%tauy_bot) + !### This is temporary and will be deleted when the units of the input velocities have changed. + do j=G%jsc,G%jec ; do k=1,nz ; do I=Isq,Ieq + up(I,j,k) = US%L_T_to_m_s*up(I,j,k) + enddo ; enddo ; enddo + do J=Jsq,Jeq ; do k=1,nz ; do i=is,ie + vp(i,J,k) = US%L_T_to_m_s*vp(i,J,k) + enddo ; enddo ; enddo call vertvisc_coef(US%m_s_to_L_T*u_in, US%m_s_to_L_T*v_in, h_av, forces, visc, dt, G, GV, US, & CS%vertvisc_CSp, CS%OBC) + !### This is temporary and will be deleted when the units of the input velocities have changed. + do j=G%jsc,G%jec ; do k=1,nz ; do I=Isq,Ieq + u_in(I,j,k) = US%m_s_to_L_T*u_in(I,j,k) + enddo ; enddo ; enddo + do J=Jsq,Jeq ; do k=1,nz ; do i=is,ie + v_in(i,J,k) = US%m_s_to_L_T*v_in(i,J,k) + enddo ; enddo ; enddo call vertvisc(u_in, v_in, h_av, forces, visc, dt, CS%OBC, CS%ADp, CS%CDp,& G, GV, US, CS%vertvisc_CSp, CS%taux_bot, CS%tauy_bot) + !### This is temporary and will be deleted when the units of the input velocities have changed. + do j=G%jsc,G%jec ; do k=1,nz ; do I=Isq,Ieq + u_in(I,j,k) = US%L_T_to_m_s*u_in(I,j,k) + enddo ; enddo ; enddo + do J=Jsq,Jeq ; do k=1,nz ; do i=is,ie + v_in(i,J,k) = US%L_T_to_m_s*v_in(i,J,k) + enddo ; enddo ; enddo call cpu_clock_end(id_clock_vertvisc) call pass_vector(up, vp, G%Domain, clock=id_clock_pass) call pass_vector(u_in, v_in, G%Domain, clock=id_clock_pass) diff --git a/src/parameterizations/vertical/MOM_vert_friction.F90 b/src/parameterizations/vertical/MOM_vert_friction.F90 index 35f0bcb78d..03b2cb767a 100644 --- a/src/parameterizations/vertical/MOM_vert_friction.F90 +++ b/src/parameterizations/vertical/MOM_vert_friction.F90 @@ -148,9 +148,9 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, US, CS, & 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_(GV)), & - intent(inout) :: u !< Zonal velocity [m s-1] + intent(inout) :: u !< Zonal velocity [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), & - intent(inout) :: v !< Meridional velocity [m s-1] + intent(inout) :: v !< Meridional velocity [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: h !< Layer thickness [H ~> m or kg m-2] type(mech_forcing), intent(in) :: forces !< A structure with the driving mechanical forces @@ -208,15 +208,6 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, US, CS, & if (.not.associated(CS)) call MOM_error(FATAL,"MOM_vert_friction(visc): "// & "Module must be initialized before it is used.") - !### This is temporary and will be deleted when the units of the input velocities have changed. - do j=G%jsc,G%jec ; do k=1,nz ; do I=Isq,Ieq - u(I,j,k) = US%m_s_to_L_T*u(I,j,k) - enddo ; enddo ; enddo - do J=Jsq,Jeq ; do k=1,nz ; do i=is,ie - v(i,J,k) = US%m_s_to_L_T*v(i,J,k) - enddo ; enddo ; enddo - - if (CS%direct_stress) then Hmix = CS%Hmix_stress I_Hmix = 1.0 / Hmix @@ -450,15 +441,6 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, US, CS, & enddo endif - - !### This is temporary and will be deleted when the units of the input velocities have changed. - do j=G%jsc,G%jec ; do k=1,nz ; do I=Isq,Ieq - u(I,j,k) = US%L_T_to_m_s*u(I,j,k) - enddo ; enddo ; enddo - do J=Jsq,Jeq ; do k=1,nz ; do i=is,ie - v(i,J,k) = US%L_T_to_m_s*v(i,J,k) - enddo ; enddo ; enddo - ! Offer diagnostic fields for averaging. if (CS%id_du_dt_visc > 0) & call post_data(CS%id_du_dt_visc, ADp%du_dt_visc, CS%diag) From 670dcd9f9bdf53b4000b7d920ea32c59e1ca5355 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Wed, 14 Aug 2019 16:51:53 -0400 Subject: [PATCH 208/297] Velocities in [L T-1] in step_MOM_dyn_split_RK2 Work with velocity units of [L T-1] inside of step_MOM_dyn_split_RK2, step_MOM_dyn_unsplit, and step_MOM_dyn_unsplit_RK2. There are still some places where the velociies revert to [m s-1] because radiation_open_bdry_conds still takes intent in/out arguments in [m s-1]. All answers are bitwise identical. --- src/core/MOM_dynamics_split_RK2.F90 | 174 ++++++++++++++------------ src/core/MOM_dynamics_unsplit.F90 | 122 +++++++----------- src/core/MOM_dynamics_unsplit_RK2.F90 | 100 ++++++--------- 3 files changed, 180 insertions(+), 216 deletions(-) diff --git a/src/core/MOM_dynamics_split_RK2.F90 b/src/core/MOM_dynamics_split_RK2.F90 index 8e1e996c2b..07910340e7 100644 --- a/src/core/MOM_dynamics_split_RK2.F90 +++ b/src/core/MOM_dynamics_split_RK2.F90 @@ -278,8 +278,8 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & ! local variables real :: dt_pred ! The time step for the predictor part of the baroclinic time stepping. - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)) :: up ! Predicted zonal velocity [m s-1]. - real, dimension(SZI_(G),SZJB_(G),SZK_(G)) :: vp ! Predicted meridional velocity [m s-1]. + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)) :: up ! Predicted zonal velocity [L T-1 ~> m s-1]. + real, dimension(SZI_(G),SZJB_(G),SZK_(G)) :: vp ! Predicted meridional velocity [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: hp ! Predicted thickness [H ~> m or kg m-2]. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)) :: u_bc_accel @@ -344,8 +344,23 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & showCallTree = callTree_showQuery() if (showCallTree) call callTree_enter("step_MOM_dyn_split_RK2(), MOM_dynamics_split_RK2.F90") + !### This is temporary and will be deleted when the units of the input velocities have changed. + do k=1,GV%ke ; do j=G%jsd,G%jed ; do I=G%IsdB,G%IedB + u(I,j,k) = US%m_s_to_L_T*u(I,j,k) + enddo ; enddo ; enddo + do k=1,GV%ke ; do J=G%JsdB,G%JedB ; do i=G%isd,G%ied + v(i,J,k) = US%m_s_to_L_T*v(i,J,k) + enddo ; enddo ; enddo + !### Remove this later. + do k=1,GV%ke ; do j=G%jsd,G%jed ; do I=G%IsdB,G%IedB + u_av(I,j,k) = US%m_s_to_L_T * u_av(I,j,k) + enddo ; enddo ; enddo + do k=1,GV%ke ; do J=G%JsdB,G%JedB ; do i=G%isd,G%ied + v_av(i,J,k) = US%m_s_to_L_T * v_av(i,J,k) + enddo ; enddo ; enddo + !$OMP parallel do default(shared) - do k = 1, nz + do k=1,nz do j=G%jsd,G%jed ; do i=G%isdB,G%iedB ; up(i,j,k) = 0.0 ; enddo ; enddo do j=G%jsdB,G%jedB ; do i=G%isd,G%ied ; vp(i,j,k) = 0.0 ; enddo ; enddo do j=G%jsd,G%jed ; do i=G%isd,G%ied ; hp(i,j,k) = h(i,j,k) ; enddo ; enddo @@ -355,7 +370,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & call updateCFLtruncationValue(Time_local, CS%vertvisc_CSp) if (CS%debug) then - call MOM_state_chksum("Start predictor ", u, v, h, uh, vh, G, GV, US, symmetric=sym, vel_scale=1.0) + call MOM_state_chksum("Start predictor ", u, v, h, uh, vh, G, GV, US, symmetric=sym, vel_scale=US%L_T_to_m_s) call check_redundant("Start predictor u ", u, v, G) call check_redundant("Start predictor uh ", uh, vh, G) endif @@ -373,10 +388,10 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & if (CS%debug_OBC) call open_boundary_test_extern_h(G, CS%OBC, h) do k=1,nz ; do j=G%jsd,G%jed ; do I=G%IsdB,G%IedB - u_old_rad_OBC(I,j,k) = u_av(I,j,k) + u_old_rad_OBC(I,j,k) = US%L_T_to_m_s*u_av(I,j,k) enddo ; enddo ; enddo do k=1,nz ; do J=G%JsdB,G%JedB ; do i=G%isd,G%ied - v_old_rad_OBC(i,J,k) = v_av(i,J,k) + v_old_rad_OBC(i,J,k) = US%L_T_to_m_s*v_av(i,J,k) enddo ; enddo ; enddo endif @@ -439,7 +454,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & ! CAu = -(f+zeta_av)/h_av vh + d/dx KE_av call cpu_clock_begin(id_clock_Cor) - call CorAdCalc(US%m_s_to_L_T*u_av, US%m_s_to_L_T*v_av, h_av, uh, vh, CS%CAu, CS%CAv, CS%OBC, CS%ADp, & + call CorAdCalc(u_av, v_av, h_av, uh, vh, CS%CAu, CS%CAv, CS%OBC, CS%ADp, & G, Gv, US, CS%CoriolisAdv_CSp) call cpu_clock_end(id_clock_Cor) if (showCallTree) call callTree_wayPoint("done with CorAdCalc (step_MOM_dyn_split_RK2)") @@ -474,22 +489,22 @@ 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 - up(I,j,k) = G%mask2dCu(I,j) * (u(I,j,k) + dt * US%L_T_to_m_s*US%s_to_T*u_bc_accel(I,j,k)) + up(I,j,k) = G%mask2dCu(I,j) * (u(I,j,k) + US%s_to_T*dt * u_bc_accel(I,j,k)) enddo ; enddo do J=Jsq,Jeq ; do i=is,ie - vp(i,J,k) = G%mask2dCv(i,J) * (v(i,J,k) + dt * US%L_T_to_m_s*US%s_to_T*v_bc_accel(i,J,k)) + vp(i,J,k) = G%mask2dCv(i,J) * (v(i,J,k) + US%s_to_T*dt * v_bc_accel(i,J,k)) enddo ; enddo enddo call enable_averaging(dt, Time_local, CS%diag) - call set_viscous_ML(US%m_s_to_L_T*u, US%m_s_to_L_T*v, h, tv, forces, visc, dt, G, GV, US, & + call set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, & CS%set_visc_CSp) call disable_averaging(CS%diag) if (CS%debug) then call uvchksum("before vertvisc: up", up, vp, G%HI, haloshift=0, symmetric=sym) endif - call vertvisc_coef(US%m_s_to_L_T*up, US%m_s_to_L_T*vp, h, forces, visc, dt, G, GV, US, CS%vertvisc_CSp, CS%OBC) + 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, 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)") @@ -518,7 +533,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(US%m_s_to_L_T*u, US%m_s_to_L_T*v, h, hp, uh_in, vh_in, dt, G, GV, US, CS%continuity_CSp, & + 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) if (BT_cont_BT_thick) then @@ -533,8 +548,8 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & uh_ptr => uh_in; vh_ptr => vh_in call safe_alloc_ptr(u_ptr, G%IsdB,G%IedB,G%jsd,G%jed,G%ke) call safe_alloc_ptr(v_ptr, G%isd,G%ied,G%JsdB,G%JedB,G%ke) - u_ptr(:,:,:) = US%m_s_to_L_T*u(:,:,:) - v_ptr(:,:,:) = US%m_s_to_L_T*v(:,:,:) + u_ptr(:,:,:) = u(:,:,:) + v_ptr(:,:,:) = v(:,:,:) endif u_init => u ; v_init => v @@ -542,8 +557,8 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & if (calc_dtbt) call set_dtbt(G, GV, US, CS%barotropic_CSp, eta, CS%pbce) if (showCallTree) call callTree_enter("btstep(), MOM_barotropic.F90") ! This is the predictor step call to btstep. - call btstep(US%m_s_to_L_T*u, US%m_s_to_L_T*v, eta, dt, u_bc_accel, v_bc_accel, forces, CS%pbce, CS%eta_PF, & - US%m_s_to_L_T*u_av, US%m_s_to_L_T*v_av, CS%u_accel_bt, CS%v_accel_bt, eta_pred, CS%uhbt, CS%vhbt, & + call btstep(u, v, eta, dt, u_bc_accel, v_bc_accel, forces, CS%pbce, CS%eta_PF, & + u_av, v_av, CS%u_accel_bt, CS%v_accel_bt, eta_pred, CS%uhbt, CS%vhbt, & G, GV, US, CS%barotropic_CSp, CS%visc_rem_u, CS%visc_rem_v, & OBC=CS%OBC, BT_cont=CS%BT_cont, eta_PF_start=eta_PF_start, & taux_bot=taux_bot, tauy_bot=tauy_bot, & @@ -558,18 +573,18 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & !$OMP parallel do default(shared) do k=1,nz do J=Jsq,Jeq ; do i=is,ie - vp(i,J,k) = G%mask2dCv(i,J) * (v_init(i,J,k) + US%s_to_T*dt_pred * US%L_T_to_m_s* & + vp(i,J,k) = G%mask2dCv(i,J) * (v_init(i,J,k) + US%s_to_T*dt_pred * & (v_bc_accel(i,J,k) + CS%v_accel_bt(i,J,k))) enddo ; enddo do j=js,je ; do I=Isq,Ieq - up(I,j,k) = G%mask2dCu(I,j) * (u_init(I,j,k) + US%s_to_T*dt_pred * US%L_T_to_m_s* & + up(I,j,k) = G%mask2dCu(I,j) * (u_init(I,j,k) + US%s_to_T*dt_pred * & (u_bc_accel(I,j,k) + CS%u_accel_bt(I,j,k))) enddo ; enddo enddo call cpu_clock_end(id_clock_mom_update) if (CS%debug) then - call uvchksum("Predictor 1 [uv]", up, vp, G%HI, haloshift=0, symmetric=sym) + call uvchksum("Predictor 1 [uv]", up, vp, G%HI, haloshift=0, symmetric=sym, scale=US%L_T_to_m_s) call hchksum(h, "Predictor 1 h", G%HI, haloshift=1, scale=GV%H_to_m) call uvchksum("Predictor 1 [uv]h", uh, vh, G%HI,haloshift=2, & symmetric=sym, scale=GV%H_to_m*US%L_to_m**2*US%s_to_T) @@ -577,7 +592,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & call MOM_accel_chksum("Predictor accel", CS%CAu, CS%CAv, CS%PFu, CS%PFv, & 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, US, haloshift=2, & - symmetric=sym, vel_scale=1.0) + symmetric=sym, vel_scale=US%L_T_to_m_s) call check_redundant("Predictor 1 up", up, vp, G) call check_redundant("Predictor 1 uh", uh, vh, G) endif @@ -586,26 +601,12 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & ! u_av <- u_av + dt_pred d/dz visc d/dz u_av call cpu_clock_begin(id_clock_vertvisc) if (CS%debug) then - call uvchksum("0 before vertvisc: [uv]p", up, vp, G%HI,haloshift=0, symmetric=sym) + call uvchksum("0 before vertvisc: [uv]p", up, vp, G%HI,haloshift=0, symmetric=sym, scale=US%L_T_to_m_s) endif - call vertvisc_coef(US%m_s_to_L_T*up, US%m_s_to_L_T*vp, h, forces, visc, dt_pred, G, GV, US, CS%vertvisc_CSp, & + call vertvisc_coef(up, vp, h, forces, visc, dt_pred, G, GV, US, CS%vertvisc_CSp, & CS%OBC) - !### This is temporary and will be deleted when the units of the input velocities have changed. - do j=G%jsc,G%jec ; do k=1,nz ; do I=Isq,Ieq - up(I,j,k) = US%m_s_to_L_T*up(I,j,k) - enddo ; enddo ; enddo - do J=Jsq,Jeq ; do k=1,nz ; do i=is,ie - vp(i,J,k) = US%m_s_to_L_T*vp(i,J,k) - enddo ; enddo ; enddo call vertvisc(up, vp, h, forces, visc, dt_pred, CS%OBC, CS%ADp, CS%CDp, G, & GV, US, CS%vertvisc_CSp, CS%taux_bot, CS%tauy_bot, waves=waves) - !### This is temporary and will be deleted when the units of the input velocities have changed. - do j=G%jsc,G%jec ; do k=1,nz ; do I=Isq,Ieq - up(I,j,k) = US%L_T_to_m_s*up(I,j,k) - enddo ; enddo ; enddo - do J=Jsq,Jeq ; do k=1,nz ; do i=is,ie - vp(i,J,k) = US%L_T_to_m_s*vp(i,J,k) - enddo ; enddo ; enddo if (showCallTree) call callTree_wayPoint("done with vertvisc (step_MOM_dyn_split_RK2)") if (G%nonblocking_updates) then call cpu_clock_end(id_clock_vertvisc) @@ -625,16 +626,9 @@ 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(US%m_s_to_L_T*up, US%m_s_to_L_T*vp, h, hp, uh, vh, dt, G, GV, US, 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) - !### Remove this later. - do k=1,GV%ke ; do j=G%jsd,G%jed ; do I=G%IsdB,G%IedB - u_av(I,j,k) = US%L_T_to_m_s * u_av(I,j,k) - enddo ; enddo ; enddo - do k=1,GV%ke ; do J=G%JsdB,G%JedB ; do i=G%isd,G%ied - v_av(i,J,k) = US%L_T_to_m_s * v_av(i,J,k) - enddo ; enddo ; enddo call cpu_clock_end(id_clock_continuity) if (showCallTree) call callTree_wayPoint("done with continuity (step_MOM_dyn_split_RK2)") @@ -643,12 +637,26 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & if (associated(CS%OBC)) then if (CS%debug) & - call uvchksum("Pre OBC avg [uv]", u_av, v_av, G%HI, haloshift=1, symmetric=sym) + call uvchksum("Pre OBC avg [uv]", u_av, v_av, G%HI, haloshift=1, symmetric=sym, scale=US%L_T_to_m_s) + !### Remove this later. + do k=1,GV%ke ; do j=G%jsd,G%jed ; do I=G%IsdB,G%IedB + u_av(I,j,k) = US%L_T_to_m_s * u_av(I,j,k) + enddo ; enddo ; enddo + do k=1,GV%ke ; do J=G%JsdB,G%JedB ; do i=G%isd,G%ied + v_av(i,J,k) = US%L_T_to_m_s * v_av(i,J,k) + enddo ; enddo ; enddo call radiation_open_bdry_conds(CS%OBC, u_av, u_old_rad_OBC, v_av, v_old_rad_OBC, G, US, dt_pred) + !### Remove this later. + do k=1,GV%ke ; do j=G%jsd,G%jed ; do I=G%IsdB,G%IedB + u_av(I,j,k) = US%m_s_to_L_T * u_av(I,j,k) + enddo ; enddo ; enddo + do k=1,GV%ke ; do J=G%JsdB,G%JedB ; do i=G%isd,G%ied + v_av(i,J,k) = US%m_s_to_L_T * v_av(i,J,k) + enddo ; enddo ; enddo if (CS%debug) & - call uvchksum("Post OBC avg [uv]", u_av, v_av, G%HI, haloshift=1, symmetric=sym) + call uvchksum("Post OBC avg [uv]", u_av, v_av, G%HI, haloshift=1, symmetric=sym, scale=US%L_T_to_m_s) ! These should be done with a pass that excludes uh & vh. ! call do_group_pass(CS%pass_hp_uv, G%Domain, clock=id_clock_pass) @@ -703,7 +711,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & endif if (CS%debug) then - call MOM_state_chksum("Predictor ", up, vp, hp, uh, vh, G, GV, US, symmetric=sym, vel_scale=1.0) + call MOM_state_chksum("Predictor ", up, vp, hp, uh, vh, G, GV, US, symmetric=sym, vel_scale=US%L_T_to_m_s) call uvchksum("Predictor avg [uv]", u_av, v_av, G%HI, haloshift=1, symmetric=sym) call hchksum(h_av, "Predictor avg h", G%HI, haloshift=0, scale=GV%H_to_m) ! call MOM_state_chksum("Predictor avg ", u_av, v_av, h_av, uh, vh, G, GV, US, vel_scale=1.0) @@ -713,7 +721,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & ! diffu = horizontal viscosity terms (u_av) call cpu_clock_begin(id_clock_horvisc) - call horizontal_viscosity(US%m_s_to_L_T*u_av, US%m_s_to_L_T*v_av, h_av, CS%diffu, CS%diffv, & + call horizontal_viscosity(u_av, v_av, h_av, CS%diffu, CS%diffv, & MEKE, Varmix, G, GV, US, CS%hor_visc_CSp, & OBC=CS%OBC, BT=CS%barotropic_CSp) call cpu_clock_end(id_clock_horvisc) @@ -721,7 +729,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & ! CAu = -(f+zeta_av)/h_av vh + d/dx KE_av call cpu_clock_begin(id_clock_Cor) - call CorAdCalc(US%m_s_to_L_T*u_av, US%m_s_to_L_T*v_av, h_av, uh, vh, CS%CAu, CS%CAv, CS%OBC, CS%ADp, & + call CorAdCalc(u_av, v_av, h_av, uh, vh, CS%CAu, CS%CAv, CS%OBC, CS%ADp, & G, GV, US, CS%CoriolisAdv_CSp) call cpu_clock_end(id_clock_Cor) if (showCallTree) call callTree_wayPoint("done with CorAdCalc (step_MOM_dyn_split_RK2)") @@ -759,14 +767,14 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & call cpu_clock_begin(id_clock_btstep) if (CS%BT_use_layer_fluxes) then uh_ptr => uh ; vh_ptr => vh ! ; u_ptr => u_av ; v_ptr => v_av - u_ptr(:,:,:) = US%m_s_to_L_T*u_av(:,:,:) - v_ptr(:,:,:) = US%m_s_to_L_T*v_av(:,:,:) + u_ptr(:,:,:) = u_av(:,:,:) + v_ptr(:,:,:) = v_av(:,:,:) endif if (showCallTree) call callTree_enter("btstep(), MOM_barotropic.F90") ! This is the corrector step call to btstep. - call btstep(US%m_s_to_L_T*u, US%m_s_to_L_T*v, eta, dt, u_bc_accel, v_bc_accel, forces, CS%pbce, & - CS%eta_PF, US%m_s_to_L_T*u_av, US%m_s_to_L_T*v_av, CS%u_accel_bt, CS%v_accel_bt, & + call btstep(u, v, eta, dt, u_bc_accel, v_bc_accel, forces, CS%pbce, & + CS%eta_PF, u_av, v_av, CS%u_accel_bt, CS%v_accel_bt, & eta_pred, CS%uhbt, CS%vhbt, G, GV, US, CS%barotropic_CSp, & CS%visc_rem_u, CS%visc_rem_v, etaav=eta_av, OBC=CS%OBC, & BT_cont = CS%BT_cont, eta_PF_start=eta_PF_start, & @@ -789,18 +797,18 @@ 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(I,j,k) = G%mask2dCu(I,j) * (u_init(I,j,k) + US%s_to_T*dt * US%L_T_to_m_s* & + u(I,j,k) = G%mask2dCu(I,j) * (u_init(I,j,k) + US%s_to_T*dt * & (u_bc_accel(I,j,k) + CS%u_accel_bt(I,j,k))) enddo ; enddo do J=Jsq,Jeq ; do i=is,ie - v(i,J,k) = G%mask2dCv(i,J) * (v_init(i,J,k) + US%s_to_T*dt * US%L_T_to_m_s* & + v(i,J,k) = G%mask2dCv(i,J) * (v_init(i,J,k) + US%s_to_T*dt * & (v_bc_accel(i,J,k) + CS%v_accel_bt(i,J,k))) enddo ; enddo enddo call cpu_clock_end(id_clock_mom_update) if (CS%debug) then - call uvchksum("Corrector 1 [uv]", u, v, G%HI,haloshift=0, symmetric=sym) + call uvchksum("Corrector 1 [uv]", u, v, G%HI,haloshift=0, symmetric=sym, scale=US%L_T_to_m_s) call hchksum(h, "Corrector 1 h", G%HI, haloshift=2, scale=GV%H_to_m) call uvchksum("Corrector 1 [uv]h", uh, vh, G%HI, haloshift=2, & symmetric=sym, scale=GV%H_to_m*US%L_to_m**2*US%s_to_T) @@ -813,23 +821,9 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & ! u <- u + dt d/dz visc d/dz u ! u_av <- u_av + dt d/dz visc d/dz u_av call cpu_clock_begin(id_clock_vertvisc) - call vertvisc_coef(US%m_s_to_L_T*u, US%m_s_to_L_T*v, h, forces, visc, dt, G, GV, US, CS%vertvisc_CSp, CS%OBC) - !### This is temporary and will be deleted when the units of the input velocities have changed. - do j=G%jsc,G%jec ; do k=1,nz ; do I=Isq,Ieq - u(I,j,k) = US%m_s_to_L_T*u(I,j,k) - enddo ; enddo ; enddo - do J=Jsq,Jeq ; do k=1,nz ; do i=is,ie - v(i,J,k) = US%m_s_to_L_T*v(i,J,k) - enddo ; enddo ; enddo + call vertvisc_coef(u, v, h, forces, visc, dt, G, GV, US, CS%vertvisc_CSp, CS%OBC) call vertvisc(u, v, h, forces, visc, dt, CS%OBC, CS%ADp, CS%CDp, G, GV, US, & CS%vertvisc_CSp, CS%taux_bot, CS%tauy_bot,waves=waves) - !### This is temporary and will be deleted when the units of the input velocities have changed. - do j=G%jsc,G%jec ; do k=1,nz ; do I=Isq,Ieq - u(I,j,k) = US%L_T_to_m_s*u(I,j,k) - enddo ; enddo ; enddo - do J=Jsq,Jeq ; do k=1,nz ; do i=is,ie - v(i,J,k) = US%L_T_to_m_s*v(i,J,k) - enddo ; enddo ; enddo if (G%nonblocking_updates) then call cpu_clock_end(id_clock_vertvisc) call start_group_pass(CS%pass_uv, G%Domain, clock=id_clock_pass) @@ -856,15 +850,8 @@ 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(US%m_s_to_L_T*u, US%m_s_to_L_T*v, h, h, uh, vh, dt, G, GV, US, CS%continuity_CSp, & + 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) - !### Remove this later. - do k=1,GV%ke ; do j=G%jsd,G%jed ; do I=G%IsdB,G%IedB - u_av(I,j,k) = US%L_T_to_m_s * u_av(I,j,k) - enddo ; enddo ; enddo - do k=1,GV%ke ; do J=G%JsdB,G%JedB ; do i=G%isd,G%ied - v_av(i,J,k) = US%L_T_to_m_s * v_av(i,J,k) - enddo ; enddo ; enddo call cpu_clock_end(id_clock_continuity) call do_group_pass(CS%pass_h, G%Domain, clock=id_clock_pass) ! Whenever thickness changes let the diag manager know, target grids @@ -879,7 +866,21 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & endif if (associated(CS%OBC)) then + !### This is temporary and will be deleted when the units of the input velocities have changed. + do k=1,GV%ke ; do j=G%jsd,G%jed ; do I=G%IsdB,G%IedB + u(I,j,k) = US%L_T_to_m_s*u(I,j,k) + enddo ; enddo ; enddo + do k=1,GV%ke ; do J=G%JsdB,G%JedB ; do i=G%isd,G%ied + v(i,J,k) = US%L_T_to_m_s*v(i,J,k) + enddo ; enddo ; enddo call radiation_open_bdry_conds(CS%OBC, u, u_old_rad_OBC, v, v_old_rad_OBC, G, US, dt) + !### This is temporary and will be deleted when the units of the input velocities have changed. + do k=1,GV%ke ; do j=G%jsd,G%jed ; do I=G%IsdB,G%IedB + u(I,j,k) = US%m_s_to_L_T*u(I,j,k) + enddo ; enddo ; enddo + do k=1,GV%ke ; do J=G%JsdB,G%JedB ; do i=G%isd,G%ied + v(i,J,k) = US%m_s_to_L_T*v(i,J,k) + enddo ; enddo ; enddo endif ! h_av = (h_in + h_out)/2 . Going in to this line, h_av = h_in. @@ -901,6 +902,21 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & enddo ; enddo enddo + !### Remove this later. + !### This is temporary and will be deleted when the units of the input velocities have changed. + do k=1,GV%ke ; do j=G%jsd,G%jed ; do I=G%IsdB,G%IedB + u(I,j,k) = US%L_T_to_m_s*u(I,j,k) + enddo ; enddo ; enddo + do k=1,GV%ke ; do J=G%JsdB,G%JedB ; do i=G%isd,G%ied + v(i,J,k) = US%L_T_to_m_s*v(i,J,k) + enddo ; enddo ; enddo + do k=1,GV%ke ; do j=G%jsd,G%jed ; do I=G%IsdB,G%IedB + u_av(I,j,k) = US%L_T_to_m_s * u_av(I,j,k) + enddo ; enddo ; enddo + do k=1,GV%ke ; do J=G%JsdB,G%JedB ; do i=G%isd,G%ied + v_av(i,J,k) = US%L_T_to_m_s * v_av(i,J,k) + enddo ; enddo ; enddo + ! The time-averaged free surface height has already been set by the last ! call to btstep. diff --git a/src/core/MOM_dynamics_unsplit.F90 b/src/core/MOM_dynamics_unsplit.F90 index 611319c706..d51ab1b526 100644 --- a/src/core/MOM_dynamics_unsplit.F90 +++ b/src/core/MOM_dynamics_unsplit.F90 @@ -222,9 +222,9 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & !! fields related to the surface wave conditions ! Local variables - real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: h_av, hp - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)) :: up, upp - real, dimension(SZI_(G),SZJB_(G),SZK_(G)) :: vp, vpp + real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: h_av, hp ! Prediced or averaged layer thicknesses [H ~> m or kg m-2] + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)) :: up, upp ! Predicted zonal velocities [L T-1 ~> m s-1] + real, dimension(SZI_(G),SZJB_(G),SZK_(G)) :: vp, vpp ! Predicted meridional velocities [L T-1 ~> m s-1] real, dimension(:,:), pointer :: p_surf => NULL() real :: dt_pred ! The time step for the predictor part of the baroclinic ! time stepping. @@ -234,6 +234,14 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB dt_pred = dt / 3.0 + !### This is temporary and will be deleted when the units of the input velocities have changed. + do k=1,GV%ke ; do j=G%jsd,G%jed ; do I=G%IsdB,G%IedB + u(I,j,k) = US%m_s_to_L_T*u(I,j,k) + enddo ; enddo ; enddo + do k=1,GV%ke ; do J=G%JsdB,G%JedB ; do i=G%isd,G%ied + v(i,J,k) = US%m_s_to_L_T*v(i,J,k) + enddo ; enddo ; enddo + h_av(:,:,:) = 0; hp(:,:,:) = 0 up(:,:,:) = 0; upp(:,:,:) = 0 vp(:,:,:) = 0; vpp(:,:,:) = 0 @@ -249,13 +257,13 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & ! all of the fields except h. h is stepped separately. if (CS%debug) then - call MOM_state_chksum("Start First Predictor ", u, v, h, uh, vh, G, GV, US, vel_scale=1.0) + call MOM_state_chksum("Start First Predictor ", u, v, h, uh, vh, G, GV, US, vel_scale=US%L_T_to_m_s) endif ! diffu = horizontal viscosity terms (u,h) call enable_averaging(dt,Time_local, CS%diag) call cpu_clock_begin(id_clock_horvisc) - call horizontal_viscosity(US%m_s_to_L_T*u, US%m_s_to_L_T*v, h, CS%diffu, CS%diffv, MEKE, Varmix, & + call horizontal_viscosity(u, v, h, CS%diffu, CS%diffv, MEKE, Varmix, & G, GV, US, CS%hor_visc_CSp) call cpu_clock_end(id_clock_horvisc) call disable_averaging(CS%diag) @@ -263,7 +271,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(US%m_s_to_L_T*u, US%m_s_to_L_T*v, h, hp, uh, vh, dt*0.5, G, GV, US, CS%continuity_CSp, OBC=CS%OBC) + 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) call pass_vector(uh, vh, G%Domain, clock=id_clock_pass) @@ -282,10 +290,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) + US%s_to_T*dt * US%L_T_to_m_s*CS%diffu(I,j,k) * G%mask2dCu(I,j) + u(I,j,k) = u(I,j,k) + US%s_to_T*dt * 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) + US%s_to_T*dt * US%L_T_to_m_s*CS%diffv(i,J,k) * G%mask2dCv(i,J) + v(i,J,k) = v(i,J,k) + US%s_to_T*dt * 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*US%s_to_T*dt*uh(i,j,k) @@ -299,7 +307,7 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & ! CAu = -(f+zeta)/h_av vh + d/dx KE call cpu_clock_begin(id_clock_Cor) - call CorAdCalc(US%m_s_to_L_T*u, US%m_s_to_L_T*v, h_av, uh, vh, CS%CAu, CS%CAv, CS%OBC, CS%ADp, & + call CorAdCalc(u, v, h_av, uh, vh, CS%CAu, CS%CAv, CS%OBC, CS%ADp, & G, GV, US, CS%CoriolisAdv_CSp) call cpu_clock_end(id_clock_Cor) @@ -323,17 +331,17 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & ! up = u + dt_pred * (PFu + CAu) 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(I,j,k) + dt_pred * & - US%L_T2_to_m_s2*(CS%PFu(I,j,k) + CS%CAu(I,j,k))) + up(I,j,k) = G%mask2dCu(I,j) * (u(I,j,k) + US%s_to_T*dt_pred * & + (CS%PFu(I,j,k) + CS%CAu(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(i,J,k) + dt_pred * & - US%L_T2_to_m_s2*(CS%PFv(i,J,k) + CS%CAv(i,J,k))) + vp(i,J,k) = G%mask2dCv(i,J) * (v(i,J,k) + US%s_to_T*dt_pred * & + (CS%PFv(i,J,k) + CS%CAv(i,J,k))) enddo ; enddo ; enddo call cpu_clock_end(id_clock_mom_update) if (CS%debug) then - call MOM_state_chksum("Predictor 1", up, vp, h_av, uh, vh, G, GV, US, vel_scale=1.0) + call MOM_state_chksum("Predictor 1", up, vp, h_av, uh, vh, G, GV, US, vel_scale=US%L_T_to_m_s) call MOM_accel_chksum("Predictor 1 accel", CS%CAu, CS%CAv, CS%PFu, CS%PFv,& CS%diffu, CS%diffv, G, GV, US) endif @@ -341,34 +349,20 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & ! up <- up + dt/2 d/dz visc d/dz up call cpu_clock_begin(id_clock_vertvisc) call enable_averaging(dt, Time_local, CS%diag) - call set_viscous_ML(US%m_s_to_L_T*u, US%m_s_to_L_T*v, h_av, tv, forces, visc, dt*0.5, G, GV, US, & + call set_viscous_ML(u, v, h_av, tv, forces, visc, dt*0.5, G, GV, US, & CS%set_visc_CSp) call disable_averaging(CS%diag) - call vertvisc_coef(US%m_s_to_L_T*up, US%m_s_to_L_T*vp, h_av, forces, visc, dt*0.5, G, GV, US, & + call vertvisc_coef(up, vp, h_av, forces, visc, dt*0.5, G, GV, US, & CS%vertvisc_CSp, CS%OBC) - !### This is temporary and will be deleted when the units of the input velocities have changed. - do j=G%jsc,G%jec ; do k=1,nz ; do I=Isq,Ieq - up(I,j,k) = US%m_s_to_L_T*up(I,j,k) - enddo ; enddo ; enddo - do J=Jsq,Jeq ; do k=1,nz ; do i=is,ie - vp(i,J,k) = US%m_s_to_L_T*vp(i,J,k) - enddo ; enddo ; enddo call vertvisc(up, vp, h_av, forces, visc, dt*0.5, CS%OBC, CS%ADp, CS%CDp, & G, GV, US, CS%vertvisc_CSp, Waves=Waves) - !### This is temporary and will be deleted when the units of the input velocities have changed. - do j=G%jsc,G%jec ; do k=1,nz ; do I=Isq,Ieq - up(I,j,k) = US%L_T_to_m_s*up(I,j,k) - enddo ; enddo ; enddo - do J=Jsq,Jeq ; do k=1,nz ; do i=is,ie - vp(i,J,k) = US%L_T_to_m_s*vp(i,J,k) - enddo ; enddo ; enddo call cpu_clock_end(id_clock_vertvisc) call pass_vector(up, vp, G%Domain, clock=id_clock_pass) ! uh = up * hp ! h_av = hp + dt/2 div . uh call cpu_clock_begin(id_clock_continuity) - call continuity(US%m_s_to_L_T*up, US%m_s_to_L_T*vp, hp, h_av, uh, vh, (0.5*dt), G, GV, US, & + call continuity(up, vp, hp, h_av, uh, vh, (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) @@ -381,7 +375,7 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & ! CAu = -(f+zeta(up))/h_av vh + d/dx KE(up) call cpu_clock_begin(id_clock_Cor) - call CorAdCalc(US%m_s_to_L_T*up, US%m_s_to_L_T*vp, h_av, uh, vh, CS%CAu, CS%CAv, CS%OBC, CS%ADp, & + call CorAdCalc(up, vp, h_av, uh, vh, CS%CAu, CS%CAv, CS%OBC, CS%ADp, & G, GV, US, CS%CoriolisAdv_CSp) call cpu_clock_end(id_clock_Cor) @@ -405,48 +399,34 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & ! upp = u + dt/2 * ( PFu + CAu ) call cpu_clock_begin(id_clock_mom_update) do k=1,nz ; do j=js,je ; do I=Isq,Ieq - upp(I,j,k) = G%mask2dCu(I,j) * (u(I,j,k) + dt * 0.5 * & - US%L_T2_to_m_s2*(CS%PFu(I,j,k) + CS%CAu(I,j,k))) + upp(I,j,k) = G%mask2dCu(I,j) * (u(I,j,k) + US%s_to_T*dt * 0.5 * & + (CS%PFu(I,j,k) + CS%CAu(I,j,k))) enddo ; enddo ; enddo do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie - vpp(i,J,k) = G%mask2dCv(i,J) * (v(i,J,k) + dt * 0.5 * & - US%L_T2_to_m_s2*(CS%PFv(i,J,k) + CS%CAv(i,J,k))) + vpp(i,J,k) = G%mask2dCv(i,J) * (v(i,J,k) + US%s_to_T*dt * 0.5 * & + (CS%PFv(i,J,k) + CS%CAv(i,J,k))) enddo ; enddo ; enddo call cpu_clock_end(id_clock_mom_update) if (CS%debug) then - call MOM_state_chksum("Predictor 2", upp, vpp, h_av, uh, vh, G, GV, US, vel_scale=1.0) + call MOM_state_chksum("Predictor 2", upp, vpp, h_av, uh, vh, G, GV, US, vel_scale=US%L_T_to_m_s) call MOM_accel_chksum("Predictor 2 accel", CS%CAu, CS%CAv, CS%PFu, CS%PFv,& CS%diffu, CS%diffv, G, GV, US) endif ! upp <- upp + dt/2 d/dz visc d/dz upp call cpu_clock_begin(id_clock_vertvisc) - call vertvisc_coef(US%m_s_to_L_T*upp, US%m_s_to_L_T*vpp, hp, forces, visc, dt*0.5, G, GV, US, & + call vertvisc_coef(upp, vpp, hp, forces, visc, dt*0.5, G, GV, US, & CS%vertvisc_CSp, CS%OBC) - !### This is temporary and will be deleted when the units of the input velocities have changed. - do j=G%jsc,G%jec ; do k=1,nz ; do I=Isq,Ieq - upp(I,j,k) = US%m_s_to_L_T*upp(I,j,k) - enddo ; enddo ; enddo - do J=Jsq,Jeq ; do k=1,nz ; do i=is,ie - vpp(i,J,k) = US%m_s_to_L_T*vpp(i,J,k) - enddo ; enddo ; enddo call vertvisc(upp, vpp, hp, forces, visc, dt*0.5, CS%OBC, CS%ADp, CS%CDp, & G, GV, US, CS%vertvisc_CSp, Waves=Waves) - !### This is temporary and will be deleted when the units of the input velocities have changed. - do j=G%jsc,G%jec ; do k=1,nz ; do I=Isq,Ieq - upp(I,j,k) = US%L_T_to_m_s*upp(I,j,k) - enddo ; enddo ; enddo - do J=Jsq,Jeq ; do k=1,nz ; do i=is,ie - vpp(i,J,k) = US%L_T_to_m_s*vpp(i,J,k) - enddo ; enddo ; enddo call cpu_clock_end(id_clock_vertvisc) call pass_vector(upp, vpp, G%Domain, clock=id_clock_pass) ! uh = upp * hp ! h = hp + dt/2 div . uh call cpu_clock_begin(id_clock_continuity) - call continuity(US%m_s_to_L_T*upp, US%m_s_to_L_T*vpp, hp, h, uh, vh, (dt*0.5), G, GV, US, & + call continuity(upp, vpp, hp, h, uh, vh, (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) @@ -477,7 +457,7 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & ! CAu = -(f+zeta(upp))/h_av vh + d/dx KE(upp) call cpu_clock_begin(id_clock_Cor) - call CorAdCalc(US%m_s_to_L_T*upp, US%m_s_to_L_T*vpp, h_av, uh, vh, CS%CAu, CS%CAv, CS%OBC, CS%ADp, & + call CorAdCalc(upp, vpp, h_av, uh, vh, CS%CAu, CS%CAv, CS%OBC, CS%ADp, & G, GV, US, CS%CoriolisAdv_CSp) call cpu_clock_end(id_clock_Cor) @@ -497,38 +477,24 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & call open_boundary_zero_normal_flow(CS%OBC, G, CS%CAu, CS%CAv) endif do k=1,nz ; do j=js,je ; do I=Isq,Ieq - u(I,j,k) = G%mask2dCu(I,j) * (u(I,j,k) + dt * & - US%L_T2_to_m_s2*(CS%PFu(I,j,k) + CS%CAu(I,j,k))) + u(I,j,k) = G%mask2dCu(I,j) * (u(I,j,k) + US%s_to_T*dt * & + (CS%PFu(I,j,k) + CS%CAu(I,j,k))) enddo ; enddo ; enddo do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie - v(i,J,k) = G%mask2dCv(i,J) * (v(i,J,k) + dt * & - US%L_T2_to_m_s2*(CS%PFv(i,J,k) + CS%CAv(i,J,k))) + v(i,J,k) = G%mask2dCv(i,J) * (v(i,J,k) + US%s_to_T*dt * & + (CS%PFv(i,J,k) + CS%CAv(i,J,k))) enddo ; enddo ; enddo ! u <- u + dt d/dz visc d/dz u call cpu_clock_begin(id_clock_vertvisc) - call vertvisc_coef(US%m_s_to_L_T*u, US%m_s_to_L_T*v, h_av, forces, visc, dt, G, GV, US, CS%vertvisc_CSp, CS%OBC) - !### This is temporary and will be deleted when the units of the input velocities have changed. - do j=G%jsc,G%jec ; do k=1,nz ; do I=Isq,Ieq - u(I,j,k) = US%m_s_to_L_T*u(I,j,k) - enddo ; enddo ; enddo - do J=Jsq,Jeq ; do k=1,nz ; do i=is,ie - v(i,J,k) = US%m_s_to_L_T*v(i,J,k) - enddo ; enddo ; enddo + call vertvisc_coef(u, v, h_av, forces, visc, dt, G, GV, US, CS%vertvisc_CSp, CS%OBC) call vertvisc(u, v, h_av, forces, visc, dt, CS%OBC, CS%ADp, CS%CDp, & G, GV, US, CS%vertvisc_CSp, CS%taux_bot, CS%tauy_bot, Waves=Waves) - !### This is temporary and will be deleted when the units of the input velocities have changed. - do j=G%jsc,G%jec ; do k=1,nz ; do I=Isq,Ieq - u(I,j,k) = US%L_T_to_m_s*u(I,j,k) - enddo ; enddo ; enddo - do J=Jsq,Jeq ; do k=1,nz ; do i=is,ie - v(i,J,k) = US%L_T_to_m_s*v(i,J,k) - enddo ; enddo ; enddo call cpu_clock_end(id_clock_vertvisc) call pass_vector(u, v, G%Domain, clock=id_clock_pass) if (CS%debug) then - call MOM_state_chksum("Corrector", u, v, h, uh, vh, G, GV, US, vel_scale=1.0) + call MOM_state_chksum("Corrector", u, v, h, uh, vh, G, GV, US, vel_scale=US%L_T_to_m_s) call MOM_accel_chksum("Corrector accel", CS%CAu, CS%CAv, CS%PFu, CS%PFv, & CS%diffu, CS%diffv, G, GV, US) endif @@ -544,6 +510,14 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & if (dyn_p_surf) deallocate(p_surf) + !### This is temporary and will be deleted when the units of the input velocities have changed. + do k=1,GV%ke ; do j=G%jsd,G%jed ; do I=G%IsdB,G%IedB + u(I,j,k) = US%L_T_to_m_s*u(I,j,k) + enddo ; enddo ; enddo + do k=1,GV%ke ; do J=G%JsdB,G%JedB ; do i=G%isd,G%ied + v(i,J,k) = US%L_T_to_m_s*v(i,J,k) + enddo ; enddo ; enddo + ! Here various terms used in to update the momentum equations are ! offered for averaging. if (CS%id_PFu > 0) call post_data(CS%id_PFu, CS%PFu, CS%diag) diff --git a/src/core/MOM_dynamics_unsplit_RK2.F90 b/src/core/MOM_dynamics_unsplit_RK2.F90 index ddbdc84364..d80b786a8a 100644 --- a/src/core/MOM_dynamics_unsplit_RK2.F90 +++ b/src/core/MOM_dynamics_unsplit_RK2.F90 @@ -234,8 +234,8 @@ subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt, !! Eddy Kinetic Energy. ! Local variables real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: h_av, hp - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)) :: up - real, dimension(SZI_(G),SZJB_(G),SZK_(G)) :: vp + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)) :: up ! Predicted zonal velocities [L T-1 ~> m s-1] + real, dimension(SZI_(G),SZJB_(G),SZK_(G)) :: vp ! Predicted meridional velocities [L T-1 ~> m s-1] real, dimension(:,:), pointer :: p_surf => NULL() real :: dt_pred ! The time step for the predictor part of the baroclinic ! time stepping. @@ -245,6 +245,14 @@ subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt, Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB dt_pred = dt * CS%BE + !### This is temporary and will be deleted when the units of the input velocities have changed. + do k=1,GV%ke ; do j=G%jsd,G%jed ; do I=G%IsdB,G%IedB + u_in(I,j,k) = US%m_s_to_L_T*u_in(I,j,k) + enddo ; enddo ; enddo + do k=1,GV%ke ; do J=G%JsdB,G%JedB ; do i=G%isd,G%ied + v_in(i,J,k) = US%m_s_to_L_T*v_in(i,J,k) + enddo ; enddo ; enddo + h_av(:,:,:) = 0; hp(:,:,:) = 0 up(:,:,:) = 0 vp(:,:,:) = 0 @@ -260,13 +268,13 @@ subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt, ! all of the fields except h. h is stepped separately. if (CS%debug) then - call MOM_state_chksum("Start Predictor ", u_in, v_in, h_in, uh, vh, G, GV, US, vel_scale=1.0) + call MOM_state_chksum("Start Predictor ", u_in, v_in, h_in, uh, vh, G, GV, US, vel_scale=US%L_T_to_m_s) endif ! diffu = horizontal viscosity terms (u,h) call enable_averaging(dt,Time_local, CS%diag) call cpu_clock_begin(id_clock_horvisc) - call horizontal_viscosity(US%m_s_to_L_T*u_in, US%m_s_to_L_T*v_in, h_in, CS%diffu, CS%diffv, MEKE, VarMix, & + call horizontal_viscosity(u_in, v_in, h_in, CS%diffu, CS%diffv, MEKE, VarMix, & G, GV, US, CS%hor_visc_CSp) call cpu_clock_end(id_clock_horvisc) call disable_averaging(CS%diag) @@ -279,7 +287,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(US%m_s_to_L_T*u_in, US%m_s_to_L_T*v_in, h_in, hp, uh, vh, dt_pred, G, GV, US, & + 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) @@ -295,7 +303,7 @@ subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt, ! CAu = -(f+zeta)/h_av vh + d/dx KE (function of u[n-1] and uh[n-1]) call cpu_clock_begin(id_clock_Cor) - call CorAdCalc(US%m_s_to_L_T*u_in, US%m_s_to_L_T*v_in, h_av, uh, vh, CS%CAu, CS%CAv, CS%OBC, CS%ADp, & + call CorAdCalc(u_in, v_in, h_av, uh, vh, CS%CAu, CS%CAv, CS%OBC, CS%ADp, & G, GV, US, CS%CoriolisAdv_CSp) call cpu_clock_end(id_clock_Cor) @@ -322,11 +330,11 @@ subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt, ! up+[n-1/2] = u[n-1] + dt_pred * (PFu + CAu) 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) + US%L_T_to_m_s * US%s_to_T*dt_pred * & + up(I,j,k) = G%mask2dCu(I,j) * (u_in(I,j,k) + US%s_to_T*dt_pred * & ((CS%PFu(I,j,k) + CS%CAu(I,j,k)) + 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) + US%L_T_to_m_s * US%s_to_T*dt_pred * & + vp(i,J,k) = G%mask2dCv(i,J) * (v_in(i,J,k) + US%s_to_T*dt_pred * & ((CS%PFv(i,J,k) + CS%CAv(i,J,k)) + CS%diffv(i,J,k))) enddo ; enddo ; enddo call cpu_clock_end(id_clock_mom_update) @@ -338,34 +346,20 @@ subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt, ! 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) call enable_averaging(dt, Time_local, CS%diag) - call set_viscous_ML(US%m_s_to_L_T*up, US%m_s_to_L_T*vp, h_av, tv, forces, visc, dt_pred, G, GV, US, & + call set_viscous_ML(up, vp, h_av, tv, forces, visc, dt_pred, G, GV, US, & CS%set_visc_CSp) call disable_averaging(CS%diag) - call vertvisc_coef(US%m_s_to_L_T*up, US%m_s_to_L_T*vp, h_av, forces, visc, dt_pred, G, GV, US, & + call vertvisc_coef(up, vp, h_av, forces, visc, dt_pred, G, GV, US, & CS%vertvisc_CSp, CS%OBC) - !### This is temporary and will be deleted when the units of the input velocities have changed. - do j=G%jsc,G%jec ; do k=1,nz ; do I=Isq,Ieq - up(I,j,k) = US%m_s_to_L_T*up(I,j,k) - enddo ; enddo ; enddo - do J=Jsq,Jeq ; do k=1,nz ; do i=is,ie - vp(i,J,k) = US%m_s_to_L_T*vp(i,J,k) - enddo ; enddo ; enddo call vertvisc(up, vp, h_av, forces, visc, dt_pred, CS%OBC, CS%ADp, CS%CDp, & G, GV, US, CS%vertvisc_CSp) - !### This is temporary and will be deleted when the units of the input velocities have changed. - do j=G%jsc,G%jec ; do k=1,nz ; do I=Isq,Ieq - up(I,j,k) = US%L_T_to_m_s*up(I,j,k) - enddo ; enddo ; enddo - do J=Jsq,Jeq ; do k=1,nz ; do i=is,ie - vp(i,J,k) = US%L_T_to_m_s*vp(i,J,k) - enddo ; enddo ; enddo call cpu_clock_end(id_clock_vertvisc) call pass_vector(up, vp, G%Domain, clock=id_clock_pass) ! uh = up[n-1/2] * h[n-1/2] ! h_av = h + dt div . uh call cpu_clock_begin(id_clock_continuity) - call continuity(US%m_s_to_L_T*up, US%m_s_to_L_T*vp, h_in, hp, uh, vh, dt, G, GV, US, CS%continuity_CSp, OBC=CS%OBC) + call continuity(up, vp, h_in, hp, uh, vh, 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) @@ -376,11 +370,11 @@ subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt, enddo ; enddo ; enddo if (CS%debug) & - call MOM_state_chksum("Predictor 1", up, vp, h_av, uh, vh, G, GV, US, vel_scale=1.0) + call MOM_state_chksum("Predictor 1", up, vp, h_av, uh, vh, G, GV, US, vel_scale=US%L_T_to_m_s) ! CAu = -(f+zeta(up))/h_av vh + d/dx KE(up) (function of up[n-1/2], h[n-1/2]) call cpu_clock_begin(id_clock_Cor) - call CorAdCalc(US%m_s_to_L_T*up, US%m_s_to_L_T*vp, h_av, uh, vh, CS%CAu, CS%CAv, CS%OBC, CS%ADp, & + call CorAdCalc(up, vp, h_av, uh, vh, CS%CAu, CS%CAv, CS%OBC, CS%ADp, & G, GV, US, CS%CoriolisAdv_CSp) call cpu_clock_end(id_clock_Cor) if (associated(CS%OBC)) then @@ -392,57 +386,29 @@ subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt, ! up* = u[n] + (1+gamma) * dt * ( PFu + CAu ) Extrapolated for damping ! 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) + US%L_T_to_m_s * US%s_to_T*dt * (1.+CS%begw) * & + up(I,j,k) = G%mask2dCu(I,j) * (u_in(I,j,k) + US%s_to_T*dt * (1.+CS%begw) * & ((CS%PFu(I,j,k) + CS%CAu(I,j,k)) + CS%diffu(I,j,k))) - u_in(I,j,k) = G%mask2dCu(I,j) * (u_in(I,j,k) + US%L_T_to_m_s * US%s_to_T*dt * & + u_in(I,j,k) = G%mask2dCu(I,j) * (u_in(I,j,k) + US%s_to_T*dt * & ((CS%PFu(I,j,k) + CS%CAu(I,j,k)) + 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) + US%L_T_to_m_s * US%s_to_T*dt * (1.+CS%begw) * & + vp(i,J,k) = G%mask2dCv(i,J) * (v_in(i,J,k) + US%s_to_T*dt * (1.+CS%begw) * & ((CS%PFv(i,J,k) + CS%CAv(i,J,k)) + CS%diffv(i,J,k))) - v_in(i,J,k) = G%mask2dCv(i,J) * (v_in(i,J,k) + US%L_T_to_m_s * US%s_to_T*dt * & + v_in(i,J,k) = G%mask2dCv(i,J) * (v_in(i,J,k) + US%s_to_T*dt * & ((CS%PFv(i,J,k) + CS%CAv(i,J,k)) + CS%diffv(i,J,k))) enddo ; enddo ; enddo ! up[n] <- up* + dt d/dz visc d/dz up ! u[n] <- u*[n] + dt d/dz visc d/dz u[n] call cpu_clock_begin(id_clock_vertvisc) - call vertvisc_coef(US%m_s_to_L_T*up, US%m_s_to_L_T*vp, h_av, forces, visc, dt, G, GV, US, & + call vertvisc_coef(up, vp, h_av, forces, visc, dt, G, GV, US, & CS%vertvisc_CSp, CS%OBC) - !### This is temporary and will be deleted when the units of the input velocities have changed. - do j=G%jsc,G%jec ; do k=1,nz ; do I=Isq,Ieq - up(I,j,k) = US%m_s_to_L_T*up(I,j,k) - enddo ; enddo ; enddo - do J=Jsq,Jeq ; do k=1,nz ; do i=is,ie - vp(i,J,k) = US%m_s_to_L_T*vp(i,J,k) - enddo ; enddo ; enddo call vertvisc(up, vp, h_av, forces, visc, dt, CS%OBC, CS%ADp, CS%CDp, & G, GV, US, CS%vertvisc_CSp, CS%taux_bot, CS%tauy_bot) - !### This is temporary and will be deleted when the units of the input velocities have changed. - do j=G%jsc,G%jec ; do k=1,nz ; do I=Isq,Ieq - up(I,j,k) = US%L_T_to_m_s*up(I,j,k) - enddo ; enddo ; enddo - do J=Jsq,Jeq ; do k=1,nz ; do i=is,ie - vp(i,J,k) = US%L_T_to_m_s*vp(i,J,k) - enddo ; enddo ; enddo - call vertvisc_coef(US%m_s_to_L_T*u_in, US%m_s_to_L_T*v_in, h_av, forces, visc, dt, G, GV, US, & + call vertvisc_coef(u_in, v_in, h_av, forces, visc, dt, G, GV, US, & CS%vertvisc_CSp, CS%OBC) - !### This is temporary and will be deleted when the units of the input velocities have changed. - do j=G%jsc,G%jec ; do k=1,nz ; do I=Isq,Ieq - u_in(I,j,k) = US%m_s_to_L_T*u_in(I,j,k) - enddo ; enddo ; enddo - do J=Jsq,Jeq ; do k=1,nz ; do i=is,ie - v_in(i,J,k) = US%m_s_to_L_T*v_in(i,J,k) - enddo ; enddo ; enddo call vertvisc(u_in, v_in, h_av, forces, visc, dt, CS%OBC, CS%ADp, CS%CDp,& G, GV, US, CS%vertvisc_CSp, CS%taux_bot, CS%tauy_bot) - !### This is temporary and will be deleted when the units of the input velocities have changed. - do j=G%jsc,G%jec ; do k=1,nz ; do I=Isq,Ieq - u_in(I,j,k) = US%L_T_to_m_s*u_in(I,j,k) - enddo ; enddo ; enddo - do J=Jsq,Jeq ; do k=1,nz ; do i=is,ie - v_in(i,J,k) = US%L_T_to_m_s*v_in(i,J,k) - enddo ; enddo ; enddo call cpu_clock_end(id_clock_vertvisc) call pass_vector(up, vp, G%Domain, clock=id_clock_pass) call pass_vector(u_in, v_in, G%Domain, clock=id_clock_pass) @@ -450,7 +416,7 @@ subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt, ! uh = up[n] * h[n] (up[n] might be extrapolated to damp GWs) ! h[n+1] = h[n] + dt div . uh call cpu_clock_begin(id_clock_continuity) - call continuity(US%m_s_to_L_T*up, US%m_s_to_L_T*vp, h_in, h_in, uh, vh,dt, G, GV, US, CS%continuity_CSp, OBC=CS%OBC) + call continuity(up, vp, h_in, h_in, uh, vh,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) @@ -466,7 +432,7 @@ subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt, enddo if (CS%debug) then - call MOM_state_chksum("Corrector", u_in, v_in, h_in, uh, vh, G, GV, US, vel_scale=1.0) + call MOM_state_chksum("Corrector", u_in, v_in, h_in, uh, vh, G, GV, US, vel_scale=US%L_T_to_m_s) call MOM_accel_chksum("Corrector accel", CS%CAu, CS%CAv, CS%PFu, CS%PFv, & CS%diffu, CS%diffv, G, GV, US) endif @@ -482,6 +448,14 @@ subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt, if (dyn_p_surf) deallocate(p_surf) + !### This is temporary and will be deleted when the units of the input velocities have changed. + do k=1,GV%ke ; do j=G%jsd,G%jed ; do I=G%IsdB,G%IedB + u_in(I,j,k) = US%L_T_to_m_s*u_in(I,j,k) + enddo ; enddo ; enddo + do k=1,GV%ke ; do J=G%JsdB,G%JedB ; do i=G%isd,G%ied + v_in(i,J,k) = US%L_T_to_m_s*v_in(i,J,k) + enddo ; enddo ; enddo + ! Here various terms used in to update the momentum equations are ! offered for averaging. if (CS%id_PFu > 0) call post_data(CS%id_PFu, CS%PFu, CS%diag) From 7b0875f86d77aeef3615e129b69d1839a0c5ed42 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Wed, 14 Aug 2019 18:07:16 -0400 Subject: [PATCH 209/297] +Pass vels to radiation_open_bdry_conds in [L T-1] Passed the velocity arguments to radiation_open_bdry_conds in rescaled units of [L T-1]. All answers are bitwise identical, but the rescaled units of several arguments in a public interface have changed. --- src/core/MOM_dynamics_split_RK2.F90 | 34 +---- src/core/MOM_open_boundary.F90 | 186 +++++++++++++++------------- 2 files changed, 100 insertions(+), 120 deletions(-) diff --git a/src/core/MOM_dynamics_split_RK2.F90 b/src/core/MOM_dynamics_split_RK2.F90 index 07910340e7..295d405ceb 100644 --- a/src/core/MOM_dynamics_split_RK2.F90 +++ b/src/core/MOM_dynamics_split_RK2.F90 @@ -310,7 +310,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & real, dimension(SZIB_(G),SZJ_(G),SZK_(G)) :: u_old_rad_OBC real, dimension(SZI_(G),SZJB_(G),SZK_(G)) :: v_old_rad_OBC ! u_old_rad_OBC and v_old_rad_OBC are the starting velocities, which are - ! saved for use in the Flather open boundary condition code [m s-1]. + ! saved for use in the Flather open boundary condition code [L T-1 ~> m s-1]. real :: Pa_to_eta ! A factor that converts pressures to the units of eta. real, pointer, dimension(:,:) :: & @@ -388,10 +388,10 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & if (CS%debug_OBC) call open_boundary_test_extern_h(G, CS%OBC, h) do k=1,nz ; do j=G%jsd,G%jed ; do I=G%IsdB,G%IedB - u_old_rad_OBC(I,j,k) = US%L_T_to_m_s*u_av(I,j,k) + u_old_rad_OBC(I,j,k) = u_av(I,j,k) enddo ; enddo ; enddo do k=1,nz ; do J=G%JsdB,G%JedB ; do i=G%isd,G%ied - v_old_rad_OBC(i,J,k) = US%L_T_to_m_s*v_av(i,J,k) + v_old_rad_OBC(i,J,k) = v_av(i,J,k) enddo ; enddo ; enddo endif @@ -639,21 +639,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & if (CS%debug) & call uvchksum("Pre OBC avg [uv]", u_av, v_av, G%HI, haloshift=1, symmetric=sym, scale=US%L_T_to_m_s) - !### Remove this later. - do k=1,GV%ke ; do j=G%jsd,G%jed ; do I=G%IsdB,G%IedB - u_av(I,j,k) = US%L_T_to_m_s * u_av(I,j,k) - enddo ; enddo ; enddo - do k=1,GV%ke ; do J=G%JsdB,G%JedB ; do i=G%isd,G%ied - v_av(i,J,k) = US%L_T_to_m_s * v_av(i,J,k) - enddo ; enddo ; enddo call radiation_open_bdry_conds(CS%OBC, u_av, u_old_rad_OBC, v_av, v_old_rad_OBC, G, US, dt_pred) - !### Remove this later. - do k=1,GV%ke ; do j=G%jsd,G%jed ; do I=G%IsdB,G%IedB - u_av(I,j,k) = US%m_s_to_L_T * u_av(I,j,k) - enddo ; enddo ; enddo - do k=1,GV%ke ; do J=G%JsdB,G%JedB ; do i=G%isd,G%ied - v_av(i,J,k) = US%m_s_to_L_T * v_av(i,J,k) - enddo ; enddo ; enddo if (CS%debug) & call uvchksum("Post OBC avg [uv]", u_av, v_av, G%HI, haloshift=1, symmetric=sym, scale=US%L_T_to_m_s) @@ -866,21 +852,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & endif if (associated(CS%OBC)) then - !### This is temporary and will be deleted when the units of the input velocities have changed. - do k=1,GV%ke ; do j=G%jsd,G%jed ; do I=G%IsdB,G%IedB - u(I,j,k) = US%L_T_to_m_s*u(I,j,k) - enddo ; enddo ; enddo - do k=1,GV%ke ; do J=G%JsdB,G%JedB ; do i=G%isd,G%ied - v(i,J,k) = US%L_T_to_m_s*v(i,J,k) - enddo ; enddo ; enddo call radiation_open_bdry_conds(CS%OBC, u, u_old_rad_OBC, v, v_old_rad_OBC, G, US, dt) - !### This is temporary and will be deleted when the units of the input velocities have changed. - do k=1,GV%ke ; do j=G%jsd,G%jed ; do I=G%IsdB,G%IedB - u(I,j,k) = US%m_s_to_L_T*u(I,j,k) - enddo ; enddo ; enddo - do k=1,GV%ke ; do J=G%JsdB,G%JedB ; do i=G%isd,G%ied - v(i,J,k) = US%m_s_to_L_T*v(i,J,k) - enddo ; enddo ; enddo endif ! h_av = (h_in + h_out)/2 . Going in to this line, h_av = h_in. diff --git a/src/core/MOM_open_boundary.F90 b/src/core/MOM_open_boundary.F90 index 93eb0005e5..4555ebaddf 100644 --- a/src/core/MOM_open_boundary.F90 +++ b/src/core/MOM_open_boundary.F90 @@ -1524,17 +1524,18 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, US, dt) type(ocean_grid_type), intent(inout) :: G !< Ocean grid structure type(ocean_OBC_type), pointer :: OBC !< Open boundary control structure real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: u_new !< On exit, new u values on open boundaries - !! On entry, the old time-level v but - !! including barotropic accelerations. - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: u_old !< Original unadjusted u + !! On entry, the old time-level v but including + !! barotropic accelerations [L T-1 ~> m s-1]. + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: u_old !< Original unadjusted u [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: v_new !< On exit, new v values on open boundaries. - !! On entry, the old time-level v but - !! including barotropic accelerations. - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: v_old !< Original unadjusted v + !! On entry, the old time-level v but including + !! barotropic accelerations [L T-1 ~> m s-1]. + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: v_old !< Original unadjusted v [L T-1 ~> m s-1] type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - real, intent(in) :: dt !< Appropriate timestep + real, intent(in) :: dt !< Appropriate timestep [s] ! Local variables - real :: dhdt, dhdx, dhdy, gamma_u, gamma_v, gamma_2 + real :: dhdt, dhdx, dhdy ! One-point differences in time or space [m s-1] + real :: gamma_u, gamma_v, gamma_2 real :: cff, Cx, Cy, tau real :: rx_max, ry_max ! coefficients for radiation real :: rx_new, rx_avg ! coefficients for radiation @@ -1602,14 +1603,14 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, US, dt) do n=1,OBC%number_of_segments segment=>OBC%segment(n) if (.not. segment%on_pe) cycle - if (segment%oblique) call gradient_at_q_points(G,segment,u_new,v_new) + if (segment%oblique) call gradient_at_q_points(G,segment,US%L_T_to_m_s*u_new(:,:,:),US%L_T_to_m_s*v_new(:,:,:)) if (segment%direction == OBC_DIRECTION_E) then I=segment%HI%IsdB if (I 0.0) rx_new = min( (dhdt/dhdx), rx_max) ! outward phase speed rx_avg = (1.0-gamma_u)*segment%rx_normal(I,j,k) + gamma_u*rx_new @@ -1617,13 +1618,13 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, US, dt) ! The new boundary value is interpolated between future interior ! value, u_new(I-1) and past boundary value but with barotropic ! accelerations, u_new(I). - segment%normal_vel(I,j,k) = US%m_s_to_L_T*(u_new(I,j,k) + rx_avg*u_new(I-1,j,k)) / (1.0+rx_avg) + segment%normal_vel(I,j,k) = (u_new(I,j,k) + rx_avg*u_new(I-1,j,k)) / (1.0+rx_avg) ! Copy restart fields into 3-d arrays. This is an inefficient and temporary issues ! implemented as a work-around to limitations in restart capability OBC%rx_normal(I,j,k) = segment%rx_normal(I,j,k) elseif (segment%oblique) then - dhdt = u_old(I-1,j,k)-u_new(I-1,j,k) !old-new - dhdx = u_new(I-1,j,k)-u_new(I-2,j,k) !in new time backward sasha for I-1 + dhdt = US%L_T_to_m_s*(u_old(I-1,j,k) - u_new(I-1,j,k)) !old-new + dhdx = US%L_T_to_m_s*(u_new(I-1,j,k) - u_new(I-2,j,k)) !in new time backward sasha for I-1 if (dhdt*(segment%grad_normal(J,1,k) + segment%grad_normal(J-1,1,k)) > 0.0) then dhdy = segment%grad_normal(J-1,1,k) elseif (dhdt*(segment%grad_normal(J,1,k) + segment%grad_normal(J-1,1,k)) == 0.0) then @@ -1641,8 +1642,9 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, US, dt) segment%rx_normal(I,j,k) = rx_avg segment%ry_normal(i,J,k) = ry_avg segment%cff_normal(i,J,k) = cff_avg - segment%normal_vel(I,j,k) = US%m_s_to_L_T*((cff_avg*u_new(I,j,k) + rx_avg*u_new(I-1,j,k)) - & - (max(ry_avg,0.0)*segment%grad_normal(J-1,2,k) + min(ry_avg,0.0)*segment%grad_normal(J,2,k))) / & + segment%normal_vel(I,j,k) = ((cff_avg*u_new(I,j,k) + rx_avg*u_new(I-1,j,k)) - & + US%m_s_to_L_T*(max(ry_avg,0.0)*segment%grad_normal(J-1,2,k) + & + min(ry_avg,0.0)*segment%grad_normal(J,2,k))) / & (cff_avg + rx_avg) ! Copy restart fields into 3-d arrays. This is an inefficient and temporary issues ! implemented as a work-around to limitations in restart capability @@ -1650,7 +1652,7 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, US, dt) OBC%ry_normal(i,J,k) = segment%ry_normal(i,J,k) OBC%cff_normal(I,j,k) = segment%cff_normal(I,j,k) elseif (segment%gradient) then - segment%normal_vel(I,j,k) = US%m_s_to_L_T*u_new(I-1,j,k) + segment%normal_vel(I,j,k) = u_new(I-1,j,k) endif if ((segment%radiation .or. segment%oblique) .and. segment%nudged) then ! dhdt gets set to 0 on inflow in oblique case @@ -1677,7 +1679,7 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, US, dt) if (segment%radiation_tan) then do k=1,nz ; do J=segment%HI%JsdB,segment%HI%JedB rx_avg = rx_tangential(I,J,k) - segment%tangential_vel(I,J,k) = US%m_s_to_L_T*(v_new(I,J,k) + rx_avg*v_new(I-1,J,k)) / (1.0+rx_avg) + segment%tangential_vel(I,J,k) = (v_new(I,J,k) + rx_avg*v_new(I-1,J,k)) / (1.0+rx_avg) enddo ; enddo endif if (segment%nudged_tan) then @@ -1699,15 +1701,15 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, US, dt) do k=1,nz ; do J=Js_obc,Je_obc rx_avg = rx_tangential(I,J,k) ! if (G%mask2dCu(I-1,j) > 0.0 .and. G%mask2dCu(I-1,j+1) > 0.0) then -! rx_avg = 0.5*US%m_s_to_L_T*(u_new(I-1,j,k) + u_new(I-1,j+1,k)) * US%s_to_T*dt * G%IdxBu(I-1,J) +! rx_avg = 0.5*(u_new(I-1,j,k) + u_new(I-1,j+1,k)) * US%s_to_T*dt * G%IdxBu(I-1,J) ! elseif (G%mask2dCu(I-1,j) > 0.0) then -! rx_avg = US%m_s_to_L_T*u_new(I-1,j,k) * US%s_to_T*dt * G%IdxBu(I-1,J) +! rx_avg = u_new(I-1,j,k) * US%s_to_T*dt * G%IdxBu(I-1,J) ! elseif (G%mask2dCu(I-1,j+1) > 0.0) then -! rx_avg = US%m_s_to_L_T*u_new(I-1,j+1,k) * US%s_to_T*dt * G%IdxBu(I-1,J) +! rx_avg = u_new(I-1,j+1,k) * US%s_to_T*dt * G%IdxBu(I-1,J) ! else ! rx_avg = 0.0 ! endif - segment%tangential_grad(I,J,k) = US%m_s_to_L_T*((v_new(i,J,k) - v_new(i-1,J,k))*G%IdxBu(I-1,J) + & + segment%tangential_grad(I,J,k) = ((v_new(i,J,k) - v_new(i-1,J,k))*G%IdxBu(I-1,J) + & rx_avg*(v_new(i-1,J,k) - v_new(i-2,J,k))*G%IdxBu(I-2,J)) / (1.0+rx_avg) enddo ; enddo endif @@ -1749,8 +1751,9 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, US, dt) rx_avg = rx_tangential(I,J,k) ry_avg = ry_tangential(I,J,k) cff_avg = cff_tangential(I,J,k) - segment%tangential_vel(I,J,k) = US%m_s_to_L_T*((cff_avg*v_new(i,J,k) + rx_avg*v_new(i-1,J,k)) - & - (max(ry_avg,0.0)*segment%grad_tan(j,2,k) + min(ry_avg,0.0)*segment%grad_tan(j+1,2,k))) / & + segment%tangential_vel(I,J,k) = ((cff_avg*v_new(i,J,k) + rx_avg*v_new(i-1,J,k)) - & + US%m_s_to_L_T * (max(ry_avg,0.0)*segment%grad_tan(j,2,k) + & + min(ry_avg,0.0)*segment%grad_tan(j+1,2,k))) / & (cff_avg + rx_avg) enddo ; enddo endif @@ -1774,10 +1777,10 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, US, dt) rx_avg = rx_tangential(I,J,k) ry_avg = ry_tangential(I,J,k) cff_avg = cff_tangential(I,J,k) - segment%tangential_grad(I,J,k) = US%m_s_to_L_T * & + segment%tangential_grad(I,J,k) = & ((cff_avg*(v_new(i,J,k) - v_new(i-1,J,k))*G%IdxBu(I-1,J) + & rx_avg*(v_new(i-1,J,k) - v_new(i-2,J,k))*G%IdxBu(I-2,J)) - & - (max(ry_avg,0.0)*segment%grad_gradient(J,2,k) + & + US%m_s_to_L_T*(max(ry_avg,0.0)*segment%grad_gradient(J,2,k) + & min(ry_avg,0.0)*segment%grad_gradient(J+1,2,k)) ) / & (cff_avg + rx_avg) enddo ; enddo @@ -1806,8 +1809,8 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, US, dt) if (I>G%HI%IecB) cycle do k=1,nz ; do j=segment%HI%jsd,segment%HI%jed if (segment%radiation) then - dhdt = u_old(I+1,j,k)-u_new(I+1,j,k) !old-new - dhdx = u_new(I+1,j,k)-u_new(I+2,j,k) !in new time forward sasha for I+1 + dhdt = US%L_T_to_m_s*(u_old(I+1,j,k) - u_new(I+1,j,k)) !old-new + dhdx = US%L_T_to_m_s*(u_new(I+1,j,k) - u_new(I+2,j,k)) !in new time forward sasha for I+1 rx_new = 0.0 if (dhdt*dhdx > 0.0) rx_new = min( (dhdt/dhdx), rx_max) rx_avg = (1.0-gamma_u)*segment%rx_normal(I,j,k) + gamma_u*rx_new @@ -1815,13 +1818,13 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, US, dt) ! The new boundary value is interpolated between future interior ! value, u_new(I+1) and past boundary value but with barotropic ! accelerations, u_new(I). - segment%normal_vel(I,j,k) = US%m_s_to_L_T*(u_new(I,j,k) + rx_avg*u_new(I+1,j,k)) / (1.0+rx_avg) + segment%normal_vel(I,j,k) = (u_new(I,j,k) + rx_avg*u_new(I+1,j,k)) / (1.0+rx_avg) ! Copy restart fields into 3-d arrays. This is an inefficient and temporary issues ! implemented as a work-around to limitations in restart capability OBC%rx_normal(I,j,k) = segment%rx_normal(I,j,k) elseif (segment%oblique) then - dhdt = u_old(I+1,j,k)-u_new(I+1,j,k) !old-new - dhdx = u_new(I+1,j,k)-u_new(I+2,j,k) !in new time forward sasha for I+1 + dhdt = US%L_T_to_m_s*(u_old(I+1,j,k) - u_new(I+1,j,k)) !old-new + dhdx = US%L_T_to_m_s*(u_new(I+1,j,k) - u_new(I+2,j,k)) !in new time forward sasha for I+1 if (dhdt*(segment%grad_normal(J,1,k) + segment%grad_normal(J-1,1,k)) > 0.0) then dhdy = segment%grad_normal(J-1,1,k) elseif (dhdt*(segment%grad_normal(J,1,k) + segment%grad_normal(J-1,1,k)) == 0.0) then @@ -1839,8 +1842,9 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, US, dt) segment%rx_normal(I,j,k) = rx_avg segment%ry_normal(i,J,k) = ry_avg segment%cff_normal(i,J,k) = cff_avg - segment%normal_vel(I,j,k) = US%m_s_to_L_T*((cff_avg*u_new(I,j,k) + rx_avg*u_new(I+1,j,k)) - & - (max(ry_avg,0.0)*segment%grad_normal(J-1,2,k) + min(ry_avg,0.0)*segment%grad_normal(J,2,k))) / & + segment%normal_vel(I,j,k) = ((cff_avg*u_new(I,j,k) + rx_avg*u_new(I+1,j,k)) - & + US%m_s_to_L_T*(max(ry_avg,0.0)*segment%grad_normal(J-1,2,k) + & + min(ry_avg,0.0)*segment%grad_normal(J,2,k))) / & (cff_avg + rx_avg) ! Copy restart fields into 3-d arrays. This is an inefficient and temporary issues ! implemented as a work-around to limitations in restart capability @@ -1848,7 +1852,7 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, US, dt) OBC%ry_normal(i,J,k) = segment%ry_normal(i,J,k) OBC%cff_normal(I,j,k) = segment%cff_normal(I,j,k) elseif (segment%gradient) then - segment%normal_vel(I,j,k) = US%m_s_to_L_T*u_new(I+1,j,k) + segment%normal_vel(I,j,k) = u_new(I+1,j,k) endif if ((segment%radiation .or. segment%oblique) .and. segment%nudged) then ! dhdt gets set to 0. on inflow in oblique case @@ -1875,7 +1879,7 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, US, dt) if (segment%radiation_tan) then do k=1,nz ; do J=segment%HI%JsdB,segment%HI%JedB rx_avg = rx_tangential(I,J,k) - segment%tangential_vel(I,J,k) = US%m_s_to_L_T*(v_new(i+1,J,k) + rx_avg*v_new(i+2,J,k)) / (1.0+rx_avg) + segment%tangential_vel(I,J,k) = (v_new(i+1,J,k) + rx_avg*v_new(i+2,J,k)) / (1.0+rx_avg) enddo ; enddo endif if (segment%nudged_tan) then @@ -1897,15 +1901,15 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, US, dt) do k=1,nz ; do J=Js_obc,Je_obc rx_avg = rx_tangential(I,J,k) ! if (G%mask2dCu(I+1,j) > 0.0 .and. G%mask2dCu(I+1,j+1) > 0.0) then -! rx_avg = 0.5*US%m_s_to_L_T*(u_new(I+1,j,k) + u_new(I+1,j+1,k)) * US%s_to_T*dt * G%IdxBu(I+1,J) +! rx_avg = 0.5*(u_new(I+1,j,k) + u_new(I+1,j+1,k)) * US%s_to_T*dt * G%IdxBu(I+1,J) ! elseif (G%mask2dCu(I+1,j) > 0.0) then -! rx_avg = US%m_s_to_L_T*u_new(I+1,j,k) * US%s_to_T*dt * G%IdxBu(I+1,J) +! rx_avg = u_new(I+1,j,k) * US%s_to_T*dt * G%IdxBu(I+1,J) ! elseif (G%mask2dCu(I+1,j+1) > 0.0) then -! rx_avg = US%m_s_to_L_T*u_new(I+1,j+1,k) * US%s_to_T*dt * G%IdxBu(I+1,J) +! rx_avg = u_new(I+1,j+1,k) * US%s_to_T*dt * G%IdxBu(I+1,J) ! else ! rx_avg = 0.0 ! endif - segment%tangential_grad(I,J,k) = US%m_s_to_L_T*((v_new(i+2,J,k) - v_new(i+1,J,k))*G%IdxBu(I+1,J) + & + segment%tangential_grad(I,J,k) = ((v_new(i+2,J,k) - v_new(i+1,J,k))*G%IdxBu(I+1,J) + & rx_avg*(v_new(i+3,J,k) - v_new(i+2,J,k))*G%IdxBu(I+2,J)) / (1.0+rx_avg) enddo ; enddo endif @@ -1947,8 +1951,9 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, US, dt) rx_avg = rx_tangential(I,J,k) ry_avg = ry_tangential(I,J,k) cff_avg = cff_tangential(I,J,k) - segment%tangential_vel(I,J,k) = US%m_s_to_L_T*((cff_avg*v_new(i+1,J,k) + rx_avg*v_new(i+2,J,k)) - & - (max(ry_avg,0.0)*segment%grad_tan(j,2,k) + min(ry_avg,0.0)*segment%grad_tan(j+1,2,k))) / & + segment%tangential_vel(I,J,k) = ((cff_avg*v_new(i+1,J,k) + rx_avg*v_new(i+2,J,k)) - & + US%m_s_to_L_T*(max(ry_avg,0.0)*segment%grad_tan(j,2,k) + & + min(ry_avg,0.0)*segment%grad_tan(j+1,2,k))) / & (cff_avg + rx_avg) enddo ; enddo endif @@ -1972,11 +1977,11 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, US, dt) rx_avg = rx_tangential(I,J,k) ry_avg = ry_tangential(I,J,k) cff_avg = cff_tangential(I,J,k) - segment%tangential_grad(I,J,k) = US%m_s_to_L_T * & + segment%tangential_grad(I,J,k) = & ((cff_avg*(v_new(i+2,J,k) - v_new(i+1,J,k))*G%IdxBu(I+1,J) + & rx_avg*(v_new(i+3,J,k) - v_new(i+2,J,k))*G%IdxBu(I+2,J)) - & - (max(ry_avg,0.0)*segment%grad_gradient(J,2,k) + & - min(ry_avg,0.0)*segment%grad_gradient(J+1,2,k))) / & + US%m_s_to_L_T*(max(ry_avg,0.0)*segment%grad_gradient(J,2,k) + & + min(ry_avg,0.0)*segment%grad_gradient(J+1,2,k))) / & (cff_avg + rx_avg) enddo ; enddo endif @@ -2004,8 +2009,8 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, US, dt) if (J 0.0) ry_new = min( (dhdt/dhdy), ry_max) ry_avg = (1.0-gamma_v)*segment%ry_normal(I,j,k) + gamma_v*ry_new @@ -2013,13 +2018,13 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, US, dt) ! The new boundary value is interpolated between future interior ! value, v_new(J-1) and past boundary value but with barotropic ! accelerations, v_new(J). - segment%normal_vel(i,J,k) = US%m_s_to_L_T*(v_new(i,J,k) + ry_avg*v_new(i,J-1,k)) / (1.0+ry_avg) + segment%normal_vel(i,J,k) = (v_new(i,J,k) + ry_avg*v_new(i,J-1,k)) / (1.0+ry_avg) ! Copy restart fields into 3-d arrays. This is an inefficient and temporary issues ! implemented as a work-around to limitations in restart capability OBC%ry_normal(i,J,k) = segment%ry_normal(i,J,k) 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 + dhdt = US%L_T_to_m_s*(v_old(i,J-1,k) - v_new(i,J-1,k)) !old-new + dhdy = US%L_T_to_m_s*(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) @@ -2038,10 +2043,10 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, US, dt) segment%rx_normal(I,j,k) = rx_avg segment%ry_normal(i,J,k) = ry_avg segment%cff_normal(i,J,k) = cff_avg - segment%normal_vel(i,J,k) = US%m_s_to_L_T * & + segment%normal_vel(i,J,k) = & ((cff_avg*v_new(i,J,k) + ry_avg*v_new(i,J-1,k)) - & - (max(rx_avg,0.0)*segment%grad_normal(I-1,2,k) +& - min(rx_avg,0.0)*segment%grad_normal(I,2,k))) / & + US%m_s_to_L_T*(max(rx_avg,0.0)*segment%grad_normal(I-1,2,k) +& + min(rx_avg,0.0)*segment%grad_normal(I,2,k))) / & (cff_avg + ry_avg) ! Copy restart fields into 3-d arrays. This is an inefficient and temporary issues ! implemented as a work-around to limitations in restart capability @@ -2049,7 +2054,7 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, US, dt) OBC%ry_normal(i,J,k) = segment%ry_normal(i,J,k) OBC%cff_normal(i,J,k) = segment%cff_normal(i,J,k) elseif (segment%gradient) then - segment%normal_vel(i,J,k) = US%m_s_to_L_T*v_new(i,J-1,k) + segment%normal_vel(i,J,k) = v_new(i,J-1,k) endif if ((segment%radiation .or. segment%oblique) .and. segment%nudged) then ! dhdt gets set to 0 on inflow in oblique case @@ -2076,7 +2081,7 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, US, dt) if (segment%radiation_tan) then do k=1,nz ; do I=segment%HI%IsdB,segment%HI%IedB rx_avg = rx_tangential(I,J,k) - segment%tangential_vel(I,J,k) = US%m_s_to_L_T*(u_new(I,j,k) + rx_avg*u_new(I,j-1,k)) / (1.0+rx_avg) + segment%tangential_vel(I,J,k) = (u_new(I,j,k) + rx_avg*u_new(I,j-1,k)) / (1.0+rx_avg) enddo ; enddo endif if (segment%nudged_tan) then @@ -2098,15 +2103,15 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, US, dt) do k=1,nz ; do I=Is_obc,Ie_obc rx_avg = rx_tangential(I,J,k) ! if (G%mask2dCv(i,J-1) > 0.0 .and. G%mask2dCv(i+1,J-1) > 0.0) then -! rx_avg = 0.5*US%m_s_to_L_T*(v_new(i,J-1,k) + v_new(i+1,J-1,k) * US%s_to_T*dt * G%IdyBu(I,J-1)) +! rx_avg = 0.5*(v_new(i,J-1,k) + v_new(i+1,J-1,k) * US%s_to_T*dt * G%IdyBu(I,J-1)) ! elseif (G%mask2dCv(i,J-1) > 0.0) then -! rx_avg = US%m_s_to_L_T*v_new(i,J-1,k) * US%s_to_T*dt *G%IdyBu(I,J-1) +! rx_avg = v_new(i,J-1,k) * US%s_to_T*dt *G%IdyBu(I,J-1) ! elseif (G%mask2dCv(i+1,J-1) > 0.0) then -! rx_avg = US%m_s_to_L_T*v_new(i+1,J-1,k) * US%s_to_T*dt *G%IdyBu(I,J-1) +! rx_avg = v_new(i+1,J-1,k) * US%s_to_T*dt *G%IdyBu(I,J-1) ! else ! rx_avg = 0.0 ! endif - segment%tangential_grad(I,J,k) = US%m_s_to_L_T * & + segment%tangential_grad(I,J,k) = & ((u_new(I,j,k) - u_new(I,j-1,k))*G%IdyBu(I,J-1) + & rx_avg*(u_new(I,j-1,k) - u_new(I,j-2,k))*G%IdyBu(I,J-2)) / (1.0+rx_avg) enddo ; enddo @@ -2149,10 +2154,10 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, US, dt) rx_avg = rx_tangential(I,J,k) ry_avg = ry_tangential(I,J,k) cff_avg = cff_tangential(I,J,k) - segment%tangential_vel(I,J,k) = US%m_s_to_L_T * & + segment%tangential_vel(I,J,k) = & ((cff_avg*u_new(I,j,k) + rx_avg*u_new(I,j-1,k)) - & - (max(ry_avg,0.0)*segment%grad_tan(i,2,k) + & - min(ry_avg,0.0)*segment%grad_tan(i+1,2,k))) / & + US%m_s_to_L_T * (max(ry_avg,0.0)*segment%grad_tan(i,2,k) + & + min(ry_avg,0.0)*segment%grad_tan(i+1,2,k))) / & (cff_avg + rx_avg) enddo ; enddo endif @@ -2176,11 +2181,11 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, US, dt) rx_avg = rx_tangential(I,J,k) ry_avg = ry_tangential(I,J,k) cff_avg = cff_tangential(I,J,k) - segment%tangential_grad(I,J,k) = US%m_s_to_L_T * & + segment%tangential_grad(I,J,k) = & ((cff_avg*(u_new(I,j,k) - u_new(I,j-1,k))*G%IdyBu(I,J-1) + & rx_avg*(u_new(I,j-1,k) - u_new(I,j-2,k))*G%IdyBu(I,J-2)) - & - (max(ry_avg,0.0)*segment%grad_gradient(I,2,k) + & - min(ry_avg,0.0)*segment%grad_gradient(I+1,2,k))) / & + US%m_s_to_L_T * (max(ry_avg,0.0)*segment%grad_gradient(I,2,k) + & + min(ry_avg,0.0)*segment%grad_gradient(I+1,2,k))) / & (cff_avg + rx_avg) enddo ; enddo endif @@ -2208,8 +2213,8 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, US, dt) if (J>G%HI%JecB) cycle do k=1,nz ; do i=segment%HI%isd,segment%HI%ied if (segment%radiation) 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 + dhdt = US%L_T_to_m_s*(v_old(i,J+1,k) - v_new(i,J+1,k)) !old-new + dhdy = US%L_T_to_m_s*(v_new(i,J+1,k) - v_new(i,J+2,k)) !in new time backward sasha for J-1 ry_new = 0.0 if (dhdt*dhdy > 0.0) ry_new = min( (dhdt/dhdy), ry_max) ry_avg = (1.0-gamma_v)*segment%ry_normal(I,j,k) + gamma_v*ry_new @@ -2217,13 +2222,13 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, US, dt) ! The new boundary value is interpolated between future interior ! value, v_new(J+1) and past boundary value but with barotropic ! accelerations, v_new(J). - segment%normal_vel(i,J,k) = US%m_s_to_L_T*(v_new(i,J,k) + ry_avg*v_new(i,J+1,k)) / (1.0+ry_avg) + segment%normal_vel(i,J,k) = (v_new(i,J,k) + ry_avg*v_new(i,J+1,k)) / (1.0+ry_avg) ! Copy restart fields into 3-d arrays. This is an inefficient and temporary issues ! implemented as a work-around to limitations in restart capability OBC%ry_normal(i,J,k) = segment%ry_normal(i,J,k) 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 + dhdt = US%L_T_to_m_s*(v_old(i,J+1,k) - v_new(i,J+1,k)) !old-new + dhdy = US%L_T_to_m_s*(v_new(i,J+1,k) - v_new(i,J+2,k)) !in new time backward sasha for J-1 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 @@ -2241,8 +2246,9 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, US, dt) segment%rx_normal(I,j,k) = rx_avg segment%ry_normal(i,J,k) = ry_avg segment%cff_normal(i,J,k) = cff_avg - segment%normal_vel(i,J,k) = US%m_s_to_L_T*((cff_avg*v_new(i,J,k) + ry_avg*v_new(i,J+1,k)) - & - (max(rx_avg,0.0)*segment%grad_normal(I-1,2,k) + min(rx_avg,0.0)*segment%grad_normal(I,2,k))) / & + segment%normal_vel(i,J,k) = ((cff_avg*v_new(i,J,k) + ry_avg*v_new(i,J+1,k)) - & + US%m_s_to_L_T*(max(rx_avg,0.0)*segment%grad_normal(I-1,2,k) + & + min(rx_avg,0.0)*segment%grad_normal(I,2,k))) / & (cff_avg + ry_avg) ! Copy restart fields into 3-d arrays. This is an inefficient and temporary issues ! implemented as a work-around to limitations in restart capability @@ -2250,7 +2256,7 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, US, dt) OBC%ry_normal(i,J,k) = segment%ry_normal(i,J,k) OBC%cff_normal(i,J,k) = segment%cff_normal(i,J,k) elseif (segment%gradient) then - segment%normal_vel(i,J,k) = US%m_s_to_L_T*v_new(i,J+1,k) + segment%normal_vel(i,J,k) = v_new(i,J+1,k) endif if ((segment%radiation .or. segment%oblique) .and. segment%nudged) then ! dhdt gets set to 0 on inflow in oblique case @@ -2277,7 +2283,7 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, US, dt) if (segment%radiation_tan) then do k=1,nz ; do I=segment%HI%IsdB,segment%HI%IedB rx_avg = rx_tangential(I,J,k) - segment%tangential_vel(I,J,k) = US%m_s_to_L_T*(u_new(I,j+1,k) + rx_avg*u_new(I,j+2,k)) / (1.0+rx_avg) + segment%tangential_vel(I,J,k) = (u_new(I,j+1,k) + rx_avg*u_new(I,j+2,k)) / (1.0+rx_avg) enddo ; enddo endif if (segment%nudged_tan) then @@ -2299,15 +2305,15 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, US, dt) do k=1,nz ; do I=Is_obc,Ie_obc rx_avg = rx_tangential(I,J,k) ! if (G%mask2dCv(i,J+1) > 0.0 .and. G%mask2dCv(i+1,J+1) > 0.0) then -! rx_avg = 0.5*US%m_s_to_L_T*(v_new(i,J+1,k) + v_new(i+1,J+1,k)) * US%s_to_T*dt * G%IdyBu(I,J+1) +! rx_avg = 0.5*(v_new(i,J+1,k) + v_new(i+1,J+1,k)) * US%s_to_T*dt * G%IdyBu(I,J+1) ! elseif (G%mask2dCv(i,J+1) > 0.0) then -! rx_avg = US%m_s_to_L_T*v_new(i,J+1,k) * US%s_to_T*dt * G%IdyBu(I,J+1) +! rx_avg = v_new(i,J+1,k) * US%s_to_T*dt * G%IdyBu(I,J+1) ! elseif (G%mask2dCv(i+1,J+1) > 0.0) then -! rx_avg = US%m_s_to_L_T*v_new(i+1,J+1,k) * US%s_to_T*dt * G%IdyBu(I,J+1) +! rx_avg = v_new(i+1,J+1,k) * US%s_to_T*dt * G%IdyBu(I,J+1) ! else ! rx_avg = 0.0 ! endif - segment%tangential_grad(I,J,k) = US%m_s_to_L_T*((u_new(I,j+2,k) - u_new(I,j+1,k))*G%IdyBu(I,J+1) + & + segment%tangential_grad(I,J,k) = ((u_new(I,j+2,k) - u_new(I,j+1,k))*G%IdyBu(I,J+1) + & rx_avg*(u_new(I,j+3,k) - u_new(I,j+2,k))*G%IdyBu(I,J+2)) / (1.0+rx_avg) enddo ; enddo endif @@ -2349,10 +2355,10 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, US, dt) rx_avg = rx_tangential(I,J,k) ry_avg = ry_tangential(I,J,k) cff_avg = cff_tangential(I,J,k) - segment%tangential_vel(I,J,k) = US%m_s_to_L_T * & + segment%tangential_vel(I,J,k) = & ((cff_avg*u_new(I,j+1,k) + rx_avg*u_new(I,j+2,k)) - & - (max(ry_avg,0.0)*segment%grad_tan(i,2,k) + & - min(ry_avg,0.0)*segment%grad_tan(i+1,2,k)) ) / & + US%m_s_to_L_T * (max(ry_avg,0.0)*segment%grad_tan(i,2,k) + & + min(ry_avg,0.0)*segment%grad_tan(i+1,2,k)) ) / & (cff_avg + rx_avg) enddo ; enddo endif @@ -2376,11 +2382,11 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, US, dt) rx_avg = rx_tangential(I,J,k) ry_avg = ry_tangential(I,J,k) cff_avg = cff_tangential(I,J,k) - segment%tangential_grad(I,J,k) = US%m_s_to_L_T * & + segment%tangential_grad(I,J,k) = & ((cff_avg*(u_new(I,j+2,k) - u_new(I,j+1,k))*G%IdyBu(I,J+1) + & rx_avg*(u_new(I,j+3,k) - u_new(I,j+2,k))*G%IdyBu(I,J+2)) - & - (max(ry_avg,0.0)*segment%grad_gradient(i,2,k) + & - min(ry_avg,0.0)*segment%grad_gradient(i+1,2,k))) / & + US%m_s_to_L_T * (max(ry_avg,0.0)*segment%grad_gradient(i,2,k) + & + min(ry_avg,0.0)*segment%grad_gradient(i+1,2,k))) / & (cff_avg + rx_avg) enddo ; enddo endif @@ -2416,8 +2422,10 @@ subroutine open_boundary_apply_normal_flow(OBC, G, u, v) ! Arguments type(ocean_OBC_type), pointer :: OBC !< Open boundary control structure type(ocean_grid_type), intent(inout) :: G !< Ocean grid structure - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: u !< u field to update on open boundaries - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: v !< v field to update on open boundaries + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: u !< u field to update on open + !! boundaries [L T-1 ~> m s-1] + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: v !< v field to update on open + !! boundaries [L T-1 ~> m s-1] ! Local variables integer :: i, j, k, n type(OBC_segment_type), pointer :: segment => NULL() @@ -2432,12 +2440,12 @@ subroutine open_boundary_apply_normal_flow(OBC, G, u, v) if (segment%is_E_or_W) then I=segment%HI%IsdB do k=1,G%ke ; do j=segment%HI%jsd,segment%HI%jed - u(I,j,k) = G%US%L_T_to_m_s*segment%normal_vel(I,j,k) + u(I,j,k) = segment%normal_vel(I,j,k) enddo ; enddo elseif (segment%is_N_or_S) then J=segment%HI%JsdB do k=1,G%ke ; do i=segment%HI%isd,segment%HI%ied - v(i,J,k) = G%US%L_T_to_m_s*segment%normal_vel(i,J,k) + v(i,J,k) = segment%normal_vel(i,J,k) enddo ; enddo endif endif @@ -2481,8 +2489,8 @@ end subroutine open_boundary_zero_normal_flow subroutine gradient_at_q_points(G, segment, uvel, vvel) type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(OBC_segment_type), pointer :: segment !< OBC segment structure - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: uvel !< zonal velocity - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: vvel !< meridional velocity + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: uvel !< zonal velocity [m s-1] + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: vvel !< meridional velocity [m s-1] integer :: i,j,k if (.not. segment%on_pe) return From 93794195538ec86547f62cb72498bde0f3677869 Mon Sep 17 00:00:00 2001 From: Kate Hedstrom Date: Thu, 15 Aug 2019 09:32:06 -0800 Subject: [PATCH 210/297] *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 3d594e0ca9bf38002aeea6a3c59e5bca0601b526 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Thu, 15 Aug 2019 14:01:03 -0400 Subject: [PATCH 211/297] MOM_dyn_split_RK2_CS%u_av in units of [L T-1] Use units of [L T-1] for MOM_dyn_split_RK2_CS%u_av and ...%v_av at all times. Also eliminated the use of unnecessary pointers and eliminated some unused variables. All answers are bitwise identical. --- src/core/MOM_dynamics_split_RK2.F90 | 88 +++++++++++------------------ 1 file changed, 32 insertions(+), 56 deletions(-) diff --git a/src/core/MOM_dynamics_split_RK2.F90 b/src/core/MOM_dynamics_split_RK2.F90 index 295d405ceb..7dae7774a3 100644 --- a/src/core/MOM_dynamics_split_RK2.F90 +++ b/src/core/MOM_dynamics_split_RK2.F90 @@ -87,7 +87,7 @@ module MOM_dynamics_split_RK2 real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_,NKMEM_) :: u_accel_bt !< The zonal layer accelerations due to the difference between !! the barotropic accelerations and the baroclinic accelerations - !! that were fed into the barotopic calculation [m s-2] + !! that were fed into the barotopic calculation [L T-2 ~> m s-2] real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_,NKMEM_) :: visc_rem_v !< Both the fraction of the meridional momentum originally in !! a layer that remains after a time-step of viscosity, and the @@ -97,7 +97,7 @@ module MOM_dynamics_split_RK2 real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_,NKMEM_) :: v_accel_bt !< The meridional layer accelerations due to the difference between !! the barotropic accelerations and the baroclinic accelerations - !! that were fed into the barotopic calculation [m s-2] + !! that were fed into the barotopic calculation [L T-2 ~> m s-2] ! The following variables are only used with the split time stepping scheme. real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: eta !< Instantaneous free surface height (in Boussinesq @@ -105,10 +105,10 @@ module MOM_dynamics_split_RK2 !! mode) [H ~> m or kg m-2] real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_,NKMEM_) :: u_av !< layer x-velocity with vertical mean replaced by !! time-mean barotropic velocity over a baroclinic - !! timestep [m s-1] + !! timestep [L T-1 ~> m s-1] real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_,NKMEM_) :: v_av !< layer y-velocity with vertical mean replaced by !! time-mean barotropic velocity over a baroclinic - !! timestep [m s-1] + !! timestep [L T-1 ~> m s-1] real ALLOCABLE_, dimension(NIMEM_,NJMEM_,NKMEM_) :: h_av !< arithmetic mean of two successive layer !! thicknesses [H ~> m or kg m-2] real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: eta_PF !< instantaneous SSH used in calculating PFu and @@ -301,12 +301,6 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & ! eta_pred is the predictor value of the free surface height or column mass, ! [H ~> m or kg m-2]. - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), target :: u_adj - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), target :: v_adj - ! u_adj and v_adj are the zonal or meridional velocities after u and v - ! have been barotropically adjusted so the resulting transports match - ! uhbt_out and vhbt_out [m s-1]. - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)) :: u_old_rad_OBC real, dimension(SZI_(G),SZJB_(G),SZK_(G)) :: v_old_rad_OBC ! u_old_rad_OBC and v_old_rad_OBC are the starting velocities, which are @@ -320,9 +314,8 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & real, pointer, dimension(:,:,:) :: & uh_ptr => NULL(), u_ptr => NULL(), vh_ptr => NULL(), v_ptr => NULL(), & - u_init => NULL(), v_init => NULL(), & ! Pointers to u and v or u_adj and v_adj. - u_av, & ! The zonal velocity time-averaged over a time step [m s-1]. - v_av, & ! The meridional velocity time-averaged over a time step [m s-1]. + u_av, & ! The zonal velocity time-averaged over a time step [L T-1 ~> m s-1]. + v_av, & ! The meridional velocity time-averaged over a time step [L T-1 ~> m s-1]. h_av ! The layer thickness time-averaged over a time step [H ~> m or kg m-2]. real :: Idt logical :: dyn_p_surf @@ -351,13 +344,6 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & do k=1,GV%ke ; do J=G%JsdB,G%JedB ; do i=G%isd,G%ied v(i,J,k) = US%m_s_to_L_T*v(i,J,k) enddo ; enddo ; enddo - !### Remove this later. - do k=1,GV%ke ; do j=G%jsd,G%jed ; do I=G%IsdB,G%IedB - u_av(I,j,k) = US%m_s_to_L_T * u_av(I,j,k) - enddo ; enddo ; enddo - do k=1,GV%ke ; do J=G%JsdB,G%JedB ; do i=G%isd,G%ied - v_av(i,J,k) = US%m_s_to_L_T * v_av(i,J,k) - enddo ; enddo ; enddo !$OMP parallel do default(shared) do k=1,nz @@ -370,7 +356,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & call updateCFLtruncationValue(Time_local, CS%vertvisc_CSp) if (CS%debug) then - call MOM_state_chksum("Start predictor ", u, v, h, uh, vh, G, GV, US, symmetric=sym, vel_scale=US%L_T_to_m_s) + call MOM_state_chksum("Start predictor ", u, v, h, uh, vh, G, GV, US, symmetric=sym) call check_redundant("Start predictor u ", u, v, G) call check_redundant("Start predictor uh ", uh, vh, G) endif @@ -544,15 +530,9 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & endif if (CS%BT_use_layer_fluxes) then - ! uh_ptr => uh_in; vh_ptr => vh_in; u_ptr => u; v_ptr => v - uh_ptr => uh_in; vh_ptr => vh_in - call safe_alloc_ptr(u_ptr, G%IsdB,G%IedB,G%jsd,G%jed,G%ke) - call safe_alloc_ptr(v_ptr, G%isd,G%ied,G%JsdB,G%JedB,G%ke) - u_ptr(:,:,:) = u(:,:,:) - v_ptr(:,:,:) = v(:,:,:) + uh_ptr => uh_in ; vh_ptr => vh_in; u_ptr => u ; v_ptr => v endif - u_init => u ; v_init => v call cpu_clock_begin(id_clock_btstep) if (calc_dtbt) call set_dtbt(G, GV, US, CS%barotropic_CSp, eta, CS%pbce) if (showCallTree) call callTree_enter("btstep(), MOM_barotropic.F90") @@ -573,11 +553,11 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & !$OMP parallel do default(shared) do k=1,nz do J=Jsq,Jeq ; do i=is,ie - vp(i,J,k) = G%mask2dCv(i,J) * (v_init(i,J,k) + US%s_to_T*dt_pred * & + vp(i,J,k) = G%mask2dCv(i,J) * (v(i,J,k) + US%s_to_T*dt_pred * & (v_bc_accel(i,J,k) + CS%v_accel_bt(i,J,k))) enddo ; enddo do j=js,je ; do I=Isq,Ieq - up(I,j,k) = G%mask2dCu(I,j) * (u_init(I,j,k) + US%s_to_T*dt_pred * & + up(I,j,k) = G%mask2dCu(I,j) * (u(I,j,k) + US%s_to_T*dt_pred * & (u_bc_accel(I,j,k) + CS%u_accel_bt(I,j,k))) enddo ; enddo enddo @@ -588,11 +568,11 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & call hchksum(h, "Predictor 1 h", G%HI, haloshift=1, scale=GV%H_to_m) call uvchksum("Predictor 1 [uv]h", uh, vh, G%HI,haloshift=2, & symmetric=sym, scale=GV%H_to_m*US%L_to_m**2*US%s_to_T) -! call MOM_state_chksum("Predictor 1", up, vp, h, uh, vh, G, GV, US, haloshift=1, vel_scale=1.0) +! call MOM_state_chksum("Predictor 1", up, vp, h, uh, vh, G, GV, US, haloshift=1) call MOM_accel_chksum("Predictor accel", CS%CAu, CS%CAv, CS%PFu, CS%PFv, & 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, US, haloshift=2, & - symmetric=sym, vel_scale=US%L_T_to_m_s) + call MOM_state_chksum("Predictor 1 init", u, v, h, uh, vh, G, GV, US, haloshift=2, & + symmetric=sym) call check_redundant("Predictor 1 up", up, vp, G) call check_redundant("Predictor 1 uh", uh, vh, G) endif @@ -697,10 +677,10 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & endif if (CS%debug) then - call MOM_state_chksum("Predictor ", up, vp, hp, uh, vh, G, GV, US, symmetric=sym, vel_scale=US%L_T_to_m_s) + call MOM_state_chksum("Predictor ", up, vp, hp, uh, vh, G, GV, US, symmetric=sym) call uvchksum("Predictor avg [uv]", u_av, v_av, G%HI, haloshift=1, symmetric=sym) call hchksum(h_av, "Predictor avg h", G%HI, haloshift=0, scale=GV%H_to_m) - ! call MOM_state_chksum("Predictor avg ", u_av, v_av, h_av, uh, vh, G, GV, US, vel_scale=1.0) + ! call MOM_state_chksum("Predictor avg ", u_av, v_av, h_av, uh, vh, G, GV, US) call check_redundant("Predictor up ", up, vp, G) call check_redundant("Predictor uh ", uh, vh, G) endif @@ -752,9 +732,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & ! pbce = dM/deta call cpu_clock_begin(id_clock_btstep) if (CS%BT_use_layer_fluxes) then - uh_ptr => uh ; vh_ptr => vh ! ; u_ptr => u_av ; v_ptr => v_av - u_ptr(:,:,:) = u_av(:,:,:) - v_ptr(:,:,:) = v_av(:,:,:) + uh_ptr => uh ; vh_ptr => vh ; u_ptr => u_av ; v_ptr => v_av endif if (showCallTree) call callTree_enter("btstep(), MOM_barotropic.F90") @@ -768,9 +746,6 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & uh0=uh_ptr, vh0=vh_ptr, u_uh0=u_ptr, v_vh0=v_ptr) do j=js,je ; do i=is,ie ; eta(i,j) = eta_pred(i,j) ; enddo ; enddo - if (associated(u_ptr)) deallocate(u_ptr) - if (associated(v_ptr)) deallocate(v_ptr) - call cpu_clock_end(id_clock_btstep) if (showCallTree) call callTree_leave("btstep()") @@ -783,11 +758,11 @@ 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(I,j,k) = G%mask2dCu(I,j) * (u_init(I,j,k) + US%s_to_T*dt * & + u(I,j,k) = G%mask2dCu(I,j) * (u(I,j,k) + US%s_to_T*dt * & (u_bc_accel(I,j,k) + CS%u_accel_bt(I,j,k))) enddo ; enddo do J=Jsq,Jeq ; do i=is,ie - v(i,J,k) = G%mask2dCv(i,J) * (v_init(i,J,k) + US%s_to_T*dt * & + v(i,J,k) = G%mask2dCv(i,J) * (v(i,J,k) + US%s_to_T*dt * & (v_bc_accel(i,J,k) + CS%v_accel_bt(i,J,k))) enddo ; enddo enddo @@ -798,7 +773,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & call hchksum(h, "Corrector 1 h", G%HI, haloshift=2, scale=GV%H_to_m) call uvchksum("Corrector 1 [uv]h", uh, vh, G%HI, haloshift=2, & symmetric=sym, scale=GV%H_to_m*US%L_to_m**2*US%s_to_T) - ! call MOM_state_chksum("Corrector 1", u, v, h, uh, vh, G, GV, US, haloshift=1, vel_scale=1.0) + ! call MOM_state_chksum("Corrector 1", u, v, h, uh, vh, G, GV, US, haloshift=1) call MOM_accel_chksum("Corrector accel", CS%CAu, CS%CAv, CS%PFu, CS%PFv, & CS%diffu, CS%diffv, G, GV, US, CS%pbce, CS%u_accel_bt, CS%v_accel_bt, & symmetric=sym) @@ -882,12 +857,6 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & do k=1,GV%ke ; do J=G%JsdB,G%JedB ; do i=G%isd,G%ied v(i,J,k) = US%L_T_to_m_s*v(i,J,k) enddo ; enddo ; enddo - do k=1,GV%ke ; do j=G%jsd,G%jed ; do I=G%IsdB,G%IedB - u_av(I,j,k) = US%L_T_to_m_s * u_av(I,j,k) - enddo ; enddo ; enddo - do k=1,GV%ke ; do J=G%JsdB,G%JedB ; do i=G%isd,G%ied - v_av(i,J,k) = US%L_T_to_m_s * v_av(i,J,k) - enddo ; enddo ; enddo ! The time-averaged free surface height has already been set by the last ! call to btstep. @@ -909,9 +878,9 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & if (CS%debug) then call MOM_state_chksum("Corrector ", u, v, h, uh, vh, G, GV, US, symmetric=sym, vel_scale=1.0) - call uvchksum("Corrector avg [uv]", u_av, v_av, G%HI, haloshift=1, symmetric=sym) + call uvchksum("Corrector avg [uv]", u_av, v_av, G%HI, haloshift=1, symmetric=sym, scale=US%L_T_to_m_s) call hchksum(h_av, "Corrector avg h", G%HI, haloshift=1, scale=GV%H_to_m) - ! call MOM_state_chksum("Corrector avg ", u_av, v_av, h_av, uh, vh, G, GV, US, vel_scale=1.0) + ! call MOM_state_chksum("Corrector avg ", u_av, v_av, h_av, uh, vh, G, GV, US) endif if (showCallTree) call callTree_leave("step_MOM_dyn_split_RK2()") @@ -1050,6 +1019,8 @@ subroutine initialize_dyn_split_RK2(u, v, h, uh, vh, eta, Time, G, GV, US, param character(len=48) :: thickness_units, flux_units, eta_rest_name real :: H_rescale ! A rescaling factor for thicknesses from the representation in ! a restart file to the internal representation in this run. + real :: vel_rescale ! A rescaling factor for velocities 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 :: accel_rescale ! A rescaling factor for accelerations from the representation in @@ -1208,8 +1179,13 @@ subroutine initialize_dyn_split_RK2(u, v, h, uh, vh, eta, Time, G, GV, US, param if (.not. query_initialized(CS%u_av,"u2", restart_CS) .or. & .not. query_initialized(CS%u_av,"v2", restart_CS)) then - CS%u_av(:,:,:) = u(:,:,:) - CS%v_av(:,:,:) = v(:,:,:) + CS%u_av(:,:,:) = US%m_s_to_L_T*u(:,:,:) + CS%v_av(:,:,:) = US%m_s_to_L_T*v(:,:,:) + 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 k=1,nz ; do j=js,je ; do I=G%IscB,G%IecB ; CS%u_av(I,j,k) = vel_rescale * CS%u_av(I,j,k) ; enddo ; enddo ; enddo + do k=1,nz ; do J=G%JscB,G%JecB ; do i=is,ie ; CS%v_av(i,J,k) = vel_rescale * CS%v_av(i,J,k) ; enddo ; enddo ; enddo endif ! This call is just here to initialize uh and vh. @@ -1262,9 +1238,9 @@ subroutine initialize_dyn_split_RK2(u, v, h, uh, vh, eta, Time, G, GV, US, param 'Meridional Pressure Force Acceleration', 'm s-2', conversion=US%L_T2_to_m_s2) CS%id_uav = register_diag_field('ocean_model', 'uav', diag%axesCuL, Time, & - 'Barotropic-step Averaged Zonal Velocity', 'm s-1') + 'Barotropic-step Averaged Zonal Velocity', 'm s-1', conversion=US%L_T_to_m_s) CS%id_vav = register_diag_field('ocean_model', 'vav', diag%axesCvL, Time, & - 'Barotropic-step Averaged Meridional Velocity', 'm s-1') + 'Barotropic-step Averaged Meridional Velocity', 'm s-1', conversion=US%L_T_to_m_s) CS%id_u_BT_accel = register_diag_field('ocean_model', 'u_BT_accel', diag%axesCuL, Time, & 'Barotropic Anomaly Zonal Acceleration', 'm s-2', conversion=US%L_T2_to_m_s2) From dd89a5ddd6f57968e3d9ee426e4d41754341b879 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Thu, 15 Aug 2019 16:40:40 -0400 Subject: [PATCH 212/297] +Pass velocities to step_MOM_dyn_... in [L T-1] Passed the velocity arguments to step_MOM_dyn_split_RK2, step_MOM_dyn_unsplit, step_MOM_dyn_unsplit_RK2, initialize_dyn_split_RK2, initialize_dyn_unsplit and initialize_dyn_unsplit_RK2 in rescaled units of [L T-1]. All answers are bitwise identical, but the rescaled units of several arguments in a public interface have changed. --- src/core/MOM.F90 | 35 +++++++++++++++++++++ src/core/MOM_dynamics_split_RK2.F90 | 45 +++++++++------------------ src/core/MOM_dynamics_unsplit.F90 | 32 +++++-------------- src/core/MOM_dynamics_unsplit_RK2.F90 | 30 +++++------------- 4 files changed, 65 insertions(+), 77 deletions(-) diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index c45d017036..0053a7dd81 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -979,6 +979,15 @@ subroutine step_MOM_dynamics(forces, p_surf_begin, p_surf_end, dt, dt_thermo, & call disable_averaging(CS%diag) endif + + !### This is temporary and will be deleted when the units of the velocities have changed. + do k=1,GV%ke ; do j=G%jsd,G%jed ; do I=G%IsdB,G%IedB + u(I,j,k) = US%m_s_to_L_T*u(I,j,k) + enddo ; enddo ; enddo + do k=1,GV%ke ; do J=G%JsdB,G%JedB ; do i=G%isd,G%ied + v(i,J,k) = US%m_s_to_L_T*v(i,J,k) + enddo ; enddo ; enddo + if (CS%do_dynamics .and. CS%split) then !--------------------------- start SPLIT ! This section uses a split time stepping scheme for the dynamic equations, ! basically the stacked shallow water equations with viscosity. @@ -1019,6 +1028,14 @@ subroutine step_MOM_dynamics(forces, p_surf_begin, p_surf_end, dt, dt_thermo, & endif ! -------------------------------------------------- end SPLIT + !### This is temporary and will be deleted when the units of the velocities have changed. + do k=1,GV%ke ; do j=G%jsd,G%jed ; do I=G%IsdB,G%IedB + u(I,j,k) = US%L_T_to_m_s*u(I,j,k) + enddo ; enddo ; enddo + do k=1,GV%ke ; do J=G%JsdB,G%JedB ; do i=G%isd,G%ied + v(i,J,k) = US%L_T_to_m_s*v(i,J,k) + enddo ; enddo ; enddo + if (CS%thickness_diffuse .and. .not.CS%thickness_diffuse_first) then call cpu_clock_begin(id_clock_thick_diff) @@ -2321,6 +2338,15 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, 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) call thickness_diffuse_init(Time, G, GV, US, param_file, diag, CS%CDp, CS%thickness_diffuse_CSp) + + !### This is temporary and will be deleted when the units of the velocities have changed. + do k=1,GV%ke ; do j=G%jsd,G%jed ; do I=G%IsdB,G%IedB + CS%u(I,j,k) = US%m_s_to_L_T*CS%u(I,j,k) + enddo ; enddo ; enddo + do k=1,GV%ke ; do J=G%JsdB,G%JedB ; do i=G%isd,G%ied + CS%v(i,J,k) = US%m_s_to_L_T*CS%v(i,J,k) + enddo ; enddo ; enddo + if (CS%split) then allocate(eta(SZI_(G),SZJ_(G))) ; eta(:,:) = 0.0 call initialize_dyn_split_RK2(CS%u, CS%v, CS%h, CS%uh, CS%vh, eta, Time, & @@ -2354,6 +2380,15 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & CS%update_OBC_CSp, CS%ALE_CSp, CS%set_visc_CSp, CS%visc, dirs, & CS%ntrunc) endif + + !### This is temporary and will be deleted when the units of the velocities have changed. + do k=1,GV%ke ; do j=G%jsd,G%jed ; do I=G%IsdB,G%IedB + CS%u(I,j,k) = US%L_T_to_m_s*CS%u(I,j,k) + enddo ; enddo ; enddo + do k=1,GV%ke ; do J=G%JsdB,G%JedB ; do i=G%isd,G%ied + CS%v(i,J,k) = US%L_T_to_m_s*CS%v(i,J,k) + enddo ; enddo ; enddo + call callTree_waypoint("dynamics initialized (initialize_MOM)") CS%mixedlayer_restrat = mixedlayer_restrat_init(Time, G, GV, US, param_file, diag, & diff --git a/src/core/MOM_dynamics_split_RK2.F90 b/src/core/MOM_dynamics_split_RK2.F90 index 7dae7774a3..9f3aca1d4b 100644 --- a/src/core/MOM_dynamics_split_RK2.F90 +++ b/src/core/MOM_dynamics_split_RK2.F90 @@ -238,9 +238,9 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & 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)), & - target, intent(inout) :: u !< zonal velocity [m s-1] + target, intent(inout) :: u !< zonal velocity [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - target, intent(inout) :: v !< merid velocity [m s-1] + target, intent(inout) :: v !< merid velocity [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(inout) :: h !< layer thickness [H ~> m or kg m-2] type(thermo_var_ptrs), intent(in) :: tv !< thermodynamic type @@ -337,14 +337,6 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & showCallTree = callTree_showQuery() if (showCallTree) call callTree_enter("step_MOM_dyn_split_RK2(), MOM_dynamics_split_RK2.F90") - !### This is temporary and will be deleted when the units of the input velocities have changed. - do k=1,GV%ke ; do j=G%jsd,G%jed ; do I=G%IsdB,G%IedB - u(I,j,k) = US%m_s_to_L_T*u(I,j,k) - enddo ; enddo ; enddo - do k=1,GV%ke ; do J=G%JsdB,G%JedB ; do i=G%isd,G%ied - v(i,J,k) = US%m_s_to_L_T*v(i,J,k) - enddo ; enddo ; enddo - !$OMP parallel do default(shared) do k=1,nz do j=G%jsd,G%jed ; do i=G%isdB,G%iedB ; up(i,j,k) = 0.0 ; enddo ; enddo @@ -849,15 +841,6 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & enddo ; enddo enddo - !### Remove this later. - !### This is temporary and will be deleted when the units of the input velocities have changed. - do k=1,GV%ke ; do j=G%jsd,G%jed ; do I=G%IsdB,G%IedB - u(I,j,k) = US%L_T_to_m_s*u(I,j,k) - enddo ; enddo ; enddo - do k=1,GV%ke ; do J=G%JsdB,G%JedB ; do i=G%isd,G%ied - v(i,J,k) = US%L_T_to_m_s*v(i,J,k) - enddo ; enddo ; enddo - ! The time-averaged free surface height has already been set by the last ! call to btstep. @@ -976,9 +959,9 @@ subroutine initialize_dyn_split_RK2(u, v, h, uh, vh, eta, Time, G, GV, US, param 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] + intent(inout) :: u !< zonal velocity [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - intent(inout) :: v !< merid velocity [m s-1] + intent(inout) :: v !< merid velocity [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJ_(G),SZK_(G)) , intent(inout) :: h !< layer thickness [H ~> m or kg m-2] real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & target, intent(inout) :: uh !< zonal volume/mass transport [H L2 T-1 ~> m3 s-1 or kg s-1] @@ -1155,13 +1138,13 @@ subroutine initialize_dyn_split_RK2(u, v, h, uh, vh, eta, Time, G, GV, US, param ! Copy eta into an output array. do j=js,je ; do i=is,ie ; eta(i,j) = CS%eta(i,j) ; enddo ; enddo - call barotropic_init(US%m_s_to_L_T*u, US%m_s_to_L_T*v, h, CS%eta, Time, G, GV, US, param_file, diag, & + call barotropic_init(u, v, h, CS%eta, Time, G, GV, US, param_file, diag, & CS%barotropic_CSp, restart_CS, calc_dtbt, CS%BT_cont, & CS%tides_CSp) if (.not. query_initialized(CS%diffu,"diffu",restart_CS) .or. & .not. query_initialized(CS%diffv,"diffv",restart_CS)) then - call horizontal_viscosity(US%m_s_to_L_T*u, US%m_s_to_L_T*v, h, CS%diffu, CS%diffv, MEKE, VarMix, & + call horizontal_viscosity(u, v, h, CS%diffu, CS%diffv, MEKE, VarMix, & G, GV, US, CS%hor_visc_CSp, & OBC=CS%OBC, BT=CS%barotropic_CSp) else @@ -1179,22 +1162,24 @@ subroutine initialize_dyn_split_RK2(u, v, h, uh, vh, eta, Time, G, GV, US, param if (.not. query_initialized(CS%u_av,"u2", restart_CS) .or. & .not. query_initialized(CS%u_av,"v2", restart_CS)) then - CS%u_av(:,:,:) = US%m_s_to_L_T*u(:,:,:) - CS%v_av(:,:,:) = US%m_s_to_L_T*v(:,:,:) + do k=1,nz ; do j=jsd,jed ; do I=IsdB,IedB ; CS%u_av(I,j,k) = u(I,j,k) ; enddo ; enddo ; enddo + do k=1,nz ; do J=JsdB,JedB ; do i=isd,ied ; CS%v_av(i,J,k) = 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 vel_rescale = (US%m_to_L * US%s_to_T_restart) / (US%m_to_L_restart * US%s_to_T) - do k=1,nz ; do j=js,je ; do I=G%IscB,G%IecB ; CS%u_av(I,j,k) = vel_rescale * CS%u_av(I,j,k) ; enddo ; enddo ; enddo - do k=1,nz ; do J=G%JscB,G%JecB ; do i=is,ie ; CS%v_av(i,J,k) = vel_rescale * CS%v_av(i,J,k) ; enddo ; enddo ; enddo + do k=1,nz ; do j=jsd,jed ; do I=IsdB,IeDB ; CS%u_av(I,j,k) = vel_rescale * CS%u_av(I,j,k) ; enddo ; enddo ; enddo + do k=1,nz ; do J=JsdB,JedB ; do i=isd,ied ; CS%v_av(i,J,k) = vel_rescale * CS%v_av(i,J,k) ; enddo ; enddo ; enddo endif ! This call is just here to initialize uh and vh. if (.not. query_initialized(uh,"uh",restart_CS) .or. & .not. query_initialized(vh,"vh",restart_CS)) then - h_tmp(:,:,:) = h(:,:,:) - call continuity(US%m_s_to_L_T*u, US%m_s_to_L_T*v, h, h_tmp, uh, vh, dt, G, GV, US, CS%continuity_CSp, OBC=CS%OBC) + do k=1,nz ; do j=jsd,jed ; do i=isd,ied ; h_tmp(i,j,k) = h(i,j,k) ; enddo ; enddo ; enddo + 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(:,:,:)) + do k=1,nz ; do j=jsd,jed ; do i=isd,ied + CS%h_av(i,j,k) = 0.5*(h(i,j,k) + h_tmp(i,j,k)) + enddo ; enddo ; enddo else if (.not. query_initialized(CS%h_av,"h2",restart_CS)) then CS%h_av(:,:,:) = h(:,:,:) diff --git a/src/core/MOM_dynamics_unsplit.F90 b/src/core/MOM_dynamics_unsplit.F90 index d51ab1b526..879310f2fa 100644 --- a/src/core/MOM_dynamics_unsplit.F90 +++ b/src/core/MOM_dynamics_unsplit.F90 @@ -187,8 +187,8 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & 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 - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: u !< The zonal velocity [m s-1]. - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: v !< The meridional velocity [m s-1]. + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: u !< The zonal velocity [L T-1 ~> m s-1]. + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: v !< The meridional velocity [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: h !< Layer thicknesses [H ~> m or kg m-2]. type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various !! thermodynamic variables. @@ -234,14 +234,6 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB dt_pred = dt / 3.0 - !### This is temporary and will be deleted when the units of the input velocities have changed. - do k=1,GV%ke ; do j=G%jsd,G%jed ; do I=G%IsdB,G%IedB - u(I,j,k) = US%m_s_to_L_T*u(I,j,k) - enddo ; enddo ; enddo - do k=1,GV%ke ; do J=G%JsdB,G%JedB ; do i=G%isd,G%ied - v(i,J,k) = US%m_s_to_L_T*v(i,J,k) - enddo ; enddo ; enddo - h_av(:,:,:) = 0; hp(:,:,:) = 0 up(:,:,:) = 0; upp(:,:,:) = 0 vp(:,:,:) = 0; vpp(:,:,:) = 0 @@ -257,7 +249,7 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & ! all of the fields except h. h is stepped separately. if (CS%debug) then - call MOM_state_chksum("Start First Predictor ", u, v, h, uh, vh, G, GV, US, vel_scale=US%L_T_to_m_s) + call MOM_state_chksum("Start First Predictor ", u, v, h, uh, vh, G, GV, US) endif ! diffu = horizontal viscosity terms (u,h) @@ -341,7 +333,7 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & call cpu_clock_end(id_clock_mom_update) if (CS%debug) then - call MOM_state_chksum("Predictor 1", up, vp, h_av, uh, vh, G, GV, US, vel_scale=US%L_T_to_m_s) + call MOM_state_chksum("Predictor 1", up, vp, h_av, uh, vh, G, GV, US) call MOM_accel_chksum("Predictor 1 accel", CS%CAu, CS%CAv, CS%PFu, CS%PFv,& CS%diffu, CS%diffv, G, GV, US) endif @@ -409,7 +401,7 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & call cpu_clock_end(id_clock_mom_update) if (CS%debug) then - call MOM_state_chksum("Predictor 2", upp, vpp, h_av, uh, vh, G, GV, US, vel_scale=US%L_T_to_m_s) + call MOM_state_chksum("Predictor 2", upp, vpp, h_av, uh, vh, G, GV, US) call MOM_accel_chksum("Predictor 2 accel", CS%CAu, CS%CAv, CS%PFu, CS%PFv,& CS%diffu, CS%diffv, G, GV, US) endif @@ -494,7 +486,7 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & call pass_vector(u, v, G%Domain, clock=id_clock_pass) if (CS%debug) then - call MOM_state_chksum("Corrector", u, v, h, uh, vh, G, GV, US, vel_scale=US%L_T_to_m_s) + call MOM_state_chksum("Corrector", u, v, h, uh, vh, G, GV, US) call MOM_accel_chksum("Corrector accel", CS%CAu, CS%CAv, CS%PFu, CS%PFv, & CS%diffu, CS%diffv, G, GV, US) endif @@ -510,14 +502,6 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & if (dyn_p_surf) deallocate(p_surf) - !### This is temporary and will be deleted when the units of the input velocities have changed. - do k=1,GV%ke ; do j=G%jsd,G%jed ; do I=G%IsdB,G%IedB - u(I,j,k) = US%L_T_to_m_s*u(I,j,k) - enddo ; enddo ; enddo - do k=1,GV%ke ; do J=G%JsdB,G%JedB ; do i=G%isd,G%ied - v(i,J,k) = US%L_T_to_m_s*v(i,J,k) - enddo ; enddo ; enddo - ! Here various terms used in to update the momentum equations are ! offered for averaging. if (CS%id_PFu > 0) call post_data(CS%id_PFu, CS%PFu, CS%diag) @@ -581,9 +565,9 @@ subroutine initialize_dyn_unsplit(u, v, h, Time, G, GV, US, param_file, diag, CS 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(inout) :: u !< The zonal velocity [m s-1]. + intent(inout) :: u !< The zonal velocity [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - intent(inout) :: v !< The meridional velocity [m s-1]. + intent(inout) :: v !< The meridional velocity [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)) , & intent(inout) :: h !< Layer thicknesses [H ~> m or kg m-2] type(time_type), target, intent(in) :: Time !< The current model time. diff --git a/src/core/MOM_dynamics_unsplit_RK2.F90 b/src/core/MOM_dynamics_unsplit_RK2.F90 index d80b786a8a..7a67254d71 100644 --- a/src/core/MOM_dynamics_unsplit_RK2.F90 +++ b/src/core/MOM_dynamics_unsplit_RK2.F90 @@ -191,9 +191,9 @@ subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt, 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(inout) :: u_in !< The input and output zonal - !! velocity [m s-1]. + !! velocity [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: v_in !< The input and output meridional - !! velocity [m s-1]. + !! velocity [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: h_in !< The input and output layer thicknesses, !! [H ~> m or kg m-2], depending on whether !! the Boussinesq approximation is made. @@ -245,14 +245,6 @@ subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt, Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB dt_pred = dt * CS%BE - !### This is temporary and will be deleted when the units of the input velocities have changed. - do k=1,GV%ke ; do j=G%jsd,G%jed ; do I=G%IsdB,G%IedB - u_in(I,j,k) = US%m_s_to_L_T*u_in(I,j,k) - enddo ; enddo ; enddo - do k=1,GV%ke ; do J=G%JsdB,G%JedB ; do i=G%isd,G%ied - v_in(i,J,k) = US%m_s_to_L_T*v_in(i,J,k) - enddo ; enddo ; enddo - h_av(:,:,:) = 0; hp(:,:,:) = 0 up(:,:,:) = 0 vp(:,:,:) = 0 @@ -268,7 +260,7 @@ subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt, ! all of the fields except h. h is stepped separately. if (CS%debug) then - call MOM_state_chksum("Start Predictor ", u_in, v_in, h_in, uh, vh, G, GV, US, vel_scale=US%L_T_to_m_s) + call MOM_state_chksum("Start Predictor ", u_in, v_in, h_in, uh, vh, G, GV, US) endif ! diffu = horizontal viscosity terms (u,h) @@ -370,7 +362,7 @@ subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt, enddo ; enddo ; enddo if (CS%debug) & - call MOM_state_chksum("Predictor 1", up, vp, h_av, uh, vh, G, GV, US, vel_scale=US%L_T_to_m_s) + call MOM_state_chksum("Predictor 1", up, vp, h_av, uh, vh, G, GV, US) ! CAu = -(f+zeta(up))/h_av vh + d/dx KE(up) (function of up[n-1/2], h[n-1/2]) call cpu_clock_begin(id_clock_Cor) @@ -432,7 +424,7 @@ subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt, enddo if (CS%debug) then - call MOM_state_chksum("Corrector", u_in, v_in, h_in, uh, vh, G, GV, US, vel_scale=US%L_T_to_m_s) + call MOM_state_chksum("Corrector", u_in, v_in, h_in, uh, vh, G, GV, US) call MOM_accel_chksum("Corrector accel", CS%CAu, CS%CAv, CS%PFu, CS%PFv, & CS%diffu, CS%diffv, G, GV, US) endif @@ -448,14 +440,6 @@ subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt, if (dyn_p_surf) deallocate(p_surf) - !### This is temporary and will be deleted when the units of the input velocities have changed. - do k=1,GV%ke ; do j=G%jsd,G%jed ; do I=G%IsdB,G%IedB - u_in(I,j,k) = US%L_T_to_m_s*u_in(I,j,k) - enddo ; enddo ; enddo - do k=1,GV%ke ; do J=G%JsdB,G%JedB ; do i=G%isd,G%ied - v_in(i,J,k) = US%L_T_to_m_s*v_in(i,J,k) - enddo ; enddo ; enddo - ! Here various terms used in to update the momentum equations are ! offered for averaging. if (CS%id_PFu > 0) call post_data(CS%id_PFu, CS%PFu, CS%diag) @@ -525,8 +509,8 @@ subroutine initialize_dyn_unsplit_RK2(u, v, h, Time, G, GV, US, param_file, diag 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 - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: u !< The zonal velocity [m s-1]. - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: v !< The meridional velocity [m s-1]. + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: u !< The zonal velocity [L T-1 ~> m s-1]. + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: v !< The meridional velocity [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)) , intent(inout) :: h !< Layer thicknesses [H ~> m or kg m-2] type(time_type), target, intent(in) :: Time !< The current model time. type(param_file_type), intent(in) :: param_file !< A structure to parse From 8d96f8d48e1bd0b18a535f0931b937e1b283437b Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Thu, 15 Aug 2019 17:46:09 -0400 Subject: [PATCH 213/297] Introduced dt_in_T to step_MOM_dyn... Introduced a new variable, dt_in_T, that is the time step in [T] to the three step_MOM_dyn... subroutines. Also changed the units of dt_pred from [s] to [T]. All answers are bitwise identical. --- src/core/MOM_dynamics_split_RK2.F90 | 35 +++++++++++++++------------ src/core/MOM_dynamics_unsplit.F90 | 32 ++++++++++++------------ src/core/MOM_dynamics_unsplit_RK2.F90 | 30 ++++++++++++----------- 3 files changed, 52 insertions(+), 45 deletions(-) diff --git a/src/core/MOM_dynamics_split_RK2.F90 b/src/core/MOM_dynamics_split_RK2.F90 index 9f3aca1d4b..17beedc723 100644 --- a/src/core/MOM_dynamics_split_RK2.F90 +++ b/src/core/MOM_dynamics_split_RK2.F90 @@ -276,8 +276,6 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & !! fields related to the surface wave conditions ! local variables - real :: dt_pred ! The time step for the predictor part of the baroclinic time stepping. - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)) :: up ! Predicted zonal velocity [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)) :: vp ! Predicted meridional velocity [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: hp ! Predicted thickness [H ~> m or kg m-2]. @@ -317,7 +315,10 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & u_av, & ! The zonal velocity time-averaged over a time step [L T-1 ~> m s-1]. v_av, & ! The meridional velocity time-averaged over a time step [L T-1 ~> m s-1]. h_av ! The layer thickness time-averaged over a time step [H ~> m or kg m-2]. - real :: Idt + real :: dt_in_T ! The dynamics time step [T ~> s] + real :: dt_pred ! The time step for the predictor part of the baroclinic time stepping [T ~> s]. + + real :: Idt ! The inverse of the timestep [s-1] logical :: dyn_p_surf logical :: BT_cont_BT_thick ! If true, use the BT_cont_type to estimate the ! relative weightings of the layers in calculating @@ -330,6 +331,8 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & 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 u_av => CS%u_av ; v_av => CS%v_av ; h_av => CS%h_av ; eta => CS%eta + + dt_in_T = US%s_to_T*dt Idt = 1.0 / dt sym=.false.;if (G%Domain%symmetric) sym=.true. ! switch to include symmetric domain in checksums @@ -467,10 +470,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 - up(I,j,k) = G%mask2dCu(I,j) * (u(I,j,k) + US%s_to_T*dt * u_bc_accel(I,j,k)) + up(I,j,k) = G%mask2dCu(I,j) * (u(I,j,k) + dt_in_T * u_bc_accel(I,j,k)) enddo ; enddo do J=Jsq,Jeq ; do i=is,ie - vp(i,J,k) = G%mask2dCv(i,J) * (v(i,J,k) + US%s_to_T*dt * v_bc_accel(i,J,k)) + vp(i,J,k) = G%mask2dCv(i,J) * (v(i,J,k) + dt_in_T * v_bc_accel(i,J,k)) enddo ; enddo enddo @@ -539,17 +542,17 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & call cpu_clock_end(id_clock_btstep) ! up = u + dt_pred*( u_bc_accel + u_accel_bt ) - dt_pred = dt * CS%be + dt_pred = dt_in_T * CS%be call cpu_clock_begin(id_clock_mom_update) !$OMP parallel do default(shared) do k=1,nz do J=Jsq,Jeq ; do i=is,ie - vp(i,J,k) = G%mask2dCv(i,J) * (v(i,J,k) + US%s_to_T*dt_pred * & + vp(i,J,k) = G%mask2dCv(i,J) * (v(i,J,k) + dt_pred * & (v_bc_accel(i,J,k) + CS%v_accel_bt(i,J,k))) enddo ; enddo do j=js,je ; do I=Isq,Ieq - up(I,j,k) = G%mask2dCu(I,j) * (u(I,j,k) + US%s_to_T*dt_pred * & + up(I,j,k) = G%mask2dCu(I,j) * (u(I,j,k) + dt_pred * & (u_bc_accel(I,j,k) + CS%u_accel_bt(I,j,k))) enddo ; enddo enddo @@ -575,9 +578,9 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & if (CS%debug) then call uvchksum("0 before vertvisc: [uv]p", up, vp, G%HI,haloshift=0, symmetric=sym, scale=US%L_T_to_m_s) endif - call vertvisc_coef(up, vp, h, forces, visc, dt_pred, G, GV, US, CS%vertvisc_CSp, & + call vertvisc_coef(up, vp, h, forces, visc, US%T_to_s*dt_pred, G, GV, US, CS%vertvisc_CSp, & CS%OBC) - call vertvisc(up, vp, h, forces, visc, dt_pred, CS%OBC, CS%ADp, CS%CDp, G, & + call vertvisc(up, vp, h, forces, visc, US%T_to_s*dt_pred, CS%OBC, CS%ADp, CS%CDp, G, & GV, US, CS%vertvisc_CSp, CS%taux_bot, CS%tauy_bot, waves=waves) if (showCallTree) call callTree_wayPoint("done with vertvisc (step_MOM_dyn_split_RK2)") if (G%nonblocking_updates) then @@ -585,7 +588,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, US, CS%vertvisc_CSp) + call vertvisc_remnant(visc, CS%visc_rem_u, CS%visc_rem_v, US%T_to_s*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) @@ -611,7 +614,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & if (CS%debug) & call uvchksum("Pre OBC avg [uv]", u_av, v_av, G%HI, haloshift=1, symmetric=sym, scale=US%L_T_to_m_s) - call radiation_open_bdry_conds(CS%OBC, u_av, u_old_rad_OBC, v_av, v_old_rad_OBC, G, US, dt_pred) + call radiation_open_bdry_conds(CS%OBC, u_av, u_old_rad_OBC, v_av, v_old_rad_OBC, G, US, US%T_to_s*dt_pred) if (CS%debug) & call uvchksum("Post OBC avg [uv]", u_av, v_av, G%HI, haloshift=1, symmetric=sym, scale=US%L_T_to_m_s) @@ -750,11 +753,11 @@ 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(I,j,k) = G%mask2dCu(I,j) * (u(I,j,k) + US%s_to_T*dt * & + u(I,j,k) = G%mask2dCu(I,j) * (u(I,j,k) + dt_in_T * & (u_bc_accel(I,j,k) + CS%u_accel_bt(I,j,k))) enddo ; enddo do J=Jsq,Jeq ; do i=is,ie - v(i,J,k) = G%mask2dCv(i,J) * (v(i,J,k) + US%s_to_T*dt * & + v(i,J,k) = G%mask2dCv(i,J) * (v(i,J,k) + dt_in_T * & (v_bc_accel(i,J,k) + CS%v_accel_bt(i,J,k))) enddo ; enddo enddo @@ -834,10 +837,10 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & !$OMP parallel do default(shared) do k=1,nz do j=js-2,je+2 ; do I=Isq-2,Ieq+2 - uhtr(I,j,k) = uhtr(I,j,k) + uh(I,j,k)*US%s_to_T*dt + uhtr(I,j,k) = uhtr(I,j,k) + uh(I,j,k)*dt_in_T enddo ; enddo do J=Jsq-2,Jeq+2 ; do i=is-2,ie+2 - vhtr(i,J,k) = vhtr(i,J,k) + vh(i,J,k)*US%s_to_T*dt + vhtr(i,J,k) = vhtr(i,J,k) + vh(i,J,k)*dt_in_T enddo ; enddo enddo diff --git a/src/core/MOM_dynamics_unsplit.F90 b/src/core/MOM_dynamics_unsplit.F90 index 879310f2fa..1dc08b0abe 100644 --- a/src/core/MOM_dynamics_unsplit.F90 +++ b/src/core/MOM_dynamics_unsplit.F90 @@ -226,13 +226,14 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & real, dimension(SZIB_(G),SZJ_(G),SZK_(G)) :: up, upp ! Predicted zonal velocities [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJB_(G),SZK_(G)) :: vp, vpp ! Predicted meridional velocities [L T-1 ~> m s-1] real, dimension(:,:), pointer :: p_surf => NULL() - real :: dt_pred ! The time step for the predictor part of the baroclinic - ! time stepping. + real :: dt_in_T ! The dynamics time step [T ~> s] + real :: dt_pred ! The time step for the predictor part of the baroclinic time stepping [T ~> s]. logical :: dyn_p_surf integer :: i, j, k, is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz 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 - dt_pred = dt / 3.0 + dt_in_T = US%s_to_T*dt + dt_pred = dt_in_T / 3.0 h_av(:,:,:) = 0; hp(:,:,:) = 0 up(:,:,:) = 0; upp(:,:,:) = 0 @@ -282,16 +283,16 @@ 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) + US%s_to_T*dt * CS%diffu(I,j,k) * G%mask2dCu(I,j) + u(I,j,k) = u(I,j,k) + dt_in_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) + US%s_to_T*dt * CS%diffv(i,J,k) * G%mask2dCv(i,J) + v(i,J,k) = v(i,J,k) + dt_in_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*US%s_to_T*dt*uh(i,j,k) + uhtr(i,j,k) = uhtr(i,j,k) + 0.5*dt_in_T*uh(i,j,k) enddo ; enddo do J=Jsq-2,Jeq+2 ; do i=is-2,ie+2 - vhtr(i,j,k) = vhtr(i,j,k) + 0.5*US%s_to_T*dt*vh(i,j,k) + vhtr(i,j,k) = vhtr(i,j,k) + 0.5*dt_in_T*vh(i,j,k) enddo ; enddo enddo call cpu_clock_end(id_clock_mom_update) @@ -323,11 +324,11 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & ! up = u + dt_pred * (PFu + CAu) 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(I,j,k) + US%s_to_T*dt_pred * & + up(I,j,k) = G%mask2dCu(I,j) * (u(I,j,k) + dt_pred * & (CS%PFu(I,j,k) + CS%CAu(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(i,J,k) + US%s_to_T*dt_pred * & + vp(i,J,k) = G%mask2dCv(i,J) * (v(i,J,k) + dt_pred * & (CS%PFv(i,J,k) + CS%CAv(i,J,k))) enddo ; enddo ; enddo call cpu_clock_end(id_clock_mom_update) @@ -344,6 +345,7 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & call set_viscous_ML(u, v, h_av, tv, forces, visc, dt*0.5, G, GV, US, & CS%set_visc_CSp) call disable_averaging(CS%diag) + !### I think that the time steps in the next two calls should be dt_pred. call vertvisc_coef(up, vp, h_av, forces, visc, dt*0.5, G, GV, US, & CS%vertvisc_CSp, CS%OBC) call vertvisc(up, vp, h_av, forces, visc, dt*0.5, CS%OBC, CS%ADp, CS%CDp, & @@ -391,11 +393,11 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & ! upp = u + dt/2 * ( PFu + CAu ) call cpu_clock_begin(id_clock_mom_update) do k=1,nz ; do j=js,je ; do I=Isq,Ieq - upp(I,j,k) = G%mask2dCu(I,j) * (u(I,j,k) + US%s_to_T*dt * 0.5 * & + upp(I,j,k) = G%mask2dCu(I,j) * (u(I,j,k) + dt_in_T * 0.5 * & (CS%PFu(I,j,k) + CS%CAu(I,j,k))) enddo ; enddo ; enddo do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie - vpp(i,J,k) = G%mask2dCv(i,J) * (v(i,J,k) + US%s_to_T*dt * 0.5 * & + vpp(i,J,k) = G%mask2dCv(i,J) * (v(i,J,k) + dt_in_T * 0.5 * & (CS%PFv(i,J,k) + CS%CAv(i,J,k))) enddo ; enddo ; enddo call cpu_clock_end(id_clock_mom_update) @@ -440,10 +442,10 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & h_av(i,j,k) = 0.5*(h(i,j,k) + hp(i,j,k)) enddo ; enddo do j=js-2,je+2 ; do I=Isq-2,Ieq+2 - uhtr(i,j,k) = uhtr(i,j,k) + 0.5*US%s_to_T*dt*uh(i,j,k) + uhtr(i,j,k) = uhtr(i,j,k) + 0.5*dt_in_T*uh(i,j,k) enddo ; enddo do J=Jsq-2,Jeq+2 ; do i=is-2,ie+2 - vhtr(i,j,k) = vhtr(i,j,k) + 0.5*US%s_to_T*dt*vh(i,j,k) + vhtr(i,j,k) = vhtr(i,j,k) + 0.5*dt_in_T*vh(i,j,k) enddo ; enddo enddo @@ -469,11 +471,11 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & call open_boundary_zero_normal_flow(CS%OBC, G, CS%CAu, CS%CAv) endif do k=1,nz ; do j=js,je ; do I=Isq,Ieq - u(I,j,k) = G%mask2dCu(I,j) * (u(I,j,k) + US%s_to_T*dt * & + u(I,j,k) = G%mask2dCu(I,j) * (u(I,j,k) + dt_in_T * & (CS%PFu(I,j,k) + CS%CAu(I,j,k))) enddo ; enddo ; enddo do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie - v(i,J,k) = G%mask2dCv(i,J) * (v(i,J,k) + US%s_to_T*dt * & + v(i,J,k) = G%mask2dCv(i,J) * (v(i,J,k) + dt_in_T * & (CS%PFv(i,J,k) + CS%CAv(i,J,k))) enddo ; enddo ; enddo diff --git a/src/core/MOM_dynamics_unsplit_RK2.F90 b/src/core/MOM_dynamics_unsplit_RK2.F90 index 7a67254d71..c4be7f96b9 100644 --- a/src/core/MOM_dynamics_unsplit_RK2.F90 +++ b/src/core/MOM_dynamics_unsplit_RK2.F90 @@ -237,13 +237,15 @@ subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt, real, dimension(SZIB_(G),SZJ_(G),SZK_(G)) :: up ! Predicted zonal velocities [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJB_(G),SZK_(G)) :: vp ! Predicted meridional velocities [L T-1 ~> m s-1] real, dimension(:,:), pointer :: p_surf => NULL() + real :: dt_in_T ! The dynamics time step [T ~> s] real :: dt_pred ! The time step for the predictor part of the baroclinic - ! time stepping. + ! time stepping [T ~> s]. logical :: dyn_p_surf integer :: i, j, k, is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz 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 - dt_pred = dt * CS%BE + dt_in_T = US%s_to_T*dt + dt_pred = dt_in_T * CS%BE h_av(:,:,:) = 0; hp(:,:,:) = 0 up(:,:,:) = 0 @@ -279,7 +281,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, US, & + call continuity(u_in, v_in, h_in, hp, uh, vh, US%T_to_s*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) @@ -322,11 +324,11 @@ subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt, ! up+[n-1/2] = u[n-1] + dt_pred * (PFu + CAu) 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) + US%s_to_T*dt_pred * & + 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))) 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) + US%s_to_T*dt_pred * & + 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))) enddo ; enddo ; enddo call cpu_clock_end(id_clock_mom_update) @@ -338,12 +340,12 @@ subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt, ! 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) call enable_averaging(dt, Time_local, CS%diag) - call set_viscous_ML(up, vp, h_av, tv, forces, visc, dt_pred, G, GV, US, & + call set_viscous_ML(up, vp, h_av, tv, forces, visc, US%T_to_s*dt_pred, G, GV, US, & CS%set_visc_CSp) call disable_averaging(CS%diag) - call vertvisc_coef(up, vp, h_av, forces, visc, dt_pred, G, GV, US, & + call vertvisc_coef(up, vp, h_av, forces, visc, US%T_to_s*dt_pred, G, GV, US, & CS%vertvisc_CSp, CS%OBC) - call vertvisc(up, vp, h_av, forces, visc, dt_pred, CS%OBC, CS%ADp, CS%CDp, & + call vertvisc(up, vp, h_av, forces, visc, US%T_to_s*dt_pred, CS%OBC, CS%ADp, CS%CDp, & G, GV, US, CS%vertvisc_CSp) call cpu_clock_end(id_clock_vertvisc) call pass_vector(up, vp, G%Domain, clock=id_clock_pass) @@ -378,15 +380,15 @@ subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt, ! up* = u[n] + (1+gamma) * dt * ( PFu + CAu ) Extrapolated for damping ! 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) + US%s_to_T*dt * (1.+CS%begw) * & + up(I,j,k) = G%mask2dCu(I,j) * (u_in(I,j,k) + dt_in_T * (1.+CS%begw) * & ((CS%PFu(I,j,k) + CS%CAu(I,j,k)) + CS%diffu(I,j,k))) - u_in(I,j,k) = G%mask2dCu(I,j) * (u_in(I,j,k) + US%s_to_T*dt * & + u_in(I,j,k) = G%mask2dCu(I,j) * (u_in(I,j,k) + dt_in_T * & ((CS%PFu(I,j,k) + CS%CAu(I,j,k)) + 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) + US%s_to_T*dt * (1.+CS%begw) * & + vp(i,J,k) = G%mask2dCv(i,J) * (v_in(i,J,k) + dt_in_T * (1.+CS%begw) * & ((CS%PFv(i,J,k) + CS%CAv(i,J,k)) + CS%diffv(i,J,k))) - v_in(i,J,k) = G%mask2dCv(i,J) * (v_in(i,J,k) + US%s_to_T*dt * & + v_in(i,J,k) = G%mask2dCv(i,J) * (v_in(i,J,k) + dt_in_T * & ((CS%PFv(i,J,k) + CS%CAv(i,J,k)) + CS%diffv(i,J,k))) enddo ; enddo ; enddo @@ -416,10 +418,10 @@ subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt, ! Accumulate mass flux for tracer transport do k=1,nz do j=js-2,je+2 ; do I=Isq-2,Ieq+2 - uhtr(I,j,k) = uhtr(I,j,k) + US%s_to_T*dt*uh(I,j,k) + uhtr(I,j,k) = uhtr(I,j,k) + dt_in_T*uh(I,j,k) enddo ; enddo do J=Jsq-2,Jeq+2 ; do i=is-2,ie+2 - vhtr(i,J,k) = vhtr(i,J,k) + US%s_to_T*dt*vh(i,J,k) + vhtr(i,J,k) = vhtr(i,J,k) + dt_in_T*vh(i,J,k) enddo ; enddo enddo From 80523af9df627359465924a0af2d4f0b5a77ddd4 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Thu, 15 Aug 2019 18:36:43 -0400 Subject: [PATCH 214/297] +Point MIS%u_prev to MOM_control_struct%u_prev MIS%u_prev is supposed to point to MOM_control_struct%u_prev, but somehow this was not happening. This has now been fixed, and the units of MIS%u_prev are now [L T-1]. Also corrected units in the documentation of ocean_internal_state. This will restore some diagnostics of truncations that were present in the code but have been disabled for some time. The model solutions are bitwise identical. --- src/core/MOM.F90 | 81 ++++++++++-------------------- src/core/MOM_variables.F90 | 16 +++--- src/diagnostics/MOM_PointAccel.F90 | 20 ++++---- 3 files changed, 44 insertions(+), 73 deletions(-) diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index 0053a7dd81..af534f90de 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -251,8 +251,8 @@ module MOM type(cont_diag_ptrs) :: CDp !< structure containing pointers to continuity equation !! terms, for derived diagnostics (e.g., energy budgets) real, dimension(:,:,:), pointer :: & - u_prev => NULL(), & !< previous value of u stored for diagnostics [m s-1] - v_prev => NULL() !< previous value of v stored for diagnostics [m s-1] + u_prev => NULL(), & !< previous value of u stored for diagnostics [L T-1 ~> m s-1] + v_prev => NULL() !< previous value of v stored for diagnostics [L T-1 ~> m s-1] logical :: interp_p_surf !< If true, linearly interpolate surface pressure !! over the coupling time step, using specified value @@ -615,6 +615,14 @@ subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, CS, & if (showCallTree) call callTree_enter("DT cycles (step_MOM) n=",n) + !### This will be removed later. + do k=1,nz ; do j=G%jsd,G%jed ; do I=G%IsdB,G%IedB + u(I,j,k) = US%m_s_to_L_T*u(I,j,k) + enddo ; enddo ; enddo + do k=1,nz ; do J=G%JsdB,G%JedB ; do i=G%isd,G%ied + v(i,J,k) = US%m_s_to_L_T*v(i,J,k) + enddo ; enddo ; enddo + !=========================================================================== ! This is the first place where the diabatic processes and remapping could occur. if (CS%diabatic_first .and. (CS%t_dyn_rel_adv==0.0) .and. do_thermo) then ! do thermodynamics. @@ -644,27 +652,11 @@ subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, CS, & end_time_thermo = Time_local + real_to_time(dtdia-dt) endif - !### This will be removed later. - do k=1,nz ; do j=G%jsd,G%jed ; do I=G%IsdB,G%IedB - u(I,j,k) = US%m_s_to_L_T*u(I,j,k) - enddo ; enddo ; enddo - do k=1,nz ; do J=G%JsdB,G%JedB ; do i=G%isd,G%ied - v(i,J,k) = US%m_s_to_L_T*v(i,J,k) - enddo ; enddo ; enddo - ! Apply diabatic forcing, do mixing, and regrid. call step_MOM_thermo(CS, G, GV, US, u, v, h, CS%tv, fluxes, dtdia, & end_time_thermo, .true., Waves=Waves) CS%time_in_thermo_cycle = CS%time_in_thermo_cycle + dtdia - !### This will be removed later. - do k=1,nz ; do j=G%jsd,G%jed ; do I=G%IsdB,G%IedB - u(I,j,k) = US%L_T_to_m_s*u(I,j,k) - enddo ; enddo ; enddo - do k=1,nz ; do J=G%JsdB,G%JedB ; do i=G%isd,G%ied - v(i,J,k) = US%L_T_to_m_s*v(i,J,k) - enddo ; enddo ; enddo - ! The diabatic processes are now ahead of the dynamics by dtdia. CS%t_dyn_rel_thermo = -dtdia if (showCallTree) call callTree_waypoint("finished diabatic_first (step_MOM)") @@ -759,27 +751,11 @@ subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, CS, & ! by the call to step_MOM_thermo, noting that they end at the same time. if (dtdia > dt) CS%Time = CS%Time - real_to_time(0.5*(dtdia-dt)) - !### This will be removed later. - do k=1,nz ; do j=G%jsd,G%jed ; do I=G%IsdB,G%IedB - u(I,j,k) = US%m_s_to_L_T*u(I,j,k) - enddo ; enddo ; enddo - do k=1,nz ; do J=G%JsdB,G%JedB ; do i=G%isd,G%ied - v(i,J,k) = US%m_s_to_L_T*v(i,J,k) - enddo ; enddo ; enddo - ! Apply diabatic forcing, do mixing, and regrid. call step_MOM_thermo(CS, G, GV, US, u, v, h, CS%tv, fluxes, dtdia, & Time_local, .false., Waves=Waves) CS%time_in_thermo_cycle = CS%time_in_thermo_cycle + dtdia - !### This will be removed later. - do k=1,nz ; do j=G%jsd,G%jed ; do I=G%IsdB,G%IedB - u(I,j,k) = US%L_T_to_m_s*u(I,j,k) - enddo ; enddo ; enddo - do k=1,nz ; do J=G%JsdB,G%JedB ; do i=G%isd,G%ied - v(i,J,k) = US%L_T_to_m_s*v(i,J,k) - enddo ; enddo ; enddo - if ((CS%t_dyn_rel_thermo==0.0) .and. .not.do_dyn) then ! The diabatic processes are now ahead of the dynamics by dtdia. CS%t_dyn_rel_thermo = -dtdia @@ -804,6 +780,14 @@ subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, CS, & call cpu_clock_end(id_clock_dynamics) endif + !### This will be removed later. + do k=1,nz ; do j=G%jsd,G%jed ; do I=G%IsdB,G%IedB + u(I,j,k) = US%L_T_to_m_s*u(I,j,k) + enddo ; enddo ; enddo + do k=1,nz ; do J=G%JsdB,G%JedB ; do i=G%isd,G%ied + v(i,J,k) = US%L_T_to_m_s*v(i,J,k) + enddo ; enddo ; enddo + !=========================================================================== ! Calculate diagnostics at the end of the time step if the state is self-consistent. if (MOM_state_is_synchronized(CS)) then @@ -972,7 +956,7 @@ subroutine step_MOM_dynamics(forces, p_surf_begin, p_surf_end, dt, dt_thermo, & Time_local + real_to_time(bbl_time_int-dt), CS%diag) ! Calculate the BBL properties and store them inside visc (u,h). call cpu_clock_begin(id_clock_BBL_visc) - call set_viscous_BBL(US%m_s_to_L_T*CS%u(:,:,:), US%m_s_to_L_T*CS%v(:,:,:), CS%h, CS%tv, CS%visc, G, GV, US, & + call set_viscous_BBL(CS%u(:,:,:), CS%v(:,:,:), CS%h, CS%tv, CS%visc, G, GV, US, & CS%set_visc_CSp, symmetrize=.true.) call cpu_clock_end(id_clock_BBL_visc) if (showCallTree) call callTree_wayPoint("done with set_viscous_BBL (step_MOM)") @@ -980,14 +964,6 @@ subroutine step_MOM_dynamics(forces, p_surf_begin, p_surf_end, dt, dt_thermo, & endif - !### This is temporary and will be deleted when the units of the velocities have changed. - do k=1,GV%ke ; do j=G%jsd,G%jed ; do I=G%IsdB,G%IedB - u(I,j,k) = US%m_s_to_L_T*u(I,j,k) - enddo ; enddo ; enddo - do k=1,GV%ke ; do J=G%JsdB,G%JedB ; do i=G%isd,G%ied - v(i,J,k) = US%m_s_to_L_T*v(i,J,k) - enddo ; enddo ; enddo - if (CS%do_dynamics .and. CS%split) then !--------------------------- start SPLIT ! This section uses a split time stepping scheme for the dynamic equations, ! basically the stacked shallow water equations with viscosity. @@ -1028,14 +1004,6 @@ subroutine step_MOM_dynamics(forces, p_surf_begin, p_surf_end, dt, dt_thermo, & endif ! -------------------------------------------------- end SPLIT - !### This is temporary and will be deleted when the units of the velocities have changed. - do k=1,GV%ke ; do j=G%jsd,G%jed ; do I=G%IsdB,G%IedB - u(I,j,k) = US%L_T_to_m_s*u(I,j,k) - enddo ; enddo ; enddo - do k=1,GV%ke ; do J=G%JsdB,G%JedB ; do i=G%isd,G%ied - v(i,J,k) = US%L_T_to_m_s*v(i,J,k) - enddo ; enddo ; enddo - if (CS%thickness_diffuse .and. .not.CS%thickness_diffuse_first) then call cpu_clock_begin(id_clock_thick_diff) @@ -2100,6 +2068,8 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & if (debug_truncations) then allocate(CS%u_prev(IsdB:IedB,jsd:jed,nz)) ; CS%u_prev(:,:,:) = 0.0 allocate(CS%v_prev(isd:ied,JsdB:JedB,nz)) ; CS%v_prev(:,:,:) = 0.0 + MOM_internal_state%u_prev => CS%u_prev + MOM_internal_state%v_prev => CS%v_prev call safe_alloc_ptr(CS%ADp%du_dt_visc,IsdB,IedB,jsd,jed,nz) call safe_alloc_ptr(CS%ADp%dv_dt_visc,isd,ied,JsdB,JedB,nz) if (.not.CS%adiabatic) then @@ -2429,7 +2399,7 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & ! now register some diagnostics since the tracer registry is now locked call register_surface_diags(Time, G, CS%sfc_IDs, CS%diag, CS%tv) - call register_diags(Time, G, GV, CS%IDs, CS%diag) + call register_diags(Time, G, GV, US, CS%IDs, CS%diag) call register_transport_diags(Time, G, GV, US, CS%transport_IDs, CS%diag) call register_tracer_diagnostics(CS%tracer_Reg, CS%h, Time, diag, G, GV, & CS%use_ALE_algorithm) @@ -2575,10 +2545,11 @@ subroutine finish_MOM_initialization(Time, dirs, CS, restart_CSp) end subroutine finish_MOM_initialization !> Register certain diagnostics -subroutine register_diags(Time, G, GV, IDs, diag) +subroutine register_diags(Time, G, GV, US, IDs, diag) type(time_type), intent(in) :: Time !< current model 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(inout) :: US !< A dimensional unit scaling type type(MOM_diag_IDs), intent(inout) :: IDs !< A structure with the diagnostic IDs. type(diag_ctrl), intent(inout) :: diag !< regulates diagnostic output @@ -2594,9 +2565,9 @@ subroutine register_diags(Time, G, GV, IDs, diag) ! Diagnostics of the rapidly varying dynamic state IDs%id_u = register_diag_field('ocean_model', 'u_dyn', diag%axesCuL, Time, & - 'Zonal velocity after the dynamics update', 'm s-1') + 'Zonal velocity after the dynamics update', 'm s-1', conversion=US%L_T_to_m_s) IDs%id_v = register_diag_field('ocean_model', 'v_dyn', diag%axesCvL, Time, & - 'Meridional velocity after the dynamics update', 'm s-1') + 'Meridional velocity after the dynamics update', 'm s-1', conversion=US%L_T_to_m_s) IDs%id_h = register_diag_field('ocean_model', 'h_dyn', diag%axesTL, Time, & 'Layer Thickness after the dynamics update', thickness_units, & v_extensive=.true., conversion=H_convert) diff --git a/src/core/MOM_variables.F90 b/src/core/MOM_variables.F90 index aeea2329b6..36148f69ba 100644 --- a/src/core/MOM_variables.F90 +++ b/src/core/MOM_variables.F90 @@ -134,21 +134,21 @@ module MOM_variables uh => NULL(), & !< Pointer to zonal transports [H L2 T-1 ~> m3 s-1 or kg s-1] vh => NULL() !< Pointer to meridional transports [H L2 T-1 ~> m3 s-1 or kg s-1] real, pointer, dimension(:,:,:) :: & - CAu => NULL(), & !< Pointer to the zonal Coriolis and Advective acceleration [m s-2] - CAv => NULL(), & !< Pointer to the meridional Coriolis and Advective acceleration [m s-2] + CAu => NULL(), & !< Pointer to the zonal Coriolis and Advective acceleration [L T-2 ~> m s-2] + CAv => NULL(), & !< Pointer to the meridional Coriolis and Advective acceleration [L T-2 ~> m s-2] PFu => NULL(), & !< Pointer to the zonal Pressure force acceleration [L T-2 ~> m s-2] PFv => NULL(), & !< Pointer to the meridional Pressure force acceleration [L T-2 ~> 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] + diffu => NULL(), & !< Pointer to the zonal acceleration due to lateral viscosity [L T-2 ~> m s-2] + diffv => NULL(), & !< Pointer to the meridional acceleration due to lateral viscosity [L T-2 ~> m s-2] pbce => NULL(), & !< Pointer to the baroclinic pressure force dependency on free surface movement !! [L2 T-2 H-1 ~> m s-2 or m4 kg-1 s-2] u_accel_bt => NULL(), & !< Pointer to the zonal barotropic-solver acceleration [L T-2 ~> m s-2] v_accel_bt => NULL() !< Pointer to the meridional barotropic-solver acceleration [L T-2 ~> m s-2] real, pointer, dimension(:,:,:) :: & - u_av => NULL(), & !< Pointer to zonal velocity averaged over the timestep [m s-1] - v_av => NULL(), & !< Pointer to meridional velocity averaged over the timestep [m s-1] - u_prev => NULL(), & !< Pointer to zonal velocity at the end of the last timestep [m s-1] - v_prev => NULL() !< Pointer to meridional velocity at the end of the last timestep [m s-1] + u_av => NULL(), & !< Pointer to zonal velocity averaged over the timestep [L T-1 ~> m s-1] + v_av => NULL(), & !< Pointer to meridional velocity averaged over the timestep [L T-1 ~> m s-1] + u_prev => NULL(), & !< Pointer to zonal velocity at the end of the last timestep [L T-1 ~> m s-1] + v_prev => NULL() !< Pointer to meridional velocity at the end of the last timestep [L T-1 ~> m s-1] end type ocean_internal_state !> Pointers to arrays with accelerations, which can later be used for derived diagnostics, like energy balances. diff --git a/src/diagnostics/MOM_PointAccel.F90 b/src/diagnostics/MOM_PointAccel.F90 index e78e6133f3..e0bbd832bb 100644 --- a/src/diagnostics/MOM_PointAccel.F90 +++ b/src/diagnostics/MOM_PointAccel.F90 @@ -49,8 +49,8 @@ module MOM_PointAccel real, pointer, dimension(:,:,:) :: & u_av => NULL(), & !< Time average u-velocity [L T-1 ~> m s-1]. v_av => NULL(), & !< Time average velocity [L T-1 ~> m s-1]. - u_prev => NULL(), & !< Previous u-velocity [m s-1]. - v_prev => NULL(), & !< Previous v-velocity [m s-1]. + u_prev => NULL(), & !< Previous u-velocity [L T-1 ~> m s-1]. + v_prev => NULL(), & !< Previous v-velocity [L T-1 ~> m s-1]. T => NULL(), & !< Temperature [degC]. S => NULL(), & !< Salinity [ppt]. u_accel_bt => NULL(), & !< Barotropic u-acclerations [L T-2 ~> m s-2] @@ -166,7 +166,7 @@ subroutine write_u_accel(I, j, um, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (US%L_T_to_m_s*um(I,j,k)); enddo if (prev_avail) then write(file,'(/,"u(mp): ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (CS%u_prev(I,j,k)); enddo + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (US%L_T_to_m_s*CS%u_prev(I,j,k)); enddo endif write(file,'(/,"u(3): ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (CS%u_av_scale*CS%u_av(I,j,k)); enddo @@ -185,7 +185,7 @@ subroutine write_u_accel(I, j, um, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st if (prev_avail) then write(file,'(/,"du: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - ((US%L_T_to_m_s*um(I,j,k)-CS%u_prev(I,j,k))); enddo + (US%L_T_to_m_s*(um(I,j,k)-CS%u_prev(I,j,k))); enddo endif write(file,'(/,"CAu: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (dt*US%L_T2_to_m_s2*ADp%CAu(I,j,k)); enddo @@ -336,7 +336,7 @@ subroutine write_u_accel(I, j, um, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st ! From here on, the normalized accelerations are written. if (prev_avail) then do k=ks,ke - du = US%L_T_to_m_s*um(I,j,k)-CS%u_prev(I,j,k) + du = US%L_T_to_m_s*(um(I,j,k) - CS%u_prev(I,j,k)) if (abs(du) < 1.0e-6) du = 1.0e-6 Inorm(k) = 1.0 / du enddo @@ -346,7 +346,7 @@ subroutine write_u_accel(I, j, um, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st write(file,'(/,"du: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(F10.6," ",$)') & - ((US%L_T_to_m_s*um(I,j,k)-CS%u_prev(I,j,k))*Inorm(k)); enddo + (US%L_T_to_m_s*(um(I,j,k)-CS%u_prev(I,j,k))*Inorm(k)); enddo write(file,'(/,"CAu: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(F10.6," ",$)') & @@ -497,7 +497,7 @@ subroutine write_v_accel(i, J, vm, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st if (prev_avail) then write(file,'(/,"v(mp): ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (CS%v_prev(i,J,k)); enddo + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (US%L_T_to_m_s*CS%v_prev(i,J,k)); enddo endif write(file,'(/,"v(3): ",$)') @@ -516,7 +516,7 @@ subroutine write_v_accel(i, J, vm, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st if (prev_avail) then write(file,'(/,"dv: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - ((US%L_T_to_m_s*vm(i,J,k)-CS%v_prev(i,J,k))); enddo + (US%L_T_to_m_s*(vm(i,J,k)-CS%v_prev(i,J,k))); enddo endif write(file,'(/,"CAv: ",$)') @@ -670,7 +670,7 @@ subroutine write_v_accel(i, J, vm, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st ! From here on, the normalized accelerations are written. if (prev_avail) then do k=ks,ke - dv = US%L_T_to_m_s*vm(i,J,k)-CS%v_prev(i,J,k) + dv = US%L_T_to_m_s*(vm(i,J,k)-CS%v_prev(i,J,k)) if (abs(dv) < 1.0e-6) dv = 1.0e-6 Inorm(k) = 1.0 / dv enddo @@ -679,7 +679,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,'(F10.6," ",$)') (1.0/Inorm(k)); enddo write(file,'(/,"dv: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(F10.6," ",$)') & - ((US%L_T_to_m_s*vm(i,J,k)-CS%v_prev(i,J,k))*Inorm(k)); enddo + (US%L_T_to_m_s*(vm(i,J,k)-CS%v_prev(i,J,k))*Inorm(k)); enddo write(file,'(/,"CAv: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(F10.6," ",$)') & (dt*US%L_T2_to_m_s2*ADp%CAv(i,J,k)*Inorm(k)); enddo From d0077ea391e408445e5a2504f5b7b9c6727620c6 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Thu, 15 Aug 2019 19:19:14 -0400 Subject: [PATCH 215/297] +Pass velocities to calculate_diagnostic_fields in [L T-1] Pass velocities to calculate_diagnostic_fields in [L T-1]. Also rearranged some code in calculate_diagnostic_fields to calculate time derivatives before they are posted or used and to check whether the diagnostics module is initialized before its control structure is used. The energy diagnostics and the diagnostics of the total acceleration should have been corrected. All diagnostics should have been properly rescaled for output, and all solutions are bitwise identical. --- src/core/MOM.F90 | 32 +++++++++--------- src/diagnostics/MOM_diagnostics.F90 | 50 ++++++++++++++--------------- 2 files changed, 41 insertions(+), 41 deletions(-) diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index af534f90de..2b9f5173d3 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -780,14 +780,6 @@ subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, CS, & call cpu_clock_end(id_clock_dynamics) endif - !### This will be removed later. - do k=1,nz ; do j=G%jsd,G%jed ; do I=G%IsdB,G%IedB - u(I,j,k) = US%L_T_to_m_s*u(I,j,k) - enddo ; enddo ; enddo - do k=1,nz ; do J=G%JsdB,G%JedB ; do i=G%isd,G%ied - v(i,J,k) = US%L_T_to_m_s*v(i,J,k) - enddo ; enddo ; enddo - !=========================================================================== ! Calculate diagnostics at the end of the time step if the state is self-consistent. if (MOM_state_is_synchronized(CS)) then @@ -808,6 +800,14 @@ subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, CS, & call cpu_clock_end(id_clock_diagnostics) ; call cpu_clock_end(id_clock_other) endif + !### This will be removed later. + do k=1,nz ; do j=G%jsd,G%jed ; do I=G%IsdB,G%IedB + u(I,j,k) = US%L_T_to_m_s*u(I,j,k) + enddo ; enddo ; enddo + do k=1,nz ; do J=G%JsdB,G%JedB ; do i=G%isd,G%ied + v(i,J,k) = US%L_T_to_m_s*v(i,J,k) + enddo ; enddo ; enddo + if (do_dyn .and. .not.CS%count_calls) CS%nstep_tot = CS%nstep_tot + 1 if (showCallTree) call callTree_leave("DT cycles (step_MOM)") @@ -2351,14 +2351,6 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & CS%ntrunc) endif - !### This is temporary and will be deleted when the units of the velocities have changed. - do k=1,GV%ke ; do j=G%jsd,G%jed ; do I=G%IsdB,G%IedB - CS%u(I,j,k) = US%L_T_to_m_s*CS%u(I,j,k) - enddo ; enddo ; enddo - do k=1,GV%ke ; do J=G%JsdB,G%JedB ; do i=G%isd,G%ied - CS%v(i,J,k) = US%L_T_to_m_s*CS%v(i,J,k) - enddo ; enddo ; enddo - call callTree_waypoint("dynamics initialized (initialize_MOM)") CS%mixedlayer_restrat = mixedlayer_restrat_init(Time, G, GV, US, param_file, diag, & @@ -2375,6 +2367,14 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & param_file, diag, CS%diagnostics_CSp, CS%tv) call diag_copy_diag_to_storage(CS%diag_pre_sync, CS%h, CS%diag) + !### This is temporary and will be deleted when the units of the velocities have changed. + do k=1,GV%ke ; do j=G%jsd,G%jed ; do I=G%IsdB,G%IedB + CS%u(I,j,k) = US%L_T_to_m_s*CS%u(I,j,k) + enddo ; enddo ; enddo + do k=1,GV%ke ; do J=G%JsdB,G%JedB ; do i=G%isd,G%ied + CS%v(i,J,k) = US%L_T_to_m_s*CS%v(i,J,k) + enddo ; enddo ; enddo + if (associated(CS%sponge_CSp)) & call init_sponge_diags(Time, G, diag, CS%sponge_CSp) diff --git a/src/diagnostics/MOM_diagnostics.F90 b/src/diagnostics/MOM_diagnostics.F90 index b853ee668b..54025a0ac0 100644 --- a/src/diagnostics/MOM_diagnostics.F90 +++ b/src/diagnostics/MOM_diagnostics.F90 @@ -66,8 +66,8 @@ module MOM_diagnostics ! following fields have nz layers. real, pointer, dimension(:,:,:) :: & - du_dt => NULL(), & !< net i-acceleration [m s-2] - dv_dt => NULL(), & !< net j-acceleration [m s-2] + du_dt => NULL(), & !< net i-acceleration [L T-1 s-1 ~> m s-2] + dv_dt => NULL(), & !< net j-acceleration [L T-1 s-1 ~> m s-2] dh_dt => NULL(), & !< thickness rate of change [H s-1 ~> m s-1 or kg m-2 s-1] p_ebt => NULL() !< Equivalent barotropic modal structure [nondim] @@ -188,9 +188,9 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & 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]. + intent(in) :: u !< The zonal velocity [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - intent(in) :: v !< The meridional velocity [m s-1]. + intent(in) :: v !< The meridional velocity [L T-1 ~> m s-1]. 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)), & @@ -251,6 +251,11 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB nz = G%ke ; nkmb = GV%nk_rho_varies + if (loc(CS)==0) call MOM_error(FATAL, & + "calculate_diagnostic_fields: Module must be initialized before used.") + + call calculate_derivs(dt, G, CS) + if (dt > 0.0) then call diag_save_grids(CS%diag) call diag_copy_storage_to_diag(CS%diag, diag_pre_sync) @@ -277,11 +282,6 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & ! one iteration that would break the following one-line workaround! 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.") - - call calculate_derivs(dt, G, CS) - if (CS%id_u > 0) call post_data(CS%id_u, u, CS%diag) if (CS%id_v > 0) call post_data(CS%id_v, v, CS%diag) @@ -629,7 +629,7 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & f2_h = absurdly_small_freq2 + 0.25 * 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)) - mag_beta = sqrt(0.5 * US%s_to_T**2*US%m_to_L**2 * ( & + mag_beta = US%s_to_T*US%m_to_L * 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 + & @@ -678,7 +678,7 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & f2_h = absurdly_small_freq2 + 0.25 * 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)) - mag_beta = sqrt(0.5 * US%s_to_T**2*US%m_to_L**2 * ( & + mag_beta = US%s_to_T*US%m_to_L * 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 + & @@ -882,9 +882,9 @@ 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)), & - intent(in) :: u !< The zonal velocity [m s-1]. + intent(in) :: u !< The zonal velocity [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - intent(in) :: v !< The meridional velocity [m s-1]. + intent(in) :: v !< The meridional velocity [L T-1 ~> m s-1]. 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)), & @@ -916,7 +916,7 @@ subroutine calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, GV, US, CS if (associated(CS%KE)) then do k=1,nz ; do j=js,je ; do i=is,ie - CS%KE(i,j,k) = ((u(I,j,k)*u(I,j,k) + u(I-1,j,k)*u(I-1,j,k)) + & + CS%KE(i,j,k) = US%L_T_to_m_s**2*((u(I,j,k)*u(I,j,k) + u(I-1,j,k)*u(I-1,j,k)) + & (v(i,J,k)*v(i,J,k) + v(i,J-1,k)*v(i,J-1,k)))*0.25 ! DELETE THE FOLLOWING... Make this 0 to test the momentum balance, ! or a huge number to test the continuity balance. @@ -936,13 +936,13 @@ subroutine calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, GV, US, CS if (associated(CS%dKE_dt)) then do k=1,nz do j=js,je ; do I=Isq,Ieq - KE_u(I,j) = US%s_to_T*uh(I,j,k)*US%L_to_m*G%dxCu(I,j)*CS%du_dt(I,j,k) + KE_u(I,j) = US%L_T_to_m_s**2*US%s_to_T*uh(I,j,k)*G%dxCu(I,j)*CS%du_dt(I,j,k) enddo ; enddo do J=Jsq,Jeq ; do i=is,ie - KE_v(i,J) = US%s_to_T*vh(i,J,k)*US%L_to_m*G%dyCv(i,J)*CS%dv_dt(i,J,k) + KE_v(i,J) = US%L_T_to_m_s**2*US%s_to_T*vh(i,J,k)*G%dyCv(i,J)*CS%dv_dt(i,J,k) enddo ; enddo do j=js,je ; do i=is,ie - KE_h(i,j) = CS%KE(i,j,k)*CS%dh_dt(i,j,k) + KE_h(i,j) = CS%KE(i,j,k)*US%s_to_T*CS%dh_dt(i,j,k) enddo ; enddo if (.not.G%symmetric) & call do_group_pass(CS%pass_KE_uv, G%domain) @@ -1123,14 +1123,14 @@ end subroutine register_time_deriv !> This subroutine calculates all registered time derivatives. subroutine calculate_derivs(dt, G, CS) - real, intent(in) :: dt !< The time interval over which differences occur [s]. + real, intent(in) :: dt !< The time interval over which differences occur [T ~> s]. type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. type(diagnostics_CS), intent(inout) :: CS !< Control structure returned by previous call to !! diagnostics_init. ! This subroutine calculates all registered time derivatives. - integer i, j, k, m - real Idt + real :: Idt ! The inverse timestep [T-1 ~> s-1] + integer :: i, j, k, m if (dt > 0.0) then ; Idt = 1.0/dt else ; return ; endif @@ -1544,10 +1544,10 @@ subroutine MOM_diagnostics_init(MIS, ADp, CDp, Time, G, GV, US, param_file, diag endif CS%id_u = register_diag_field('ocean_model', 'u', diag%axesCuL, Time, & - 'Zonal velocity', 'm s-1', cmor_field_name='uo', & + 'Zonal velocity', 'm s-1', conversion=US%L_T_to_m_s, cmor_field_name='uo', & cmor_standard_name='sea_water_x_velocity', cmor_long_name='Sea Water X Velocity') CS%id_v = register_diag_field('ocean_model', 'v', diag%axesCvL, Time, & - 'Meridional velocity', 'm s-1', cmor_field_name='vo', & + 'Meridional velocity', 'm s-1', conversion=US%L_T_to_m_s, cmor_field_name='vo', & cmor_standard_name='sea_water_y_velocity', cmor_long_name='Sea Water Y Velocity') CS%id_h = register_diag_field('ocean_model', 'h', diag%axesTL, Time, & 'Layer Thickness', thickness_units, v_extensive=.true., conversion=convert_H) @@ -1574,21 +1574,21 @@ subroutine MOM_diagnostics_init(MIS, ADp, CDp, Time, G, GV, US, param_file, diag 'In situ density', 'kg m-3') CS%id_du_dt = register_diag_field('ocean_model', 'dudt', diag%axesCuL, Time, & - 'Zonal Acceleration', 'm s-2') + 'Zonal Acceleration', 'm s-2', conversion=US%L_T2_to_m_s2) if ((CS%id_du_dt>0) .and. .not.associated(CS%du_dt)) then call safe_alloc_ptr(CS%du_dt,IsdB,IedB,jsd,jed,nz) call register_time_deriv(lbound(MIS%u), MIS%u, CS%du_dt, CS) endif CS%id_dv_dt = register_diag_field('ocean_model', 'dvdt', diag%axesCvL, Time, & - 'Meridional Acceleration', 'm s-2') + 'Meridional Acceleration', 'm s-2', conversion=US%L_T2_to_m_s2) if ((CS%id_dv_dt>0) .and. .not.associated(CS%dv_dt)) then call safe_alloc_ptr(CS%dv_dt,isd,ied,JsdB,JedB,nz) call register_time_deriv(lbound(MIS%v), MIS%v, CS%dv_dt, CS) endif CS%id_dh_dt = register_diag_field('ocean_model', 'dhdt', diag%axesTL, Time, & - 'Thickness tendency', trim(thickness_units)//" s-1", v_extensive = .true.) + 'Thickness tendency', trim(thickness_units)//" s-1", conversion=convert_H*US%s_to_T, v_extensive=.true.) if ((CS%id_dh_dt>0) .and. .not.associated(CS%dh_dt)) then call safe_alloc_ptr(CS%dh_dt,isd,ied,jsd,jed,nz) call register_time_deriv(lbound(MIS%h), MIS%h, CS%dh_dt, CS) From 897fa670a80363fa39cf6b5cd8462d7a36f0fab6 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Fri, 16 Aug 2019 05:21:57 -0400 Subject: [PATCH 216/297] +Change units of MOM_control_struct%u to [L T-1] Changed the units of MOM_control_struct%u and ...%v to [L T-1] for greater dimensional consistency testing, and return velocities from MOM_initialize_state in units of [L T-1]. This step includes changing the units of u and v in the restart files to [L T-1]. All answers are bitwise identical. --- src/core/MOM.F90 | 88 ++++++------------- .../MOM_state_initialization.F90 | 32 +++++-- 2 files changed, 53 insertions(+), 67 deletions(-) diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index 2b9f5173d3..df4fbba77d 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -155,11 +155,11 @@ module MOM T, & !< potential temperature [degC] S !< salinity [ppt] real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_,NKMEM_) :: & - u, & !< zonal velocity component [m s-1] + u, & !< zonal velocity component [L T-1 ~> m s-1] uh, & !< uh = u * h * dy at u grid points [H L2 T-1 ~> m3 s-1 or kg s-1] uhtr !< accumulated zonal thickness fluxes to advect tracers [H L2 ~> m3 or kg] real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_,NKMEM_) :: & - v, & !< meridional velocity [m s-1] + v, & !< meridional velocity [L T-1 ~> m s-1] vh, & !< vh = v * h * dx at v grid points [H L2 T-1 ~> m3 s-1 or kg s-1] vhtr !< accumulated meridional thickness fluxes to advect tracers [H L2 ~> m3 or kg] real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: ssh_rint @@ -461,8 +461,8 @@ subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, CS, & ssh ! sea surface height, which may be based on eta_av [m] real, dimension(:,:,:), pointer :: & - u => NULL(), & ! u : zonal velocity component [m s-1] - v => NULL(), & ! v : meridional velocity component [m s-1] + u => NULL(), & ! u : zonal velocity component [L T-1 ~> m s-1] + v => NULL(), & ! v : meridional velocity component [L T-1 ~> m s-1] h => NULL() ! h : layer thickness [H ~> m or kg m-2] real, dimension(:,:), pointer :: & p_surf => NULL() ! A pointer to the ocean surface pressure [Pa]. @@ -492,7 +492,7 @@ subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, CS, & call cpu_clock_begin(id_clock_other) if (CS%debug) then - call MOM_state_chksum("Beginning of step_MOM ", u, v, h, CS%uh, CS%vh, G, GV, US, vel_scale=1.0) + call MOM_state_chksum("Beginning of step_MOM ", u, v, h, CS%uh, CS%vh, G, GV, US) endif showCallTree = callTree_showQuery() @@ -598,7 +598,7 @@ subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, CS, & if (CS%debug) then if (cycle_start) & - call MOM_state_chksum("Before steps ", u, v, h, CS%uh, CS%vh, G, GV, US, vel_scale=1.0) + call MOM_state_chksum("Before steps ", u, v, h, CS%uh, CS%vh, G, GV, US) if (cycle_start) call check_redundant("Before steps ", u, v, G) if (do_dyn) call MOM_mech_forcing_chksum("Before steps", forces, G, US, haloshift=0) if (do_dyn) call check_redundant("Before steps ", forces%taux, forces%tauy, G) @@ -615,14 +615,6 @@ subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, CS, & if (showCallTree) call callTree_enter("DT cycles (step_MOM) n=",n) - !### This will be removed later. - do k=1,nz ; do j=G%jsd,G%jed ; do I=G%IsdB,G%IedB - u(I,j,k) = US%m_s_to_L_T*u(I,j,k) - enddo ; enddo ; enddo - do k=1,nz ; do J=G%JsdB,G%JedB ; do i=G%isd,G%ied - v(i,J,k) = US%m_s_to_L_T*v(i,J,k) - enddo ; enddo ; enddo - !=========================================================================== ! This is the first place where the diabatic processes and remapping could occur. if (CS%diabatic_first .and. (CS%t_dyn_rel_adv==0.0) .and. do_thermo) then ! do thermodynamics. @@ -800,14 +792,6 @@ subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, CS, & call cpu_clock_end(id_clock_diagnostics) ; call cpu_clock_end(id_clock_other) endif - !### This will be removed later. - do k=1,nz ; do j=G%jsd,G%jed ; do I=G%IsdB,G%IedB - u(I,j,k) = US%L_T_to_m_s*u(I,j,k) - enddo ; enddo ; enddo - do k=1,nz ; do J=G%JsdB,G%JedB ; do i=G%isd,G%ied - v(i,J,k) = US%L_T_to_m_s*v(i,J,k) - enddo ; enddo ; enddo - if (do_dyn .and. .not.CS%count_calls) CS%nstep_tot = CS%nstep_tot + 1 if (showCallTree) call callTree_leave("DT cycles (step_MOM)") @@ -837,12 +821,12 @@ subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, CS, & enddo ; enddo ; endif if (CS%ensemble_ocean) then - ! update the time for the next analysis step if needed - call set_analysis_time(CS%Time,CS%odaCS) - ! store ensemble vector in odaCS - call set_prior_tracer(CS%Time, G, GV, CS%h, CS%tv, CS%odaCS) - ! call DA interface - call oda(CS%Time,CS%odaCS) + ! update the time for the next analysis step if needed + call set_analysis_time(CS%Time,CS%odaCS) + ! store ensemble vector in odaCS + call set_prior_tracer(CS%Time, G, GV, CS%h, CS%tv, CS%odaCS) + ! call DA interface + call oda(CS%Time,CS%odaCS) endif if (showCallTree) call callTree_waypoint("calling extract_surface_state (step_MOM)") @@ -870,7 +854,7 @@ subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, CS, & G, CS%sum_output_CSp) if (MOM_state_is_synchronized(CS)) & - call write_energy(CS%u, CS%v, CS%h, CS%tv, Time_local, CS%nstep_tot, & + call write_energy(US%L_T_to_m_s*CS%u, US%L_T_to_m_s*CS%v, CS%h, CS%tv, Time_local, CS%nstep_tot, & G, GV, US, CS%sum_output_CSp, CS%tracer_flow_CSp, & dt_forcing=real_to_time(time_interval) ) @@ -2199,7 +2183,6 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & G%ke = GV%ke ; G%g_Earth = GV%mks_g_Earth endif - ! At this point, all user-modified initialization code has been called. The ! remainder of this subroutine is controlled by the parameters that have ! have already been set. @@ -2309,14 +2292,6 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & call set_visc_init(Time, G, GV, US, param_file, diag, CS%visc, CS%set_visc_CSp, restart_CSp, CS%OBC) call thickness_diffuse_init(Time, G, GV, US, param_file, diag, CS%CDp, CS%thickness_diffuse_CSp) - !### This is temporary and will be deleted when the units of the velocities have changed. - do k=1,GV%ke ; do j=G%jsd,G%jed ; do I=G%IsdB,G%IedB - CS%u(I,j,k) = US%m_s_to_L_T*CS%u(I,j,k) - enddo ; enddo ; enddo - do k=1,GV%ke ; do J=G%JsdB,G%JedB ; do i=G%isd,G%ied - CS%v(i,J,k) = US%m_s_to_L_T*CS%v(i,J,k) - enddo ; enddo ; enddo - if (CS%split) then allocate(eta(SZI_(G),SZJ_(G))) ; eta(:,:) = 0.0 call initialize_dyn_split_RK2(CS%u, CS%v, CS%h, CS%uh, CS%vh, eta, Time, & @@ -2367,14 +2342,6 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & param_file, diag, CS%diagnostics_CSp, CS%tv) call diag_copy_diag_to_storage(CS%diag_pre_sync, CS%h, CS%diag) - !### This is temporary and will be deleted when the units of the velocities have changed. - do k=1,GV%ke ; do j=G%jsd,G%jed ; do I=G%IsdB,G%IedB - CS%u(I,j,k) = US%L_T_to_m_s*CS%u(I,j,k) - enddo ; enddo ; enddo - do k=1,GV%ke ; do J=G%JsdB,G%JedB ; do i=G%isd,G%ied - CS%v(i,J,k) = US%L_T_to_m_s*CS%v(i,J,k) - enddo ; enddo ; enddo - if (associated(CS%sponge_CSp)) & call init_sponge_diags(Time, G, diag, CS%sponge_CSp) @@ -2536,7 +2503,7 @@ subroutine finish_MOM_initialization(Time, dirs, CS, restart_CSp) deallocate(restart_CSp_tmp) endif - call write_energy(CS%u, CS%v, CS%h, CS%tv, Time, 0, G, GV, US, & + call write_energy(US%L_T_to_m_s*CS%u, US%L_T_to_m_s*CS%v, CS%h, CS%tv, Time, 0, G, GV, US, & CS%sum_output_CSp, CS%tracer_flow_CSp) call callTree_leave("finish_MOM_initialization()") @@ -2726,12 +2693,13 @@ subroutine extract_surface_state(CS, sfc_state) ! local real :: hu, hv ! Thicknesses interpolated to velocity points [H ~> m or kg m-2] - type(ocean_grid_type), pointer :: G => NULL() !< pointer to a structure containing + type(ocean_grid_type), pointer :: G => NULL() !< pointer to a structure containing !! metrics and related information - type(verticalGrid_type), pointer :: GV => NULL() - real, dimension(:,:,:), pointer :: & - u => NULL(), & !< u : zonal velocity component [m s-1] - v => NULL(), & !< v : meridional velocity component [m s-1] + type(verticalGrid_type), pointer :: GV => NULL() !< structure containing vertical grid info + type(unit_scale_type), pointer :: US => NULL() !< structure containing various unit conversion factors + real, dimension(:,:,:), pointer :: & +! u => NULL(), & !< u : zonal velocity component [m s-1] +! v => NULL(), & !< v : meridional velocity component [m s-1] h => NULL() !< h : layer thickness [H ~> m or kg m-2] real :: depth(SZI_(CS%G)) !< Distance from the surface in depth units [Z ~> m] real :: depth_ml !< Depth over which to average to determine mixed @@ -2749,12 +2717,12 @@ subroutine extract_surface_state(CS, sfc_state) character(240) :: msg call callTree_enter("extract_surface_state(), MOM.F90") - G => CS%G ; GV => CS%GV + G => CS%G ; GV => CS%GV ; US => CS%US is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed iscB = G%iscB ; iecB = G%iecB; jscB = G%jscB ; jecB = G%jecB isdB = G%isdB ; iedB = G%iedB; jsdB = G%jsdB ; jedB = G%jedB - u => CS%u ; v => CS%v ; h => CS%h + h => CS%h use_temperature = associated(CS%tv%T) @@ -2788,10 +2756,10 @@ subroutine extract_surface_state(CS, sfc_state) sfc_state%SSS(i,j) = CS%tv%S(i,j,1) enddo ; enddo ; endif do j=js,je ; do I=is-1,ie - sfc_state%u(I,j) = u(I,j,1) + sfc_state%u(I,j) = US%L_T_to_m_s * CS%u(I,j,1) enddo ; enddo do J=js-1,je ; do i=is,ie - sfc_state%v(i,J) = v(i,J,1) + sfc_state%v(i,J) = US%L_T_to_m_s * CS%v(i,J,1) enddo ; enddo else ! (CS%Hmix >= 0.0) @@ -2864,7 +2832,7 @@ subroutine extract_surface_state(CS, sfc_state) else dh = 0.0 endif - sfc_state%v(i,J) = sfc_state%v(i,J) + dh * v(i,J,k) + sfc_state%v(i,J) = sfc_state%v(i,J) + dh * US%L_T_to_m_s * CS%v(i,J,k) depth(i) = depth(i) + dh enddo ; enddo ! Calculate the average properties of the mixed layer depth. @@ -2890,7 +2858,7 @@ subroutine extract_surface_state(CS, sfc_state) else dh = 0.0 endif - sfc_state%u(I,j) = sfc_state%u(I,j) + dh * u(I,j,k) + sfc_state%u(I,j) = sfc_state%u(I,j) + dh * US%L_T_to_m_s * CS%u(I,j,k) depth(I) = depth(I) + dh enddo ; enddo ! Calculate the average properties of the mixed layer depth. @@ -2902,10 +2870,10 @@ subroutine extract_surface_state(CS, sfc_state) enddo ! end of j loop else ! Hmix_UV<=0. do j=js,je ; do I=is-1,ie - sfc_state%u(I,j) = u(I,j,1) + sfc_state%u(I,j) = US%L_T_to_m_s * CS%u(I,j,1) enddo ; enddo do J=js-1,je ; do i=is,ie - sfc_state%v(i,J) = v(i,J,1) + sfc_state%v(i,J) = US%L_T_to_m_s * CS%v(i,J,1) enddo ; enddo endif endif ! (CS%Hmix >= 0.0) diff --git a/src/initialization/MOM_state_initialization.F90 b/src/initialization/MOM_state_initialization.F90 index 0beda5477c..241ce01b76 100644 --- a/src/initialization/MOM_state_initialization.F90 +++ b/src/initialization/MOM_state_initialization.F90 @@ -126,10 +126,10 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, US, PF, dirs, & type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & intent(out) :: u !< The zonal velocity that is being - !! initialized [m s-1] + !! initialized [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & intent(out) :: v !< The meridional velocity that is being - !! initialized [m s-1] + !! initialized [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(out) :: h !< Layer thicknesses [H ~> m or kg m-2] type(thermo_var_ptrs), intent(inout) :: tv !< A structure pointing to various thermodynamic @@ -153,9 +153,11 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, US, PF, dirs, & character(len=200) :: filename2 ! The name of an input files. character(len=200) :: inputdir ! The directory where NetCDF input files are. character(len=200) :: config - real :: H_rescale ! A rescaling factor for thicknesses from the representation in - ! a restart file to the internal representation in this run. - real :: dt ! The baroclinic dynamics timestep for this run [s]. + real :: H_rescale ! A rescaling factor for thicknesses from the representation in + ! a restart file to the internal representation in this run. + real :: vel_rescale ! A rescaling factor for velocities from the representation in + ! a restart file to the internal representation in this run. + real :: dt ! The baroclinic dynamics timestep for this run [s]. logical :: from_Z_file, useALE logical :: new_sim integer :: write_geom @@ -424,9 +426,19 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, US, PF, dirs, & "Unrecognized velocity configuration "//trim(config)) end select + ! This rescaling should be incorporated into the calls above. + if (new_sim) then + do k=1,GV%ke ; do j=G%jsd,G%jed ; do I=G%IsdB,G%IedB + u(I,j,k) = US%m_s_to_L_T*u(I,j,k) + enddo ; enddo ; enddo + do k=1,GV%ke ; do J=G%JsdB,G%JedB ; do i=G%isd,G%ied + v(i,J,k) = US%m_s_to_L_T*v(i,J,k) + enddo ; enddo ; enddo + endif + if (new_sim) call pass_vector(u, v, G%Domain) if (debug .and. new_sim) then - call uvchksum("MOM_initialize_state [uv]", u, v, G%HI, haloshift=1) + call uvchksum("MOM_initialize_state [uv]", u, v, G%HI, haloshift=1, scale=US%m_s_to_L_T) endif ! Optionally convert the thicknesses from m to kg m-2. This is particularly @@ -493,6 +505,12 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, US, PF, dirs, & H_rescale = GV%m_to_H / GV%m_to_H_restart do k=1,nz ; do j=js,je ; do i=is,ie ; h(i,j,k) = H_rescale * h(i,j,k) ; enddo ; enddo ; enddo endif + if ( (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 k=1,nz ; do j=jsd,jed ; do I=IsdB,IeDB ; u(I,j,k) = vel_rescale * u(I,j,k) ; enddo ; enddo ; enddo + do k=1,nz ; do J=JsdB,JedB ; do i=isd,ied ; v(i,J,k) = vel_rescale * v(i,J,k) ; enddo ; enddo ; enddo + endif endif if ( use_temperature ) then @@ -535,7 +553,7 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, US, PF, dirs, & sponge_CSp, ALE_sponge_CSp) case ("ISOMIP"); call ISOMIP_initialize_sponges(G, GV, US, tv, PF, useALE, & sponge_CSp, ALE_sponge_CSp) - case("RGC"); call RGC_initialize_sponges(G, GV, tv, u, v, PF, useALE, & + case("RGC"); call RGC_initialize_sponges(G, GV, tv, US%L_T_to_m_s*u(:,:,:), US%L_T_to_m_s*v(:,:,:), PF, useALE, & sponge_CSp, ALE_sponge_CSp) case ("USER"); call user_initialize_sponges(G, GV, use_temperature, tv, PF, sponge_CSp, h) case ("BFB"); call BFB_initialize_sponges_southonly(G, GV, US, use_temperature, tv, PF, & From 29bb12b8384134c04e6d2e5ff1fcbec774d5d1bf Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Fri, 16 Aug 2019 06:53:42 -0400 Subject: [PATCH 217/297] +initialize_vel routines pass velocities in [L T-1] Changed initialize_velocity routines to return velocities in [L T-1], including ..._from_file, ..._uniform, ..._circular, soliton_..., Phillips_..., Rossby_front_..., and USER_initialize_velocity. Several of these routines required new unit_scale_type arguments. Also added the target attribute to the u and v arguments to RGC_initialize_sponges and cleaned up indenting in RGC_initialization to comply with MOM6 2-point indent standards. All answers are bitwise identical in the MOM6-examples test cases, but there are new arguments and unit changes in multiple public interfaces. --- .../MOM_state_initialization.F90 | 55 ++++---- src/user/Phillips_initialization.F90 | 28 ++-- src/user/RGC_initialization.F90 | 129 +++++++++--------- src/user/Rossby_front_2d_initialization.F90 | 8 +- src/user/soliton_initialization.F90 | 22 +-- src/user/user_initialization.F90 | 7 +- 6 files changed, 127 insertions(+), 122 deletions(-) diff --git a/src/initialization/MOM_state_initialization.F90 b/src/initialization/MOM_state_initialization.F90 index 241ce01b76..67959c9d9b 100644 --- a/src/initialization/MOM_state_initialization.F90 +++ b/src/initialization/MOM_state_initialization.F90 @@ -407,35 +407,25 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, US, PF, dirs, & " \t USER - call a user modified routine.", default="zero", & do_not_log=just_read) select case (trim(config)) - case ("file"); call initialize_velocity_from_file(u, v, G, PF, & + case ("file"); call initialize_velocity_from_file(u, v, G, US, PF, & just_read_params=just_read) case ("zero"); call initialize_velocity_zero(u, v, G, PF, & just_read_params=just_read) - case ("uniform"); call initialize_velocity_uniform(u, v, G, PF, & + case ("uniform"); call initialize_velocity_uniform(u, v, G, US, PF, & just_read_params=just_read) - case ("circular"); call initialize_velocity_circular(u, v, G, PF, & + case ("circular"); call initialize_velocity_circular(u, v, G, US, PF, & just_read_params=just_read) case ("phillips"); call Phillips_initialize_velocity(u, v, G, GV, US, PF, & just_read_params=just_read) case ("rossby_front"); call Rossby_front_initialize_velocity(u, v, h, & G, GV, US, PF, just_read_params=just_read) - case ("soliton"); call soliton_initialize_velocity(u, v, h, G) - case ("USER"); call user_initialize_velocity(u, v, G, PF, & + case ("soliton"); call soliton_initialize_velocity(u, v, h, G, US) + case ("USER"); call user_initialize_velocity(u, v, G, US, PF, & just_read_params=just_read) case default ; call MOM_error(FATAL, "MOM_initialize_state: "//& "Unrecognized velocity configuration "//trim(config)) end select - ! This rescaling should be incorporated into the calls above. - if (new_sim) then - do k=1,GV%ke ; do j=G%jsd,G%jed ; do I=G%IsdB,G%IedB - u(I,j,k) = US%m_s_to_L_T*u(I,j,k) - enddo ; enddo ; enddo - do k=1,GV%ke ; do J=G%JsdB,G%JedB ; do i=G%isd,G%ied - v(i,J,k) = US%m_s_to_L_T*v(i,J,k) - enddo ; enddo ; enddo - endif - if (new_sim) call pass_vector(u, v, G%Domain) if (debug .and. new_sim) then call uvchksum("MOM_initialize_state [uv]", u, v, G%HI, haloshift=1, scale=US%m_s_to_L_T) @@ -553,7 +543,7 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, US, PF, dirs, & sponge_CSp, ALE_sponge_CSp) case ("ISOMIP"); call ISOMIP_initialize_sponges(G, GV, US, tv, PF, useALE, & sponge_CSp, ALE_sponge_CSp) - case("RGC"); call RGC_initialize_sponges(G, GV, tv, US%L_T_to_m_s*u(:,:,:), US%L_T_to_m_s*v(:,:,:), PF, useALE, & + case("RGC"); call RGC_initialize_sponges(G, GV, tv, u, v, PF, useALE, & sponge_CSp, ALE_sponge_CSp) case ("USER"); call user_initialize_sponges(G, GV, use_temperature, tv, PF, sponge_CSp, h) case ("BFB"); call BFB_initialize_sponges_southonly(G, GV, US, use_temperature, tv, PF, & @@ -1256,12 +1246,13 @@ subroutine cut_off_column_top(nk, tv, GV, G_earth, depth, min_thickness, & end subroutine cut_off_column_top !> Initialize horizontal velocity components from file -subroutine initialize_velocity_from_file(u, v, G, param_file, just_read_params) +subroutine initialize_velocity_from_file(u, v, G, US, param_file, just_read_params) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & - intent(out) :: u !< The zonal velocity that is being initialized [m s-1] + intent(out) :: u !< The zonal velocity that is being initialized [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - intent(out) :: v !< The meridional velocity that is being initialized [m s-1] + intent(out) :: v !< The meridional velocity that is being initialized [L T-1 ~> m s-1] + 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 modelparameter values. logical, optional, intent(in) :: just_read_params !< If present and true, this call will @@ -1290,7 +1281,7 @@ subroutine initialize_velocity_from_file(u, v, G, param_file, just_read_params) " initialize_velocity_from_file: Unable to open "//trim(filename)) ! Read the velocities from a netcdf file. - call MOM_read_vector(filename, "u", "v", u(:,:,:), v(:,:,:),G%Domain) + call MOM_read_vector(filename, "u", "v", u(:,:,:), v(:,:,:), G%Domain, scale=US%m_s_to_L_T) call callTree_leave(trim(mdl)//'()') end subroutine initialize_velocity_from_file @@ -1299,9 +1290,9 @@ end subroutine initialize_velocity_from_file subroutine initialize_velocity_zero(u, v, G, param_file, just_read_params) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & - intent(out) :: u !< The zonal velocity that is being initialized [m s-1] + intent(out) :: u !< The zonal velocity that is being initialized [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - intent(out) :: v !< The meridional velocity that is being initialized [m s-1] + intent(out) :: v !< The meridional velocity that is being initialized [L T-1 ~> m s-1] type(param_file_type), intent(in) :: param_file !< A structure indicating the open file to !! parse for modelparameter values. logical, optional, intent(in) :: just_read_params !< If present and true, this call will @@ -1330,12 +1321,13 @@ subroutine initialize_velocity_zero(u, v, G, param_file, just_read_params) end subroutine initialize_velocity_zero !> Sets the initial velocity components to uniform -subroutine initialize_velocity_uniform(u, v, G, param_file, just_read_params) +subroutine initialize_velocity_uniform(u, v, G, US, param_file, just_read_params) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & - intent(out) :: u !< The zonal velocity that is being initialized [m s-1] + intent(out) :: u !< The zonal velocity that is being initialized [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - intent(out) :: v !< The meridional velocity that is being initialized [m s-1] + intent(out) :: v !< The meridional velocity that is being initialized [L T-1 ~> m s-1] + 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 modelparameter values. logical, optional, intent(in) :: just_read_params !< If present and true, this call will @@ -1352,10 +1344,10 @@ subroutine initialize_velocity_uniform(u, v, G, param_file, just_read_params) call get_param(param_file, mdl, "INITIAL_U_CONST", initial_u_const, & "A initial uniform value for the zonal flow.", & - units="m s-1", fail_if_missing=.not.just_read, do_not_log=just_read) + units="m s-1", scale=US%m_s_to_L_T, fail_if_missing=.not.just_read, do_not_log=just_read) call get_param(param_file, mdl, "INITIAL_V_CONST", initial_v_const, & "A initial uniform value for the meridional flow.", & - units="m s-1", fail_if_missing=.not.just_read, do_not_log=just_read) + units="m s-1", scale=US%m_s_to_L_T, fail_if_missing=.not.just_read, do_not_log=just_read) if (just_read) return ! All run-time parameters have been read, so return. @@ -1370,12 +1362,13 @@ end subroutine initialize_velocity_uniform !> Sets the initial velocity components to be circular with !! no flow at edges of domain and center. -subroutine initialize_velocity_circular(u, v, G, param_file, just_read_params) +subroutine initialize_velocity_circular(u, v, G, US, param_file, just_read_params) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & - intent(out) :: u !< The zonal velocity that is being initialized [m s-1] + intent(out) :: u !< The zonal velocity that is being initialized [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - intent(out) :: v !< The meridional velocity that is being initialized [m s-1] + intent(out) :: v !< The meridional velocity that is being initialized [L T-1 ~> m s-1] + 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. logical, optional, intent(in) :: just_read_params !< If present and true, this call will @@ -1394,7 +1387,7 @@ subroutine initialize_velocity_circular(u, v, G, param_file, just_read_params) call get_param(param_file, mdl, "CIRCULAR_MAX_U", circular_max_u, & "The amplitude of zonal flow from which to scale the "// & "circular stream function [m s-1].", & - units="m s-1", default=0., do_not_log=just_read) + units="m s-1", default=0., scale=US%L_T_to_m_s, do_not_log=just_read) if (just_read) return ! All run-time parameters have been read, so return. diff --git a/src/user/Phillips_initialization.F90 b/src/user/Phillips_initialization.F90 index af17bb87a5..29e049c9b6 100644 --- a/src/user/Phillips_initialization.F90 +++ b/src/user/Phillips_initialization.F90 @@ -51,7 +51,7 @@ subroutine Phillips_initialize_thickness(h, G, GV, US, param_file, just_read_par real :: eta1D(SZK_(G)+1) ! Interface height relative to the sea surface, positive upward [Z ~> m] real :: jet_width ! The width of the zonal-mean jet [km] real :: jet_height ! The interface height scale associated with the zonal-mean jet [Z ~> m] - real :: y_2 + real :: y_2 ! The y-position relative to the center of the domain [km] real :: half_strat ! The fractional depth where the stratification is centered [nondim] real :: half_depth ! The depth where the stratification is centered [Z ~> m] logical :: just_read ! If true, just read parameters but set nothing. @@ -120,18 +120,22 @@ end subroutine Phillips_initialize_thickness subroutine Phillips_initialize_velocity(u, v, G, GV, US, param_file, just_read_params) type(ocean_grid_type), intent(in) :: G !< Grid structure type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), & + intent(out) :: u !< i-component of velocity [L T-1 ~> m s-1] + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), & + intent(out) :: v !< j-component of velocity [L T-1 ~> m s-1] type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & - intent(out) :: u !< i-component of velocity [m s-1] - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - intent(out) :: v !< j-component of velocity [m s-1] type(param_file_type), intent(in) :: param_file !< A structure indicating the open file to !! parse for modelparameter values. logical, optional, intent(in) :: just_read_params !< If present and true, this call will !! only read parameters without changing h. - real :: jet_width, jet_height, x_2, y_2 - real :: velocity_amplitude, pi + real :: jet_width ! The width of the zonal-mean jet [km] + real :: jet_height ! The interface height scale associated with the zonal-mean jet [Z ~> m] + real :: x_2 ! The x-position relative to the center of the domain [nondim] + real :: y_2 ! The y-position relative to the center of the domain [km] or [nondim] + real :: velocity_amplitude ! The amplitude of velocity perturbations [L T-1 ~> m s-1] + real :: pi ! The ratio of the circumference of a circle to its diameter [nondim] integer :: i, j, k, is, ie, js, je, nz, m logical :: just_read ! If true, just read parameters but set nothing. character(len=40) :: mdl = "Phillips_initialize_velocity" ! This subroutine's name. @@ -142,7 +146,7 @@ subroutine Phillips_initialize_velocity(u, v, G, GV, US, param_file, just_read_p if (.not.just_read) call log_version(param_file, mdl, version) call get_param(param_file, mdl, "VELOCITY_IC_PERTURB_AMP", velocity_amplitude, & "The magnitude of the initial velocity perturbation.", & - units="m s-1", default=0.001, do_not_log=just_read) + units="m s-1", default=0.001, scale=US%m_s_to_L_T, do_not_log=just_read) call get_param(param_file, mdl, "JET_WIDTH", jet_width, & "The width of the zonal-mean jet.", units="km", & fail_if_missing=.not.just_read, do_not_log=just_read) @@ -163,12 +167,12 @@ subroutine Phillips_initialize_velocity(u, v, G, GV, US, param_file, just_read_p y_2 = G%geoLatCu(I,j) - G%south_lat - 0.5*G%len_lat ! 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 * 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))) +! (US%m_to_L*jet_width * (1.0 + (y_2 / jet_width)**2))) * & +! (2.0 * GV%g_prime(K+1) / (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) * & + u(I,j,k) = u(I,j,k+1) + (1e-3 * (jet_height / (US%m_to_L*jet_width)) * & (sech(y_2 / jet_width))**2 ) * & - (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))) + (2.0 * GV%g_prime(K+1) / (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/RGC_initialization.F90 b/src/user/RGC_initialization.F90 index f0000dc03d..d5f2bb608b 100644 --- a/src/user/RGC_initialization.F90 +++ b/src/user/RGC_initialization.F90 @@ -44,9 +44,8 @@ module RGC_initialization contains -!> Sets up the the inverse restoration time (Idamp), and -! the values towards which the interface heights and an arbitrary -! number of tracers should be restored within each sponge. +!> Sets up the the inverse restoration time, and the values towards which the interface heights, +!! velocities and tracers should be restored within the sponges for the RGC test case. subroutine RGC_initialize_sponges(G, GV, tv, u, v, PF, use_ALE, CSp, ACSp) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. @@ -55,8 +54,10 @@ subroutine RGC_initialize_sponges(G, GV, tv, u, v, PF, use_ALE, CSp, ACSp) !! fields, potential temperature and !! salinity or mixed layer density. !! Absent fields have NULL ptrs. - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: u !< u velocity. - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: v !< v velocity. + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & + target, intent(in) :: u !< Array with the u velocity [L T-1 ~> m s-1] + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & + target, intent(in) :: v !< Array with the v velocity [L T-1 ~> m s-1] type(param_file_type), intent(in) :: PF !< A structure indicating the !! open file to parse for model !! parameter values. @@ -67,12 +68,12 @@ subroutine RGC_initialize_sponges(G, GV, tv, u, v, PF, use_ALE, CSp, ACSp) ! Local variables real :: T(SZI_(G),SZJ_(G),SZK_(G)) ! A temporary array for temp real :: S(SZI_(G),SZJ_(G),SZK_(G)) ! A temporary array for salt - real :: U1(SZIB_(G), SZJ_(G), SZK_(G)) ! A temporary array for u - real :: V1(SZI_(G), SZJB_(G), SZK_(G)) ! A temporary array for v + real :: U1(SZIB_(G),SZJ_(G),SZK_(G)) ! A temporary array for u [L T-1 ~> m s-1] + real :: V1(SZI_(G),SZJB_(G),SZK_(G)) ! A temporary array for v [L T-1 ~> m s-1] real :: RHO(SZI_(G),SZJ_(G),SZK_(G)) ! A temporary array for RHO real :: tmp(SZI_(G),SZJ_(G)) ! A temporary array for tracers. real :: h(SZI_(G),SZJ_(G),SZK_(G)) ! A temporary array for thickness at h points - real :: Idamp(SZI_(G),SZJ_(G)) ! The inverse damping rate at h points, in s-1. + real :: Idamp(SZI_(G),SZJ_(G)) ! The inverse damping rate at h points [s-1]. real :: TNUDG ! Nudging time scale, days real :: pres(SZI_(G)) ! An array of the reference pressure, in Pa real :: e0(SZK_(G)+1) ! The resting interface heights, in m, usually ! @@ -118,9 +119,9 @@ subroutine RGC_initialize_sponges(G, GV, tv, u, v, PF, use_ALE, CSp, ACSp) call get_param(PF, mod, "MINIMUM_DEPTH", min_depth, & "The minimum depth of the ocean.", units="m", default=0.0) - if (associated(CSp)) call MOM_error(FATAL, & + if (associated(CSp)) call MOM_error(FATAL, & "RGC_initialize_sponges called with an associated control structure.") - if (associated(ACSp)) call MOM_error(FATAL, & + if (associated(ACSp)) call MOM_error(FATAL, & "RGC_initialize_sponges called with an associated ALE-sponge control structure.") ! Here the inverse damping time, in s-1, is set. Set Idamp to 0 ! @@ -128,61 +129,61 @@ subroutine RGC_initialize_sponges(G, GV, tv, u, v, PF, use_ALE, CSp, ACSp) ! will automatically set up the sponges only where Idamp is positive! ! and mask2dT is 1. - do i=is,ie; do j=js,je - if (G%geoLonT(i,j) <= lensponge) then - dummy1 = -(G%geoLonT(i,j))/lensponge + 1.0 - !damp = 1.0/TNUDG * max(0.0,dummy1) - damp = 0.0 - !write(*,*)'1st, G%geoLonT(i,j), damp',G%geoLonT(i,j), damp + do i=is,ie ; do j=js,je + if (G%geoLonT(i,j) <= lensponge) then + dummy1 = -(G%geoLonT(i,j))/lensponge + 1.0 + !damp = 1.0/TNUDG * max(0.0,dummy1) + damp = 0.0 + !write(*,*)'1st, G%geoLonT(i,j), damp',G%geoLonT(i,j), damp - elseif (G%geoLonT(i,j) >= (lenlon - lensponge) .AND. G%geoLonT(i,j) <= lenlon) then + elseif (G%geoLonT(i,j) >= (lenlon - lensponge) .AND. G%geoLonT(i,j) <= lenlon) then - ! 1 / day - dummy1=(G%geoLonT(i,j)-(lenlon - lensponge))/(lensponge) - damp = (1.0/TNUDG) * max(0.0,dummy1) +! 1 / day + dummy1=(G%geoLonT(i,j)-(lenlon - lensponge))/(lensponge) + damp = (1.0/TNUDG) * max(0.0,dummy1) - else ; damp=0.0 - endif + else ; damp=0.0 + endif - ! convert to 1 / seconds - if (G%bathyT(i,j) > min_depth) then - Idamp(i,j) = damp/86400.0 - else ; Idamp(i,j) = 0.0 ; endif - enddo ; enddo +! convert to 1 / seconds + if (G%bathyT(i,j) > min_depth) then + Idamp(i,j) = damp/86400.0 + else ; Idamp(i,j) = 0.0 ; endif + enddo ; enddo - ! 1) Read eta, salt and temp from IC file - call get_param(PF, mod, "INPUTDIR", inputdir, default=".") - inputdir = slasher(inputdir) + ! 1) Read eta, salt and temp from IC file + call get_param(PF, mod, "INPUTDIR", inputdir, default=".") + inputdir = slasher(inputdir) ! GM: get two different files, one with temp and one with salt values ! this is work around to avoid having wrong values near the surface ! because of the FIT_SALINITY option. To get salt values right in the ! sponge, FIT_SALINITY=False. The oposite is true for temp. One can ! combined the *correct* temp and salt values in one file instead. - call get_param(PF, mod, "RGC_SPONGE_FILE", state_file, & + call get_param(PF, mod, "RGC_SPONGE_FILE", state_file, & "The name of the file with temps., salts. and interfaces to \n"// & " damp toward.", fail_if_missing=.true.) - call get_param(PF, mod, "SPONGE_PTEMP_VAR", temp_var, & + call get_param(PF, mod, "SPONGE_PTEMP_VAR", temp_var, & "The name of the potential temperature variable in \n"//& "SPONGE_STATE_FILE.", default="Temp") - call get_param(PF, mod, "SPONGE_SALT_VAR", salt_var, & + call get_param(PF, mod, "SPONGE_SALT_VAR", salt_var, & "The name of the salinity variable in \n"//& "SPONGE_STATE_FILE.", default="Salt") - call get_param(PF, mod, "SPONGE_ETA_VAR", eta_var, & + call get_param(PF, mod, "SPONGE_ETA_VAR", eta_var, & "The name of the interface height variable in \n"//& "SPONGE_STATE_FILE.", default="eta") - call get_param(PF, mod, "SPONGE_H_VAR", h_var, & + call get_param(PF, mod, "SPONGE_H_VAR", h_var, & "The name of the layer thickness variable in \n"//& "SPONGE_STATE_FILE.", default="h") - !read temp and eta - filename = trim(inputdir)//trim(state_file) - if (.not.file_exists(filename, G%Domain)) & - call MOM_error(FATAL, " RGC_initialize_sponges: Unable to open "//trim(filename)) - call read_data(filename,temp_var,T(:,:,:), domain=G%Domain%mpp_domain) - call read_data(filename,salt_var,S(:,:,:), domain=G%Domain%mpp_domain) + !read temp and eta + filename = trim(inputdir)//trim(state_file) + if (.not.file_exists(filename, G%Domain)) & + call MOM_error(FATAL, " RGC_initialize_sponges: Unable to open "//trim(filename)) + call read_data(filename,temp_var,T(:,:,:), domain=G%Domain%mpp_domain) + call read_data(filename,salt_var,S(:,:,:), domain=G%Domain%mpp_domain) - if (use_ALE) then + if (use_ALE) then call read_data(filename,h_var,h(:,:,:), domain=G%Domain%mpp_domain) call pass_var(h, G%domain) @@ -199,37 +200,37 @@ subroutine RGC_initialize_sponges(G, GV, tv, u, v, PF, use_ALE, CSp, ACSp) endif if (sponge_uv) then - U1(:,:,:) = 0.0; V1(:,:,:) = 0.0 - call set_up_ALE_sponge_vel_field(U1,V1,G,u,v,ACSp) + U1(:,:,:) = 0.0; V1(:,:,:) = 0.0 + call set_up_ALE_sponge_vel_field(U1,V1,G,u,v,ACSp) endif - else ! layer mode + else ! layer mode - !read eta - call read_data(filename,eta_var,eta(:,:,:), domain=G%Domain%mpp_domain) + !read eta + call read_data(filename,eta_var,eta(:,:,:), domain=G%Domain%mpp_domain) - ! Set the inverse damping rates so that the model will know where to - ! apply the sponges, along with the interface heights. - call initialize_sponge(Idamp, eta, G, PF, CSp, GV) + ! Set the inverse damping rates so that the model will know where to + ! apply the sponges, along with the interface heights. + call initialize_sponge(Idamp, eta, G, PF, CSp, GV) - if ( GV%nkml>0 ) then - ! This call to set_up_sponge_ML_density registers the target values of the - ! mixed layer density, which is used in determining which layers can be - ! inflated without causing static instabilities. - do i=is-1,ie ; pres(i) = tv%P_Ref ; enddo + if ( GV%nkml>0 ) then + ! This call to set_up_sponge_ML_density registers the target values of the + ! mixed layer density, which is used in determining which layers can be + ! inflated without causing static instabilities. + do i=is-1,ie ; pres(i) = tv%P_Ref ; enddo - do j=js,je - call calculate_density(T(:,j,1), S(:,j,1), pres, tmp(:,j), & - is, ie-is+1, tv%eqn_of_state) - enddo + do j=js,je + call calculate_density(T(:,j,1), S(:,j,1), pres, tmp(:,j), & + is, ie-is+1, tv%eqn_of_state) + enddo - call set_up_sponge_ML_density(tmp, G, CSp) - endif + call set_up_sponge_ML_density(tmp, G, CSp) + endif - ! Apply sponge in tracer fields - call set_up_sponge_field(T, tv%T, G, nz, CSp) - call set_up_sponge_field(S, tv%S, G, nz, CSp) + ! Apply sponge in tracer fields + call set_up_sponge_field(T, tv%T, G, nz, CSp) + call set_up_sponge_field(S, tv%S, G, nz, CSp) endif diff --git a/src/user/Rossby_front_2d_initialization.F90 b/src/user/Rossby_front_2d_initialization.F90 index 9676464330..b991fa95bc 100644 --- a/src/user/Rossby_front_2d_initialization.F90 +++ b/src/user/Rossby_front_2d_initialization.F90 @@ -163,13 +163,13 @@ end subroutine Rossby_front_initialize_temperature_salinity subroutine Rossby_front_initialize_velocity(u, v, h, G, GV, US, param_file, just_read_params) type(ocean_grid_type), intent(in) :: G !< Grid structure 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),SZK_(G)), & - intent(out) :: u !< i-component of velocity [m s-1] + intent(out) :: u !< i-component of velocity [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - intent(out) :: v !< j-component of velocity [m s-1] + intent(out) :: v !< j-component of velocity [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJ_(G), SZK_(G)), & intent(in) :: h !< Thickness [H ~> m or kg m-2] + 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. logical, optional, intent(in) :: just_read_params !< If present and true, this call @@ -214,7 +214,7 @@ subroutine Rossby_front_initialize_velocity(u, v, h, G, GV, US, param_file, just 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) = US%L_T_to_m_s * dUdT * Ty * zm ! Thermal wind starting at base of ML + u(I,j,k) = dUdT * Ty * zm ! Thermal wind starting at base of ML enddo enddo ; enddo diff --git a/src/user/soliton_initialization.F90 b/src/user/soliton_initialization.F90 index 033a8f0e52..4351060fb8 100644 --- a/src/user/soliton_initialization.F90 +++ b/src/user/soliton_initialization.F90 @@ -63,14 +63,20 @@ end subroutine soliton_initialize_thickness !> Initialization of u and v in the equatorial Rossby soliton test -subroutine soliton_initialize_velocity(u, v, h, G) - type(ocean_grid_type), intent(in) :: G !< Grid structure - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(out) :: u !< i-component of velocity [m s-1] - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(out) :: v !< j-component of velocity [m s-1] +subroutine soliton_initialize_velocity(u, v, h, G, US) + type(ocean_grid_type), intent(in) :: G !< Grid structure + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(out) :: u !< i-component of velocity [L T-1 ~> m s-1] + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(out) :: v !< j-component of velocity [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJ_(G), SZK_(G)), intent(in) :: h !< Thickness [H ~> m or kg m-2] - - real :: x, y, x0, y0 - real :: val1, val2, val3, val4 + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + + ! Local variables + real :: x, x0 ! Positions in the same units as geoLonT. + real :: y, y0 ! Positions in the same units as geoLatT. + real :: val1 ! A zonal decay scale in the inverse of the units of geoLonT. + real :: val2 ! An overall velocity amplitude [L T-1 ~> m s-1] + real :: val3 ! A decay factor [nondim] + real :: val4 ! The local velocity amplitude [L T-1 ~> m 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 @@ -78,7 +84,7 @@ subroutine soliton_initialize_velocity(u, v, h, G) x0 = 2.0*G%len_lon/3.0 y0 = 0.0 val1 = 0.395 - val2 = 0.771*(val1*val1) + val2 = US%m_s_to_L_T * 0.771*(val1*val1) v(:,:,:) = 0.0 u(:,:,:) = 0.0 diff --git a/src/user/user_initialization.F90 b/src/user/user_initialization.F90 index bcf1942cad..64f4f84247 100644 --- a/src/user/user_initialization.F90 +++ b/src/user/user_initialization.F90 @@ -106,10 +106,11 @@ subroutine USER_initialize_thickness(h, G, GV, param_file, just_read_params) end subroutine USER_initialize_thickness !> initialize velocities. -subroutine USER_initialize_velocity(u, v, G, param_file, just_read_params) +subroutine USER_initialize_velocity(u, v, G, US, param_file, just_read_params) type(ocean_grid_type), intent(in) :: G !< Ocean grid structure. - real, dimension(SZIB_(G), SZJ_(G), SZK_(G)), intent(out) :: u !< i-component of velocity [m s-1] - real, dimension(SZI_(G), SZJB_(G), SZK_(G)), intent(out) :: v !< j-component of velocity [m/s] + real, dimension(SZIB_(G), SZJ_(G), SZK_(G)), intent(out) :: u !< i-component of velocity [L T-1 ~> m s-1] + real, dimension(SZI_(G), SZJB_(G), SZK_(G)), intent(out) :: v !< j-component of velocity [L T-1 ~> m s-1] + 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. From 57eb24bcae21700ebee4654e7281880cbd7fedb0 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Fri, 16 Aug 2019 07:26:56 -0400 Subject: [PATCH 218/297] +Pass velocities to write_energy in [L T-1] Pass velocities to write_energy in [L T-1]. All answers are bitwise identical, but the rescaled units of several arguments to a public interface have changed. --- src/core/MOM.F90 | 4 ++-- src/diagnostics/MOM_sum_output.F90 | 21 ++++++++++++--------- 2 files changed, 14 insertions(+), 11 deletions(-) diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index df4fbba77d..3e41e075c1 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -854,7 +854,7 @@ subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, CS, & G, CS%sum_output_CSp) if (MOM_state_is_synchronized(CS)) & - call write_energy(US%L_T_to_m_s*CS%u, US%L_T_to_m_s*CS%v, CS%h, CS%tv, Time_local, CS%nstep_tot, & + call write_energy(CS%u, CS%v, CS%h, CS%tv, Time_local, CS%nstep_tot, & G, GV, US, CS%sum_output_CSp, CS%tracer_flow_CSp, & dt_forcing=real_to_time(time_interval) ) @@ -2503,7 +2503,7 @@ subroutine finish_MOM_initialization(Time, dirs, CS, restart_CSp) deallocate(restart_CSp_tmp) endif - call write_energy(US%L_T_to_m_s*CS%u, US%L_T_to_m_s*CS%v, CS%h, CS%tv, Time, 0, G, GV, US, & + call write_energy(CS%u, CS%v, CS%h, CS%tv, Time, 0, G, GV, US, & CS%sum_output_CSp, CS%tracer_flow_CSp) call callTree_leave("finish_MOM_initialization()") diff --git a/src/diagnostics/MOM_sum_output.F90 b/src/diagnostics/MOM_sum_output.F90 index d2c21551ce..d6f495faa5 100644 --- a/src/diagnostics/MOM_sum_output.F90 +++ b/src/diagnostics/MOM_sum_output.F90 @@ -305,9 +305,9 @@ subroutine write_energy(u, v, h, tv, day, n, G, GV, US, CS, tracer_CSp, OBC, dt_ 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]. + intent(in) :: u !< The zonal velocity [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - intent(in) :: v !< The meridional velocity [m s-1]. + intent(in) :: v !< The meridional velocity [L T-1 ~> 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 pointing to various @@ -387,6 +387,8 @@ subroutine write_energy(u, v, h, tv, day, n, G, GV, US, CS, tracer_CSp, OBC, dt_ real, dimension(SZI_(G),SZJ_(G)) :: & Temp_int, Salt_int ! Layer and cell integrated heat and salt [J] and [g Salt]. real :: H_to_kg_m2 ! Local copy of a unit conversion factor. + real :: KE_scale_factor ! The combination of unit rescaling factors in the kinetic energy + ! calculation [kg T2 L-2 s-2 H-1 ~> kg m-3 or nondim] integer :: num_nc_fields ! The number of fields that will actually go into ! the NetCDF file. integer :: i, j, k, is, ie, js, je, ns, nz, m, Isq, Ieq, Jsq, Jeq @@ -687,9 +689,10 @@ subroutine write_energy(u, v, h, tv, day, n, G, GV, US, CS, tracer_CSp, OBC, dt_ endif ! Calculate the Kinetic Energy integrated over each layer. + KE_scale_factor = GV%H_to_kg_m2*US%L_T_to_m_s**2 tmp1(:,:,:) = 0.0 do k=1,nz ; do j=js,je ; do i=is,ie - tmp1(i,j,k) = (0.25 * H_to_kg_m2 * (areaTm(i,j) * h(i,j,k))) * & + tmp1(i,j,k) = (0.25 * KE_scale_factor * (areaTm(i,j) * h(i,j,k))) * & (u(I-1,j,k)**2 + u(I,j,k)**2 + v(i,J-1,k)**2 + v(i,J,k)**2) enddo ; enddo ; enddo KE_tot = reproducing_sum(tmp1, sums=KE) @@ -713,21 +716,21 @@ subroutine write_energy(u, v, h, tv, day, n, G, GV, US, CS, tracer_CSp, OBC, dt_ max_CFL(1:2) = 0.0 do k=1,nz ; do j=js,je ; do I=Isq,Ieq if (u(I,j,k) < 0.0) then - CFL_trans = (-US%m_s_to_L_T*u(I,j,k) * US%s_to_T*CS%dt) * (G%dy_Cu(I,j) * G%IareaT(i+1,j)) + CFL_trans = (-u(I,j,k) * US%s_to_T*CS%dt) * (G%dy_Cu(I,j) * G%IareaT(i+1,j)) else - CFL_trans = (US%m_s_to_L_T*u(I,j,k) * US%s_to_T*CS%dt) * (G%dy_Cu(I,j) * G%IareaT(i,j)) + CFL_trans = (u(I,j,k) * US%s_to_T*CS%dt) * (G%dy_Cu(I,j) * G%IareaT(i,j)) endif - CFL_lin = abs(US%m_s_to_L_T*u(I,j,k) * US%s_to_T*CS%dt) * G%IdxCu(I,j) + CFL_lin = abs(u(I,j,k) * US%s_to_T*CS%dt) * G%IdxCu(I,j) max_CFL(1) = max(max_CFL(1), CFL_trans) max_CFL(2) = max(max_CFL(2), CFL_lin) enddo ; enddo ; enddo do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie if (v(i,J,k) < 0.0) then - CFL_trans = (-US%m_s_to_L_T*v(i,J,k) * US%s_to_T*CS%dt) * (G%dx_Cv(i,J) * G%IareaT(i,j+1)) + CFL_trans = (-v(i,J,k) * US%s_to_T*CS%dt) * (G%dx_Cv(i,J) * G%IareaT(i,j+1)) else - CFL_trans = (US%m_s_to_L_T*v(i,J,k) * US%s_to_T*CS%dt) * (G%dx_Cv(i,J) * G%IareaT(i,j)) + CFL_trans = (v(i,J,k) * US%s_to_T*CS%dt) * (G%dx_Cv(i,J) * G%IareaT(i,j)) endif - CFL_lin = abs(US%m_s_to_L_T*v(i,J,k) * US%s_to_T*CS%dt) * G%IdyCv(i,J) + CFL_lin = abs(v(i,J,k) * US%s_to_T*CS%dt) * G%IdyCv(i,J) max_CFL(1) = max(max_CFL(1), CFL_trans) max_CFL(2) = max(max_CFL(2), CFL_lin) enddo ; enddo ; enddo From d645d98db72bba1e84d2facde3eb1eb9a8396e0e Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Fri, 16 Aug 2019 09:02:16 -0400 Subject: [PATCH 219/297] +Pass timestep to continuity in [T] Pass the timestep to continuity and continuity_PPM in [T]. All answers are bitwise identical, but the rescaled units of arguments to two public interfaces have changed. --- src/core/MOM_continuity.F90 | 2 +- src/core/MOM_continuity_PPM.F90 | 20 ++++++++++---------- src/core/MOM_dynamics_split_RK2.F90 | 8 ++++---- src/core/MOM_dynamics_unsplit.F90 | 6 +++--- src/core/MOM_dynamics_unsplit_RK2.F90 | 6 +++--- 5 files changed, 21 insertions(+), 21 deletions(-) diff --git a/src/core/MOM_continuity.F90 b/src/core/MOM_continuity.F90 index 7e8d2d1843..9aaa6f92fc 100644 --- a/src/core/MOM_continuity.F90 +++ b/src/core/MOM_continuity.F90 @@ -57,7 +57,7 @@ subroutine continuity(u, v, hin, h, uh, vh, dt, G, GV, US, CS, uhbt, vhbt, OBC, real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & intent(out) :: vh !< Volume flux through meridional faces = !! v*h*dx [H L2 T-1 ~> m3 s-1 or kg s-1]. - real, intent(in) :: dt !< Time increment [s]. + real, intent(in) :: dt !< Time increment [T ~> 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)), & diff --git a/src/core/MOM_continuity_PPM.F90 b/src/core/MOM_continuity_PPM.F90 index 3a6021e6b5..8a8ecf9da5 100644 --- a/src/core/MOM_continuity_PPM.F90 +++ b/src/core/MOM_continuity_PPM.F90 @@ -73,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, US, CS, uhbt, vhbt, OBC, & +subroutine continuity_PPM(u, v, hin, h, uh, vh, dt_in_T, G, GV, US, CS, uhbt, vhbt, OBC, & visc_rem_u, visc_rem_v, u_cor, v_cor, BT_cont) type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. type(continuity_PPM_CS), pointer :: CS !< Module's control structure. @@ -89,7 +89,7 @@ subroutine continuity_PPM(u, v, hin, h, uh, vh, dt, G, GV, US, CS, uhbt, vhbt, O intent(out) :: uh !< Zonal volume flux, u*h*dy [H L2 T-1 ~> m3 s-1 or kg s-1]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & intent(out) :: vh !< Meridional volume flux, v*h*dx [H L2 T-1 ~> m3 s-1 or kg s-1]. - real, intent(in) :: dt !< Time increment [s]. + real, intent(in) :: dt_in_T !< Time increment [T ~> 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)), & @@ -149,12 +149,12 @@ subroutine continuity_PPM(u, v, hin, h, uh, vh, dt, G, GV, US, CS, uhbt, vhbt, O ! 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, US%s_to_T*dt, G, GV, US, CS, LB, uhbt, OBC, visc_rem_u, u_cor, BT_cont) + call zonal_mass_flux(u, hin, uh, dt_in_T, G, GV, US, CS, LB, uhbt, OBC, visc_rem_u, u_cor, BT_cont) call cpu_clock_begin(id_clock_update) !$OMP parallel do default(shared) do k=1,nz ; do j=LB%jsh,LB%jeh ; do i=LB%ish,LB%ieh - h(i,j,k) = hin(i,j,k) - US%s_to_T*dt * G%IareaT(i,j) * (uh(I,j,k) - uh(I-1,j,k)) + h(i,j,k) = hin(i,j,k) - dt_in_T * G%IareaT(i,j) * (uh(I,j,k) - uh(I-1,j,k)) ! Uncomment this line to prevent underflow. ! if (h(i,j,k) < h_min) h(i,j,k) = h_min enddo ; enddo ; enddo @@ -164,12 +164,12 @@ subroutine continuity_PPM(u, v, hin, h, uh, vh, dt, G, GV, US, CS, uhbt, vhbt, O ! Now advect meridionally, using the updated thicknesses to determine ! the fluxes. - call meridional_mass_flux(v, h, vh, US%s_to_T*dt, G, GV, US, CS, LB, vhbt, OBC, visc_rem_v, v_cor, BT_cont) + call meridional_mass_flux(v, h, vh, dt_in_T, G, GV, US, CS, LB, vhbt, OBC, visc_rem_v, v_cor, BT_cont) call cpu_clock_begin(id_clock_update) !$OMP parallel do default(shared) do k=1,nz ; do j=LB%jsh,LB%jeh ; do i=LB%ish,LB%ieh - h(i,j,k) = h(i,j,k) - US%s_to_T*dt * G%IareaT(i,j) * (vh(i,J,k) - vh(i,J-1,k)) + h(i,j,k) = h(i,j,k) - dt_in_T * G%IareaT(i,j) * (vh(i,J,k) - vh(i,J-1,k)) ! This line prevents underflow. if (h(i,j,k) < h_min) h(i,j,k) = h_min enddo ; enddo ; enddo @@ -180,24 +180,24 @@ subroutine continuity_PPM(u, v, hin, h, uh, vh, dt, G, GV, US, CS, uhbt, vhbt, O 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, US%s_to_T*dt, G, GV, US, CS, LB, vhbt, OBC, visc_rem_v, v_cor, BT_cont) + call meridional_mass_flux(v, hin, vh, dt_in_T, G, GV, US, CS, LB, vhbt, OBC, visc_rem_v, v_cor, BT_cont) call cpu_clock_begin(id_clock_update) !$OMP parallel do default(shared) do k=1,nz ; do j=LB%jsh,LB%jeh ; do i=LB%ish,LB%ieh - h(i,j,k) = hin(i,j,k) - US%s_to_T*dt * G%IareaT(i,j) * (vh(i,J,k) - vh(i,J-1,k)) + h(i,j,k) = hin(i,j,k) - dt_in_T * G%IareaT(i,j) * (vh(i,J,k) - vh(i,J-1,k)) enddo ; enddo ; enddo call cpu_clock_end(id_clock_update) ! 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, US%s_to_T*dt, G, GV, US, CS, LB, uhbt, OBC, visc_rem_u, u_cor, BT_cont) + call zonal_mass_flux(u, h, uh, dt_in_T, G, GV, US, CS, LB, uhbt, OBC, visc_rem_u, u_cor, BT_cont) call cpu_clock_begin(id_clock_update) !$OMP parallel do default(shared) do k=1,nz ; do j=LB%jsh,LB%jeh ; do i=LB%ish,LB%ieh - h(i,j,k) = h(i,j,k) - US%s_to_T*dt * G%IareaT(i,j) * (uh(I,j,k) - uh(I-1,j,k)) + h(i,j,k) = h(i,j,k) - dt_in_T * G%IareaT(i,j) * (uh(I,j,k) - uh(I-1,j,k)) ! This line prevents underflow. if (h(i,j,k) < h_min) h(i,j,k) = h_min enddo ; enddo ; enddo diff --git a/src/core/MOM_dynamics_split_RK2.F90 b/src/core/MOM_dynamics_split_RK2.F90 index 17beedc723..696953f649 100644 --- a/src/core/MOM_dynamics_split_RK2.F90 +++ b/src/core/MOM_dynamics_split_RK2.F90 @@ -514,7 +514,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, US, CS%continuity_CSp, & + call continuity(u, v, h, hp, uh_in, vh_in, dt_in_T, 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) if (BT_cont_BT_thick) then @@ -601,7 +601,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, US, CS%continuity_CSp, & + call continuity(up, vp, h, hp, uh, vh, dt_in_T, 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) @@ -806,7 +806,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, US, CS%continuity_CSp, & + call continuity(u, v, h, h, uh, vh, dt_in_T, 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) call do_group_pass(CS%pass_h, G%Domain, clock=id_clock_pass) @@ -1178,7 +1178,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 do k=1,nz ; do j=jsd,jed ; do i=isd,ied ; h_tmp(i,j,k) = h(i,j,k) ; enddo ; enddo ; enddo - call continuity(u, v, h, h_tmp, uh, vh, dt, G, GV, US, CS%continuity_CSp, OBC=CS%OBC) + call continuity(u, v, h, h_tmp, uh, vh, US%s_to_T*dt, G, GV, US, CS%continuity_CSp, OBC=CS%OBC) call pass_var(h_tmp, G%Domain, clock=id_clock_pass_init) do k=1,nz ; do j=jsd,jed ; do i=isd,ied CS%h_av(i,j,k) = 0.5*(h(i,j,k) + h_tmp(i,j,k)) diff --git a/src/core/MOM_dynamics_unsplit.F90 b/src/core/MOM_dynamics_unsplit.F90 index 1dc08b0abe..6ffc526f4a 100644 --- a/src/core/MOM_dynamics_unsplit.F90 +++ b/src/core/MOM_dynamics_unsplit.F90 @@ -264,7 +264,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, US, CS%continuity_CSp, OBC=CS%OBC) + call continuity(u, v, h, hp, uh, vh, dt_in_T*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) call pass_vector(uh, vh, G%Domain, clock=id_clock_pass) @@ -356,7 +356,7 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & ! uh = up * hp ! 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, US, & + call continuity(up, vp, hp, h_av, uh, vh, (0.5*dt_in_T), 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) @@ -420,7 +420,7 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & ! uh = upp * hp ! 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, US, & + call continuity(upp, vpp, hp, h, uh, vh, (dt_in_T*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) diff --git a/src/core/MOM_dynamics_unsplit_RK2.F90 b/src/core/MOM_dynamics_unsplit_RK2.F90 index c4be7f96b9..729dae15bb 100644 --- a/src/core/MOM_dynamics_unsplit_RK2.F90 +++ b/src/core/MOM_dynamics_unsplit_RK2.F90 @@ -281,7 +281,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, US%T_to_s*dt_pred, G, GV, US, & + 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) @@ -353,7 +353,7 @@ subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt, ! uh = up[n-1/2] * h[n-1/2] ! 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, US, CS%continuity_CSp, OBC=CS%OBC) + call continuity(up, vp, h_in, hp, uh, vh, dt_in_T, 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, ! uh = up[n] * h[n] (up[n] might be extrapolated to damp GWs) ! 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, US, CS%continuity_CSp, OBC=CS%OBC) + call continuity(up, vp, h_in, h_in, uh, vh, dt_in_T, 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) From e3b875467121e2118e76f1ed76effe77b4360cc8 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Fri, 16 Aug 2019 09:08:14 -0400 Subject: [PATCH 220/297] Rescaled MOM_open_boundary.F90 internal variables Rescaled internal variables in MOM_open_boundary.F90. There are some expressions with oblique boundary conditions that do not make sense to me and may be dimensionally inconsistent. All solutions are bitwise identical. --- src/core/MOM_open_boundary.F90 | 132 +++++++++++++++++---------------- 1 file changed, 68 insertions(+), 64 deletions(-) diff --git a/src/core/MOM_open_boundary.F90 b/src/core/MOM_open_boundary.F90 index 4555ebaddf..7c0ba4c6b4 100644 --- a/src/core/MOM_open_boundary.F90 +++ b/src/core/MOM_open_boundary.F90 @@ -156,11 +156,11 @@ module MOM_open_boundary !! the OB segment [L T-1 ~> m s-1]. real, pointer, dimension(:,:) :: eta=>NULL() !< The sea-surface elevation along the segment [m]. real, pointer, dimension(:,:,:) :: grad_normal=>NULL() !< The gradient of the normal flow along the - !! segment [s-1] + !! segment [T-1 ~> s-1] real, pointer, dimension(:,:,:) :: grad_tan=>NULL() !< The gradient of the tangential flow along the - !! segment [s-1] + !! segment [T-1 ~> s-1] real, pointer, dimension(:,:,:) :: grad_gradient=>NULL() !< The gradient of the gradient of tangential flow along the - !! segment times a grid spacing [m s-1 L-1 ~> s-1] + !! segment times a grid spacing [T-1 ~> s-1] real, pointer, dimension(:,:,:) :: rx_normal=>NULL() !< The rx_old_u value for radiation coeff !! for normal velocity real, pointer, dimension(:,:,:) :: ry_normal=>NULL() !< The tangential value for radiation coeff @@ -1534,7 +1534,7 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, US, dt) type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, intent(in) :: dt !< Appropriate timestep [s] ! Local variables - real :: dhdt, dhdx, dhdy ! One-point differences in time or space [m s-1] + real :: dhdt, dhdx, dhdy ! One-point differences in time or space [L T-1 ~> m s-1] real :: gamma_u, gamma_v, gamma_2 real :: cff, Cx, Cy, tau real :: rx_max, ry_max ! coefficients for radiation @@ -1544,7 +1544,7 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, US, dt) real, pointer, dimension(:,:,:) :: rx_tangential=>NULL() real, pointer, dimension(:,:,:) :: ry_tangential=>NULL() real, pointer, dimension(:,:,:) :: cff_tangential=>NULL() - real, parameter :: eps = 1.0e-20 + real :: eps ! A small velocity squared [L2 T-2 ~> m2 s-2]? type(OBC_segment_type), pointer :: segment => NULL() integer :: i, j, k, is, ie, js, je, nz, n integer :: is_obc, ie_obc, js_obc, je_obc @@ -1556,6 +1556,8 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, US, dt) if (.not.(OBC%open_u_BCs_exist_globally .or. OBC%open_v_BCs_exist_globally)) & return + eps = 1.0e-20*US%m_s_to_L_T**2 + !! Copy previously calculated phase velocity from global arrays into segments !! This is terribly inefficient and temporary solution for continuity across restarts !! and needs to be revisited in the future. @@ -1603,14 +1605,14 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, US, dt) do n=1,OBC%number_of_segments segment=>OBC%segment(n) if (.not. segment%on_pe) cycle - if (segment%oblique) call gradient_at_q_points(G,segment,US%L_T_to_m_s*u_new(:,:,:),US%L_T_to_m_s*v_new(:,:,:)) + if (segment%oblique) call gradient_at_q_points(G, segment, u_new(:,:,:), v_new(:,:,:)) if (segment%direction == OBC_DIRECTION_E) then I=segment%HI%IsdB if (I 0.0) rx_new = min( (dhdt/dhdx), rx_max) ! outward phase speed rx_avg = (1.0-gamma_u)*segment%rx_normal(I,j,k) + gamma_u*rx_new @@ -1623,8 +1625,8 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, US, dt) ! implemented as a work-around to limitations in restart capability OBC%rx_normal(I,j,k) = segment%rx_normal(I,j,k) elseif (segment%oblique) then - dhdt = US%L_T_to_m_s*(u_old(I-1,j,k) - u_new(I-1,j,k)) !old-new - dhdx = US%L_T_to_m_s*(u_new(I-1,j,k) - u_new(I-2,j,k)) !in new time backward sasha for I-1 + dhdt = (u_old(I-1,j,k) - u_new(I-1,j,k)) !old-new + dhdx = (u_new(I-1,j,k) - u_new(I-2,j,k)) !in new time backward sasha for I-1 if (dhdt*(segment%grad_normal(J,1,k) + segment%grad_normal(J-1,1,k)) > 0.0) then dhdy = segment%grad_normal(J-1,1,k) elseif (dhdt*(segment%grad_normal(J,1,k) + segment%grad_normal(J-1,1,k)) == 0.0) then @@ -1633,9 +1635,10 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, US, dt) dhdy = segment%grad_normal(J,1,k) endif 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)) + rx_new = US%L_T_to_m_s**2*dhdt*dhdx + cff_new = US%L_T_to_m_s**2*max(dhdx*dhdx + dhdy*dhdy, eps) + !### I do not think that cff is ever set. + ry_new = min(cff,max(US%L_T_to_m_s**2*dhdt*dhdy,-cff)) 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 @@ -1643,7 +1646,7 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, US, dt) segment%ry_normal(i,J,k) = ry_avg segment%cff_normal(i,J,k) = cff_avg segment%normal_vel(I,j,k) = ((cff_avg*u_new(I,j,k) + rx_avg*u_new(I-1,j,k)) - & - US%m_s_to_L_T*(max(ry_avg,0.0)*segment%grad_normal(J-1,2,k) + & + (max(ry_avg,0.0)*segment%grad_normal(J-1,2,k) + & min(ry_avg,0.0)*segment%grad_normal(J,2,k))) / & (cff_avg + rx_avg) ! Copy restart fields into 3-d arrays. This is an inefficient and temporary issues @@ -1752,9 +1755,9 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, US, dt) ry_avg = ry_tangential(I,J,k) cff_avg = cff_tangential(I,J,k) segment%tangential_vel(I,J,k) = ((cff_avg*v_new(i,J,k) + rx_avg*v_new(i-1,J,k)) - & - US%m_s_to_L_T * (max(ry_avg,0.0)*segment%grad_tan(j,2,k) + & - min(ry_avg,0.0)*segment%grad_tan(j+1,2,k))) / & - (cff_avg + rx_avg) + (max(ry_avg,0.0)*segment%grad_tan(j,2,k) + & + min(ry_avg,0.0)*segment%grad_tan(j+1,2,k))) / & + (cff_avg + rx_avg) enddo ; enddo endif if (segment%nudged_tan) then @@ -1780,7 +1783,7 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, US, dt) segment%tangential_grad(I,J,k) = & ((cff_avg*(v_new(i,J,k) - v_new(i-1,J,k))*G%IdxBu(I-1,J) + & rx_avg*(v_new(i-1,J,k) - v_new(i-2,J,k))*G%IdxBu(I-2,J)) - & - US%m_s_to_L_T*(max(ry_avg,0.0)*segment%grad_gradient(J,2,k) + & + (max(ry_avg,0.0)*segment%grad_gradient(J,2,k) + & min(ry_avg,0.0)*segment%grad_gradient(J+1,2,k)) ) / & (cff_avg + rx_avg) enddo ; enddo @@ -1809,8 +1812,8 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, US, dt) if (I>G%HI%IecB) cycle do k=1,nz ; do j=segment%HI%jsd,segment%HI%jed if (segment%radiation) then - dhdt = US%L_T_to_m_s*(u_old(I+1,j,k) - u_new(I+1,j,k)) !old-new - dhdx = US%L_T_to_m_s*(u_new(I+1,j,k) - u_new(I+2,j,k)) !in new time forward sasha for I+1 + dhdt = (u_old(I+1,j,k) - u_new(I+1,j,k)) !old-new + dhdx = (u_new(I+1,j,k) - u_new(I+2,j,k)) !in new time forward sasha for I+1 rx_new = 0.0 if (dhdt*dhdx > 0.0) rx_new = min( (dhdt/dhdx), rx_max) rx_avg = (1.0-gamma_u)*segment%rx_normal(I,j,k) + gamma_u*rx_new @@ -1823,8 +1826,8 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, US, dt) ! implemented as a work-around to limitations in restart capability OBC%rx_normal(I,j,k) = segment%rx_normal(I,j,k) elseif (segment%oblique) then - dhdt = US%L_T_to_m_s*(u_old(I+1,j,k) - u_new(I+1,j,k)) !old-new - dhdx = US%L_T_to_m_s*(u_new(I+1,j,k) - u_new(I+2,j,k)) !in new time forward sasha for I+1 + dhdt = (u_old(I+1,j,k) - u_new(I+1,j,k)) !old-new + dhdx = (u_new(I+1,j,k) - u_new(I+2,j,k)) !in new time forward sasha for I+1 if (dhdt*(segment%grad_normal(J,1,k) + segment%grad_normal(J-1,1,k)) > 0.0) then dhdy = segment%grad_normal(J-1,1,k) elseif (dhdt*(segment%grad_normal(J,1,k) + segment%grad_normal(J-1,1,k)) == 0.0) then @@ -1833,9 +1836,10 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, US, dt) dhdy = segment%grad_normal(J,1,k) endif 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)) + rx_new = US%L_T_to_m_s**2*dhdt*dhdx + cff_new = US%L_T_to_m_s**2*max(dhdx*dhdx + dhdy*dhdy, eps) + !### I do not think that cff is ever set. + ry_new = min(cff,max(US%L_T_to_m_s**2*dhdt*dhdy,-cff)) 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 @@ -1843,9 +1847,9 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, US, dt) segment%ry_normal(i,J,k) = ry_avg segment%cff_normal(i,J,k) = cff_avg segment%normal_vel(I,j,k) = ((cff_avg*u_new(I,j,k) + rx_avg*u_new(I+1,j,k)) - & - US%m_s_to_L_T*(max(ry_avg,0.0)*segment%grad_normal(J-1,2,k) + & - min(ry_avg,0.0)*segment%grad_normal(J,2,k))) / & - (cff_avg + rx_avg) + (max(ry_avg,0.0)*segment%grad_normal(J-1,2,k) + & + min(ry_avg,0.0)*segment%grad_normal(J,2,k))) / & + (cff_avg + rx_avg) ! Copy restart fields into 3-d arrays. This is an inefficient and temporary issues ! implemented as a work-around to limitations in restart capability OBC%rx_normal(I,j,k) = segment%rx_normal(I,j,k) @@ -1952,9 +1956,9 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, US, dt) ry_avg = ry_tangential(I,J,k) cff_avg = cff_tangential(I,J,k) segment%tangential_vel(I,J,k) = ((cff_avg*v_new(i+1,J,k) + rx_avg*v_new(i+2,J,k)) - & - US%m_s_to_L_T*(max(ry_avg,0.0)*segment%grad_tan(j,2,k) + & - min(ry_avg,0.0)*segment%grad_tan(j+1,2,k))) / & - (cff_avg + rx_avg) + (max(ry_avg,0.0)*segment%grad_tan(j,2,k) + & + min(ry_avg,0.0)*segment%grad_tan(j+1,2,k))) / & + (cff_avg + rx_avg) enddo ; enddo endif if (segment%nudged_tan) then @@ -1980,8 +1984,8 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, US, dt) segment%tangential_grad(I,J,k) = & ((cff_avg*(v_new(i+2,J,k) - v_new(i+1,J,k))*G%IdxBu(I+1,J) + & rx_avg*(v_new(i+3,J,k) - v_new(i+2,J,k))*G%IdxBu(I+2,J)) - & - US%m_s_to_L_T*(max(ry_avg,0.0)*segment%grad_gradient(J,2,k) + & - min(ry_avg,0.0)*segment%grad_gradient(J+1,2,k))) / & + (max(ry_avg,0.0)*segment%grad_gradient(J,2,k) + & + min(ry_avg,0.0)*segment%grad_gradient(J+1,2,k))) / & (cff_avg + rx_avg) enddo ; enddo endif @@ -2009,8 +2013,8 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, US, dt) if (J 0.0) ry_new = min( (dhdt/dhdy), ry_max) ry_avg = (1.0-gamma_v)*segment%ry_normal(I,j,k) + gamma_v*ry_new @@ -2023,8 +2027,8 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, US, dt) ! implemented as a work-around to limitations in restart capability OBC%ry_normal(i,J,k) = segment%ry_normal(i,J,k) elseif (segment%oblique) then - dhdt = US%L_T_to_m_s*(v_old(i,J-1,k) - v_new(i,J-1,k)) !old-new - dhdy = US%L_T_to_m_s*(v_new(i,J-1,k) - v_new(i,J-2,k)) !in new time backward sasha for J-1 + 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) @@ -2034,20 +2038,20 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, US, dt) dhdx = segment%grad_normal(I,1,k) endif 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)) + ry_new = US%L_T_to_m_s**2*dhdt*dhdy + cff_new = US%L_T_to_m_s**2*max(dhdx*dhdx + dhdy*dhdy, eps) + !### I do not think that cff is ever set. + rx_new = min(cff,max(US%L_T_to_m_s**2*dhdt*dhdx,-cff)) 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 segment%rx_normal(I,j,k) = rx_avg segment%ry_normal(i,J,k) = ry_avg segment%cff_normal(i,J,k) = cff_avg - segment%normal_vel(i,J,k) = & - ((cff_avg*v_new(i,J,k) + ry_avg*v_new(i,J-1,k)) - & - US%m_s_to_L_T*(max(rx_avg,0.0)*segment%grad_normal(I-1,2,k) +& - min(rx_avg,0.0)*segment%grad_normal(I,2,k))) / & - (cff_avg + ry_avg) + segment%normal_vel(i,J,k) = ((cff_avg*v_new(i,J,k) + ry_avg*v_new(i,J-1,k)) - & + (max(rx_avg,0.0)*segment%grad_normal(I-1,2,k) +& + min(rx_avg,0.0)*segment%grad_normal(I,2,k))) / & + (cff_avg + ry_avg) ! Copy restart fields into 3-d arrays. This is an inefficient and temporary issues ! implemented as a work-around to limitations in restart capability OBC%rx_normal(I,j,k) = segment%rx_normal(I,j,k) @@ -2154,11 +2158,10 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, US, dt) rx_avg = rx_tangential(I,J,k) ry_avg = ry_tangential(I,J,k) cff_avg = cff_tangential(I,J,k) - segment%tangential_vel(I,J,k) = & - ((cff_avg*u_new(I,j,k) + rx_avg*u_new(I,j-1,k)) - & - US%m_s_to_L_T * (max(ry_avg,0.0)*segment%grad_tan(i,2,k) + & + segment%tangential_vel(I,J,k) = ((cff_avg*u_new(I,j,k) + rx_avg*u_new(I,j-1,k)) - & + (max(ry_avg,0.0)*segment%grad_tan(i,2,k) + & min(ry_avg,0.0)*segment%grad_tan(i+1,2,k))) / & - (cff_avg + rx_avg) + (cff_avg + rx_avg) enddo ; enddo endif if (segment%nudged_tan) then @@ -2184,7 +2187,7 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, US, dt) segment%tangential_grad(I,J,k) = & ((cff_avg*(u_new(I,j,k) - u_new(I,j-1,k))*G%IdyBu(I,J-1) + & rx_avg*(u_new(I,j-1,k) - u_new(I,j-2,k))*G%IdyBu(I,J-2)) - & - US%m_s_to_L_T * (max(ry_avg,0.0)*segment%grad_gradient(I,2,k) + & + (max(ry_avg,0.0)*segment%grad_gradient(I,2,k) + & min(ry_avg,0.0)*segment%grad_gradient(I+1,2,k))) / & (cff_avg + rx_avg) enddo ; enddo @@ -2213,8 +2216,8 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, US, dt) if (J>G%HI%JecB) cycle do k=1,nz ; do i=segment%HI%isd,segment%HI%ied if (segment%radiation) then - dhdt = US%L_T_to_m_s*(v_old(i,J+1,k) - v_new(i,J+1,k)) !old-new - dhdy = US%L_T_to_m_s*(v_new(i,J+1,k) - v_new(i,J+2,k)) !in new time backward sasha for J-1 + 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 ry_new = 0.0 if (dhdt*dhdy > 0.0) ry_new = min( (dhdt/dhdy), ry_max) ry_avg = (1.0-gamma_v)*segment%ry_normal(I,j,k) + gamma_v*ry_new @@ -2227,8 +2230,8 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, US, dt) ! implemented as a work-around to limitations in restart capability OBC%ry_normal(i,J,k) = segment%ry_normal(i,J,k) elseif (segment%oblique) then - dhdt = US%L_T_to_m_s*(v_old(i,J+1,k) - v_new(i,J+1,k)) !old-new - dhdy = US%L_T_to_m_s*(v_new(i,J+1,k) - v_new(i,J+2,k)) !in new time backward sasha for J-1 + 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 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 @@ -2237,9 +2240,10 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, US, dt) dhdx = segment%grad_normal(I,1,k) endif 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)) + ry_new = US%L_T_to_m_s**2*dhdt*dhdy + cff_new = US%L_T_to_m_s**2*max(dhdx*dhdx + dhdy*dhdy, eps) + !### I do not think that cff is ever set. + rx_new = min(cff,max(US%L_T_to_m_s**2*dhdt*dhdx,-cff)) 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 @@ -2247,7 +2251,7 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, US, dt) segment%ry_normal(i,J,k) = ry_avg segment%cff_normal(i,J,k) = cff_avg segment%normal_vel(i,J,k) = ((cff_avg*v_new(i,J,k) + ry_avg*v_new(i,J+1,k)) - & - US%m_s_to_L_T*(max(rx_avg,0.0)*segment%grad_normal(I-1,2,k) + & + (max(rx_avg,0.0)*segment%grad_normal(I-1,2,k) + & min(rx_avg,0.0)*segment%grad_normal(I,2,k))) / & (cff_avg + ry_avg) ! Copy restart fields into 3-d arrays. This is an inefficient and temporary issues @@ -2357,8 +2361,8 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, US, dt) cff_avg = cff_tangential(I,J,k) segment%tangential_vel(I,J,k) = & ((cff_avg*u_new(I,j+1,k) + rx_avg*u_new(I,j+2,k)) - & - US%m_s_to_L_T * (max(ry_avg,0.0)*segment%grad_tan(i,2,k) + & - min(ry_avg,0.0)*segment%grad_tan(i+1,2,k)) ) / & + (max(ry_avg,0.0)*segment%grad_tan(i,2,k) + & + min(ry_avg,0.0)*segment%grad_tan(i+1,2,k)) ) / & (cff_avg + rx_avg) enddo ; enddo endif @@ -2385,8 +2389,8 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, US, dt) segment%tangential_grad(I,J,k) = & ((cff_avg*(u_new(I,j+2,k) - u_new(I,j+1,k))*G%IdyBu(I,J+1) + & rx_avg*(u_new(I,j+3,k) - u_new(I,j+2,k))*G%IdyBu(I,J+2)) - & - US%m_s_to_L_T * (max(ry_avg,0.0)*segment%grad_gradient(i,2,k) + & - min(ry_avg,0.0)*segment%grad_gradient(i+1,2,k))) / & + (max(ry_avg,0.0)*segment%grad_gradient(i,2,k) + & + min(ry_avg,0.0)*segment%grad_gradient(i+1,2,k))) / & (cff_avg + rx_avg) enddo ; enddo endif @@ -2489,8 +2493,8 @@ end subroutine open_boundary_zero_normal_flow subroutine gradient_at_q_points(G, segment, uvel, vvel) type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(OBC_segment_type), pointer :: segment !< OBC segment structure - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: uvel !< zonal velocity [m s-1] - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: vvel !< meridional velocity [m s-1] + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: uvel !< zonal velocity [L T-1 ~> m s-1] + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: vvel !< meridional velocity [L T-1 ~> m s-1] integer :: i,j,k if (.not. segment%on_pe) return From 4b62f777dda06b488d60a5cc72d89b858f04e0d9 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Fri, 16 Aug 2019 09:17:46 -0400 Subject: [PATCH 221/297] Simplified a logical test in step_forward_MEKE Simplified a logical test in step_forward_MEKE to eliminate the addition of variables with different units. All answers are bitwise identical. --- src/parameterizations/lateral/MOM_MEKE.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/parameterizations/lateral/MOM_MEKE.F90 b/src/parameterizations/lateral/MOM_MEKE.F90 index 9f43034564..5d6b71a576 100644 --- a/src/parameterizations/lateral/MOM_MEKE.F90 +++ b/src/parameterizations/lateral/MOM_MEKE.F90 @@ -168,7 +168,7 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h if (.not.associated(MEKE)) call MOM_error(FATAL, & "MOM_MEKE: MEKE must be initialized before it is used.") - if ((US%s_to_T*CS%MEKE_damping + CS%MEKE_Cd_scale > 0.0) .or. (CS%MEKE_Cb>0.) & + if ((CS%MEKE_damping > 0.0) .or. (CS%MEKE_Cd_scale > 0.0) .or. (CS%MEKE_Cb>0.) & .or. CS%visc_drag) then use_drag_rate = .true. else From 7c4cfa72899656f1924bc9467f7ef6aa5ad09b52 Mon Sep 17 00:00:00 2001 From: Kate Hedstrom Date: Fri, 16 Aug 2019 13:22:40 -0800 Subject: [PATCH 222/297] 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 170c7be79ada580be976780f301b50b9f4e01c4b Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Fri, 16 Aug 2019 17:02:06 -0400 Subject: [PATCH 223/297] Rescaled taux_bot and tauy_bot to [kg L Z T-2 m-3] Rescaled the bottom drag returned from MOM_vert_friction and passed to btstep into units of [kg L Z T-2 m-3 ~> Pa] for greater dimensional consistency testing. All answers are bitwise identical. --- src/core/MOM_barotropic.F90 | 13 ++++++++----- src/core/MOM_dynamics_split_RK2.F90 | 6 ++++-- src/core/MOM_dynamics_unsplit.F90 | 6 ++++-- src/core/MOM_dynamics_unsplit_RK2.F90 | 6 ++++-- .../vertical/MOM_vert_friction.F90 | 18 ++++++++++-------- 5 files changed, 30 insertions(+), 19 deletions(-) diff --git a/src/core/MOM_barotropic.F90 b/src/core/MOM_barotropic.F90 index b3b0b1925c..8d48ebbb0b 100644 --- a/src/core/MOM_barotropic.F90 +++ b/src/core/MOM_barotropic.F90 @@ -444,9 +444,9 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, !! gradient at the start of the barotropic stepping !! [H ~> m or kg m-2]. real, dimension(:,:), optional, pointer :: taux_bot !< The zonal bottom frictional stress from - !! ocean to the seafloor [Pa]. + !! ocean to the seafloor [kg L Z T-2 m-3 ~> Pa]. real, dimension(:,:), optional, pointer :: tauy_bot !< The meridional bottom frictional stress - !! from ocean to the seafloor [Pa]. + !! from ocean to the seafloor [kg L Z T-2 m-3 ~> Pa]. real, dimension(:,:,:), optional, pointer :: uh0 !< The zonal layer transports at reference !! velocities [H L2 T-1 ~> m3 s-1 or kg s-1]. real, dimension(:,:,:), optional, pointer :: u_uh0 !< The velocities used to calculate @@ -581,6 +581,8 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, 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) [Z m2 kg-1 ~> m3 kg-1]. + real :: mass_accel_to_Z ! The depth unit converison times an acceleration conversion divided by + ! the mean density (Rho0) [Z L m s2 T-2 kg-1 ~> m3 kg-1]. real :: visc_rem ! A work variable that may equal visc_rem_[uv]. Nondim. real :: vel_prev ! The previous velocity [L T-1 ~> m s-1]. real :: dtbt ! The barotropic time step [T ~> s]. @@ -722,7 +724,8 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, dtbt = dt_in_T * Instep bebt = CS%bebt be_proj = CS%bebt - mass_to_Z = US%m_to_L*US%T_to_s**2 * US%m_to_Z / GV%Rho0 + mass_accel_to_Z = US%m_to_L*US%T_to_s**2 * US%m_to_Z / GV%Rho0 + mass_to_Z = US%m_to_Z / GV%Rho0 !--- setup the weight when computing vbt_trans and ubt_trans if (project_velocity) then @@ -986,14 +989,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_accel_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_accel_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 diff --git a/src/core/MOM_dynamics_split_RK2.F90 b/src/core/MOM_dynamics_split_RK2.F90 index 696953f649..1f43a699a1 100644 --- a/src/core/MOM_dynamics_split_RK2.F90 +++ b/src/core/MOM_dynamics_split_RK2.F90 @@ -123,8 +123,10 @@ module MOM_dynamics_split_RK2 !! anomaly in each layer due to free surface height !! 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] + real, pointer, dimension(:,:) :: taux_bot => NULL() !< frictional x-bottom stress from the ocean + !! to the seafloor [kg L Z T-2 m-3 ~> Pa] + real, pointer, dimension(:,:) :: tauy_bot => NULL() !< frictional y-bottom stress from the ocean + !! to the seafloor [kg L Z T-2 m-3 ~> Pa] type(BT_cont_type), pointer :: BT_cont => NULL() !< A structure with elements that describe the !! effective summed open face areas as a function !! of barotropic flow. diff --git a/src/core/MOM_dynamics_unsplit.F90 b/src/core/MOM_dynamics_unsplit.F90 index 6ffc526f4a..108f4c8943 100644 --- a/src/core/MOM_dynamics_unsplit.F90 +++ b/src/core/MOM_dynamics_unsplit.F90 @@ -116,8 +116,10 @@ module MOM_dynamics_unsplit PFv, & !< PFv = -dM/dy [L T-2 ~> m s-2]. diffv !< Meridional acceleration due to convergence of the along-isopycnal stress tensor [L T-2 ~> 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] + real, pointer, dimension(:,:) :: taux_bot => NULL() !< frictional x-bottom stress from the ocean + !! to the seafloor [kg L Z T-2 m-3 ~> Pa] + real, pointer, dimension(:,:) :: tauy_bot => NULL() !< frictional y-bottom stress from the ocean + !! to the seafloor [kg L Z T-2 m-3 ~> Pa] logical :: debug !< If true, write verbose checksums for debugging purposes. diff --git a/src/core/MOM_dynamics_unsplit_RK2.F90 b/src/core/MOM_dynamics_unsplit_RK2.F90 index 729dae15bb..af33db8011 100644 --- a/src/core/MOM_dynamics_unsplit_RK2.F90 +++ b/src/core/MOM_dynamics_unsplit_RK2.F90 @@ -113,8 +113,10 @@ module MOM_dynamics_unsplit_RK2 PFv, & !< PFv = -dM/dy [L T-2 ~> m s-2]. diffv !< Meridional acceleration due to convergence of the along-isopycnal stress tensor [L T-2 ~> 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) + real, pointer, dimension(:,:) :: taux_bot => NULL() !< frictional x-bottom stress from the ocean + !! to the seafloor [kg L Z T-2 m-3 ~> Pa] + real, pointer, dimension(:,:) :: tauy_bot => NULL() !< frictional y-bottom stress from the ocean + !! to the seafloor [kg L Z T-2 m-3 ~> Pa] real :: be !< A nondimensional number from 0.5 to 1 that controls !! the backward weighting of the time stepping scheme. diff --git a/src/parameterizations/vertical/MOM_vert_friction.F90 b/src/parameterizations/vertical/MOM_vert_friction.F90 index 9aadb526b7..1bed36e75e 100644 --- a/src/parameterizations/vertical/MOM_vert_friction.F90 +++ b/src/parameterizations/vertical/MOM_vert_friction.F90 @@ -162,9 +162,11 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, US, CS, & type(cont_diag_ptrs), intent(inout) :: CDp !< Continuity equation terms type(vertvisc_CS), pointer :: CS !< Vertical viscosity control structure real, dimension(SZIB_(G),SZJ_(G)), & - optional, intent(out) :: taux_bot !< Zonal bottom stress from ocean to rock [kg Z s-2 m-2 ~> Pa] + optional, intent(out) :: taux_bot !< Zonal bottom stress from ocean to + !! rock [kg L Z T-2 m-3 ~> Pa] real, dimension(SZI_(G),SZJB_(G)), & - optional, intent(out) :: tauy_bot !< Meridional bottom stress from ocean to rock [kg Z s-2 m-2 ~> Pa] + optional, intent(out) :: tauy_bot !< Meridional bottom stress from ocean to + !! rock [kg L Z T-2 m-3 ~> Pa] type(wave_parameters_CS), & optional, pointer :: Waves !< Container for wave/Stokes information @@ -325,10 +327,10 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, US, CS, & if (PRESENT(taux_bot)) then do I=Isq,Ieq - taux_bot(I,j) = US%L_T2_to_m_s2*Rho0 * (u(I,j,nz)*CS%a_u(I,j,nz+1)) + taux_bot(I,j) = Rho0 * (u(I,j,nz)*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) + US%L_T2_to_m_s2*Rho0 * (Ray(I,k)*u(I,j,k)) + taux_bot(I,j) = taux_bot(I,j) + Rho0 * (Ray(I,k)*u(I,j,k)) enddo ; enddo ; endif endif @@ -406,10 +408,10 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, US, CS, & if (present(tauy_bot)) then do i=is,ie - tauy_bot(i,J) = Rho0 * (US%L_T2_to_m_s2*v(i,J,nz)*CS%a_v(i,J,nz+1)) + tauy_bot(i,J) = Rho0 * (v(i,J,nz)*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 * (US%L_T2_to_m_s2*Ray(i,k)*v(i,J,k)) + tauy_bot(i,J) = tauy_bot(i,J) + Rho0 * (Ray(i,k)*v(i,J,k)) enddo ; enddo ; endif endif @@ -1730,10 +1732,10 @@ subroutine vertvisc_init(MIS, Time, G, GV, US, param_file, diag, ADp, dirs, & CS%id_taux_bot = register_diag_field('ocean_model', 'taux_bot', diag%axesCu1, & Time, 'Zonal Bottom Stress from Ocean to Earth', 'Pa', & - conversion=US%Z_to_m) + conversion=US%L_T2_to_m_s2*US%Z_to_m) CS%id_tauy_bot = register_diag_field('ocean_model', 'tauy_bot', diag%axesCv1, & Time, 'Meridional Bottom Stress from Ocean to Earth', 'Pa', & - conversion=US%Z_to_m) + conversion=US%L_T2_to_m_s2*US%Z_to_m) if ((len_trim(CS%u_trunc_file) > 0) .or. (len_trim(CS%v_trunc_file) > 0)) & call PointAccel_init(MIS, Time, G, param_file, diag, dirs, CS%PointAccel_CSp) From 8cfac0f9a3be31c2fdd2f9d0846dc22fb9848e42 Mon Sep 17 00:00:00 2001 From: Kate Hedstrom Date: Sat, 17 Aug 2019 14:27:36 -0800 Subject: [PATCH 224/297] 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"//& From f0ed7f8760b36b578321facdcfed5b438dec0562 Mon Sep 17 00:00:00 2001 From: matthew harrison Date: Tue, 20 Aug 2019 13:36:02 -0400 Subject: [PATCH 225/297] changes needed for reproducibility across restarts using OBCs --- src/tracer/MOM_tracer_advect.F90 | 278 +++++++++++++++++++++---------- 1 file changed, 187 insertions(+), 91 deletions(-) diff --git a/src/tracer/MOM_tracer_advect.F90 b/src/tracer/MOM_tracer_advect.F90 index 201f8aeb6f..28312f1dca 100644 --- a/src/tracer/MOM_tracer_advect.F90 +++ b/src/tracer/MOM_tracer_advect.F90 @@ -353,6 +353,8 @@ subroutine advect_x(Tr, hprev, uhr, uh_neglect, OBC, domore_u, ntr, Idt, & slope_x ! The concentration slope per grid point [conc]. real, dimension(SZIB_(G),ntr) :: & flux_x ! The tracer flux across a boundary [H m2 conc ~> m3 conc or kg conc]. + real, dimension(SZI_(G),ntr) :: & + T_tmp ! The copy of the tracer concentration at constant i,k [H m2 conc ~> m3 conc or kg conc]. real :: maxslope ! The maximum concentration slope per grid point ! consistent with monotonicity [conc]. real :: hup, hlos ! hup is the upwind volume, hlos is the @@ -420,6 +422,72 @@ subroutine advect_x(Tr, hprev, uhr, uh_neglect, OBC, domore_u, ntr, Idt, & enddo ; enddo endif ! usePLMslope + ! make a copy of the tracers in case values need to be overridden for OBCs + do m = 1,ntr + do i=is-stencil,ie+stencil + T_tmp(i,m) = Tr(m)%t(i,j,k) + enddo + enddo + ! loop through open boundaries and recalculate flux terms + if (associated(OBC)) then ; if (OBC%OBC_pe) then + do n=1,OBC%number_of_segments + segment=>OBC%segment(n) + if (.not. associated(segment%tr_Reg)) cycle + if (segment%is_E_or_W) then + if (j>=segment%HI%jsd .and. j<=segment%HI%jed) then + I = segment%HI%IsdB + + ishift=0 ! ishift+I corresponds to the nearest interior tracer cell index + idir=1 ! idir switches the sign of the flow so that positive is into the reservoir + if (segment%direction == OBC_DIRECTION_W) then + ishift=1 + idir=-1 + endif + ! update the reservoir tracer concentration implicitly + ! using Backward-Euler timestep + do m=1,ntr + if (associated(segment%tr_Reg%Tr(m)%tres)) then + uhh(I)=uhr(I,j,k) + u_L_in=max(idir*uhh(I)*segment%Tr_InvLscale3_in,0.) + u_L_out=min(idir*uhh(I)*segment%Tr_InvLscale3_out,0.) + fac1=1.0+dt*(u_L_in-u_L_out) + segment%tr_Reg%Tr(m)%tres(I,j,k)= (1.0/fac1)*(segment%tr_Reg%Tr(m)%tres(I,j,k) + & + dt*(u_L_in*Tr(m)%t(I+ishift,j,k) - & + u_L_out*segment%tr_Reg%Tr(m)%t(I,j,k))) + endif + enddo + + do m = 1,ntr ! replace tracers with OBC values + if (associated(segment%tr_Reg%Tr(m)%tres)) then + if (segment%direction == OBC_DIRECTION_W) then + T_tmp(i,m) = segment%tr_Reg%Tr(m)%tres(i,j,k) + else + T_tmp(I+1,m) = segment%tr_Reg%Tr(m)%tres(i,j,k) + endif + else + if (segment%direction == OBC_DIRECTION_W) then + T_tmp(i,m) = segment%tr_Reg%Tr(m)%OBC_inflow_conc + else + T_tmp(I+1,m) = segment%tr_Reg%Tr(m)%OBC_inflow_conc + endif + endif + enddo + do m = 1,ntr ! Apply update tracer values for slope calculation + do i=segment%HI%IsdB-1,segment%HI%IsdB+1 + Tp = T_tmp(i+1,m) ; Tc = T_tmp(i,m) ; Tm = T_tmp(i-1,m) + dMx = max( Tp, Tc, Tm ) - Tc + dMn= Tc - min( Tp, Tc, Tm ) + slope_x(i,m) = G%mask2dCu(I,j)*G%mask2dCu(I-1,j) * & + sign( min(0.5*abs(Tp-Tm), 2.0*dMx, 2.0*dMn), Tp-Tm ) + enddo + enddo + + endif + endif + enddo + endif; endif + + ! Calculate the i-direction fluxes of each tracer, using as much ! the minimum of the remaining mass flux (uhr) and the half the mass ! in the cell plus whatever part of its half of the mass flux that @@ -466,7 +534,7 @@ subroutine advect_x(Tr, hprev, uhr, uh_neglect, OBC, domore_u, ntr, Idt, & endif ! Implementation of PPM-H3 - Tp = Tr(m)%t(i_up+1,j,k) ; Tc = Tr(m)%t(i_up,j,k) ; Tm = Tr(m)%t(i_up-1,j,k) + Tp = T_tmp(i_up+1,m) ; Tc = T_tmp(i_up,m) ; Tm = T_tmp(i_up-1,m) if (useHuynh) then aL = ( 5.*Tc + ( 2.*Tm - Tp ) )/6. ! H3 estimate @@ -508,7 +576,7 @@ subroutine advect_x(Tr, hprev, uhr, uh_neglect, OBC, domore_u, ntr, Idt, & !aR = Tr(m)%t(i,j,k) + 0.5 * slope_x(i,m) !flux_x(I,m) = uhh(I)*( aR - 0.5 * slope_x(i,m) * CFL(I) ) ! Alternative implementation of PLM - Tc = Tr(m)%t(i,j,k) + Tc = T_tmp(i,m) flux_x(I,m) = uhh(I)*( Tc + 0.5 * slope_x(i,m) * ( 1. - CFL(I) ) ) ! Original implementation of PLM !flux_x(I,m) = uhh(I)*(Tr(m)%t(i,j,k) + slope_x(i,m)*ts2(I)) @@ -521,7 +589,7 @@ subroutine advect_x(Tr, hprev, uhr, uh_neglect, OBC, domore_u, ntr, Idt, & !aL = Tr(m)%t(i+1,j,k) - 0.5 * slope_x(i+1,m) !flux_x(I,m) = uhh(I)*( aL + 0.5 * slope_x(i+1,m) * CFL(I) ) ! Alternative implementation of PLM - Tc = Tr(m)%t(i+1,j,k) + Tc = T_tmp(i+1,m) flux_x(I,m) = uhh(I)*( Tc - 0.5 * slope_x(i+1,m) * ( 1. - CFL(I) ) ) ! Original implementation of PLM !flux_x(I,m) = uhh(I)*(Tr(m)%t(i+1,j,k) - slope_x(i+1,m)*ts2(I)) @@ -531,10 +599,9 @@ subroutine advect_x(Tr, hprev, uhr, uh_neglect, OBC, domore_u, ntr, Idt, & endif ! usePPM if (associated(OBC)) then ; if (OBC%OBC_pe) then - if (OBC%specified_u_BCs_exist_globally) then + if (OBC%specified_u_BCs_exist_globally .or. OBC%open_u_BCs_exist_globally) then do n=1,OBC%number_of_segments segment=>OBC%segment(n) - if (.not. segment%specified) cycle if (.not. associated(segment%tr_Reg)) cycle if (segment%is_E_or_W) then if (j>=segment%HI%jsd .and. j<=segment%HI%jed) then @@ -554,48 +621,8 @@ subroutine advect_x(Tr, hprev, uhr, uh_neglect, OBC, domore_u, ntr, Idt, & endif endif enddo - endif + endif - if (OBC%open_u_BCs_exist_globally) then - do n=1,OBC%number_of_segments - segment=>OBC%segment(n) - I = segment%HI%IsdB - if (segment%is_E_or_W .and. (j >= segment%HI%jsd .and. j<= segment%HI%jed)) then - if (segment%specified) cycle - if (.not. associated(segment%tr_Reg)) cycle - ishift=0 ! ishift+I corresponds to the nearest interior tracer cell index - idir=1 ! idir switches the sign of the flow so that positive is into the reservoir - if (segment%direction == OBC_DIRECTION_W) then - ishift=1 - idir=-1 - endif - ! update the reservoir tracer concentration implicitly - ! using Backward-Euler timestep - do m=1,ntr - if (associated(segment%tr_Reg%Tr(m)%tres)) then - uhh(I)=uhr(I,j,k) - u_L_in=max(idir*uhh(I)*segment%Tr_InvLscale3_in,0.) - u_L_out=min(idir*uhh(I)*segment%Tr_InvLscale3_out,0.) - fac1=1.0+dt*(u_L_in-u_L_out) - segment%tr_Reg%Tr(m)%tres(I,j,k)= (1.0/fac1)*(segment%tr_Reg%Tr(m)%tres(I,j,k) + & - dt*(u_L_in*Tr(m)%t(I+ishift,j,k) - & - u_L_out*segment%tr_Reg%Tr(m)%t(I,j,k))) - endif - enddo - - ! Tracer fluxes are set to prescribed values only for inflows from masked areas. - if ((uhr(I,j,k) > 0.0) .and. (G%mask2dT(i,j) < 0.5) .or. & - (uhr(I,j,k) < 0.0) .and. (G%mask2dT(i+1,j) < 0.5)) then - uhh(I) = uhr(I,j,k) - do m=1,ntr - if (associated(segment%tr_Reg%Tr(m)%tres)) then - flux_x(I,m) = uhh(I)*segment%tr_Reg%Tr(m)%tres(I,j,k) - else; flux_x(I,m) = uhh(I)*segment%tr_Reg%Tr(m)%OBC_inflow_conc; endif - enddo - endif - endif - enddo - endif endif ; endif ! Calculate new tracer concentration in each cell after accounting @@ -680,7 +707,10 @@ subroutine advect_y(Tr, hprev, vhr, vh_neglect, OBC, domore_v, ntr, Idt, & real, dimension(SZI_(G),ntr,SZJ_(G)) :: & slope_y ! The concentration slope per grid point [conc]. real, dimension(SZI_(G),ntr,SZJB_(G)) :: & - flux_y ! The tracer flux across a boundary [H m2 conc ~> m3 conc or kg conc]. + flux_y ! The tracer flux across a boundary [H m2 conc ~> m3 conc or kg conc]. + real, dimension(SZI_(G),ntr,SZJB_(G)) :: & + T_tmp ! The copy of the tracer concentration at constant i,k [H m2 conc ~> m3 conc or kg conc]. + real :: maxslope ! The maximum concentration slope per grid point ! consistent with monotonicity [conc]. real :: vhh(SZI_(G),SZJB_(G)) ! The meridional flux that occurs during the @@ -757,6 +787,72 @@ subroutine advect_y(Tr, hprev, vhr, vh_neglect, OBC, domore_v, ntr, Idt, & enddo ; enddo ; endif ; enddo ! End of i-, m-, & j- loops. endif ! usePLMslope + + ! make a copy of the tracers in case values need to be overridden for OBCs + + do j=js-stencil,je+stencil ; if (do_j_tr(j)) then ; do m=1,ntr ; do i=is,ie + T_tmp(i,m,j) = Tr(m)%t(i,j,k) + enddo ; enddo ; endif ; enddo + + ! loop through open boundaries and recalculate flux terms + if (associated(OBC)) then ; if (OBC%OBC_pe) then + do n=1,OBC%number_of_segments + segment=>OBC%segment(n) + if (.not. associated(segment%tr_Reg)) cycle + do i=is,ie + if (segment%is_N_or_S) then + if (i>=segment%HI%isd .and. i<=segment%HI%ied) then + J = segment%HI%JsdB + jshift=0 ! jshift+J corresponds to the nearest interior tracer cell index + jdir=1 ! jdir switches the sign of the flow so that positive is into the reservoir + if (segment%direction == OBC_DIRECTION_S) then + jshift=1 + jdir=-1 + endif + ! update the reservoir tracer concentration implicitly + ! using Backward-Euler timestep + do m=1,ntr + if (associated(segment%tr_Reg%Tr(m)%tres)) then + vhh(i,J)=vhr(i,J,k) + v_L_in=max(jdir*vhh(i,J)*segment%Tr_InvLscale3_in,0.) + v_L_out=min(jdir*vhh(i,J)*segment%Tr_InvLscale3_out,0.) + fac1=1.0+dt*(v_L_in-v_L_out) + segment%tr_Reg%Tr(m)%tres(i,J,k)= (1.0/fac1)*(segment%tr_Reg%Tr(m)%tres(i,J,k) + & + dt*(v_L_in*Tr(m)%t(i,J+jshift,k) - & + v_L_out*segment%tr_Reg%Tr(m)%t(i,J,k))) + endif + enddo + + do m = 1,ntr ! replace tracers with OBC values + if (associated(segment%tr_Reg%Tr(m)%tres)) then + if (segment%direction == OBC_DIRECTION_S) then + T_tmp(i,j,m) = segment%tr_Reg%Tr(m)%tres(i,j,k) + else + T_tmp(i,j+1,m) = segment%tr_Reg%Tr(m)%tres(i,j,k) + endif + else + if (segment%direction == OBC_DIRECTION_S) then + T_tmp(i,j,m) = segment%tr_Reg%Tr(m)%OBC_inflow_conc + else + T_tmp(i,j+1,m) = segment%tr_Reg%Tr(m)%OBC_inflow_conc + endif + endif + enddo + do m = 1,ntr ! Apply update tracer values for slope calculation + do j=segment%HI%JsdB-1,segment%HI%JsdB+1 + Tp = T_tmp(i,j+1,m) ; Tc = T_tmp(i,j,m) ; Tm = T_tmp(i,j-1,m) + dMx = max( Tp, Tc, Tm ) - Tc + dMn= Tc - min( Tp, Tc, Tm ) + slope_y(i,m,j) = G%mask2dCv(i,J)*G%mask2dCv(i,J-1) * & + sign( min(0.5*abs(Tp-Tm), 2.0*dMx, 2.0*dMn), Tp-Tm ) + enddo + enddo + endif + endif ! is_N_S + enddo ! i-loop + enddo ! segment loop + endif; endif + ! Calculate the j-direction fluxes of each tracer, using as much ! the minimum of the remaining mass flux (vhr) and the half the mass ! in the cell plus whatever part of its half of the mass flux that @@ -869,7 +965,7 @@ subroutine advect_y(Tr, hprev, vhr, vh_neglect, OBC, domore_v, ntr, Idt, & endif ! usePPM if (associated(OBC)) then ; if (OBC%OBC_pe) then - if (OBC%specified_v_BCs_exist_globally) then + if (OBC%specified_v_BCs_exist_globally .or. OBC%open_v_BCs_exist_globally) then do n=1,OBC%number_of_segments segment=>OBC%segment(n) if (.not. segment%specified) cycle @@ -893,51 +989,51 @@ subroutine advect_y(Tr, hprev, vhr, vh_neglect, OBC, domore_v, ntr, Idt, & endif enddo endif - - - if (OBC%open_v_BCs_exist_globally) then - do n=1,OBC%number_of_segments - segment=>OBC%segment(n) - if (segment%specified) cycle - if (.not. associated(segment%tr_Reg)) cycle - if (segment%is_N_or_S .and. & - (J >= segment%HI%JsdB .and. J<= segment%HI%JedB)) then - jshift=0 - jdir=1 - if (segment%direction == OBC_DIRECTION_S) then - jshift=1 - jdir=-1 - endif - do i=segment%HI%isd,segment%HI%ied - ! update the reservoir tracer concentration implicitly - ! using Backward-Euler timestep - do m=1,ntr - if (associated(segment%tr_Reg%Tr(m)%tres)) then - vhh(i,J)=vhr(i,J,k) - v_L_in=max(jdir*vhh(i,J)*segment%Tr_InvLscale3_in,0.) - v_L_out=min(jdir*vhh(i,J)*segment%Tr_InvLscale3_out,0.) - fac1=1.0+dt*(v_L_in-v_L_out) - segment%tr_Reg%Tr(m)%tres(i,J,k)= (1.0/fac1)*(segment%tr_Reg%Tr(m)%tres(i,J,k) + & - dt*v_L_in*Tr(m)%t(i,j+jshift,k) - & - dt*v_L_out*segment%tr_Reg%Tr(m)%t(i,j,k)) - endif - enddo - ! Tracer fluxes are set to prescribed values only for inflows from masked areas. - if ((vhr(i,J,k) > 0.0) .and. (G%mask2dT(i,j) < 0.5) .or. & - (vhr(i,J,k) < 0.0) .and. (G%mask2dT(i,j+1) < 0.5)) then - vhh(i,J) = vhr(i,J,k) - do m=1,ntr - if (associated(segment%tr_Reg%Tr(m)%t)) then - flux_y(i,m,J) = vhh(i,J)*segment%tr_Reg%Tr(m)%tres(i,J,k) - else ; flux_y(i,m,J) = vhh(i,J)*segment%tr_Reg%Tr(m)%OBC_inflow_conc ; endif - enddo - endif - enddo - endif - enddo - endif endif; endif + ! if (OBC%open_v_BCs_exist_globally) then + ! do n=1,OBC%number_of_segments + ! segment=>OBC%segment(n) + ! if (segment%specified) cycle + ! if (.not. associated(segment%tr_Reg)) cycle + ! if (segment%is_N_or_S .and. & + ! (J >= segment%HI%JsdB .and. J<= segment%HI%JedB)) then + ! jshift=0 + ! jdir=1 + ! if (segment%direction == OBC_DIRECTION_S) then + ! jshift=1 + ! jdir=-1 + ! endif + ! do i=segment%HI%isd,segment%HI%ied + ! ! update the reservoir tracer concentration implicitly + ! ! using Backward-Euler timestep + ! do m=1,ntr + ! if (associated(segment%tr_Reg%Tr(m)%tres)) then + ! vhh(i,J)=vhr(i,J,k) + ! v_L_in=max(jdir*vhh(i,J)*segment%Tr_InvLscale3_in,0.) + ! v_L_out=min(jdir*vhh(i,J)*segment%Tr_InvLscale3_out,0.) + ! fac1=1.0+dt*(v_L_in-v_L_out) + ! segment%tr_Reg%Tr(m)%tres(i,J,k)= (1.0/fac1)*(segment%tr_Reg%Tr(m)%tres(i,J,k) + & + ! dt*v_L_in*Tr(m)%t(i,j+jshift,k) - & + ! dt*v_L_out*segment%tr_Reg%Tr(m)%t(i,j,k)) + ! endif + ! enddo + ! ! Tracer fluxes are set to prescribed values only for inflows from masked areas. + ! if ((vhr(i,J,k) > 0.0) .and. (G%mask2dT(i,j) < 0.5) .or. & + ! (vhr(i,J,k) < 0.0) .and. (G%mask2dT(i,j+1) < 0.5)) then + ! vhh(i,J) = vhr(i,J,k) + ! do m=1,ntr + ! if (associated(segment%tr_Reg%Tr(m)%t)) then + ! flux_y(i,m,J) = vhh(i,J)*segment%tr_Reg%Tr(m)%tres(i,J,k) + ! else ; flux_y(i,m,J) = vhh(i,J)*segment%tr_Reg%Tr(m)%OBC_inflow_conc ; endif + ! enddo + ! endif + ! enddo + ! endif + ! enddo + ! endif + !endif; endif + else ! not domore_v. do i=is,ie ; vhh(i,J) = 0.0 ; enddo do m=1,ntr ; do i=is,ie ; flux_y(i,m,J) = 0.0 ; enddo ; enddo From b5b081e0e9d6c7a977a542e2863c109d0a8e3967 Mon Sep 17 00:00:00 2001 From: matthew harrison Date: Tue, 20 Aug 2019 14:37:48 -0400 Subject: [PATCH 226/297] remove commented code --- src/tracer/MOM_tracer_advect.F90 | 43 -------------------------------- 1 file changed, 43 deletions(-) diff --git a/src/tracer/MOM_tracer_advect.F90 b/src/tracer/MOM_tracer_advect.F90 index 28312f1dca..f17b8672e0 100644 --- a/src/tracer/MOM_tracer_advect.F90 +++ b/src/tracer/MOM_tracer_advect.F90 @@ -991,49 +991,6 @@ subroutine advect_y(Tr, hprev, vhr, vh_neglect, OBC, domore_v, ntr, Idt, & endif endif; endif - ! if (OBC%open_v_BCs_exist_globally) then - ! do n=1,OBC%number_of_segments - ! segment=>OBC%segment(n) - ! if (segment%specified) cycle - ! if (.not. associated(segment%tr_Reg)) cycle - ! if (segment%is_N_or_S .and. & - ! (J >= segment%HI%JsdB .and. J<= segment%HI%JedB)) then - ! jshift=0 - ! jdir=1 - ! if (segment%direction == OBC_DIRECTION_S) then - ! jshift=1 - ! jdir=-1 - ! endif - ! do i=segment%HI%isd,segment%HI%ied - ! ! update the reservoir tracer concentration implicitly - ! ! using Backward-Euler timestep - ! do m=1,ntr - ! if (associated(segment%tr_Reg%Tr(m)%tres)) then - ! vhh(i,J)=vhr(i,J,k) - ! v_L_in=max(jdir*vhh(i,J)*segment%Tr_InvLscale3_in,0.) - ! v_L_out=min(jdir*vhh(i,J)*segment%Tr_InvLscale3_out,0.) - ! fac1=1.0+dt*(v_L_in-v_L_out) - ! segment%tr_Reg%Tr(m)%tres(i,J,k)= (1.0/fac1)*(segment%tr_Reg%Tr(m)%tres(i,J,k) + & - ! dt*v_L_in*Tr(m)%t(i,j+jshift,k) - & - ! dt*v_L_out*segment%tr_Reg%Tr(m)%t(i,j,k)) - ! endif - ! enddo - ! ! Tracer fluxes are set to prescribed values only for inflows from masked areas. - ! if ((vhr(i,J,k) > 0.0) .and. (G%mask2dT(i,j) < 0.5) .or. & - ! (vhr(i,J,k) < 0.0) .and. (G%mask2dT(i,j+1) < 0.5)) then - ! vhh(i,J) = vhr(i,J,k) - ! do m=1,ntr - ! if (associated(segment%tr_Reg%Tr(m)%t)) then - ! flux_y(i,m,J) = vhh(i,J)*segment%tr_Reg%Tr(m)%tres(i,J,k) - ! else ; flux_y(i,m,J) = vhh(i,J)*segment%tr_Reg%Tr(m)%OBC_inflow_conc ; endif - ! enddo - ! endif - ! enddo - ! endif - ! enddo - ! endif - !endif; endif - else ! not domore_v. do i=is,ie ; vhh(i,J) = 0.0 ; enddo do m=1,ntr ; do i=is,ie ; flux_y(i,m,J) = 0.0 ; enddo ; enddo From a38b298e482258e70676383051c45e010f91bb68 Mon Sep 17 00:00:00 2001 From: Graeme MacGilchrist Date: Tue, 20 Aug 2019 15:37:21 -0400 Subject: [PATCH 227/297] added diagnostic for internal heat in 3D --- .../vertical/MOM_geothermal.F90 | 26 +++++++++++++++++++ 1 file changed, 26 insertions(+) diff --git a/src/parameterizations/vertical/MOM_geothermal.F90 b/src/parameterizations/vertical/MOM_geothermal.F90 index 15f1116190..8fb96e2c97 100644 --- a/src/parameterizations/vertical/MOM_geothermal.F90 +++ b/src/parameterizations/vertical/MOM_geothermal.F90 @@ -35,6 +35,8 @@ module MOM_geothermal 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. + integer :: id_internal_heat_tend_3d = -1 ! ID for 3D diagnostic of internal heat + end type geothermal_CS contains @@ -100,6 +102,11 @@ subroutine geothermal(h, tv, dt, ea, eb, G, GV, CS, halo) real :: Irho_cp ! inverse of heat capacity per unit layer volume ! [degC H m2 J-1 ~> degC m3 J-1 or degC kg J-1] + real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: temp_old ! Temperature of each layer before any heat is added, for diagnostics [degC] + real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: h_old ! Thickness of each layer before any heat is added, for diagnostics [m or kg m-2] + real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: work_3d ! Scratch variable used to calculate change in heat due to geothermal + real :: Idt ! inverse of the timestep [s-1] + logical :: do_i(SZI_(G)) integer :: i, j, k, is, ie, js, je, nz, k2, i2 integer :: isj, iej, num_start, num_left, nkmb, k_tgt @@ -119,6 +126,7 @@ subroutine geothermal(h, tv, dt, ea, eb, G, GV, CS, halo) Angstrom = GV%Angstrom_H H_neglect = GV%H_subroundoff p_ref(:) = tv%P_Ref + Idt = 1/dt if (.not.associated(tv%T)) call MOM_error(FATAL, "MOM geothermal: "//& "Geothermal heating can only be applied if T & S are state variables.") @@ -136,6 +144,10 @@ subroutine geothermal(h, tv, dt, ea, eb, G, GV, CS, halo) !$OMP wt_in_place,dTemp,dRcv,h_transfer,heating, & !$OMP I_h) +! Save temperature and thickness before any changes are made (for diagnostic) +temp_old = tv%T +h_old = h + do j=js,je ! 1. Only work on columns that are being heated. ! 2. Find the deepest layer with any mass. @@ -304,6 +316,14 @@ subroutine geothermal(h, tv, dt, ea, eb, G, GV, CS, halo) enddo ; endif enddo ! j-loop +! Calculate heat tendency due to addition and transfer of internal heat +if (CS%id_internal_heat_tend_3d > 0) then + do k=1,nz ; do j=js,je ; do i=is,ie + work_3d(i,j,k) = GV%H_to_kg_m2 * tv%C_p * Idt * (h(i,j,k) * tv%T(i,j,k) - h_old(i,j,k) * temp_old(i,j,k)) + enddo ; enddo ; enddo + call post_data(CS%id_internal_heat_tend_3d, work_3d, CS%diag, alt_h = h_old) +endif + ! do i=is,ie ; do j=js,je ! resid(i,j) = tv%internal_heat(i,j) - resid(i,j) - GV%H_to_kg_m2 * & ! (G%mask2dT(i,j) * (CS%geo_heat(i,j) * (dt*Irho_cp))) @@ -392,6 +412,12 @@ subroutine geothermal_init(Time, G, param_file, diag, CS) x_cell_method='mean', y_cell_method='mean', area_cell_method='mean') if (id > 0) call post_data(id, CS%geo_heat, diag, .true.) + ! Diagnostic for tendency due to internal heat (in 3d) + CS%id_internal_heat_tend_3d = register_diag_field('ocean_model',& + 'internal_heat_tend_3d', diag%axesTL, Time, & + 'Internal heat tendency in 3D, reveals layer(s) that heat is added to','W m-2',& + v_extensive = .true.) + end subroutine geothermal_init !> Clean up and deallocate memory associated with the geothermal heating module. From ee2e09059bd9e1040540e8a7beaab0ef6cb4f3a9 Mon Sep 17 00:00:00 2001 From: Graeme MacGilchrist Date: Tue, 20 Aug 2019 16:49:55 -0400 Subject: [PATCH 228/297] further modifications to internal heat diagnostic --- .../vertical/MOM_geothermal.F90 | 44 +++++++++++-------- 1 file changed, 25 insertions(+), 19 deletions(-) diff --git a/src/parameterizations/vertical/MOM_geothermal.F90 b/src/parameterizations/vertical/MOM_geothermal.F90 index 8fb96e2c97..4121795766 100644 --- a/src/parameterizations/vertical/MOM_geothermal.F90 +++ b/src/parameterizations/vertical/MOM_geothermal.F90 @@ -35,7 +35,7 @@ module MOM_geothermal 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. - integer :: id_internal_heat_tend_3d = -1 ! ID for 3D diagnostic of internal heat + integer :: id_internal_heat_tend_3d = -1 !< ID for 3D diagnostic of internal heat end type geothermal_CS @@ -102,9 +102,15 @@ subroutine geothermal(h, tv, dt, ea, eb, G, GV, CS, halo) real :: Irho_cp ! inverse of heat capacity per unit layer volume ! [degC H m2 J-1 ~> degC m3 J-1 or degC kg J-1] - real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: temp_old ! Temperature of each layer before any heat is added, for diagnostics [degC] - real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: h_old ! Thickness of each layer before any heat is added, for diagnostics [m or kg m-2] - real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: work_3d ! Scratch variable used to calculate change in heat due to geothermal + real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: temp_old ! Temperature of each layer + ! before any heat is added, + ! for diagnostics [degC] + real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: h_old ! Thickness of each layer + ! before any heat is added, + ! for diagnostics [m or kg m-2] + real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: work_3d ! Scratch variable used to + ! calculate change in heat + ! due to geothermal real :: Idt ! inverse of the timestep [s-1] logical :: do_i(SZI_(G)) @@ -126,7 +132,7 @@ subroutine geothermal(h, tv, dt, ea, eb, G, GV, CS, halo) Angstrom = GV%Angstrom_H H_neglect = GV%H_subroundoff p_ref(:) = tv%P_Ref - Idt = 1/dt + Idt = 1.0 / dt if (.not.associated(tv%T)) call MOM_error(FATAL, "MOM geothermal: "//& "Geothermal heating can only be applied if T & S are state variables.") @@ -144,9 +150,9 @@ subroutine geothermal(h, tv, dt, ea, eb, G, GV, CS, halo) !$OMP wt_in_place,dTemp,dRcv,h_transfer,heating, & !$OMP I_h) -! Save temperature and thickness before any changes are made (for diagnostic) -temp_old = tv%T -h_old = h + ! Save temperature and thickness before any changes are made (for diagnostic) + temp_old = tv%T + h_old = h do j=js,je ! 1. Only work on columns that are being heated. @@ -316,13 +322,13 @@ subroutine geothermal(h, tv, dt, ea, eb, G, GV, CS, halo) enddo ; endif enddo ! j-loop -! Calculate heat tendency due to addition and transfer of internal heat -if (CS%id_internal_heat_tend_3d > 0) then - do k=1,nz ; do j=js,je ; do i=is,ie - work_3d(i,j,k) = GV%H_to_kg_m2 * tv%C_p * Idt * (h(i,j,k) * tv%T(i,j,k) - h_old(i,j,k) * temp_old(i,j,k)) - enddo ; enddo ; enddo - call post_data(CS%id_internal_heat_tend_3d, work_3d, CS%diag, alt_h = h_old) -endif + ! Calculate heat tendency due to addition and transfer of internal heat + if (CS%id_internal_heat_tend_3d > 0) then + do k=1,nz ; do j=js,je ; do i=is,ie + work_3d(i,j,k) = GV%H_to_kg_m2 * tv%C_p * Idt * (h(i,j,k) * tv%T(i,j,k) - h_old(i,j,k) * temp_old(i,j,k)) + enddo ; enddo ; enddo + call post_data(CS%id_internal_heat_tend_3d, work_3d, CS%diag, alt_h = h_old) + endif ! do i=is,ie ; do j=js,je ! resid(i,j) = tv%internal_heat(i,j) - resid(i,j) - GV%H_to_kg_m2 * & @@ -413,10 +419,10 @@ subroutine geothermal_init(Time, G, param_file, diag, CS) if (id > 0) call post_data(id, CS%geo_heat, diag, .true.) ! Diagnostic for tendency due to internal heat (in 3d) - CS%id_internal_heat_tend_3d = register_diag_field('ocean_model',& - 'internal_heat_tend_3d', diag%axesTL, Time, & - 'Internal heat tendency in 3D, reveals layer(s) that heat is added to','W m-2',& - v_extensive = .true.) + CS%id_internal_heat_tend_3d=register_diag_field('ocean_model', & + 'internal_heat_tend_3d', diag%axesTL, Time, & + 'Internal heat tendency in 3D, reveals layer(s) that heat is added to', & + 'W m-2', v_extensive = .true.) end subroutine geothermal_init From 6860cecf0b24e26a8d94899473c5824bedf4a600 Mon Sep 17 00:00:00 2001 From: matthew harrison Date: Wed, 21 Aug 2019 10:15:30 -0400 Subject: [PATCH 229/297] fix indexing error in advect_y --- src/tracer/MOM_tracer_advect.F90 | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/src/tracer/MOM_tracer_advect.F90 b/src/tracer/MOM_tracer_advect.F90 index f17b8672e0..906c6d8be2 100644 --- a/src/tracer/MOM_tracer_advect.F90 +++ b/src/tracer/MOM_tracer_advect.F90 @@ -826,21 +826,21 @@ subroutine advect_y(Tr, hprev, vhr, vh_neglect, OBC, domore_v, ntr, Idt, & do m = 1,ntr ! replace tracers with OBC values if (associated(segment%tr_Reg%Tr(m)%tres)) then if (segment%direction == OBC_DIRECTION_S) then - T_tmp(i,j,m) = segment%tr_Reg%Tr(m)%tres(i,j,k) + T_tmp(i,m,j) = segment%tr_Reg%Tr(m)%tres(i,j,k) else - T_tmp(i,j+1,m) = segment%tr_Reg%Tr(m)%tres(i,j,k) + T_tmp(i,m,j+1) = segment%tr_Reg%Tr(m)%tres(i,j,k) endif else if (segment%direction == OBC_DIRECTION_S) then - T_tmp(i,j,m) = segment%tr_Reg%Tr(m)%OBC_inflow_conc + T_tmp(i,m,j) = segment%tr_Reg%Tr(m)%OBC_inflow_conc else - T_tmp(i,j+1,m) = segment%tr_Reg%Tr(m)%OBC_inflow_conc + T_tmp(i,m,j+1) = segment%tr_Reg%Tr(m)%OBC_inflow_conc endif endif enddo do m = 1,ntr ! Apply update tracer values for slope calculation do j=segment%HI%JsdB-1,segment%HI%JsdB+1 - Tp = T_tmp(i,j+1,m) ; Tc = T_tmp(i,j,m) ; Tm = T_tmp(i,j-1,m) + Tp = T_tmp(i,m,j+1) ; Tc = T_tmp(i,m,j) ; Tm = T_tmp(i,m,j-1) dMx = max( Tp, Tc, Tm ) - Tc dMn= Tc - min( Tp, Tc, Tm ) slope_y(i,m,j) = G%mask2dCv(i,J)*G%mask2dCv(i,J-1) * & From ae4efae1d4721097c88388c1ebf5e1e07e94d063 Mon Sep 17 00:00:00 2001 From: Marshall Ward Date: Wed, 21 Aug 2019 10:51:09 -0400 Subject: [PATCH 230/297] Travis test suite expansion This patch extends the current test suite to report code coverage and includes the following tests: * Regression testing (for a GitHub PR) * Symmetric/nonsymmetric grids * Layouts for 1 and 2 domains * Restart resubmission * DEBUG/REPRO builds * NaN initialization of allocated arrays * Dimensional scaling (2^11) The test uses four build configurations: * Symmetric grids * Asymmetric grids * REPRO build * A "target" build for PR merges, as a regression test A test will pass if the "ocean.stats" file is unchanged when compared to the symmetric DEBUG build. Comparisons of the diagnostic checksums ("chksum_diag") are included but the results are only reported and are not treated as a fail-condition. Four experiments are currently supported, currently based on the MOM6-examples repo: * tc0: unit_tests * tc1: A low-resolution configuration of benchmark * tc2: An ALE-based config of benchmark * tc3: A shortened simulation of circle_obcs Coverage reports are generated using "gcov" and are reported to "codecov.io". The build Makefile (.testing/Makefile) is usable at command line and does not require a Travis VM session, although there are some potentially volatile dependencies on git which should probably be explored before distributing it for general use. It is expected that the tests will be expanded (e.g. repeat using MOM_parameter_doc output) as well as the number of experiments. Other notes: - Includes an independent build of FMS - Real-number inequality warnings are disabled --- .gitignore | 16 + .testing/Makefile | 319 ++++++++++++--- .testing/linux-ubuntu-xenial-gnu.mk | 8 +- .testing/tc0/MOM_input | 229 +++++++++++ .testing/tc0/MOM_override | 0 .testing/tc0/diag_table | 2 + .testing/tc0/input.nml | 20 + .testing/tc1/MOM_input | 576 ++++++++++++++++++++++++++ .testing/tc1/MOM_override | 0 .testing/tc1/diag_table | 86 ++++ .testing/tc1/input.nml | 19 + .testing/tc2/MOM_input | 614 ++++++++++++++++++++++++++++ .testing/tc2/MOM_override | 0 .testing/tc2/diag_table | 86 ++++ .testing/tc2/input.nml | 19 + .testing/tc3/MOM_input | 471 +++++++++++++++++++++ .testing/tc3/MOM_override | 0 .testing/tc3/diag_table | 207 ++++++++++ .testing/tc3/input.nml | 17 + .travis.yml | 107 ++--- 20 files changed, 2656 insertions(+), 140 deletions(-) create mode 100644 .testing/tc0/MOM_input create mode 100644 .testing/tc0/MOM_override create mode 100644 .testing/tc0/diag_table create mode 100644 .testing/tc0/input.nml create mode 100644 .testing/tc1/MOM_input create mode 100644 .testing/tc1/MOM_override create mode 100644 .testing/tc1/diag_table create mode 100644 .testing/tc1/input.nml create mode 100644 .testing/tc2/MOM_input create mode 100644 .testing/tc2/MOM_override create mode 100644 .testing/tc2/diag_table create mode 100644 .testing/tc2/input.nml create mode 100644 .testing/tc3/MOM_input create mode 100644 .testing/tc3/MOM_override create mode 100644 .testing/tc3/diag_table create mode 100644 .testing/tc3/input.nml diff --git a/.gitignore b/.gitignore index 01b8f29b54..c0bfc8b428 100644 --- a/.gitignore +++ b/.gitignore @@ -3,3 +3,19 @@ *~ html *.log +MOM6 +build/ +deps/ +.testing/*/available_diags.* +.testing/*/CPU_stats +.testing/*/chksum_diag +.testing/*/exitcode +.testing/*/logfile.*.out +.testing/*/MOM_parameter_doc.* +.testing/*/ocean_geometry.nc +.testing/*/ocean.stats +.testing/*/ocean.stats.nc +.testing/*/RESTART/ +.testing/*/time_stamp.out +.testing/*/Vertical_coordinate.nc +.testing/*/GOLD_IC.nc diff --git a/.testing/Makefile b/.testing/Makefile index 6bafa2191e..009be95731 100644 --- a/.testing/Makefile +++ b/.testing/Makefile @@ -1,77 +1,290 @@ -# Makefile steps to run on Travis-CI -# e.g. make MEMORY_SHAPE=dynamic_symmetric REPRO=1 OPENMP=1 +SHELL = bash +MPIRUN ?= mpirun -# Versions to use -FMS_COMMIT ?= f2e2c86f6c0eb6d389a20509a8a60fa22924e16b +#--- +# Dependencies +DEPS = deps + +# mkmf, list_paths (GFDL build toolchain) +MKMF_URL ?= https://github.com/NOAA-GFDL/mkmf.git MKMF_COMMIT ?= master +LIST_PATHS := $(abspath $(DEPS)/mkmf/bin/list_paths) +MKMF := $(abspath $(DEPS)/mkmf/bin/mkmf) -# Where to clone from +# FMS framework FMS_URL ?= https://github.com/NOAA-GFDL/FMS.git -MKMF_URL ?= https://github.com/NOAA-GFDL/mkmf.git -CONFIGS_URL ?= https://github.com/NOAA-GFDL/MOM6-examples.git -REGRESSIONS_URL ?= https://github.com/adcroft/Gaea-stats-MOM6-examples +FMS_COMMIT ?= f2e2c86f6c0eb6d389a20509a8a60fa22924e16b +FMS := $(DEPS)/fms + +#--- +# Build configuration + +# Build settings +MKMF_CPP = "-Duse_libMPI -Duse_netCDF -DSPMD" + +# Environment +# TODO: This info ought to be determined by CMake, automake, etc. +#MKMF_TEMPLATE ?= linux-ubuntu-xenial-gnu.mk +MKMF_TEMPLATE ?= ncrc-gnu.mk +#MKMF_TEMPLATE ?= ncrc-intel.mk + +#--- +# Repository configuration + +# NOTE: MOM_TARGET_REMOTE_NAME and MOM_MERGED_BRANCH are arbitrary +# TODO: check for conflicts with existing branchs and remotes? +# TODO: Define them appropriately (if at all) when DO_REGRESSION_TESTS is false + +# URL-friendly target repo name (TRAVIS_REPO_SLUG) +MOM_TARGET_SLUG ?= NOAA-GFDL/MOM6 +MOM_TARGET_URL ?= https://github.com/$(MOM_TARGET_SLUG) + +# Target branch name (TRAVIS_BRANCH) +MOM_TARGET_LOCAL_BRANCH ?= dev/gfdl -# Experiments to run -ifeq ($(MEMORY_SHAPE),"dynamic_symmetric") -EXPERIMENTS ?= unit_tests double_gyre flow_downslope/z CVmix_SCM_tests/cooling_only/EPBL circle_obcs +MOM_TARGET_REMOTE_NAME ?= target +MOM_TARGET_BRANCH := $(MOM_TARGET_REMOTE_NAME)/$(MOM_TARGET_LOCAL_BRANCH) + +MOM_MERGED_BRANCH ?= mergetest + +#--- +# Test configuration + +# Executables +BUILDS = symmetric asymmetric repro +CONFIGS := $(foreach n,$(shell seq 0 3),tc$(n)) +TESTS = grids layouts restarts repros nans dims + +# DO_REGRESSION_TESTS obtained from $(TRAVIS_PULL_REQUEST) +DO_REGRESSION_TESTS ?= "true" +ifneq ($(DO_REGRESSION_TESTS), false) + BUILDS += target + TEST += regressions + GIT_TARGET_REMOTE = .git/refs/remotes/$(MOM_TARGET_BRANCH) else -EXPERIMENTS ?= unit_tests double_gyre flow_downslope/z CVmix_SCM_tests/cooling_only/EPBL + GIT_TARGET_REMOTE = endif -FMS_PACKAGES ?= platform,include,memutils,constants,mpp,fms,time_manager,diag_manager,data_override,coupler/coupler_types.F90,coupler/ensemble_manager.F90,axis_utils,horiz_interp,time_interp,astronomy,mosaic,random_numbers -TEMPLATE ?= .testing/linux-ubuntu-xenial-gnu.mk -MPIRUN ?= mpirun -# MEMORY_SHAPE must be defined for this Makefile to work -MEMORY_SHAPE ?= dynamic_symmetric +#--- +# Rules -# Everything above is above is "configurable" with environment variables -SHELL = bash +.PHONY: all +all: $(foreach b,$(BUILDS),build/$(b)/MOM6) + +# Executable +BUILD_TARGETS = MOM6 Makefile path_names +.PRECIOUS: $(foreach b,$(BUILDS),$(foreach f,$(BUILD_TARGETS),build/$(b)/$(f))) -# Path where executable will be built -BUILD_PATH = build -###/$(MEMORY_SHAPE)-$(EXEC_MODE) -# Root of configurations (MOM6-examples) -EXPERIMENTS_ROOT = experiments -# Regression results -REGRESSIONS_ROOT = answers +$(foreach f,$(BUILD_TARGETS),build/target/$(f)): BRANCH=$(MOM_TARGET_BRANCH) +$(foreach f,$(BUILD_TARGETS),build/%/$(f)): BRANCH=$(MOM_MERGED_BRANCH) -.PRECIOUS: %/ocean.stats +build/target/MOM6: MOMFLAGS=NETCDF=3 DEBUG=1 +build/symmetric/MOM6: MOMFLAGS=NETCDF=3 DEBUG=1 COVERAGE=1 +build/asymmetric/MOM6: MOMFLAGS=NETCDF=3 DEBUG=1 +build/repro/MOM6: MOMFLAGS=NETCDF=3 REPRO=1 -run: $(foreach e,$(EXPERIMENTS),$(EXPERIMENTS_ROOT)/ocean_only/$(e)/ocean.stats) +build/target/path_names: REMOTE=$(GIT_TARGET_REMOTE) +build/%/path_names: REMOTE=.git/refs/heads/$(MOM_MERGED_BRANCH) -test: $(foreach e,$(EXPERIMENTS),$(REGRESSIONS_ROOT)/regressions/ocean_only/$(e)/ocean.stats.gnu) +build/asymmetric/path_names: GRID_SRC=config_src/dynamic +build/%/path_names: GRID_SRC=config_src/dynamic_symmetric -compile: $(BUILD_PATH)/MOM6 +build/%/MOM6: build/%/Makefile $(FMS)/lib/libfms.a + git checkout $(BRANCH) + make -C $(@D) $(MOMFLAGS) $(@F) + git checkout @{-1} -$(BUILD_PATH)/MOM6: FMS mkmf +build/%/Makefile: build/%/path_names + git checkout $(BRANCH) + cp .testing/$(MKMF_TEMPLATE) $(@D) + cd $(@D) && $(MKMF) \ + -t $(MKMF_TEMPLATE) \ + -o '-I ../../$(FMS)/build' \ + -p MOM6 \ + -l '../../$(FMS)/lib/libfms.a' \ + -c $(MKMF_CPP) \ + path_names + git checkout @{-1} + +build/%/path_names: $(LIST_PATHS) $(REMOTE) + git checkout $(BRANCH) mkdir -p $(@D) - cd $(@D); \ - ../mkmf/bin/list_paths -l ../FMS/{$(FMS_PACKAGES)} ../config_src/{$(MEMORY_SHAPE),solo_driver} ../src \ - && ../mkmf/bin/mkmf -t ../$(TEMPLATE) -c '-Duse_libMPI -Duse_netCDF -DSPMD -DUSE_LOG_DIAG_FIELD_INFO -DMAXFIELDMETHODS_=500' -p $(@F) path_names \ - && make -j NETCDF=3 $(@F) + cd $(@D) && $(LIST_PATHS) -l \ + ../../src \ + ../../config_src/solo_driver \ + ../../$(GRID_SRC) + git checkout @{-1} -$(EXPERIMENTS_ROOT)/%/ocean.stats: $(EXPERIMENTS_ROOT) - mkdir -p $(@D)/RESTART - cd $(@D) ; $(MPIRUN) -n 1 $(PWD)/$(BUILD_PATH)/MOM6 -$(REGRESSIONS_ROOT)/regressions/%/ocean.stats.gnu: $(EXPERIMENTS_ROOT)/%/ocean.stats $(REGRESSIONS_ROOT) - cp $< $@ - cd $(@D) ; git status --porcelain $(@F) +#---- +# Repository management -# Targets to clone repositories needed to build -FMS: - git clone -q $(FMS_URL) - cd $@ ; git checkout -q $(FMS_COMMIT) +# WARNING: Implicit dependency of GIT_TARGET_REMOTE and DO_REGRESSION_TESTS +.git/refs/heads/$(MOM_MERGED_BRANCH): $(GIT_TARGET_REMOTE) + git checkout -b $(MOM_MERGED_BRANCH) + if [ $(DO_REGRESSION_TESTS) != "false" ]; then \ + git merge --no-edit $(MOM_TARGET_BRANCH); \ + fi + git checkout @{-1} -mkmf: - git clone -q $(MKMF_URL) - cd $@ ; git checkout -q $(MKMF_COMMIT) +# GIT_TARGET_REMOTE conditional rule +.git/refs/remotes/$(MOM_TARGET_BRANCH): + git ls-remote $(MOM_TARGET_REMOTE_NAME) \ + || git remote add $(MOM_TARGET_REMOTE_NAME) $(MOM_TARGET_URL) + git fetch --no-recurse-submodules $(MOM_TARGET_REMOTE_NAME) -$(EXPERIMENTS_ROOT): - mkdir -p $(@D) - cd $(@D) ; git clone --depth 1 $(CONFIGS_URL) experiments -$(REGRESSIONS_ROOT): +#---- +# FMS build + +$(FMS)/lib/libfms.a: $(FMS)/build/Makefile + mkdir -p $(FMS)/lib + cd $(FMS)/build && make NETCDF=3 DEBUG=1 ../lib/libfms.a + +$(FMS)/build/Makefile: $(FMS)/build/path_names + cp .testing/$(MKMF_TEMPLATE) $(@D) + cd $(@D) && $(MKMF) \ + -t $(MKMF_TEMPLATE) \ + -p ../lib/libfms.a \ + -c $(MKMF_CPP) \ + path_names + +$(FMS)/build/path_names: $(FMS)/src $(FMS_FILES) $(LIST_PATHS) mkdir -p $(@D) - cd $(@D) ; git clone --depth 1 $(REGRESSIONS_URL) answers + cd $(@D) && $(LIST_PATHS) -l ../src + +$(FMS)/src: + git clone $(FMS_URL) $@ + cd $@; git checkout $(FMS_COMMIT) + + +#--- +# Build Toolchain + +$(LIST_PATHS) $(MKMF): + git clone $(MKMF_URL) $(DEPS)/mkmf + cd $(DEPS)/mkmf; git checkout $(MKMF_COMMIT) + + +#---- +# Testing + +.PHONY: test +test: $(foreach t,$(TESTS),test.$(t)) + +# NOTE: We remove tc3 (OBC) from grid test + +.PHONY: $(foreach t,$(TESTS),test.$(t)) +test.regressions: $(foreach c,$(CONFIGS),$(c).regreession $(c).regression.diag) +test.grids: $(foreach c,$(filter-out tc3,$(CONFIGS)),$(c).grid $(c).grid.diag) +test.layouts: $(foreach c,$(CONFIGS),$(c).layout $(c).layout.diag) +test.restarts: $(foreach c,$(CONFIGS),$(c).restart) +test.repros: $(foreach c,$(CONFIGS),$(c).repro $(c).repro.diag) +test.nans: $(foreach c,$(CONFIGS),$(c).nan $(c).nan.diag) +test.dims: $(foreach c,$(CONFIGS),$(foreach d,t l h z,$(c).dim.$(d) $(c).dim.$(d).diag)) + +# NOTE: chksum_diag return code of cmp is currently ignored since many fail! +define CMP_RULE +%.$(1): $(foreach b,$(2),.testing/%/ocean.stats.$(b)) + cmp $$^ + +%.$(1).diag: $(foreach b,$(2),.testing/%/chksum_diag.$(b)) + -cmp $$^ +endef + +$(eval $(call CMP_RULE,regression,symmetric target)) +$(eval $(call CMP_RULE,grid,symmetric asymmetric)) +$(eval $(call CMP_RULE,layout,symmetric layout)) +$(eval $(call CMP_RULE,repro,symmetric repro)) +$(eval $(call CMP_RULE,nan,symmetric nan)) +$(foreach d,t l h z,$(eval $(call CMP_RULE,dim.$(d),symmetric dim.$(d)))) + +# Restart tests only compare the final stat record +%.restart: $(foreach b,symmetric restart,.testing/%/ocean.stats.$(b)) + cmp $(foreach f,$^,<(tr -s ' ' < $(f) | cut -d ' ' -f3- | tail -n 1)) + +# TODO: chksum_diag parsing of restart files + + +#--- +# Test run output files + +#(1): Configuration name +#(2): Executable type +#(3): Enable coverage flag +#(4): MOM_override configuration +#(5): Environment variables +#(6): Number of MPI ranks + +define STAT_RULE +.testing/%/ocean.stats.$(1): build/$(2)/MOM6 + if [ $(3) ]; then find build -name *.gcda -exec rm -f '{}' \; ; fi + mkdir -p $$(@D)/RESTART + echo $(4) > $$(@D)/MOM_override + cd $$(@D) && $(5) $$(MPIRUN) -n $(6) ../../$$< 2> debug.out + cp $$(@D)/ocean.stats $$@ + > $$(@D)/MOM_override + if [ $(3) ]; then bash <(curl -s https://codecov.io/bash) -n $$@; fi + +.testing/%/chksum_diag.$(1): .testing/%/ocean.stats.$(1) + cp $$(@D)/chksum_diag $$@ +endef + +# Define $(,) as comma escape character +, := , + +$(eval $(call STAT_RULE,symmetric,symmetric,true,,,1)) +$(eval $(call STAT_RULE,asymmetric,asymmetric,,,,1)) +$(eval $(call STAT_RULE,target,target,,,,1)) +$(eval $(call STAT_RULE,repro,repro,,,,1)) +$(eval $(call STAT_RULE,layout,symmetric,,LAYOUT=2$(,)1,,2)) +$(eval $(call STAT_RULE,nan,symmetric,,,MALLOC_PERTURB_=256,1)) +$(eval $(call STAT_RULE,dim.t,symmetric,,T_RESCALE_POWER=11,,1)) +$(eval $(call STAT_RULE,dim.l,symmetric,,L_RESCALE_POWER=11,,1)) +$(eval $(call STAT_RULE,dim.h,symmetric,,H_RESCALE_POWER=11,,1)) +$(eval $(call STAT_RULE,dim.z,symmetric,,Z_RESCALE_POWER=11,,1)) + +# Restart tests require signicant preprocessing, and are handled separately. +.testing/%/ocean.stats.restart: build/symmetric/MOM6 + # Cleanup + mkdir -p $(@D)/RESTART + git checkout $(@D)/input.nml + > $(@D)/MOM_override + # Generate the half-period input namelist + # TODO: Assumes runtime set by DAYMAX, will fail if set by input.nml + cd $(@D) \ + && daymax=$$(grep DAYMAX MOM_input | cut -d '!' -f 1 | cut -d '=' -f 2 | xargs) \ + && timeunit=$$(grep TIMEUNIT MOM_input | cut -d '!' -f 1 | cut -d '=' -f 2 | xargs) \ + && if [ -z "$${timeunit}" ]; then timeunit="8.64e4"; fi \ + && printf -v timeunit_int "%.f" "$${timeunit}" \ + && halfperiod=$$(printf "%.f" $$(bc <<< "scale=10; 0.5 * $${daymax} * $${timeunit_int}")) \ + && f90nml -g ocean_solo_nml -v seconds=$${halfperiod} input.nml > tmp.nml \ + && mv tmp.nml input.nml \ + && echo $${daymax} $${timeunit} + # Run the first half-period + cd $(@D) && $(MPIRUN) -n 1 ../../$< 2> debug.out + # Setup the next inputs + rm -rf $(@D)/INPUT && mv $(@D)/RESTART $(@D)/INPUT + mkdir $(@D)/RESTART + cd $(@D) && f90nml -g mom_input_nml -v input_filename='r' input.nml > tmp.nml + mv $(@D)/tmp.nml $(@D)/input.nml + # Run the second half-period + cd $(@D) && $(MPIRUN) -n 1 ../../$< 2> debug.out + # Archive the results and cleanup + cp $(@D)/ocean.stats $@ + rm -rf $(@D)/INPUT + git checkout $(@D)/input.nml + +# TODO: Restart checksum diagnostics + + +#---- +.PHONY: clean +clean: clean.stats + rm -rf build + +.PHONY: clean.stats +clean.stats: + find .testing -name ocean.stats* -exec rm {} \; + find .testing -name chksum_diag* -exec rm {} \; diff --git a/.testing/linux-ubuntu-xenial-gnu.mk b/.testing/linux-ubuntu-xenial-gnu.mk index 80abc4e48d..8c96c8c5c6 100644 --- a/.testing/linux-ubuntu-xenial-gnu.mk +++ b/.testing/linux-ubuntu-xenial-gnu.mk @@ -88,12 +88,12 @@ FFLAGS := -fcray-pointer -fdefault-double-8 -fdefault-real-8 -Waliasing -ffree-l # Flags based on perforance target (production (OPT), reproduction (REPRO), or debug (DEBUG) FFLAGS_OPT = -O3 FFLAGS_REPRO = -O2 -fbounds-check -FFLAGS_DEBUG = -O0 -g -W -fbounds-check -fbacktrace -ffpe-trap=invalid,zero,overflow +FFLAGS_DEBUG = -O0 -g -W -Wno-compare-reals -fbounds-check -fbacktrace -ffpe-trap=invalid,zero,overflow # Flags to add additional build options FFLAGS_OPENMP = -fopenmp FFLAGS_VERBOSE = -FFLAGS_COVERAGE = +FFLAGS_COVERAGE = --coverage # Macro for C preprocessor CPPFLAGS = $(INCLUDES) @@ -111,7 +111,7 @@ CFLAGS_DEBUG = -O0 -g # Flags to add additional build options CFLAGS_OPENMP = -fopenmp CFLAGS_VERBOSE = -CFLAGS_COVERAGE = +CFLAGS_COVERAGE = --coverage # Optional Testing compile flags. Mutually exclusive from DEBUG, REPRO, and OPT # *_TEST will match the production if no new option(s) is(are) to be tested. @@ -122,7 +122,7 @@ CFLAGS_TEST = $(CFLAGS_OPT) LDFLAGS := LDFLAGS_OPENMP := -fopenmp LDFLAGS_VERBOSE := -LDFLAGS_COVERAGE := +LDFLAGS_COVERAGE := --coverage # Start with a blank LIBS LIBS = diff --git a/.testing/tc0/MOM_input b/.testing/tc0/MOM_input new file mode 100644 index 0000000000..217b2d2c3d --- /dev/null +++ b/.testing/tc0/MOM_input @@ -0,0 +1,229 @@ +! This file was written by the model and records the non-default parameters used at run-time. + +! === module MOM === +DO_UNIT_TESTS = True ! [Boolean] default = False + ! If True, exercises unit tests at model start up. +SPLIT = False ! [Boolean] default = True + ! Use the split time stepping if true. +ENABLE_THERMODYNAMICS = False ! [Boolean] default = True + ! If true, Temperature and salinity are used as state + ! variables. +ADIABATIC = True ! [Boolean] default = False + ! There are no diapycnal mass fluxes if ADIABATIC is + ! true. This assumes that KD = KDML = 0.0 and that + ! there is no buoyancy forcing, but makes the model + ! faster by eliminating subroutine calls. +DT = 8.64E+04 ! [s] + ! The (baroclinic) dynamics time step. The time-step that + ! is actually used will be an integer fraction of the + ! forcing time-step (DT_FORCING in ocean-only mode or the + ! coupling timestep in coupled mode.) + +! === module MOM_domains === +NIGLOBAL = 4 ! + ! The total number of thickness grid points in the + ! x-direction in the physical domain. With STATIC_MEMORY_ + ! this is set in MOM_memory.h at compile time. +NJGLOBAL = 4 ! + ! The total number of thickness grid points in the + ! y-direction in the physical domain. With STATIC_MEMORY_ + ! this is set in MOM_memory.h at compile time. + +! === module MOM_hor_index === +! Sets the horizontal array index types. + +! === module MOM_verticalGrid === +! Parameters providing information about the vertical grid. +NK = 1 ! [nondim] + ! The number of model layers. + +! === module MOM_tracer_registry === + +! === module MOM_restart === + +! === module MOM_tracer_flow_control === + +! === module MOM_fixed_initialization === + +! === module MOM_grid_init === +GRID_CONFIG = "cartesian" ! + ! A character string that determines the method for + ! defining the horizontal grid. Current options are: + ! mosaic - read the grid from a mosaic (supergrid) + ! file set by GRID_FILE. + ! cartesian - use a (flat) Cartesian grid. + ! spherical - use a simple spherical grid. + ! mercator - use a Mercator spherical grid. +SOUTHLAT = 0.0 ! [degrees] + ! The southern latitude of the domain or the equivalent + ! starting value for the y-axis. +LENLAT = 1.0 ! [degrees] + ! The latitudinal or y-direction length of the domain. +LENLON = 1.0 ! [degrees] + ! The longitudinal or x-direction length of the domain. +TOPO_CONFIG = "flat" ! + ! This specifies how bathymetry is specified: + ! file - read bathymetric information from the file + ! specified by (TOPO_FILE). + ! flat - flat bottom set to MAXIMUM_DEPTH. + ! bowl - an analytically specified bowl-shaped basin + ! ranging between MAXIMUM_DEPTH and MINIMUM_DEPTH. + ! spoon - a similar shape to 'bowl', but with an vertical + ! wall at the southern face. + ! halfpipe - a zonally uniform channel with a half-sine + ! profile in the meridional direction. + ! benchmark - use the benchmark test case topography. + ! DOME - use a slope and channel configuration for the + ! DOME sill-overflow test case. + ! ISOMIP - use a slope and channel configuration for the + ! ISOMIP test case. + ! DOME2D - use a shelf and slope configuration for the + ! DOME2D gravity current/overflow test case. + ! seamount - Gaussian bump for spontaneous motion test case. + ! Phillips - ACC-like idealized topography used in the Phillips config. + ! USER - call a user modified routine. +MAXIMUM_DEPTH = 100.0 ! [m] + ! The maximum depth of the ocean. + +! === module MOM_open_boundary === +! Controls where open boundaries are located, what kind of boundary condition to impose, and what data to apply, if any. + +! === module MOM_coord_initialization === +COORD_CONFIG = "none" ! + ! This specifies how layers are to be defined: + ! file - read coordinate information from the file + ! specified by (COORD_FILE). + ! BFB - Custom coords for buoyancy-forced basin case + ! based on SST_S, T_BOT and DRHO_DT. + ! linear - linear based on interfaces not layers + ! layer_ref - linear based on layer densities + ! ts_ref - use reference temperature and salinity + ! ts_range - use range of temperature and salinity + ! (T_REF and S_REF) to determine surface density + ! and GINT calculate internal densities. + ! gprime - use reference density (RHO_0) for surface + ! density and GINT calculate internal densities. + ! ts_profile - use temperature and salinity profiles + ! (read from COORD_FILE) to set layer densities. + ! USER - call a user modified routine. + +! === module MOM_grid === +! Parameters providing information about the lateral grid. + +! === module MOM_state_initialization === +THICKNESS_CONFIG = "uniform" ! + ! A string that determines how the initial layer + ! thicknesses are specified for a new run: + ! file - read interface heights from the file specified + ! thickness_file - read thicknesses from the file specified + ! by (THICKNESS_FILE). + ! coord - determined by ALE coordinate. + ! uniform - uniform thickness layers evenly distributed + ! between the surface and MAXIMUM_DEPTH. + ! DOME - use a slope and channel configuration for the + ! DOME sill-overflow test case. + ! ISOMIP - use a configuration for the + ! ISOMIP test case. + ! benchmark - use the benchmark test case thicknesses. + ! search - search a density profile for the interface + ! densities. This is not yet implemented. + ! circle_obcs - the circle_obcs test case is used. + ! DOME2D - 2D version of DOME initialization. + ! adjustment2d - TBD AJA. + ! sloshing - TBD AJA. + ! seamount - TBD AJA. + ! soliton - Equatorial Rossby soliton. + ! rossby_front - a mixed layer front in thermal wind balance. + ! USER - call a user modified routine. + +! === module MOM_diag_mediator === + +! === module MOM_MEKE === + +! === module MOM_lateral_mixing_coeffs === + +! === module MOM_set_visc === +BOTTOMDRAGLAW = False ! [Boolean] default = True + ! If true, the bottom stress is calculated with a drag + ! law of the form c_drag*|u|*u. The velocity magnitude + ! may be an assumed value or it may be based on the + ! actual velocity in the bottommost HBBL, depending on + ! LINEAR_DRAG. +HBBL = 1.0 ! [m] + ! The thickness of a bottom boundary layer with a + ! viscosity of KVBBL if BOTTOMDRAGLAW is not defined, or + ! the thickness over which near-bottom velocities are + ! averaged for the drag law if BOTTOMDRAGLAW is defined + ! but LINEAR_DRAG is not. +KV = 1.0 ! [m2 s-1] + ! The background kinematic viscosity in the interior. + ! The molecular value, ~1e-6 m2 s-1, may be used. + +! === module MOM_continuity === + +! === module MOM_continuity_PPM === +SIMPLE_2ND_PPM_CONTINUITY = True ! [Boolean] default = False + ! If true, CONTINUITY_PPM uses a simple 2nd order + ! (arithmetic mean) interpolation of the edge values. + ! This may give better PV conservation propterties. While + ! it formally reduces the accuracy of the continuity + ! solver itself in the strongly advective limit, it does + ! not reduce the overall order of accuracy of the dynamic + ! core. + +! === module MOM_CoriolisAdv === + +! === module MOM_PressureForce === + +! === module MOM_PressureForce_AFV === + +! === module MOM_hor_visc === + +! === module MOM_vert_friction === +HMIX_FIXED = 1.0 ! [m] + ! The prescribed depth over which the near-surface + ! viscosity and diffusivity are elevated when the bulk + ! mixed layer is not used. + +! === module MOM_thickness_diffuse === + +! === module MOM_mixed_layer_restrat === + +! === module MOM_diabatic_driver === +! The following parameters are used for diabatic processes. + +! === module MOM_tracer_advect === + +! === module MOM_tracer_hor_diff === + +! === module MOM_neutral_diffusion === +! This module implements neutral diffusion of tracers + +! === module MOM_surface_forcing === +BUOY_CONFIG = "zero" ! + ! The character string that indicates how buoyancy forcing + ! is specified. Valid options include (file), (zero), + ! (linear), (USER), (BFB) and (NONE). +WIND_CONFIG = "zero" ! + ! The character string that indicates how wind forcing + ! is specified. Valid options include (file), (2gyre), + ! (1gyre), (gyres), (zero), and (USER). + +! === module MOM_restart === + +! === module MOM_sum_output === + +! === module MOM_write_cputime === + +! === module MOM_main (MOM_driver) === +DAYMAX = 2.0 ! [days] + ! The final time of the whole simulation, in units of + ! TIMEUNIT seconds. This also sets the potential end + ! time of the present run segment if the end time is + ! not set via ocean_solo_nml in input.nml. +ENERGYSAVEDAYS = 1.0 + +! === module MOM_file_parser === + +DIAG_AS_CHKSUM = True +DEBUG = True diff --git a/.testing/tc0/MOM_override b/.testing/tc0/MOM_override new file mode 100644 index 0000000000..e69de29bb2 diff --git a/.testing/tc0/diag_table b/.testing/tc0/diag_table new file mode 100644 index 0000000000..1527de166b --- /dev/null +++ b/.testing/tc0/diag_table @@ -0,0 +1,2 @@ +"Unit tests" +1 1 1 0 0 0 diff --git a/.testing/tc0/input.nml b/.testing/tc0/input.nml new file mode 100644 index 0000000000..961963ea8e --- /dev/null +++ b/.testing/tc0/input.nml @@ -0,0 +1,20 @@ +&MOM_input_nml + output_directory = './' + input_filename = 'n' + restart_input_dir = 'INPUT' + restart_output_dir = 'RESTART' + parameter_filename = + 'MOM_input', + 'MOM_override', +/ + +&diag_manager_nml +/ + +&fms_nml + domains_stack_size = 710000 + stack_size = 0 +/ + +&ocean_domains_nml +/ diff --git a/.testing/tc1/MOM_input b/.testing/tc1/MOM_input new file mode 100644 index 0000000000..80fdd90860 --- /dev/null +++ b/.testing/tc1/MOM_input @@ -0,0 +1,576 @@ +/* This input file provides the adjustable run-time parameters for version 6 of + the Modular Ocean Model (MOM6), a numerical ocean model developed at NOAA-GFDL. + Where appropriate, parameters use usually given in MKS units. + + This particular file is for the example in benchmark. + + This MOM_input file typically contains only the non-default values that are + needed to reproduce this example. A full list of parameters for this example + can be found in the corresponding MOM_parameter_doc.all file which is + generated by the model at run-time. */ + +!SYMMETRIC_MEMORY_ = False ! [Boolean] + ! If defined, the velocity point data domain includes + ! every face of the thickness points. In other words, + ! some arrays are larger than others, depending on where + ! they are on the staggered grid. Also, the starting + ! index of the velocity-point arrays is usually 0, not 1. + ! This can only be set at compile time. +!STATIC_MEMORY_ = False ! [Boolean] + ! If STATIC_MEMORY_ is defined, the principle variables + ! will have sizes that are statically determined at + ! compile time. Otherwise the sizes are not determined + ! until run time. The STATIC option is substantially + ! faster, but does not allow the PE count to be changed + ! at run time. This can only be set at compile time. +NIHALO = 4 ! default = 2 + ! The number of halo points on each side in the + ! x-direction. With STATIC_MEMORY_ this is set as NIHALO_ + ! in MOM_memory.h at compile time; without STATIC_MEMORY_ + ! the default is NIHALO_ in MOM_memory.h (if defined) or 2. +NJHALO = 4 ! default = 2 + ! The number of halo points on each side in the + ! y-direction. With STATIC_MEMORY_ this is set as NJHALO_ + ! in MOM_memory.h at compile time; without STATIC_MEMORY_ + ! the default is NJHALO_ in MOM_memory.h (if defined) or 2. +NIGLOBAL = 10 ! + ! The total number of thickness grid points in the + ! x-direction in the physical domain. With STATIC_MEMORY_ + ! this is set in MOM_memory.h at compile time. +NJGLOBAL = 8 ! + ! The total number of thickness grid points in the + ! y-direction in the physical domain. With STATIC_MEMORY_ + ! this is set in MOM_memory.h at compile time. +!NIPROC = 12 ! + ! The number of processors in the x-direction. With + ! STATIC_MEMORY_ this is set in MOM_memory.h at compile time. +!NJPROC = 6 ! + ! The number of processors in the x-direction. With + ! STATIC_MEMORY_ this is set in MOM_memory.h at compile time. +!LAYOUT = 12, 6 ! + ! The processor layout that was acutally used. +IO_LAYOUT = 1, 1 ! default = 0 + ! The processor layout to be used, or 0,0 to automatically + ! set the io_layout to be the same as the layout. + +! === module MOM_grid === +! Parameters providing information about the vertical grid. +NK = 8 ! [nondim] + ! The number of model layers. + +! === module MOM_verticalGrid === +! Parameters providing information about the vertical grid. + +! === module MOM === +THICKNESSDIFFUSE = True ! [Boolean] default = False + ! If true, interfaces or isopycnal surfaces are diffused, + ! depending on the value of FULL_THICKNESSDIFFUSE. +THICKNESSDIFFUSE_FIRST = True ! [Boolean] default = False + ! If true, do thickness diffusion before dynamics. + ! This is only used if THICKNESSDIFFUSE is true. +MIXEDLAYER_RESTRAT = True ! [Boolean] default = False + ! If true, a density-gradient dependent re-stratifying + ! flow is imposed in the mixed layer. + ! This is only used if BULKMIXEDLAYER is true. +DT = 900.0 ! [s] + ! The (baroclinic) dynamics time step. The time-step that + ! is actually used will be an integer fraction of the + ! forcing time-step (DT_FORCING in ocean-only mode or the + ! coupling timestep in coupled mode.) +DT_THERM = 3600.0 ! [s] default = 900.0 + ! 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. + ! By default DT_THERM is set to DT. +DTBT_RESET_PERIOD = 0.0 ! [s] default = 3600.0 + ! The period between recalculations of DTBT (if DTBT <= 0). + ! If DTBT_RESET_PERIOD is negative, DTBT is set based + ! only on information available at initialization. If + ! dynamic, DTBT will be set at least every forcing time + ! step, and if 0, every dynamics time step. The default is + ! set by DT_THERM. This is only used if SPLIT is true. +FRAZIL = True ! [Boolean] default = False + ! If true, water freezes if it gets too cold, and the + ! the accumulated heat deficit is returned in the + ! surface state. FRAZIL is only used if + ! ENABLE_THERMODYNAMICS is true. +C_P = 3925.0 ! [J kg-1 K-1] default = 3991.86795711963 + ! The heat capacity of sea water, approximated as a + ! constant. This is only used if ENABLE_THERMODYNAMICS is + ! true. The default value is from the TEOS-10 definition + ! of conservative temperature. +SAVE_INITIAL_CONDS = True ! [Boolean] default = False + ! If true, write the initial conditions to a file given + ! by IC_OUTPUT_FILE. +IC_OUTPUT_FILE = "GOLD_IC" ! default = "MOM_IC" + ! The file into which to write the initial conditions. + +! === module MOM_tracer_registry === + +! === module MOM_tracer_flow_control === +USE_IDEAL_AGE_TRACER = True ! [Boolean] default = False + ! If true, use the ideal_age_example tracer package. + +! === module ideal_age_example === +INPUTDIR = "INPUT" ! default = "." + ! The directory in which input files are found. +COORD_CONFIG = "ts_range" ! + ! This specifies how layers are to be defined: + ! file - read coordinate information from the file + ! specified by (COORD_FILE). + ! linear - linear based on interfaces not layesrs. + ! ts_ref - use reference temperature and salinity + ! ts_range - use range of temperature and salinity + ! (T_REF and S_REF) to determine surface density + ! and GINT calculate internal densities. + ! gprime - use reference density (RHO_0) for surface + ! density and GINT calculate internal densities. + ! ts_profile - use temperature and salinity profiles + ! (read from COORD_FILE) to set layer densities. + ! USER - call a user modified routine. +TS_RANGE_T_LIGHT = 25.0 ! [degC] default = 10.0 + ! The initial temperature of the lightest layer when + ! COORD_CONFIG is set to ts_range. +TS_RANGE_T_DENSE = 3.0 ! [degC] default = 10.0 + ! The initial temperature of the densest layer when + ! COORD_CONFIG is set to ts_range. +TS_RANGE_RESOLN_RATIO = 5.0 ! [nondim] default = 1.0 + ! The ratio of density space resolution in the densest + ! part of the range to that in the lightest part of the + ! range when COORD_CONFIG is set to ts_range. Values + ! greater than 1 increase the resolution of the denser water. + +! === module MOM_grid_init === +GRID_CONFIG = "mercator" ! + ! A character string that determines the method for + ! defining the horizontal grid. Current options are: + ! mosaic - read the grid from a mosaic (supergrid) + ! file set by GRID_FILE. + ! cartesian - use a (flat) Cartesian grid. + ! spherical - use a simple spherical grid. + ! mercator - use a Mercator spherical grid. +SOUTHLAT = -41.0 ! [degrees] + ! The southern latitude of the domain. +LENLAT = 41.0 ! [degrees] + ! The latitudinal length of the domain. +LENLON = 90.0 ! [degrees] + ! The longitudinal length of the domain. +ISOTROPIC = True ! [Boolean] default = False + ! If true, an isotropic grid on a sphere (also known as + ! a Mercator grid) is used. With an isotropic grid, the + ! meridional extent of the domain (LENLAT), the zonal + ! extent (LENLON), and the number of grid points in each + ! direction are _not_ independent. In MOM the meridional + ! extent is determined to fit the zonal extent and the + ! number of grid points, while grid is perfectly isotropic. +TOPO_CONFIG = "benchmark" ! + ! This specifies how bathymetry is specified: + ! file - read bathymetric information from the file + ! specified by (TOPO_FILE). + ! flat - flat bottom set to MAXIMUM_DEPTH. + ! bowl - an analytically specified bowl-shaped basin + ! ranging between MAXIMUM_DEPTH and MINIMUM_DEPTH. + ! spoon - a similar shape to 'bowl', but with an vertical + ! wall at the southern face. + ! halfpipe - a zonally uniform channel with a half-sine + ! profile in the meridional direction. + ! benchmark - use the benchmark test case topography. + ! DOME - use a slope and channel configuration for the + ! DOME sill-overflow test case. + ! DOME2D - use a shelf and slope configuration for the + ! DOME2D gravity current/overflow test case. + ! seamount - Gaussian bump for spontaneous motion test case. + ! USER - call a user modified routine. + +! === module benchmark_initialize_topography === +MINIMUM_DEPTH = 1.0 ! [m] default = 0.0 + ! The minimum depth of the ocean. +MAXIMUM_DEPTH = 5500.0 ! [m] + ! The maximum depth of the ocean. +THICKNESS_CONFIG = "benchmark" ! + ! A string that determines how the initial layer + ! thicknesses are specified for a new run: + ! file - read interface heights from the file specified + ! thickness_file - read thicknesses from the file specified + ! by (THICKNESS_FILE). + ! uniform - uniform thickness layers evenly distributed + ! between the surface and MAXIMUM_DEPTH. + ! DOME - use a slope and channel configuration for the + ! DOME sill-overflow test case. + ! benchmark - use the benchmark test case thicknesses. + ! search - search a density profile for the interface + ! densities. This is not yet implemented. + ! circle_obcs - the circle_obcs test case is used. + ! DOME2D - 2D version of DOME initialization. + ! adjustment2d - TBD AJA. + ! sloshing - TBD AJA. + ! seamount - TBD AJA. + ! USER - call a user modified routine. +TS_CONFIG = "benchmark" ! + ! A string that determines how the initial tempertures + ! and salinities are specified for a new run: + ! file - read velocities from the file specified + ! by (TS_FILE). + ! fit - find the temperatures that are consistent with + ! the layer densities and salinity S_REF. + ! TS_profile - use temperature and salinity profiles + ! (read from TS_FILE) to set layer densities. + ! benchmark - use the benchmark test case T & S. + ! linear - linear in logical layer space. + ! DOME2D - 2D DOME initialization. + ! adjustment2d - TBD AJA. + ! sloshing - TBD AJA. + ! seamount - TBD AJA. + ! USER - call a user modified routine. + +! === module MOM_MEKE === + +! === module MOM_lateral_mixing_coeffs === +USE_VARIABLE_MIXING = True ! [Boolean] default = False + ! If true, the variable mixing code will be called. This + ! allows diagnostics to be created even if the scheme is + ! not used. If KHTR_SLOPE_CFF>0 or KhTh_Slope_Cff>0, + ! this is set to true regardless of what is in the + ! parameter file. +USE_VISBECK = True ! [Boolean] default = False + ! If true, use the Visbeck et al. (1997) formulation for + ! thickness diffusivity. +RESOLN_SCALED_KH = True ! [Boolean] default = False + ! If true, the Laplacian lateral viscosity is scaled away + ! when the first baroclinic deformation radius is well + ! resolved. +RESOLN_SCALED_KHTH = True ! [Boolean] default = False + ! If true, the interface depth diffusivity is scaled away + ! when the first baroclinic deformation radius is well + ! resolved. +RESOLN_SCALED_KHTR = True ! [Boolean] default = False + ! If true, the epipycnal tracer diffusivity is scaled + ! away when the first baroclinic deformation radius is + ! well resolved. +KHTH_SLOPE_CFF = 0.1 ! [nondim] default = 0.0 + ! The nondimensional coefficient in the Visbeck formula + ! for the interface depth diffusivity +KHTR_SLOPE_CFF = 0.1 ! [nondim] default = 0.0 + ! The nondimensional coefficient in the Visbeck formula + ! for the epipycnal tracer diffusivity +VARMIX_KTOP = 6 ! [nondim] default = 2 + ! The layer number at which to start vertical integration + ! of S*N for purposes of finding the Eady growth rate. +VISBECK_L_SCALE = 3.0E+04 ! [m] default = 0.0 + ! The fixed length scale in the Visbeck formula. + +! === module MOM_wave_speed === +ETA_TOLERANCE = 1.0E-06 ! [m] default = 1.1E-09 + ! The tolerance for the differences between the + ! barotropic and baroclinic estimates of the sea surface + ! height due to the fluxes through each face. The total + ! tolerance for SSH is 4 times this value. The default + ! is 0.5*NK*ANGSTROM, and this should not be set less x + ! than about 10^-15*MAXIMUM_DEPTH. +VELOCITY_TOLERANCE = 0.001 ! [m s-1] default = 3.0E+08 + ! The tolerance for barotropic velocity discrepancies + ! between the barotropic solution and the sum of the + ! layer thicknesses. +BOUND_CORIOLIS = True ! [Boolean] default = False + ! If true, the Coriolis terms at u-points are bounded by + ! the four estimates of (f+rv)v from the four neighboring + ! v-points, and similarly at v-points. This option would + ! have no effect on the SADOURNY Coriolis scheme if it + ! were possible to use centered difference thickness fluxes. + +! === module MOM_hor_visc === +AH_VEL_SCALE = 0.05 ! [m s-1] default = 0.0 + ! The velocity scale which is multiplied by the cube of + ! the grid spacing to calculate the Laplacian viscosity. + ! The final viscosity is the largest of this scaled + ! viscosity, the Smagorinsky viscosity and AH. +SMAGORINSKY_AH = True ! [Boolean] default = False + ! If true, use a biharmonic Smagorinsky nonlinear eddy + ! viscosity. +SMAG_BI_CONST = 0.06 ! [nondim] default = 0.0 + ! The nondimensional biharmonic Smagorinsky constant, + ! typically 0.015 - 0.06. + +! === module MOM_vert_friction === +PRANDTL_TURB = 0.0 ! [nondim] default = 1.0 + ! The turbulent Prandtl number applied to shear + ! instability. +DYNAMIC_VISCOUS_ML = True ! [Boolean] default = False + ! If true, use a bulk Richardson number criterion to + ! determine the mixed layer thickness for viscosity. +U_TRUNC_FILE = "U_velocity_truncations" ! default = "" + ! The absolute path to a file into which the accelerations + ! leading to zonal velocity truncations are written. + ! Undefine this for efficiency if this diagnostic is not + ! needed. +V_TRUNC_FILE = "V_velocity_truncations" ! default = "" + ! The absolute path to a file into which the accelerations + ! leading to meridional velocity truncations are written. + ! Undefine this for efficiency if this diagnostic is not + ! needed. +KV = 1.0E-04 ! [m2 s-1] + ! The background kinematic viscosity in the interior. + ! The molecular value, ~1e-6 m2 s-1, may be used. +HBBL = 10.0 ! [m] + ! The thickness of a bottom boundary layer with a + ! viscosity of KVBBL if BOTTOMDRAGLAW is not defined, or + ! the thickness over which near-bottom velocities are + ! averaged for the drag law if BOTTOMDRAGLAW is defined + ! but LINEAR_DRAG is not. +MAXVEL = 10.0 ! [m s-1] default = 3.0E+08 + ! The maximum velocity allowed before the velocity + ! components are truncated. + +! === module MOM_PointAccel === + +! === module MOM_set_visc === +USE_JACKSON_PARAM = True ! [Boolean] default = False + ! If true, use the Jackson-Hallberg-Legg (JPO 2008) + ! shear mixing parameterization. +ML_OMEGA_FRAC = 1.0 ! [nondim] default = 0.0 + ! 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). +DRAG_BG_VEL = 0.1 ! [m s-1] default = 0.0 + ! 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. DRAG_BG_VEL is only used when + ! BOTTOMDRAGLAW is defined. +BBL_THICK_MIN = 0.1 ! [m] default = 0.0 + ! The minimum bottom boundary layer thickness that can be + ! used with BOTTOMDRAGLAW. This might be + ! Kv / (cdrag * drag_bg_vel) to give Kv as the minimum + ! near-bottom viscosity. + +! === module MOM_barotropic === +BOUND_BT_CORRECTION = True ! [Boolean] default = False + ! If true, the corrective pseudo mass-fluxes into the + ! barotropic solver are limited to values that require + ! less than 0.1*MAXVEL to be accommodated. +!BT x-halo = 0 ! + ! The barotropic x-halo size that is actually used. +!BT y-halo = 0 ! + ! The barotropic y-halo size that is actually used. +NONLINEAR_BT_CONTINUITY = True ! [Boolean] default = False + ! If true, use nonlinear transports in the barotropic + ! continuity equation. This does not apply if + ! USE_BT_CONT_TYPE is true. +BT_PROJECT_VELOCITY = True ! [Boolean] default = False + ! If true, step the barotropic velocity first and project + ! out the velocity tendancy by 1+BEBT when calculating the + ! transport. The default (false) is to use a predictor + ! continuity step to find the pressure field, and then + ! to do a corrector continuity step using a weighted + ! average of the old and new velocities, with weights + ! of (1-BEBT) and BEBT. +BT_THICK_SCHEME = "FROM_BT_CONT" ! default = "HYBRID" + ! A string describing the scheme that is used to set the + ! open face areas used for barotropic transport and the + ! relative weights of the accelerations. Valid values are: + ! ARITHMETIC - arithmetic mean layer thicknesses + ! HARMONIC - harmonic mean layer thicknesses + ! HYBRID (the default) - use arithmetic means for + ! layers above the shallowest bottom, the harmonic + ! mean for layers below, and a weighted average for + ! layers that straddle that depth + ! FROM_BT_CONT - use the average thicknesses kept + ! in the h_u and h_v fields of the BT_cont_type +BEBT = 0.2 ! [nondim] default = 0.1 + ! BEBT determines whether the barotropic time stepping + ! uses the forward-backward time-stepping scheme or a + ! backward Euler scheme. BEBT is valid in the range from + ! 0 (for a forward-backward treatment of nonrotating + ! gravity waves) to 1 (for a backward Euler treatment). + ! In practice, BEBT must be greater than about 0.05. +DTBT = -0.95 ! [s or nondim] default = -0.98 + ! The barotropic time step, in s. DTBT is only used with + ! the split explicit time stepping. To set the time step + ! automatically based the maximum stable value use 0, or + ! a negative value gives the fraction of the stable value. + ! Setting DTBT to 0 is the same as setting it to -0.98. + ! The value of DTBT that will actually be used is an + ! integer fraction of DT, rounding down. + +! === module MOM_thickness_diffuse === +KHTH = 1.0 ! [m2 s-1] default = 0.0 + ! The background horizontal thickness diffusivity. +KHTH_MAX = 900.0 ! [m2 s-1] default = 0.0 + ! The maximum horizontal thickness diffusivity. + +! === module MOM_mixed_layer_restrat === +FOX_KEMPER_ML_RESTRAT_COEF = 5.0 ! [nondim] default = 0.0 + ! A nondimensional coefficient that is proportional to + ! the ratio of the deformation radius to the dominant + ! lengthscale of the submesoscale mixed layer + ! instabilities, times the minimum of the ratio of the + ! mesoscale eddy kinetic energy to the large-scale + ! geostrophic kinetic energy or 1 plus the square of the + ! grid spacing over the deformation radius, as detailed + ! by Fox-Kemper et al. (2010) + +! === module MOM_diabatic_driver === +! The following parameters are used for diabatic processes. +RECLAIM_FRAZIL = False ! [Boolean] default = True + ! If true, try to use any frazil heat deficit to cool any + ! overlying layers down to the freezing point, thereby + ! avoiding the creation of thin ice when the SST is above + ! the freezing point. +KD = 2.0E-05 ! [m2 s-1] + ! The background diapycnal diffusivity of density in the + ! interior. Zero or the molecular value, ~1e-7 m2 s-1, + ! may be used. + +! === module MOM_KPP === +! This is the MOM wrapper to CVmix:KPP +! See http://code.google.com/p/cvmix/ +KPP% +%KPP + +! === module MOM_diffConvection === +! This module implements enhanced diffusivity as a +! function of static stability, N^2. +CONVECTION% +%CONVECTION + +! === module MOM_entrain_diffusive === +MAX_ENT_IT = 20 ! default = 5 + ! The maximum number of iterations that may be used to + ! calculate the interior diapycnal entrainment. +TOLERANCE_ENT = 1.0E-05 ! [m] default = 1.341640786499874E-05 + ! The tolerance with which to solve for entrainment values. + +! === module MOM_kappa_shear === +MAX_RINO_IT = 25 ! [nondim] default = 50 + ! The maximum number of iterations that may be used to + ! estimate the Richardson number driven mixing. + +! === module MOM_mixed_layer === +BULK_RI_ML = 0.05 ! [nondim] + ! The efficiency with which mean kinetic energy released + ! by mechanically forced entrainment of the mixed layer + ! is converted to turbulent kinetic energy. +ABSORB_ALL_SW = True ! [Boolean] default = False + ! If true, all shortwave radiation is absorbed by the + ! ocean, instead of passing through to the bottom mud. +MSTAR = 0.3 ! [units=nondim] default = 1.2 + ! The ratio of the friction velocity cubed to the TKE + ! input to the mixed layer. +TKE_DECAY = 10.0 ! [nondim] default = 2.5 + ! TKE_DECAY relates the vertical rate of decay of the + ! TKE available for mechanical entrainment to the natural + ! Ekman depth. +HMIX_MIN = 2.0 ! [m] default = 0.0 + ! The minimum mixed layer depth if the mixed layer depth + ! is determined dynamically. +LIMIT_BUFFER_DETRAIN = True ! [Boolean] default = False + ! If true, limit the detrainment from the buffer layers + ! to not be too different from the neighbors. +DEPTH_LIMIT_FLUXES = 0.1 ! [m] default = 0.2 + ! The surface fluxes are scaled away when the total ocean + ! depth is less than DEPTH_LIMIT_FLUXES. +CORRECT_ABSORPTION_DEPTH = True ! [Boolean] default = False + ! If true, the depth at which penetrating shortwave + ! radiation is absorbed is corrected by moving some of + ! the heating upward in the water column. + +! === module MOM_regularize_layers === + +! === module MOM_opacity === +PEN_SW_SCALE = 15.0 ! [m] default = 0.0 + ! The vertical absorption e-folding depth of the + ! penetrating shortwave radiation. +PEN_SW_FRAC = 0.42 ! [nondim] default = 0.0 + ! The fraction of the shortwave radiation that penetrates + ! below the surface. + +! === module MOM_tracer_advect === + +! === module MOM_tracer_hor_diff === +KHTR = 1.0 ! [m2 s-1] default = 0.0 + ! The background along-isopycnal tracer diffusivity. +KHTR_MAX = 900.0 ! [m2 s-1] default = 0.0 + ! The maximum along-isopycnal tracer diffusivity. +DIFFUSE_ML_TO_INTERIOR = True ! [Boolean] default = False + ! If true, enable epipycnal mixing between the surface + ! boundary layer and the interior. +ML_KHTR_SCALE = 0.0 ! [nondim] default = 1.0 + ! With Diffuse_ML_interior, the ratio of the truly + ! horizontal diffusivity in the mixed layer to the + ! epipycnal diffusivity. The valid range is 0 to 1. + +! === module MOM_surface_forcing === +BUOY_CONFIG = "linear" ! + ! The character string that indicates how buoyancy forcing + ! is specified. Valid options include (file), (zero), + ! (linear), (USER), and (NONE). +WIND_CONFIG = "gyres" ! + ! The character string that indicates how wind forcing + ! is specified. Valid options include (file), (2gyre), + ! (1gyre), (gyres), (zero), and (USER). +TAUX_SIN_AMP = 0.1 ! [Pa] default = 0.0 + ! With the gyres wind_config, the sine amplitude in the + ! zonal wind stress profile: + ! B in taux = A + B*sin(n*pi*y/L) + C*cos(n*pi*y/L). +TAUX_N_PIS = 1.0 ! [nondim] default = 0.0 + ! With the gyres wind_config, the number of gyres in + ! the zonal wind stress profile: + ! n in taux = A + B*sin(n*pi*y/L) + C*cos(n*pi*y/L). +RESTOREBUOY = True ! [Boolean] default = False + ! If true, the buoyancy fluxes drive the model back + ! toward some specified surface state with a rate + ! given by FLUXCONST. +FLUXCONST = 0.5 ! [m day-1] + ! The constant that relates the restoring surface fluxes + ! to the relative surface anomalies (akin to a piston + ! velocity). Note the non-MKS units. +SST_NORTH = 27.0 ! [deg C] default = 0.0 + ! With buoy_config linear, the sea surface temperature + ! at the northern end of the domain toward which to + ! to restore. +SST_SOUTH = 3.0 ! [deg C] default = 0.0 + ! With buoy_config linear, the sea surface temperature + ! at the southern end of the domain toward which to + ! to restore. + +! === module MOM_sum_output === +MAXTRUNC = 5000 ! [truncations save_interval-1] default = 0 + ! The run will be stopped, and the day set to a very + ! large value if the velocity is truncated more than + ! MAXTRUNC times between energy saves. Set MAXTRUNC to 0 + ! to stop if there is any truncation of velocities. +MAXCPU = 2.88E+04 ! [wall-clock seconds] default = -1.0 + ! The maximum amount of cpu time per processor for which + ! MOM should run before saving a restart file and + ! quitting with a return value that indicates that a + ! further run is required to complete the simulation. + ! If automatic restarts are not desired, use a negative + ! value for MAXCPU. MAXCPU has units of wall-clock + ! seconds, so the actual CPU time used is larger by a + ! factor of the number of processors used. + +! === module MOM_main (MOM_driver) === +DT_FORCING = 3600.0 ! [s] default = 900.0 + ! The time step for changing forcing, coupling with other + ! components, or potentially writing certain diagnostics. + ! The default value is given by DT. +DAYMAX = 0.25 ! [days] + ! The final time of the whole simulation, in units of + ! TIMEUNIT seconds. This also sets the potential end + ! time of the present run segment if the end time is + ! not set (as it was here) via ocean_solo_nml in input.nml. +RESTART_CONTROL = 3 ! default = 1 + ! 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 non-time-stamped + ! restart file is saved at the end of the run segment + ! for any non-negative value. +RESTINT = 365.0 ! [days] default = 0.0 + ! The interval between saves of the restart file in units + ! of TIMEUNIT. Use 0 (the default) to not save + ! incremental restart files at all. +ENERGYSAVEDAYS = 0.125 ! [days] default = 3600.0 + ! The interval in units of TIMEUNIT between saves of the + ! energies of the run and other globally summed diagnostics. +DIAG_AS_CHKSUM = True +DEBUG = True diff --git a/.testing/tc1/MOM_override b/.testing/tc1/MOM_override new file mode 100644 index 0000000000..e69de29bb2 diff --git a/.testing/tc1/diag_table b/.testing/tc1/diag_table new file mode 100644 index 0000000000..19d6a32e1e --- /dev/null +++ b/.testing/tc1/diag_table @@ -0,0 +1,86 @@ +"MOM benchmark Experiment" +1 1 1 0 0 0 +"prog", 1,"days",1,"days","time", +#"ave_prog", 5,"days",1,"days","Time",365,"days" +#"cont", 5,"days",1,"days","Time",365,"days" + +#This is the field section of the diag_table. + +# Prognostic Ocean fields: +#========================= + +"ocean_model","u","u","prog","all",.false.,"none",2 +"ocean_model","v","v","prog","all",.false.,"none",2 +"ocean_model","h","h","prog","all",.false.,"none",1 +"ocean_model","e","e","prog","all",.false.,"none",2 +"ocean_model","temp","temp","prog","all",.false.,"none",2 +#"ocean_model","salt","salt","prog","all",.false.,"none",2 + +#"ocean_model","u","u","ave_prog_%4yr_%3dy","all",.true.,"none",2 +#"ocean_model","v","v","ave_prog_%4yr_%3dy","all",.true.,"none",2 +#"ocean_model","h","h","ave_prog_%4yr_%3dy","all",.true.,"none",1 +#"ocean_model","e","e","ave_prog_%4yr_%3dy","all",.true.,"none",2 + +# Auxilary Tracers: +#================== +#"ocean_model","vintage","vintage","prog_%4yr_%3dy","all",.false.,"none",2 +#"ocean_model","age","age","prog_%4yr_%3dy","all",.false.,"none",2 + +# Continuity Equation Terms: +#=========================== +#"ocean_model","dhdt","dhdt","cont_%4yr_%3dy","all",.true.,"none",2 +#"ocean_model","wd","wd","cont_%4yr_%3dy","all",.true.,"none",2 +#"ocean_model","uh","uh","cont_%4yr_%3dy","all",.true.,"none",2 +#"ocean_model","vh","vh","cont_%4yr_%3dy","all",.true.,"none",2 +#"ocean_model","h_rho","h_rho","cont_%4yr_%3dy","all",.true.,"none",2 +#"ocean_model","uh_rho","uh_rho","cont_%4yr_%3dy","all",.true.,"none",2 +#"ocean_model","vh_rho","vh_rho","cont_%4yr_%3dy","all",.true.,"none",2 +#"ocean_model","uhGM_rho","uhGM_rho","cont_%4yr_%3dy","all",.true.,"none",2 +#"ocean_model","vhGM_rho","vhGM_rho","cont_%4yr_%3dy","all",.true.,"none",2 + +# +# Tracer Fluxes: +#================== +#"ocean_model","T_adx", "T_adx", "ave_prog_%4yr_%3dy","all",.true.,"none",2 +#"ocean_model","T_ady", "T_ady", "ave_prog_%4yr_%3dy","all",.true.,"none",2 +#"ocean_model","T_diffx","T_diffx","ave_prog_%4yr_%3dy","all",.true.,"none",2 +#"ocean_model","T_diffy","T_diffy","ave_prog_%4yr_%3dy","all",.true.,"none",2 +#"ocean_model","S_adx", "S_adx", "ave_prog_%4yr_%3dy","all",.true.,"none",2 +#"ocean_model","S_ady", "S_ady", "ave_prog_%4yr_%3dy","all",.true.,"none",2 +#"ocean_model","S_diffx","S_diffx","ave_prog_%4yr_%3dy","all",.true.,"none",2 +#"ocean_model","S_diffy","S_diffy","ave_prog_%4yr_%3dy","all",.true.,"none",2 + +#============================================================================================= +# +#===- This file can be used with diag_manager/v2.0a (or higher) ==== +# +# +# FORMATS FOR FILE ENTRIES (not all input values are used) +# ------------------------ +# +#"file_name", output_freq, "output_units", format, "time_units", "time_long_name", ... +# (opt) new_file_frequecy, (opt) "new_file_freq_units", "new_file_start_date" +# +# +#output_freq: > 0 output frequency in "output_units" +# = 0 output frequency every time step +# =-1 output frequency at end of run +# +#output_units = units used for output frequency +# (years, months, days, minutes, hours, seconds) +# +#time_units = units used to label the time axis +# (days, minutes, hours, seconds) +# +# +# FORMAT FOR FIELD ENTRIES (not all input values are used) +# ------------------------ +# +#"module_name", "field_name", "output_name", "file_name" "time_sampling", time_avg, "other_opts", packing +# +#time_avg = .true. or .false. +# +#packing = 1 double precision +# = 2 float +# = 4 packed 16-bit integers +# = 8 packed 1-byte (not tested?) diff --git a/.testing/tc1/input.nml b/.testing/tc1/input.nml new file mode 100644 index 0000000000..54b26920b1 --- /dev/null +++ b/.testing/tc1/input.nml @@ -0,0 +1,19 @@ +&mom_input_nml + output_directory = './' + input_filename = 'n' + restart_input_dir = 'INPUT/' + restart_output_dir = 'RESTART/' + parameter_filename = + 'MOM_input', + 'MOM_override', +/ + +&diag_manager_nml +/ + +&fms_nml + clock_grain = 'ROUTINE' + clock_flags = 'SYNC' + domains_stack_size = 955296 + stack_size = 0 +/ diff --git a/.testing/tc2/MOM_input b/.testing/tc2/MOM_input new file mode 100644 index 0000000000..9b36f2675c --- /dev/null +++ b/.testing/tc2/MOM_input @@ -0,0 +1,614 @@ +/* This input file provides the adjustable run-time parameters for version 6 of + the Modular Ocean Model (MOM6), a numerical ocean model developed at NOAA-GFDL. + Where appropriate, parameters use usually given in MKS units. + + This particular file is for the example in benchmark. + + This MOM_input file typically contains only the non-default values that are + needed to reproduce this example. A full list of parameters for this example + can be found in the corresponding MOM_parameter_doc.all file which is + generated by the model at run-time. */ + +!SYMMETRIC_MEMORY_ = False ! [Boolean] + ! If defined, the velocity point data domain includes + ! every face of the thickness points. In other words, + ! some arrays are larger than others, depending on where + ! they are on the staggered grid. Also, the starting + ! index of the velocity-point arrays is usually 0, not 1. + ! This can only be set at compile time. +!STATIC_MEMORY_ = False ! [Boolean] + ! If STATIC_MEMORY_ is defined, the principle variables + ! will have sizes that are statically determined at + ! compile time. Otherwise the sizes are not determined + ! until run time. The STATIC option is substantially + ! faster, but does not allow the PE count to be changed + ! at run time. This can only be set at compile time. +NIHALO = 4 ! default = 2 + ! The number of halo points on each side in the + ! x-direction. With STATIC_MEMORY_ this is set as NIHALO_ + ! in MOM_memory.h at compile time; without STATIC_MEMORY_ + ! the default is NIHALO_ in MOM_memory.h (if defined) or 2. +NJHALO = 4 ! default = 2 + ! The number of halo points on each side in the + ! y-direction. With STATIC_MEMORY_ this is set as NJHALO_ + ! in MOM_memory.h at compile time; without STATIC_MEMORY_ + ! the default is NJHALO_ in MOM_memory.h (if defined) or 2. +NIGLOBAL = 10 ! + ! The total number of thickness grid points in the + ! x-direction in the physical domain. With STATIC_MEMORY_ + ! this is set in MOM_memory.h at compile time. +NJGLOBAL = 8 ! + ! The total number of thickness grid points in the + ! y-direction in the physical domain. With STATIC_MEMORY_ + ! this is set in MOM_memory.h at compile time. +!NIPROC = 12 ! + ! The number of processors in the x-direction. With + ! STATIC_MEMORY_ this is set in MOM_memory.h at compile time. +!NJPROC = 6 ! + ! The number of processors in the x-direction. With + ! STATIC_MEMORY_ this is set in MOM_memory.h at compile time. +!LAYOUT = 12, 6 ! + ! The processor layout that was acutally used. +IO_LAYOUT = 1, 1 ! default = 0 + ! The processor layout to be used, or 0,0 to automatically + ! set the io_layout to be the same as the layout. + +! === module MOM_grid === +! Parameters providing information about the vertical grid. +NK = 8 ! [nondim] + ! The number of model layers. + +USE_REGRIDDING = True ! [Boolean] default = False + ! If True, use the ALE algorithm (regridding/remapping). If False, use the + +! === module MOM_verticalGrid === +! Parameters providing information about the vertical grid. + +! === module MOM === +THICKNESSDIFFUSE = True ! [Boolean] default = False + ! If true, interfaces or isopycnal surfaces are diffused, + ! depending on the value of FULL_THICKNESSDIFFUSE. +THICKNESSDIFFUSE_FIRST = True ! [Boolean] default = False + ! If true, do thickness diffusion before dynamics. + ! This is only used if THICKNESSDIFFUSE is true. +MIXEDLAYER_RESTRAT = True ! [Boolean] default = False + ! If true, a density-gradient dependent re-stratifying + ! flow is imposed in the mixed layer. + ! This is only used if BULKMIXEDLAYER is true. +DT = 3600.0 ! [s] + ! The (baroclinic) dynamics time step. The time-step that + ! is actually used will be an integer fraction of the + ! forcing time-step (DT_FORCING in ocean-only mode or the + ! coupling timestep in coupled mode.) +DT_THERM = 7200.0 ! [s] default = 900.0 + ! 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. + ! By default DT_THERM is set to DT. +DTBT_RESET_PERIOD = -.98 ! [s] default = 3600.0 + ! The period between recalculations of DTBT (if DTBT <= 0). + ! If DTBT_RESET_PERIOD is negative, DTBT is set based + ! only on information available at initialization. If + ! dynamic, DTBT will be set at least every forcing time + ! step, and if 0, every dynamics time step. The default is + ! set by DT_THERM. This is only used if SPLIT is true. +FRAZIL = True ! [Boolean] default = False + ! If true, water freezes if it gets too cold, and the + ! the accumulated heat deficit is returned in the + ! surface state. FRAZIL is only used if + ! ENABLE_THERMODYNAMICS is true. +C_P = 3925.0 ! [J kg-1 K-1] default = 3991.86795711963 + ! The heat capacity of sea water, approximated as a + ! constant. This is only used if ENABLE_THERMODYNAMICS is + ! true. The default value is from the TEOS-10 definition + ! of conservative temperature. +SAVE_INITIAL_CONDS = True ! [Boolean] default = False + ! If true, write the initial conditions to a file given + ! by IC_OUTPUT_FILE. +IC_OUTPUT_FILE = "GOLD_IC" ! default = "MOM_IC" + ! The file into which to write the initial conditions. + +! === module MOM_tracer_registry === + +! === module MOM_tracer_flow_control === +USE_IDEAL_AGE_TRACER = True ! [Boolean] default = False + ! If true, use the ideal_age_example tracer package. + +! === module ideal_age_example === +INPUTDIR = "INPUT" ! default = "." + ! The directory in which input files are found. +COORD_CONFIG = "ALE" ! + ! This specifies how layers are to be defined: + ! file - read coordinate information from the file + ! specified by (COORD_FILE). + ! linear - linear based on interfaces not layesrs. + ! ts_ref - use reference temperature and salinity + ! ts_range - use range of temperature and salinity + ! (T_REF and S_REF) to determine surface density + ! and GINT calculate internal densities. + ! gprime - use reference density (RHO_0) for surface + ! density and GINT calculate internal densities. + ! ts_profile - use temperature and salinity profiles + ! (read from COORD_FILE) to set layer densities. + ! USER - call a user modified routine. +REGRIDDING_COORDINATE_MODE = "Z*" ! default = "LAYER" + ! Coordinate mode for vertical regridding. Choose among the following + ! possibilities: LAYER - Isopycnal or stacked shallow water layers + ! ZSTAR, Z* - stretched geopotential z* + ! SIGMA_SHELF_ZSTAR - stretched geopotential z* ignoring shelf + ! SIGMA - terrain following coordinates + ! RHO - continuous isopycnal + ! HYCOM1 - HyCOM-like hybrid coordinate + ! SLIGHT - stretched coordinates above continuous isopycnal + ! ADAPTIVE - optimize for smooth neutral density surfaces +REMAPPING_SCHEME = "PPM_IH4" ! default = "PLM" + ! This sets the reconstruction scheme used for vertical remapping for all + ! variables. It can be one of the following schemes: PCM (1st-order + ! accurate) + ! PLM (2nd-order accurate) + ! PPM_H4 (3rd-order accurate) + ! PPM_IH4 (3rd-order accurate) + ! PQM_IH4IH3 (4th-order accurate) + ! PQM_IH6IH5 (5th-order accurate) + +! === module MOM_grid_init === +GRID_CONFIG = "spherical" ! + ! A character string that determines the method for + ! defining the horizontal grid. Current options are: + ! mosaic - read the grid from a mosaic (supergrid) + ! file set by GRID_FILE. + ! cartesian - use a (flat) Cartesian grid. + ! spherical - use a simple spherical grid. + ! mercator - use a Mercator spherical grid. +SOUTHLAT = -21.0 ! [degrees] + ! The southern latitude of the domain. +LENLAT = 42.0 ! [degrees] + ! The latitudinal length of the domain. +LENLON = 90.0 ! [degrees] + ! The longitudinal length of the domain. +TOPO_CONFIG = "halfpipe" ! + ! This specifies how bathymetry is specified: + ! file - read bathymetric information from the file + ! specified by (TOPO_FILE). + ! flat - flat bottom set to MAXIMUM_DEPTH. + ! bowl - an analytically specified bowl-shaped basin + ! ranging between MAXIMUM_DEPTH and MINIMUM_DEPTH. + ! spoon - a similar shape to 'bowl', but with an vertical + ! wall at the southern face. + ! halfpipe - a zonally uniform channel with a half-sine + ! profile in the meridional direction. + ! benchmark - use the benchmark test case topography. + ! DOME - use a slope and channel configuration for the + ! DOME sill-overflow test case. + ! DOME2D - use a shelf and slope configuration for the + ! DOME2D gravity current/overflow test case. + ! seamount - Gaussian bump for spontaneous motion test case. + ! USER - call a user modified routine. + +! === module benchmark_initialize_topography === +MINIMUM_DEPTH = 1.0 ! [m] default = 0.0 + ! The minimum depth of the ocean. +MAXIMUM_DEPTH = 4500.0 ! [m] + ! The maximum depth of the ocean. +THICKNESS_CONFIG = "uniform" ! + ! A string that determines how the initial layer + ! thicknesses are specified for a new run: + ! file - read interface heights from the file specified + ! thickness_file - read thicknesses from the file specified + ! by (THICKNESS_FILE). + ! uniform - uniform thickness layers evenly distributed + ! between the surface and MAXIMUM_DEPTH. + ! DOME - use a slope and channel configuration for the + ! DOME sill-overflow test case. + ! benchmark - use the benchmark test case thicknesses. + ! search - search a density profile for the interface + ! densities. This is not yet implemented. + ! circle_obcs - the circle_obcs test case is used. + ! DOME2D - 2D version of DOME initialization. + ! adjustment2d - TBD AJA. + ! sloshing - TBD AJA. + ! seamount - TBD AJA. + ! USER - call a user modified routine. +TS_CONFIG = "benchmark" ! + ! A string that determines how the initial tempertures + ! and salinities are specified for a new run: + ! file - read velocities from the file specified + ! by (TS_FILE). + ! fit - find the temperatures that are consistent with + ! the layer densities and salinity S_REF. + ! TS_profile - use temperature and salinity profiles + ! (read from TS_FILE) to set layer densities. + ! benchmark - use the benchmark test case T & S. + ! linear - linear in logical layer space. + ! DOME2D - 2D DOME initialization. + ! adjustment2d - TBD AJA. + ! sloshing - TBD AJA. + ! seamount - TBD AJA. + ! USER - call a user modified routine. + +! === module MOM_MEKE === +USE_MEKE = True ! [Boolean] default = False + ! If true, turns on the MEKE scheme which calculates a sub-grid mesoscale eddy + ! kinetic energy budget. +MEKE_GMCOEFF = 1.0 ! [nondim] default = -1.0 + ! The efficiency of the conversion of potential energy into MEKE by the + ! thickness mixing parameterization. If MEKE_GMCOEFF is negative, this + ! conversion is not used or calculated. +MEKE_BGSRC = 1.0E-13 ! [W kg-1] default = 0.0 + ! A background energy source for MEKE. +MEKE_KHTH_FAC = 0.5 ! [nondim] default = 0.0 + ! A factor that maps MEKE%Kh to KhTh. +MEKE_KHTR_FAC = 0.5 ! [nondim] default = 0.0 + ! A factor that maps MEKE%Kh to KhTr. +MEKE_KHMEKE_FAC = 1.0 ! [nondim] default = 0.0 + ! A factor that maps MEKE%Kh to Kh for MEKE itself. +MEKE_VISCOSITY_COEFF_KU = 1.0 ! [nondim] default = 0.0 + ! If non-zero, is the scaling coefficient in the expression forviscosity used to + ! parameterize harmonic lateral momentum mixing byunresolved eddies represented + ! by MEKE. Can be negative torepresent backscatter from the unresolved eddies. +MEKE_ALPHA_RHINES = 0.15 ! [nondim] default = 0.05 + ! If positive, is a coefficient weighting the Rhines scale in the expression for + ! mixing length used in MEKE-derived diffusivity. +MEKE_ALPHA_EADY = 0.15 ! [nondim] default = 0.05 + ! If positive, is a coefficient weighting the Eady length scale in the + ! expression for mixing length used in MEKE-derived diffusivity. + +! === module MOM_lateral_mixing_coeffs === +USE_VARIABLE_MIXING = True ! [Boolean] default = False + ! If true, the variable mixing code will be called. This + ! allows diagnostics to be created even if the scheme is + ! not used. If KHTR_SLOPE_CFF>0 or KhTh_Slope_Cff>0, + ! this is set to true regardless of what is in the + ! parameter file. +USE_VISBECK = False ! [Boolean] default = False + ! If true, use the Visbeck et al. (1997) formulation for + ! thickness diffusivity. +RESOLN_SCALED_KH = False ! [Boolean] default = False + ! If true, the Laplacian lateral viscosity is scaled away + ! when the first baroclinic deformation radius is well + ! resolved. +RESOLN_SCALED_KHTH = False ! [Boolean] default = False + ! If true, the interface depth diffusivity is scaled away + ! when the first baroclinic deformation radius is well + ! resolved. +RESOLN_SCALED_KHTR = False ! [Boolean] default = False + ! If true, the epipycnal tracer diffusivity is scaled + ! away when the first baroclinic deformation radius is + ! well resolved. +USE_STORED_SLOPES = True ! [Boolean] default = False + ! If true, the isopycnal slopes are calculated once and stored for re-use. This + ! uses more memory but avoids calling the equation of state more times than + +! === module MOM_wave_speed === +ETA_TOLERANCE = 1.0E-06 ! [m] default = 1.1E-09 + ! The tolerance for the differences between the + ! barotropic and baroclinic estimates of the sea surface + ! height due to the fluxes through each face. The total + ! tolerance for SSH is 4 times this value. The default + ! is 0.5*NK*ANGSTROM, and this should not be set less x + ! than about 10^-15*MAXIMUM_DEPTH. +VELOCITY_TOLERANCE = 0.001 ! [m s-1] default = 3.0E+08 + ! The tolerance for barotropic velocity discrepancies + ! between the barotropic solution and the sum of the + ! layer thicknesses. +BOUND_CORIOLIS = True ! [Boolean] default = False + ! If true, the Coriolis terms at u-points are bounded by + ! the four estimates of (f+rv)v from the four neighboring + ! v-points, and similarly at v-points. This option would + ! have no effect on the SADOURNY Coriolis scheme if it + ! were possible to use centered difference thickness fluxes. + +! === module MOM_hor_visc === +LAPLACIAN = True +KH_VEL_SCALE = 0.05 +SMAGORINSKY_KH = True ! [Boolean] default = False +SMAG_LAP_CONST = 0.06 ! [nondim] default = 0.0 +AH_VEL_SCALE = 0.05 ! [m s-1] default = 0.0 + ! The velocity scale which is multiplied by the cube of + ! the grid spacing to calculate the Laplacian viscosity. + ! The final viscosity is the largest of this scaled + ! viscosity, the Smagorinsky viscosity and AH. +SMAGORINSKY_AH = True ! [Boolean] default = False + ! If true, use a biharmonic Smagorinsky nonlinear eddy + ! viscosity. +SMAG_BI_CONST = 0.06 ! [nondim] default = 0.0 + ! The nondimensional biharmonic Smagorinsky constant, + ! typically 0.015 - 0.06. + +! === module MOM_vert_friction === +ENERGETICS_SFC_PBL = True +DO_GEOTHERMAL = True +GEOTHERMAL_SCALE = 0.05 +TIDES = True +TIDE_M2 = True +TIDE_S2 = True +TIDE_N2 = True +TIDE_K2 = True +TIDE_K1 = True +TIDE_O1 = True +TIDE_P1 = True +TIDE_Q1 = True +TIDE_MF = True +TIDE_MM = True +TIDE_SAL_SCALAR_VALUE = 1. +USE_NEUTRAL_DIFFUSION = True +DYNAMIC_VISCOUS_ML = True ! [Boolean] default = False + ! If true, use a bulk Richardson number criterion to + ! determine the mixed layer thickness for viscosity. +U_TRUNC_FILE = "U_velocity_truncations" ! default = "" + ! The absolute path to a file into which the accelerations + ! leading to zonal velocity truncations are written. + ! Undefine this for efficiency if this diagnostic is not + ! needed. +V_TRUNC_FILE = "V_velocity_truncations" ! default = "" + ! The absolute path to a file into which the accelerations + ! leading to meridional velocity truncations are written. + ! Undefine this for efficiency if this diagnostic is not + ! needed. +KV = 1.0E-04 ! [m2 s-1] + ! The background kinematic viscosity in the interior. + ! The molecular value, ~1e-6 m2 s-1, may be used. +HMIX_FIXED = 0.5 ! [m] + ! The prescribed depth over which the near-surface viscosity and diffusivity are + ! elevated when the bulk mixed layer is not used. +CHANNEL_DRAG = True ! [Boolean] default = False +HBBL = 10.0 ! [m] + ! The thickness of a bottom boundary layer with a + ! viscosity of KVBBL if BOTTOMDRAGLAW is not defined, or + ! the thickness over which near-bottom velocities are + ! averaged for the drag law if BOTTOMDRAGLAW is defined + ! but LINEAR_DRAG is not. +MAXVEL = 10.0 ! [m s-1] default = 3.0E+08 + ! The maximum velocity allowed before the velocity + ! components are truncated. + +! === module MOM_PointAccel === + +! === module MOM_set_visc === +USE_JACKSON_PARAM = True ! [Boolean] default = False + ! If true, use the Jackson-Hallberg-Legg (JPO 2008) + ! shear mixing parameterization. +ML_OMEGA_FRAC = 1.0 ! [nondim] default = 0.0 + ! 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). +DRAG_BG_VEL = 0.1 ! [m s-1] default = 0.0 + ! 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. DRAG_BG_VEL is only used when + ! BOTTOMDRAGLAW is defined. +BBL_THICK_MIN = 0.1 ! [m] default = 0.0 + ! The minimum bottom boundary layer thickness that can be + ! used with BOTTOMDRAGLAW. This might be + ! Kv / (cdrag * drag_bg_vel) to give Kv as the minimum + ! near-bottom viscosity. + +! === module MOM_barotropic === +BOUND_BT_CORRECTION = True ! [Boolean] default = False + ! If true, the corrective pseudo mass-fluxes into the + ! barotropic solver are limited to values that require + ! less than 0.1*MAXVEL to be accommodated. +!BT x-halo = 0 ! + ! The barotropic x-halo size that is actually used. +!BT y-halo = 0 ! + ! The barotropic y-halo size that is actually used. +NONLINEAR_BT_CONTINUITY = True ! [Boolean] default = False + ! If true, use nonlinear transports in the barotropic + ! continuity equation. This does not apply if + ! USE_BT_CONT_TYPE is true. +BT_PROJECT_VELOCITY = True ! [Boolean] default = False + ! If true, step the barotropic velocity first and project + ! out the velocity tendancy by 1+BEBT when calculating the + ! transport. The default (false) is to use a predictor + ! continuity step to find the pressure field, and then + ! to do a corrector continuity step using a weighted + ! average of the old and new velocities, with weights + ! of (1-BEBT) and BEBT. +BT_THICK_SCHEME = "FROM_BT_CONT" ! default = "HYBRID" + ! A string describing the scheme that is used to set the + ! open face areas used for barotropic transport and the + ! relative weights of the accelerations. Valid values are: + ! ARITHMETIC - arithmetic mean layer thicknesses + ! HARMONIC - harmonic mean layer thicknesses + ! HYBRID (the default) - use arithmetic means for + ! layers above the shallowest bottom, the harmonic + ! mean for layers below, and a weighted average for + ! layers that straddle that depth + ! FROM_BT_CONT - use the average thicknesses kept + ! in the h_u and h_v fields of the BT_cont_type +BEBT = 0.2 ! [nondim] default = 0.1 + ! BEBT determines whether the barotropic time stepping + ! uses the forward-backward time-stepping scheme or a + ! backward Euler scheme. BEBT is valid in the range from + ! 0 (for a forward-backward treatment of nonrotating + ! gravity waves) to 1 (for a backward Euler treatment). + ! In practice, BEBT must be greater than about 0.05. +DTBT = -0.95 ! [s or nondim] default = -0.98 + ! The barotropic time step, in s. DTBT is only used with + ! the split explicit time stepping. To set the time step + ! automatically based the maximum stable value use 0, or + ! a negative value gives the fraction of the stable value. + ! Setting DTBT to 0 is the same as setting it to -0.98. + ! The value of DTBT that will actually be used is an + ! integer fraction of DT, rounding down. + +! === module MOM_thickness_diffuse === +KHTH = 1.0 ! [m2 s-1] default = 0.0 + ! The background horizontal thickness diffusivity. +KHTH_MAX = 900.0 ! [m2 s-1] default = 0.0 + ! The maximum horizontal thickness diffusivity. + +! === module MOM_mixed_layer_restrat === +FOX_KEMPER_ML_RESTRAT_COEF = 5.0 ! [nondim] default = 0.0 + ! A nondimensional coefficient that is proportional to + ! the ratio of the deformation radius to the dominant + ! lengthscale of the submesoscale mixed layer + ! instabilities, times the minimum of the ratio of the + ! mesoscale eddy kinetic energy to the large-scale + ! geostrophic kinetic energy or 1 plus the square of the + ! grid spacing over the deformation radius, as detailed + ! by Fox-Kemper et al. (2010) + +! === module MOM_diabatic_driver === +! The following parameters are used for diabatic processes. +RECLAIM_FRAZIL = False ! [Boolean] default = True + ! If true, try to use any frazil heat deficit to cool any + ! overlying layers down to the freezing point, thereby + ! avoiding the creation of thin ice when the SST is above + ! the freezing point. +KD = 2.0E-05 ! [m2 s-1] + ! The background diapycnal diffusivity of density in the + ! interior. Zero or the molecular value, ~1e-7 m2 s-1, + ! may be used. + +! === module MOM_KPP === +! This is the MOM wrapper to CVmix:KPP +! See http://code.google.com/p/cvmix/ +KPP% +%KPP + +! === module MOM_diffConvection === +! This module implements enhanced diffusivity as a +! function of static stability, N^2. +CONVECTION% +%CONVECTION + +! === module MOM_entrain_diffusive === +MAX_ENT_IT = 20 ! default = 5 + ! The maximum number of iterations that may be used to + ! calculate the interior diapycnal entrainment. +TOLERANCE_ENT = 1.0E-05 ! [m] default = 1.341640786499874E-05 + ! The tolerance with which to solve for entrainment values. + +! === module MOM_kappa_shear === +MAX_RINO_IT = 25 ! [nondim] default = 50 + ! The maximum number of iterations that may be used to + ! estimate the Richardson number driven mixing. + +! === module MOM_mixed_layer === +BULK_RI_ML = 0.05 ! [nondim] + ! The efficiency with which mean kinetic energy released + ! by mechanically forced entrainment of the mixed layer + ! is converted to turbulent kinetic energy. +ABSORB_ALL_SW = True ! [Boolean] default = False + ! If true, all shortwave radiation is absorbed by the + ! ocean, instead of passing through to the bottom mud. +MSTAR = 0.3 ! [units=nondim] default = 1.2 + ! The ratio of the friction velocity cubed to the TKE + ! input to the mixed layer. +TKE_DECAY = 10.0 ! [nondim] default = 2.5 + ! TKE_DECAY relates the vertical rate of decay of the + ! TKE available for mechanical entrainment to the natural + ! Ekman depth. +HMIX_MIN = 2.0 ! [m] default = 0.0 + ! The minimum mixed layer depth if the mixed layer depth + ! is determined dynamically. +LIMIT_BUFFER_DETRAIN = True ! [Boolean] default = False + ! If true, limit the detrainment from the buffer layers + ! to not be too different from the neighbors. +DEPTH_LIMIT_FLUXES = 0.1 ! [m] default = 0.2 + ! The surface fluxes are scaled away when the total ocean + ! depth is less than DEPTH_LIMIT_FLUXES. +CORRECT_ABSORPTION_DEPTH = True ! [Boolean] default = False + ! If true, the depth at which penetrating shortwave + ! radiation is absorbed is corrected by moving some of + ! the heating upward in the water column. + +! === module MOM_regularize_layers === + +! === module MOM_opacity === +PEN_SW_SCALE = 15.0 ! [m] default = 0.0 + ! The vertical absorption e-folding depth of the + ! penetrating shortwave radiation. +PEN_SW_FRAC = 0.42 ! [nondim] default = 0.0 + ! The fraction of the shortwave radiation that penetrates + ! below the surface. + +! === module MOM_tracer_advect === + +! === module MOM_tracer_hor_diff === +KHTR = 1.0 ! [m2 s-1] default = 0.0 + ! The background along-isopycnal tracer diffusivity. +KHTR_MAX = 900.0 ! [m2 s-1] default = 0.0 + ! The maximum along-isopycnal tracer diffusivity. +ML_KHTR_SCALE = 0.0 ! [nondim] default = 1.0 + ! With Diffuse_ML_interior, the ratio of the truly + ! horizontal diffusivity in the mixed layer to the + ! epipycnal diffusivity. The valid range is 0 to 1. + +! === module MOM_surface_forcing === +BUOY_CONFIG = "linear" ! + ! The character string that indicates how buoyancy forcing + ! is specified. Valid options include (file), (zero), + ! (linear), (USER), and (NONE). +WIND_CONFIG = "gyres" ! + ! The character string that indicates how wind forcing + ! is specified. Valid options include (file), (2gyre), + ! (1gyre), (gyres), (zero), and (USER). +TAUX_SIN_AMP = 0.1 ! [Pa] default = 0.0 + ! With the gyres wind_config, the sine amplitude in the + ! zonal wind stress profile: + ! B in taux = A + B*sin(n*pi*y/L) + C*cos(n*pi*y/L). +TAUX_N_PIS = 1.0 ! [nondim] default = 0.0 + ! With the gyres wind_config, the number of gyres in + ! the zonal wind stress profile: + ! n in taux = A + B*sin(n*pi*y/L) + C*cos(n*pi*y/L). +RESTOREBUOY = True ! [Boolean] default = False + ! If true, the buoyancy fluxes drive the model back + ! toward some specified surface state with a rate + ! given by FLUXCONST. +FLUXCONST = 0.5 ! [m day-1] + ! The constant that relates the restoring surface fluxes + ! to the relative surface anomalies (akin to a piston + ! velocity). Note the non-MKS units. +SST_NORTH = 27.0 ! [deg C] default = 0.0 + ! With buoy_config linear, the sea surface temperature + ! at the northern end of the domain toward which to + ! to restore. +SST_SOUTH = 3.0 ! [deg C] default = 0.0 + ! With buoy_config linear, the sea surface temperature + ! at the southern end of the domain toward which to + ! to restore. + +! === module MOM_sum_output === +MAXTRUNC = 5000 ! [truncations save_interval-1] default = 0 + ! The run will be stopped, and the day set to a very + ! large value if the velocity is truncated more than + ! MAXTRUNC times between energy saves. Set MAXTRUNC to 0 + ! to stop if there is any truncation of velocities. +MAXCPU = 2.88E+04 ! [wall-clock seconds] default = -1.0 + ! The maximum amount of cpu time per processor for which + ! MOM should run before saving a restart file and + ! quitting with a return value that indicates that a + ! further run is required to complete the simulation. + ! If automatic restarts are not desired, use a negative + ! value for MAXCPU. MAXCPU has units of wall-clock + ! seconds, so the actual CPU time used is larger by a + ! factor of the number of processors used. + +! === module MOM_main (MOM_driver) === +DT_FORCING = 10800.0 ! [s] default = 900.0 + ! The time step for changing forcing, coupling with other + ! components, or potentially writing certain diagnostics. + ! The default value is given by DT. +DAYMAX = 1.0 ! [days] + ! The final time of the whole simulation, in units of + ! TIMEUNIT seconds. This also sets the potential end + ! time of the present run segment if the end time is + ! not set (as it was here) via ocean_solo_nml in input.nml. +RESTART_CONTROL = 3 ! default = 1 + ! 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 non-time-stamped + ! restart file is saved at the end of the run segment + ! for any non-negative value. +RESTINT = 365.0 ! [days] default = 0.0 + ! The interval between saves of the restart file in units + ! of TIMEUNIT. Use 0 (the default) to not save + ! incremental restart files at all. +ENERGYSAVEDAYS = 0.5 ! [days] default = 3600.0 + ! The interval in units of TIMEUNIT between saves of the + ! energies of the run and other globally summed diagnostics. +DIAG_AS_CHKSUM = True +DEBUG = True diff --git a/.testing/tc2/MOM_override b/.testing/tc2/MOM_override new file mode 100644 index 0000000000..e69de29bb2 diff --git a/.testing/tc2/diag_table b/.testing/tc2/diag_table new file mode 100644 index 0000000000..19d6a32e1e --- /dev/null +++ b/.testing/tc2/diag_table @@ -0,0 +1,86 @@ +"MOM benchmark Experiment" +1 1 1 0 0 0 +"prog", 1,"days",1,"days","time", +#"ave_prog", 5,"days",1,"days","Time",365,"days" +#"cont", 5,"days",1,"days","Time",365,"days" + +#This is the field section of the diag_table. + +# Prognostic Ocean fields: +#========================= + +"ocean_model","u","u","prog","all",.false.,"none",2 +"ocean_model","v","v","prog","all",.false.,"none",2 +"ocean_model","h","h","prog","all",.false.,"none",1 +"ocean_model","e","e","prog","all",.false.,"none",2 +"ocean_model","temp","temp","prog","all",.false.,"none",2 +#"ocean_model","salt","salt","prog","all",.false.,"none",2 + +#"ocean_model","u","u","ave_prog_%4yr_%3dy","all",.true.,"none",2 +#"ocean_model","v","v","ave_prog_%4yr_%3dy","all",.true.,"none",2 +#"ocean_model","h","h","ave_prog_%4yr_%3dy","all",.true.,"none",1 +#"ocean_model","e","e","ave_prog_%4yr_%3dy","all",.true.,"none",2 + +# Auxilary Tracers: +#================== +#"ocean_model","vintage","vintage","prog_%4yr_%3dy","all",.false.,"none",2 +#"ocean_model","age","age","prog_%4yr_%3dy","all",.false.,"none",2 + +# Continuity Equation Terms: +#=========================== +#"ocean_model","dhdt","dhdt","cont_%4yr_%3dy","all",.true.,"none",2 +#"ocean_model","wd","wd","cont_%4yr_%3dy","all",.true.,"none",2 +#"ocean_model","uh","uh","cont_%4yr_%3dy","all",.true.,"none",2 +#"ocean_model","vh","vh","cont_%4yr_%3dy","all",.true.,"none",2 +#"ocean_model","h_rho","h_rho","cont_%4yr_%3dy","all",.true.,"none",2 +#"ocean_model","uh_rho","uh_rho","cont_%4yr_%3dy","all",.true.,"none",2 +#"ocean_model","vh_rho","vh_rho","cont_%4yr_%3dy","all",.true.,"none",2 +#"ocean_model","uhGM_rho","uhGM_rho","cont_%4yr_%3dy","all",.true.,"none",2 +#"ocean_model","vhGM_rho","vhGM_rho","cont_%4yr_%3dy","all",.true.,"none",2 + +# +# Tracer Fluxes: +#================== +#"ocean_model","T_adx", "T_adx", "ave_prog_%4yr_%3dy","all",.true.,"none",2 +#"ocean_model","T_ady", "T_ady", "ave_prog_%4yr_%3dy","all",.true.,"none",2 +#"ocean_model","T_diffx","T_diffx","ave_prog_%4yr_%3dy","all",.true.,"none",2 +#"ocean_model","T_diffy","T_diffy","ave_prog_%4yr_%3dy","all",.true.,"none",2 +#"ocean_model","S_adx", "S_adx", "ave_prog_%4yr_%3dy","all",.true.,"none",2 +#"ocean_model","S_ady", "S_ady", "ave_prog_%4yr_%3dy","all",.true.,"none",2 +#"ocean_model","S_diffx","S_diffx","ave_prog_%4yr_%3dy","all",.true.,"none",2 +#"ocean_model","S_diffy","S_diffy","ave_prog_%4yr_%3dy","all",.true.,"none",2 + +#============================================================================================= +# +#===- This file can be used with diag_manager/v2.0a (or higher) ==== +# +# +# FORMATS FOR FILE ENTRIES (not all input values are used) +# ------------------------ +# +#"file_name", output_freq, "output_units", format, "time_units", "time_long_name", ... +# (opt) new_file_frequecy, (opt) "new_file_freq_units", "new_file_start_date" +# +# +#output_freq: > 0 output frequency in "output_units" +# = 0 output frequency every time step +# =-1 output frequency at end of run +# +#output_units = units used for output frequency +# (years, months, days, minutes, hours, seconds) +# +#time_units = units used to label the time axis +# (days, minutes, hours, seconds) +# +# +# FORMAT FOR FIELD ENTRIES (not all input values are used) +# ------------------------ +# +#"module_name", "field_name", "output_name", "file_name" "time_sampling", time_avg, "other_opts", packing +# +#time_avg = .true. or .false. +# +#packing = 1 double precision +# = 2 float +# = 4 packed 16-bit integers +# = 8 packed 1-byte (not tested?) diff --git a/.testing/tc2/input.nml b/.testing/tc2/input.nml new file mode 100644 index 0000000000..54b26920b1 --- /dev/null +++ b/.testing/tc2/input.nml @@ -0,0 +1,19 @@ +&mom_input_nml + output_directory = './' + input_filename = 'n' + restart_input_dir = 'INPUT/' + restart_output_dir = 'RESTART/' + parameter_filename = + 'MOM_input', + 'MOM_override', +/ + +&diag_manager_nml +/ + +&fms_nml + clock_grain = 'ROUTINE' + clock_flags = 'SYNC' + domains_stack_size = 955296 + stack_size = 0 +/ diff --git a/.testing/tc3/MOM_input b/.testing/tc3/MOM_input new file mode 100644 index 0000000000..1689ef993e --- /dev/null +++ b/.testing/tc3/MOM_input @@ -0,0 +1,471 @@ +/* This input file provides the adjustable run-time parameters for version 6 of + the Modular Ocean Model (MOM6), a numerical ocean model developed at NOAA-GFDL. + Where appropriate, parameters use usually given in MKS units. + + This particular file is for the example in circle_obcs. + + This MOM_input file typically contains only the non-default values that are + needed to reproduce this example. A full list of parameters for this example + can be found in the corresponding MOM_parameter_doc.all file which is + generated by the model at run-time. */ + +REENTRANT_X = False ! [Boolean] default = True + ! If true, the domain is zonally reentrant. +!SYMMETRIC_MEMORY_ = True ! [Boolean] + ! If defined, the velocity point data domain includes + ! every face of the thickness points. In other words, + ! some arrays are larger than others, depending on where + ! they are on the staggered grid. Also, the starting + ! index of the velocity-point arrays is usually 0, not 1. + ! This can only be set at compile time. +!STATIC_MEMORY_ = False ! [Boolean] + ! If STATIC_MEMORY_ is defined, the principle variables + ! will have sizes that are statically determined at + ! compile time. Otherwise the sizes are not determined + ! until run time. The STATIC option is substantially + ! faster, but does not allow the PE count to be changed + ! at run time. This can only be set at compile time. +NIHALO = 4 ! default = 2 + ! The number of halo points on each side in the + ! x-direction. With STATIC_MEMORY_ this is set as NIHALO_ + ! in MOM_memory.h at compile time; without STATIC_MEMORY_ + ! the default is NIHALO_ in MOM_memory.h (if defined) or 2. +NJHALO = 4 ! default = 2 + ! The number of halo points on each side in the + ! y-direction. With STATIC_MEMORY_ this is set as NJHALO_ + ! in MOM_memory.h at compile time; without STATIC_MEMORY_ + ! the default is NJHALO_ in MOM_memory.h (if defined) or 2. +NIGLOBAL = 25 ! + ! The total number of thickness grid points in the + ! x-direction in the physical domain. With STATIC_MEMORY_ + ! this is set in MOM_memory.h at compile time. +NJGLOBAL = 25 ! + ! The total number of thickness grid points in the + ! y-direction in the physical domain. With STATIC_MEMORY_ + ! this is set in MOM_memory.h at compile time. +!NIPROC = 1 ! + ! The number of processors in the x-direction. With + ! STATIC_MEMORY_ this is set in MOM_memory.h at compile time. +!NJPROC = 2 ! + ! The number of processors in the x-direction. With + ! STATIC_MEMORY_ this is set in MOM_memory.h at compile time. +!LAYOUT = 1, 2 ! + ! The processor layout that was acutally used. +IO_LAYOUT = 1, 1 ! default = 0 + ! The processor layout to be used, or 0,0 to automatically + ! set the io_layout to be the same as the layout. + +! === module MOM_grid === +! Parameters providing information about the vertical grid. +RHO_0 = 1031.0 ! [kg m-3] default = 1035.0 + ! 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. +NK = 10 ! [nondim] + ! The number of model layers. + +! === module MOM_verticalGrid === +! Parameters providing information about the vertical grid. + +! === module MOM === +ENABLE_THERMODYNAMICS = False ! [Boolean] default = True + ! If true, Temperature and salinity are used as state + ! variables. +DT = 120.0 ! [s] + ! The (baroclinic) dynamics time step. The time-step that + ! is actually used will be an integer fraction of the + ! forcing time-step (DT_FORCING in ocean-only mode or the + ! coupling timestep in coupled mode.) +DTBT_RESET_PERIOD = -1.0 ! [s] default = 120.0 + ! The period between recalculations of DTBT (if DTBT <= 0). + ! If DTBT_RESET_PERIOD is negative, DTBT is set based + ! only on information available at initialization. If + ! dynamic, DTBT will be set at least every forcing time + ! step, and if 0, every dynamics time step. The default is + ! set by DT_THERM. This is only used if SPLIT is true. +SAVE_INITIAL_CONDS = True ! [Boolean] default = False + ! If true, write the initial conditions to a file given + ! by IC_OUTPUT_FILE. +IC_OUTPUT_FILE = "GOLD_IC" ! default = "MOM_IC" + ! The file into which to write the initial conditions. + +! === module MOM_tracer_registry === + +! === module MOM_tracer_flow_control === +USE_DOME_TRACER = True ! [Boolean] default = False + ! If true, use the DOME_tracer tracer package. + +! === module DOME_tracer === +INPUTDIR = "INPUT" ! default = "." + ! The directory in which input files are found. +COORD_CONFIG = "layer_ref" ! + ! This specifies how layers are to be defined: + ! file - read coordinate information from the file + ! specified by (COORD_FILE). + ! linear - linear based on interfaces not layesrs. + ! ts_ref - use reference temperature and salinity + ! ts_range - use range of temperature and salinity + ! (T_REF and S_REF) to determine surface density + ! and GINT calculate internal densities. + ! gprime - use reference density (RHO_0) for surface + ! density and GINT calculate internal densities. + ! ts_profile - use temperature and salinity profiles + ! (read from COORD_FILE) to set layer densities. + ! USER - call a user modified routine. +LIGHTEST_DENSITY = 1030.0 ! [kg m-3] default = 1031.0 + ! The reference potential density used for layer 1. + +! === module MOM_grid_init === +GRID_CONFIG = "cartesian" ! + ! A character string that determines the method for + ! defining the horizontal grid. Current options are: + ! mosaic - read the grid from a mosaic (supergrid) + ! file set by GRID_FILE. + ! cartesian - use a (flat) Cartesian grid. + ! spherical - use a simple spherical grid. + ! mercator - use a Mercator spherical grid. +AXIS_UNITS = "k" ! default = "degrees" + ! The units for the Cartesian axes. Valid entries are: + ! degrees - degrees of latitude and longitude + ! m - meters + ! k - kilometers +SOUTHLAT = 0.0 ! [k] + ! The southern latitude of the domain or the equivalent + ! starting value for the y-axis. +LENLAT = 100.0 ! [k] + ! The latitudinal or y-direction length of the domain. +LENLON = 100.0 ! [k] + ! The longitudinal or x-direction length of the domain. +TOPO_CONFIG = "flat" ! + ! This specifies how bathymetry is specified: + ! file - read bathymetric information from the file + ! specified by (TOPO_FILE). + ! flat - flat bottom set to MAXIMUM_DEPTH. + ! bowl - an analytically specified bowl-shaped basin + ! ranging between MAXIMUM_DEPTH and MINIMUM_DEPTH. + ! spoon - a similar shape to 'bowl', but with an vertical + ! wall at the southern face. + ! halfpipe - a zonally uniform channel with a half-sine + ! profile in the meridional direction. + ! benchmark - use the benchmark test case topography. + ! DOME - use a slope and channel configuration for the + ! DOME sill-overflow test case. + ! DOME2D - use a shelf and slope configuration for the + ! DOME2D gravity current/overflow test case. + ! seamount - Gaussian bump for spontaneous motion test case. + ! USER - call a user modified routine. +MINIMUM_DEPTH = 1.0 ! [m] default = 0.0 + ! The minimum depth of the ocean. +MAXIMUM_DEPTH = 600.0 ! [m] + ! The maximum depth of the ocean. +! === module MOM_open_boundary === +! Controls where open boundaries are located, what kind of boundary condition to impose, and what data to apply, if any. +OBC_NUMBER_OF_SEGMENTS = 4 ! default = 0 + ! The number of open boundary segments. +OBC_FREESLIP_VORTICITY = True ! [Boolean] default = False + ! If true, sets the normal gradient of tangential velocity to + ! zero in the relative vorticity on open boundaries. This cannot + ! be true if OBC_ZERO_VORTICITY is True. +OBC_FREESLIP_STRAIN = True ! [Boolean] default = False + ! If true, sets the normal gradient of tangential velocity to + ! zero in the strain use in the stress tensor on open boundaries. This cannot + ! be true if OBC_ZERO_STRAIN is True. +OBC_ZERO_BIHARMONIC = True ! [Boolean] default = False + ! If true, zeros the Laplacian of flow on open boundaries in the biharmonic + ! viscosity term. +OBC_SEGMENT_001 = "J=N,I=N:0,FLATHER,ORLANSKI" ! + ! Documentation needs to be dynamic????? +OBC_SEGMENT_002 = "J=0,I=0:N,FLATHER,ORLANSKI" ! + ! Documentation needs to be dynamic????? +OBC_SEGMENT_003 = "I=N,J=0:N,FLATHER,ORLANSKI" ! + ! Documentation needs to be dynamic????? +OBC_SEGMENT_004 = "I=0,J=N:0,FLATHER,ORLANSKI" ! + ! Documentation needs to be dynamic????? +OBC_SEGMENT_001_DATA = "U=value:0.0,V=value:0.0,SSH=value:0.0" +OBC_SEGMENT_002_DATA = "U=value:0.0,V=value:0.0,SSH=value:0.0" +OBC_SEGMENT_003_DATA = "U=value:0.0,V=value:0.0,SSH=value:0.0" +OBC_SEGMENT_004_DATA = "U=value:0.0,V=value:0.0,SSH=value:0.0" + +ROTATION = "beta" ! default = "2omegasinlat" + ! This specifies how the Coriolis parameter is specified: + ! 2omegasinlat - Use twice the planetary rotation rate + ! times the sine of latitude. + ! betaplane - Use a beta-plane or f-plane. + ! USER - call a user modified routine. +THICKNESS_CONFIG = "circle_obcs" ! + ! A string that determines how the initial layer + ! thicknesses are specified for a new run: + ! file - read interface heights from the file specified + ! thickness_file - read thicknesses from the file specified + ! by (THICKNESS_FILE). + ! uniform - uniform thickness layers evenly distributed + ! between the surface and MAXIMUM_DEPTH. + ! DOME - use a slope and channel configuration for the + ! DOME sill-overflow test case. + ! benchmark - use the benchmark test case thicknesses. + ! search - search a density profile for the interface + ! densities. This is not yet implemented. + ! circle_obcs - the circle_obcs test case is used. + ! DOME2D - 2D version of DOME initialization. + ! adjustment2d - TBD AJA. + ! sloshing - TBD AJA. + ! seamount - TBD AJA. + ! USER - call a user modified routine. + +! === module circle_obcs_initialize_thickness === +DISK_RADIUS = 24.0 ! [k] + ! The radius of the initially elevated disk in the + ! circle_obcs test case. + +! === module MOM_MEKE === +CDRAG = 0.002 ! [nondim] default = 0.003 + ! CDRAG is the drag coefficient relating the magnitude of + ! the velocity field to the bottom stress. + +! === module MOM_lateral_mixing_coeffs === +BOUND_CORIOLIS = True ! [Boolean] default = False + ! If true, the Coriolis terms at u-points are bounded by + ! the four estimates of (f+rv)v from the four neighboring + ! v-points, and similarly at v-points. This option would + ! have no effect on the SADOURNY Coriolis scheme if it + ! were possible to use centered difference thickness fluxes. + +! === module MOM_hor_visc === +LAPLACIAN = True ! [Boolean] default = False + ! If true, use a Laplacian horizontal viscosity. +KH = 25.0 ! [m2 s-1] default = 0.0 + ! The background Laplacian horizontal viscosity. +KH_VEL_SCALE = 0.003 ! [m s-1] default = 0.0 + ! 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 viscosity and KH. +SMAGORINSKY_KH = True ! [Boolean] default = False + ! If true, use a Smagorinsky nonlinear eddy viscosity. +SMAG_LAP_CONST = 0.15 ! [nondim] default = 0.0 + ! The nondimensional Laplacian Smagorinsky constant, + ! often 0.15. +AH_VEL_SCALE = 0.003 ! [m s-1] default = 0.0 + ! The velocity scale which is multiplied by the cube of + ! the grid spacing to calculate the Laplacian viscosity. + ! The final viscosity is the largest of this scaled + ! viscosity, the Smagorinsky viscosity and AH. +SMAGORINSKY_AH = True ! [Boolean] default = False + ! If true, use a biharmonic Smagorinsky nonlinear eddy + ! viscosity. +SMAG_BI_CONST = 0.06 ! [nondim] default = 0.0 + ! The nondimensional biharmonic Smagorinsky constant, + ! typically 0.015 - 0.06. + +! === module MOM_vert_friction === +DIRECT_STRESS = True ! [Boolean] default = False + ! If true, the wind stress is distributed over the + ! topmost HMIX_STRESS of fluid (like in HYCOM), and KVML + ! may be set to a very small value. +U_TRUNC_FILE = "U_velocity_truncations" ! default = "" + ! The absolute path to a file into which the accelerations + ! leading to zonal velocity truncations are written. + ! Undefine this for efficiency if this diagnostic is not + ! needed. +V_TRUNC_FILE = "V_velocity_truncations" ! default = "" + ! The absolute path to a file into which the accelerations + ! leading to meridional velocity truncations are written. + ! Undefine this for efficiency if this diagnostic is not + ! needed. +HARMONIC_VISC = True ! [Boolean] default = False + ! If true, use the harmonic mean thicknesses for + ! calculating the vertical viscosity. +HMIX_FIXED = 20.0 ! [m] + ! The prescribed depth over which the near-surface + ! viscosity and diffusivity are elevated when the bulk + ! mixed layer is not used. +KV = 1.0E-04 ! [m2 s-1] + ! The background kinematic viscosity in the interior. + ! The molecular value, ~1e-6 m2 s-1, may be used. +KVML = 0.01 ! [m2 s-1] default = 1.0E-04 + ! 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. +HBBL = 10.0 ! [m] + ! The thickness of a bottom boundary layer with a + ! viscosity of KVBBL if BOTTOMDRAGLAW is not defined, or + ! the thickness over which near-bottom velocities are + ! averaged for the drag law if BOTTOMDRAGLAW is defined + ! but LINEAR_DRAG is not. +MAXVEL = 10.0 ! [m s-1] default = 3.0E+08 + ! The maximum velocity allowed before the velocity + ! components are truncated. + +! === module MOM_PointAccel === + +! === module MOM_set_visc === +USE_JACKSON_PARAM = True ! [Boolean] default = False + ! If true, use the Jackson-Hallberg-Legg (JPO 2008) + ! shear mixing parameterization. +DRAG_BG_VEL = 0.05 ! [m s-1] default = 0.0 + ! 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. DRAG_BG_VEL is only used when + ! BOTTOMDRAGLAW is defined. +BBL_THICK_MIN = 0.1 ! [m] default = 0.0 + ! The minimum bottom boundary layer thickness that can be + ! used with BOTTOMDRAGLAW. This might be + ! Kv / (cdrag * drag_bg_vel) to give Kv as the minimum + ! near-bottom viscosity. + +! === module MOM_barotropic === +BOUND_BT_CORRECTION = True ! [Boolean] default = False + ! If true, the corrective pseudo mass-fluxes into the + ! barotropic solver are limited to values that require + ! less than 0.1*MAXVEL to be accommodated. +!BT x-halo = 0 ! + ! The barotropic x-halo size that is actually used. +!BT y-halo = 0 ! + ! The barotropic y-halo size that is actually used. +NONLINEAR_BT_CONTINUITY = True ! [Boolean] default = False + ! If true, use nonlinear transports in the barotropic + ! continuity equation. This does not apply if + ! USE_BT_CONT_TYPE is true. +BT_PROJECT_VELOCITY = True ! [Boolean] default = False + ! If true, step the barotropic velocity first and project + ! out the velocity tendancy by 1+BEBT when calculating the + ! transport. The default (false) is to use a predictor + ! continuity step to find the pressure field, and then + ! to do a corrector continuity step using a weighted + ! average of the old and new velocities, with weights + ! of (1-BEBT) and BEBT. +BT_THICK_SCHEME = "FROM_BT_CONT" ! default = "HYBRID" + ! A string describing the scheme that is used to set the + ! open face areas used for barotropic transport and the + ! relative weights of the accelerations. Valid values are: + ! ARITHMETIC - arithmetic mean layer thicknesses + ! HARMONIC - harmonic mean layer thicknesses + ! HYBRID (the default) - use arithmetic means for + ! layers above the shallowest bottom, the harmonic + ! mean for layers below, and a weighted average for + ! layers that straddle that depth + ! FROM_BT_CONT - use the average thicknesses kept + ! in the h_u and h_v fields of the BT_cont_type +BT_STRONG_DRAG = False ! [Boolean] default = True + ! If true, use a stronger estimate of the retarding + ! effects of strong bottom drag, by making it implicit + ! with the barotropic time-step instead of implicit with + ! the baroclinic time-step and dividing by the number of + ! barotropic steps. +BEBT = 0.2 ! [nondim] default = 0.1 + ! BEBT determines whether the barotropic time stepping + ! uses the forward-backward time-stepping scheme or a + ! backward Euler scheme. BEBT is valid in the range from + ! 0 (for a forward-backward treatment of nonrotating + ! gravity waves) to 1 (for a backward Euler treatment). + ! In practice, BEBT must be greater than about 0.05. +DTBT = -0.95 ! [s or nondim] default = -0.98 + ! The barotropic time step, in s. DTBT is only used with + ! the split explicit time stepping. To set the time step + ! automatically based the maximum stable value use 0, or + ! a negative value gives the fraction of the stable value. + ! Setting DTBT to 0 is the same as setting it to -0.98. + ! The value of DTBT that will actually be used is an + ! integer fraction of DT, rounding down. + +! === module MOM_thickness_diffuse === + +! === module MOM_diabatic_driver === +! The following parameters are used for diabatic processes. +KD = 1.0E-04 ! [m2 s-1] + ! The background diapycnal diffusivity of density in the + ! interior. Zero or the molecular value, ~1e-7 m2 s-1, + ! may be used. + +! === module MOM_KPP === +! This is the MOM wrapper to CVmix:KPP +! See http://code.google.com/p/cvmix/ +KPP% +%KPP + +! === module MOM_diffConvection === +! This module implements enhanced diffusivity as a +! function of static stability, N^2. +CONVECTION% +%CONVECTION + +! === module MOM_entrain_diffusive === +MAX_ENT_IT = 20 ! default = 5 + ! The maximum number of iterations that may be used to + ! calculate the interior diapycnal entrainment. +TOLERANCE_ENT = 1.0E-05 ! [m] default = 1.095445115010332E-05 + ! The tolerance with which to solve for entrainment values. + +! === module MOM_kappa_shear === +MAX_RINO_IT = 25 ! [nondim] default = 50 + ! The maximum number of iterations that may be used to + ! estimate the Richardson number driven mixing. + +! === module MOM_regularize_layers === + +! === module MOM_tracer_advect === + +! === module MOM_tracer_hor_diff === + +! === module MOM_surface_forcing === +VARIABLE_WINDS = False ! [Boolean] default = True + ! If true, the winds vary in time after the initialization. +VARIABLE_BUOYFORCE = False ! [Boolean] default = True + ! If true, the buoyancy forcing varies in time after the + ! initialization of the model. +BUOY_CONFIG = "zero" ! + ! The character string that indicates how buoyancy forcing + ! is specified. Valid options include (file), (zero), + ! (linear), (USER), and (NONE). +WIND_CONFIG = "zero" ! + ! The character string that indicates how wind forcing + ! is specified. Valid options include (file), (2gyre), + ! (1gyre), (gyres), (zero), and (USER). + +! === module MOM_sum_output === +MAXTRUNC = 10 ! [truncations save_interval-1] default = 0 + ! The run will be stopped, and the day set to a very + ! large value if the velocity is truncated more than + ! MAXTRUNC times between energy saves. Set MAXTRUNC to 0 + ! to stop if there is any truncation of velocities. +DATE_STAMPED_STDOUT = False ! [Boolean] default = True + ! If true, use dates (not times) in messages to stdout +TIMEUNIT = 120.0 ! [s] default = 8.64E+04 + ! The time unit in seconds a number of input fields +MAXCPU = 2.88E+04 ! [wall-clock seconds] default = -1.0 + ! The maximum amount of cpu time per processor for which + ! MOM should run before saving a restart file and + ! quitting with a return value that indicates that a + ! further run is required to complete the simulation. + ! If automatic restarts are not desired, use a negative + ! value for MAXCPU. MAXCPU has units of wall-clock + ! seconds, so the actual CPU time used is larger by a + ! factor of the number of processors used. + +! === module MOM_main (MOM_driver) === +DT_FORCING = 360.0 ! [s] default = 120.0 + ! The time step for changing forcing, coupling with other + ! components, or potentially writing certain diagnostics. + ! The default value is given by DT. +DAYMAX = 6.0 ! [hours] + ! The final time of the whole simulation, in units of + ! TIMEUNIT seconds. This also sets the potential end + ! time of the present run segment if the end time is + ! not set (as it was here) via ocean_solo_nml in input.nml. +RESTART_CONTROL = 3 ! default = 1 + ! 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 non-time-stamped + ! restart file is saved at the end of the run segment + ! for any non-negative value. +RESTINT = 10.0 ! [hours] default = 0.0 + ! The interval between saves of the restart file in units + ! of TIMEUNIT. Use 0 (the default) to not save + ! incremental restart files at all. +ENERGYSAVEDAYS = 3.0 ! [hours] default = 1.44E+04 + ! The interval in units of TIMEUNIT between saves of the + ! energies of the run and other globally summed diagnostics. +DIAG_AS_CHKSUM = True +DEBUG = True diff --git a/.testing/tc3/MOM_override b/.testing/tc3/MOM_override new file mode 100644 index 0000000000..e69de29bb2 diff --git a/.testing/tc3/diag_table b/.testing/tc3/diag_table new file mode 100644 index 0000000000..e31244cbd4 --- /dev/null +++ b/.testing/tc3/diag_table @@ -0,0 +1,207 @@ +"MOM Experiment" +1 1 1 0 0 0 +"prog", 2,"minutes",1,"days","Time", +#"ave_prog", 1,"hours",1,"days","Time", +#"cont", 1,"hours",1,"days","Time", +#"trac", 5,"days",1,"days","Time", +#"mom", 5,"days",1,"days","Time", +#"bt_mom", 5,"days",1,"days","Time", +#"visc", 5,"days",1,"days","Time", +#"energy", 5,"days",1,"days","Time", +#"ML_TKE", 5,"days",1,"days","Time", +#"forcing", 5,"days",1,"days","Time", + +#This is the field section of the diag_table. + +# Prognostic Ocean fields: +#========================= + +"ocean_model","u","u","prog","all",.false.,"none",2 +"ocean_model","v","v","prog","all",.false.,"none",2 +"ocean_model","h","h","prog","all",.false.,"none",1 +"ocean_model","e","e","prog","all",.false.,"none",2 +#"ocean_model","SSH","SSH","prog","all",.false.,"none",2 +#"ocean_model","temp","temp","prog","all",.false.,"none",2 +#"ocean_model","salt","salt","prog","all",.false.,"none",2 +#"ocean_model","Rml","Rml","prog","all",.false.,"none",2 +#"ocean_model","tr_D1","tr1","prog","all",.false.,"none",2 + +#"ocean_model","RV","RV","prog","all",.false.,"none",2 +#"ocean_model","PV","PV","prog","all",.false.,"none",2 +#"ocean_model","e_D","e_D","prog","all",.false.,"none",2 + +#"ocean_model","u","u","ave_prog","all",.true.,"none",2 +#"ocean_model","v","v","ave_prog","all",.true.,"none",2 +#"ocean_model","h","h","ave_prog","all",.true.,"none",1 +#"ocean_model","e","e","ave_prog","all",.true.,"none",2 +#"ocean_model","temp","temp","ave_prog","all",.true.,"none",2 +#"ocean_model","salt","salt","ave_prog","all",.true.,"none",2 +#"ocean_model","Rml","Rml","ave_prog","all",.true.,"none",2 + +# Auxilary Tracers: +#================== +#"ocean_model","vintage","vintage","prog","all",.false.,"none",2 +#"ocean_model","age","age","prog","all",.false.,"none",2 + +# Tracers: +#========= +#"ocean_model","tr_D1","tr1","trac","all",.false.,"none",2 +#"ocean_model","tr_D2","tr2","trac","all",.false.,"none",2 +#"ocean_model","tr_D3","tr3","trac","all",.false.,"none",2 +#"ocean_model","tr_D4","tr4","trac","all",.false.,"none",2 +#"ocean_model","tr_D5","tr5","trac","all",.false.,"none",2 +#"ocean_model","tr_D6","tr6","trac","all",.false.,"none",2 +#"ocean_model","tr_D7","tr7","trac","all",.false.,"none",2 +#"ocean_model","tr_D8","tr8","trac","all",.false.,"none",2 +#"ocean_model","tr_D9","tr9","trac","all",.false.,"none",2 +#"ocean_model","tr_D10","tr10","trac","all",.false.,"none",2 +#"ocean_model","tr_D11","tr11","trac","all",.false.,"none",2 + +# Continuity Equation Terms: +#=========================== +#"ocean_model","dhdt","dhdt","cont","all",.true.,"none",2 +#"ocean_model","wd","wd","cont","all",.true.,"none",2 +#"ocean_model","uh","uh","cont","all",.true.,"none",2 +#"ocean_model","vh","vh","cont","all",.true.,"none",2 +#"ocean_model","uhGM","uhGM","cont","all",.true.,"none",2 +#"ocean_model","vhGM","vhGM","cont","all",.true.,"none",2 +#"ocean_model","uhbt","uhbt","cont","all",.true.,"none",2 +#"ocean_model","vhbt","vhbt","cont","all",.true.,"none",2 + +# Continuity Equation Terms In Pure Potential Density Coordiantes: +#================================================================= +#"ocean_model","h_rho","h_rho","cont","all",.true.,"none",2 +#"ocean_model","uh_rho","uh_rho","cont","all",.true.,"none",2 +#"ocean_model","vh_rho","vh_rho","cont","all",.true.,"none",2 +#"ocean_model","uhGM_rho","uhGM_rho","cont","all",.true.,"none",2 +#"ocean_model","vhGM_rho","vhGM_rho","cont","all",.true.,"none",2 + +# +# Tracer Fluxes: +#================== +#"ocean_model","T_adx", "T_adx", "ave_prog","all",.true.,"none",2 +#"ocean_model","T_ady", "T_ady", "ave_prog","all",.true.,"none",2 +#"ocean_model","T_diffx","T_diffx","ave_prog","all",.true.,"none",2 +#"ocean_model","T_diffy","T_diffy","ave_prog","all",.true.,"none",2 +#"ocean_model","S_adx", "S_adx", "ave_prog","all",.true.,"none",2 +#"ocean_model","S_ady", "S_ady", "ave_prog","all",.true.,"none",2 +#"ocean_model","S_diffx","S_diffx","ave_prog","all",.true.,"none",2 +#"ocean_model","S_diffy","S_diffy","ave_prog","all",.true.,"none",2 + + +# Momentum Balance Terms: +#======================= +#"ocean_model","dudt","dudt","mom","all",.true.,"none",2 +#"ocean_model","dvdt","dvdt","mom","all",.true.,"none",2 +#"ocean_model","CAu","CAu","mom","all",.true.,"none",2 +#"ocean_model","CAv","CAv","mom","all",.true.,"none",2 +#"ocean_model","PFu","PFu","mom","all",.true.,"none",2 +#"ocean_model","PFv","PFv","mom","all",.true.,"none",2 +#"ocean_model","du_dt_visc","du_dt_visc","mom","all",.true.,"none",2 +#"ocean_model","dv_dt_visc","dv_dt_visc","mom","all",.true.,"none",2 +#"ocean_model","diffu","diffu","mom","all",.true.,"none",2 +#"ocean_model","diffv","diffv","mom","all",.true.,"none",2 +#"ocean_model","dudt_dia","dudt_dia","mom","all",.true.,"none",2 +#"ocean_model","dvdt_dia","dvdt_dia","mom","all",.true.,"none",2 +# Subterms that should not be added to a closed budget. +#"ocean_model","gKEu","gKEu","mom","all",.true.,"none",2 +#"ocean_model","gKEv","gKEv","mom","all",.true.,"none",2 +#"ocean_model","rvxu","rvxu","mom","all",.true.,"none",2 +#"ocean_model","rvxv","rvxv","mom","all",.true.,"none",2 +#"ocean_model","PFu_bc","PFu_bc","mom","all",.true.,"none",2 +#"ocean_model","PFv_bc","PFv_bc","mom","all",.true.,"none",2 + +# Barotropic Momentum Balance Terms: +# (only available with split time stepping.) +#=========================================== +#"ocean_model","PFuBT","PFuBT","bt_mom","all",.true.,"none",2 +#"ocean_model","PFvBT","PFvBT","bt_mom","all",.true.,"none",2 +#"ocean_model","CoruBT","CoruBT","bt_mom","all",.true.,"none",2 +#"ocean_model","CorvBT","CorvBT","bt_mom","all",.true.,"none",2 +#"ocean_model","ubtforce","ubtforce","bt_mom","all",.true.,"none",2 +#"ocean_model","vbtforce","vbtforce","bt_mom","all",.true.,"none",2 +#"ocean_model","u_accel_bt","u_accel_bt","bt_mom","all",.true.,"none",2 +#"ocean_model","v_accel_bt","v_accel_bt","bt_mom","all",.true.,"none",2 +# +# Viscosities and diffusivities: +#=============================== +#"ocean_model","Kd_effective","Kd_effective","visc","all",.true.,"none",2 +#"ocean_model","Ahh","Ahh","visc","all",.true.,"none",2 +#"ocean_model","Ahq","Ahq","visc","all",.true.,"none",2 +#"ocean_model","Khh","Khh","visc","all",.true.,"none",2 +#"ocean_model","Khq","Khq","visc","all",.true.,"none",2 +#"ocean_model","bbl_thick_u","bbl_thick_u","visc","all",.true.,"none",2 +#"ocean_model","kv_bbl_u","kv_bbl_u","visc","all",.true.,"none",2 +#"ocean_model","bbl_thick_v","bbl_thick_v","visc","all",.true.,"none",2 +#"ocean_model","kv_bbl_v","kv_bbl_v","visc","all",.true.,"none",2 +#"ocean_model","av_visc","av_visc","visc","all",.true.,"none",2 +#"ocean_model","au_visc","au_visc","visc","all",.true.,"none",2 +# +# Kinetic Energy Balance Terms: +#============================= +#"ocean_model","KE","KE","energy","all",.true.,"none",2 +#"ocean_model","dKE_dt","dKE_dt","energy","all",.true.,"none",2 +#"ocean_model","PE_to_KE","PE_to_KE","energy","all",.true.,"none",2 +#"ocean_model","KE_Coradv","KE_Coradv","energy","all",.true.,"none",2 +#"ocean_model","KE_adv","KE_adv","energy","all",.true.,"none",2 +#"ocean_model","KE_visc","KE_visc","energy","all",.true.,"none",2 +#"ocean_model","KE_horvisc","KE_horvisc","energy","all",.true.,"none",2 +#"ocean_model","KE_dia","KE_dia","energy","all",.true.,"none",2 +# +# Mixed Layer TKE Budget Terms: +#=========================== +#"ocean_model","TKE_wind","TKE_wind","ML_TKE","all",.true.,"none",2 +#"ocean_model","TKE_RiBulk","TKE_RiBulk","ML_TKE","all",.true.,"none",2 +#"ocean_model","TKE_conv","TKE_conv","ML_TKE","all",.true.,"none",2 +#"ocean_model","TKE_pen_SW","TKE_pen_SW","ML_TKE","all",.true.,"none",2 +#"ocean_model","TKE_mixing","TKE_mixing","ML_TKE","all",.true.,"none",2 +#"ocean_model","TKE_mech_decay","TKE_mech_decay","ML_TKE","all",.true.,"none",2 +#"ocean_model","TKE_conv_decay","TKE_conv_decay","ML_TKE","all",.true.,"none",2 + +# Surface Forcing: +#================= +#"ocean_model","taux","taux","forcing","all",.true.,"none",2 +#"ocean_model","tauy","tauy","forcing","all",.true.,"none",2 +#"ocean_model","ustar","ustar","forcing","all",.true.,"none",2 +#"ocean_model","PRCmE","PRCmE","forcing","all",.true.,"none",2 +#"ocean_model","SW","SW","forcing","all",.true.,"none",2 +#"ocean_model","LwLatSens","LwLatSens","forcing","all",.true.,"none",2 +#"ocean_model","p_surf","p_surf","forcing","all",.true.,"none",2 +#"ocean_model","salt_flux","salt_flux","forcing","all",.true.,"none",2 +# + + +#============================================================================================= +# +#====> This file can be used with diag_manager/v2.0a (or higher) <==== +# +# +# FORMATS FOR FILE ENTRIES (not all input values are used) +# ------------------------ +# +#"file_name", output_freq, "output_units", format, "time_units", "time_long_name", ... +# (opt) new_file_frequecy, (opt) "new_file_freq_units", "new_file_start_date" +# +# +#output_freq: > 0 output frequency in "output_units" +# = 0 output frequency every time step +# =-1 output frequency at end of run +# +#output_units = units used for output frequency +# (years, months, days, minutes, hours, seconds) +# +#time_units = units used to label the time axis +# (days, minutes, hours, seconds) +# +# +# FORMAT FOR FIELD ENTRIES (not all input values are used) +# ------------------------ +# +#"module_name", "field_name", "output_name", "file_name" "time_sampling", time_avg, "other_opts", packing +# +#time_avg = .true. or .false. +# +#packing = 1 double precision +# = 2 float +# = 4 packed 16-bit integers +# = 8 packed 1-byte (not tested?) diff --git a/.testing/tc3/input.nml b/.testing/tc3/input.nml new file mode 100644 index 0000000000..e9aa67941d --- /dev/null +++ b/.testing/tc3/input.nml @@ -0,0 +1,17 @@ +&MOM_input_nml + output_directory = './' + input_filename = 'n' + restart_input_dir = 'INPUT' + restart_output_dir = 'RESTART/' + parameter_filename = + 'MOM_input', + 'MOM_override' +/ + +&diag_manager_nml +/ + +&fms_nml + domains_stack_size = 1326000 + stack_size = 0 +/ diff --git a/.travis.yml b/.travis.yml index 1d200d1899..cd84722c70 100644 --- a/.travis.yml +++ b/.travis.yml @@ -5,6 +5,11 @@ language: c dist: xenial +# --depth flag is breaking our merge, try disabling it +# NOTE: We may be able to go back to depth=50 in production +git: + depth: false + addons: apt: sources: @@ -13,15 +18,8 @@ addons: - tcsh pkg-config netcdf-bin libnetcdf-dev libnetcdff-dev openmpi-bin libopenmpi-dev gfortran - doxygen graphviz flex bison cmake -# Stages occur sequentially. Within each stage jobs run concurrently. -stages: - - check and compile - - tests - - cleanup - -cache: - directories: - - build +before_install: + - pip install --user f90nml # Compilation and testing is controlled by the "configure" and "Makefile" in # .testing/ but they operate from the root directory. We copy them into place @@ -30,82 +28,25 @@ install: - echo "Install step" - cp .testing/{configure,Makefile} . -before_script: - - ls -l - - ls build - -# This avoids caching files we do not need between stages -before_cache: - - rm -f build/*.o build/*.mod - jobs: include: - - # Checks and compilation ################################################### -# - stage: check and compile -# script: -# - echo "Blank environment - this is where we would compile if we wanted to reuse executables in multiple tests" -# #- touch build/comp_nothing - - stage: check and compile - env: JOB="Code style compliance" + - env: JOB="Code style compliance" script: - - ./.testing/trailer.py -e TEOS10 -l 120 src config_src - - stage: check and compile - env: JOB="Doxygen" + - ./.testing/trailer.py -e TEOS10 -l 120 src config_src + - env: JOB="Doxygen" script: - - cd docs && doxygen Doxyfile_nortd - - grep -v "config_src/solo_driver/coupler_types.F90" doxygen.log | tee doxy_errors - - test ! -s doxy_errors - - &compile-code - stage: check and compile - env: MAKEARGS="MEMORY_SHAPE=dynamic_symmetric REPRO=1" - script: - - make $MAKEARGS compile - - touch build/comp_${MAKEARGS//\ /_} - - <<: *compile-code - env: MAKEARGS="MEMORY_SHAPE=dynamic REPRO=1" - - <<: *compile-code - env: MAKEARGS="MEMORY_SHAPE=dynamic_symmetric DEBUG=1" - - <<: *compile-code - env: MAKEARGS="MEMORY_SHAPE=dynamic DEBUG=1" -# - <<: *compile-code -# env: MAKEARGS="MEMORY_SHAPE=dynamic_symmetric OPENMP=1" - - # Run tests ################################################################ - # The default "test" job is automatically invoked for each of the matrix environments - # The "test" jobs executes "./configure && make && make test" -# - stage: tests -# script: -# - echo "Placeholder for generic text using blank environment" - - &compile - stage: tests - env: MAKEARGS="MEMORY_SHAPE=dynamic_symmetric REPRO=1" - script: - - ./configure && make -j && make test - - <<: *compile - env: MAKEARGS="MEMORY_SHAPE=dynamic REPRO=1" - - <<: *compile - env: MAKEARGS="MEMORY_SHAPE=dynamic_symmetric DEBUG=1" - - <<: *compile - env: MAKEARGS="MEMORY_SHAPE=dynamic DEBUG=1" -# - <<: *compile -# env: MAKEARGS="MEMORY_SHAPE=dynamic_symmetric OPENMP=1" - - # Clean up ################################################################# - # We only want the cache directory to exist between stages so we manually - # clean out the cache, i.e. build/ - - &clean-build - stage: cleanup + - cd docs && doxygen Doxyfile_nortd + - grep -v "config_src/solo_driver/coupler_types.F90" doxygen.log | tee doxy_errors + - test ! -s doxy_errors + - env: JOB="Compile and run" script: - - rm -rf build/* - - ls -l -# - <<: *clean-build - env: MAKEARGS="MEMORY_SHAPE=dynamic_symmetric REPRO=1" - - <<: *clean-build - env: MAKEARGS="MEMORY_SHAPE=dynamic REPRO=1" - - <<: *clean-build - env: MAKEARGS="MEMORY_SHAPE=dynamic_symmetric DEBUG=1" - - <<: *clean-build - env: MAKEARGS="MEMORY_SHAPE=dynamic DEBUG=1" -# - <<: *clean-build -# env: MAKEARGS="MEMORY_SHAPE=dynamic_symmetric OPENMP=1" + - echo 'Configuring...' && echo -en 'travis_fold:start:script.1\\r' + - make \ + MKMF_TEMPLATE=linux-ubuntu-xenial-gnu.mk \ + MOM_TARGET_SLUG=${TRAVIS_REPO_SLUG} \ + MOM_TARGET_LOCAL_BRANCH=${TRAVIS_PULL_REQUEST_BRANCH} \ + DO_REGRESSION_TESTS=${TRAVIS_PULL_REQUEST} + - echo -en 'travis_fold:end:script.1\\r' + - echo 'Running tests...' && echo -en 'travis_fold:start:script.2\\r' + - make DO_REGRESSION_TESTS=${TRAVIS_PULL_REQUEST} test + - echo -en 'travis_fold:end:script.2\\r' From 8472a2d684b61eb74042380e1ae676d1c12c00d5 Mon Sep 17 00:00:00 2001 From: Marshall Ward Date: Wed, 21 Aug 2019 11:54:51 -0400 Subject: [PATCH 231/297] Explicit dependency for Travis path_names Makefile The path_names rules in the Travis Makefile were using a variable to define its remote branch, which does not work in Makefiles. This patch removes the REMOTE variable and the rule has been split into two rules with explicit dependencies. We might try to merge these two rules at some point. This issue was not raised in previous tests because there was an old remote branch with the same name as the merged case (mergetest). So namespace conflicts are still a potential issue with this Makefile. --- .testing/Makefile | 17 +++++++++++++---- 1 file changed, 13 insertions(+), 4 deletions(-) diff --git a/.testing/Makefile b/.testing/Makefile index 009be95731..6350efdb9e 100644 --- a/.testing/Makefile +++ b/.testing/Makefile @@ -84,9 +84,6 @@ build/symmetric/MOM6: MOMFLAGS=NETCDF=3 DEBUG=1 COVERAGE=1 build/asymmetric/MOM6: MOMFLAGS=NETCDF=3 DEBUG=1 build/repro/MOM6: MOMFLAGS=NETCDF=3 REPRO=1 -build/target/path_names: REMOTE=$(GIT_TARGET_REMOTE) -build/%/path_names: REMOTE=.git/refs/heads/$(MOM_MERGED_BRANCH) - build/asymmetric/path_names: GRID_SRC=config_src/dynamic build/%/path_names: GRID_SRC=config_src/dynamic_symmetric @@ -107,7 +104,19 @@ build/%/Makefile: build/%/path_names path_names git checkout @{-1} -build/%/path_names: $(LIST_PATHS) $(REMOTE) +# TODO: Merge the target and generic path_names rules +# (Only dependency differs at the moment) + +build/target/path_names: $(LIST_PATHS) $(GIT_TARGET_REMOTE) + git checkout $(BRANCH) + mkdir -p $(@D) + cd $(@D) && $(LIST_PATHS) -l \ + ../../src \ + ../../config_src/solo_driver \ + ../../$(GRID_SRC) + git checkout @{-1} + +build/%/path_names: $(LIST_PATHS) .git/refs/heads/$(MOM_MERGED_BRANCH) git checkout $(BRANCH) mkdir -p $(@D) cd $(@D) && $(LIST_PATHS) -l \ From 1c2b3444f4a6635ac14622e5496c11c681d97aec Mon Sep 17 00:00:00 2001 From: Marshall Ward Date: Wed, 21 Aug 2019 13:11:41 -0400 Subject: [PATCH 232/297] Redefined target PR branch name via Travis --- .travis.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.travis.yml b/.travis.yml index cd84722c70..b9a03104a2 100644 --- a/.travis.yml +++ b/.travis.yml @@ -44,7 +44,7 @@ jobs: - make \ MKMF_TEMPLATE=linux-ubuntu-xenial-gnu.mk \ MOM_TARGET_SLUG=${TRAVIS_REPO_SLUG} \ - MOM_TARGET_LOCAL_BRANCH=${TRAVIS_PULL_REQUEST_BRANCH} \ + MOM_TARGET_LOCAL_BRANCH=${TRAVIS_BRANCH} \ DO_REGRESSION_TESTS=${TRAVIS_PULL_REQUEST} - echo -en 'travis_fold:end:script.1\\r' - echo 'Running tests...' && echo -en 'travis_fold:start:script.2\\r' From 49797c8d1d188ea84ebddc3ff04f74d2cbe516db Mon Sep 17 00:00:00 2001 From: Matthew Harrison Date: Thu, 22 Aug 2019 09:55:33 -0400 Subject: [PATCH 233/297] Makes OBC restart field rx_normal not required - this is desired for OBC runs initialized from a parent model where this field would not be available. --- src/core/MOM_open_boundary.F90 | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/core/MOM_open_boundary.F90 b/src/core/MOM_open_boundary.F90 index 70f3508206..24bf68a1c9 100644 --- a/src/core/MOM_open_boundary.F90 +++ b/src/core/MOM_open_boundary.F90 @@ -3947,17 +3947,17 @@ subroutine open_boundary_register_restarts(HI, GV, OBC_CS,restart_CSp) allocate(OBC_CS%rx_normal(HI%isdB:HI%iedB,HI%jsd:HI%jed,GV%ke)) OBC_CS%rx_normal(:,:,:) = 0.0 vd = var_desc("rx_normal","m s-1", "Normal Phase Speed for EW OBCs",'u','L') - call register_restart_field(OBC_CS%rx_normal, vd, .true., restart_CSp) + call register_restart_field(OBC_CS%rx_normal, vd, .false., restart_CSp) allocate(OBC_CS%ry_normal(HI%isd:HI%ied,HI%jsdB:HI%jedB,GV%ke)) OBC_CS%ry_normal(:,:,:) = 0.0 vd = var_desc("ry_normal","m s-1", "Normal Phase Speed for NS OBCs",'v','L') - call register_restart_field(OBC_CS%ry_normal, vd, .true., restart_CSp) + call register_restart_field(OBC_CS%ry_normal, vd, .false., restart_CSp) endif if (OBC_CS%oblique_BCs_exist_globally) then allocate(OBC_CS%cff_normal(HI%IsdB:HI%IedB,HI%jsdB:HI%jedB,GV%ke)) OBC_CS%cff_normal(:,:,:) = 0.0 vd = var_desc("cff_normal","m s-1", "denominator for oblique OBCs",'q','L') - call register_restart_field(OBC_CS%cff_normal, vd, .true., restart_CSp) + call register_restart_field(OBC_CS%cff_normal, vd, .false., restart_CSp) endif end subroutine open_boundary_register_restarts From ceab18a8ada53b7d60960db21d8806fc91848897 Mon Sep 17 00:00:00 2001 From: Matthew Harrison Date: Thu, 22 Aug 2019 09:57:38 -0400 Subject: [PATCH 234/297] Source data are assumed to be zonally re-entrant. --- src/framework/MOM_horizontal_regridding.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/framework/MOM_horizontal_regridding.F90 b/src/framework/MOM_horizontal_regridding.F90 index 2113d5156e..0cb670197d 100644 --- a/src/framework/MOM_horizontal_regridding.F90 +++ b/src/framework/MOM_horizontal_regridding.F90 @@ -520,7 +520,7 @@ subroutine horiz_interp_and_extrap_tracer_record(filename, varnam, conversion, if (k == 1) then call horiz_interp_new(Interp,x_in,y_in,lon_out(is:ie,js:je),lat_out(is:ie,js:je), & - interp_method='bilinear',src_modulo=reentrant_x) + interp_method='bilinear',src_modulo=.true.) endif if (debug) then @@ -796,7 +796,7 @@ subroutine horiz_interp_and_extrap_tracer_fms_id(fms_id, Time, conversion, G, t ! call fms routine horiz_interp to interpolate input level data to model horizontal grid if (k == 1) then call horiz_interp_new(Interp, x_in, y_in, lon_out(is:ie,js:je), lat_out(is:ie,js:je), & - interp_method='bilinear', src_modulo=reentrant_x) + interp_method='bilinear', src_modulo=.true.) endif if (debug) then From a3c5ef9bc91eda92b5da50b68bdf30be582fc409 Mon Sep 17 00:00:00 2001 From: Graeme MacGilchrist Date: Thu, 22 Aug 2019 13:44:51 -0400 Subject: [PATCH 235/297] testing stream --- src/parameterizations/vertical/MOM_geothermal.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/parameterizations/vertical/MOM_geothermal.F90 b/src/parameterizations/vertical/MOM_geothermal.F90 index 4121795766..7fe6d53bea 100644 --- a/src/parameterizations/vertical/MOM_geothermal.F90 +++ b/src/parameterizations/vertical/MOM_geothermal.F90 @@ -35,7 +35,7 @@ module MOM_geothermal 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. - integer :: id_internal_heat_tend_3d = -1 !< ID for 3D diagnostic of internal heat + integer :: id_internal_heat_tend_3d = -1 !< test ID for 3D diagnostic of internal heat end type geothermal_CS From bb231db2d519387102e8becc5d110f2ad8f4f167 Mon Sep 17 00:00:00 2001 From: Raphael Dussin Date: Thu, 22 Aug 2019 13:46:12 -0400 Subject: [PATCH 236/297] add checks land values --- .../coupled_driver/MOM_surface_forcing.F90 | 39 +++++++++++++++++++ 1 file changed, 39 insertions(+) diff --git a/config_src/coupled_driver/MOM_surface_forcing.F90 b/config_src/coupled_driver/MOM_surface_forcing.F90 index bb6270c177..f093b5b66f 100644 --- a/config_src/coupled_driver/MOM_surface_forcing.F90 +++ b/config_src/coupled_driver/MOM_surface_forcing.F90 @@ -408,39 +408,51 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, US, CS, sfc if (associated(IOB%lprec)) & fluxes%lprec(i,j) = IOB%lprec(i-i0,j-j0) * G%mask2dT(i,j) + call check_mask_val_consistency(IOB%lprec(i-i0,j-j0), G%mask2dT(i,j), i, j) if (associated(IOB%fprec)) & fluxes%fprec(i,j) = IOB%fprec(i-i0,j-j0) * G%mask2dT(i,j) + call check_mask_val_consistency(IOB%fprec(i-i0,j-j0), G%mask2dT(i,j), i, j) if (associated(IOB%q_flux)) & fluxes%evap(i,j) = - IOB%q_flux(i-i0,j-j0) * G%mask2dT(i,j) + call check_mask_val_consistency(IOB%q_flux(i-i0,j-j0), G%mask2dT(i,j), i, j) if (associated(IOB%runoff)) & fluxes%lrunoff(i,j) = IOB%runoff(i-i0,j-j0) * G%mask2dT(i,j) + call check_mask_val_consistency(IOB%runoff(i-i0,j-j0), G%mask2dT(i,j), i, j) if (associated(IOB%calving)) & fluxes%frunoff(i,j) = IOB%calving(i-i0,j-j0) * G%mask2dT(i,j) + call check_mask_val_consistency(IOB%calving(i-i0,j-j0), G%mask2dT(i,j), i, j) if (associated(IOB%ustar_berg)) & fluxes%ustar_berg(i,j) = US%m_to_Z*US%T_to_s * IOB%ustar_berg(i-i0,j-j0) * G%mask2dT(i,j) + call check_mask_val_consistency(IOB%ustar_berg(i-i0,j-j0), G%mask2dT(i,j), i, j) if (associated(IOB%area_berg)) & fluxes%area_berg(i,j) = IOB%area_berg(i-i0,j-j0) * G%mask2dT(i,j) + call check_mask_val_consistency(IOB%area_berg(i-i0,j-j0), G%mask2dT(i,j), i, j) if (associated(IOB%mass_berg)) & fluxes%mass_berg(i,j) = IOB%mass_berg(i-i0,j-j0) * G%mask2dT(i,j) + call check_mask_val_consistency(IOB%mass_berg(i-i0,j-j0), G%mask2dT(i,j), i, j) if (associated(IOB%runoff_hflx)) & fluxes%heat_content_lrunoff(i,j) = IOB%runoff_hflx(i-i0,j-j0) * G%mask2dT(i,j) + call check_mask_val_consistency(IOB%runoff_hflx(i-i0,j-j0), G%mask2dT(i,j), i, j) if (associated(IOB%calving_hflx)) & fluxes%heat_content_frunoff(i,j) = IOB%calving_hflx(i-i0,j-j0) * G%mask2dT(i,j) + call check_mask_val_consistency(IOB%calving_hflx(i-i0,j-j0), G%mask2dT(i,j), i, j) if (associated(IOB%lw_flux)) & fluxes%LW(i,j) = IOB%lw_flux(i-i0,j-j0) * G%mask2dT(i,j) + call check_mask_val_consistency(IOB%lw_flux(i-i0,j-j0), G%mask2dT(i,j), i, j) if (associated(IOB%t_flux)) & fluxes%sens(i,j) = - IOB%t_flux(i-i0,j-j0) * G%mask2dT(i,j) + call check_mask_val_consistency(IOB%t_flux(i-i0,j-j0), G%mask2dT(i,j), i, j) fluxes%latent(i,j) = 0.0 if (associated(IOB%fprec)) then @@ -460,12 +472,16 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, US, CS, sfc 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) + call check_mask_val_consistency(IOB%sw_flux_vis_dir(i-i0,j-j0), G%mask2dT(i,j), i, j) 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) + call check_mask_val_consistency(IOB%sw_flux_vis_dif(i-i0,j-j0), G%mask2dT(i,j), i, j) 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) + call check_mask_val_consistency(IOB%sw_flux_nir_dir(i-i0,j-j0), G%mask2dT(i,j), i, j) 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) + call check_mask_val_consistency(IOB%sw_flux_nir_dif(i-i0,j-j0), G%mask2dT(i,j), i, j) 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) @@ -476,11 +492,13 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, US, CS, sfc 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) + call check_mask_val_consistency(IOB%p(i-i0,j-j0), G%mask2dT(i,j), i, j) 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) + call check_mask_val_consistency(IOB%p(i-i0,j-j0), G%mask2dT(i,j), i, j) fluxes%p_surf(i,j) = fluxes%p_surf_full(i,j) enddo ; enddo endif @@ -492,6 +510,7 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, US, CS, sfc 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) ) + call check_mask_val_consistency(IOB%salt_flux(i-i0,j-j0), G%mask2dT(i,j), i, j) enddo ; enddo endif @@ -1550,4 +1569,24 @@ subroutine ice_ocn_bnd_type_chksum(id, timestep, iobt) end subroutine ice_ocn_bnd_type_chksum +!> Check the values passed by IOB over land are zero +subroutine check_mask_val_consistency(val, mask, i, j) + + real, intent(in) :: val !< value of flux/variable passed by IOB + real, intent(in) :: mask !< value of ocean mask + real, intent(in) :: i, j !< model grid cell indices + ! Local variables + character(len=48) :: ci, cj !< model grid cell indices as strings + character(len=256) :: error_message !< error message to be displayed + + if (mask == 0.) .and. (val /= 0.) then + write(ci, '(I8)') i + write(cj, '(I8)') j + error_message = "MOM_surface_forcing: found non-zero value over land "//& + "at point (i, j) = ("//trim(ci)//", "//trim(cj)//")" + call MOM_error(FATAL, error_message) + endif + +end subroutine + end module MOM_surface_forcing From dde649246767632fb599d17e47e79be4bc62ad97 Mon Sep 17 00:00:00 2001 From: Graeme MacGilchrist Date: Thu, 22 Aug 2019 13:46:47 -0400 Subject: [PATCH 237/297] testing stream --- src/parameterizations/vertical/MOM_geothermal.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/parameterizations/vertical/MOM_geothermal.F90 b/src/parameterizations/vertical/MOM_geothermal.F90 index 7fe6d53bea..4121795766 100644 --- a/src/parameterizations/vertical/MOM_geothermal.F90 +++ b/src/parameterizations/vertical/MOM_geothermal.F90 @@ -35,7 +35,7 @@ module MOM_geothermal 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. - integer :: id_internal_heat_tend_3d = -1 !< test ID for 3D diagnostic of internal heat + integer :: id_internal_heat_tend_3d = -1 !< ID for 3D diagnostic of internal heat end type geothermal_CS From 177ed82f613ba52abf33db322bc15cbcdf479c53 Mon Sep 17 00:00:00 2001 From: Graeme MacGilchrist Date: Thu, 22 Aug 2019 16:43:35 -0400 Subject: [PATCH 238/297] updated calculation of internal heat diagnostic --- .../vertical/MOM_geothermal.F90 | 44 ++++++++++++------- 1 file changed, 27 insertions(+), 17 deletions(-) diff --git a/src/parameterizations/vertical/MOM_geothermal.F90 b/src/parameterizations/vertical/MOM_geothermal.F90 index 4121795766..d2dc565bde 100644 --- a/src/parameterizations/vertical/MOM_geothermal.F90 +++ b/src/parameterizations/vertical/MOM_geothermal.F90 @@ -102,15 +102,12 @@ subroutine geothermal(h, tv, dt, ea, eb, G, GV, CS, halo) real :: Irho_cp ! inverse of heat capacity per unit layer volume ! [degC H m2 J-1 ~> degC m3 J-1 or degC kg J-1] - real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: temp_old ! Temperature of each layer - ! before any heat is added, - ! for diagnostics [degC] - real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: h_old ! Thickness of each layer - ! before any heat is added, - ! for diagnostics [m or kg m-2] - real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: work_3d ! Scratch variable used to - ! calculate change in heat - ! due to geothermal + real :: T_old ! Temperature of each layer before any heat is added, + ! for diagnostics [degC] + real, allocatable, dimension(:,:,:) :: h_old ! Thickness of each layer before any heat is added, + ! for diagnostics [m or kg m-2] + real, allocatable, dimension(:,:,:) :: work_3d ! Scratch variable used to calculate change in heat + ! due to geothermal real :: Idt ! inverse of the timestep [s-1] logical :: do_i(SZI_(G)) @@ -150,9 +147,11 @@ subroutine geothermal(h, tv, dt, ea, eb, G, GV, CS, halo) !$OMP wt_in_place,dTemp,dRcv,h_transfer,heating, & !$OMP I_h) - ! Save temperature and thickness before any changes are made (for diagnostic) - temp_old = tv%T - h_old = h + ! Allocate diagnostic arrays if required + if (CS%id_internal_heat_tend_3d > 0) then + allocate(h_old(is:ie,js:je,nz)) ; h_old(:,:,:) = 0.0 + allocate(work_3d(is:ie,js:je,nz)) ; work_3d(:,:,:) = 0.0 + endif do j=js,je ! 1. Only work on columns that are being heated. @@ -193,6 +192,12 @@ subroutine geothermal(h, tv, dt, ea, eb, G, GV, CS, halo) do k=nz,1,-1 do i=isj,iej ; if (do_i(i)) then + ! Save temperature and thickness before any changes are made (for diagnostic) + if (CS%id_internal_heat_tend_3d > 0) then + T_old = tv%T(i,j,k) + h_old(i,j,k) = h(i,j,k) + endif + if (h(i,j,k) > Angstrom) then if ((h(i,j,k)-Angstrom) >= h_geo_rem(i)) then h_heated = h_geo_rem(i) @@ -312,6 +317,12 @@ subroutine geothermal(h, tv, dt, ea, eb, G, GV, CS, halo) ! endif endif endif + + ! Calculate heat tendency due to addition and transfer of internal heat + if (CS%id_internal_heat_tend_3d > 0) then + work_3d(i,j,k) = ((GV%H_to_kg_m2 * tv%C_p) * Idt) * (h(i,j,k) * tv%T(i,j,k) - h_old(i,j,k) * T_old) + endif + endif ; enddo if (num_left <= 0) exit enddo ! k-loop @@ -322,12 +333,11 @@ subroutine geothermal(h, tv, dt, ea, eb, G, GV, CS, halo) enddo ; endif enddo ! j-loop - ! Calculate heat tendency due to addition and transfer of internal heat + ! Post diagnostic of internal heat tendency in 3D if (CS%id_internal_heat_tend_3d > 0) then - do k=1,nz ; do j=js,je ; do i=is,ie - work_3d(i,j,k) = GV%H_to_kg_m2 * tv%C_p * Idt * (h(i,j,k) * tv%T(i,j,k) - h_old(i,j,k) * temp_old(i,j,k)) - enddo ; enddo ; enddo call post_data(CS%id_internal_heat_tend_3d, work_3d, CS%diag, alt_h = h_old) + deallocate(h_old) + deallocate(work_3d) endif ! do i=is,ie ; do j=js,je @@ -421,7 +431,7 @@ subroutine geothermal_init(Time, G, param_file, diag, CS) ! Diagnostic for tendency due to internal heat (in 3d) CS%id_internal_heat_tend_3d=register_diag_field('ocean_model', & 'internal_heat_tend_3d', diag%axesTL, Time, & - 'Internal heat tendency in 3D, reveals layer(s) that heat is added to', & + '3D heat tendency due to internal (geothermal) sources', & 'W m-2', v_extensive = .true.) end subroutine geothermal_init From 67cb7853baedbaad6773dc2f2aa1124072d8ea36 Mon Sep 17 00:00:00 2001 From: Marshall Ward Date: Thu, 22 Aug 2019 17:18:33 -0400 Subject: [PATCH 239/297] Makefile local support The testing Makefile was updated to avoid aggressive git repo manipulations when used locally. When DO_REGRESSION_TESTS is disabled, we now define the target and merge branches as the current local branch, and most git operations become inert. As part of this, the DO_REGRESSION_TESTS variable is handled as a more traditional bash variable, where false is attributed to unassigned values, rather than explicitly looking for the "false" string. --- .testing/Makefile | 46 +++++++++++++++++++++++----------------------- .travis.yml | 7 ++++--- 2 files changed, 27 insertions(+), 26 deletions(-) diff --git a/.testing/Makefile b/.testing/Makefile index 6350efdb9e..0c939e1e39 100644 --- a/.testing/Makefile +++ b/.testing/Makefile @@ -28,25 +28,6 @@ MKMF_CPP = "-Duse_libMPI -Duse_netCDF -DSPMD" MKMF_TEMPLATE ?= ncrc-gnu.mk #MKMF_TEMPLATE ?= ncrc-intel.mk -#--- -# Repository configuration - -# NOTE: MOM_TARGET_REMOTE_NAME and MOM_MERGED_BRANCH are arbitrary -# TODO: check for conflicts with existing branchs and remotes? -# TODO: Define them appropriately (if at all) when DO_REGRESSION_TESTS is false - -# URL-friendly target repo name (TRAVIS_REPO_SLUG) -MOM_TARGET_SLUG ?= NOAA-GFDL/MOM6 -MOM_TARGET_URL ?= https://github.com/$(MOM_TARGET_SLUG) - -# Target branch name (TRAVIS_BRANCH) -MOM_TARGET_LOCAL_BRANCH ?= dev/gfdl - -MOM_TARGET_REMOTE_NAME ?= target -MOM_TARGET_BRANCH := $(MOM_TARGET_REMOTE_NAME)/$(MOM_TARGET_LOCAL_BRANCH) - -MOM_MERGED_BRANCH ?= mergetest - #--- # Test configuration @@ -55,14 +36,33 @@ BUILDS = symmetric asymmetric repro CONFIGS := $(foreach n,$(shell seq 0 3),tc$(n)) TESTS = grids layouts restarts repros nans dims -# DO_REGRESSION_TESTS obtained from $(TRAVIS_PULL_REQUEST) -DO_REGRESSION_TESTS ?= "true" -ifneq ($(DO_REGRESSION_TESTS), false) +# The following variables are configured by Travis: +# DO_REGRESSION_TESTS: true if $(TRAVIS_PULL_REQUEST) is a PR number +# MOM_TARGET_SLUG: TRAVIS_REPO_SLUG +# MOM_TARGET_LOCAL_BRANCH: TRAVIS_BRANCH + +DO_REGRESSION_TESTS ?= +ifeq ($(DO_REGRESSION_TESTS), true) BUILDS += target TEST += regressions + + MOM_TARGET_SLUG ?= NOAA-GFDL/MOM6 + MOM_TARGET_URL ?= https://github.com/$(MOM_TARGET_SLUG) + + MOM_TARGET_LOCAL_BRANCH ?= dev/gfdl + MOM_TARGET_REMOTE_NAME ?= target + MOM_TARGET_BRANCH := $(MOM_TARGET_REMOTE_NAME)/$(MOM_TARGET_LOCAL_BRANCH) GIT_TARGET_REMOTE = .git/refs/remotes/$(MOM_TARGET_BRANCH) + + MOM_MERGED_BRANCH ?= mergetest else + MOM_TARGET_URL = + MOM_TARGET_LOCAL_BRANCH = + MOM_TARGET_BRANCH = GIT_TARGET_REMOTE = + + # Inert self-checkout of current branch + MOM_MERGED_BRANCH := $(shell git rev-parse --abbrev-ref HEAD) endif @@ -132,7 +132,7 @@ build/%/path_names: $(LIST_PATHS) .git/refs/heads/$(MOM_MERGED_BRANCH) # WARNING: Implicit dependency of GIT_TARGET_REMOTE and DO_REGRESSION_TESTS .git/refs/heads/$(MOM_MERGED_BRANCH): $(GIT_TARGET_REMOTE) git checkout -b $(MOM_MERGED_BRANCH) - if [ $(DO_REGRESSION_TESTS) != "false" ]; then \ + if [ $(DO_REGRESSION_TESTS) ]; then \ git merge --no-edit $(MOM_TARGET_BRANCH); \ fi git checkout @{-1} diff --git a/.travis.yml b/.travis.yml index b9a03104a2..2c17fb9443 100644 --- a/.travis.yml +++ b/.travis.yml @@ -40,13 +40,14 @@ jobs: - test ! -s doxy_errors - env: JOB="Compile and run" script: - - echo 'Configuring...' && echo -en 'travis_fold:start:script.1\\r' + - echo 'Build executables...' && echo -en 'travis_fold:start:script.1\\r' + - TRAVIS_IS_PR=$( [ ${TRAVIS_PULL_REQUEST} = "false" ] || echo "true" ) - make \ MKMF_TEMPLATE=linux-ubuntu-xenial-gnu.mk \ MOM_TARGET_SLUG=${TRAVIS_REPO_SLUG} \ MOM_TARGET_LOCAL_BRANCH=${TRAVIS_BRANCH} \ - DO_REGRESSION_TESTS=${TRAVIS_PULL_REQUEST} + DO_REGRESSION_TESTS=${TRAVIS_IS_PR} - echo -en 'travis_fold:end:script.1\\r' - echo 'Running tests...' && echo -en 'travis_fold:start:script.2\\r' - - make DO_REGRESSION_TESTS=${TRAVIS_PULL_REQUEST} test + - make DO_REGRESSION_TESTS=${TRAVIS_IS_PR} test - echo -en 'travis_fold:end:script.2\\r' From a8f3fb31b4a5a9c46135ad7dc0abd4e1184e35b5 Mon Sep 17 00:00:00 2001 From: Raphael Dussin Date: Thu, 22 Aug 2019 17:46:30 -0400 Subject: [PATCH 240/297] duh --- config_src/coupled_driver/MOM_surface_forcing.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/config_src/coupled_driver/MOM_surface_forcing.F90 b/config_src/coupled_driver/MOM_surface_forcing.F90 index f093b5b66f..917055a2f1 100644 --- a/config_src/coupled_driver/MOM_surface_forcing.F90 +++ b/config_src/coupled_driver/MOM_surface_forcing.F90 @@ -1574,7 +1574,7 @@ subroutine check_mask_val_consistency(val, mask, i, j) real, intent(in) :: val !< value of flux/variable passed by IOB real, intent(in) :: mask !< value of ocean mask - real, intent(in) :: i, j !< model grid cell indices + integer, intent(in) :: i, j !< model grid cell indices ! Local variables character(len=48) :: ci, cj !< model grid cell indices as strings character(len=256) :: error_message !< error message to be displayed From 36ca30dc3bf921fa00f5a24e0ef93bc30e3dfa03 Mon Sep 17 00:00:00 2001 From: Raphael Dussin Date: Thu, 22 Aug 2019 17:50:11 -0400 Subject: [PATCH 241/297] pff --- config_src/coupled_driver/MOM_surface_forcing.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/config_src/coupled_driver/MOM_surface_forcing.F90 b/config_src/coupled_driver/MOM_surface_forcing.F90 index 917055a2f1..a61db3a75e 100644 --- a/config_src/coupled_driver/MOM_surface_forcing.F90 +++ b/config_src/coupled_driver/MOM_surface_forcing.F90 @@ -1579,7 +1579,7 @@ subroutine check_mask_val_consistency(val, mask, i, j) character(len=48) :: ci, cj !< model grid cell indices as strings character(len=256) :: error_message !< error message to be displayed - if (mask == 0.) .and. (val /= 0.) then + if ((mask == 0.) .and. (val /= 0.)) then write(ci, '(I8)') i write(cj, '(I8)') j error_message = "MOM_surface_forcing: found non-zero value over land "//& From a04e559781b431660d50c4706a9056e2c93cb5d0 Mon Sep 17 00:00:00 2001 From: Graeme MacGilchrist Date: Thu, 22 Aug 2019 19:21:08 -0400 Subject: [PATCH 242/297] included diagnostics for T and h from internal heat, and improved logic --- .../vertical/MOM_geothermal.F90 | 74 ++++++++++++------- 1 file changed, 48 insertions(+), 26 deletions(-) diff --git a/src/parameterizations/vertical/MOM_geothermal.F90 b/src/parameterizations/vertical/MOM_geothermal.F90 index d2dc565bde..e80af18220 100644 --- a/src/parameterizations/vertical/MOM_geothermal.F90 +++ b/src/parameterizations/vertical/MOM_geothermal.F90 @@ -35,7 +35,9 @@ module MOM_geothermal 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. - integer :: id_internal_heat_tend_3d = -1 !< ID for 3D diagnostic of internal heat + integer :: id_internal_heat_heat_tendency = -1 !< ID for diagnostic of heat tendency + integer :: id_internal_heat_temp_tendency = -1 !< ID for diagnostic of temperature tendency + integer :: id_internal_heat_h_tendency = -1 !< ID for diagnostic of thickness tendency end type geothermal_CS @@ -102,12 +104,15 @@ subroutine geothermal(h, tv, dt, ea, eb, G, GV, CS, halo) real :: Irho_cp ! inverse of heat capacity per unit layer volume ! [degC H m2 J-1 ~> degC m3 J-1 or degC kg J-1] - real :: T_old ! Temperature of each layer before any heat is added, - ! for diagnostics [degC] - real, allocatable, dimension(:,:,:) :: h_old ! Thickness of each layer before any heat is added, - ! for diagnostics [m or kg m-2] - real, allocatable, dimension(:,:,:) :: work_3d ! Scratch variable used to calculate change in heat - ! due to geothermal + real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: T_old ! Temperature of each layer + ! before any heat is added, + ! for diagnostics [degC] + real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: h_old ! Thickness of each layer + ! before any heat is added, + ! for diagnostics [m or kg m-2] + real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: work_3d ! Scratch variable used to + ! calculate change in heat + ! due to geothermal real :: Idt ! inverse of the timestep [s-1] logical :: do_i(SZI_(G)) @@ -147,12 +152,6 @@ subroutine geothermal(h, tv, dt, ea, eb, G, GV, CS, halo) !$OMP wt_in_place,dTemp,dRcv,h_transfer,heating, & !$OMP I_h) - ! Allocate diagnostic arrays if required - if (CS%id_internal_heat_tend_3d > 0) then - allocate(h_old(is:ie,js:je,nz)) ; h_old(:,:,:) = 0.0 - allocate(work_3d(is:ie,js:je,nz)) ; work_3d(:,:,:) = 0.0 - endif - do j=js,je ! 1. Only work on columns that are being heated. ! 2. Find the deepest layer with any mass. @@ -193,10 +192,15 @@ subroutine geothermal(h, tv, dt, ea, eb, G, GV, CS, halo) do i=isj,iej ; if (do_i(i)) then ! Save temperature and thickness before any changes are made (for diagnostic) - if (CS%id_internal_heat_tend_3d > 0) then - T_old = tv%T(i,j,k) + if (CS%id_internal_heat_h_tendency > 0 & + .or. CS%id_internal_heat_heat_tendency & + .or. CS%id_internal_heat_temp_tendency ) then h_old(i,j,k) = h(i,j,k) endif + if (CS%id_internal_heat_heat_tendency > 0 .or. CS%id_internal_heat_temp_tendency) then + T_old(i,j,k) = tv%T(i,j,k) + endif + if (h(i,j,k) > Angstrom) then if ((h(i,j,k)-Angstrom) >= h_geo_rem(i)) then @@ -319,8 +323,8 @@ subroutine geothermal(h, tv, dt, ea, eb, G, GV, CS, halo) endif ! Calculate heat tendency due to addition and transfer of internal heat - if (CS%id_internal_heat_tend_3d > 0) then - work_3d(i,j,k) = ((GV%H_to_kg_m2 * tv%C_p) * Idt) * (h(i,j,k) * tv%T(i,j,k) - h_old(i,j,k) * T_old) + if (CS%id_internal_heat_heat_tendency > 0) then + work_3d(i,j,k) = ((GV%H_to_kg_m2 * tv%C_p) * Idt) * (h(i,j,k) * tv%T(i,j,k) - h_old(i,j,k) * T_old(i,j,k)) endif endif ; enddo @@ -333,11 +337,21 @@ subroutine geothermal(h, tv, dt, ea, eb, G, GV, CS, halo) enddo ; endif enddo ! j-loop - ! Post diagnostic of internal heat tendency in 3D - if (CS%id_internal_heat_tend_3d > 0) then - call post_data(CS%id_internal_heat_tend_3d, work_3d, CS%diag, alt_h = h_old) - deallocate(h_old) - deallocate(work_3d) + ! Post diagnostic of 3D tendencies (heat, temperature, and thickness) due to internal heat + if (CS%id_internal_heat_heat_tendency > 0) then + call post_data(CS%id_internal_heat_heat_tendemcy, work_3d, CS%diag, alt_h = h_old) + endif + if (CS%id_internal_heat_temp_tendency > 0) then + do j=js,je; do i=is,ie; do k=ks,ke + work_3d(i,j,k) = Idt * (tv%T(i,j,k) - T_old(i,j,k)) + enddo; enddo; enddo + call post_data(CS%id_T_internal_heat_temp_tendency, work_3d, CS%diag, alt_h = h_old) + endif + if (CS%id_internal_heat_h_tendency > 0) then + do j=js,je; do i=is,ie; do k=ks,ke + work_3d(i,j,k) = Idt * (h(i,j,k) - h_old(i,j,k)) + enddo; enddo; enddo + call post_data(CS%id_internal_heat_h_tendency, work_3d, CS%diag, alt_h = h_old) endif ! do i=is,ie ; do j=js,je @@ -428,11 +442,19 @@ subroutine geothermal_init(Time, G, param_file, diag, CS) x_cell_method='mean', y_cell_method='mean', area_cell_method='mean') if (id > 0) call post_data(id, CS%geo_heat, diag, .true.) - ! Diagnostic for tendency due to internal heat (in 3d) - CS%id_internal_heat_tend_3d=register_diag_field('ocean_model', & - 'internal_heat_tend_3d', diag%axesTL, Time, & - '3D heat tendency due to internal (geothermal) sources', & + ! Diagnostic for tendencies due to internal heat (in 3d) + CS%id_internal_heat_heat_tendency=register_diag_field('ocean_model', & + 'internal_heat_heat_tendency', diag%axesTL, Time, & + 'Heat tendency (in 3D) due to internal (geothermal) sources', & 'W m-2', v_extensive = .true.) + CS%id_internal_heat_temp_tendency=register_diag_field('ocean_model', & + 'internal_heat_temp_tendency', diag%axesTL, Time, & + 'Temperature tendency (in 3D) due to internal (geothermal) sources', & + 'degC s-1', v_extensive = .true.) + CS%id_internal_heat_h_tendency=register_diag_field('ocean_model', & + 'internal_heat_h_tendency', diag%axesTL, Time, & + 'Thickness tendency (in 3D) due to internal (geothermal) sources', & + 'm OR kg m-2', v_extensive = .true.) end subroutine geothermal_init From ed7382e1a731d13b718c9d1b4bfd13875ca1a5cf Mon Sep 17 00:00:00 2001 From: Graeme MacGilchrist Date: Thu, 22 Aug 2019 19:25:32 -0400 Subject: [PATCH 243/297] minor adjustment --- src/parameterizations/vertical/MOM_geothermal.F90 | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/src/parameterizations/vertical/MOM_geothermal.F90 b/src/parameterizations/vertical/MOM_geothermal.F90 index e80af18220..5c29c3667c 100644 --- a/src/parameterizations/vertical/MOM_geothermal.F90 +++ b/src/parameterizations/vertical/MOM_geothermal.F90 @@ -339,16 +339,16 @@ subroutine geothermal(h, tv, dt, ea, eb, G, GV, CS, halo) ! Post diagnostic of 3D tendencies (heat, temperature, and thickness) due to internal heat if (CS%id_internal_heat_heat_tendency > 0) then - call post_data(CS%id_internal_heat_heat_tendemcy, work_3d, CS%diag, alt_h = h_old) + call post_data(CS%id_internal_heat_heat_tendency, work_3d, CS%diag, alt_h = h_old) endif if (CS%id_internal_heat_temp_tendency > 0) then - do j=js,je; do i=is,ie; do k=ks,ke + do j=js,je; do i=is,ie; do k=nz,1,-1 work_3d(i,j,k) = Idt * (tv%T(i,j,k) - T_old(i,j,k)) enddo; enddo; enddo - call post_data(CS%id_T_internal_heat_temp_tendency, work_3d, CS%diag, alt_h = h_old) + call post_data(CS%id_internal_heat_temp_tendency, work_3d, CS%diag, alt_h = h_old) endif if (CS%id_internal_heat_h_tendency > 0) then - do j=js,je; do i=is,ie; do k=ks,ke + do j=js,je; do i=is,ie; do k=nz,1,-1 work_3d(i,j,k) = Idt * (h(i,j,k) - h_old(i,j,k)) enddo; enddo; enddo call post_data(CS%id_internal_heat_h_tendency, work_3d, CS%diag, alt_h = h_old) @@ -455,7 +455,7 @@ subroutine geothermal_init(Time, G, param_file, diag, CS) 'internal_heat_h_tendency', diag%axesTL, Time, & 'Thickness tendency (in 3D) due to internal (geothermal) sources', & 'm OR kg m-2', v_extensive = .true.) - + end subroutine geothermal_init !> Clean up and deallocate memory associated with the geothermal heating module. From ebec6108ef6bb30022f0a7be24cb62c80a491d7c Mon Sep 17 00:00:00 2001 From: Graeme MacGilchrist Date: Thu, 22 Aug 2019 23:11:17 -0400 Subject: [PATCH 244/297] removed whitespace --- src/parameterizations/vertical/MOM_geothermal.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/parameterizations/vertical/MOM_geothermal.F90 b/src/parameterizations/vertical/MOM_geothermal.F90 index 5c29c3667c..5885473459 100644 --- a/src/parameterizations/vertical/MOM_geothermal.F90 +++ b/src/parameterizations/vertical/MOM_geothermal.F90 @@ -455,7 +455,7 @@ subroutine geothermal_init(Time, G, param_file, diag, CS) 'internal_heat_h_tendency', diag%axesTL, Time, & 'Thickness tendency (in 3D) due to internal (geothermal) sources', & 'm OR kg m-2', v_extensive = .true.) - + end subroutine geothermal_init !> Clean up and deallocate memory associated with the geothermal heating module. From 7c811e2bd9e87fb77c18cf4268d62a4378660468 Mon Sep 17 00:00:00 2001 From: Graeme MacGilchrist Date: Thu, 22 Aug 2019 23:59:44 -0400 Subject: [PATCH 245/297] fixed problem in conditional statements --- src/parameterizations/vertical/MOM_geothermal.F90 | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/src/parameterizations/vertical/MOM_geothermal.F90 b/src/parameterizations/vertical/MOM_geothermal.F90 index 5885473459..10fe37da89 100644 --- a/src/parameterizations/vertical/MOM_geothermal.F90 +++ b/src/parameterizations/vertical/MOM_geothermal.F90 @@ -193,11 +193,12 @@ subroutine geothermal(h, tv, dt, ea, eb, G, GV, CS, halo) ! Save temperature and thickness before any changes are made (for diagnostic) if (CS%id_internal_heat_h_tendency > 0 & - .or. CS%id_internal_heat_heat_tendency & - .or. CS%id_internal_heat_temp_tendency ) then + .or. CS%id_internal_heat_heat_tendency > 0 & + .or. CS%id_internal_heat_temp_tendency > 0 ) then h_old(i,j,k) = h(i,j,k) endif - if (CS%id_internal_heat_heat_tendency > 0 .or. CS%id_internal_heat_temp_tendency) then + if (CS%id_internal_heat_heat_tendency > 0 & + .or. CS%id_internal_heat_temp_tendency > 0) then T_old(i,j,k) = tv%T(i,j,k) endif From c22265d33184eb60e0266f9465e05c37892c920b Mon Sep 17 00:00:00 2001 From: Marshall Ward Date: Fri, 23 Aug 2019 10:37:25 -0400 Subject: [PATCH 246/297] Skip checkout/merge for non-regression tests Out Travis testing makefile relied on `git rev-parse` to determine its branch name, but this does not work for pushes which returns the name of HEAD. We were running the non-regression builds through the same rule which merges the target reference codebase, but were relying on these to be null operations since they were operating on themselves. But this was always a poor strategy. We resolve this by un-defining the dependency on the rule which creates this new merged branch, and should skip the checkout/merge step altogether. (But we shall see...) --- .testing/Makefile | 12 +++++++++--- 1 file changed, 9 insertions(+), 3 deletions(-) diff --git a/.testing/Makefile b/.testing/Makefile index 0c939e1e39..ae57d6d69b 100644 --- a/.testing/Makefile +++ b/.testing/Makefile @@ -40,6 +40,9 @@ TESTS = grids layouts restarts repros nans dims # DO_REGRESSION_TESTS: true if $(TRAVIS_PULL_REQUEST) is a PR number # MOM_TARGET_SLUG: TRAVIS_REPO_SLUG # MOM_TARGET_LOCAL_BRANCH: TRAVIS_BRANCH +# +# MOM_TARGET_REMOTE_NAME and MOM_MERGED_BRANCH are arbitrary labels which may +# cause namespace conflicts, and should probably be renamed or phased out. DO_REGRESSION_TESTS ?= ifeq ($(DO_REGRESSION_TESTS), true) @@ -55,6 +58,7 @@ ifeq ($(DO_REGRESSION_TESTS), true) GIT_TARGET_REMOTE = .git/refs/remotes/$(MOM_TARGET_BRANCH) MOM_MERGED_BRANCH ?= mergetest + GIT_MERGED_HEAD = .git/refs/heads/$(MOM_MERGED_BRANCH) else MOM_TARGET_URL = MOM_TARGET_LOCAL_BRANCH = @@ -62,7 +66,9 @@ else GIT_TARGET_REMOTE = # Inert self-checkout of current branch - MOM_MERGED_BRANCH := $(shell git rev-parse --abbrev-ref HEAD) + #MOM_MERGED_BRANCH := $(shell git rev-parse --abbrev-ref HEAD) + MOM_MERGED_BRANCH = + GIT_MERGED_HEAD = endif @@ -116,7 +122,7 @@ build/target/path_names: $(LIST_PATHS) $(GIT_TARGET_REMOTE) ../../$(GRID_SRC) git checkout @{-1} -build/%/path_names: $(LIST_PATHS) .git/refs/heads/$(MOM_MERGED_BRANCH) +build/%/path_names: $(LIST_PATHS) $(GIT_MERGED_HEAD) git checkout $(BRANCH) mkdir -p $(@D) cd $(@D) && $(LIST_PATHS) -l \ @@ -130,7 +136,7 @@ build/%/path_names: $(LIST_PATHS) .git/refs/heads/$(MOM_MERGED_BRANCH) # Repository management # WARNING: Implicit dependency of GIT_TARGET_REMOTE and DO_REGRESSION_TESTS -.git/refs/heads/$(MOM_MERGED_BRANCH): $(GIT_TARGET_REMOTE) +$(GIT_MERGED_HEAD): $(GIT_TARGET_REMOTE) git checkout -b $(MOM_MERGED_BRANCH) if [ $(DO_REGRESSION_TESTS) ]; then \ git merge --no-edit $(MOM_TARGET_BRANCH); \ From 74df31a2b80d88566645f45b55b5f4fb586da231 Mon Sep 17 00:00:00 2001 From: Matthew Harrison Date: Fri, 23 Aug 2019 15:19:23 -0400 Subject: [PATCH 247/297] *Adjust Segment Data Thicknesses - previously, the code was treating the segment data thicknesses as given, without adjustments for model bathymetry. This change starts with the reported dz and compresses to an Angstrom below the level of bathymetry in the case where the segment thicknesses are in excess. If the segments are deficient, then layers are uniformly expanded. This procedure follows model dz adjustments upon initilization. --- src/core/MOM_open_boundary.F90 | 117 +++++++++++++++++++++++++++++++++ 1 file changed, 117 insertions(+) diff --git a/src/core/MOM_open_boundary.F90 b/src/core/MOM_open_boundary.F90 index 7117850880..2a86e69092 100644 --- a/src/core/MOM_open_boundary.F90 +++ b/src/core/MOM_open_boundary.F90 @@ -3229,6 +3229,8 @@ subroutine update_OBC_segment_data(G, GV, US, OBC, tv, h, Time) endif endif + call adjustSegmentEtaToFitBathymetry(G,GV,US,segment,m) + if (segment%is_E_or_W) then ishift=1 if (segment%direction == OBC_DIRECTION_E) ishift=0 @@ -4051,6 +4053,121 @@ subroutine open_boundary_register_restarts(HI, GV, OBC_CS,restart_CSp) end subroutine open_boundary_register_restarts +!> Adjust interface heights to fit the bathymetry and diagnose layer thickness. +!! +!! If the bottom most interface is below the topography then the bottom-most +!! layers are contracted to GV%Angstrom_m. +!! If the bottom most interface is above the topography then the entire column +!! is dilated (expanded) to fill the void. +!! @remark{There is a (hard-wired) "tolerance" parameter such that the +!! criteria for adjustment must equal or exceed 10cm.} +subroutine adjustSegmentEtaToFitBathymetry(G, GV, US, segment,fld) + 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(OBC_segment_type), intent(inout) :: segment !< pointer to segment type + integer, intent(in) :: fld + ! Local variables + integer :: i, j, k, is, ie, js, je, nz, contractions, dilations + integer :: n, ishift,jshift + real, allocatable, dimension(:,:,:) :: eta ! Segment source data interface heights, [Z -> m] + real :: hTolerance = 0.1 !< Tolerance to exceed adjustment criteria [Z ~> m] + real :: hTmp, eTmp, dilate + character(len=100) :: mesg + + nz = G%ke + hTolerance = 0.1*US%m_to_Z + + ishift=0;jshift=0 + if (segment%is_E_or_W) then + if (segment%field(fld)%name == 'V' .or. segment%field(fld)%name == 'DVDX') then + is = segment%HI%isdB ; ie = segment%HI%iedB + js = segment%HI%jsdB ; je = segment%HI%jedB + else + is = segment%HI%isd ; ie = segment%HI%ied + js = segment%HI%jsd ; je = segment%HI%jed + endif + if (segment%direction == OBC_DIRECTION_W) ishift=1 + else + if (segment%field(fld)%name == 'U' .or. segment%field(fld)%name == 'DUDY') then + is = segment%HI%isdB ; ie = segment%HI%iedB + js = segment%HI%jsdB ; je = segment%HI%jedB + else + is = segment%HI%isd ; ie = segment%HI%ied + js = segment%HI%jsd ; je = segment%HI%jed + endif + if (segment%direction == OBC_DIRECTION_S) jshift=1 + endif + allocate(eta(is:ie,js:je,nz+1)) + contractions=0; dilations=0 + do j=js,je ; do i=is,ie + eta(i,j,1)=0.0 ! segment data are assumed to be located on a static grid + ! For remapping calls, the entire column will be dilated + ! by a factor equal to the ratio of the sum of the geopotential referenced + ! source data thicknesses, and the current model thicknesses. This could be + ! an issue to be addressed, for instance if we are placing open boundaries + ! under ice shelf cavities. + do k=2,nz+1 + eta(i,j,k)=eta(i,j,k-1)-segment%field(fld)%dz_src(i,j,k) + enddo + ! The normal slope at the boundary is zero by a + ! previous call to open_boundary_impose_normal_slope + do k=nz+1,1,-1 + if (-eta(i,j,k) > segment%htot(i,j) + hTolerance) then + eta(i,j,k) = -segment%htot(i,j) + contractions = contractions + 1 + endif + enddo + + do k=1,nz + ! Collapse layers to thinnest possible if the thickness less than + ! the thinnest possible (or negative). + if (eta(i,j,K) < (eta(i,j,K+1) + GV%Angstrom_Z)) then + eta(i,j,K) = eta(i,j,K+1) + GV%Angstrom_Z + segment%field(fld)%dz_src(i,j,k) = GV%Angstrom_Z + else + segment%field(fld)%dz_src(i,j,k) = (eta(i,j,K) - eta(i,j,K+1)) + endif + enddo + + ! The whole column is dilated to accommodate deeper topography than + ! the bathymetry would indicate. + if (-eta(i,j,nz+1) < segment%htot(i,j) - hTolerance) then + dilations = dilations + 1 + if (eta(i,j,1) <= eta(i,j,nz+1)) then + do k=1,nz ; segment%field(fld)%dz_src(i,j,k) = (eta(i,j,1) + segment%htot(i,j)) / real(nz) ; enddo + else + dilate = (eta(i,j,1) + segment%htot(i,j)) / (eta(i,j,1) - eta(i,j,nz+1)) + do k=1,nz ; segment%field(fld)%dz_src(i,j,k) = segment%field(fld)%dz_src(i,j,k) * dilate ; enddo + endif + do k=nz,2,-1 ; eta(i,j,K) = eta(i,j,K+1) + segment%field(fld)%dz_src(i,j,k) ; enddo + endif + ! Now convert thicknesses to units of H. + do k=1,nz + segment%field(fld)%dz_src(i,j,k) = segment%field(fld)%dz_src(i,j,k)*GV%Z_to_H + enddo + enddo; enddo + + ! can not do communication call here since only PEs on the current segment are here + + ! call sum_across_PEs(contractions) + ! if ((contractions > 0) .and. (is_root_pe())) then + ! write(mesg,'("Thickness OBCs were contracted ",'// & + ! '"to fit topography in ",I8," places.")') contractions + ! call MOM_error(WARNING, 'adjustEtaToFitBathymetry: '//mesg) + ! endif + ! call sum_across_PEs(dilations) + ! if ((dilations > 0) .and. (is_root_pe())) then + ! write(mesg,'("Thickness OBCs were dilated ",'// & + ! '"to fit topography in ",I8," places.")') dilations + ! call MOM_error(WARNING, 'adjustEtaToFitBathymetry: '//mesg) + ! endif + deallocate(eta) + + + +end subroutine adjustSegmentEtaToFitBathymetry + !> \namespace mom_open_boundary !! This module implements some aspects of internal open boundary !! conditions in MOM. From 870c71ea15eaabfc3cf679e7348f95852cfd1209 Mon Sep 17 00:00:00 2001 From: Raphael Dussin Date: Fri, 23 Aug 2019 15:52:22 -0400 Subject: [PATCH 248/297] add more verbosity --- .../coupled_driver/MOM_surface_forcing.F90 | 47 ++++++++++--------- 1 file changed, 25 insertions(+), 22 deletions(-) diff --git a/config_src/coupled_driver/MOM_surface_forcing.F90 b/config_src/coupled_driver/MOM_surface_forcing.F90 index a61db3a75e..74e36d5908 100644 --- a/config_src/coupled_driver/MOM_surface_forcing.F90 +++ b/config_src/coupled_driver/MOM_surface_forcing.F90 @@ -408,51 +408,51 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, US, CS, sfc if (associated(IOB%lprec)) & fluxes%lprec(i,j) = IOB%lprec(i-i0,j-j0) * G%mask2dT(i,j) - call check_mask_val_consistency(IOB%lprec(i-i0,j-j0), G%mask2dT(i,j), i, j) + call check_mask_val_consistency(IOB%lprec(i-i0,j-j0), G%mask2dT(i,j), i, j, 'lprec') if (associated(IOB%fprec)) & fluxes%fprec(i,j) = IOB%fprec(i-i0,j-j0) * G%mask2dT(i,j) - call check_mask_val_consistency(IOB%fprec(i-i0,j-j0), G%mask2dT(i,j), i, j) + call check_mask_val_consistency(IOB%fprec(i-i0,j-j0), G%mask2dT(i,j), i, j, 'fprec') if (associated(IOB%q_flux)) & fluxes%evap(i,j) = - IOB%q_flux(i-i0,j-j0) * G%mask2dT(i,j) - call check_mask_val_consistency(IOB%q_flux(i-i0,j-j0), G%mask2dT(i,j), i, j) + call check_mask_val_consistency(IOB%q_flux(i-i0,j-j0), G%mask2dT(i,j), i, j, 'q_flux') if (associated(IOB%runoff)) & fluxes%lrunoff(i,j) = IOB%runoff(i-i0,j-j0) * G%mask2dT(i,j) - call check_mask_val_consistency(IOB%runoff(i-i0,j-j0), G%mask2dT(i,j), i, j) + call check_mask_val_consistency(IOB%runoff(i-i0,j-j0), G%mask2dT(i,j), i, j, 'runoff') if (associated(IOB%calving)) & fluxes%frunoff(i,j) = IOB%calving(i-i0,j-j0) * G%mask2dT(i,j) - call check_mask_val_consistency(IOB%calving(i-i0,j-j0), G%mask2dT(i,j), i, j) + call check_mask_val_consistency(IOB%calving(i-i0,j-j0), G%mask2dT(i,j), i, j, 'calving') if (associated(IOB%ustar_berg)) & fluxes%ustar_berg(i,j) = US%m_to_Z*US%T_to_s * IOB%ustar_berg(i-i0,j-j0) * G%mask2dT(i,j) - call check_mask_val_consistency(IOB%ustar_berg(i-i0,j-j0), G%mask2dT(i,j), i, j) + call check_mask_val_consistency(IOB%ustar_berg(i-i0,j-j0), G%mask2dT(i,j), i, j, 'ustar_berg') if (associated(IOB%area_berg)) & fluxes%area_berg(i,j) = IOB%area_berg(i-i0,j-j0) * G%mask2dT(i,j) - call check_mask_val_consistency(IOB%area_berg(i-i0,j-j0), G%mask2dT(i,j), i, j) + call check_mask_val_consistency(IOB%area_berg(i-i0,j-j0), G%mask2dT(i,j), i, j, 'area_berg') if (associated(IOB%mass_berg)) & fluxes%mass_berg(i,j) = IOB%mass_berg(i-i0,j-j0) * G%mask2dT(i,j) - call check_mask_val_consistency(IOB%mass_berg(i-i0,j-j0), G%mask2dT(i,j), i, j) + call check_mask_val_consistency(IOB%mass_berg(i-i0,j-j0), G%mask2dT(i,j), i, j, 'mass_berg') if (associated(IOB%runoff_hflx)) & fluxes%heat_content_lrunoff(i,j) = IOB%runoff_hflx(i-i0,j-j0) * G%mask2dT(i,j) - call check_mask_val_consistency(IOB%runoff_hflx(i-i0,j-j0), G%mask2dT(i,j), i, j) + call check_mask_val_consistency(IOB%runoff_hflx(i-i0,j-j0), G%mask2dT(i,j), i, j, 'runoff_hflx') if (associated(IOB%calving_hflx)) & fluxes%heat_content_frunoff(i,j) = IOB%calving_hflx(i-i0,j-j0) * G%mask2dT(i,j) - call check_mask_val_consistency(IOB%calving_hflx(i-i0,j-j0), G%mask2dT(i,j), i, j) + call check_mask_val_consistency(IOB%calving_hflx(i-i0,j-j0), G%mask2dT(i,j), i, j, 'calving_hflx') if (associated(IOB%lw_flux)) & fluxes%LW(i,j) = IOB%lw_flux(i-i0,j-j0) * G%mask2dT(i,j) - call check_mask_val_consistency(IOB%lw_flux(i-i0,j-j0), G%mask2dT(i,j), i, j) + call check_mask_val_consistency(IOB%lw_flux(i-i0,j-j0), G%mask2dT(i,j), i, j, 'lw_flux') if (associated(IOB%t_flux)) & fluxes%sens(i,j) = - IOB%t_flux(i-i0,j-j0) * G%mask2dT(i,j) - call check_mask_val_consistency(IOB%t_flux(i-i0,j-j0), G%mask2dT(i,j), i, j) + call check_mask_val_consistency(IOB%t_flux(i-i0,j-j0), G%mask2dT(i,j), i, j, 't_flux') fluxes%latent(i,j) = 0.0 if (associated(IOB%fprec)) then @@ -472,16 +472,16 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, US, CS, sfc 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) - call check_mask_val_consistency(IOB%sw_flux_vis_dir(i-i0,j-j0), G%mask2dT(i,j), i, j) + call check_mask_val_consistency(IOB%sw_flux_vis_dir(i-i0,j-j0), G%mask2dT(i,j), i, j, 'sw_flux_vis_dir') 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) - call check_mask_val_consistency(IOB%sw_flux_vis_dif(i-i0,j-j0), G%mask2dT(i,j), i, j) + call check_mask_val_consistency(IOB%sw_flux_vis_dif(i-i0,j-j0), G%mask2dT(i,j), i, j, 'sw_flux_vis_dif') 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) - call check_mask_val_consistency(IOB%sw_flux_nir_dir(i-i0,j-j0), G%mask2dT(i,j), i, j) + call check_mask_val_consistency(IOB%sw_flux_nir_dir(i-i0,j-j0), G%mask2dT(i,j), i, j, 'sw_flux_nir_dir') 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) - call check_mask_val_consistency(IOB%sw_flux_nir_dif(i-i0,j-j0), G%mask2dT(i,j), i, j) + call check_mask_val_consistency(IOB%sw_flux_nir_dif(i-i0,j-j0), G%mask2dT(i,j), i, j, 'sw_flux_nir_dif') 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) @@ -492,13 +492,13 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, US, CS, sfc 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) - call check_mask_val_consistency(IOB%p(i-i0,j-j0), G%mask2dT(i,j), i, j) + call check_mask_val_consistency(IOB%p(i-i0,j-j0), G%mask2dT(i,j), i, j, 'p') 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) - call check_mask_val_consistency(IOB%p(i-i0,j-j0), G%mask2dT(i,j), i, j) + call check_mask_val_consistency(IOB%p(i-i0,j-j0), G%mask2dT(i,j), i, j, 'p') fluxes%p_surf(i,j) = fluxes%p_surf_full(i,j) enddo ; enddo endif @@ -510,7 +510,7 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, US, CS, sfc 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) ) - call check_mask_val_consistency(IOB%salt_flux(i-i0,j-j0), G%mask2dT(i,j), i, j) + call check_mask_val_consistency(IOB%salt_flux(i-i0,j-j0), G%mask2dT(i,j), i, j, 'salt_flux') enddo ; enddo endif @@ -1570,20 +1570,23 @@ subroutine ice_ocn_bnd_type_chksum(id, timestep, iobt) end subroutine ice_ocn_bnd_type_chksum !> Check the values passed by IOB over land are zero -subroutine check_mask_val_consistency(val, mask, i, j) +subroutine check_mask_val_consistency(val, mask, i, j, varname) real, intent(in) :: val !< value of flux/variable passed by IOB real, intent(in) :: mask !< value of ocean mask integer, intent(in) :: i, j !< model grid cell indices + character(len=48), intent(in) :: varname !< variable name ! Local variables character(len=48) :: ci, cj !< model grid cell indices as strings + character(len=48) :: cval !< value to be displayed character(len=256) :: error_message !< error message to be displayed if ((mask == 0.) .and. (val /= 0.)) then write(ci, '(I8)') i write(cj, '(I8)') j - error_message = "MOM_surface_forcing: found non-zero value over land "//& - "at point (i, j) = ("//trim(ci)//", "//trim(cj)//")" + write(cval, '(F8.2)') val + error_message = "MOM_surface_forcing: found non-zero value (="//trim(cval)//") over land "//& + "for variable"//trim(varname)//"at point (i, j) = ("//trim(ci)//", "//trim(cj)//")" call MOM_error(FATAL, error_message) endif From 097f91280ce7ce0d33061cc1625e8546060a0ef0 Mon Sep 17 00:00:00 2001 From: Raphael Dussin Date: Fri, 23 Aug 2019 16:01:05 -0400 Subject: [PATCH 249/297] char len change --- config_src/coupled_driver/MOM_surface_forcing.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/config_src/coupled_driver/MOM_surface_forcing.F90 b/config_src/coupled_driver/MOM_surface_forcing.F90 index 74e36d5908..5f32fbeb94 100644 --- a/config_src/coupled_driver/MOM_surface_forcing.F90 +++ b/config_src/coupled_driver/MOM_surface_forcing.F90 @@ -1575,7 +1575,7 @@ subroutine check_mask_val_consistency(val, mask, i, j, varname) real, intent(in) :: val !< value of flux/variable passed by IOB real, intent(in) :: mask !< value of ocean mask integer, intent(in) :: i, j !< model grid cell indices - character(len=48), intent(in) :: varname !< variable name + character(len=*), intent(in) :: varname !< variable name ! Local variables character(len=48) :: ci, cj !< model grid cell indices as strings character(len=48) :: cval !< value to be displayed From e8b9ebf589aecff741bb6b32b992ce3820aa78a6 Mon Sep 17 00:00:00 2001 From: Raphael Dussin Date: Fri, 23 Aug 2019 16:17:02 -0400 Subject: [PATCH 250/297] change precision output string --- config_src/coupled_driver/MOM_surface_forcing.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/config_src/coupled_driver/MOM_surface_forcing.F90 b/config_src/coupled_driver/MOM_surface_forcing.F90 index 5f32fbeb94..bba78c6ce5 100644 --- a/config_src/coupled_driver/MOM_surface_forcing.F90 +++ b/config_src/coupled_driver/MOM_surface_forcing.F90 @@ -1584,9 +1584,9 @@ subroutine check_mask_val_consistency(val, mask, i, j, varname) if ((mask == 0.) .and. (val /= 0.)) then write(ci, '(I8)') i write(cj, '(I8)') j - write(cval, '(F8.2)') val + write(cval, '(E22.16)') val error_message = "MOM_surface_forcing: found non-zero value (="//trim(cval)//") over land "//& - "for variable"//trim(varname)//"at point (i, j) = ("//trim(ci)//", "//trim(cj)//")" + "for variable "//trim(varname)//" at point (i, j) = ("//trim(ci)//", "//trim(cj)//")" call MOM_error(FATAL, error_message) endif From 7ba25aee155dcb8dd1bc44472d552a84e1a67a6a Mon Sep 17 00:00:00 2001 From: Marshall Ward Date: Fri, 23 Aug 2019 19:49:50 -0400 Subject: [PATCH 251/297] Fixed typo; removed old comment --- .testing/Makefile | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/.testing/Makefile b/.testing/Makefile index ae57d6d69b..b0f38e6166 100644 --- a/.testing/Makefile +++ b/.testing/Makefile @@ -66,7 +66,6 @@ else GIT_TARGET_REMOTE = # Inert self-checkout of current branch - #MOM_MERGED_BRANCH := $(shell git rev-parse --abbrev-ref HEAD) MOM_MERGED_BRANCH = GIT_MERGED_HEAD = endif @@ -191,7 +190,7 @@ test: $(foreach t,$(TESTS),test.$(t)) # NOTE: We remove tc3 (OBC) from grid test .PHONY: $(foreach t,$(TESTS),test.$(t)) -test.regressions: $(foreach c,$(CONFIGS),$(c).regreession $(c).regression.diag) +test.regressions: $(foreach c,$(CONFIGS),$(c).regression $(c).regression.diag) test.grids: $(foreach c,$(filter-out tc3,$(CONFIGS)),$(c).grid $(c).grid.diag) test.layouts: $(foreach c,$(CONFIGS),$(c).layout $(c).layout.diag) test.restarts: $(foreach c,$(CONFIGS),$(c).restart) From 5adefb79a4d4fd4019ba3e909d27cbdb08eb3b44 Mon Sep 17 00:00:00 2001 From: Matthew Harrison Date: Sun, 25 Aug 2019 07:50:01 -0400 Subject: [PATCH 252/297] *Fixed routine for adjusting segment data thicknesses. -bugfixes -If source data has deficient vertical extent, then entend bottom-most cell instead of dilating the entire column --- src/core/MOM_open_boundary.F90 | 52 ++++++++++++++-------------------- 1 file changed, 22 insertions(+), 30 deletions(-) diff --git a/src/core/MOM_open_boundary.F90 b/src/core/MOM_open_boundary.F90 index 2a86e69092..100f66f54a 100644 --- a/src/core/MOM_open_boundary.F90 +++ b/src/core/MOM_open_boundary.F90 @@ -4069,34 +4069,23 @@ subroutine adjustSegmentEtaToFitBathymetry(G, GV, US, segment,fld) integer, intent(in) :: fld ! Local variables integer :: i, j, k, is, ie, js, je, nz, contractions, dilations - integer :: n, ishift,jshift + integer :: n real, allocatable, dimension(:,:,:) :: eta ! Segment source data interface heights, [Z -> m] real :: hTolerance = 0.1 !< Tolerance to exceed adjustment criteria [Z ~> m] real :: hTmp, eTmp, dilate character(len=100) :: mesg - nz = G%ke hTolerance = 0.1*US%m_to_Z - ishift=0;jshift=0 + nz = size(segment%field(fld)%dz_src,3) + if (segment%is_E_or_W) then - if (segment%field(fld)%name == 'V' .or. segment%field(fld)%name == 'DVDX') then - is = segment%HI%isdB ; ie = segment%HI%iedB - js = segment%HI%jsdB ; je = segment%HI%jedB - else - is = segment%HI%isd ; ie = segment%HI%ied - js = segment%HI%jsd ; je = segment%HI%jed - endif - if (segment%direction == OBC_DIRECTION_W) ishift=1 + ! segment thicknesses are defined at cell face centers. + is = segment%HI%isdB ; ie = segment%HI%iedB + js = segment%HI%jsd ; je = segment%HI%jed else - if (segment%field(fld)%name == 'U' .or. segment%field(fld)%name == 'DUDY') then - is = segment%HI%isdB ; ie = segment%HI%iedB - js = segment%HI%jsdB ; je = segment%HI%jedB - else - is = segment%HI%isd ; ie = segment%HI%ied - js = segment%HI%jsd ; je = segment%HI%jed - endif - if (segment%direction == OBC_DIRECTION_S) jshift=1 + is = segment%HI%isd ; ie = segment%HI%ied + js = segment%HI%jsdB ; je = segment%HI%jedB endif allocate(eta(is:ie,js:je,nz+1)) contractions=0; dilations=0 @@ -4108,13 +4097,13 @@ subroutine adjustSegmentEtaToFitBathymetry(G, GV, US, segment,fld) ! an issue to be addressed, for instance if we are placing open boundaries ! under ice shelf cavities. do k=2,nz+1 - eta(i,j,k)=eta(i,j,k-1)-segment%field(fld)%dz_src(i,j,k) + eta(i,j,k)=eta(i,j,k-1)-segment%field(fld)%dz_src(i,j,k-1) enddo ! The normal slope at the boundary is zero by a ! previous call to open_boundary_impose_normal_slope do k=nz+1,1,-1 - if (-eta(i,j,k) > segment%htot(i,j) + hTolerance) then - eta(i,j,k) = -segment%htot(i,j) + if (-eta(i,j,k) > segment%Htot(i,j) + hTolerance) then + eta(i,j,k) = -segment%Htot(i,j) contractions = contractions + 1 endif enddo @@ -4132,15 +4121,18 @@ subroutine adjustSegmentEtaToFitBathymetry(G, GV, US, segment,fld) ! The whole column is dilated to accommodate deeper topography than ! the bathymetry would indicate. - if (-eta(i,j,nz+1) < segment%htot(i,j) - hTolerance) then + if (-eta(i,j,nz+1) < segment%Htot(i,j) - hTolerance) then dilations = dilations + 1 - if (eta(i,j,1) <= eta(i,j,nz+1)) then - do k=1,nz ; segment%field(fld)%dz_src(i,j,k) = (eta(i,j,1) + segment%htot(i,j)) / real(nz) ; enddo - else - dilate = (eta(i,j,1) + segment%htot(i,j)) / (eta(i,j,1) - eta(i,j,nz+1)) - do k=1,nz ; segment%field(fld)%dz_src(i,j,k) = segment%field(fld)%dz_src(i,j,k) * dilate ; enddo - endif - do k=nz,2,-1 ; eta(i,j,K) = eta(i,j,K+1) + segment%field(fld)%dz_src(i,j,k) ; enddo + ! expand bottom-most cell only + eta(i,j,nz+1) = -segment%Htot(i,j) + segment%field(fld)%dz_src(i,k,nz)= eta(i,j,nz)-eta(i,j,nz+1) + ! if (eta(i,j,1) <= eta(i,j,nz+1)) then + ! do k=1,nz ; segment%field(fld)%dz_src(i,j,k) = (eta(i,j,1) + G%bathyT(i,j)) / real(nz) ; enddo + ! else + ! dilate = (eta(i,j,1) + G%bathyT(i,j)) / (eta(i,j,1) - eta(i,j,nz+1)) + ! do k=1,nz ; segment%field(fld)%dz_src(i,j,k) = segment%field(fld)%dz_src(i,j,k) * dilate ; enddo + ! endif + !do k=nz,2,-1 ; eta(i,j,K) = eta(i,j,K+1) + segment%field(fld)%dz_src(i,j,k) ; enddo endif ! Now convert thicknesses to units of H. do k=1,nz From 8828ecddcbd160a7efdb0e3662d791ecb346368b Mon Sep 17 00:00:00 2001 From: Matthew Harrison Date: Sun, 25 Aug 2019 13:09:45 -0400 Subject: [PATCH 253/297] Fix index error --- 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 100f66f54a..481197f85a 100644 --- a/src/core/MOM_open_boundary.F90 +++ b/src/core/MOM_open_boundary.F90 @@ -4125,7 +4125,7 @@ subroutine adjustSegmentEtaToFitBathymetry(G, GV, US, segment,fld) dilations = dilations + 1 ! expand bottom-most cell only eta(i,j,nz+1) = -segment%Htot(i,j) - segment%field(fld)%dz_src(i,k,nz)= eta(i,j,nz)-eta(i,j,nz+1) + segment%field(fld)%dz_src(i,j,nz)= eta(i,j,nz)-eta(i,j,nz+1) ! if (eta(i,j,1) <= eta(i,j,nz+1)) then ! do k=1,nz ; segment%field(fld)%dz_src(i,j,k) = (eta(i,j,1) + G%bathyT(i,j)) / real(nz) ; enddo ! else From 5b71b370117647d9dfbe0e05a25f4d432adfd62a Mon Sep 17 00:00:00 2001 From: Matthew Harrison Date: Mon, 26 Aug 2019 10:46:30 -0400 Subject: [PATCH 254/297] Fixes answer changes due to incomplete copy of tracer array --- src/tracer/MOM_tracer_advect.F90 | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/tracer/MOM_tracer_advect.F90 b/src/tracer/MOM_tracer_advect.F90 index 906c6d8be2..0fa09682fd 100644 --- a/src/tracer/MOM_tracer_advect.F90 +++ b/src/tracer/MOM_tracer_advect.F90 @@ -424,7 +424,7 @@ subroutine advect_x(Tr, hprev, uhr, uh_neglect, OBC, domore_u, ntr, Idt, & ! make a copy of the tracers in case values need to be overridden for OBCs do m = 1,ntr - do i=is-stencil,ie+stencil + do i=G%isd,G%ied T_tmp(i,m) = Tr(m)%t(i,j,k) enddo enddo @@ -790,9 +790,9 @@ subroutine advect_y(Tr, hprev, vhr, vh_neglect, OBC, domore_v, ntr, Idt, & ! make a copy of the tracers in case values need to be overridden for OBCs - do j=js-stencil,je+stencil ; if (do_j_tr(j)) then ; do m=1,ntr ; do i=is,ie + do j=G%jsd,G%jed; do m=1,ntr; do i=G%isd,G%ied T_tmp(i,m,j) = Tr(m)%t(i,j,k) - enddo ; enddo ; endif ; enddo + enddo ; enddo ; enddo ! loop through open boundaries and recalculate flux terms if (associated(OBC)) then ; if (OBC%OBC_pe) then From 9abe97600bdf736adbc3ec020d0d43c2deddef0c Mon Sep 17 00:00:00 2001 From: Marshall Ward Date: Mon, 26 Aug 2019 11:24:13 -0400 Subject: [PATCH 255/297] MKMF default template; Coverage report flag Two minor changes to improve usability outside of Travis. We first fix a bug where the default MKMF template file did not exist (ncrc-gnu.mk); we now pull from a template in the mkmf repository. The second change is where we conditionally upload coverage reports to Codecov.io, since we probably do not want to manually upload reports during testing. Compute nodes also do not typically have internet access on compute clusters. --- .testing/Makefile | 18 ++++++++++-------- .travis.yml | 1 + 2 files changed, 11 insertions(+), 8 deletions(-) diff --git a/.testing/Makefile b/.testing/Makefile index b0f38e6166..37946dfbdf 100644 --- a/.testing/Makefile +++ b/.testing/Makefile @@ -24,9 +24,9 @@ MKMF_CPP = "-Duse_libMPI -Duse_netCDF -DSPMD" # Environment # TODO: This info ought to be determined by CMake, automake, etc. -#MKMF_TEMPLATE ?= linux-ubuntu-xenial-gnu.mk -MKMF_TEMPLATE ?= ncrc-gnu.mk -#MKMF_TEMPLATE ?= ncrc-intel.mk +#MKMF_TEMPLATE ?= .testing/linux-ubuntu-xenial-gnu.mk +MKMF_TEMPLATE ?= $(DEPS)/mkmf/templates/ncrc-gnu.mk +#MKMF_TEMPLATE ?= $(DEPS)/mkmf/templates/ncrc-intel.mk #--- # Test configuration @@ -70,6 +70,8 @@ else GIT_MERGED_HEAD = endif +REPORT_COVERAGE ?= + #--- # Rules @@ -99,9 +101,9 @@ build/%/MOM6: build/%/Makefile $(FMS)/lib/libfms.a build/%/Makefile: build/%/path_names git checkout $(BRANCH) - cp .testing/$(MKMF_TEMPLATE) $(@D) + cp $(MKMF_TEMPLATE) $(@D) cd $(@D) && $(MKMF) \ - -t $(MKMF_TEMPLATE) \ + -t $(notdir $(MKMF_TEMPLATE)) \ -o '-I ../../$(FMS)/build' \ -p MOM6 \ -l '../../$(FMS)/lib/libfms.a' \ @@ -157,9 +159,9 @@ $(FMS)/lib/libfms.a: $(FMS)/build/Makefile cd $(FMS)/build && make NETCDF=3 DEBUG=1 ../lib/libfms.a $(FMS)/build/Makefile: $(FMS)/build/path_names - cp .testing/$(MKMF_TEMPLATE) $(@D) + cp $(MKMF_TEMPLATE) $(@D) cd $(@D) && $(MKMF) \ - -t $(MKMF_TEMPLATE) \ + -t $(notdir $(MKMF_TEMPLATE)) \ -p ../lib/libfms.a \ -c $(MKMF_CPP) \ path_names @@ -248,7 +250,7 @@ endef # Define $(,) as comma escape character , := , -$(eval $(call STAT_RULE,symmetric,symmetric,true,,,1)) +$(eval $(call STAT_RULE,symmetric,symmetric,$(REPORT_COVERAGE),,,1)) $(eval $(call STAT_RULE,asymmetric,asymmetric,,,,1)) $(eval $(call STAT_RULE,target,target,,,,1)) $(eval $(call STAT_RULE,repro,repro,,,,1)) diff --git a/.travis.yml b/.travis.yml index 2c17fb9443..581d019c6e 100644 --- a/.travis.yml +++ b/.travis.yml @@ -47,6 +47,7 @@ jobs: MOM_TARGET_SLUG=${TRAVIS_REPO_SLUG} \ MOM_TARGET_LOCAL_BRANCH=${TRAVIS_BRANCH} \ DO_REGRESSION_TESTS=${TRAVIS_IS_PR} + REPORT_COVERAGE=${TRAVIS_IS_PR} - echo -en 'travis_fold:end:script.1\\r' - echo 'Running tests...' && echo -en 'travis_fold:start:script.2\\r' - make DO_REGRESSION_TESTS=${TRAVIS_IS_PR} test From 6aa8dfa8bad7990b312e6c345e217553979737a1 Mon Sep 17 00:00:00 2001 From: Marshall Ward Date: Mon, 26 Aug 2019 11:31:48 -0400 Subject: [PATCH 256/297] Fixing travis mkmf template path --- .travis.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.travis.yml b/.travis.yml index 581d019c6e..6d9e99ed37 100644 --- a/.travis.yml +++ b/.travis.yml @@ -43,7 +43,7 @@ jobs: - echo 'Build executables...' && echo -en 'travis_fold:start:script.1\\r' - TRAVIS_IS_PR=$( [ ${TRAVIS_PULL_REQUEST} = "false" ] || echo "true" ) - make \ - MKMF_TEMPLATE=linux-ubuntu-xenial-gnu.mk \ + MKMF_TEMPLATE=.testing/linux-ubuntu-xenial-gnu.mk \ MOM_TARGET_SLUG=${TRAVIS_REPO_SLUG} \ MOM_TARGET_LOCAL_BRANCH=${TRAVIS_BRANCH} \ DO_REGRESSION_TESTS=${TRAVIS_IS_PR} From 09f215746bd848988c3c7a9efc2bcd3fad24cde7 Mon Sep 17 00:00:00 2001 From: Kate Hedstrom Date: Mon, 26 Aug 2019 10:53:40 -0800 Subject: [PATCH 257/297] Tiny tweak to Matt's giant merger --- src/core/MOM_open_boundary.F90 | 4 ++-- src/tracer/MOM_tracer_advect.F90 | 3 +-- 2 files changed, 3 insertions(+), 4 deletions(-) diff --git a/src/core/MOM_open_boundary.F90 b/src/core/MOM_open_boundary.F90 index 461b93f8f8..cea51b1fd9 100644 --- a/src/core/MOM_open_boundary.F90 +++ b/src/core/MOM_open_boundary.F90 @@ -4092,8 +4092,8 @@ subroutine adjustSegmentEtaToFitBathymetry(G, GV, US, segment,fld) 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(OBC_segment_type), intent(inout) :: segment !< pointer to segment type - integer, intent(in) :: fld + type(OBC_segment_type), intent(inout) :: segment !< pointer to segment type + integer, intent(in) :: fld !< field index to adjust thickness ! Local variables integer :: i, j, k, is, ie, js, je, nz, contractions, dilations integer :: n diff --git a/src/tracer/MOM_tracer_advect.F90 b/src/tracer/MOM_tracer_advect.F90 index ef26cc9119..0e4c867253 100644 --- a/src/tracer/MOM_tracer_advect.F90 +++ b/src/tracer/MOM_tracer_advect.F90 @@ -354,10 +354,9 @@ subroutine advect_x(Tr, hprev, uhr, uh_neglect, OBC, domore_u, ntr, Idt, & real, dimension(SZI_(G),ntr) :: & slope_x ! The concentration slope per grid point [conc]. real, dimension(SZIB_(G),ntr) :: & - flux_x ! The tracer flux across a boundary [H m2 conc ~> m3 conc or kg conc]. + flux_x ! The tracer flux across a boundary [H L2 conc ~> m3 conc or kg conc]. real, dimension(SZI_(G),ntr) :: & T_tmp ! The copy of the tracer concentration at constant i,k [H m2 conc ~> m3 conc or kg conc]. - flux_x ! The tracer flux across a boundary [H L2 conc ~> m3 conc or kg conc]. real :: maxslope ! The maximum concentration slope per grid point ! consistent with monotonicity [conc]. From 7e448510d82443e0228651d97dbd82d4a3dc8a64 Mon Sep 17 00:00:00 2001 From: Marshall Ward Date: Mon, 26 Aug 2019 15:34:26 -0400 Subject: [PATCH 258/297] Travis: git management replaced with subdirectory The manipulation of the repository in-place has been replaced with a self-checkout of the target codebase inside of the build/ directory of the repository, which is used to build the target executable. This eliminates the need for self-manipulation of the repository during testing, as well as much of the complexity of the existing Makefile. --- .testing/Makefile | 64 ++++++++++++----------------------------------- 1 file changed, 16 insertions(+), 48 deletions(-) diff --git a/.testing/Makefile b/.testing/Makefile index 37946dfbdf..6eeef51af9 100644 --- a/.testing/Makefile +++ b/.testing/Makefile @@ -44,7 +44,10 @@ TESTS = grids layouts restarts repros nans dims # MOM_TARGET_REMOTE_NAME and MOM_MERGED_BRANCH are arbitrary labels which may # cause namespace conflicts, and should probably be renamed or phased out. +# These are set to true by Travis if testing a pull request DO_REGRESSION_TESTS ?= +REPORT_COVERAGE ?= + ifeq ($(DO_REGRESSION_TESTS), true) BUILDS += target TEST += regressions @@ -53,25 +56,15 @@ ifeq ($(DO_REGRESSION_TESTS), true) MOM_TARGET_URL ?= https://github.com/$(MOM_TARGET_SLUG) MOM_TARGET_LOCAL_BRANCH ?= dev/gfdl - MOM_TARGET_REMOTE_NAME ?= target - MOM_TARGET_BRANCH := $(MOM_TARGET_REMOTE_NAME)/$(MOM_TARGET_LOCAL_BRANCH) - GIT_TARGET_REMOTE = .git/refs/remotes/$(MOM_TARGET_BRANCH) + MOM_TARGET_BRANCH := origin/$(MOM_TARGET_LOCAL_BRANCH) - MOM_MERGED_BRANCH ?= mergetest - GIT_MERGED_HEAD = .git/refs/heads/$(MOM_MERGED_BRANCH) + TARGET_CODEBASE = build/target_codebase else MOM_TARGET_URL = - MOM_TARGET_LOCAL_BRANCH = MOM_TARGET_BRANCH = - GIT_TARGET_REMOTE = - - # Inert self-checkout of current branch - MOM_MERGED_BRANCH = - GIT_MERGED_HEAD = + TARGET_CODEBASE = endif -REPORT_COVERAGE ?= - #--- # Rules @@ -83,9 +76,6 @@ all: $(foreach b,$(BUILDS),build/$(b)/MOM6) BUILD_TARGETS = MOM6 Makefile path_names .PRECIOUS: $(foreach b,$(BUILDS),$(foreach f,$(BUILD_TARGETS),build/$(b)/$(f))) -$(foreach f,$(BUILD_TARGETS),build/target/$(f)): BRANCH=$(MOM_TARGET_BRANCH) -$(foreach f,$(BUILD_TARGETS),build/%/$(f)): BRANCH=$(MOM_MERGED_BRANCH) - build/target/MOM6: MOMFLAGS=NETCDF=3 DEBUG=1 build/symmetric/MOM6: MOMFLAGS=NETCDF=3 DEBUG=1 COVERAGE=1 build/asymmetric/MOM6: MOMFLAGS=NETCDF=3 DEBUG=1 @@ -95,12 +85,9 @@ build/asymmetric/path_names: GRID_SRC=config_src/dynamic build/%/path_names: GRID_SRC=config_src/dynamic_symmetric build/%/MOM6: build/%/Makefile $(FMS)/lib/libfms.a - git checkout $(BRANCH) make -C $(@D) $(MOMFLAGS) $(@F) - git checkout @{-1} build/%/Makefile: build/%/path_names - git checkout $(BRANCH) cp $(MKMF_TEMPLATE) $(@D) cd $(@D) && $(MKMF) \ -t $(notdir $(MKMF_TEMPLATE)) \ @@ -109,46 +96,27 @@ build/%/Makefile: build/%/path_names -l '../../$(FMS)/lib/libfms.a' \ -c $(MKMF_CPP) \ path_names - git checkout @{-1} -# TODO: Merge the target and generic path_names rules -# (Only dependency differs at the moment) +# NOTE: These path_names rules could be merged -build/target/path_names: $(LIST_PATHS) $(GIT_TARGET_REMOTE) - git checkout $(BRANCH) +build/target/path_names: $(LIST_PATHS) $(TARGET_CODEBASE) mkdir -p $(@D) cd $(@D) && $(LIST_PATHS) -l \ - ../../src \ - ../../config_src/solo_driver \ - ../../$(GRID_SRC) - git checkout @{-1} + ../../$(TARGET_CODEBASE)/src \ + ../../$(TARGET_CODEBASE)/config_src/solo_driver \ + ../../$(TARGET_CODEBASE)/$(GRID_SRC) -build/%/path_names: $(LIST_PATHS) $(GIT_MERGED_HEAD) - git checkout $(BRANCH) +build/%/path_names: $(LIST_PATHS) mkdir -p $(@D) cd $(@D) && $(LIST_PATHS) -l \ ../../src \ ../../config_src/solo_driver \ ../../$(GRID_SRC) - git checkout @{-1} - -#---- -# Repository management - -# WARNING: Implicit dependency of GIT_TARGET_REMOTE and DO_REGRESSION_TESTS -$(GIT_MERGED_HEAD): $(GIT_TARGET_REMOTE) - git checkout -b $(MOM_MERGED_BRANCH) - if [ $(DO_REGRESSION_TESTS) ]; then \ - git merge --no-edit $(MOM_TARGET_BRANCH); \ - fi - git checkout @{-1} - -# GIT_TARGET_REMOTE conditional rule -.git/refs/remotes/$(MOM_TARGET_BRANCH): - git ls-remote $(MOM_TARGET_REMOTE_NAME) \ - || git remote add $(MOM_TARGET_REMOTE_NAME) $(MOM_TARGET_URL) - git fetch --no-recurse-submodules $(MOM_TARGET_REMOTE_NAME) +# Target repository for regression tests +$(TARGET_CODEBASE): + git clone --recursive $(MOM_TARGET_URL) $@ + cd $@ && git checkout -b $(MOM_TARGET_BRANCH) #---- From 7cdcdaa024fb1024c03432958e54681b2e667000 Mon Sep 17 00:00:00 2001 From: Raphael Dussin Date: Mon, 26 Aug 2019 16:38:33 -0400 Subject: [PATCH 259/297] fix alloc and give global indices --- .../coupled_driver/MOM_surface_forcing.F90 | 99 +++++++++++-------- 1 file changed, 60 insertions(+), 39 deletions(-) diff --git a/config_src/coupled_driver/MOM_surface_forcing.F90 b/config_src/coupled_driver/MOM_surface_forcing.F90 index bba78c6ce5..d75db885e3 100644 --- a/config_src/coupled_driver/MOM_surface_forcing.F90 +++ b/config_src/coupled_driver/MOM_surface_forcing.F90 @@ -406,53 +406,65 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, US, CS, sfc i0 = is - isc_bnd ; j0 = js - jsc_bnd do j=js,je ; do i=is,ie - if (associated(IOB%lprec)) & + if (associated(IOB%lprec)) then fluxes%lprec(i,j) = IOB%lprec(i-i0,j-j0) * G%mask2dT(i,j) - call check_mask_val_consistency(IOB%lprec(i-i0,j-j0), G%mask2dT(i,j), i, j, 'lprec') + call check_mask_val_consistency(IOB%lprec(i-i0,j-j0), G%mask2dT(i,j), i, j, 'lprec', G) + endif - if (associated(IOB%fprec)) & + if (associated(IOB%fprec)) then fluxes%fprec(i,j) = IOB%fprec(i-i0,j-j0) * G%mask2dT(i,j) - call check_mask_val_consistency(IOB%fprec(i-i0,j-j0), G%mask2dT(i,j), i, j, 'fprec') + call check_mask_val_consistency(IOB%fprec(i-i0,j-j0), G%mask2dT(i,j), i, j, 'fprec', G) + endif - if (associated(IOB%q_flux)) & + if (associated(IOB%q_flux)) then fluxes%evap(i,j) = - IOB%q_flux(i-i0,j-j0) * G%mask2dT(i,j) - call check_mask_val_consistency(IOB%q_flux(i-i0,j-j0), G%mask2dT(i,j), i, j, 'q_flux') + call check_mask_val_consistency(IOB%q_flux(i-i0,j-j0), G%mask2dT(i,j), i, j, 'q_flux', G) + endif - if (associated(IOB%runoff)) & + if (associated(IOB%runoff)) then fluxes%lrunoff(i,j) = IOB%runoff(i-i0,j-j0) * G%mask2dT(i,j) - call check_mask_val_consistency(IOB%runoff(i-i0,j-j0), G%mask2dT(i,j), i, j, 'runoff') + call check_mask_val_consistency(IOB%runoff(i-i0,j-j0), G%mask2dT(i,j), i, j, 'runoff', G) + endif - if (associated(IOB%calving)) & + if (associated(IOB%calving)) then fluxes%frunoff(i,j) = IOB%calving(i-i0,j-j0) * G%mask2dT(i,j) - call check_mask_val_consistency(IOB%calving(i-i0,j-j0), G%mask2dT(i,j), i, j, 'calving') + call check_mask_val_consistency(IOB%calving(i-i0,j-j0), G%mask2dT(i,j), i, j, 'calving', G) + endif - if (associated(IOB%ustar_berg)) & + if (associated(IOB%ustar_berg)) then fluxes%ustar_berg(i,j) = US%m_to_Z*US%T_to_s * IOB%ustar_berg(i-i0,j-j0) * G%mask2dT(i,j) - call check_mask_val_consistency(IOB%ustar_berg(i-i0,j-j0), G%mask2dT(i,j), i, j, 'ustar_berg') + call check_mask_val_consistency(IOB%ustar_berg(i-i0,j-j0), G%mask2dT(i,j), i, j, 'ustar_berg', G) + endif - if (associated(IOB%area_berg)) & + if (associated(IOB%area_berg)) then fluxes%area_berg(i,j) = IOB%area_berg(i-i0,j-j0) * G%mask2dT(i,j) - call check_mask_val_consistency(IOB%area_berg(i-i0,j-j0), G%mask2dT(i,j), i, j, 'area_berg') + call check_mask_val_consistency(IOB%area_berg(i-i0,j-j0), G%mask2dT(i,j), i, j, 'area_berg', G) + endif - if (associated(IOB%mass_berg)) & + if (associated(IOB%mass_berg)) then fluxes%mass_berg(i,j) = IOB%mass_berg(i-i0,j-j0) * G%mask2dT(i,j) - call check_mask_val_consistency(IOB%mass_berg(i-i0,j-j0), G%mask2dT(i,j), i, j, 'mass_berg') + call check_mask_val_consistency(IOB%mass_berg(i-i0,j-j0), G%mask2dT(i,j), i, j, 'mass_berg', G) + endif - if (associated(IOB%runoff_hflx)) & + if (associated(IOB%runoff_hflx)) then fluxes%heat_content_lrunoff(i,j) = IOB%runoff_hflx(i-i0,j-j0) * G%mask2dT(i,j) - call check_mask_val_consistency(IOB%runoff_hflx(i-i0,j-j0), G%mask2dT(i,j), i, j, 'runoff_hflx') + call check_mask_val_consistency(IOB%runoff_hflx(i-i0,j-j0), G%mask2dT(i,j), i, j, 'runoff_hflx', G) + endif - if (associated(IOB%calving_hflx)) & + if (associated(IOB%calving_hflx)) then fluxes%heat_content_frunoff(i,j) = IOB%calving_hflx(i-i0,j-j0) * G%mask2dT(i,j) - call check_mask_val_consistency(IOB%calving_hflx(i-i0,j-j0), G%mask2dT(i,j), i, j, 'calving_hflx') + call check_mask_val_consistency(IOB%calving_hflx(i-i0,j-j0), G%mask2dT(i,j), i, j, 'calving_hflx', G) + endif - if (associated(IOB%lw_flux)) & + if (associated(IOB%lw_flux)) then fluxes%LW(i,j) = IOB%lw_flux(i-i0,j-j0) * G%mask2dT(i,j) - call check_mask_val_consistency(IOB%lw_flux(i-i0,j-j0), G%mask2dT(i,j), i, j, 'lw_flux') + call check_mask_val_consistency(IOB%lw_flux(i-i0,j-j0), G%mask2dT(i,j), i, j, 'lw_flux', G) + endif - if (associated(IOB%t_flux)) & + if (associated(IOB%t_flux)) then fluxes%sens(i,j) = - IOB%t_flux(i-i0,j-j0) * G%mask2dT(i,j) - call check_mask_val_consistency(IOB%t_flux(i-i0,j-j0), G%mask2dT(i,j), i, j, 't_flux') + call check_mask_val_consistency(IOB%t_flux(i-i0,j-j0), G%mask2dT(i,j), i, j, 't_flux', G) + endif fluxes%latent(i,j) = 0.0 if (associated(IOB%fprec)) then @@ -470,18 +482,22 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, US, CS, sfc fluxes%latent(i,j) = G%mask2dT(i,j) * fluxes%latent(i,j) - if (associated(IOB%sw_flux_vis_dir)) & + if (associated(IOB%sw_flux_vis_dir)) then fluxes%sw_vis_dir(i,j) = G%mask2dT(i,j) * IOB%sw_flux_vis_dir(i-i0,j-j0) - call check_mask_val_consistency(IOB%sw_flux_vis_dir(i-i0,j-j0), G%mask2dT(i,j), i, j, 'sw_flux_vis_dir') - if (associated(IOB%sw_flux_vis_dif)) & + call check_mask_val_consistency(IOB%sw_flux_vis_dir(i-i0,j-j0), G%mask2dT(i,j), i, j, 'sw_flux_vis_dir', G) + endif + if (associated(IOB%sw_flux_vis_dif)) then fluxes%sw_vis_dif(i,j) = G%mask2dT(i,j) * IOB%sw_flux_vis_dif(i-i0,j-j0) - call check_mask_val_consistency(IOB%sw_flux_vis_dif(i-i0,j-j0), G%mask2dT(i,j), i, j, 'sw_flux_vis_dif') - if (associated(IOB%sw_flux_nir_dir)) & + call check_mask_val_consistency(IOB%sw_flux_vis_dif(i-i0,j-j0), G%mask2dT(i,j), i, j, 'sw_flux_vis_dif', G) + endif + if (associated(IOB%sw_flux_nir_dir)) then fluxes%sw_nir_dir(i,j) = G%mask2dT(i,j) * IOB%sw_flux_nir_dir(i-i0,j-j0) - call check_mask_val_consistency(IOB%sw_flux_nir_dir(i-i0,j-j0), G%mask2dT(i,j), i, j, 'sw_flux_nir_dir') - if (associated(IOB%sw_flux_nir_dif)) & + call check_mask_val_consistency(IOB%sw_flux_nir_dir(i-i0,j-j0), G%mask2dT(i,j), i, j, 'sw_flux_nir_dir', G) + endif + if (associated(IOB%sw_flux_nir_dif)) then fluxes%sw_nir_dif(i,j) = G%mask2dT(i,j) * IOB%sw_flux_nir_dif(i-i0,j-j0) - call check_mask_val_consistency(IOB%sw_flux_nir_dif(i-i0,j-j0), G%mask2dT(i,j), i, j, 'sw_flux_nir_dif') + call check_mask_val_consistency(IOB%sw_flux_nir_dif(i-i0,j-j0), G%mask2dT(i,j), i, j, 'sw_flux_nir_dif', G) + endif 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) @@ -492,14 +508,14 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, US, CS, sfc 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) - call check_mask_val_consistency(IOB%p(i-i0,j-j0), G%mask2dT(i,j), i, j, 'p') fluxes%p_surf(i,j) = MIN(fluxes%p_surf_full(i,j),CS%max_p_surf) + call check_mask_val_consistency(IOB%p(i-i0,j-j0), G%mask2dT(i,j), i, j, 'p', G) 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) - call check_mask_val_consistency(IOB%p(i-i0,j-j0), G%mask2dT(i,j), i, j, 'p') fluxes%p_surf(i,j) = fluxes%p_surf_full(i,j) + call check_mask_val_consistency(IOB%p(i-i0,j-j0), G%mask2dT(i,j), i, j, 'p', G) enddo ; enddo endif fluxes%accumulate_p_surf = .true. ! Multiple components may contribute to surface pressure. @@ -510,7 +526,7 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, US, CS, sfc 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) ) - call check_mask_val_consistency(IOB%salt_flux(i-i0,j-j0), G%mask2dT(i,j), i, j, 'salt_flux') + call check_mask_val_consistency(IOB%salt_flux(i-i0,j-j0), G%mask2dT(i,j), i, j, 'salt_flux', G) enddo ; enddo endif @@ -1570,24 +1586,29 @@ subroutine ice_ocn_bnd_type_chksum(id, timestep, iobt) end subroutine ice_ocn_bnd_type_chksum !> Check the values passed by IOB over land are zero -subroutine check_mask_val_consistency(val, mask, i, j, varname) +subroutine check_mask_val_consistency(val, mask, i, j, varname, G) real, intent(in) :: val !< value of flux/variable passed by IOB real, intent(in) :: mask !< value of ocean mask integer, intent(in) :: i, j !< model grid cell indices character(len=*), intent(in) :: varname !< variable name + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure ! Local variables - character(len=48) :: ci, cj !< model grid cell indices as strings + character(len=48) :: ci, cj !< model local grid cell indices as strings + character(len=48) :: ciglo, cjglo !< model global grid cell indices as strings character(len=48) :: cval !< value to be displayed character(len=256) :: error_message !< error message to be displayed if ((mask == 0.) .and. (val /= 0.)) then write(ci, '(I8)') i write(cj, '(I8)') j + write(ciglo, '(I8)') i + G%HI%idg_offset + write(cjglo, '(I8)') j + G%HI%jdg_offset write(cval, '(E22.16)') val error_message = "MOM_surface_forcing: found non-zero value (="//trim(cval)//") over land "//& - "for variable "//trim(varname)//" at point (i, j) = ("//trim(ci)//", "//trim(cj)//")" - call MOM_error(FATAL, error_message) + "for variable "//trim(varname)//" at local point (i, j) = ("//trim(ci)//", "//trim(cj)//& + ", global point (iglo, jglo) = ("//trim(ciglo)//", "//trim(cjglo)//")" + call MOM_error(WARNING, error_message) endif end subroutine From 7ed0247d8e265019b223f8a992113ad9f81feb04 Mon Sep 17 00:00:00 2001 From: Marshall Ward Date: Mon, 26 Aug 2019 17:13:17 -0400 Subject: [PATCH 260/297] Travis: Regression target as detached head --- .testing/Makefile | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.testing/Makefile b/.testing/Makefile index 6eeef51af9..0166cd6d4e 100644 --- a/.testing/Makefile +++ b/.testing/Makefile @@ -116,7 +116,7 @@ build/%/path_names: $(LIST_PATHS) # Target repository for regression tests $(TARGET_CODEBASE): git clone --recursive $(MOM_TARGET_URL) $@ - cd $@ && git checkout -b $(MOM_TARGET_BRANCH) + cd $@ && git checkout $(MOM_TARGET_BRANCH) #---- From ddcfe7d76e415e60a8fce5be03cac6cf417d2d15 Mon Sep 17 00:00:00 2001 From: Marshall Ward Date: Tue, 27 Aug 2019 11:28:24 -0400 Subject: [PATCH 261/297] Travis: OpenMPI environment variable support Travis OpenMPI jobs appears to not be supporting the MALLOC_PERTURB_ environment variable, most likely because we are not using the -x flag. This PR introduces a $(MPIRUN_CMD) Make function to support more generalized mpirun commands. We can expand it in the future to include, say, the MPI rank count. --- .testing/Makefile | 10 +++++++++- 1 file changed, 9 insertions(+), 1 deletion(-) diff --git a/.testing/Makefile b/.testing/Makefile index 0166cd6d4e..441a4c817e 100644 --- a/.testing/Makefile +++ b/.testing/Makefile @@ -201,12 +201,20 @@ $(foreach d,t l h z,$(eval $(call CMP_RULE,dim.$(d),symmetric dim.$(d)))) #(5): Environment variables #(6): Number of MPI ranks +# Simple environment variable support for Slurm and OpenMPI +# This will probably need to be generalized in the future. +ifeq ($(MPIRUN), srun) +MPIRUN_CMD=$(1) $(MPIRUN) +else +MPIRUN_CMD=$(MPIRUN) -x $(1) +endif + define STAT_RULE .testing/%/ocean.stats.$(1): build/$(2)/MOM6 if [ $(3) ]; then find build -name *.gcda -exec rm -f '{}' \; ; fi mkdir -p $$(@D)/RESTART echo $(4) > $$(@D)/MOM_override - cd $$(@D) && $(5) $$(MPIRUN) -n $(6) ../../$$< 2> debug.out + cd $$(@D) && $$(call MPIRUN_CMD,$(5)) -n $(6) ../../$$< 2> debug.out cp $$(@D)/ocean.stats $$@ > $$(@D)/MOM_override if [ $(3) ]; then bash <(curl -s https://codecov.io/bash) -n $$@; fi From 356a44b80278541348df66317d28202f1e20a9a0 Mon Sep 17 00:00:00 2001 From: Marshall Ward Date: Tue, 27 Aug 2019 11:43:44 -0400 Subject: [PATCH 262/297] Travis: Conditionally add -x flag for envars --- .testing/Makefile | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.testing/Makefile b/.testing/Makefile index 441a4c817e..12826a9a55 100644 --- a/.testing/Makefile +++ b/.testing/Makefile @@ -206,7 +206,7 @@ $(foreach d,t l h z,$(eval $(call CMP_RULE,dim.$(d),symmetric dim.$(d)))) ifeq ($(MPIRUN), srun) MPIRUN_CMD=$(1) $(MPIRUN) else -MPIRUN_CMD=$(MPIRUN) -x $(1) +MPIRUN_CMD=$(MPIRUN) $(if $(1),-x $(1),) endif define STAT_RULE From fe2f4a7e32a2a96674a222a547b0ea9b2816691a Mon Sep 17 00:00:00 2001 From: Marshall Ward Date: Tue, 27 Aug 2019 17:56:36 -0400 Subject: [PATCH 263/297] Makefile root moved to .testing; configure removed The Makefile is now designed to be called from .testing, rather than copied into the root directory as was previously done by Travis to support pipelined jobs. We have also removed the configure script and removed the install stage from the Travis session. --- .testing/Makefile | 75 ++++++++++++++++++++++++---------------------- .testing/configure | 4 --- .travis.yml | 8 +---- 3 files changed, 40 insertions(+), 47 deletions(-) delete mode 100755 .testing/configure diff --git a/.testing/Makefile b/.testing/Makefile index 12826a9a55..8c27e73d8e 100644 --- a/.testing/Makefile +++ b/.testing/Makefile @@ -3,7 +3,9 @@ MPIRUN ?= mpirun #--- # Dependencies -DEPS = deps +BASE = $(dir $(abspath $(lastword $(MAKEFILE_LIST))))/.. +DEPS = $(BASE)/deps +BUILD = $(BASE)/build # mkmf, list_paths (GFDL build toolchain) MKMF_URL ?= https://github.com/NOAA-GFDL/mkmf.git @@ -58,7 +60,7 @@ ifeq ($(DO_REGRESSION_TESTS), true) MOM_TARGET_LOCAL_BRANCH ?= dev/gfdl MOM_TARGET_BRANCH := origin/$(MOM_TARGET_LOCAL_BRANCH) - TARGET_CODEBASE = build/target_codebase + TARGET_CODEBASE = $(BUILD)/target_codebase else MOM_TARGET_URL = MOM_TARGET_BRANCH = @@ -70,48 +72,48 @@ endif # Rules .PHONY: all -all: $(foreach b,$(BUILDS),build/$(b)/MOM6) +all: $(foreach b,$(BUILDS),$(BUILD)/$(b)/MOM6) # Executable BUILD_TARGETS = MOM6 Makefile path_names -.PRECIOUS: $(foreach b,$(BUILDS),$(foreach f,$(BUILD_TARGETS),build/$(b)/$(f))) +.PRECIOUS: $(foreach b,$(BUILDS),$(foreach f,$(BUILD_TARGETS),$(BUILD)/$(b)/$(f))) -build/target/MOM6: MOMFLAGS=NETCDF=3 DEBUG=1 -build/symmetric/MOM6: MOMFLAGS=NETCDF=3 DEBUG=1 COVERAGE=1 -build/asymmetric/MOM6: MOMFLAGS=NETCDF=3 DEBUG=1 -build/repro/MOM6: MOMFLAGS=NETCDF=3 REPRO=1 +$(BUILD)/target/MOM6: MOMFLAGS=NETCDF=3 DEBUG=1 +$(BUILD)/symmetric/MOM6: MOMFLAGS=NETCDF=3 DEBUG=1 COVERAGE=1 +$(BUILD)/asymmetric/MOM6: MOMFLAGS=NETCDF=3 DEBUG=1 +$(BUILD)/repro/MOM6: MOMFLAGS=NETCDF=3 REPRO=1 -build/asymmetric/path_names: GRID_SRC=config_src/dynamic -build/%/path_names: GRID_SRC=config_src/dynamic_symmetric +$(BUILD)/asymmetric/path_names: GRID_SRC=config_src/dynamic +$(BUILD)/%/path_names: GRID_SRC=config_src/dynamic_symmetric -build/%/MOM6: build/%/Makefile $(FMS)/lib/libfms.a +$(BUILD)/%/MOM6: $(BUILD)/%/Makefile $(FMS)/lib/libfms.a make -C $(@D) $(MOMFLAGS) $(@F) -build/%/Makefile: build/%/path_names +$(BUILD)/%/Makefile: $(BUILD)/%/path_names cp $(MKMF_TEMPLATE) $(@D) cd $(@D) && $(MKMF) \ -t $(notdir $(MKMF_TEMPLATE)) \ - -o '-I ../../$(FMS)/build' \ + -o '-I $(FMS)/build' \ -p MOM6 \ - -l '../../$(FMS)/lib/libfms.a' \ + -l '$(FMS)/lib/libfms.a' \ -c $(MKMF_CPP) \ path_names # NOTE: These path_names rules could be merged -build/target/path_names: $(LIST_PATHS) $(TARGET_CODEBASE) +$(BUILD)/target/path_names: $(LIST_PATHS) $(TARGET_CODEBASE) mkdir -p $(@D) cd $(@D) && $(LIST_PATHS) -l \ - ../../$(TARGET_CODEBASE)/src \ - ../../$(TARGET_CODEBASE)/config_src/solo_driver \ - ../../$(TARGET_CODEBASE)/$(GRID_SRC) + $(TARGET_CODEBASE)/src \ + $(TARGET_CODEBASE)/config_src/solo_driver \ + $(TARGET_CODEBASE)/$(GRID_SRC) -build/%/path_names: $(LIST_PATHS) +$(BUILD)/%/path_names: $(LIST_PATHS) mkdir -p $(@D) cd $(@D) && $(LIST_PATHS) -l \ - ../../src \ - ../../config_src/solo_driver \ - ../../$(GRID_SRC) + $(BASE)/src \ + $(BASE)/config_src/solo_driver \ + $(BASE)/$(GRID_SRC) # Target repository for regression tests $(TARGET_CODEBASE): @@ -170,10 +172,10 @@ test.dims: $(foreach c,$(CONFIGS),$(foreach d,t l h z,$(c).dim.$(d) $(c).dim.$(d # NOTE: chksum_diag return code of cmp is currently ignored since many fail! define CMP_RULE -%.$(1): $(foreach b,$(2),.testing/%/ocean.stats.$(b)) +%.$(1): $(foreach b,$(2),$(BASE)/.testing/%/ocean.stats.$(b)) cmp $$^ -%.$(1).diag: $(foreach b,$(2),.testing/%/chksum_diag.$(b)) +%.$(1).diag: $(foreach b,$(2),$(BASE)/.testing/%/chksum_diag.$(b)) -cmp $$^ endef @@ -185,7 +187,7 @@ $(eval $(call CMP_RULE,nan,symmetric nan)) $(foreach d,t l h z,$(eval $(call CMP_RULE,dim.$(d),symmetric dim.$(d)))) # Restart tests only compare the final stat record -%.restart: $(foreach b,symmetric restart,.testing/%/ocean.stats.$(b)) +%.restart: $(foreach b,symmetric restart,$(BASE)/.testing/%/ocean.stats.$(b)) cmp $(foreach f,$^,<(tr -s ' ' < $(f) | cut -d ' ' -f3- | tail -n 1)) # TODO: chksum_diag parsing of restart files @@ -201,8 +203,9 @@ $(foreach d,t l h z,$(eval $(call CMP_RULE,dim.$(d),symmetric dim.$(d)))) #(5): Environment variables #(6): Number of MPI ranks -# Simple environment variable support for Slurm and OpenMPI -# This will probably need to be generalized in the future. +# Simple function for generalised Slurm (srun) and OpenMPI (mpirun) support +# (1): Environment variables + ifeq ($(MPIRUN), srun) MPIRUN_CMD=$(1) $(MPIRUN) else @@ -210,16 +213,16 @@ MPIRUN_CMD=$(MPIRUN) $(if $(1),-x $(1),) endif define STAT_RULE -.testing/%/ocean.stats.$(1): build/$(2)/MOM6 +$$(BASE)/.testing/%/ocean.stats.$(1): $$(BUILD)/$(2)/MOM6 if [ $(3) ]; then find build -name *.gcda -exec rm -f '{}' \; ; fi mkdir -p $$(@D)/RESTART echo $(4) > $$(@D)/MOM_override - cd $$(@D) && $$(call MPIRUN_CMD,$(5)) -n $(6) ../../$$< 2> debug.out + cd $$(@D) && $$(call MPIRUN_CMD,$(5)) -n $(6) $$< 2> debug.out cp $$(@D)/ocean.stats $$@ > $$(@D)/MOM_override if [ $(3) ]; then bash <(curl -s https://codecov.io/bash) -n $$@; fi -.testing/%/chksum_diag.$(1): .testing/%/ocean.stats.$(1) +$$(BASE)/.testing/%/chksum_diag.$(1): $$(BASE)/.testing/%/ocean.stats.$(1) cp $$(@D)/chksum_diag $$@ endef @@ -238,7 +241,7 @@ $(eval $(call STAT_RULE,dim.h,symmetric,,H_RESCALE_POWER=11,,1)) $(eval $(call STAT_RULE,dim.z,symmetric,,Z_RESCALE_POWER=11,,1)) # Restart tests require signicant preprocessing, and are handled separately. -.testing/%/ocean.stats.restart: build/symmetric/MOM6 +$(BASE)/.testing/%/ocean.stats.restart: $(BUILD)/symmetric/MOM6 # Cleanup mkdir -p $(@D)/RESTART git checkout $(@D)/input.nml @@ -255,14 +258,14 @@ $(eval $(call STAT_RULE,dim.z,symmetric,,Z_RESCALE_POWER=11,,1)) && mv tmp.nml input.nml \ && echo $${daymax} $${timeunit} # Run the first half-period - cd $(@D) && $(MPIRUN) -n 1 ../../$< 2> debug.out + cd $(@D) && $(MPIRUN) -n 1 $< 2> debug.out # Setup the next inputs rm -rf $(@D)/INPUT && mv $(@D)/RESTART $(@D)/INPUT mkdir $(@D)/RESTART cd $(@D) && f90nml -g mom_input_nml -v input_filename='r' input.nml > tmp.nml mv $(@D)/tmp.nml $(@D)/input.nml # Run the second half-period - cd $(@D) && $(MPIRUN) -n 1 ../../$< 2> debug.out + cd $(@D) && $(MPIRUN) -n 1 $< 2> debug.out # Archive the results and cleanup cp $(@D)/ocean.stats $@ rm -rf $(@D)/INPUT @@ -274,9 +277,9 @@ $(eval $(call STAT_RULE,dim.z,symmetric,,Z_RESCALE_POWER=11,,1)) #---- .PHONY: clean clean: clean.stats - rm -rf build + rm -rf $(BUILD) .PHONY: clean.stats clean.stats: - find .testing -name ocean.stats* -exec rm {} \; - find .testing -name chksum_diag* -exec rm {} \; + find $(BASE)/.testing -name ocean.stats* -exec rm {} \; + find $(BASE)/.testing -name chksum_diag* -exec rm {} \; diff --git a/.testing/configure b/.testing/configure deleted file mode 100755 index 841635d6f4..0000000000 --- a/.testing/configure +++ /dev/null @@ -1,4 +0,0 @@ -#!/usr/bin/env bash - -echo "Configured!" $MAKEARGS -touch build/test_${MAKEARGS//\ /_} diff --git a/.travis.yml b/.travis.yml index 6d9e99ed37..02a26d98ee 100644 --- a/.travis.yml +++ b/.travis.yml @@ -21,13 +21,6 @@ addons: before_install: - pip install --user f90nml -# Compilation and testing is controlled by the "configure" and "Makefile" in -# .testing/ but they operate from the root directory. We copy them into place -# so that they can remain hidden from users. -install: - - echo "Install step" - - cp .testing/{configure,Makefile} . - jobs: include: - env: JOB="Code style compliance" @@ -42,6 +35,7 @@ jobs: script: - echo 'Build executables...' && echo -en 'travis_fold:start:script.1\\r' - TRAVIS_IS_PR=$( [ ${TRAVIS_PULL_REQUEST} = "false" ] || echo "true" ) + - cd .testing - make \ MKMF_TEMPLATE=.testing/linux-ubuntu-xenial-gnu.mk \ MOM_TARGET_SLUG=${TRAVIS_REPO_SLUG} \ From 91eea3e9f2019b6d3a5b9c8c4ac934824673d1b0 Mon Sep 17 00:00:00 2001 From: Marshall Ward Date: Tue, 27 Aug 2019 18:00:54 -0400 Subject: [PATCH 264/297] Fixed path of Travis mkmf template --- .travis.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.travis.yml b/.travis.yml index 02a26d98ee..b8bd33ca60 100644 --- a/.travis.yml +++ b/.travis.yml @@ -37,7 +37,7 @@ jobs: - TRAVIS_IS_PR=$( [ ${TRAVIS_PULL_REQUEST} = "false" ] || echo "true" ) - cd .testing - make \ - MKMF_TEMPLATE=.testing/linux-ubuntu-xenial-gnu.mk \ + MKMF_TEMPLATE=linux-ubuntu-xenial-gnu.mk \ MOM_TARGET_SLUG=${TRAVIS_REPO_SLUG} \ MOM_TARGET_LOCAL_BRANCH=${TRAVIS_BRANCH} \ DO_REGRESSION_TESTS=${TRAVIS_IS_PR} From 0b9eb019e622fcb63d22372055323d8c14c3e478 Mon Sep 17 00:00:00 2001 From: Raphael Dussin Date: Wed, 28 Aug 2019 13:35:07 -0400 Subject: [PATCH 265/297] add namelist param --- .../coupled_driver/MOM_surface_forcing.F90 | 44 +++++++++++-------- 1 file changed, 25 insertions(+), 19 deletions(-) diff --git a/config_src/coupled_driver/MOM_surface_forcing.F90 b/config_src/coupled_driver/MOM_surface_forcing.F90 index d75db885e3..d24baeb7df 100644 --- a/config_src/coupled_driver/MOM_surface_forcing.F90 +++ b/config_src/coupled_driver/MOM_surface_forcing.F90 @@ -130,6 +130,7 @@ module MOM_surface_forcing 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. + logical :: check_no_land_fluxes !< Return warning if IOB flux over land is non-zero type(diag_ctrl), pointer :: diag => NULL() !< Structure to regulate diagnostic output timing character(len=200) :: inputdir !< Directory where NetCDF input files are @@ -408,62 +409,62 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, US, CS, sfc if (associated(IOB%lprec)) then fluxes%lprec(i,j) = IOB%lprec(i-i0,j-j0) * G%mask2dT(i,j) - call check_mask_val_consistency(IOB%lprec(i-i0,j-j0), G%mask2dT(i,j), i, j, 'lprec', G) + if (CS%check_no_land_fluxes) call check_mask_val_consistency(IOB%lprec(i-i0,j-j0), G%mask2dT(i,j), i, j, 'lprec', G) endif if (associated(IOB%fprec)) then fluxes%fprec(i,j) = IOB%fprec(i-i0,j-j0) * G%mask2dT(i,j) - call check_mask_val_consistency(IOB%fprec(i-i0,j-j0), G%mask2dT(i,j), i, j, 'fprec', G) + if (CS%check_no_land_fluxes) call check_mask_val_consistency(IOB%fprec(i-i0,j-j0), G%mask2dT(i,j), i, j, 'fprec', G) endif if (associated(IOB%q_flux)) then fluxes%evap(i,j) = - IOB%q_flux(i-i0,j-j0) * G%mask2dT(i,j) - call check_mask_val_consistency(IOB%q_flux(i-i0,j-j0), G%mask2dT(i,j), i, j, 'q_flux', G) + if (CS%check_no_land_fluxes) call check_mask_val_consistency(IOB%q_flux(i-i0,j-j0), G%mask2dT(i,j), i, j, 'q_flux', G) endif if (associated(IOB%runoff)) then fluxes%lrunoff(i,j) = IOB%runoff(i-i0,j-j0) * G%mask2dT(i,j) - call check_mask_val_consistency(IOB%runoff(i-i0,j-j0), G%mask2dT(i,j), i, j, 'runoff', G) + if (CS%check_no_land_fluxes) call check_mask_val_consistency(IOB%runoff(i-i0,j-j0), G%mask2dT(i,j), i, j, 'runoff', G) endif if (associated(IOB%calving)) then fluxes%frunoff(i,j) = IOB%calving(i-i0,j-j0) * G%mask2dT(i,j) - call check_mask_val_consistency(IOB%calving(i-i0,j-j0), G%mask2dT(i,j), i, j, 'calving', G) + if (CS%check_no_land_fluxes) call check_mask_val_consistency(IOB%calving(i-i0,j-j0), G%mask2dT(i,j), i, j, 'calving', G) endif if (associated(IOB%ustar_berg)) then fluxes%ustar_berg(i,j) = US%m_to_Z*US%T_to_s * IOB%ustar_berg(i-i0,j-j0) * G%mask2dT(i,j) - call check_mask_val_consistency(IOB%ustar_berg(i-i0,j-j0), G%mask2dT(i,j), i, j, 'ustar_berg', G) + if (CS%check_no_land_fluxes) call check_mask_val_consistency(IOB%ustar_berg(i-i0,j-j0), G%mask2dT(i,j), i, j, 'ustar_berg', G) endif if (associated(IOB%area_berg)) then fluxes%area_berg(i,j) = IOB%area_berg(i-i0,j-j0) * G%mask2dT(i,j) - call check_mask_val_consistency(IOB%area_berg(i-i0,j-j0), G%mask2dT(i,j), i, j, 'area_berg', G) + if (CS%check_no_land_fluxes) call check_mask_val_consistency(IOB%area_berg(i-i0,j-j0), G%mask2dT(i,j), i, j, 'area_berg', G) endif if (associated(IOB%mass_berg)) then fluxes%mass_berg(i,j) = IOB%mass_berg(i-i0,j-j0) * G%mask2dT(i,j) - call check_mask_val_consistency(IOB%mass_berg(i-i0,j-j0), G%mask2dT(i,j), i, j, 'mass_berg', G) + if (CS%check_no_land_fluxes) call check_mask_val_consistency(IOB%mass_berg(i-i0,j-j0), G%mask2dT(i,j), i, j, 'mass_berg', G) endif if (associated(IOB%runoff_hflx)) then fluxes%heat_content_lrunoff(i,j) = IOB%runoff_hflx(i-i0,j-j0) * G%mask2dT(i,j) - call check_mask_val_consistency(IOB%runoff_hflx(i-i0,j-j0), G%mask2dT(i,j), i, j, 'runoff_hflx', G) + if (CS%check_no_land_fluxes) call check_mask_val_consistency(IOB%runoff_hflx(i-i0,j-j0), G%mask2dT(i,j), i, j, 'runoff_hflx', G) endif if (associated(IOB%calving_hflx)) then fluxes%heat_content_frunoff(i,j) = IOB%calving_hflx(i-i0,j-j0) * G%mask2dT(i,j) - call check_mask_val_consistency(IOB%calving_hflx(i-i0,j-j0), G%mask2dT(i,j), i, j, 'calving_hflx', G) + if (CS%check_no_land_fluxes) call check_mask_val_consistency(IOB%calving_hflx(i-i0,j-j0), G%mask2dT(i,j), i, j, 'calving_hflx', G) endif if (associated(IOB%lw_flux)) then fluxes%LW(i,j) = IOB%lw_flux(i-i0,j-j0) * G%mask2dT(i,j) - call check_mask_val_consistency(IOB%lw_flux(i-i0,j-j0), G%mask2dT(i,j), i, j, 'lw_flux', G) + if (CS%check_no_land_fluxes) call check_mask_val_consistency(IOB%lw_flux(i-i0,j-j0), G%mask2dT(i,j), i, j, 'lw_flux', G) endif if (associated(IOB%t_flux)) then fluxes%sens(i,j) = - IOB%t_flux(i-i0,j-j0) * G%mask2dT(i,j) - call check_mask_val_consistency(IOB%t_flux(i-i0,j-j0), G%mask2dT(i,j), i, j, 't_flux', G) + if (CS%check_no_land_fluxes) call check_mask_val_consistency(IOB%t_flux(i-i0,j-j0), G%mask2dT(i,j), i, j, 't_flux', G) endif fluxes%latent(i,j) = 0.0 @@ -484,19 +485,19 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, US, CS, sfc if (associated(IOB%sw_flux_vis_dir)) then fluxes%sw_vis_dir(i,j) = G%mask2dT(i,j) * IOB%sw_flux_vis_dir(i-i0,j-j0) - call check_mask_val_consistency(IOB%sw_flux_vis_dir(i-i0,j-j0), G%mask2dT(i,j), i, j, 'sw_flux_vis_dir', G) + if (CS%check_no_land_fluxes) call check_mask_val_consistency(IOB%sw_flux_vis_dir(i-i0,j-j0), G%mask2dT(i,j), i, j, 'sw_flux_vis_dir', G) endif if (associated(IOB%sw_flux_vis_dif)) then fluxes%sw_vis_dif(i,j) = G%mask2dT(i,j) * IOB%sw_flux_vis_dif(i-i0,j-j0) - call check_mask_val_consistency(IOB%sw_flux_vis_dif(i-i0,j-j0), G%mask2dT(i,j), i, j, 'sw_flux_vis_dif', G) + if (CS%check_no_land_fluxes) call check_mask_val_consistency(IOB%sw_flux_vis_dif(i-i0,j-j0), G%mask2dT(i,j), i, j, 'sw_flux_vis_dif', G) endif if (associated(IOB%sw_flux_nir_dir)) then fluxes%sw_nir_dir(i,j) = G%mask2dT(i,j) * IOB%sw_flux_nir_dir(i-i0,j-j0) - call check_mask_val_consistency(IOB%sw_flux_nir_dir(i-i0,j-j0), G%mask2dT(i,j), i, j, 'sw_flux_nir_dir', G) + if (CS%check_no_land_fluxes) call check_mask_val_consistency(IOB%sw_flux_nir_dir(i-i0,j-j0), G%mask2dT(i,j), i, j, 'sw_flux_nir_dir', G) endif if (associated(IOB%sw_flux_nir_dif)) then fluxes%sw_nir_dif(i,j) = G%mask2dT(i,j) * IOB%sw_flux_nir_dif(i-i0,j-j0) - call check_mask_val_consistency(IOB%sw_flux_nir_dif(i-i0,j-j0), G%mask2dT(i,j), i, j, 'sw_flux_nir_dif', G) + if (CS%check_no_land_fluxes) call check_mask_val_consistency(IOB%sw_flux_nir_dif(i-i0,j-j0), G%mask2dT(i,j), i, j, 'sw_flux_nir_dif', G) endif 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) @@ -509,13 +510,13 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, US, CS, sfc 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) - call check_mask_val_consistency(IOB%p(i-i0,j-j0), G%mask2dT(i,j), i, j, 'p', G) + if (CS%check_no_land_fluxes) call check_mask_val_consistency(IOB%p(i-i0,j-j0), G%mask2dT(i,j), i, j, 'p', G) 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) - call check_mask_val_consistency(IOB%p(i-i0,j-j0), G%mask2dT(i,j), i, j, 'p', G) + if (CS%check_no_land_fluxes) call check_mask_val_consistency(IOB%p(i-i0,j-j0), G%mask2dT(i,j), i, j, 'p', G) enddo ; enddo endif fluxes%accumulate_p_surf = .true. ! Multiple components may contribute to surface pressure. @@ -526,7 +527,7 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, US, CS, sfc 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) ) - call check_mask_val_consistency(IOB%salt_flux(i-i0,j-j0), G%mask2dT(i,j), i, j, 'salt_flux', G) + if (CS%check_no_land_fluxes) call check_mask_val_consistency(IOB%salt_flux(i-i0,j-j0), G%mask2dT(i,j), i, j, 'salt_flux', G) enddo ; enddo endif @@ -1480,6 +1481,11 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS) "If true, allows flux adjustments to specified via the "//& "data_table using the component name 'OCN'.", default=.false.) + call get_param(param_file, mdl, "CHECK_NO_LAND_FLUXES", CS%check_no_land_fluxes, & + "If true, checks that values from IOB fluxes are zero "//& + "above land points (i.e. G%mask2dT = 0).", default=.false., & + debuggingParam=.true.) + call data_override_init(Ocean_domain_in=G%Domain%mpp_domain) if (CS%restore_salt) then From be3620143bcd3a8fba6150233d4565525c648245 Mon Sep 17 00:00:00 2001 From: Raphael Dussin Date: Wed, 28 Aug 2019 13:48:15 -0400 Subject: [PATCH 266/297] shorter lines --- .../coupled_driver/MOM_surface_forcing.F90 | 57 ++++++++++++------- 1 file changed, 38 insertions(+), 19 deletions(-) diff --git a/config_src/coupled_driver/MOM_surface_forcing.F90 b/config_src/coupled_driver/MOM_surface_forcing.F90 index 8bdb913154..a8d49853a4 100644 --- a/config_src/coupled_driver/MOM_surface_forcing.F90 +++ b/config_src/coupled_driver/MOM_surface_forcing.F90 @@ -409,62 +409,74 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, US, CS, sfc if (associated(IOB%lprec)) then fluxes%lprec(i,j) = IOB%lprec(i-i0,j-j0) * G%mask2dT(i,j) - if (CS%check_no_land_fluxes) call check_mask_val_consistency(IOB%lprec(i-i0,j-j0), G%mask2dT(i,j), i, j, 'lprec', G) + if (CS%check_no_land_fluxes) & + call check_mask_val_consistency(IOB%lprec(i-i0,j-j0), G%mask2dT(i,j), i, j, 'lprec', G) endif if (associated(IOB%fprec)) then fluxes%fprec(i,j) = IOB%fprec(i-i0,j-j0) * G%mask2dT(i,j) - if (CS%check_no_land_fluxes) call check_mask_val_consistency(IOB%fprec(i-i0,j-j0), G%mask2dT(i,j), i, j, 'fprec', G) + if (CS%check_no_land_fluxes) & + call check_mask_val_consistency(IOB%fprec(i-i0,j-j0), G%mask2dT(i,j), i, j, 'fprec', G) endif if (associated(IOB%q_flux)) then fluxes%evap(i,j) = - IOB%q_flux(i-i0,j-j0) * G%mask2dT(i,j) - if (CS%check_no_land_fluxes) call check_mask_val_consistency(IOB%q_flux(i-i0,j-j0), G%mask2dT(i,j), i, j, 'q_flux', G) + if (CS%check_no_land_fluxes) & + call check_mask_val_consistency(IOB%q_flux(i-i0,j-j0), G%mask2dT(i,j), i, j, 'q_flux', G) endif if (associated(IOB%runoff)) then fluxes%lrunoff(i,j) = IOB%runoff(i-i0,j-j0) * G%mask2dT(i,j) - if (CS%check_no_land_fluxes) call check_mask_val_consistency(IOB%runoff(i-i0,j-j0), G%mask2dT(i,j), i, j, 'runoff', G) + if (CS%check_no_land_fluxes) & + call check_mask_val_consistency(IOB%runoff(i-i0,j-j0), G%mask2dT(i,j), i, j, 'runoff', G) endif if (associated(IOB%calving)) then fluxes%frunoff(i,j) = IOB%calving(i-i0,j-j0) * G%mask2dT(i,j) - if (CS%check_no_land_fluxes) call check_mask_val_consistency(IOB%calving(i-i0,j-j0), G%mask2dT(i,j), i, j, 'calving', G) + if (CS%check_no_land_fluxes) & + call check_mask_val_consistency(IOB%calving(i-i0,j-j0), G%mask2dT(i,j), i, j, 'calving', G) endif if (associated(IOB%ustar_berg)) then 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 (CS%check_no_land_fluxes) call check_mask_val_consistency(IOB%ustar_berg(i-i0,j-j0), G%mask2dT(i,j), i, j, 'ustar_berg', G) + if (CS%check_no_land_fluxes) & + call check_mask_val_consistency(IOB%ustar_berg(i-i0,j-j0), G%mask2dT(i,j), i, j, 'ustar_berg', G) endif if (associated(IOB%area_berg)) then fluxes%area_berg(i,j) = IOB%area_berg(i-i0,j-j0) * G%mask2dT(i,j) - if (CS%check_no_land_fluxes) call check_mask_val_consistency(IOB%area_berg(i-i0,j-j0), G%mask2dT(i,j), i, j, 'area_berg', G) + if (CS%check_no_land_fluxes) & + call check_mask_val_consistency(IOB%area_berg(i-i0,j-j0), G%mask2dT(i,j), i, j, 'area_berg', G) endif if (associated(IOB%mass_berg)) then fluxes%mass_berg(i,j) = IOB%mass_berg(i-i0,j-j0) * G%mask2dT(i,j) - if (CS%check_no_land_fluxes) call check_mask_val_consistency(IOB%mass_berg(i-i0,j-j0), G%mask2dT(i,j), i, j, 'mass_berg', G) + if (CS%check_no_land_fluxes) & + call check_mask_val_consistency(IOB%mass_berg(i-i0,j-j0), G%mask2dT(i,j), i, j, 'mass_berg', G) endif if (associated(IOB%runoff_hflx)) then fluxes%heat_content_lrunoff(i,j) = IOB%runoff_hflx(i-i0,j-j0) * G%mask2dT(i,j) - if (CS%check_no_land_fluxes) call check_mask_val_consistency(IOB%runoff_hflx(i-i0,j-j0), G%mask2dT(i,j), i, j, 'runoff_hflx', G) + if (CS%check_no_land_fluxes) & + call check_mask_val_consistency(IOB%runoff_hflx(i-i0,j-j0), G%mask2dT(i,j), i, j, 'runoff_hflx', G) endif if (associated(IOB%calving_hflx)) then fluxes%heat_content_frunoff(i,j) = IOB%calving_hflx(i-i0,j-j0) * G%mask2dT(i,j) - if (CS%check_no_land_fluxes) call check_mask_val_consistency(IOB%calving_hflx(i-i0,j-j0), G%mask2dT(i,j), i, j, 'calving_hflx', G) + if (CS%check_no_land_fluxes) & + call check_mask_val_consistency(IOB%calving_hflx(i-i0,j-j0), G%mask2dT(i,j), i, j, 'calving_hflx', G) endif if (associated(IOB%lw_flux)) then fluxes%LW(i,j) = IOB%lw_flux(i-i0,j-j0) * G%mask2dT(i,j) - if (CS%check_no_land_fluxes) call check_mask_val_consistency(IOB%lw_flux(i-i0,j-j0), G%mask2dT(i,j), i, j, 'lw_flux', G) + if (CS%check_no_land_fluxes) & + call check_mask_val_consistency(IOB%lw_flux(i-i0,j-j0), G%mask2dT(i,j), i, j, 'lw_flux', G) endif if (associated(IOB%t_flux)) then fluxes%sens(i,j) = - IOB%t_flux(i-i0,j-j0) * G%mask2dT(i,j) - if (CS%check_no_land_fluxes) call check_mask_val_consistency(IOB%t_flux(i-i0,j-j0), G%mask2dT(i,j), i, j, 't_flux', G) + if (CS%check_no_land_fluxes) & + call check_mask_val_consistency(IOB%t_flux(i-i0,j-j0), G%mask2dT(i,j), i, j, 't_flux', G) endif fluxes%latent(i,j) = 0.0 @@ -485,19 +497,23 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, US, CS, sfc if (associated(IOB%sw_flux_vis_dir)) then fluxes%sw_vis_dir(i,j) = G%mask2dT(i,j) * IOB%sw_flux_vis_dir(i-i0,j-j0) - if (CS%check_no_land_fluxes) call check_mask_val_consistency(IOB%sw_flux_vis_dir(i-i0,j-j0), G%mask2dT(i,j), i, j, 'sw_flux_vis_dir', G) + if (CS%check_no_land_fluxes) & + call check_mask_val_consistency(IOB%sw_flux_vis_dir(i-i0,j-j0), G%mask2dT(i,j), i, j, 'sw_flux_vis_dir', G) endif if (associated(IOB%sw_flux_vis_dif)) then fluxes%sw_vis_dif(i,j) = G%mask2dT(i,j) * IOB%sw_flux_vis_dif(i-i0,j-j0) - if (CS%check_no_land_fluxes) call check_mask_val_consistency(IOB%sw_flux_vis_dif(i-i0,j-j0), G%mask2dT(i,j), i, j, 'sw_flux_vis_dif', G) + if (CS%check_no_land_fluxes) & + call check_mask_val_consistency(IOB%sw_flux_vis_dif(i-i0,j-j0), G%mask2dT(i,j), i, j, 'sw_flux_vis_dif', G) endif if (associated(IOB%sw_flux_nir_dir)) then fluxes%sw_nir_dir(i,j) = G%mask2dT(i,j) * IOB%sw_flux_nir_dir(i-i0,j-j0) - if (CS%check_no_land_fluxes) call check_mask_val_consistency(IOB%sw_flux_nir_dir(i-i0,j-j0), G%mask2dT(i,j), i, j, 'sw_flux_nir_dir', G) + if (CS%check_no_land_fluxes) & + call check_mask_val_consistency(IOB%sw_flux_nir_dir(i-i0,j-j0), G%mask2dT(i,j), i, j, 'sw_flux_nir_dir', G) endif if (associated(IOB%sw_flux_nir_dif)) then fluxes%sw_nir_dif(i,j) = G%mask2dT(i,j) * IOB%sw_flux_nir_dif(i-i0,j-j0) - if (CS%check_no_land_fluxes) call check_mask_val_consistency(IOB%sw_flux_nir_dif(i-i0,j-j0), G%mask2dT(i,j), i, j, 'sw_flux_nir_dif', G) + if (CS%check_no_land_fluxes) & + call check_mask_val_consistency(IOB%sw_flux_nir_dif(i-i0,j-j0), G%mask2dT(i,j), i, j, 'sw_flux_nir_dif', G) endif 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) @@ -510,13 +526,15 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, US, CS, sfc 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) - if (CS%check_no_land_fluxes) call check_mask_val_consistency(IOB%p(i-i0,j-j0), G%mask2dT(i,j), i, j, 'p', G) + if (CS%check_no_land_fluxes) & + call check_mask_val_consistency(IOB%p(i-i0,j-j0), G%mask2dT(i,j), i, j, 'p', G) 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) - if (CS%check_no_land_fluxes) call check_mask_val_consistency(IOB%p(i-i0,j-j0), G%mask2dT(i,j), i, j, 'p', G) + if (CS%check_no_land_fluxes) & + call check_mask_val_consistency(IOB%p(i-i0,j-j0), G%mask2dT(i,j), i, j, 'p', G) enddo ; enddo endif fluxes%accumulate_p_surf = .true. ! Multiple components may contribute to surface pressure. @@ -527,7 +545,8 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, US, CS, sfc 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) ) - if (CS%check_no_land_fluxes) call check_mask_val_consistency(IOB%salt_flux(i-i0,j-j0), G%mask2dT(i,j), i, j, 'salt_flux', G) + if (CS%check_no_land_fluxes) & + call check_mask_val_consistency(IOB%salt_flux(i-i0,j-j0), G%mask2dT(i,j), i, j, 'salt_flux', G) enddo ; enddo endif From b5e3049c449912097c76d121d5b8a2f5c2ba8208 Mon Sep 17 00:00:00 2001 From: Marshall Ward Date: Wed, 28 Aug 2019 15:21:15 -0400 Subject: [PATCH 267/297] README update; travis bugfix This PR updates the README to include instructions for the test suite Makefile. It also fixes a bug in the travis config file which may have been preventing code coverage updates. --- .testing/README.md | 207 ++++++++++++++++++++++++++++++++++++++++++++- .travis.yml | 4 +- 2 files changed, 208 insertions(+), 3 deletions(-) diff --git a/.testing/README.md b/.testing/README.md index 46b154da14..d163a20cd9 100644 --- a/.testing/README.md +++ b/.testing/README.md @@ -1,3 +1,208 @@ # .testing -This directory contains scripts used when evaluating commits on Travis-CI +This directory contains the Makefile and test configurations used to evaluate +submissions to the MOM6 codebase. The tests are designed to run either locally +or in a Travis-CI. + + +## Overview + +This section gives a very brief overview of the test suite and how to use it. + +To build and run the model tests +``` +make +make test +``` + +Regression testing is disabled on default. To include regression tests: +``` +make DO_REGRESSION_TESTS=true +make test DO_REGRESSION_TESTS=true +``` + +On platforms other than Gaea, a MKMF build template may be required. To +specify the path to the template: +``` +make MKMF_TEMPLATE=/path/to/template.mk +``` + +To run individual classes of tests, use the subclass name: +``` +make test.grids +make test.layouts +make DO_REGRESSION_TESTS=true test.regressions +``` + +To test an individual test configuration (TC): +``` +make tc0.grid +``` + +The rest of the document describes the test suite in more detail, including +names and descriptions of the test classes and configurations. + + +## Testing overview + +The test suite consists of many comparisons of model output for different model +configurations when subjected to relevant numerical and mathematical +transformations, such as grid layout or dimensional rescaling, for which the +model output should be invariant. If the model state is unchanged after each +transformation, then the test is reported as passing. Any discrepancy in the +model state causes the test to fail. + +Model state is currently defined by the `ocean.stats` output file, which +reports the total energy (per unit mass) at machine precision alongside similar +global metrics, such as mass or mean sea level, at lower precision. + +Clhecksums for every available diagnostic are also compared and the Makefile +will report any differences, but such differences are not yet considered a fail +condition. + + +## Building the executables + +Run `make` to build the test executables. +``` +make +``` +This will fetch the MKMF build toolchain, fetch and compile the FMS framework +library, and compile the executables used in the test suite. The default +configuration uses the symmetric grid in the debug-compile mode, with +optimizations disabled and stronger quality controls. The following +executables will be created: + +- `build/symmetric/MOM6`: Symmetric grid configuration (extended grids along + western and/or southern boundaries). This is the default configuration. + +- `build/asymmetric/MOM6`: Non-symmetric grid (equal-sized grids) + +- `build/repro/MOM6`: Optimized reproducible mode + +- (optional) `build/target/MOM6`: A reference build for regression testing + +The `target` build is only created when the `DO_REGRESSION_TESTS` flag is set +to `true`: +``` +make DO_REGRESSION_TESTS=true +``` +When set, the build will check out a second copy of the repository from a +specified URL and branch given by `MOM_TARGET_URL` and `MOM_TARGET_BRANCH`, +respectively. The code is checked out into the `TARGET_CODEBASE` directory. + +The current default settings are +``` +MOM_TARGET_SLUG = NOAA-GFDL/MOM6 +MOM_TARGET_URL = https://github.com/$(MOM_TARGET_SLUG) +# = https://github.com/NOAA-GFDL/MOM6 +MOM_TARGET_LOCAL_BRANCH = dev/gfdl +MOM_TARGET_BRANCH = origin/$(MOM_TARGET_LOCAL_BRANCH) +# = origin/dev/gfdl +TARGET_CODEBASE = $(BUILD)/target_codebase +``` +These default values can be configured to target a particular development +branch. + + +#### MKMF template + +The MKMF build toolchain requires a template file when building the model. The +default template, `ncrc-gnu.mk`, is part of the MKMF repository, but has been +specifically configured for use on NOAA's Gaea computer, and other institutes +will require their own template files. + +The template can be specified as a Make flag. +``` +make MKMF_TEMPLATE=/path/to/template.mk +``` +The `linux-ubuntu-xenial-gnu.mk` template is provided in the `.testing` +directory, and is intended for Travis-CI builds, but may also be a good +reference point for other Linux distributions. + +In the future, this step may be replaced with a more generalized build system, +such as CMake or automake. + + +## Tests + +Using `test` will run through the test suite. +``` +make test +``` +This will run through the following tests: + +- `test.regressions`: Regression tests relative to a code state (when enabled) +- `test.grids`: Symmetric vs nonsymmetric grids +- `test.layouts`: Domain decomposition, based on parallelization +- `test.restarts`: Resubmission by restarts +- `test.repros: Optimized (REPRO) and unoptimized (DEBUG) compilation +- `test.nans`: NaN initialization of allocated arrays +- `test.dims`: Dimensional scaling (length, time, thichkness, depth) + +To enable the regression tests, use `DO_REGRESSION_TEST=true`. +``` +make test DO_REGRESSION_TESTS=true +``` + +Each test can also be run individually. For example, the following command +will only run the grid tests. +``` +make test.grids +``` + +Each configuration is tested relative to the `symmetric` build, and reports a +fail if the answers differ from this build. + + +## Test configurations + +The following test configurations (TCs) are supported: + +- TC0: Unit testing of various model components, based on `unit_tests` +- TC1: A low-resolution version of the `benchmark` configuration +- TC2: An ALE configuration based on TC1 +- TC3: An open-boundary condition (OBC) test based on `circle_obcs` + + +## Code coverage + +Code coverage reports the lines of code which have been tested, and can +explicitly demonstrate when a particular operation is untested. + +Coverage is measued using `gcov` and is reported for TCs using the `symmetric` +executable. + +Coverage reporting is optionally sent to the `codecov.io` site. +``` +https://codecov.io/gh/NOAA-GFDL/MOM6 +``` +This is disabled on default, but can be enabled by the `REPORT_COVERAGE` flag. +``` +make test REPORT_COVERAGE=true +``` +Note that any uploads will require a valid token generated by CodeCov. + + +## Running on Travis + +Whenever code is pushed to GitHub or a pull request (PR) is created, the test +suite is triggered and the code changes are tested. + +When the tests are run on Travis, the following variables are re-defined: + +- `DO_REGRESSION_TESTS` is set to `true` for a PR submission, and is unset for + code pushes. + +- `MOM_TARGET_SLUG` is set to `TRAVIS_REPO_SLUG`, the URL stub of the model to + be built. + + For submissions to NOAA-GFDL, this will be set to `NOAA-GFDL/MOM6` and the + reference URL will be `https://github.com/NOAA-GFDL/MOM6`. + +- `MOM_TARGET_LOCAL_BRANCH` is set to `TRAVIS_BRANCH`. + + For a code push, this is set to the name of the active branch at GitHub. For + a PR, this is the name of the branch which is receiving the PR. + +- `REPORT_COVERAGE` is set to `true`. diff --git a/.travis.yml b/.travis.yml index b8bd33ca60..21dc9319ba 100644 --- a/.travis.yml +++ b/.travis.yml @@ -40,8 +40,8 @@ jobs: MKMF_TEMPLATE=linux-ubuntu-xenial-gnu.mk \ MOM_TARGET_SLUG=${TRAVIS_REPO_SLUG} \ MOM_TARGET_LOCAL_BRANCH=${TRAVIS_BRANCH} \ - DO_REGRESSION_TESTS=${TRAVIS_IS_PR} - REPORT_COVERAGE=${TRAVIS_IS_PR} + DO_REGRESSION_TESTS=${TRAVIS_IS_PR} \ + REPORT_COVERAGE=true - echo -en 'travis_fold:end:script.1\\r' - echo 'Running tests...' && echo -en 'travis_fold:start:script.2\\r' - make DO_REGRESSION_TESTS=${TRAVIS_IS_PR} test From 8eb3844de68a9d8caa3850119aea36595e6fdfec Mon Sep 17 00:00:00 2001 From: Marshall Ward Date: Wed, 28 Aug 2019 16:13:24 -0400 Subject: [PATCH 268/297] Initialize geothermal internal heat diagnostics The variables used for calculating internal heat in MOM_geothermal.F90 relied on zero-initialization due to the conditional do_i() check inside of the loops, which was producing NaN warnings in our test suite. This patch resolves this by conditionally initializing the fields based on diagnostic registration. It also introduces two new logical variables to control the initialization and evaluation of the arrays. --- .../vertical/MOM_geothermal.F90 | 34 ++++++++++++------- 1 file changed, 21 insertions(+), 13 deletions(-) diff --git a/src/parameterizations/vertical/MOM_geothermal.F90 b/src/parameterizations/vertical/MOM_geothermal.F90 index 10fe37da89..d3d0f2bc6e 100644 --- a/src/parameterizations/vertical/MOM_geothermal.F90 +++ b/src/parameterizations/vertical/MOM_geothermal.F90 @@ -116,10 +116,10 @@ subroutine geothermal(h, tv, dt, ea, eb, G, GV, CS, halo) real :: Idt ! inverse of the timestep [s-1] logical :: do_i(SZI_(G)) + logical :: compute_h_old, compute_T_old integer :: i, j, k, is, ie, js, je, nz, k2, i2 integer :: isj, iej, num_start, num_left, nkmb, k_tgt - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke if (present(halo)) then is = G%isc-halo ; ie = G%iec+halo ; js = G%jsc-halo ; je = G%jec+halo @@ -152,6 +152,18 @@ subroutine geothermal(h, tv, dt, ea, eb, G, GV, CS, halo) !$OMP wt_in_place,dTemp,dRcv,h_transfer,heating, & !$OMP I_h) + ! Conditionals for tracking diagnostic depdendencies + compute_h_old = CS%id_internal_heat_h_tendency > 0 & + .or. CS%id_internal_heat_heat_tendency > 0 & + .or. CS%id_internal_heat_temp_tendency > 0 + + compute_T_old = CS%id_internal_heat_heat_tendency > 0 & + .or. CS%id_internal_heat_temp_tendency > 0 + + if (CS%id_internal_heat_heat_tendency > 0) work_3d(:,:,:) = 0.0 + if (compute_h_old) h_old(:,:,:) = 0.0 + if (compute_T_old) T_old(:,:,:) = 0.0 + do j=js,je ! 1. Only work on columns that are being heated. ! 2. Find the deepest layer with any mass. @@ -192,17 +204,13 @@ subroutine geothermal(h, tv, dt, ea, eb, G, GV, CS, halo) do i=isj,iej ; if (do_i(i)) then ! Save temperature and thickness before any changes are made (for diagnostic) - if (CS%id_internal_heat_h_tendency > 0 & - .or. CS%id_internal_heat_heat_tendency > 0 & - .or. CS%id_internal_heat_temp_tendency > 0 ) then + if (compute_h_old) then h_old(i,j,k) = h(i,j,k) endif - if (CS%id_internal_heat_heat_tendency > 0 & - .or. CS%id_internal_heat_temp_tendency > 0) then + if (compute_T_old) then T_old(i,j,k) = tv%T(i,j,k) endif - if (h(i,j,k) > Angstrom) then if ((h(i,j,k)-Angstrom) >= h_geo_rem(i)) then h_heated = h_geo_rem(i) @@ -340,19 +348,19 @@ subroutine geothermal(h, tv, dt, ea, eb, G, GV, CS, halo) ! Post diagnostic of 3D tendencies (heat, temperature, and thickness) due to internal heat if (CS%id_internal_heat_heat_tendency > 0) then - call post_data(CS%id_internal_heat_heat_tendency, work_3d, CS%diag, alt_h = h_old) + call post_data(CS%id_internal_heat_heat_tendency, work_3d, CS%diag, alt_h=h_old) endif if (CS%id_internal_heat_temp_tendency > 0) then do j=js,je; do i=is,ie; do k=nz,1,-1 work_3d(i,j,k) = Idt * (tv%T(i,j,k) - T_old(i,j,k)) enddo; enddo; enddo - call post_data(CS%id_internal_heat_temp_tendency, work_3d, CS%diag, alt_h = h_old) + call post_data(CS%id_internal_heat_temp_tendency, work_3d, CS%diag, alt_h=h_old) endif if (CS%id_internal_heat_h_tendency > 0) then do j=js,je; do i=is,ie; do k=nz,1,-1 work_3d(i,j,k) = Idt * (h(i,j,k) - h_old(i,j,k)) enddo; enddo; enddo - call post_data(CS%id_internal_heat_h_tendency, work_3d, CS%diag, alt_h = h_old) + call post_data(CS%id_internal_heat_h_tendency, work_3d, CS%diag, alt_h=h_old) endif ! do i=is,ie ; do j=js,je @@ -447,15 +455,15 @@ subroutine geothermal_init(Time, G, param_file, diag, CS) CS%id_internal_heat_heat_tendency=register_diag_field('ocean_model', & 'internal_heat_heat_tendency', diag%axesTL, Time, & 'Heat tendency (in 3D) due to internal (geothermal) sources', & - 'W m-2', v_extensive = .true.) + 'W m-2', v_extensive=.true.) CS%id_internal_heat_temp_tendency=register_diag_field('ocean_model', & 'internal_heat_temp_tendency', diag%axesTL, Time, & 'Temperature tendency (in 3D) due to internal (geothermal) sources', & - 'degC s-1', v_extensive = .true.) + 'degC s-1', v_extensive=.true.) CS%id_internal_heat_h_tendency=register_diag_field('ocean_model', & 'internal_heat_h_tendency', diag%axesTL, Time, & 'Thickness tendency (in 3D) due to internal (geothermal) sources', & - 'm OR kg m-2', v_extensive = .true.) + 'm OR kg m-2', v_extensive=.true.) end subroutine geothermal_init From 2c48cd6069d7753f655c027575add7adcbcc1a82 Mon Sep 17 00:00:00 2001 From: Marshall Ward Date: Wed, 28 Aug 2019 18:10:08 -0400 Subject: [PATCH 269/297] PRECIOUS output; gitignore restructure ocean.stats and chksum_diag output is now tagged as PRECIOUS, and is retained after a run. This helps to identify an issue after a fail. .gitignore was also restructured to move the test ignore rules into a subdirectory. Finally, we no longer rely on (-) to ignore commands in Makefile, since it was causing odd issues after PRECIOUS was introduced. We now just explicitly ignore any commands by piping nonzero commands to `true`. --- .gitignore | 26 +++++++++++++------------- .testing/.gitignore | 13 +++++++++++++ .testing/Makefile | 5 ++++- 3 files changed, 30 insertions(+), 14 deletions(-) create mode 100644 .testing/.gitignore diff --git a/.gitignore b/.gitignore index c0bfc8b428..0b3138728d 100644 --- a/.gitignore +++ b/.gitignore @@ -6,16 +6,16 @@ html MOM6 build/ deps/ -.testing/*/available_diags.* -.testing/*/CPU_stats -.testing/*/chksum_diag -.testing/*/exitcode -.testing/*/logfile.*.out -.testing/*/MOM_parameter_doc.* -.testing/*/ocean_geometry.nc -.testing/*/ocean.stats -.testing/*/ocean.stats.nc -.testing/*/RESTART/ -.testing/*/time_stamp.out -.testing/*/Vertical_coordinate.nc -.testing/*/GOLD_IC.nc +#.testing/*/available_diags.* +#.testing/*/CPU_stats +#.testing/*/chksum_diag +#.testing/*/exitcode +#.testing/*/logfile.*.out +#.testing/*/MOM_parameter_doc.* +#.testing/*/ocean_geometry.nc +#.testing/*/ocean.stats +#.testing/*/ocean.stats.nc +#.testing/*/RESTART/ +#.testing/*/time_stamp.out +#.testing/*/Vertical_coordinate.nc +#.testing/*/GOLD_IC.nc diff --git a/.testing/.gitignore b/.testing/.gitignore new file mode 100644 index 0000000000..f119a40591 --- /dev/null +++ b/.testing/.gitignore @@ -0,0 +1,13 @@ +available_diags.* +CPU_stats +chksum_diag +exitcode +logfile.*.out +MOM_parameter_doc.* +ocean_geometry.nc +ocean.stats +ocean.stats.nc +RESTART/ +time_stamp.out +Vertical_coordinate.nc +GOLD_IC.nc diff --git a/.testing/Makefile b/.testing/Makefile index 8c27e73d8e..261947486e 100644 --- a/.testing/Makefile +++ b/.testing/Makefile @@ -172,11 +172,13 @@ test.dims: $(foreach c,$(CONFIGS),$(foreach d,t l h z,$(c).dim.$(d) $(c).dim.$(d # NOTE: chksum_diag return code of cmp is currently ignored since many fail! define CMP_RULE +.PRECIOUS: $(foreach b,$(2),$(BASE)/.testing/%/ocean.stats.$(b)) %.$(1): $(foreach b,$(2),$(BASE)/.testing/%/ocean.stats.$(b)) cmp $$^ +.PRECIOUS: $(foreach b,$(2),$(BASE)/.testing/%/chksum_diag.$(b)) %.$(1).diag: $(foreach b,$(2),$(BASE)/.testing/%/chksum_diag.$(b)) - -cmp $$^ + cmp $$^ || true endef $(eval $(call CMP_RULE,regression,symmetric target)) @@ -187,6 +189,7 @@ $(eval $(call CMP_RULE,nan,symmetric nan)) $(foreach d,t l h z,$(eval $(call CMP_RULE,dim.$(d),symmetric dim.$(d)))) # Restart tests only compare the final stat record +.PRECIOUS: $(foreach b,symmetric restart,$(BASE)/.testing/%/ocean.stats.$(b)) %.restart: $(foreach b,symmetric restart,$(BASE)/.testing/%/ocean.stats.$(b)) cmp $(foreach f,$^,<(tr -s ' ' < $(f) | cut -d ' ' -f3- | tail -n 1)) From 8efd3182cf440724f9af46d74bd7fe236d289785 Mon Sep 17 00:00:00 2001 From: Marshall Ward Date: Thu, 29 Aug 2019 11:58:22 -0400 Subject: [PATCH 270/297] Removed f90nml dependency; conditional coverage f90nml is no longer used to modify the input.nml files for restart runs, since it was adding an unnecessary dependency. Code coverage is now conditionally enabled for the symmetric build, and controlled by the REPORT_COVERAGE flag, since it can significantly increase the build and run times. --- .testing/Makefile | 16 +++++++--------- .travis.yml | 3 --- 2 files changed, 7 insertions(+), 12 deletions(-) diff --git a/.testing/Makefile b/.testing/Makefile index 261947486e..5ce85d4456 100644 --- a/.testing/Makefile +++ b/.testing/Makefile @@ -43,9 +43,6 @@ TESTS = grids layouts restarts repros nans dims # MOM_TARGET_SLUG: TRAVIS_REPO_SLUG # MOM_TARGET_LOCAL_BRANCH: TRAVIS_BRANCH # -# MOM_TARGET_REMOTE_NAME and MOM_MERGED_BRANCH are arbitrary labels which may -# cause namespace conflicts, and should probably be renamed or phased out. - # These are set to true by Travis if testing a pull request DO_REGRESSION_TESTS ?= REPORT_COVERAGE ?= @@ -78,8 +75,11 @@ all: $(foreach b,$(BUILDS),$(BUILD)/$(b)/MOM6) BUILD_TARGETS = MOM6 Makefile path_names .PRECIOUS: $(foreach b,$(BUILDS),$(foreach f,$(BUILD_TARGETS),$(BUILD)/$(b)/$(f))) +# Conditionally build symmetric with coverage support +COVFLAG=$(if $(REPORT_COVERAGE),COVERAGE=1,) + $(BUILD)/target/MOM6: MOMFLAGS=NETCDF=3 DEBUG=1 -$(BUILD)/symmetric/MOM6: MOMFLAGS=NETCDF=3 DEBUG=1 COVERAGE=1 +$(BUILD)/symmetric/MOM6: MOMFLAGS=NETCDF=3 DEBUG=1 $(COVFLAG) $(BUILD)/asymmetric/MOM6: MOMFLAGS=NETCDF=3 DEBUG=1 $(BUILD)/repro/MOM6: MOMFLAGS=NETCDF=3 REPRO=1 @@ -159,7 +159,7 @@ $(LIST_PATHS) $(MKMF): .PHONY: test test: $(foreach t,$(TESTS),test.$(t)) -# NOTE: We remove tc3 (OBC) from grid test +# NOTE: We remove tc3 (OBC) from grid test since it cannot run asymmetric grids .PHONY: $(foreach t,$(TESTS),test.$(t)) test.regressions: $(foreach c,$(CONFIGS),$(c).regression $(c).regression.diag) @@ -257,16 +257,14 @@ $(BASE)/.testing/%/ocean.stats.restart: $(BUILD)/symmetric/MOM6 && if [ -z "$${timeunit}" ]; then timeunit="8.64e4"; fi \ && printf -v timeunit_int "%.f" "$${timeunit}" \ && halfperiod=$$(printf "%.f" $$(bc <<< "scale=10; 0.5 * $${daymax} * $${timeunit_int}")) \ - && f90nml -g ocean_solo_nml -v seconds=$${halfperiod} input.nml > tmp.nml \ - && mv tmp.nml input.nml \ + && printf "\n&ocean_solo_nml\n seconds = $${halfperiod}\n/\n" >> input.nml \ && echo $${daymax} $${timeunit} # Run the first half-period cd $(@D) && $(MPIRUN) -n 1 $< 2> debug.out # Setup the next inputs rm -rf $(@D)/INPUT && mv $(@D)/RESTART $(@D)/INPUT mkdir $(@D)/RESTART - cd $(@D) && f90nml -g mom_input_nml -v input_filename='r' input.nml > tmp.nml - mv $(@D)/tmp.nml $(@D)/input.nml + cd $(@D) && sed -i -e "s/input_filename *= *'n'/input_filename = 'r'/g" input.nml # Run the second half-period cd $(@D) && $(MPIRUN) -n 1 $< 2> debug.out # Archive the results and cleanup diff --git a/.travis.yml b/.travis.yml index 21dc9319ba..3b5156c60f 100644 --- a/.travis.yml +++ b/.travis.yml @@ -18,9 +18,6 @@ addons: - tcsh pkg-config netcdf-bin libnetcdf-dev libnetcdff-dev openmpi-bin libopenmpi-dev gfortran - doxygen graphviz flex bison cmake -before_install: - - pip install --user f90nml - jobs: include: - env: JOB="Code style compliance" From afee4c50c160a1206dbe69e84ce334601b93ac39 Mon Sep 17 00:00:00 2001 From: Alistair Adcroft Date: Thu, 29 Aug 2019 17:11:18 +0000 Subject: [PATCH 271/297] Fixed typo and added slurm section to .testing/README --- .testing/README.md | 10 +++++++++- 1 file changed, 9 insertions(+), 1 deletion(-) diff --git a/.testing/README.md b/.testing/README.md index d163a20cd9..a9289a87dd 100644 --- a/.testing/README.md +++ b/.testing/README.md @@ -136,7 +136,7 @@ This will run through the following tests: - `test.grids`: Symmetric vs nonsymmetric grids - `test.layouts`: Domain decomposition, based on parallelization - `test.restarts`: Resubmission by restarts -- `test.repros: Optimized (REPRO) and unoptimized (DEBUG) compilation +- `test.repros`: Optimized (REPRO) and unoptimized (DEBUG) compilation - `test.nans`: NaN initialization of allocated arrays - `test.dims`: Dimensional scaling (length, time, thichkness, depth) @@ -206,3 +206,11 @@ When the tests are run on Travis, the following variables are re-defined: a PR, this is the name of the branch which is receiving the PR. - `REPORT_COVERAGE` is set to `true`. + +## Running under slurm + +By default the executables are invoked using `mpirun`. Under slurm you might need to +use `srun` (such as on GFDL's gaea HPC): +``` +make MPIRUN=srun test +``` From 30838e079f3e9a9be5c7ea9c51996aa891057f5c Mon Sep 17 00:00:00 2001 From: Marshall Ward Date: Thu, 29 Aug 2019 16:14:43 -0400 Subject: [PATCH 272/297] (*) Bugfix: [uv]hml z-diags in general restrat The z-interpolated uhml and vhml diagnostics gave inconsistent answers across layouts when using the general mixed layer restratification scheme, because the value of h had changed but its halos had not been updated. This had been previously fixed in the BML restratification but not the general stratification method. This patch updates the value of h by conditionally updating the halos if this diagnostic is required. --- src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 b/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 index 37ce9f0b79..c4a2d0c38f 100644 --- a/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 +++ b/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 @@ -514,6 +514,13 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt_in_T, MLD_in enddo ; enddo ; enddo !$OMP end parallel + ! Whenever thickness changes let the diag manager know, target grids + ! for vertical remapping may need to be regenerated. + if (CS%id_uhml > 0 .or. CS%id_vhml > 0) & + ! Remapped uhml and vhml 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) + ! Offer diagnostic fields for averaging. if (query_averaging_enabled(CS%diag)) then if (CS%id_urestrat_time > 0) call post_data(CS%id_urestrat_time, utimescale_diag, CS%diag) From 90b8228e414b74ef5dcbeaf04a507ad888b46a50 Mon Sep 17 00:00:00 2001 From: Marshall Ward Date: Thu, 29 Aug 2019 16:52:06 -0400 Subject: [PATCH 273/297] Travis: config.mk user config; enable coverage This PR enables coverage cleanup and CodeCov upload for test runs. It also introduces an optional configuration file, config.mk which can be used for user-configured settings, such as templates or mpirun commands. --- .testing/Makefile | 2 ++ .travis.yml | 5 ++++- 2 files changed, 6 insertions(+), 1 deletion(-) diff --git a/.testing/Makefile b/.testing/Makefile index 5ce85d4456..75aa79cb53 100644 --- a/.testing/Makefile +++ b/.testing/Makefile @@ -1,6 +1,8 @@ SHELL = bash MPIRUN ?= mpirun +-include config.mk + #--- # Dependencies BASE = $(dir $(abspath $(lastword $(MAKEFILE_LIST))))/.. diff --git a/.travis.yml b/.travis.yml index 3b5156c60f..e82d598030 100644 --- a/.travis.yml +++ b/.travis.yml @@ -41,5 +41,8 @@ jobs: REPORT_COVERAGE=true - echo -en 'travis_fold:end:script.1\\r' - echo 'Running tests...' && echo -en 'travis_fold:start:script.2\\r' - - make DO_REGRESSION_TESTS=${TRAVIS_IS_PR} test + - make \ + DO_REGRESSION_TESTS=${TRAVIS_IS_PR} \ + REPORT_COVERAGE=true \ + test - echo -en 'travis_fold:end:script.2\\r' From 6bd9459bb7454b4020bc1c3467be7055a709b21f Mon Sep 17 00:00:00 2001 From: Marshall Ward Date: Thu, 29 Aug 2019 17:07:42 -0400 Subject: [PATCH 274/297] Modify make test rule --- .travis.yml | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/.travis.yml b/.travis.yml index e82d598030..41d9d9b348 100644 --- a/.travis.yml +++ b/.travis.yml @@ -41,8 +41,7 @@ jobs: REPORT_COVERAGE=true - echo -en 'travis_fold:end:script.1\\r' - echo 'Running tests...' && echo -en 'travis_fold:start:script.2\\r' - - make \ + - make test \ DO_REGRESSION_TESTS=${TRAVIS_IS_PR} \ - REPORT_COVERAGE=true \ - test + REPORT_COVERAGE=true - echo -en 'travis_fold:end:script.2\\r' From d496ee7e52f7c45f1a966d62ec0a45e32df14da0 Mon Sep 17 00:00:00 2001 From: Marshall Ward Date: Thu, 29 Aug 2019 17:18:52 -0400 Subject: [PATCH 275/297] Travis: coverage path fixes Path rules for cleaning up old code coverage files (*.gcda) and for running the CodeCov.io upload script have been fixed. --- .testing/Makefile | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/.testing/Makefile b/.testing/Makefile index 75aa79cb53..1dee0e2100 100644 --- a/.testing/Makefile +++ b/.testing/Makefile @@ -219,13 +219,13 @@ endif define STAT_RULE $$(BASE)/.testing/%/ocean.stats.$(1): $$(BUILD)/$(2)/MOM6 - if [ $(3) ]; then find build -name *.gcda -exec rm -f '{}' \; ; fi + if [ $(3) ]; then find $$(BUILD) -name *.gcda -exec rm -f '{}' \; ; fi mkdir -p $$(@D)/RESTART echo $(4) > $$(@D)/MOM_override cd $$(@D) && $$(call MPIRUN_CMD,$(5)) -n $(6) $$< 2> debug.out cp $$(@D)/ocean.stats $$@ > $$(@D)/MOM_override - if [ $(3) ]; then bash <(curl -s https://codecov.io/bash) -n $$@; fi + if [ $(3) ]; then cd $$(BASE) && bash <(curl -s https://codecov.io/bash) -n $$@; fi $$(BASE)/.testing/%/chksum_diag.$(1): $$(BASE)/.testing/%/ocean.stats.$(1) cp $$(@D)/chksum_diag $$@ From 5c97200be2e05aa80c2c0df006ed37a81f577cce Mon Sep 17 00:00:00 2001 From: Kate Hedstrom Date: Thu, 29 Aug 2019 14:47:41 -0800 Subject: [PATCH 276/297] *Add new update_segment_tracer_reservoirs routine - The OBC tracer reservoirs were being updated in MOM_tracer_advect - twice each! Update them separately after tracer advection. - The OBC tracer lengthscale was being cubed to get the volume. Change that to a lengthscale times the face area where the advection is happening. - Changes answers if the tracer lengthscales were not set to zero. --- src/core/MOM.F90 | 3 + src/core/MOM_open_boundary.F90 | 102 ++++++++++++++++++++++++++++--- src/tracer/MOM_tracer_advect.F90 | 81 +----------------------- 3 files changed, 96 insertions(+), 90 deletions(-) diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index 3e41e075c1..23c11cc05b 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -86,6 +86,7 @@ module MOM use MOM_open_boundary, only : ocean_OBC_type, OBC_registry_type use MOM_open_boundary, only : register_temp_salt_segments use MOM_open_boundary, only : open_boundary_register_restarts +use MOM_open_boundary, only : update_segment_tracer_reservoirs use MOM_set_visc, only : set_viscous_BBL, set_viscous_ML, set_visc_init use MOM_set_visc, only : set_visc_register_restarts, set_visc_CS use MOM_sponge, only : init_sponge_diags, sponge_CS @@ -1089,6 +1090,8 @@ subroutine step_MOM_tracer_dyn(CS, G, GV, US, h, Time_local) call tracer_hordiff(h, CS%t_dyn_rel_adv, CS%MEKE, CS%VarMix, G, GV, US, & CS%tracer_diff_CSp, CS%tracer_Reg, CS%tv) if (showCallTree) call callTree_waypoint("finished tracer advection/diffusion (step_MOM)") + call update_segment_tracer_reservoirs(G, GV, CS%uhtr, CS%vhtr, h, CS%OBC, & + CS%t_dyn_rel_adv, CS%tracer_Reg) call cpu_clock_end(id_clock_tracer) ; call cpu_clock_end(id_clock_thermo) call cpu_clock_begin(id_clock_other) ; call cpu_clock_begin(id_clock_diagnostics) diff --git a/src/core/MOM_open_boundary.F90 b/src/core/MOM_open_boundary.F90 index cea51b1fd9..6973b0f67f 100644 --- a/src/core/MOM_open_boundary.F90 +++ b/src/core/MOM_open_boundary.F90 @@ -53,6 +53,7 @@ module MOM_open_boundary public register_temp_salt_segments public fill_temp_salt_segments public open_boundary_register_restarts +public update_segment_tracer_reservoirs integer, parameter, public :: OBC_NONE = 0 !< Indicates the use of no open boundary integer, parameter, public :: OBC_SIMPLE = 1 !< Indicates the use of a simple inflow open boundary @@ -181,11 +182,11 @@ module MOM_open_boundary !! can occur [T-1 ~> s-1]. type(segment_tracer_registry_type), pointer :: tr_Reg=> NULL()!< A pointer to the tracer registry for the segment. type(hor_index_type) :: HI !< Horizontal index ranges - real :: Tr_InvLscale3_out !< An effective inverse length scale cubed [m-3] - real :: Tr_InvLscale3_in !< for restoring the tracer concentration in a - !! ficticious reservior towards interior values - !! when flow is exiting the domain, or towards - !! an externally imposed value when flow is entering + real :: Tr_InvLscale_out !< An effective inverse length scale [m-1] + real :: Tr_InvLscale_in !< for restoring the tracer concentration in a + !! ficticious reservior towards interior values + !! when flow is exiting the domain, or towards + !! an externally imposed value when flow is entering end type OBC_segment_type !> Open-boundary data @@ -494,10 +495,10 @@ subroutine open_boundary_config(G, US, param_file, OBC) ! tracer-specific in the future for example, in cases where certain tracers are poorly constrained ! by data while others are well constrained - MJH. do l = 1, OBC%number_of_segments - OBC%segment(l)%Tr_InvLscale3_in=0.0 - if (Lscale_in>0.) OBC%segment(l)%Tr_InvLscale3_in = 1.0/(Lscale_in*Lscale_in*Lscale_in) - OBC%segment(l)%Tr_InvLscale3_out=0.0 - if (Lscale_out>0.) OBC%segment(l)%Tr_InvLscale3_out = 1.0/(Lscale_out*Lscale_out*Lscale_out) + OBC%segment(l)%Tr_InvLscale_in=0.0 + if (Lscale_in>0.) OBC%segment(l)%Tr_InvLscale_in = 1.0/Lscale_in + OBC%segment(l)%Tr_InvLscale_out=0.0 + if (Lscale_out>0.) OBC%segment(l)%Tr_InvLscale_out = 1.0/Lscale_out enddo endif ! OBC%number_of_segments > 0 @@ -4041,7 +4042,7 @@ subroutine flood_fill2(G, color, cin, cout, cland) end subroutine flood_fill2 !> Register OBC segment data for restarts -subroutine open_boundary_register_restarts(HI, GV, OBC_CS,restart_CSp) +subroutine open_boundary_register_restarts(HI, GV, OBC_CS, restart_CSp) type(hor_index_type), intent(in) :: HI !< Horizontal indices type(verticalGrid_type), pointer :: GV !< Container for vertical grid information type(ocean_OBC_type), pointer :: OBC_CS !< OBC data structure, data intent(inout) @@ -4080,6 +4081,87 @@ subroutine open_boundary_register_restarts(HI, GV, OBC_CS,restart_CSp) end subroutine open_boundary_register_restarts +!> Update the OBC tracer reservoirs after the tracers have been updated. +subroutine update_segment_tracer_reservoirs(G, GV, uhr, vhr, h, OBC, dt, Reg) + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure + type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: uhr !< accumulated volume/mass flux through + !! the zonal face [H L2 ~> m3 or kg] + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: vhr !< accumulated volume/mass flux through + !! the meridional face [H L2 ~> m3 or kg] + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< layer thickness after advection + !! [H ~> m or kg m-2] + type(ocean_OBC_type), pointer :: OBC !< Open boundary structure + real, intent(in) :: dt !< time increment [s] + type(tracer_registry_type), pointer :: Reg !< pointer to tracer registry + ! Local variables + integer :: i, j, k, m, n, ntr, nz + integer :: ishift, idir, jshift, jdir + type(OBC_segment_type), pointer :: segment=>NULL() + real :: u_L_in, u_L_out + real :: v_L_in, v_L_out + real :: fac1 + + nz = GV%ke + ntr = Reg%ntr + if (associated(OBC)) then ; if (OBC%OBC_pe) then + do n=1,OBC%number_of_segments + segment=>OBC%segment(n) + if (.not. associated(segment%tr_Reg)) cycle + if (segment%is_E_or_W) then + do j=segment%HI%jsd,segment%HI%jed + I = segment%HI%IsdB + + ishift=0 ! ishift+I corresponds to the nearest interior tracer cell index + idir=1 ! idir switches the sign of the flow so that positive is into the reservoir + if (segment%direction == OBC_DIRECTION_W) then + ishift=1 + idir=-1 + endif + ! update the reservoir tracer concentration implicitly + ! using Backward-Euler timestep + do m=1,ntr + if (associated(segment%tr_Reg%Tr(m)%tres)) then + do k=1,nz + u_L_in=max((idir*uhr(I,j,k))*segment%Tr_InvLscale_in/(h(i+ishift,j,k)*G%dyCu(I,j)),0.) + u_L_out=min((idir*uhr(I,j,k))*segment%Tr_InvLscale_out/(h(i+ishift,j,k)*G%dyCu(I,j)),0.) + fac1=1.0+dt*(u_L_in-u_L_out) + segment%tr_Reg%Tr(m)%tres(I,j,k)= (1.0/fac1)*(segment%tr_Reg%Tr(m)%tres(I,j,k) + & + dt*(u_L_in*Reg%Tr(m)%t(I+ishift,j,k) - & + u_L_out*segment%tr_Reg%Tr(m)%t(I,j,k))) + enddo + endif + enddo + enddo + else + do i=segment%HI%isd,segment%HI%ied + J = segment%HI%JsdB + jshift=0 ! jshift+J corresponds to the nearest interior tracer cell index + jdir=1 ! jdir switches the sign of the flow so that positive is into the reservoir + if (segment%direction == OBC_DIRECTION_S) then + jshift=1 + jdir=-1 + endif + ! update the reservoir tracer concentration implicitly + ! using Backward-Euler timestep + do m=1,ntr + if (associated(segment%tr_Reg%Tr(m)%tres)) then + do k=1,nz + v_L_in=max((jdir*vhr(i,J,k))*segment%Tr_InvLscale_in/(h(i,j+jshift,k)*G%dxCv(i,J)),0.) + v_L_out=min((jdir*vhr(i,J,k))*segment%Tr_InvLscale_out/(h(i,j+jshift,k)*G%dxCv(i,J)),0.) + fac1=1.0+dt*(v_L_in-v_L_out) + segment%tr_Reg%Tr(m)%tres(i,J,k)= (1.0/fac1)*(segment%tr_Reg%Tr(m)%tres(i,J,k) + & + dt*(v_L_in*Reg%Tr(m)%t(i,J+jshift,k) - & + v_L_out*segment%tr_Reg%Tr(m)%t(i,J,k))) + enddo + endif + enddo + enddo + endif + enddo + endif; endif +end subroutine update_segment_tracer_reservoirs + !> Adjust interface heights to fit the bathymetry and diagnose layer thickness. !! !! If the bottom most interface is below the topography then the bottom-most diff --git a/src/tracer/MOM_tracer_advect.F90 b/src/tracer/MOM_tracer_advect.F90 index 0e4c867253..7717fcc050 100644 --- a/src/tracer/MOM_tracer_advect.F90 +++ b/src/tracer/MOM_tracer_advect.F90 @@ -380,7 +380,6 @@ subroutine advect_x(Tr, hprev, uhr, uh_neglect, OBC, domore_u, ntr, Idt, & real :: aR, aL, dMx, dMn, Tp, Tc, Tm, dA, mA, a6 real :: fac1,u_L_in,u_L_out ! terms used for time-stepping OBC reservoirs type(OBC_segment_type), pointer :: segment=>NULL() - integer :: ishift, idir real :: dt ! the inverse of Idt, needed for time-stepping of tracer reservoirs logical :: usePLMslope @@ -439,27 +438,6 @@ subroutine advect_x(Tr, hprev, uhr, uh_neglect, OBC, domore_u, ntr, Idt, & if (segment%is_E_or_W) then if (j>=segment%HI%jsd .and. j<=segment%HI%jed) then I = segment%HI%IsdB - - ishift=0 ! ishift+I corresponds to the nearest interior tracer cell index - idir=1 ! idir switches the sign of the flow so that positive is into the reservoir - if (segment%direction == OBC_DIRECTION_W) then - ishift=1 - idir=-1 - endif - ! update the reservoir tracer concentration implicitly - ! using Backward-Euler timestep - do m=1,ntr - if (associated(segment%tr_Reg%Tr(m)%tres)) then - uhh(I)=uhr(I,j,k) - u_L_in=max(idir*uhh(I)*segment%Tr_InvLscale3_in,0.) - u_L_out=min(idir*uhh(I)*segment%Tr_InvLscale3_out,0.) - fac1=1.0+dt*(u_L_in-u_L_out) - segment%tr_Reg%Tr(m)%tres(I,j,k)= (1.0/fac1)*(segment%tr_Reg%Tr(m)%tres(I,j,k) + & - dt*(u_L_in*Tr(m)%t(I+ishift,j,k) - & - u_L_out*segment%tr_Reg%Tr(m)%t(I,j,k))) - endif - enddo - do m = 1,ntr ! replace tracers with OBC values if (associated(segment%tr_Reg%Tr(m)%tres)) then if (segment%direction == OBC_DIRECTION_W) then @@ -624,7 +602,7 @@ subroutine advect_x(Tr, hprev, uhr, uh_neglect, OBC, domore_u, ntr, Idt, & endif endif enddo - endif + endif if (OBC%open_u_BCs_exist_globally) then do n=1,OBC%number_of_segments @@ -633,25 +611,6 @@ subroutine advect_x(Tr, hprev, uhr, uh_neglect, OBC, domore_u, ntr, Idt, & if (segment%is_E_or_W .and. (j >= segment%HI%jsd .and. j<= segment%HI%jed)) then if (segment%specified) cycle if (.not. associated(segment%tr_Reg)) cycle - ishift=0 ! ishift+I corresponds to the nearest interior tracer cell index - idir=1 ! idir switches the sign of the flow so that positive is into the reservoir - if (segment%direction == OBC_DIRECTION_W) then - ishift = 1 - idir = -1 - endif - ! update the reservoir tracer concentration implicitly - ! using Backward-Euler timestep - do m=1,ntr - if (associated(segment%tr_Reg%Tr(m)%tres)) then - uhh(I) = uhr(I,j,k) - u_L_in = max(idir*uhh(I)*segment%Tr_InvLscale3_in,0.) - u_L_out = min(idir*uhh(I)*segment%Tr_InvLscale3_out,0.) - fac1 = 1.0+dt*(u_L_in-u_L_out) - segment%tr_Reg%Tr(m)%tres(I,j,k) = (1.0/fac1)*(segment%tr_Reg%Tr(m)%tres(I,j,k) + & - dt*(u_L_in*Tr(m)%t(I+ishift,j,k) - & - u_L_out*segment%tr_Reg%Tr(m)%t(I,j,k))) - endif - enddo ! Tracer fluxes are set to prescribed values only for inflows from masked areas. if ((uhr(I,j,k) > 0.0) .and. (G%mask2dT(i,j) < 0.5) .or. & @@ -777,7 +736,6 @@ subroutine advect_y(Tr, hprev, vhr, vh_neglect, OBC, domore_v, ntr, Idt, & integer :: i, j, j2, m, n, j_up, stencil real :: aR, aL, dMx, dMn, Tp, Tc, Tm, dA, mA, a6 real :: fac1,v_L_in,v_L_out ! terms used for time-stepping OBC reservoirs - integer :: jshift, jdir real :: dt ! The inverse of Idt, needed for segment reservoir time-stepping type(OBC_segment_type), pointer :: segment=>NULL() logical :: usePLMslope @@ -847,26 +805,6 @@ subroutine advect_y(Tr, hprev, vhr, vh_neglect, OBC, domore_v, ntr, Idt, & if (segment%is_N_or_S) then if (i>=segment%HI%isd .and. i<=segment%HI%ied) then J = segment%HI%JsdB - jshift=0 ! jshift+J corresponds to the nearest interior tracer cell index - jdir=1 ! jdir switches the sign of the flow so that positive is into the reservoir - if (segment%direction == OBC_DIRECTION_S) then - jshift=1 - jdir=-1 - endif - ! update the reservoir tracer concentration implicitly - ! using Backward-Euler timestep - do m=1,ntr - if (associated(segment%tr_Reg%Tr(m)%tres)) then - vhh(i,J)=vhr(i,J,k) - v_L_in=max(jdir*vhh(i,J)*segment%Tr_InvLscale3_in,0.) - v_L_out=min(jdir*vhh(i,J)*segment%Tr_InvLscale3_out,0.) - fac1=1.0+dt*(v_L_in-v_L_out) - segment%tr_Reg%Tr(m)%tres(i,J,k)= (1.0/fac1)*(segment%tr_Reg%Tr(m)%tres(i,J,k) + & - dt*(v_L_in*Tr(m)%t(i,J+jshift,k) - & - v_L_out*segment%tr_Reg%Tr(m)%t(i,J,k))) - endif - enddo - do m = 1,ntr ! replace tracers with OBC values if (associated(segment%tr_Reg%Tr(m)%tres)) then if (segment%direction == OBC_DIRECTION_S) then @@ -1040,24 +978,7 @@ subroutine advect_y(Tr, hprev, vhr, vh_neglect, OBC, domore_v, ntr, Idt, & if (segment%specified) cycle if (.not. associated(segment%tr_Reg)) cycle if (segment%is_N_or_S .and. (J >= segment%HI%JsdB .and. J<= segment%HI%JedB)) then - jshift = 0 ; jdir = 1 - if (segment%direction == OBC_DIRECTION_S) then - jshift = 1 ; jdir = -1 - endif do i=segment%HI%isd,segment%HI%ied - ! update the reservoir tracer concentration implicitly - ! using Backward-Euler timestep - do m=1,ntr - if (associated(segment%tr_Reg%Tr(m)%tres)) then - vhh(i,J)=vhr(i,J,k) - v_L_in = max(jdir*vhh(i,J)*segment%Tr_InvLscale3_in,0.) - v_L_out = min(jdir*vhh(i,J)*segment%Tr_InvLscale3_out,0.) - fac1 = 1.0 + dt*(v_L_in-v_L_out) - segment%tr_Reg%Tr(m)%tres(i,J,k) = (1.0/fac1)*(segment%tr_Reg%Tr(m)%tres(i,J,k) + & - dt*v_L_in*Tr(m)%t(i,j+jshift,k) - & - dt*v_L_out*segment%tr_Reg%Tr(m)%t(i,j,k)) - endif - enddo ! Tracer fluxes are set to prescribed values only for inflows from masked areas. if ((vhr(i,J,k) > 0.0) .and. (G%mask2dT(i,j) < 0.5) .or. & (vhr(i,J,k) < 0.0) .and. (G%mask2dT(i,j+1) < 0.5)) then From 2294f80b5dd341252570d585d8021e78c8fe7aeb Mon Sep 17 00:00:00 2001 From: Kate Hedstrom Date: Thu, 29 Aug 2019 16:06:33 -0800 Subject: [PATCH 277/297] Fixed the OBC checking for data and dying if missing. - Could make it more verbose to let the user know which data are missing. --- src/core/MOM_open_boundary.F90 | 10 +++++++--- 1 file changed, 7 insertions(+), 3 deletions(-) diff --git a/src/core/MOM_open_boundary.F90 b/src/core/MOM_open_boundary.F90 index 6973b0f67f..dbdc0b72c1 100644 --- a/src/core/MOM_open_boundary.F90 +++ b/src/core/MOM_open_boundary.F90 @@ -612,7 +612,13 @@ subroutine initialize_segment_data(G, OBC, PF) ! needs documentation !! Yet, unsafe for now, causes grief for ! MOM_parameter_docs in circle_obcs on two processes. ! call get_param(PF, mdl, segnam, segstr, 'xyz') + ! Clear out any old values + segstr = '' call get_param(PF, mdl, segnam, segstr) + if (segstr == '') then + write(mesg,'("No OBC_SEGMENT_XXX_DATA string for OBC segment ",I3)') n + call MOM_error(FATAL, mesg) + endif call parse_segment_data_str(trim(segstr), fields=fields, num_fields=num_fields) if (num_fields == 0) then @@ -772,8 +778,7 @@ subroutine initialize_segment_data(G, OBC, PF) 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) + call MOM_error(FATAL, mesg) endif enddo @@ -4111,7 +4116,6 @@ subroutine update_segment_tracer_reservoirs(G, GV, uhr, vhr, h, OBC, dt, Reg) if (segment%is_E_or_W) then do j=segment%HI%jsd,segment%HI%jed I = segment%HI%IsdB - ishift=0 ! ishift+I corresponds to the nearest interior tracer cell index idir=1 ! idir switches the sign of the flow so that positive is into the reservoir if (segment%direction == OBC_DIRECTION_W) then From c7d2a719b6cd18ea4501ef9a8a79473f27072449 Mon Sep 17 00:00:00 2001 From: Alistair Adcroft Date: Fri, 30 Aug 2019 17:24:43 +0000 Subject: [PATCH 278/297] Renamed MOM_surcace_forcing.F90 in coupler/ directory - As agreed on the MOM6 dev call, we renamed MOM_surface_forcing.F90 to help distinguish it from the other caps. It is now called MOM_surface_forcing_gfdl.F90. --- ...M_surface_forcing.F90 => MOM_surface_forcing_gfdl.F90} | 4 ++-- config_src/coupled_driver/ocean_model_MOM.F90 | 8 ++++---- 2 files changed, 6 insertions(+), 6 deletions(-) rename config_src/coupled_driver/{MOM_surface_forcing.F90 => MOM_surface_forcing_gfdl.F90} (99%) diff --git a/config_src/coupled_driver/MOM_surface_forcing.F90 b/config_src/coupled_driver/MOM_surface_forcing_gfdl.F90 similarity index 99% rename from config_src/coupled_driver/MOM_surface_forcing.F90 rename to config_src/coupled_driver/MOM_surface_forcing_gfdl.F90 index a8d49853a4..4102bba491 100644 --- a/config_src/coupled_driver/MOM_surface_forcing.F90 +++ b/config_src/coupled_driver/MOM_surface_forcing_gfdl.F90 @@ -1,4 +1,4 @@ -module MOM_surface_forcing +module MOM_surface_forcing_gfdl ! This file is part of MOM6. See LICENSE.md for the license. @@ -1639,4 +1639,4 @@ subroutine check_mask_val_consistency(val, mask, i, j, varname, G) end subroutine -end module MOM_surface_forcing +end module MOM_surface_forcing_gfdl diff --git a/config_src/coupled_driver/ocean_model_MOM.F90 b/config_src/coupled_driver/ocean_model_MOM.F90 index 96366a78e9..c5d10c7aaf 100644 --- a/config_src/coupled_driver/ocean_model_MOM.F90 +++ b/config_src/coupled_driver/ocean_model_MOM.F90 @@ -33,10 +33,10 @@ module ocean_model_mod 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_surface_forcing_gfdl, only : surface_forcing_init, convert_IOB_to_fluxes +use MOM_surface_forcing_gfdl, only : convert_IOB_to_forces, ice_ocn_bnd_type_chksum +use MOM_surface_forcing_gfdl, only : ice_ocean_boundary_type, surface_forcing_CS +use MOM_surface_forcing_gfdl, only : forcing_save_restart use MOM_time_manager, only : time_type, operator(>), operator(+), operator(-) use MOM_time_manager, only : operator(*), operator(/), operator(/=) use MOM_time_manager, only : operator(<=), operator(>=), operator(<) From 15a03c5aadfc8d2fd968a018dd07171c85451d05 Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Tue, 3 Sep 2019 09:25:25 -0600 Subject: [PATCH 279/297] Commented out variables left over from merge These need to be cleaned before submitting a PR to dev/ncar --- .../lateral/MOM_hor_visc.F90 | 23 ++++++++++--------- 1 file changed, 12 insertions(+), 11 deletions(-) diff --git a/src/parameterizations/lateral/MOM_hor_visc.F90 b/src/parameterizations/lateral/MOM_hor_visc.F90 index 0498e34edf..f734bb2788 100644 --- a/src/parameterizations/lateral/MOM_hor_visc.F90 +++ b/src/parameterizations/lateral/MOM_hor_visc.F90 @@ -1002,7 +1002,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, if (CS%id_Kh_q>0 .or. CS%debug) Kh_q(I,J,k) = Kh if (CS%id_vort_xy_q>0) vort_xy_q(I,J,k) = vort_xy(I,J) - if (CS%debug) sh_xy_3d(I,J,k) = sh_xy(I,J) +! if (CS%debug) sh_xy_3d(I,J,k) = sh_xy(I,J) str_xy(I,J) = -Kh * sh_xy(I,J) else ! not Laplacian @@ -1048,10 +1048,10 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, if (CS%id_Ah_q>0 .or. CS%debug) Ah_q(I,J,k) = Ah - str_xy(I,J) = str_xy(I,J) + Ah * ( dvdx3(I,J) + dudy3(I,J) ) + str_xy(I,J) = str_xy(I,J) + Ah * ( dDel2vdx(I,J) + dDel2udy(I,J) ) ! Keep a copy of the biharmonic contribution for backscatter parameterization - bhstr_xy(I,J) = Ah * ( dvdx3(I,J) + dudy3(I,J) ) * & + bhstr_xy(I,J) = Ah * ( dDel2vdx(I,J) + dDel2udy(I,J) ) * & (hq(I,J) * G%mask2dBu(I,J) * CS%reduction_xy(I,J)) endif ! biharmonic @@ -1305,7 +1305,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, if (CS%Laplacian) then call hchksum(Kh_h, "Kh_h", G%HI, haloshift=0, scale=US%L_to_m**2*US%s_to_T) call Bchksum(Kh_q, "Kh_q", G%HI, haloshift=0, scale=US%L_to_m**2*US%s_to_T) - call Bchksum(sh_xy_3d, "shear_xy", G%HI, haloshift=0, scale=US%s_to_T) +! call Bchksum(sh_xy_3d, "shear_xy", G%HI, haloshift=0, scale=US%s_to_T) ! call hchksum(sh_xx_3d, "shear_xx", G%HI, haloshift=0, scale=US%s_to_T) endif if (CS%biharmonic) call hchksum(Ah_h, "Ah_h", G%HI, haloshift=0, scale=US%L_to_m**4*US%s_to_T) @@ -1426,13 +1426,14 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS, MEKE) ! 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, "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, "DEBUG", CS%debug, default=.false.) call get_param(param_file, mdl, "LAPLACIAN", CS%Laplacian, & From ab9bc8a3eebfaeefc45478743eeb1664d0c70f9b Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Tue, 3 Sep 2019 09:27:46 -0600 Subject: [PATCH 280/297] Adds OS%US as argument in add_shelf_forces --- config_src/mct_driver/mom_ocean_model_mct.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/config_src/mct_driver/mom_ocean_model_mct.F90 b/config_src/mct_driver/mom_ocean_model_mct.F90 index 4f1c7d963a..94bc15cec8 100644 --- a/config_src/mct_driver/mom_ocean_model_mct.F90 +++ b/config_src/mct_driver/mom_ocean_model_mct.F90 @@ -525,7 +525,7 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & 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) + call add_shelf_forces(OS%grid, OS%US, OS%Ice_shelf_CSp, OS%forces) endif if (OS%icebergs_alter_ocean) then if (do_dyn) & @@ -560,7 +560,7 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & 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) + call add_shelf_forces(OS%grid, OS%US, OS%Ice_shelf_CSp, OS%forces) endif if (OS%icebergs_alter_ocean) then if (do_dyn) & From 25b409bdcb3d0b2bc156093f967d5232b8d0e2eb Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Tue, 3 Sep 2019 10:45:15 -0600 Subject: [PATCH 281/297] Adding back 2018_answers and cleanning the code --- .../lateral/MOM_hor_visc.F90 | 22 +++++++------------ 1 file changed, 8 insertions(+), 14 deletions(-) diff --git a/src/parameterizations/lateral/MOM_hor_visc.F90 b/src/parameterizations/lateral/MOM_hor_visc.F90 index f734bb2788..e9ff06d337 100644 --- a/src/parameterizations/lateral/MOM_hor_visc.F90 +++ b/src/parameterizations/lateral/MOM_hor_visc.F90 @@ -306,7 +306,6 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, FrictWork_GME, & ! work done by GME [W m-2] div_xx_h ! horizontal divergence [s-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 [L2 T-1 ~> m2 s-1] real :: Ah ! biharmonic viscosity [L4 T-1 ~> m4 s-1] real :: Kh ! Laplacian viscosity [L2 T-1 ~> m2 s-1] @@ -363,11 +362,6 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, Ah_h(:,:,:) = 0.0 Kh_h(:,:,:) = 0.0 -! if (CS%debug) then -! sh_xx_3d(:,:,:) = 0.0 ; sh_xy_3d(:,:,:) = 0.0 -! Kh_q(:,:,:) = 0.0 ; Ah_q(:,:,:) = 0.0 -! endif - if (present(OBC)) then ; if (associated(OBC)) then ; if (OBC%OBC_pe) then apply_OBC = OBC%Flather_u_BCs_exist_globally .or. OBC%Flather_v_BCs_exist_globally apply_OBC = .true. @@ -1379,6 +1373,7 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS, MEKE) ! If false and USE_GME = True, issue a FATAL error. logical :: use_MEKE ! If true, use the MEKE module for calculating eddy kinetic energy. ! If false and USE_GME = True, issue a FATAL error. + logical :: default_2018_answers character(len=64) :: inputdir, filename real :: deg2rad ! Converts degrees to radians @@ -1426,13 +1421,13 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS, MEKE) ! 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, "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, "DEBUG", CS%debug, default=.false.) @@ -2142,7 +2137,6 @@ subroutine smooth_GME(CS,G,GME_flux_h,GME_flux_q) real :: wc, ww, we, wn, ws ! averaging weights for smoothing integer :: i, j, k, s - !do s=1,CS%n_smooth do s=1,1 ! Update halos From 185235666d2e8799021cc88396849e91ec264bc9 Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Mon, 16 Sep 2019 11:13:23 -0600 Subject: [PATCH 282/297] Removes white space --- src/parameterizations/lateral/MOM_hor_visc.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/parameterizations/lateral/MOM_hor_visc.F90 b/src/parameterizations/lateral/MOM_hor_visc.F90 index e9ff06d337..213e9a485f 100644 --- a/src/parameterizations/lateral/MOM_hor_visc.F90 +++ b/src/parameterizations/lateral/MOM_hor_visc.F90 @@ -263,7 +263,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, real, dimension(SZIB_(G),SZJB_(G)) :: & dvdx, dudy, & ! components in the shearing strain [s-1] - dDel2vdx, dDel2udy, & ! Components in the biharmonic equivalent of the shearing strain [L-2 T-1 ~> m-2 s-1] + dDel2vdx, dDel2udy, & ! Components in the biharmonic equivalent of the shearing strain [L-2 T-1 ~> m-2 s-1] dvdx_bt, dudy_bt, & ! components in the barotropic shearing strain [s-1] sh_xy, & ! horizontal shearing strain (du/dy + dv/dx) including metric terms [s-1] sh_xy_bt, & ! barotropic horizontal shearing strain (du/dy + dv/dx) inc. metric terms [s-1] From ba2f186aedb18320ca4110729ad65574c6c53e06 Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Tue, 17 Sep 2019 09:43:33 -0600 Subject: [PATCH 283/297] Removed diagnostics related to FrictWork_diss and FrictWork_Max * We deleted these terms previously but forgot to remove posting the diagnostics. Thanks to Travis and .testing/tc0 we were able to identidy this mistake. --- .../lateral/MOM_hor_visc.F90 | 19 +------------------ 1 file changed, 1 insertion(+), 18 deletions(-) diff --git a/src/parameterizations/lateral/MOM_hor_visc.F90 b/src/parameterizations/lateral/MOM_hor_visc.F90 index 213e9a485f..b798fb4d86 100644 --- a/src/parameterizations/lateral/MOM_hor_visc.F90 +++ b/src/parameterizations/lateral/MOM_hor_visc.F90 @@ -180,8 +180,7 @@ module MOM_hor_visc integer :: id_GME_coeff_h = -1, id_GME_coeff_q = -1 integer :: id_vort_xy_q = -1, id_div_xx_h = -1 integer :: id_FrictWork = -1, id_FrictWorkIntz = -1 - integer :: id_FrictWorkMax = -1 - integer :: id_FrictWork_diss = -1, id_FrictWork_GME = -1 + integer :: id_FrictWork_GME = -1 !!@} @@ -301,8 +300,6 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, 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_GME, & ! work done by GME [W m-2] div_xx_h ! horizontal divergence [s-1] real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: & @@ -1283,8 +1280,6 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, if (CS%id_diffu>0) call post_data(CS%id_diffu, diffu, CS%diag) if (CS%id_diffv>0) call post_data(CS%id_diffv, diffv, CS%diag) if (CS%id_FrictWork>0) call post_data(CS%id_FrictWork, FrictWork, CS%diag) - if (CS%id_FrictWorkMax>0) call post_data(CS%id_FrictWorkMax, FrictWorkMax, CS%diag) - if (CS%id_FrictWork_diss>0) call post_data(CS%id_FrictWork_diss, FrictWork_diss, CS%diag) if (CS%id_FrictWork_GME>0) call post_data(CS%id_FrictWork_GME, FrictWork_GME, CS%diag) if (CS%id_Ah_h>0) call post_data(CS%id_Ah_h, Ah_h, CS%diag) if (CS%id_div_xx_h>0) call post_data(CS%id_div_xx_h, div_xx_h, CS%diag) @@ -2077,18 +2072,6 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS, MEKE) CS%id_FrictWork = register_diag_field('ocean_model','FrictWork',diag%axesTL,Time,& 'Integral work done by lateral friction terms', 'W m-2', conversion=US%s_to_T**3*US%L_to_m**2) - 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', conversion=US%s_to_T**3*US%L_to_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', conversion=US%s_to_T**3*US%L_to_m**2) - endif - endif - CS%id_FrictWorkIntz = register_diag_field('ocean_model','FrictWorkIntz',diag%axesT1,Time, & 'Depth integrated work done by lateral friction', 'W m-2', conversion=US%s_to_T**3*US%L_to_m**2, & cmor_field_name='dispkexyfo', & From 992e82652f73190b330eeec83f2375291e7f7c68 Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Tue, 17 Sep 2019 10:23:21 -0600 Subject: [PATCH 284/297] Avoids posting Kv_slow when it is not initialized --- src/parameterizations/vertical/MOM_vert_friction.F90 | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/parameterizations/vertical/MOM_vert_friction.F90 b/src/parameterizations/vertical/MOM_vert_friction.F90 index 1bed36e75e..d286bc815a 100644 --- a/src/parameterizations/vertical/MOM_vert_friction.F90 +++ b/src/parameterizations/vertical/MOM_vert_friction.F90 @@ -1015,7 +1015,8 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, US, CS, OBC) endif ! Offer diagnostic fields for averaging. - if (CS%id_Kv_slow > 0) call post_data(CS%id_Kv_slow, visc%Kv_slow, CS%diag) + if (associated(visc%Kv_slow) .and. (CS%id_Kv_slow > 0)) & + call post_data(CS%id_Kv_slow, visc%Kv_slow, CS%diag) if (CS%id_Kv_u > 0) call post_data(CS%id_Kv_u, Kv_u, CS%diag) if (CS%id_Kv_v > 0) call post_data(CS%id_Kv_v, Kv_v, CS%diag) if (CS%id_au_vv > 0) call post_data(CS%id_au_vv, CS%a_u, CS%diag) From 353cea1d24689686480b3356f725666d291bc3f3 Mon Sep 17 00:00:00 2001 From: alperaltuntas Date: Tue, 17 Sep 2019 13:22:08 -0600 Subject: [PATCH 285/297] remove unused modules --- config_src/mct_driver/mom_ocean_model_mct.F90 | 1 - config_src/nuopc_driver/mom_ocean_model_nuopc.F90 | 1 - 2 files changed, 2 deletions(-) diff --git a/config_src/mct_driver/mom_ocean_model_mct.F90 b/config_src/mct_driver/mom_ocean_model_mct.F90 index ec894f1ebb..3dd302cf2d 100644 --- a/config_src/mct_driver/mom_ocean_model_mct.F90 +++ b/config_src/mct_driver/mom_ocean_model_mct.F90 @@ -56,7 +56,6 @@ module MOM_ocean_model_mct 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 diff --git a/config_src/nuopc_driver/mom_ocean_model_nuopc.F90 b/config_src/nuopc_driver/mom_ocean_model_nuopc.F90 index 426c7e9922..a99c1b60eb 100644 --- a/config_src/nuopc_driver/mom_ocean_model_nuopc.F90 +++ b/config_src/nuopc_driver/mom_ocean_model_nuopc.F90 @@ -52,7 +52,6 @@ module MOM_ocean_model_nuopc 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 From c295ce1bdb5760deaea84667eeb4ee6df98ebb2d Mon Sep 17 00:00:00 2001 From: alperaltuntas Date: Tue, 17 Sep 2019 13:24:27 -0600 Subject: [PATCH 286/297] add ncar version of Doxyfile --- docs/Doxyfile_ncar_rtd | 2437 ++++++++++++++++++++++++++++++++++++++++ 1 file changed, 2437 insertions(+) create mode 100644 docs/Doxyfile_ncar_rtd diff --git a/docs/Doxyfile_ncar_rtd b/docs/Doxyfile_ncar_rtd new file mode 100644 index 0000000000..46e06ef109 --- /dev/null +++ b/docs/Doxyfile_ncar_rtd @@ -0,0 +1,2437 @@ +# Doxyfile 1.8.12 + +# This file describes the settings to be used by the documentation system +# doxygen (www.doxygen.org) for a project. +# +# All text after a double hash (##) is considered a comment and is placed in +# front of the TAG it is preceding. +# +# All text after a single hash (#) is considered a comment and will be ignored. +# The format is: +# TAG = value [value, ...] +# For lists, items can also be appended using: +# TAG += value [value, ...] +# Values that contain spaces should be placed between quotes (\" \"). + +#--------------------------------------------------------------------------- +# Project related configuration options +#--------------------------------------------------------------------------- + +# This tag specifies the encoding used for all characters in the config file +# that follow. The default is UTF-8 which is also the encoding used for all text +# before the first occurrence of this tag. Doxygen uses libiconv (or the iconv +# built into libc) for the transcoding. See http://www.gnu.org/software/libiconv +# for the list of possible encodings. +# The default value is: UTF-8. + +DOXYFILE_ENCODING = UTF-8 + +# The PROJECT_NAME tag is a single word (or a sequence of words surrounded by +# double-quotes, unless you are using Doxywizard) that should identify the +# project for which the documentation is generated. This name is used in the +# title of most generated pages and in a few other places. +# The default value is: My Project. + +PROJECT_NAME = "MOM6" + +# The PROJECT_NUMBER tag can be used to enter a project or revision number. This +# could be handy for archiving the generated documentation or if some version +# control system is used. + +PROJECT_NUMBER = + +# Using the PROJECT_BRIEF tag one can provide an optional one line description +# for a project that appears at the top of each page and should give viewer a +# quick idea about the purpose of the project. Keep the description short. + +PROJECT_BRIEF = + +# With the PROJECT_LOGO tag one can specify a logo or an icon that is included +# in the documentation. The maximum height of the logo should not exceed 55 +# pixels and the maximum width should not exceed 200 pixels. Doxygen will copy +# the logo to the output directory. + +PROJECT_LOGO = + +# The OUTPUT_DIRECTORY tag is used to specify the (relative or absolute) path +# into which the generated documentation will be written. If a relative path is +# entered, it will be relative to the location where doxygen was started. If +# left blank the current directory will be used. + +#OUTPUT_DIRECTORY = + +# If the CREATE_SUBDIRS tag is set to YES then doxygen will create 4096 sub- +# directories (in 2 levels) under the output directory of each output format and +# will distribute the generated files over these directories. Enabling this +# option can be useful when feeding doxygen a huge amount of source files, where +# putting all generated files in the same directory would otherwise causes +# performance problems for the file system. +# The default value is: NO. + +CREATE_SUBDIRS = NO + +# If the ALLOW_UNICODE_NAMES tag is set to YES, doxygen will allow non-ASCII +# characters to appear in the names of generated files. If set to NO, non-ASCII +# characters will be escaped, for example _xE3_x81_x84 will be used for Unicode +# U+3044. +# The default value is: NO. + +ALLOW_UNICODE_NAMES = NO + +# The OUTPUT_LANGUAGE tag is used to specify the language in which all +# documentation generated by doxygen is written. Doxygen will use this +# information to generate all constant output in the proper language. +# Possible values are: Afrikaans, Arabic, Armenian, Brazilian, Catalan, Chinese, +# Chinese-Traditional, Croatian, Czech, Danish, Dutch, English (United States), +# Esperanto, Farsi (Persian), Finnish, French, German, Greek, Hungarian, +# Indonesian, Italian, Japanese, Japanese-en (Japanese with English messages), +# Korean, Korean-en (Korean with English messages), Latvian, Lithuanian, +# Macedonian, Norwegian, Persian (Farsi), Polish, Portuguese, Romanian, Russian, +# Serbian, Serbian-Cyrillic, Slovak, Slovene, Spanish, Swedish, Turkish, +# Ukrainian and Vietnamese. +# The default value is: English. + +OUTPUT_LANGUAGE = English + +# If the BRIEF_MEMBER_DESC tag is set to YES, doxygen will include brief member +# descriptions after the members that are listed in the file and class +# documentation (similar to Javadoc). Set to NO to disable this. +# The default value is: YES. + +BRIEF_MEMBER_DESC = YES + +# If the REPEAT_BRIEF tag is set to YES, doxygen will prepend the brief +# description of a member or function before the detailed description +# +# Note: If both HIDE_UNDOC_MEMBERS and BRIEF_MEMBER_DESC are set to NO, the +# brief descriptions will be completely suppressed. +# The default value is: YES. + +REPEAT_BRIEF = YES + +# This tag implements a quasi-intelligent brief description abbreviator that is +# used to form the text in various listings. Each string in this list, if found +# as the leading text of the brief description, will be stripped from the text +# and the result, after processing the whole list, is used as the annotated +# text. Otherwise, the brief description is used as-is. If left blank, the +# following values are used ($name is automatically replaced with the name of +# the entity):The $name class, The $name widget, The $name file, is, provides, +# specifies, contains, represents, a, an and the. + +ABBREVIATE_BRIEF = + +# If the ALWAYS_DETAILED_SEC and REPEAT_BRIEF tags are both set to YES then +# doxygen will generate a detailed section even if there is only a brief +# description. +# The default value is: NO. + +ALWAYS_DETAILED_SEC = NO + +# If the INLINE_INHERITED_MEMB tag is set to YES, doxygen will show all +# inherited members of a class in the documentation of that class as if those +# members were ordinary class members. Constructors, destructors and assignment +# operators of the base classes will not be shown. +# The default value is: NO. + +INLINE_INHERITED_MEMB = NO + +# If the FULL_PATH_NAMES tag is set to YES, doxygen will prepend the full path +# before files name in the file list and in the header files. If set to NO the +# shortest path that makes the file name unique will be used +# The default value is: YES. + +FULL_PATH_NAMES = YES + +# The STRIP_FROM_PATH tag can be used to strip a user-defined part of the path. +# Stripping is only done if one of the specified strings matches the left-hand +# part of the path. The tag can be used to show relative paths in the file list. +# If left blank the directory from which doxygen is run is used as the path to +# strip. +# +# Note that you can specify absolute paths here, but also relative paths, which +# will be relative from the directory where doxygen is started. +# This tag requires that the tag FULL_PATH_NAMES is set to YES. + +STRIP_FROM_PATH = + +# The STRIP_FROM_INC_PATH tag can be used to strip a user-defined part of the +# path mentioned in the documentation of a class, which tells the reader which +# header file to include in order to use a class. If left blank only the name of +# the header file containing the class definition is used. Otherwise one should +# specify the list of include paths that are normally passed to the compiler +# using the -I flag. + +STRIP_FROM_INC_PATH = + +# If the SHORT_NAMES tag is set to YES, doxygen will generate much shorter (but +# less readable) file names. This can be useful is your file systems doesn't +# support long names like on DOS, Mac, or CD-ROM. +# The default value is: NO. + +SHORT_NAMES = NO + +# If the JAVADOC_AUTOBRIEF tag is set to YES then doxygen will interpret the +# first line (until the first dot) of a Javadoc-style comment as the brief +# description. If set to NO, the Javadoc-style will behave just like regular Qt- +# style comments (thus requiring an explicit @brief command for a brief +# description.) +# The default value is: NO. + +JAVADOC_AUTOBRIEF = NO + +# If the QT_AUTOBRIEF tag is set to YES then doxygen will interpret the first +# line (until the first dot) of a Qt-style comment as the brief description. If +# set to NO, the Qt-style will behave just like regular Qt-style comments (thus +# requiring an explicit \brief command for a brief description.) +# The default value is: NO. + +QT_AUTOBRIEF = NO + +# The MULTILINE_CPP_IS_BRIEF tag can be set to YES to make doxygen treat a +# multi-line C++ special comment block (i.e. a block of //! or /// comments) as +# a brief description. This used to be the default behavior. The new default is +# to treat a multi-line C++ comment block as a detailed description. Set this +# tag to YES if you prefer the old behavior instead. +# +# Note that setting this tag to YES also means that rational rose comments are +# not recognized any more. +# The default value is: NO. + +MULTILINE_CPP_IS_BRIEF = NO + +# If the INHERIT_DOCS tag is set to YES then an undocumented member inherits the +# documentation from any documented member that it re-implements. +# The default value is: YES. + +INHERIT_DOCS = YES + +# If the SEPARATE_MEMBER_PAGES tag is set to YES then doxygen will produce a new +# page for each member. If set to NO, the documentation of a member will be part +# of the file/class/namespace that contains it. +# The default value is: NO. + +SEPARATE_MEMBER_PAGES = NO + +# The TAB_SIZE tag can be used to set the number of spaces in a tab. Doxygen +# uses this value to replace tabs by spaces in code fragments. +# Minimum value: 1, maximum value: 16, default value: 4. + +TAB_SIZE = 2 + +# This tag can be used to specify a number of aliases that act as commands in +# the documentation. An alias has the form: +# name=value +# For example adding +# "sideeffect=@par Side Effects:\n" +# will allow you to put the command \sideeffect (or @sideeffect) in the +# documentation, which will result in a user-defined paragraph with heading +# "Side Effects:". You can put \n's in the value part of an alias to insert +# newlines. + +ALIASES = + +# This tag can be used to specify a number of word-keyword mappings (TCL only). +# A mapping has the form "name=value". For example adding "class=itcl::class" +# will allow you to use the command class in the itcl::class meaning. + +TCL_SUBST = + +# Set the OPTIMIZE_OUTPUT_FOR_C tag to YES if your project consists of C sources +# only. Doxygen will then generate output that is more tailored for C. For +# instance, some of the names that are used will be different. The list of all +# members will be omitted, etc. +# The default value is: NO. + +OPTIMIZE_OUTPUT_FOR_C = NO + +# Set the OPTIMIZE_OUTPUT_JAVA tag to YES if your project consists of Java or +# Python sources only. Doxygen will then generate output that is more tailored +# for that language. For instance, namespaces will be presented as packages, +# qualified scopes will look different, etc. +# The default value is: NO. + +OPTIMIZE_OUTPUT_JAVA = NO + +# Set the OPTIMIZE_FOR_FORTRAN tag to YES if your project consists of Fortran +# sources. Doxygen will then generate output that is tailored for Fortran. +# The default value is: NO. + +OPTIMIZE_FOR_FORTRAN = YES + +# Set the OPTIMIZE_OUTPUT_VHDL tag to YES if your project consists of VHDL +# sources. Doxygen will then generate output that is tailored for VHDL. +# The default value is: NO. + +OPTIMIZE_OUTPUT_VHDL = NO + +# Doxygen selects the parser to use depending on the extension of the files it +# parses. With this tag you can assign which parser to use for a given +# extension. Doxygen has a built-in mapping, but you can override or extend it +# using this tag. The format is ext=language, where ext is a file extension, and +# language is one of the parsers supported by doxygen: IDL, Java, Javascript, +# C#, C, C++, D, PHP, Objective-C, Python, Fortran (fixed format Fortran: +# FortranFixed, free formatted Fortran: FortranFree, unknown formatted Fortran: +# Fortran. In the later case the parser tries to guess whether the code is fixed +# or free formatted code, this is the default for Fortran type files), VHDL. For +# instance to make doxygen treat .inc files as Fortran files (default is PHP), +# and .f files as C (default is Fortran), use: inc=Fortran f=C. +# +# Note: For files without extension you can use no_extension as a placeholder. +# +# Note that for custom extensions you also need to set FILE_PATTERNS otherwise +# the files are not read by doxygen. + +EXTENSION_MAPPING = + +# If the MARKDOWN_SUPPORT tag is enabled then doxygen pre-processes all comments +# according to the Markdown format, which allows for more readable +# documentation. See http://daringfireball.net/projects/markdown/ for details. +# The output of markdown processing is further processed by doxygen, so you can +# mix doxygen, HTML, and XML commands with Markdown formatting. Disable only in +# case of backward compatibilities issues. +# The default value is: YES. + +MARKDOWN_SUPPORT = YES + +# When the TOC_INCLUDE_HEADINGS tag is set to a non-zero value, all headings up +# to that level are automatically included in the table of contents, even if +# they do not have an id attribute. +# Note: This feature currently applies only to Markdown headings. +# Minimum value: 0, maximum value: 99, default value: 0. +# This tag requires that the tag MARKDOWN_SUPPORT is set to YES. + +TOC_INCLUDE_HEADINGS = 0 + +# When enabled doxygen tries to link words that correspond to documented +# classes, or namespaces to their corresponding documentation. Such a link can +# be prevented in individual cases by putting a % sign in front of the word or +# globally by setting AUTOLINK_SUPPORT to NO. +# The default value is: YES. + +AUTOLINK_SUPPORT = YES + +# If you use STL classes (i.e. std::string, std::vector, etc.) but do not want +# to include (a tag file for) the STL sources as input, then you should set this +# tag to YES in order to let doxygen match functions declarations and +# definitions whose arguments contain STL classes (e.g. func(std::string); +# versus func(std::string) {}). This also make the inheritance and collaboration +# diagrams that involve STL classes more complete and accurate. +# The default value is: NO. + +BUILTIN_STL_SUPPORT = NO + +# If you use Microsoft's C++/CLI language, you should set this option to YES to +# enable parsing support. +# The default value is: NO. + +CPP_CLI_SUPPORT = NO + +# Set the SIP_SUPPORT tag to YES if your project consists of sip (see: +# http://www.riverbankcomputing.co.uk/software/sip/intro) sources only. Doxygen +# will parse them like normal C++ but will assume all classes use public instead +# of private inheritance when no explicit protection keyword is present. +# The default value is: NO. + +SIP_SUPPORT = NO + +# For Microsoft's IDL there are propget and propput attributes to indicate +# getter and setter methods for a property. Setting this option to YES will make +# doxygen to replace the get and set methods by a property in the documentation. +# This will only work if the methods are indeed getting or setting a simple +# type. If this is not the case, or you want to show the methods anyway, you +# should set this option to NO. +# The default value is: YES. + +IDL_PROPERTY_SUPPORT = YES + +# If member grouping is used in the documentation and the DISTRIBUTE_GROUP_DOC +# tag is set to YES then doxygen will reuse the documentation of the first +# member in the group (if any) for the other members of the group. By default +# all members of a group must be documented explicitly. +# The default value is: NO. + +DISTRIBUTE_GROUP_DOC = YES + +# If one adds a struct or class to a group and this option is enabled, then also +# any nested class or struct is added to the same group. By default this option +# is disabled and one has to add nested compounds explicitly via \ingroup. +# The default value is: NO. + +GROUP_NESTED_COMPOUNDS = NO + +# Set the SUBGROUPING tag to YES to allow class member groups of the same type +# (for instance a group of public functions) to be put as a subgroup of that +# type (e.g. under the Public Functions section). Set it to NO to prevent +# subgrouping. Alternatively, this can be done per class using the +# \nosubgrouping command. +# The default value is: YES. + +SUBGROUPING = YES + +# When the INLINE_GROUPED_CLASSES tag is set to YES, classes, structs and unions +# are shown inside the group in which they are included (e.g. using \ingroup) +# instead of on a separate page (for HTML and Man pages) or section (for LaTeX +# and RTF). +# +# Note that this feature does not work in combination with +# SEPARATE_MEMBER_PAGES. +# The default value is: NO. + +INLINE_GROUPED_CLASSES = NO + +# When the INLINE_SIMPLE_STRUCTS tag is set to YES, structs, classes, and unions +# with only public data fields or simple typedef fields will be shown inline in +# the documentation of the scope in which they are defined (i.e. file, +# namespace, or group documentation), provided this scope is documented. If set +# to NO, structs, classes, and unions are shown on a separate page (for HTML and +# Man pages) or section (for LaTeX and RTF). +# The default value is: NO. + +INLINE_SIMPLE_STRUCTS = NO + +# When TYPEDEF_HIDES_STRUCT tag is enabled, a typedef of a struct, union, or +# enum is documented as struct, union, or enum with the name of the typedef. So +# typedef struct TypeS {} TypeT, will appear in the documentation as a struct +# with name TypeT. When disabled the typedef will appear as a member of a file, +# namespace, or class. And the struct will be named TypeS. This can typically be +# useful for C code in case the coding convention dictates that all compound +# types are typedef'ed and only the typedef is referenced, never the tag name. +# The default value is: NO. + +TYPEDEF_HIDES_STRUCT = NO + +# The size of the symbol lookup cache can be set using LOOKUP_CACHE_SIZE. This +# cache is used to resolve symbols given their name and scope. Since this can be +# an expensive process and often the same symbol appears multiple times in the +# code, doxygen keeps a cache of pre-resolved symbols. If the cache is too small +# doxygen will become slower. If the cache is too large, memory is wasted. The +# cache size is given by this formula: 2^(16+LOOKUP_CACHE_SIZE). The valid range +# is 0..9, the default is 0, corresponding to a cache size of 2^16=65536 +# symbols. At the end of a run doxygen will report the cache usage and suggest +# the optimal cache size from a speed point of view. +# Minimum value: 0, maximum value: 9, default value: 0. + +LOOKUP_CACHE_SIZE = 0 + +#--------------------------------------------------------------------------- +# Build related configuration options +#--------------------------------------------------------------------------- + +# If the EXTRACT_ALL tag is set to YES, doxygen will assume all entities in +# documentation are documented, even if no documentation was available. Private +# class members and static file members will be hidden unless the +# EXTRACT_PRIVATE respectively EXTRACT_STATIC tags are set to YES. +# Note: This will also disable the warnings about undocumented members that are +# normally produced when WARNINGS is set to YES. +# The default value is: NO. + +EXTRACT_ALL = YES + +# If the EXTRACT_PRIVATE tag is set to YES, all private members of a class will +# be included in the documentation. +# The default value is: NO. + +EXTRACT_PRIVATE = YES + +# If the EXTRACT_PACKAGE tag is set to YES, all members with package or internal +# scope will be included in the documentation. +# The default value is: NO. + +EXTRACT_PACKAGE = YES + +# If the EXTRACT_STATIC tag is set to YES, all static members of a file will be +# included in the documentation. +# The default value is: NO. + +EXTRACT_STATIC = YES + +# If the EXTRACT_LOCAL_CLASSES tag is set to YES, classes (and structs) defined +# locally in source files will be included in the documentation. If set to NO, +# only classes defined in header files are included. Does not have any effect +# for Java sources. +# The default value is: YES. + +EXTRACT_LOCAL_CLASSES = YES + +# This flag is only useful for Objective-C code. If set to YES, local methods, +# which are defined in the implementation section but not in the interface are +# included in the documentation. If set to NO, only methods in the interface are +# included. +# The default value is: NO. + +EXTRACT_LOCAL_METHODS = YES + +# If this flag is set to YES, the members of anonymous namespaces will be +# extracted and appear in the documentation as a namespace called +# 'anonymous_namespace{file}', where file will be replaced with the base name of +# the file that contains the anonymous namespace. By default anonymous namespace +# are hidden. +# The default value is: NO. + +EXTRACT_ANON_NSPACES = YES + +# If the HIDE_UNDOC_MEMBERS tag is set to YES, doxygen will hide all +# undocumented members inside documented classes or files. If set to NO these +# members will be included in the various overviews, but no documentation +# section is generated. This option has no effect if EXTRACT_ALL is enabled. +# The default value is: NO. + +HIDE_UNDOC_MEMBERS = NO + +# If the HIDE_UNDOC_CLASSES tag is set to YES, doxygen will hide all +# undocumented classes that are normally visible in the class hierarchy. If set +# to NO, these classes will be included in the various overviews. This option +# has no effect if EXTRACT_ALL is enabled. +# The default value is: NO. + +HIDE_UNDOC_CLASSES = NO + +# If the HIDE_FRIEND_COMPOUNDS tag is set to YES, doxygen will hide all friend +# (class|struct|union) declarations. If set to NO, these declarations will be +# included in the documentation. +# The default value is: NO. + +HIDE_FRIEND_COMPOUNDS = NO + +# If the HIDE_IN_BODY_DOCS tag is set to YES, doxygen will hide any +# documentation blocks found inside the body of a function. If set to NO, these +# blocks will be appended to the function's detailed documentation block. +# The default value is: NO. + +HIDE_IN_BODY_DOCS = NO + +# The INTERNAL_DOCS tag determines if documentation that is typed after a +# \internal command is included. If the tag is set to NO then the documentation +# will be excluded. Set it to YES to include the internal documentation. +# The default value is: NO. + +INTERNAL_DOCS = YES + +# If the CASE_SENSE_NAMES tag is set to NO then doxygen will only generate file +# names in lower-case letters. If set to YES, upper-case letters are also +# allowed. This is useful if you have classes or files whose names only differ +# in case and if your file system supports case sensitive file names. Windows +# and Mac users are advised to set this option to NO. +# The default value is: system dependent. + +CASE_SENSE_NAMES = YES + +# If the HIDE_SCOPE_NAMES tag is set to NO then doxygen will show members with +# their full class and namespace scopes in the documentation. If set to YES, the +# scope will be hidden. +# The default value is: NO. + +HIDE_SCOPE_NAMES = NO + +# If the HIDE_COMPOUND_REFERENCE tag is set to NO (default) then doxygen will +# append additional text to a page's title, such as Class Reference. If set to +# YES the compound reference will be hidden. +# The default value is: NO. + +HIDE_COMPOUND_REFERENCE= NO + +# If the SHOW_INCLUDE_FILES tag is set to YES then doxygen will put a list of +# the files that are included by a file in the documentation of that file. +# The default value is: YES. + +SHOW_INCLUDE_FILES = YES + +# If the SHOW_GROUPED_MEMB_INC tag is set to YES then Doxygen will add for each +# grouped member an include statement to the documentation, telling the reader +# which file to include in order to use the member. +# The default value is: NO. + +SHOW_GROUPED_MEMB_INC = NO + +# If the FORCE_LOCAL_INCLUDES tag is set to YES then doxygen will list include +# files with double quotes in the documentation rather than with sharp brackets. +# The default value is: NO. + +FORCE_LOCAL_INCLUDES = NO + +# If the INLINE_INFO tag is set to YES then a tag [inline] is inserted in the +# documentation for inline members. +# The default value is: YES. + +INLINE_INFO = YES + +# If the SORT_MEMBER_DOCS tag is set to YES then doxygen will sort the +# (detailed) documentation of file and class members alphabetically by member +# name. If set to NO, the members will appear in declaration order. +# The default value is: YES. + +SORT_MEMBER_DOCS = YES + +# If the SORT_BRIEF_DOCS tag is set to YES then doxygen will sort the brief +# descriptions of file, namespace and class members alphabetically by member +# name. If set to NO, the members will appear in declaration order. Note that +# this will also influence the order of the classes in the class list. +# The default value is: NO. + +SORT_BRIEF_DOCS = NO + +# If the SORT_MEMBERS_CTORS_1ST tag is set to YES then doxygen will sort the +# (brief and detailed) documentation of class members so that constructors and +# destructors are listed first. If set to NO the constructors will appear in the +# respective orders defined by SORT_BRIEF_DOCS and SORT_MEMBER_DOCS. +# Note: If SORT_BRIEF_DOCS is set to NO this option is ignored for sorting brief +# member documentation. +# Note: If SORT_MEMBER_DOCS is set to NO this option is ignored for sorting +# detailed member documentation. +# The default value is: NO. + +SORT_MEMBERS_CTORS_1ST = NO + +# If the SORT_GROUP_NAMES tag is set to YES then doxygen will sort the hierarchy +# of group names into alphabetical order. If set to NO the group names will +# appear in their defined order. +# The default value is: NO. + +SORT_GROUP_NAMES = NO + +# If the SORT_BY_SCOPE_NAME tag is set to YES, the class list will be sorted by +# fully-qualified names, including namespaces. If set to NO, the class list will +# be sorted only by class name, not including the namespace part. +# Note: This option is not very useful if HIDE_SCOPE_NAMES is set to YES. +# Note: This option applies only to the class list, not to the alphabetical +# list. +# The default value is: NO. + +SORT_BY_SCOPE_NAME = NO + +# If the STRICT_PROTO_MATCHING option is enabled and doxygen fails to do proper +# type resolution of all parameters of a function it will reject a match between +# the prototype and the implementation of a member function even if there is +# only one candidate or it is obvious which candidate to choose by doing a +# simple string match. By disabling STRICT_PROTO_MATCHING doxygen will still +# accept a match between prototype and implementation in such cases. +# The default value is: NO. + +STRICT_PROTO_MATCHING = NO + +# The GENERATE_TODOLIST tag can be used to enable (YES) or disable (NO) the todo +# list. This list is created by putting \todo commands in the documentation. +# The default value is: YES. + +GENERATE_TODOLIST = NO + +# The GENERATE_TESTLIST tag can be used to enable (YES) or disable (NO) the test +# list. This list is created by putting \test commands in the documentation. +# The default value is: YES. + +GENERATE_TESTLIST = YES + +# The GENERATE_BUGLIST tag can be used to enable (YES) or disable (NO) the bug +# list. This list is created by putting \bug commands in the documentation. +# The default value is: YES. + +GENERATE_BUGLIST = YES + +# The GENERATE_DEPRECATEDLIST tag can be used to enable (YES) or disable (NO) +# the deprecated list. This list is created by putting \deprecated commands in +# the documentation. +# The default value is: YES. + +GENERATE_DEPRECATEDLIST= YES + +# The ENABLED_SECTIONS tag can be used to enable conditional documentation +# sections, marked by \if ... \endif and \cond +# ... \endcond blocks. + +ENABLED_SECTIONS = + +# The MAX_INITIALIZER_LINES tag determines the maximum number of lines that the +# initial value of a variable or macro / define can have for it to appear in the +# documentation. If the initializer consists of more lines than specified here +# it will be hidden. Use a value of 0 to hide initializers completely. The +# appearance of the value of individual variables and macros / defines can be +# controlled using \showinitializer or \hideinitializer command in the +# documentation regardless of this setting. +# Minimum value: 0, maximum value: 10000, default value: 30. + +MAX_INITIALIZER_LINES = 30 + +# Set the SHOW_USED_FILES tag to NO to disable the list of files generated at +# the bottom of the documentation of classes and structs. If set to YES, the +# list will mention the files that were used to generate the documentation. +# The default value is: YES. + +SHOW_USED_FILES = YES + +# Set the SHOW_FILES tag to NO to disable the generation of the Files page. This +# will remove the Files entry from the Quick Index and from the Folder Tree View +# (if specified). +# The default value is: YES. + +SHOW_FILES = YES + +# Set the SHOW_NAMESPACES tag to NO to disable the generation of the Namespaces +# page. This will remove the Namespaces entry from the Quick Index and from the +# Folder Tree View (if specified). +# The default value is: YES. + +SHOW_NAMESPACES = YES + +# The FILE_VERSION_FILTER tag can be used to specify a program or script that +# doxygen should invoke to get the current version for each file (typically from +# the version control system). Doxygen will invoke the program by executing (via +# popen()) the command command input-file, where command is the value of the +# FILE_VERSION_FILTER tag, and input-file is the name of an input file provided +# by doxygen. Whatever the program writes to standard output is used as the file +# version. For an example see the documentation. + +FILE_VERSION_FILTER = + +# The LAYOUT_FILE tag can be used to specify a layout file which will be parsed +# by doxygen. The layout file controls the global structure of the generated +# output files in an output format independent way. To create the layout file +# that represents doxygen's defaults, run doxygen with the -l option. You can +# optionally specify a file name after the option, if omitted DoxygenLayout.xml +# will be used as the name of the layout file. +# +# Note that if you run doxygen from a directory containing a file called +# DoxygenLayout.xml, doxygen will parse it automatically even if the LAYOUT_FILE +# tag is left empty. + +LAYOUT_FILE = + +# The CITE_BIB_FILES tag can be used to specify one or more bib files containing +# the reference definitions. This must be a list of .bib files. The .bib +# extension is automatically appended if omitted. This requires the bibtex tool +# to be installed. See also http://en.wikipedia.org/wiki/BibTeX for more info. +# For LaTeX the style of the bibliography can be controlled using +# LATEX_BIB_STYLE. To use this feature you need bibtex and perl available in the +# search path. See also \cite for info how to create references. + +CITE_BIB_FILES = + +#--------------------------------------------------------------------------- +# Configuration options related to warning and progress messages +#--------------------------------------------------------------------------- + +# The QUIET tag can be used to turn on/off the messages that are generated to +# standard output by doxygen. If QUIET is set to YES this implies that the +# messages are off. +# The default value is: NO. + +QUIET = NO + +# The WARNINGS tag can be used to turn on/off the warning messages that are +# generated to standard error (stderr) by doxygen. If WARNINGS is set to YES +# this implies that the warnings are on. +# +# Tip: Turn warnings on while writing the documentation. +# The default value is: YES. + +WARNINGS = YES + +# If the WARN_IF_UNDOCUMENTED tag is set to YES then doxygen will generate +# warnings for undocumented members. If EXTRACT_ALL is set to YES then this flag +# will automatically be disabled. +# The default value is: YES. + +WARN_IF_UNDOCUMENTED = YES + +# If the WARN_IF_DOC_ERROR tag is set to YES, doxygen will generate warnings for +# potential errors in the documentation, such as not documenting some parameters +# in a documented function, or documenting parameters that don't exist or using +# markup commands wrongly. +# The default value is: YES. + +WARN_IF_DOC_ERROR = YES + +# This WARN_NO_PARAMDOC option can be enabled to get warnings for functions that +# are documented, but have no documentation for their parameters or return +# value. If set to NO, doxygen will only warn about wrong or incomplete +# parameter documentation, but not about the absence of documentation. +# The default value is: NO. + +WARN_NO_PARAMDOC = NO + +# If the WARN_AS_ERROR tag is set to YES then doxygen will immediately stop when +# a warning is encountered. +# The default value is: NO. + +WARN_AS_ERROR = NO + +# The WARN_FORMAT tag determines the format of the warning messages that doxygen +# can produce. The string should contain the $file, $line, and $text tags, which +# will be replaced by the file and line number from which the warning originated +# and the warning text. Optionally the format may contain $version, which will +# be replaced by the version of the file (if it could be obtained via +# FILE_VERSION_FILTER) +# The default value is: $file:$line: $text. + +WARN_FORMAT = "$file:$line: $text" + +# The WARN_LOGFILE tag can be used to specify a file to which warning and error +# messages should be written. If left blank the output is written to standard +# error (stderr). + +WARN_LOGFILE = doxygen.log + +#--------------------------------------------------------------------------- +# Configuration options related to the input files +#--------------------------------------------------------------------------- + +# The INPUT tag is used to specify the files and/or directories that contain +# documented source files. You may enter file names like myfile.cpp or +# directories like /usr/src/myproject. Separate the files or directories with +# spaces. +# Note: If this tag is empty the current directory is searched. + +INPUT = ../src \ + ../config_src/solo_driver \ + ../config_src/mct_driver \ + ../config_src/nuopc_driver \ + +# This tag can be used to specify the character encoding of the source files +# that doxygen parses. Internally doxygen uses the UTF-8 encoding. Doxygen uses +# libiconv (or the iconv built into libc) for the transcoding. See the libiconv +# documentation (see: http://www.gnu.org/software/libiconv) for the list of +# possible encodings. +# The default value is: UTF-8. + +INPUT_ENCODING = UTF-8 + +# If the value of the INPUT tag contains directories, you can use the +# FILE_PATTERNS tag to specify one or more wildcard patterns (like *.cpp and +# *.h) to filter out the source-files in the directories. +# +# Note that for custom extensions or not directly supported extensions you also +# need to set EXTENSION_MAPPING for the extension otherwise the files are not +# read by doxygen. +# +# If left blank the following patterns are tested:*.c, *.cc, *.cxx, *.cpp, +# *.c++, *.java, *.ii, *.ixx, *.ipp, *.i++, *.inl, *.idl, *.ddl, *.odl, *.h, +# *.hh, *.hxx, *.hpp, *.h++, *.cs, *.d, *.php, *.php4, *.php5, *.phtml, *.inc, +# *.m, *.markdown, *.md, *.mm, *.dox, *.py, *.pyw, *.f90, *.f, *.for, *.tcl, +# *.vhd, *.vhdl, *.ucf and *.qsf. + +FILE_PATTERNS = *.c \ + *.cc \ + *.cxx \ + *.cpp \ + *.c++ \ + *.h \ + *.hh \ + *.hxx \ + *.hpp \ + *.h++ \ + *.inc \ + *.m \ + *.markdown \ + *.md \ + *.mm \ + *.dox \ + *.f90 \ + *.f \ + *.for \ + *.F90 + +# The RECURSIVE tag can be used to specify whether or not subdirectories should +# be searched for input files as well. +# The default value is: NO. + +RECURSIVE = YES + +# The EXCLUDE tag can be used to specify files and/or directories that should be +# excluded from the INPUT source files. This way you can easily exclude a +# subdirectory from a directory tree whose root is specified with the INPUT tag. +# +# Note that relative paths are relative to the directory from which doxygen is +# run. + +EXCLUDE = ../src/equation_of_state/TEOS10 + +# The EXCLUDE_SYMLINKS tag can be used to select whether or not files or +# directories that are symbolic links (a Unix file system feature) are excluded +# from the input. +# The default value is: NO. + +EXCLUDE_SYMLINKS = NO + +# If the value of the INPUT tag contains directories, you can use the +# EXCLUDE_PATTERNS tag to specify one or more wildcard patterns to exclude +# certain files from those directories. +# +# Note that the wildcards are matched against the file with absolute path, so to +# exclude all test directories for example use the pattern */test/* + +EXCLUDE_PATTERNS = makedep.py Makefile INSTALL + +# The EXCLUDE_SYMBOLS tag can be used to specify one or more symbol names +# (namespaces, classes, functions, etc.) that should be excluded from the +# output. The symbol name can be a fully qualified name, a word, or if the +# wildcard * is used, a substring. Examples: ANamespace, AClass, +# AClass::ANamespace, ANamespace::*Test +# +# Note that the wildcards are matched against the file with absolute path, so to +# exclude all test directories use the pattern */test/* + +EXCLUDE_SYMBOLS = + +# The EXAMPLE_PATH tag can be used to specify one or more files or directories +# that contain example code fragments that are included (see the \include +# command). + +EXAMPLE_PATH = ../src + +# If the value of the EXAMPLE_PATH tag contains directories, you can use the +# EXAMPLE_PATTERNS tag to specify one or more wildcard pattern (like *.cpp and +# *.h) to filter out the source-files in the directories. If left blank all +# files are included. + +EXAMPLE_PATTERNS = * + +# If the EXAMPLE_RECURSIVE tag is set to YES then subdirectories will be +# searched for input files to be used with the \include or \dontinclude commands +# irrespective of the value of the RECURSIVE tag. +# The default value is: NO. + +EXAMPLE_RECURSIVE = NO + +# The IMAGE_PATH tag can be used to specify one or more files or directories +# that contain images that are to be included in the documentation (see the +# \image command). + +IMAGE_PATH = images ../src + +# The INPUT_FILTER tag can be used to specify a program that doxygen should +# invoke to filter for each input file. Doxygen will invoke the filter program +# by executing (via popen()) the command: +# +# +# +# where is the value of the INPUT_FILTER tag, and is the +# name of an input file. Doxygen will then use the output that the filter +# program writes to standard output. If FILTER_PATTERNS is specified, this tag +# will be ignored. +# +# Note that the filter must not add or remove lines; it is applied before the +# code is scanned, but not when the output code is generated. If lines are added +# or removed, the anchors will not be placed correctly. +# +# Note that for custom extensions or not directly supported extensions you also +# need to set EXTENSION_MAPPING for the extension otherwise the files are not +# properly processed by doxygen. + +INPUT_FILTER = + +# The FILTER_PATTERNS tag can be used to specify filters on a per file pattern +# basis. Doxygen will compare the file name with each pattern and apply the +# filter if there is a match. The filters are a list of the form: pattern=filter +# (like *.cpp=my_cpp_filter). See INPUT_FILTER for further information on how +# filters are used. If the FILTER_PATTERNS tag is empty or if none of the +# patterns match the file name, INPUT_FILTER is applied. +# +# Note that for custom extensions or not directly supported extensions you also +# need to set EXTENSION_MAPPING for the extension otherwise the files are not +# properly processed by doxygen. + +FILTER_PATTERNS = + +# If the FILTER_SOURCE_FILES tag is set to YES, the input filter (if set using +# INPUT_FILTER) will also be used to filter the input files that are used for +# producing the source files to browse (i.e. when SOURCE_BROWSER is set to YES). +# The default value is: NO. + +FILTER_SOURCE_FILES = NO + +# The FILTER_SOURCE_PATTERNS tag can be used to specify source filters per file +# pattern. A pattern will override the setting for FILTER_PATTERN (if any) and +# it is also possible to disable source filtering for a specific pattern using +# *.ext= (so without naming a filter). +# This tag requires that the tag FILTER_SOURCE_FILES is set to YES. + +FILTER_SOURCE_PATTERNS = + +# If the USE_MDFILE_AS_MAINPAGE tag refers to the name of a markdown file that +# is part of the input, its contents will be placed on the main page +# (index.html). This can be useful if you have a project on for instance GitHub +# and want to reuse the introduction page also for the doxygen output. + +USE_MDFILE_AS_MAINPAGE = ../README.md + +#--------------------------------------------------------------------------- +# Configuration options related to source browsing +#--------------------------------------------------------------------------- + +# If the SOURCE_BROWSER tag is set to YES then a list of source files will be +# generated. Documented entities will be cross-referenced with these sources. +# +# Note: To get rid of all source code in the generated output, make sure that +# also VERBATIM_HEADERS is set to NO. +# The default value is: NO. + +SOURCE_BROWSER = YES + +# Setting the INLINE_SOURCES tag to YES will include the body of functions, +# classes and enums directly into the documentation. +# The default value is: NO. + +INLINE_SOURCES = YES + +# Setting the STRIP_CODE_COMMENTS tag to YES will instruct doxygen to hide any +# special comment blocks from generated source code fragments. Normal C, C++ and +# Fortran comments will always remain visible. +# The default value is: YES. + +STRIP_CODE_COMMENTS = NO + +# If the REFERENCED_BY_RELATION tag is set to YES then for each documented +# function all documented functions referencing it will be listed. +# The default value is: NO. + +REFERENCED_BY_RELATION = YES + +# If the REFERENCES_RELATION tag is set to YES then for each documented function +# all documented entities called/used by that function will be listed. +# The default value is: NO. + +REFERENCES_RELATION = YES + +# If the REFERENCES_LINK_SOURCE tag is set to YES and SOURCE_BROWSER tag is set +# to YES then the hyperlinks from functions in REFERENCES_RELATION and +# REFERENCED_BY_RELATION lists will link to the source code. Otherwise they will +# link to the documentation. +# The default value is: YES. + +REFERENCES_LINK_SOURCE = NO + +# If SOURCE_TOOLTIPS is enabled (the default) then hovering a hyperlink in the +# source code will show a tooltip with additional information such as prototype, +# brief description and links to the definition and documentation. Since this +# will make the HTML file larger and loading of large files a bit slower, you +# can opt to disable this feature. +# The default value is: YES. +# This tag requires that the tag SOURCE_BROWSER is set to YES. + +SOURCE_TOOLTIPS = YES + +# If the USE_HTAGS tag is set to YES then the references to source code will +# point to the HTML generated by the htags(1) tool instead of doxygen built-in +# source browser. The htags tool is part of GNU's global source tagging system +# (see http://www.gnu.org/software/global/global.html). You will need version +# 4.8.6 or higher. +# +# To use it do the following: +# - Install the latest version of global +# - Enable SOURCE_BROWSER and USE_HTAGS in the config file +# - Make sure the INPUT points to the root of the source tree +# - Run doxygen as normal +# +# Doxygen will invoke htags (and that will in turn invoke gtags), so these +# tools must be available from the command line (i.e. in the search path). +# +# The result: instead of the source browser generated by doxygen, the links to +# source code will now point to the output of htags. +# The default value is: NO. +# This tag requires that the tag SOURCE_BROWSER is set to YES. + +USE_HTAGS = NO + +# If the VERBATIM_HEADERS tag is set the YES then doxygen will generate a +# verbatim copy of the header file for each class for which an include is +# specified. Set to NO to disable this. +# See also: Section \class. +# The default value is: YES. + +VERBATIM_HEADERS = YES + +#--------------------------------------------------------------------------- +# Configuration options related to the alphabetical class index +#--------------------------------------------------------------------------- + +# If the ALPHABETICAL_INDEX tag is set to YES, an alphabetical index of all +# compounds will be generated. Enable this if the project contains a lot of +# classes, structs, unions or interfaces. +# The default value is: YES. + +ALPHABETICAL_INDEX = YES + +# The COLS_IN_ALPHA_INDEX tag can be used to specify the number of columns in +# which the alphabetical index list will be split. +# Minimum value: 1, maximum value: 20, default value: 5. +# This tag requires that the tag ALPHABETICAL_INDEX is set to YES. + +COLS_IN_ALPHA_INDEX = 1 + +# In case all classes in a project start with a common prefix, all classes will +# be put under the same header in the alphabetical index. The IGNORE_PREFIX tag +# can be used to specify a prefix (or a list of prefixes) that should be ignored +# while generating the index headers. +# This tag requires that the tag ALPHABETICAL_INDEX is set to YES. + +IGNORE_PREFIX = + +#--------------------------------------------------------------------------- +# Configuration options related to the HTML output +#--------------------------------------------------------------------------- + +# If the GENERATE_HTML tag is set to YES, doxygen will generate HTML output +# The default value is: YES. + +GENERATE_HTML = NO + +# The HTML_OUTPUT tag is used to specify where the HTML docs will be put. If a +# relative path is entered the value of OUTPUT_DIRECTORY will be put in front of +# it. +# The default directory is: html. +# This tag requires that the tag GENERATE_HTML is set to YES. + +HTML_OUTPUT = APIs + +# The HTML_FILE_EXTENSION tag can be used to specify the file extension for each +# generated HTML page (for example: .htm, .php, .asp). +# The default value is: .html. +# This tag requires that the tag GENERATE_HTML is set to YES. + +HTML_FILE_EXTENSION = .html + +# The HTML_HEADER tag can be used to specify a user-defined HTML header file for +# each generated HTML page. If the tag is left blank doxygen will generate a +# standard header. +# +# To get valid HTML the header file that includes any scripts and style sheets +# that doxygen needs, which is dependent on the configuration options used (e.g. +# the setting GENERATE_TREEVIEW). It is highly recommended to start with a +# default header using +# doxygen -w html new_header.html new_footer.html new_stylesheet.css +# YourConfigFile +# and then modify the file new_header.html. See also section "Doxygen usage" +# for information on how to generate the default header that doxygen normally +# uses. +# Note: The header is subject to change so you typically have to regenerate the +# default header when upgrading to a newer version of doxygen. For a description +# of the possible markers and block names see the documentation. +# This tag requires that the tag GENERATE_HTML is set to YES. + +HTML_HEADER = dox_rtd_header.html + +# The HTML_FOOTER tag can be used to specify a user-defined HTML footer for each +# generated HTML page. If the tag is left blank doxygen will generate a standard +# footer. See HTML_HEADER for more information on how to generate a default +# footer and what special commands can be used inside the footer. See also +# section "Doxygen usage" for information on how to generate the default footer +# that doxygen normally uses. +# This tag requires that the tag GENERATE_HTML is set to YES. + +HTML_FOOTER = dox_rtd_footer.html + +# The HTML_STYLESHEET tag can be used to specify a user-defined cascading style +# sheet that is used by each HTML page. It can be used to fine-tune the look of +# the HTML output. If left blank doxygen will generate a default style sheet. +# See also section "Doxygen usage" for information on how to generate the style +# sheet that doxygen normally uses. +# Note: It is recommended to use HTML_EXTRA_STYLESHEET instead of this tag, as +# it is more robust and this tag (HTML_STYLESHEET) will in the future become +# obsolete. +# This tag requires that the tag GENERATE_HTML is set to YES. + +HTML_STYLESHEET = + +# The HTML_EXTRA_STYLESHEET tag can be used to specify additional user-defined +# cascading style sheets that are included after the standard style sheets +# created by doxygen. Using this option one can overrule certain style aspects. +# This is preferred over using HTML_STYLESHEET since it does not replace the +# standard style sheet and is therefore more robust against future updates. +# Doxygen will copy the style sheet files to the output directory. +# Note: The order of the extra style sheet files is of importance (e.g. the last +# style sheet in the list overrules the setting of the previous ones in the +# list). For an example see the documentation. +# This tag requires that the tag GENERATE_HTML is set to YES. + +HTML_EXTRA_STYLESHEET = + +# The HTML_EXTRA_FILES tag can be used to specify one or more extra images or +# other source files which should be copied to the HTML output directory. Note +# that these files will be copied to the base HTML output directory. Use the +# $relpath^ marker in the HTML_HEADER and/or HTML_FOOTER files to load these +# files. In the HTML_STYLESHEET file, use the file name only. Also note that the +# files will be copied as-is; there are no commands or markers available. +# This tag requires that the tag GENERATE_HTML is set to YES. + +HTML_EXTRA_FILES = + +# The HTML_COLORSTYLE_HUE tag controls the color of the HTML output. Doxygen +# will adjust the colors in the style sheet and background images according to +# this color. Hue is specified as an angle on a colorwheel, see +# http://en.wikipedia.org/wiki/Hue for more information. For instance the value +# 0 represents red, 60 is yellow, 120 is green, 180 is cyan, 240 is blue, 300 +# purple, and 360 is red again. +# Minimum value: 0, maximum value: 359, default value: 220. +# This tag requires that the tag GENERATE_HTML is set to YES. + +HTML_COLORSTYLE_HUE = 220 + +# The HTML_COLORSTYLE_SAT tag controls the purity (or saturation) of the colors +# in the HTML output. For a value of 0 the output will use grayscales only. A +# value of 255 will produce the most vivid colors. +# Minimum value: 0, maximum value: 255, default value: 100. +# This tag requires that the tag GENERATE_HTML is set to YES. + +HTML_COLORSTYLE_SAT = 100 + +# The HTML_COLORSTYLE_GAMMA tag controls the gamma correction applied to the +# luminance component of the colors in the HTML output. Values below 100 +# gradually make the output lighter, whereas values above 100 make the output +# darker. The value divided by 100 is the actual gamma applied, so 80 represents +# a gamma of 0.8, The value 220 represents a gamma of 2.2, and 100 does not +# change the gamma. +# Minimum value: 40, maximum value: 240, default value: 80. +# This tag requires that the tag GENERATE_HTML is set to YES. + +HTML_COLORSTYLE_GAMMA = 80 + +# If the HTML_TIMESTAMP tag is set to YES then the footer of each generated HTML +# page will contain the date and time when the page was generated. Setting this +# to YES can help to show when doxygen was last run and thus if the +# to NO can help when comparing the output of multiple runs. +# The default value is: YES. +# This tag requires that the tag GENERATE_HTML is set to YES. + +HTML_TIMESTAMP = NO + +# If the HTML_DYNAMIC_SECTIONS tag is set to YES then the generated HTML +# documentation will contain sections that can be hidden and shown after the +# page has loaded. +# The default value is: NO. +# This tag requires that the tag GENERATE_HTML is set to YES. + +HTML_DYNAMIC_SECTIONS = NO + +# With HTML_INDEX_NUM_ENTRIES one can control the preferred number of entries +# shown in the various tree structured indices initially; the user can expand +# and collapse entries dynamically later on. Doxygen will expand the tree to +# such a level that at most the specified number of entries are visible (unless +# a fully collapsed tree already exceeds this amount). So setting the number of +# entries 1 will produce a full collapsed tree by default. 0 is a special value +# representing an infinite number of entries and will result in a full expanded +# tree by default. +# Minimum value: 0, maximum value: 9999, default value: 100. +# This tag requires that the tag GENERATE_HTML is set to YES. + +HTML_INDEX_NUM_ENTRIES = 900 + +# If the GENERATE_DOCSET tag is set to YES, additional index files will be +# generated that can be used as input for Apple's Xcode 3 integrated development +# environment (see: http://developer.apple.com/tools/xcode/), introduced with +# OSX 10.5 (Leopard). To create a documentation set, doxygen will generate a +# Makefile in the HTML output directory. Running make will produce the docset in +# that directory and running make install will install the docset in +# ~/Library/Developer/Shared/Documentation/DocSets so that Xcode will find it at +# startup. See http://developer.apple.com/tools/creatingdocsetswithdoxygen.html +# for more information. +# The default value is: NO. +# This tag requires that the tag GENERATE_HTML is set to YES. + +GENERATE_DOCSET = NO + +# This tag determines the name of the docset feed. A documentation feed provides +# an umbrella under which multiple documentation sets from a single provider +# (such as a company or product suite) can be grouped. +# The default value is: Doxygen generated docs. +# This tag requires that the tag GENERATE_DOCSET is set to YES. + +DOCSET_FEEDNAME = "Doxygen generated docs" + +# This tag specifies a string that should uniquely identify the documentation +# set bundle. This should be a reverse domain-name style string, e.g. +# com.mycompany.MyDocSet. Doxygen will append .docset to the name. +# The default value is: org.doxygen.Project. +# This tag requires that the tag GENERATE_DOCSET is set to YES. + +DOCSET_BUNDLE_ID = org.doxygen.Project + +# The DOCSET_PUBLISHER_ID tag specifies a string that should uniquely identify +# the documentation publisher. This should be a reverse domain-name style +# string, e.g. com.mycompany.MyDocSet.documentation. +# The default value is: org.doxygen.Publisher. +# This tag requires that the tag GENERATE_DOCSET is set to YES. + +DOCSET_PUBLISHER_ID = org.doxygen.Publisher + +# The DOCSET_PUBLISHER_NAME tag identifies the documentation publisher. +# The default value is: Publisher. +# This tag requires that the tag GENERATE_DOCSET is set to YES. + +DOCSET_PUBLISHER_NAME = Publisher + +# If the GENERATE_HTMLHELP tag is set to YES then doxygen generates three +# additional HTML index files: index.hhp, index.hhc, and index.hhk. The +# index.hhp is a project file that can be read by Microsoft's HTML Help Workshop +# (see: http://www.microsoft.com/en-us/download/details.aspx?id=21138) on +# Windows. +# +# The HTML Help Workshop contains a compiler that can convert all HTML output +# generated by doxygen into a single compiled HTML file (.chm). Compiled HTML +# files are now used as the Windows 98 help format, and will replace the old +# Windows help format (.hlp) on all Windows platforms in the future. Compressed +# HTML files also contain an index, a table of contents, and you can search for +# words in the documentation. The HTML workshop also contains a viewer for +# compressed HTML files. +# The default value is: NO. +# This tag requires that the tag GENERATE_HTML is set to YES. + +GENERATE_HTMLHELP = NO + +# The CHM_FILE tag can be used to specify the file name of the resulting .chm +# file. You can add a path in front of the file if the result should not be +# written to the html output directory. +# This tag requires that the tag GENERATE_HTMLHELP is set to YES. + +CHM_FILE = + +# The HHC_LOCATION tag can be used to specify the location (absolute path +# including file name) of the HTML help compiler (hhc.exe). If non-empty, +# doxygen will try to run the HTML help compiler on the generated index.hhp. +# The file has to be specified with full path. +# This tag requires that the tag GENERATE_HTMLHELP is set to YES. + +HHC_LOCATION = + +# The GENERATE_CHI flag controls if a separate .chi index file is generated +# (YES) or that it should be included in the master .chm file (NO). +# The default value is: NO. +# This tag requires that the tag GENERATE_HTMLHELP is set to YES. + +GENERATE_CHI = NO + +# The CHM_INDEX_ENCODING is used to encode HtmlHelp index (hhk), content (hhc) +# and project file content. +# This tag requires that the tag GENERATE_HTMLHELP is set to YES. + +CHM_INDEX_ENCODING = + +# The BINARY_TOC flag controls whether a binary table of contents is generated +# (YES) or a normal table of contents (NO) in the .chm file. Furthermore it +# enables the Previous and Next buttons. +# The default value is: NO. +# This tag requires that the tag GENERATE_HTMLHELP is set to YES. + +BINARY_TOC = NO + +# The TOC_EXPAND flag can be set to YES to add extra items for group members to +# the table of contents of the HTML help documentation and to the tree view. +# The default value is: NO. +# This tag requires that the tag GENERATE_HTMLHELP is set to YES. + +TOC_EXPAND = NO + +# If the GENERATE_QHP tag is set to YES and both QHP_NAMESPACE and +# QHP_VIRTUAL_FOLDER are set, an additional index file will be generated that +# can be used as input for Qt's qhelpgenerator to generate a Qt Compressed Help +# (.qch) of the generated HTML documentation. +# The default value is: NO. +# This tag requires that the tag GENERATE_HTML is set to YES. + +GENERATE_QHP = NO + +# If the QHG_LOCATION tag is specified, the QCH_FILE tag can be used to specify +# the file name of the resulting .qch file. The path specified is relative to +# the HTML output folder. +# This tag requires that the tag GENERATE_QHP is set to YES. + +QCH_FILE = + +# The QHP_NAMESPACE tag specifies the namespace to use when generating Qt Help +# Project output. For more information please see Qt Help Project / Namespace +# (see: http://qt-project.org/doc/qt-4.8/qthelpproject.html#namespace). +# The default value is: org.doxygen.Project. +# This tag requires that the tag GENERATE_QHP is set to YES. + +QHP_NAMESPACE = org.doxygen.Project + +# The QHP_VIRTUAL_FOLDER tag specifies the namespace to use when generating Qt +# Help Project output. For more information please see Qt Help Project / Virtual +# Folders (see: http://qt-project.org/doc/qt-4.8/qthelpproject.html#virtual- +# folders). +# The default value is: doc. +# This tag requires that the tag GENERATE_QHP is set to YES. + +QHP_VIRTUAL_FOLDER = doc + +# If the QHP_CUST_FILTER_NAME tag is set, it specifies the name of a custom +# filter to add. For more information please see Qt Help Project / Custom +# Filters (see: http://qt-project.org/doc/qt-4.8/qthelpproject.html#custom- +# filters). +# This tag requires that the tag GENERATE_QHP is set to YES. + +QHP_CUST_FILTER_NAME = + +# The QHP_CUST_FILTER_ATTRS tag specifies the list of the attributes of the +# custom filter to add. For more information please see Qt Help Project / Custom +# Filters (see: http://qt-project.org/doc/qt-4.8/qthelpproject.html#custom- +# filters). +# This tag requires that the tag GENERATE_QHP is set to YES. + +QHP_CUST_FILTER_ATTRS = + +# The QHP_SECT_FILTER_ATTRS tag specifies the list of the attributes this +# project's filter section matches. Qt Help Project / Filter Attributes (see: +# http://qt-project.org/doc/qt-4.8/qthelpproject.html#filter-attributes). +# This tag requires that the tag GENERATE_QHP is set to YES. + +QHP_SECT_FILTER_ATTRS = + +# The QHG_LOCATION tag can be used to specify the location of Qt's +# qhelpgenerator. If non-empty doxygen will try to run qhelpgenerator on the +# generated .qhp file. +# This tag requires that the tag GENERATE_QHP is set to YES. + +QHG_LOCATION = + +# If the GENERATE_ECLIPSEHELP tag is set to YES, additional index files will be +# generated, together with the HTML files, they form an Eclipse help plugin. To +# install this plugin and make it available under the help contents menu in +# Eclipse, the contents of the directory containing the HTML and XML files needs +# to be copied into the plugins directory of eclipse. The name of the directory +# within the plugins directory should be the same as the ECLIPSE_DOC_ID value. +# After copying Eclipse needs to be restarted before the help appears. +# The default value is: NO. +# This tag requires that the tag GENERATE_HTML is set to YES. + +GENERATE_ECLIPSEHELP = NO + +# A unique identifier for the Eclipse help plugin. When installing the plugin +# the directory name containing the HTML and XML files should also have this +# name. Each documentation set should have its own identifier. +# The default value is: org.doxygen.Project. +# This tag requires that the tag GENERATE_ECLIPSEHELP is set to YES. + +ECLIPSE_DOC_ID = org.doxygen.Project + +# If you want full control over the layout of the generated HTML pages it might +# be necessary to disable the index and replace it with your own. The +# DISABLE_INDEX tag can be used to turn on/off the condensed index (tabs) at top +# of each HTML page. A value of NO enables the index and the value YES disables +# it. Since the tabs in the index contain the same information as the navigation +# tree, you can set this option to YES if you also set GENERATE_TREEVIEW to YES. +# The default value is: NO. +# This tag requires that the tag GENERATE_HTML is set to YES. + +DISABLE_INDEX = YES + +# The GENERATE_TREEVIEW tag is used to specify whether a tree-like index +# structure should be generated to display hierarchical information. If the tag +# value is set to YES, a side panel will be generated containing a tree-like +# index structure (just like the one that is generated for HTML Help). For this +# to work a browser that supports JavaScript, DHTML, CSS and frames is required +# (i.e. any modern browser). Windows users are probably better off using the +# HTML help feature. Via custom style sheets (see HTML_EXTRA_STYLESHEET) one can +# further fine-tune the look of the index. As an example, the default style +# sheet generated by doxygen has an example that shows how to put an image at +# the root of the tree instead of the PROJECT_NAME. Since the tree basically has +# the same information as the tab index, you could consider setting +# DISABLE_INDEX to YES when enabling this option. +# The default value is: NO. +# This tag requires that the tag GENERATE_HTML is set to YES. + +GENERATE_TREEVIEW = NO + +# The ENUM_VALUES_PER_LINE tag can be used to set the number of enum values that +# doxygen will group on one line in the generated HTML documentation. +# +# Note that a value of 0 will completely suppress the enum values from appearing +# in the overview section. +# Minimum value: 0, maximum value: 20, default value: 4. +# This tag requires that the tag GENERATE_HTML is set to YES. + +ENUM_VALUES_PER_LINE = 4 + +# If the treeview is enabled (see GENERATE_TREEVIEW) then this tag can be used +# to set the initial width (in pixels) of the frame in which the tree is shown. +# Minimum value: 0, maximum value: 1500, default value: 250. +# This tag requires that the tag GENERATE_HTML is set to YES. + +TREEVIEW_WIDTH = 250 + +# If the EXT_LINKS_IN_WINDOW option is set to YES, doxygen will open links to +# external symbols imported via tag files in a separate window. +# The default value is: NO. +# This tag requires that the tag GENERATE_HTML is set to YES. + +EXT_LINKS_IN_WINDOW = YES + +# Use this tag to change the font size of LaTeX formulas included as images in +# the HTML documentation. When you change the font size after a successful +# doxygen run you need to manually remove any form_*.png images from the HTML +# output directory to force them to be regenerated. +# Minimum value: 8, maximum value: 50, default value: 10. +# This tag requires that the tag GENERATE_HTML is set to YES. + +FORMULA_FONTSIZE = 10 + +# Use the FORMULA_TRANPARENT tag to determine whether or not the images +# generated for formulas are transparent PNGs. Transparent PNGs are not +# supported properly for IE 6.0, but are supported on all modern browsers. +# +# Note that when changing this option you need to delete any form_*.png files in +# the HTML output directory before the changes have effect. +# The default value is: YES. +# This tag requires that the tag GENERATE_HTML is set to YES. + +FORMULA_TRANSPARENT = YES + +# Enable the USE_MATHJAX option to render LaTeX formulas using MathJax (see +# http://www.mathjax.org) which uses client side Javascript for the rendering +# instead of using pre-rendered bitmaps. Use this if you do not have LaTeX +# installed or if you want to formulas look prettier in the HTML output. When +# enabled you may also need to install MathJax separately and configure the path +# to it using the MATHJAX_RELPATH option. +# The default value is: NO. +# This tag requires that the tag GENERATE_HTML is set to YES. + +USE_MATHJAX = YES + +# When MathJax is enabled you can set the default output format to be used for +# the MathJax output. See the MathJax site (see: +# http://docs.mathjax.org/en/latest/output.html) for more details. +# Possible values are: HTML-CSS (which is slower, but has the best +# compatibility), NativeMML (i.e. MathML) and SVG. +# The default value is: HTML-CSS. +# This tag requires that the tag USE_MATHJAX is set to YES. + +MATHJAX_FORMAT = HTML-CSS + +# When MathJax is enabled you need to specify the location relative to the HTML +# output directory using the MATHJAX_RELPATH option. The destination directory +# should contain the MathJax.js script. For instance, if the mathjax directory +# is located at the same level as the HTML output directory, then +# MATHJAX_RELPATH should be ../mathjax. The default value points to the MathJax +# Content Delivery Network so you can quickly see the result without installing +# MathJax. However, it is strongly recommended to install a local copy of +# MathJax from http://www.mathjax.org before deployment. +# The default value is: http://cdn.mathjax.org/mathjax/latest. +# This tag requires that the tag USE_MATHJAX is set to YES. + +MATHJAX_RELPATH = http://cdn.mathjax.org/mathjax/latest + +# The MATHJAX_EXTENSIONS tag can be used to specify one or more MathJax +# extension names that should be enabled during MathJax rendering. For example +# MATHJAX_EXTENSIONS = TeX/AMSmath TeX/AMSsymbols +# This tag requires that the tag USE_MATHJAX is set to YES. + +MATHJAX_EXTENSIONS = + +# The MATHJAX_CODEFILE tag can be used to specify a file with javascript pieces +# of code that will be used on startup of the MathJax code. See the MathJax site +# (see: http://docs.mathjax.org/en/latest/output.html) for more details. For an +# example see the documentation. +# This tag requires that the tag USE_MATHJAX is set to YES. + +MATHJAX_CODEFILE = + +# When the SEARCHENGINE tag is enabled doxygen will generate a search box for +# the HTML output. The underlying search engine uses javascript and DHTML and +# should work on any modern browser. Note that when using HTML help +# (GENERATE_HTMLHELP), Qt help (GENERATE_QHP), or docsets (GENERATE_DOCSET) +# there is already a search function so this one should typically be disabled. +# For large projects the javascript based search engine can be slow, then +# enabling SERVER_BASED_SEARCH may provide a better solution. It is possible to +# search using the keyboard; to jump to the search box use + S +# (what the is depends on the OS and browser, but it is typically +# , /