From e39675a8d115fb0924e240ba9497673ce8c0a809 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Wed, 10 Jul 2019 18:52:11 -0400 Subject: [PATCH 01/32] (*)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 02/32] +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 03/32] +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 2426ab6d9c8061e2c3a9371d21fed34d84e7b170 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Thu, 11 Jul 2019 17:25:09 -0400 Subject: [PATCH 04/32] 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 05/32] +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 06/32] +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 07/32] +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 08/32] 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 09/32] 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 10/32] 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 11/32] +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 12/32] (+*)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 13/32] 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 14/32] +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 15/32] 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 16/32] (*)+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 17/32] +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 dd1484cbe72e66cdc7e73614bd1d06fd0b7c1879 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 16 Jul 2019 16:25:00 -0400 Subject: [PATCH 18/32] +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 19/32] +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 20/32] 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 21/32] 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 22/32] 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 ee369fb8eea472842de977bfc411472746645877 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Wed, 17 Jul 2019 11:24:23 -0400 Subject: [PATCH 23/32] +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 24/32] 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 25/32] 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 26/32] +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 27/32] (*) 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 28/32] 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 29/32] 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 30/32] 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 31/32] 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 32/32] 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, &