From 4622d6a0f9fb6f09ba859387a176ff5320054cee Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Wed, 1 Oct 2025 10:48:32 -0400 Subject: [PATCH 01/64] +*Fix 3-equation ice-ocean flux iteration (#972) Fix the 3-equation iteration for the buoyancy flux between the ocean and an overlying ice-shelf when ICE_SHELF_BUOYANCY_FLUX_ITT_BUGFIX is true and SHELF_3EQ_GAMMA it false. This code now uses proper bounding of the self-consistent solution, avoiding further amplifying the fluxes in the cases when the differences between the diffusivities of heat and salt to make the buoyancy flux destabilizing for finite turbulent mixing. Both the false-position iterations and the (appropriately chosen) Newton's method iterations have been extensively examined and determined to be working correctly via print statements that have subsequently been removed for efficiency. Previously, the code to determine the 3-equation solution for the buoyancy flux between the ocean and an ice shelf had been skipping iteration altogether or doing un-bounded Newton's method iterations with a sign error in part of the derivative, including taking the square root of negative numbers, leading to the issue described at https://github.com/NOAA-GFDL/MOM6/issues/945. That issue has now been corrected and can be closed once this commit has been merged into the dev/gfdl branch of MOM6. This commit also changes the names of the runtime parameters to correct the ice shelf flux iteration bugs from ICE_SHELF_BUOYANCY_FLUX_ITT_BUG and ICE_SHELF_SALT_FLUX_ITT_BUG to ICE_SHELF_BUOYANCY_FLUX_ITT_BUGFIX and ICE_SHELF_SALT_FLUX_ITT_BUGFIX to avoid confusion with other ..._BUG parameters where `true` is to turn the bugs on, whereas here `true` fixes them. The old names are retained via `old_name` arguments to the `get_param()` calls, so no existing configurations will be disrupted by these changes. Additionally, an expression to determine a scaling factor to limit ice-shelf bottom slopes in `calc_shelf_driving_stress()` was refactored to avoid the possibility of division by zero. This commit will change (and correct) answers for cases with ICE_SHELF_BUOYANCY_FLUX_ITT_BUGFIX set to true, but as these would often fail with a NaN from taking the square root of a negative value, it is very unlikely that any such configurations are actively being used, and there seems little point in retaining the previous answers. No answers are changed in cases that do not use an active ice shelf. Co-authored-by: Alistair Adcroft --- src/ice_shelf/MOM_ice_shelf.F90 | 274 +++++++++++++++-------- src/ice_shelf/MOM_ice_shelf_dynamics.F90 | 2 +- 2 files changed, 186 insertions(+), 90 deletions(-) diff --git a/src/ice_shelf/MOM_ice_shelf.F90 b/src/ice_shelf/MOM_ice_shelf.F90 index 2def8097ea..8ea1ec3d16 100644 --- a/src/ice_shelf/MOM_ice_shelf.F90 +++ b/src/ice_shelf/MOM_ice_shelf.F90 @@ -126,9 +126,9 @@ module MOM_ice_shelf real :: kd_molec_salt!< The molecular diffusivity of salt [Z2 T-1 ~> m2 s-1]. real :: kd_molec_temp!< The molecular diffusivity of heat [Z2 T-1 ~> m2 s-1]. real :: Lat_fusion !< The latent heat of fusion [Q ~> J kg-1]. - real :: Gamma_T_3EQ !< Nondimensional heat-transfer coefficient, used in the 3Eq. formulation - real :: Gamma_S_3EQ !< Nondimensional salt-transfer coefficient, used in the 3Eq. formulation - !< This number should be specified by the user. + real :: Gamma_T_3EQ !< Nondimensional heat-transfer coefficient, used in the 3Eq. formulation [nondim] + real :: Gamma_S_3EQ !< Nondimensional salt-transfer coefficient, used in the 3Eq. formulation [nondim] + !< This number should be specified by the user. real :: col_mass_melt_threshold !< An ocean column mass below the iceshelf below which melting !! does not occur [R Z ~> kg m-2] logical :: mass_from_file !< Read the ice shelf mass from a file every dt @@ -194,12 +194,12 @@ module MOM_ice_shelf real :: dTFr_dp !< Partial derivative of freezing temperature with !! pressure [C T2 R-1 L-2 ~> degC Pa-1] real :: Zeta_N !< The stability constant xi_N = 0.052 from Holland & Jenkins '99 - !! divided by the von Karman constant VK. Was 1/8. - real :: Vk !< Von Karman's constant - dimensionless - real :: Rc !< critical flux Richardson number. - logical :: buoy_flux_itt_bug !< If true, fixes buoyancy iteration bug - logical :: salt_flux_itt_bug !< If true, fixes salt iteration bug - real :: buoy_flux_itt_threshold !< Buoyancy iteration threshold for convergence + !! divided by the von Karman constant VK [nondim]. Was 1/8. + real :: Vk !< Von Karman's constant [nondim] + real :: Rc !< critical flux Richardson number [nondim] + logical :: buoy_flux_itt_bugfix !< If true, fixes buoyancy iteration bug + logical :: salt_flux_itt_bugfix !< If true, fixes salt iteration bug + real :: buoy_flux_tol !< Fractional buoyancy iteration tolerance for convergence [nondim] !>@{ Diagnostic handles integer :: id_melt = -1, id_exch_vel_s = -1, id_exch_vel_t = -1, & @@ -294,11 +294,11 @@ subroutine shelf_calc_flux(sfc_state_in, fluxes_in, Time, time_step_in, CS) !! This is computed as part of the ISOMIP diagnostics. real :: time_step !< Length of time over which these fluxes will be applied [T ~> s]. real :: Itime_step !< Inverse of the length of time over which these fluxes will be applied [T-1 ~> s-1] - real :: VK !< Von Karman's constant - dimensionless + real :: VK !< Von Karman's constant [nondim] real :: ZETA_N !< This is the stability constant xi_N = 0.052 from Holland & Jenkins '99 !! divided by the von Karman constant VK. Was 1/8. [nondim] - real :: RC !< critical flux Richardson number. - real :: I_ZETA_N !< The inverse of ZETA_N [nondim]. + real :: Rf_crit !< critical flux Richardson number [nondim] + real :: I_2Zeta_N !< Half the inverse of Zeta_N [nondim]. real :: I_LF !< The inverse of the latent heat of fusion [Q-1 ~> kg J-1]. real :: I_VK !< The inverse of the Von Karman constant [nondim]. real :: PR, SC !< The Prandtl number and Schmidt number [nondim]. @@ -318,7 +318,8 @@ subroutine shelf_calc_flux(sfc_state_in, fluxes_in, Time, time_step_in, CS) real :: wB_flux !< The downward vertical flux of buoyancy just inside the ocean [Z2 T-3 ~> m2 s-3]. real :: dB_dS !< The derivative of buoyancy with salinity [Z T-2 S-1 ~> m s-2 ppt-1]. real :: dB_dT !< The derivative of buoyancy with temperature [Z T-2 C-1 ~> m s-2 degC-1]. - real :: I_n_star ! [nondim] + real :: I_n_star ! The inverse of the ratio of working boundary layer thickness + ! to the neutral thickness [nondim] real :: n_star_term ! A term in the expression for nstar [T3 Z-2 ~> s3 m-2] real :: absf ! The absolute value of the Coriolis parameter [T-1 ~> s-1] real :: dIns_dwB !< The partial derivative of I_n_star with wB_flux, in [T3 Z-2 ~> s3 m-2] @@ -327,34 +328,42 @@ subroutine shelf_calc_flux(sfc_state_in, fluxes_in, Time, time_step_in, CS) real :: dS_ustar ! The difference between the salinity at the ice-ocean interface and the ocean ! boundary layer salinity times the friction velocity [S Z T-1 ~> ppt m s-1] real :: ustar_h ! The friction velocity in the water below the ice shelf [Z T-1 ~> m s-1] - real :: Gam_turb ! [nondim] + real :: Gam_turb ! A relative turbluent diffusivity [nondim] real :: Gam_mol_t, Gam_mol_s ! Relative coefficients of molecular diffusivities [nondim] real :: RhoCp ! A typical ocean density times the heat capacity of water [Q R C-1 ~> J m-3 degC-1] - real :: ln_neut + real :: ln_neut ! The log of the ratio of the neutral boundary layer thickness to the molecular + ! boundary layer thickness if it is greater than 1 or 0 otherwise [nondim] real :: mass_exch ! A mass exchange rate [R Z T-1 ~> kg m-2 s-1] real :: Sb_min, Sb_max ! Minimum and maximum boundary salinities [S ~> ppt] real :: dS_min, dS_max ! Minimum and maximum salinity changes [S ~> ppt] ! Variables used in iterating for wB_flux. - real :: wB_flux_new, dDwB_dwB_in - real :: I_Gam_T, I_Gam_S - real :: dG_dwB ! The derivative of Gam_turb with wB [T3 Z-2 ~> s3 m-2] + real :: wB_flux_next ! The next interation's guess for wB_flux [Z2 T-3 ~> m2 s-2] + real :: wB_flux_new ! An updated value of wB_flux when Gam_turb is based on wB_flux [Z2 T-3 ~> m2 s-2] + real :: wB_flux_max ! The upper bound on wB_flux [Z2 T-3 ~> m2 s-2] + real :: wB_flux_min ! The lower bound on wB_flux [Z2 T-3 ~> m2 s-2] + real :: dDwB_dwB ! The slope of the change in wB_flux between iterations with wB_flux [nondim] + real :: DwB_max ! The change in wB_flux when it is wB_flux_max [Z2 T-3 ~> m2 s-2] + real :: DwB_min ! The change in wB_flux when it is wB_flux_min [Z2 T-3 ~> m2 s-2] + real :: I_Gam_T, I_Gam_S ! Terms that vary inversely with Gam_mol_T or Gam_mol_S and Gam_turb [nondim] + real :: dG_dwB ! The derivative of Gam_turb with wB [T3 Z-2 ~> s3 m-2] real :: taux2, tauy2 ! The squared surface stresses [R2 L2 Z2 T-4 ~> Pa2]. real :: u2_av, v2_av ! The ice-area weighted average squared ocean velocities [L2 T-2 ~> m2 s-2] - real :: asu1, asu2 ! Ocean areas covered by ice shelves at neighboring u- - real :: asv1, asv2 ! and v-points [L2 ~> m2]. + real :: asu1, asu2 ! Ocean areas covered by ice shelves at neighboring u-points [L2 ~> m2] + real :: asv1, asv2 ! Ocean areas covered by ice shelves at neighboring v-points [L2 ~> m2] real :: I_au, I_av ! The Adcroft reciprocals of the ice shelf areas at adjacent points [L-2 ~> m-2] real :: Irho0 ! The inverse of the mean density times a unit conversion factor [R-1 L Z-1 ~> m3 kg-1] logical :: Sb_min_set, Sb_max_set + logical :: root_found logical :: update_ice_vel ! If true, it is time to update the ice shelf velocities. logical :: coupled_GL ! If true, the grounding line position is determined based on ! coupled ice-ocean dynamics. - real, parameter :: c2_3 = 2.0/3.0 - character(len=160) :: mesg ! The text of an error message + real, parameter :: c2_3 = 2.0/3.0 ! Two thirds [nondim] + character(len=320) :: mesg ! The text of an error message integer, dimension(2) :: EOSdom ! The i-computational domain for the equation of state integer :: i, j, is, ie, js, je, ied, jed, it1, it3 - real :: vaf0, vaf0_A, vaf0_G !The previous volumes above floatation [Z L2 ~> m3] - !for all ice sheets, Antarctica only, or Greenland only [Z L2 ~> m3] + real :: vaf0, vaf0_A, vaf0_G ! The previous volumes above floatation [Z L2 ~> m3] + ! for all ice sheets, Antarctica only, or Greenland only if (.not. associated(CS)) call MOM_error(FATAL, "shelf_calc_flux: "// & "initialize_ice_shelf must be called before shelf_calc_flux.") @@ -394,8 +403,8 @@ subroutine shelf_calc_flux(sfc_state_in, fluxes_in, Time, time_step_in, CS) ! useful parameters ZETA_N = CS%Zeta_N VK = CS%Vk - RC = CS%Rc - I_ZETA_N = 1.0 / ZETA_N + Rf_crit = CS%Rc + I_2Zeta_N = 0.5 / CS%Zeta_N I_LF = 1.0 / CS%Lat_fusion SC = CS%kv_molec/CS%kd_molec_salt PR = CS%kv_molec/CS%kd_molec_temp @@ -502,11 +511,12 @@ subroutine shelf_calc_flux(sfc_state_in, fluxes_in, Time, time_step_in, CS) if (absf*sfc_state%Hml(i,j) <= VK*ustar_h) then ; hBL_neut = sfc_state%Hml(i,j) else ; hBL_neut = (VK*ustar_h) / absf ; endif hBL_neut_h_molec = ZETA_N * ((hBL_neut * ustar_h) / (5.0 * CS%kv_molec)) + ln_neut = 0.0 ; if (hBL_neut_h_molec > 1.0) ln_neut = log(hBL_neut_h_molec) + n_star_term = (ZETA_N * hBL_neut * VK) / (Rf_crit * ustar_h**3) ! Determine the mixed layer buoyancy flux, wB_flux. dB_dS = (US%L_to_Z**2*CS%g_Earth / Rhoml(i)) * dR0_dS(i) dB_dT = (US%L_to_Z**2*CS%g_Earth / Rhoml(i)) * dR0_dT(i) - ln_neut = 0.0 ; if (hBL_neut_h_molec > 1.0) ln_neut = log(hBL_neut_h_molec) if (CS%find_salt_root) then ! Solve for the skin salinity using the linearized liquidus parameters and @@ -556,68 +566,152 @@ subroutine shelf_calc_flux(sfc_state_in, fluxes_in, Time, time_step_in, CS) dT_ustar = (ISS%tfreeze(i,j) - sfc_state%sst(i,j)) * ustar_h dS_ustar = (Sbdry(i,j) - sfc_state%sss(i,j)) * ustar_h - ! First, determine the buoyancy flux assuming no effects of stability - ! on the turbulence. Following H & J '99, this limit also applies - ! when the buoyancy flux is destabilizing. - - if (CS%const_gamma) then ! if using a constant gamma_T - ! note the different form, here I_Gam_T is NOT 1/Gam_T! + if (CS%const_gamma) then + ! If using a constant gamma_T, there are no effects of the buoyancy flux on the turbulence. I_Gam_T = CS%Gamma_T_3EQ I_Gam_S = CS%Gamma_S_3EQ - else - Gam_turb = I_VK * (ln_neut + (0.5 * I_ZETA_N - 1.0)) + wT_flux = dT_ustar * CS%Gamma_T_3EQ + wB_flux = dB_dS * (dS_ustar * CS%Gamma_S_3EQ) + dB_dT * wT_flux + elseif (.not.CS%buoy_flux_itt_bugfix) then + ! Gamma_T and gamma_S are a function of the buoyancy flux, and there should have been + ! iteration to find the root where wB_flux is consistent with the values of gamma with + ! that flux, but it was omitted. + Gam_turb = I_VK * (ln_neut + (I_2Zeta_N - 1.0)) I_Gam_T = 1.0 / (Gam_mol_t + Gam_turb) I_Gam_S = 1.0 / (Gam_mol_s + Gam_turb) - endif + wB_flux = dB_dS * (dS_ustar * I_Gam_S) + dB_dT * (dT_ustar * I_Gam_T) - wT_flux = dT_ustar * I_Gam_T - wB_flux = dB_dS * (dS_ustar * I_Gam_S) + dB_dT * wT_flux + if (wB_flux < 0.0) then ! The stabilising buoyancy flux reduces the turbulent fluxes. + I_n_star = sqrt(1.0 - n_star_term * wB_flux) + if (hBL_neut_h_molec > I_n_star**2) then + Gam_turb = I_VK * ((ln_neut - 2.0*log(I_n_star)) + (I_2Zeta_N*I_n_star - 1.0)) + else ! The layer dominated by molecular viscosity is smaller than the boundary layer. + Gam_turb = I_VK * (I_2Zeta_N*I_n_star - 1.0) + endif + I_Gam_T = 1.0 / (Gam_mol_t + Gam_turb) + I_Gam_S = 1.0 / (Gam_mol_s + Gam_turb) + endif + wT_flux = dT_ustar * I_Gam_T + else ! gamma_T and gamma_S are a function of the buoyancy flux with proper iteration. + ! Find the root where wB_flux is consistent with the values of gamma with that flux. + + ! First, determine the buoyancy flux assuming no effects of stability + ! on the turbulence. Following H & J '99, this limit also applies + ! when the buoyancy flux is destabilizing. + Gam_turb = I_VK * (ln_neut + (I_2Zeta_N - 1.0)) + I_Gam_T = 1.0 / (Gam_mol_t + Gam_turb) + I_Gam_S = 1.0 / (Gam_mol_s + Gam_turb) + wB_flux = (dB_dS * dS_ustar) * I_Gam_S + (dB_dT * dT_ustar) * I_Gam_T - if (wB_flux < 0.0) then - ! The buoyancy flux is stabilizing and will reduce the turbulent - ! fluxes, and iteration is required. - n_star_term = (ZETA_N * hBL_neut * VK) / (RC * ustar_h**3) - do it3 = 1,30 - ! n_star <= 1.0 is the ratio of working boundary layer thickness - ! to the neutral thickness. - ! hBL = n_star*hBL_neut ; hSub = 1/8*n_star*hBL + if (wB_flux < 0.0) then + ! The buoyancy flux is stabilizing and will reduce the turbulent + ! fluxes, and iteration is required. + ! n_star <= 1.0 is the ratio of working boundary layer thickness + ! to the neutral thickness. I_n_star is its inverse. I_n_star = sqrt(1.0 - n_star_term * wB_flux) - dIns_dwB = 0.5 * n_star_term / I_n_star if (hBL_neut_h_molec > I_n_star**2) then - Gam_turb = I_VK * ((ln_neut - 2.0*log(I_n_star)) + & - (0.5*I_ZETA_N*I_n_star - 1.0)) - dG_dwB = I_VK * ( -2.0 / I_n_star + (0.5 * I_ZETA_N)) * dIns_dwB - else - ! The layer dominated by molecular viscosity is smaller than - ! the assumed boundary layer. This should be rare! - Gam_turb = I_VK * (0.5 * I_ZETA_N*I_n_star - 1.0) - dG_dwB = I_VK * (0.5 * I_ZETA_N) * dIns_dwB + Gam_turb = I_VK * ((ln_neut - 2.0*log(I_n_star)) + (I_2Zeta_N*I_n_star - 1.0)) + else ! The layer dominated by molecular viscosity is smaller than the boundary layer. + Gam_turb = I_VK * (I_2Zeta_N*I_n_star - 1.0) endif - - if (CS%const_gamma) then ! if using a constant gamma_T - ! note the different form, here I_Gam_T is NOT 1/Gam_T! - I_Gam_T = CS%Gamma_T_3EQ - I_Gam_S = CS%Gamma_S_3EQ - else - I_Gam_T = 1.0 / (Gam_mol_t + Gam_turb) - I_Gam_S = 1.0 / (Gam_mol_s + Gam_turb) + I_Gam_T = 1.0 / (Gam_mol_t + Gam_turb) + I_Gam_S = 1.0 / (Gam_mol_s + Gam_turb) + + wB_flux_new = (dB_dS * dS_ustar) * I_Gam_S + (dB_dT * dT_ustar) * I_Gam_T + root_found = (abs(wB_flux_new - wB_flux) < CS%buoy_flux_tol*(abs(wB_flux_new) + abs(wB_flux))) + ! Do not update the flux if its maagnitude would be increased by the otherwise + ! stabilizing buoyancy fluxes. This can happen when the buoyancy flux + ! is stabilizing when one of the heat or salt fluxes are destabilizing due + ! to their different molecular properties. + if (wB_flux_new <= wB_flux) root_found = .true. + + if (.not.root_found) then + wB_flux_max = 0.0 ; DwB_max = wB_flux + wB_flux_min = wB_flux ; DwB_min = wB_flux_new - wB_flux + + if ((wB_flux_min*n_star_term < (1.0 - hBL_neut_h_molec)) .and. & + ((1.0 - hBL_neut_h_molec) < wB_flux_max*n_star_term)) then + ! The derivative of Gam_turb with wB_flux has a discontinuous change within the + ! bracketed range of values. Take this discontinous slope value for a first + ! guess, because Newton's method and the false position method may not converge + ! quickly when this discontinuity is between a guess and the solution. + wB_flux = (1.0 - hBL_neut_h_molec) / n_star_term + I_n_star = sqrt(hBL_neut_h_molec) + Gam_turb = I_VK * (I_2Zeta_N*I_n_star - 1.0) + I_Gam_T = 1.0 / (Gam_mol_t + Gam_turb) + I_Gam_S = 1.0 / (Gam_mol_s + Gam_turb) + wB_flux_new = (dB_dS * dS_ustar) * I_Gam_S + (dB_dT * dT_ustar) * I_Gam_T + + if (abs(wB_flux_new - wB_flux) <= CS%buoy_flux_tol*(abs(wB_flux_new) + abs(wB_flux))) then + ! The root has been found to within the tolerance at the kink. This should be very rare. + root_found = .true. + elseif (wB_flux_new > wB_flux) then + ! The solution is in the limit where abs(wB_flux) is small and + ! Gam_turb = I_VK * ((ln_neut - 2.0*log(I_n_star)) + (I_2Zeta_N*I_n_star - 1.0)) + wB_flux_min = wB_flux ; DwB_min = wB_flux_new - wB_flux + else + ! The solution is in the limt where abs(wB_flux) is large and + ! Gam_turb = I_VK * (I_2Zeta_N*I_n_star - 1.0) + wB_flux_max = wB_flux ; DwB_max = wB_flux_new - wB_flux + endif + endif endif - wT_flux = dT_ustar * I_Gam_T - wB_flux_new = dB_dS * (dS_ustar * I_Gam_S) + dB_dT * wT_flux - - ! Find the root where wB_flux_new = wB_flux. - if (abs(wB_flux_new - wB_flux) < CS%buoy_flux_itt_threshold*(abs(wB_flux_new) + abs(wB_flux))) exit + if (.not.root_found) then + ! Use the false position for the next guess. + wB_flux = wB_flux_min + (wB_flux_max-wB_flux_min) * (DwB_min / (DwB_min - DwB_max)) + + do it3 = 1,30 + ! Iterate using Newton's method with bounds or the false position method to find the root. + + I_n_star = sqrt(1.0 - n_star_term * wB_flux) + dIns_dwB = -0.5 * n_star_term / I_n_star + if (hBL_neut_h_molec > I_n_star**2) then + Gam_turb = I_VK * ((ln_neut - 2.0*log(I_n_star)) + (I_2Zeta_N*I_n_star - 1.0)) + dG_dwB = I_VK * (( -2.0 / I_n_star + I_2Zeta_N) * dIns_dwB) + else + ! The layer dominated by molecular viscosity is smaller than the boundary layer. + Gam_turb = I_VK * (I_2Zeta_N*I_n_star - 1.0) + dG_dwB = I_VK * (I_2Zeta_N * dIns_dwB) + endif + I_Gam_T = 1.0 / (Gam_mol_t + Gam_turb) + I_Gam_S = 1.0 / (Gam_mol_s + Gam_turb) + wB_flux_new = (dB_dS * dS_ustar) * I_Gam_S + (dB_dT * dT_ustar) * I_Gam_T + + ! Test for convergence to within tolerance at the point where wB_flux_new = wB_flux. + if (abs(wB_flux_new - wB_flux) <= CS%buoy_flux_tol*(abs(wB_flux_new) + abs(wB_flux))) & + root_found = .true. + if (root_found) exit + + dDwB_dwB = -dG_dwB * ((dB_dS * dS_ustar) * I_Gam_S**2 + & + (dB_dT * dT_ustar) * I_Gam_T**2) - 1.0 + if ((dDwB_dwB >= 0.0) .or. & + ( wB_flux - wB_flux_new >= abs(dDwB_dwB)*(wB_flux_max - wB_flux)) .or. & + ( wB_flux - wB_flux_new <= abs(dDwB_dwB)*(wB_flux_min - wB_flux)) ) then + ! Use the False position method to determine the guess for the next iteration when + ! Newton's method would go out of bounds + wB_flux_next = wB_flux_min + (wB_flux_max-wB_flux_min) * (DwB_min / (DwB_min - DwB_max)) + else + ! Use Newton's method for the next guess. + wB_flux_next = wB_flux - (wB_flux_new - wB_flux) / dDwB_dwB + endif + + ! Reset one of the bounds inward. + if (wB_flux_new - wB_flux > 0) then + wB_flux_min = wB_flux ; DwB_min = wB_flux_new - wB_flux + else + wB_flux_max = wB_flux ; DwB_max = wB_flux_new - wB_flux + endif + + ! Update wB_flux + wB_flux = wB_flux_next + enddo ! it3 + endif - dDwB_dwB_in = dG_dwB * (dB_dS * (dS_ustar * I_Gam_S**2) + & - dB_dT * (dT_ustar * I_Gam_T**2)) - 1.0 - ! This is Newton's method without any bounds. Should bounds be needed? - wB_flux_new = wB_flux - (wB_flux_new - wB_flux) / dDwB_dwB_in - ! Update wB_flux - if (CS%buoy_flux_itt_bug) wB_flux = wB_flux_new - enddo !it3 - endif + endif ! End of test for first guess of wB_flux < 0. + wT_flux = dT_ustar * I_Gam_T + endif ! End of test for CS%const_gamma ISS%tflux_ocn(i,j) = RhoCp * wT_flux exch_vel_t(i,j) = ustar_h * I_Gam_T @@ -688,7 +782,7 @@ subroutine shelf_calc_flux(sfc_state_in, fluxes_in, Time, time_step_in, CS) Sbdry(i,j) = Sbdry_it endif ! Sb_min_set - if (.not.CS%salt_flux_itt_bug) Sbdry(i,j) = Sbdry_it + if (.not.CS%salt_flux_itt_bugfix) Sbdry(i,j) = Sbdry_it endif ! CS%find_salt_root @@ -1138,7 +1232,7 @@ subroutine add_shelf_flux(G, US, CS, sfc_state, fluxes, time_step) type(ice_shelf_CS), pointer :: CS !< This module's control structure. type(surface), intent(inout) :: sfc_state !< Surface ocean state type(forcing), intent(inout) :: fluxes !< A structure of surface fluxes that may be used/updated. - real, intent(in) :: time_step !< Time step over which fluxes are applied + real, intent(in) :: time_step !< Time step over which fluxes are applied [T ~> s] ! local variables real :: frac_shelf !< The fractional area covered by the ice shelf [nondim]. real :: frac_open !< The fractional area of the ocean that is not covered by the ice shelf [nondim]. @@ -1377,10 +1471,12 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, Time_init, type(directories) :: dirs type(dyn_horgrid_type), pointer :: dG => NULL() type(dyn_horgrid_type), pointer :: dG_in => NULL() - real :: meltrate_conversion ! The conversion factor to use for in the melt rate diagnostic. + real :: meltrate_conversion ! The conversion factor to use for in the melt rate diagnostic + ! [T kg R-1 Z-1 m-2 s-1 ~> nondim] real :: dz_ocean_min_float ! The minimum ocean thickness above which the ice shelf is considered ! to be floating when CONST_SEA_LEVEL = True [Z ~> m]. - real :: cdrag, drag_bg_vel + real :: cdrag ! The drag coefficient at the ice-ocean interface [nondim] + real :: drag_bg_vel ! A background velocity used in the quadratic drag [Z T-1 ~> m s-1] logical :: new_sim, save_IC !This include declares and sets the variable "version". # include "version_variable.h" @@ -1396,7 +1492,7 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, Time_init, real :: utide ! A tidal velocity [L T-1 ~> m s-1] real :: col_thick_melt_thresh ! An ocean column thickness below which iceshelf melting ! does not occur [Z ~> m] - real, allocatable, dimension(:,:) :: tmp2d ! Temporary array for storing ice shelf input data + real, allocatable, dimension(:,:) :: tmp2d ! Temporary array for ice shelf input data [L T-1 ~> m s-1] type(surface), pointer :: sfc_state => NULL() type(vardesc) :: u_desc, v_desc @@ -1686,11 +1782,11 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, Time_init, call get_param(param_file, mdl, "ICE_SHELF_RC", CS%Rc, & "Critical flux Richardson number for ice melt ", & units="nondim", default=0.20) - call get_param(param_file, mdl, "ICE_SHELF_BUOYANCY_FLUX_ITT_BUG", CS%buoy_flux_itt_bug, & - "Bug fix of buoyancy iteration", default=.true.) - call get_param(param_file, mdl, "ICE_SHELF_SALT_FLUX_ITT_BUG", CS%salt_flux_itt_bug, & - "Bug fix of salt iteration", default=.true.) - call get_param(param_file, mdl, "ICE_SHELF_BUOYANCY_FLUX_ITT_THRESHOLD", CS%buoy_flux_itt_threshold, & + call get_param(param_file, mdl, "ICE_SHELF_BUOYANCY_FLUX_ITT_BUGFIX", CS%buoy_flux_itt_bugfix, & + "Bug fix of buoyancy iteration", default=.true., old_name="ICE_SHELF_BUOYANCY_FLUX_ITT_BUG") + call get_param(param_file, mdl, "ICE_SHELF_SALT_FLUX_ITT_BUGFIX", CS%salt_flux_itt_bugfix, & + "Bug fix of salt iteration", default=.true., old_name="ICE_SHELF_SALT_FLUX_ITT_BUG") + call get_param(param_file, mdl, "ICE_SHELF_BUOYANCY_FLUX_ITT_THRESHOLD", CS%buoy_flux_tol, & "Convergence criterion of Newton's method for ice shelf "//& "buoyancy iteration.", units="nondim", default=1.0e-4) @@ -2356,6 +2452,7 @@ subroutine initialize_shelf_mass(G, param_file, CS, ISS, new_sim) end select end subroutine initialize_shelf_mass + !> This subroutine applies net accumulation/ablation at the top surface to the dynamic ice shelf. !! acc_rate[m-s]=surf_mass_flux/density_ice is ablation/accumulation rate !! positive for accumulation negative for ablation @@ -2372,14 +2469,13 @@ subroutine change_thickness_using_precip(CS, ISS, G, US, fluxes, time_step, Time ! locals integer :: i, j - real ::I_rho_ice + real :: I_rho_ice ! The specific volume of ice [R-1 ~> m3 kg-1] I_rho_ice = 1.0 / CS%density_ice !update time ! CS%Time = Time - ! CS%time_step = time_step ! update surface mass flux rate ! if (CS%surf_mass_flux_from_file) call update_surf_mass_flux(G, US, CS, ISS, Time) @@ -2463,7 +2559,7 @@ subroutine ice_shelf_query(CS, G, frac_shelf_h, mass_shelf, data_override_shelf_ type(ice_shelf_CS), pointer :: CS !< ice shelf control structure type(ocean_grid_type), intent(in) :: G !< A pointer to an ocean grid control structure. real, optional, dimension(SZI_(G),SZJ_(G)), intent(out) :: frac_shelf_h !< Ice shelf area fraction [nondim]. - real, optional, dimension(SZI_(G),SZJ_(G)), intent(out) :: mass_shelf ! kg m-2] + real, optional, dimension(SZI_(G),SZJ_(G)), intent(out) :: mass_shelf !< Ice shelf mass [R Z ~> kg m-2] logical, optional :: data_override_shelf_fluxes !< If true, shelf fluxes can be written using !! the data_override capability (only for MOSAIC grids) diff --git a/src/ice_shelf/MOM_ice_shelf_dynamics.F90 b/src/ice_shelf/MOM_ice_shelf_dynamics.F90 index 5c9b0b306d..904624f924 100644 --- a/src/ice_shelf/MOM_ice_shelf_dynamics.F90 +++ b/src/ice_shelf/MOM_ice_shelf_dynamics.F90 @@ -2538,7 +2538,7 @@ subroutine calc_shelf_driving_stress(CS, ISS, G, US, taudx, taudy, OD) endif if (CS%max_surface_slope>0) then - scale = min(CS%max_surface_slope/sqrt((sx**2)+(sy**2)),1.0) + scale = CS%max_surface_slope / max( sqrt((sx**2) + (sy**2)), CS%max_surface_slope ) sx = scale*sx; sy = scale*sy endif From 8d7541644509d3ee7f8cc7a88983289918690a8f Mon Sep 17 00:00:00 2001 From: Kate Hedstrom Date: Fri, 10 Oct 2025 13:21:02 -0800 Subject: [PATCH 02/64] Fixes shelfwave failure in debug mode - rotated OBC%segment%num_fields needs to be set. --- src/core/MOM_open_boundary.F90 | 9 +++++++++ 1 file changed, 9 insertions(+) diff --git a/src/core/MOM_open_boundary.F90 b/src/core/MOM_open_boundary.F90 index ed12d03520..0ed4620647 100644 --- a/src/core/MOM_open_boundary.F90 +++ b/src/core/MOM_open_boundary.F90 @@ -6671,6 +6671,11 @@ subroutine rotate_OBC_segment_config(segment_in, G_in, segment, G, turns) ! These are conditionally set if Lscale_{in,out} are present segment%Tr_InvLscale_in = segment_in%Tr_InvLscale_in segment%Tr_InvLscale_out = segment_in%Tr_InvLscale_out + segment%Th_InvLscale_in = segment_in%Th_InvLscale_in + segment%Th_InvLscale_out = segment_in%Th_InvLscale_out + + ! This needs to be set + segment%num_fields = segment_in%num_fields end subroutine rotate_OBC_segment_config @@ -6982,6 +6987,10 @@ subroutine write_OBC_info(OBC, G, GV, US) call MOM_mesg(mesg, verb=1) write(mesg, '(" Tr_InvLscale_in ", ES16.6)') segment%Tr_InvLscale_in*US%m_to_L call MOM_mesg(mesg, verb=1) + write(mesg, '(" Th_InvLscale_out ", ES16.6)') segment%Th_InvLscale_out*US%m_to_L + call MOM_mesg(mesg, verb=1) + write(mesg, '(" Th_InvLscale_in ", ES16.6)') segment%Th_InvLscale_in*US%m_to_L + call MOM_mesg(mesg, verb=1) enddo From f2641348cdd470d9fbcb5d04519e6b50d20ef9e4 Mon Sep 17 00:00:00 2001 From: Kate Hedstrom Date: Fri, 24 Oct 2025 12:31:47 -0800 Subject: [PATCH 03/64] Make sure reversed segments get rotated. --- src/core/MOM_open_boundary.F90 | 1 + 1 file changed, 1 insertion(+) diff --git a/src/core/MOM_open_boundary.F90 b/src/core/MOM_open_boundary.F90 index 0ed4620647..2ebbce6475 100644 --- a/src/core/MOM_open_boundary.F90 +++ b/src/core/MOM_open_boundary.F90 @@ -6444,6 +6444,7 @@ subroutine rotate_OBC_config(OBC_in, G_in, OBC, G, turns) OBC%zero_biharmonic = OBC_in%zero_biharmonic OBC%silly_h = OBC_in%silly_h OBC%silly_u = OBC_in%silly_u + OBC%reverse_segment_order = OBC_in%reverse_segment_order ! Segment rotation allocate(OBC%segment(0:OBC%number_of_segments)) From 75fa2408dc36a5ccf32152696233fa7051f50c25 Mon Sep 17 00:00:00 2001 From: He Wang Date: Thu, 25 Sep 2025 22:05:23 -0400 Subject: [PATCH 04/64] Bugfix for default TIDES_ANSWER_DATE in SAL Fix a bug that the recently changed default answer date for TIDES_ANSWER_DATE is not properly applied to MOM_self_attr_load. TIDES_ANSWER_DATE is used in MOM_self_attr_load to check if SAL_USE_BPA is used after a timestamp, so its default should be consistent with MOM_PressureForce_FV. --- src/core/MOM_PressureForce_FV.F90 | 18 +++++++++--------- .../lateral/MOM_self_attr_load.F90 | 10 +++++++--- 2 files changed, 16 insertions(+), 12 deletions(-) diff --git a/src/core/MOM_PressureForce_FV.F90 b/src/core/MOM_PressureForce_FV.F90 index b727c30595..6acdddf0a1 100644 --- a/src/core/MOM_PressureForce_FV.F90 +++ b/src/core/MOM_PressureForce_FV.F90 @@ -2078,16 +2078,16 @@ subroutine PressureForce_FV_init(Time, G, GV, US, param_file, diag, CS, ADp, SAL "If true, apply tidal momentum forcing.", default=.false.) if (CS%tides) then call get_param(param_file, mdl, "DEFAULT_ANSWER_DATE", default_answer_date, & - "This sets the default value for the various _ANSWER_DATE parameters.", & - default=99991231) + "This sets the default value for the various _ANSWER_DATE parameters.", & + default=99991231) call get_param(param_file, mdl, "TIDES_ANSWER_DATE", CS%tides_answer_date, "The vintage of "//& - "self-attraction and loading (SAL) and tidal forcing calculations. Setting "//& - "dates before 20230701 recovers old answers (Boussinesq and non-Boussinesq "//& - "modes) when SAL is part of the tidal forcing calculation. The answer "//& - "difference is only at bit level and due to a reordered summation. Setting "//& - "dates before 20250201 recovers answers (Boussinesq mode) that interface "//& - "heights are modified before pressure force integrals are calculated.", & - default=default_answer_date, do_not_log=(.not.CS%tides)) + "self-attraction and loading (SAL) and tidal forcing calculations. Setting "//& + "dates before 20230701 recovers old answers (Boussinesq and non-Boussinesq "//& + "modes) when SAL is part of the tidal forcing calculation. The answer "//& + "difference is only at bit level and due to a reordered summation. Setting "//& + "dates before 20250201 recovers answers (Boussinesq mode) that interface "//& + "heights are modified before pressure force integrals are calculated.", & + default=default_answer_date, do_not_log=(.not.CS%tides)) endif call get_param(param_file, mdl, "CALCULATE_SAL", CS%calculate_SAL, & "If true, calculate self-attraction and loading.", default=CS%tides) diff --git a/src/parameterizations/lateral/MOM_self_attr_load.F90 b/src/parameterizations/lateral/MOM_self_attr_load.F90 index 045027f05c..bf3f0d50a2 100644 --- a/src/parameterizations/lateral/MOM_self_attr_load.F90 +++ b/src/parameterizations/lateral/MOM_self_attr_load.F90 @@ -205,7 +205,7 @@ subroutine SAL_init(h, tv, G, GV, US, param_file, CS, restart_CS) type(vardesc) :: vars(1) ! used to write ref_pbot file type(MOM_field) :: fields(1) ! used to write ref_pbot file logical :: calculate_sal, tides, use_tidal_sal_file - integer :: tides_answer_date ! Recover old answers with tides + integer :: default_answer_date, tides_answer_date ! Recover old answers with tides real :: sal_scalar_value ! Scaling SAL factors [nondim] integer :: isd, ied, jsd, jed @@ -267,8 +267,12 @@ subroutine SAL_init(h, tv, G, GV, US, param_file, CS, restart_CS) end select call pass_var(CS%pbot_ref, G%Domain) endif - call get_param(param_file, '', "TIDES_ANSWER_DATE", tides_answer_date, default=20230630, & - do_not_log=.True.) ! used to check SAL_USE_BPA + + call get_param(param_file, mdl, "DEFAULT_ANSWER_DATE", default_answer_date, & + "This sets the default value for the various _ANSWER_DATE parameters.", & + default=99991231, do_not_log=.True.) ! used to check SAL_USE_BPA + call get_param(param_file, '', "TIDES_ANSWER_DATE", tides_answer_date, & + default=default_answer_date, do_not_log=.True.) ! used to check SAL_USE_BPA if (tides_answer_date<=20250131 .and. CS%use_bpa) & call MOM_error(FATAL, trim(mdl) // ", SAL_init: SAL_USE_BPA needs to be false to recover "//& "tide answers before 20250131.") From 257650d3793444989397f3a9e27c9345c69ec3f4 Mon Sep 17 00:00:00 2001 From: Alistair Adcroft Date: Tue, 21 Oct 2025 11:20:50 -0400 Subject: [PATCH 05/64] Fixes a typo in Recon1d PPM limiter Thanks to both @alperaltuntas and @marshallward who noted that a PPM limiter has the expression `( u2 - u1 ) * ( u1 - u0 ) <- 0.0` which is interpreted as `( u2 - u1 ) * ( u1 - u0 ) < -0.0a. Needless to say, the intended code was `( u2 - u1 ) * ( u1 - u0 ) <= 0.0`. The same typo was copied to three files. The high-order estimate of edge value was previously bounded by (u2,u1) or (u1,u0). The missed conditions of either `( u2 - u1) == 0.` or `( u1 - u0 ) == 0.` would then have been caught by the subsequence test for an interior extrema. Thus, I think the cell was still limited to PCM appropriately. However, the typo obscured the intention of the limiter and I was lucky it still worked. --- src/ALE/Recon1d_PPM_CW.F90 | 2 +- src/ALE/Recon1d_PPM_CWK.F90 | 2 +- src/ALE/Recon1d_PPM_hybgen.F90 | 2 +- 3 files changed, 3 insertions(+), 3 deletions(-) diff --git a/src/ALE/Recon1d_PPM_CW.F90 b/src/ALE/Recon1d_PPM_CW.F90 index 9523ad46ea..7e25bc3d49 100644 --- a/src/ALE/Recon1d_PPM_CW.F90 +++ b/src/ALE/Recon1d_PPM_CW.F90 @@ -158,7 +158,7 @@ subroutine reconstruct(this, h, u) u2 = u(k+1) a6 = 3.0 * ( ( u1 - this%ul(k) ) + ( u1 - this%ur(k) ) ) du = this%ur(k) - this%ul(k) - if ( ( u2 - u1 ) * ( u1 - u0 ) <- 0.0 ) then ! Large scale extrema + if ( ( u2 - u1 ) * ( u1 - u0 ) <= 0.0 ) then ! Large scale extrema this%ul(k) = u1 this%ur(k) = u1 elseif ( du * a6 > du * du ) then ! Extrema on right diff --git a/src/ALE/Recon1d_PPM_CWK.F90 b/src/ALE/Recon1d_PPM_CWK.F90 index a0cbce5877..7e0d613e7a 100644 --- a/src/ALE/Recon1d_PPM_CWK.F90 +++ b/src/ALE/Recon1d_PPM_CWK.F90 @@ -143,7 +143,7 @@ subroutine reconstruct(this, h, u) u2 = u(k+1) a6 = 3.0 * ( ( u1 - this%ul(k) ) + ( u1 - this%ur(k) ) ) du = this%ur(k) - this%ul(k) - if ( ( u2 - u1 ) * ( u1 - u0 ) <- 0.0 ) then ! Large scale extrema + if ( ( u2 - u1 ) * ( u1 - u0 ) <= 0.0 ) then ! Large scale extrema this%ul(k) = u1 this%ur(k) = u1 elseif ( du * a6 > du * du ) then ! Extrema on right diff --git a/src/ALE/Recon1d_PPM_hybgen.F90 b/src/ALE/Recon1d_PPM_hybgen.F90 index 2978dd9269..058c0a80dc 100644 --- a/src/ALE/Recon1d_PPM_hybgen.F90 +++ b/src/ALE/Recon1d_PPM_hybgen.F90 @@ -134,7 +134,7 @@ subroutine reconstruct(this, h, u) a6 = 3.0 * ( ( u1 - this%ul(k) ) + ( u1 - this%ur(k) ) ) a6 = 6.0 * u1 - 3.0 * ( this%ul(k) + this%ur(k) ) du = this%ur(k) - this%ul(k) - if ( ( u2 - u1 ) * ( u1 - u0 ) <- 0.0 ) then ! Large scale extrema + if ( ( u2 - u1 ) * ( u1 - u0 ) <= 0.0 ) then ! Large scale extrema this%ul(k) = u1 this%ur(k) = u1 elseif ( du * a6 > du * du ) then ! Extrema on right From 5994b9a0cb96d1fa83012609005580a798bdf5aa Mon Sep 17 00:00:00 2001 From: William Xu Date: Wed, 8 Oct 2025 09:42:52 -0300 Subject: [PATCH 06/64] Frequency-dependent drag in tensor form This commit allows the frequency-dependent drag to be implemented in tensor form, by incorporating the off-diagonal components of the wave drag tensor into the MOM_wave_drag module. --- .../lateral/MOM_wave_drag.F90 | 75 +++++++++++++++---- 1 file changed, 60 insertions(+), 15 deletions(-) diff --git a/src/parameterizations/lateral/MOM_wave_drag.F90 b/src/parameterizations/lateral/MOM_wave_drag.F90 index a507c762c1..ed60066f0e 100644 --- a/src/parameterizations/lateral/MOM_wave_drag.F90 +++ b/src/parameterizations/lateral/MOM_wave_drag.F90 @@ -21,6 +21,10 @@ module MOM_wave_drag integer :: nf !< Number of filters to be used in the simulation real, allocatable, dimension(:,:,:) :: coef_u !< frequency-dependent drag coefficients [H T-1 ~> m s-1] real, allocatable, dimension(:,:,:) :: coef_v !< frequency-dependent drag coefficients [H T-1 ~> m s-1] + real, allocatable, dimension(:,:,:) :: coef_uv !< frequency-dependent drag coefficients [H T-1 ~> m s-1] + real, allocatable, dimension(:,:,:) :: coef_vu !< frequency-dependent drag coefficients [H T-1 ~> m s-1] + logical :: tensor_drag !< If true, include the off-diagonal components of the + !! wave drag tensor for computing the wave drag end type wave_drag_CS contains @@ -38,7 +42,7 @@ subroutine wave_drag_init(param_file, wave_drag_file, G, GV, US, CS) character(len=40) :: mdl = "MOM_wave_drag" !< This module's name character(len=50) :: filter_name_str !< List of drag coefficients to be used character(len=2), allocatable, dimension(:) :: filter_names !< Names of drag coefficients - character(len=80) :: var_names(2) !< Names of variables in wave_drag_file + character(len=80) :: var_names(4) !< Names of variables in wave_drag_file character(len=200) :: mesg real :: var_scale !< Scaling factors of drag coefficients [nondim] integer :: c @@ -53,8 +57,12 @@ subroutine wave_drag_init(param_file, wave_drag_file, G, GV, US, CS) allocate(CS%coef_u(G%IsdB:G%IedB,G%jsd:G%jed,CS%nf)) ; CS%coef_u(:,:,:) = 0.0 allocate(CS%coef_v(G%isd:G%ied,G%JsdB:G%JedB,CS%nf)) ; CS%coef_v(:,:,:) = 0.0 + allocate(CS%coef_uv(G%IsdB:G%IedB,G%jsd:G%jed,CS%nf)) ; CS%coef_uv(:,:,:) = 0.0 + allocate(CS%coef_vu(G%isd:G%ied,G%JsdB:G%JedB,CS%nf)) ; CS%coef_vu(:,:,:) = 0.0 allocate(filter_names(CS%nf)) ; read(filter_name_str, *) filter_names + CS%tensor_drag = .false. + if (len_trim(wave_drag_file) > 0) then do c=1,CS%nf call get_param(param_file, mdl, "BT_"//trim(filter_names(c))//"_DRAG_U", & @@ -65,11 +73,21 @@ subroutine wave_drag_init(param_file, wave_drag_file, G, GV, US, CS) var_names(2), "The name of the variable in BT_WAVE_DRAG_FILE "//& "for the drag coefficient of the "//trim(filter_names(c))//& " frequency at v points.", default="") + call get_param(param_file, mdl, "BT_"//trim(filter_names(c))//"_DRAG_UV", & + var_names(3), "The name of the variable in BT_WAVE_DRAG_FILE "//& + "for the drag coefficient of the "//trim(filter_names(c))//& + " frequency at u points, corresponding to the off-diagonal "//& + "component of the wave drag tensor.", default="") + call get_param(param_file, mdl, "BT_"//trim(filter_names(c))//"_DRAG_VU", & + var_names(4), "The name of the variable in BT_WAVE_DRAG_FILE "//& + "for the drag coefficient of the "//trim(filter_names(c))//& + " frequency at v points, corresponding to the off-diagonal "//& + "component of the wave drag tensor.", default="") call get_param(param_file, mdl, "BT_"//trim(filter_names(c))//"_DRAG_SCALE", & var_scale, "A scaling factor for the drag coefficient of the "//& trim(filter_names(c))//" frequency.", default=1.0, units="nondim") - if (len_trim(var_names(1))+len_trim(var_names(2))>0 .and. var_scale>0.0) then + if (len_trim(var_names(1))>0 .and. len_trim(var_names(2))>0 .and. var_scale>0.0) then call MOM_read_data(wave_drag_file, trim(var_names(1)), CS%coef_u(:,:,c), G%Domain, & position=EAST_FACE, scale=var_scale*GV%m_to_H*US%T_to_s) call MOM_read_data(wave_drag_file, trim(var_names(2)), CS%coef_v(:,:,c), G%Domain, & @@ -77,6 +95,17 @@ subroutine wave_drag_init(param_file, wave_drag_file, G, GV, US, CS) call pass_vector(CS%coef_u(:,:,c), CS%coef_v(:,:,c), G%domain, & direction=To_All+SCALAR_PAIR) + if (len_trim(var_names(3))>0 .and. len_trim(var_names(4))>0) then + CS%tensor_drag = .true. + + call MOM_read_data(wave_drag_file, trim(var_names(3)), CS%coef_uv(:,:,c), G%Domain, & + position=EAST_FACE, scale=var_scale*GV%m_to_H*US%T_to_s) + call MOM_read_data(wave_drag_file, trim(var_names(4)), CS%coef_vu(:,:,c), G%Domain, & + position=NORTH_FACE, scale=var_scale*GV%m_to_H*US%T_to_s) + call pass_vector(CS%coef_uv(:,:,c), CS%coef_vu(:,:,c), G%domain, & + direction=To_All+SCALAR_PAIR) + endif + write(mesg, *) "MOM_wave_drag: ", trim(filter_names(c)), & " coefficients read from file, scaling factor = ", var_scale call MOM_error(NOTE, trim(mesg)) @@ -101,27 +130,40 @@ subroutine wave_drag_calc(u, v, drag_u, drag_v, G, CS) !! and scaled frequency-dependent drag [L2 T-2 ~> m2 s-2] ! Local variables - integer :: is, ie, js, je, i, j, k + integer :: is, ie, js, je, i, j, c is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec - Drag_u(:,:) = 0.0 ; Drag_v(:,:) = 0.0 - - !$OMP do - do k=1,CS%nf ; do j=js,je ; do I=is-1,ie - Drag_u(I,j) = Drag_u(I,j) + u(I,j,k) * CS%coef_u(I,j,k) - enddo ; enddo ; enddo - - !$OMP do - do k=1,CS%nf ; do J=js-1,je ; do i=is,ie - Drag_v(i,J) = Drag_v(i,J) + v(i,J,k) * CS%coef_v(i,J,k) - enddo ; enddo ; enddo + drag_u(:,:) = 0.0 ; drag_v(:,:) = 0.0 + + if (CS%tensor_drag) then + call pass_vector(u(:,:,1:CS%nf), v(:,:,1:CS%nf), G%domain, direction=To_All+SCALAR_PAIR) + !$OMP do + do j=js,je ; do I=is-1,ie ; do c=1,CS%nf ; if (G%mask2dCu(I,j) * CS%coef_u(I,j,c) > 0.0) then + drag_u(I,j) = drag_u(I,j) + (u(I,j,c) * CS%coef_u(I,j,c) + & + 0.25 * ((v(i+1,J,c) + v(i,J-1,c)) + (v(i,J,c) + v(i+1,J-1,c))) * CS%coef_uv(I,j,c)) + endif ; enddo ; enddo ; enddo + !$OMP do + do J=js-1,je ; do i=is,ie ; do c=1,CS%nf ; if (G%mask2dCv(i,J) * CS%coef_v(i,J,c) > 0.0) then + drag_v(i,J) = drag_v(i,J) + (v(i,J,c) * CS%coef_v(i,J,c) + & + 0.25 * ((u(I-1,j,c) + u(I,j+1,c)) + (u(I,j,c) + u(I-1,j+1,c))) * CS%coef_vu(i,J,c)) + endif ; enddo ; enddo ; enddo + else ! (.not.CS%tensor_drag) + !$OMP do + do j=js,je ; do I=is-1,ie ; do c=1,CS%nf ; if (G%mask2dCu(I,j) * CS%coef_u(I,j,c) > 0.0) then + drag_u(I,j) = drag_u(I,j) + u(I,j,c) * CS%coef_u(I,j,c) + endif ; enddo ; enddo ; enddo + !$OMP do + do J=js-1,je ; do i=is,ie ; do c=1,CS%nf ; if (G%mask2dCv(i,J) * CS%coef_v(i,J,c) > 0.0) then + drag_v(i,J) = drag_v(i,J) + v(i,J,c) * CS%coef_v(i,J,c) + endif ; enddo ; enddo ; enddo + endif ! (CS%tensor_drag) end subroutine wave_drag_calc !> \namespace mom_wave_drag !! -!! By Chengzhu Xu (chengzhu.xu@oregonstate.edu) and Edward D. Zaron, December 2024 +!! By Chengzhu Xu (chengzhu.xu@oregonstate.edu) and Edward D. Zaron !! !! This module calculates the net effects of the frequency-dependent internal wave drag applied to !! the tidal velocities, and returns the sum of products of frequency-dependent drag coefficients @@ -130,6 +172,9 @@ end subroutine wave_drag_calc !! the number of drag coefficients cannot exceed that of the streaming filters, and the names of !! drag coefficients should match those of the streaming filters. The frequency-dependent drag !! coefficients are read from the same file for the linear drag coefficients in MOM_barotropic. +!! +!! Reference: Xu, C., & Zaron, E. D. (2025). Parameterization of frequency-dependent internal wave drag. +!! Journal of Advances in Modeling Earth Systems, 17, e2025MS005126. https://doi.org/10.1029/2025MS005126 end module MOM_wave_drag From 8e731941d0baa52f7bed734c64bc1fab4cdbebaa Mon Sep 17 00:00:00 2001 From: Alistair Adcroft Date: Tue, 4 Nov 2025 16:17:50 -0500 Subject: [PATCH 07/64] Adds a PLM reconstruction scheme using least squares for the slope Recon1d_PLM_WLS provides a piecewise linear reconstruction where the slope is the "best" fit as determined by volume-weighted least squares. The reconstruction is NOT limited by neighboring cells. Therefore, this reconstruction is NOT useful for vertical remapping or grid generation. It is instead intended for the pressure gradient calculation; the idea is to disconnect the PLM slope from the values in vanish(ing) layers which appear to be the source of pressure-gradient errors over topographic slopes in z*-coordinate tests. Because the normal limiters do not apply, the only test I could think of was to check that the least squares fit was actually correct. The documentation explains how this was checked (which took a while due to round-off challenges with the loss function). --- src/ALE/MOM_remapping.F90 | 9 + src/ALE/Recon1d_PLM_WLS.F90 | 460 ++++++++++++++++++++++++++++++++++++ 2 files changed, 469 insertions(+) create mode 100644 src/ALE/Recon1d_PLM_WLS.F90 diff --git a/src/ALE/MOM_remapping.F90 b/src/ALE/MOM_remapping.F90 index c47ab73b77..36336f8823 100644 --- a/src/ALE/MOM_remapping.F90 +++ b/src/ALE/MOM_remapping.F90 @@ -35,6 +35,7 @@ module MOM_remapping use Recon1d_EPPM_CWK, only : EPPM_CWK use Recon1d_PPM_H4_2019, only : PPM_H4_2019 use Recon1d_PPM_H4_2018, only : PPM_H4_2018 +use Recon1d_PLM_WLS, only : PLM_WLS implicit none ; private @@ -1792,6 +1793,9 @@ subroutine setReconstructionType(string,CS) case ("C_PPM_H4_2018") allocate( PPM_H4_2018 :: CS%reconstruction ) CS%remapping_scheme = REMAPPING_VIA_CLASS + case ("C_PLM_WLS") + allocate( PLM_WLS :: CS%reconstruction ) + CS%remapping_scheme = REMAPPING_VIA_CLASS case default call MOM_error(FATAL, "setReconstructionType: "//& "Unrecognized choice for REMAPPING_SCHEME ("//trim(string)//").") @@ -2111,6 +2115,7 @@ logical function remapping_unit_tests(verbose, num_comp_samp) type(PPM_hybgen) :: PPM_hybgen type(PPM_CWK) :: PPM_CWK type(EPPM_CWK) :: EPPM_CWK + type(PLM_WLS) :: PLM_WLS call test%set( verbose=verbose ) ! Sets the verbosity flag in test ! call test%set( stop_instantly=.true. ) ! While debugging @@ -2740,6 +2745,7 @@ logical function remapping_unit_tests(verbose, num_comp_samp) call test%test( PPM_CW%unit_tests(verbose, test%stdout, test%stderr), 'PPM_CW unit test') call test%test( PPM_CWK%unit_tests(verbose, test%stdout, test%stderr), 'PPM_CWK unit test') call test%test( EPPM_CWK%unit_tests(verbose, test%stdout, test%stderr), 'EPPM_CWK unit test') + call test%test( PLM_WLS%unit_tests(verbose, test%stdout, test%stderr), 'PLM_WLS unit test') ! Randomized, brute force tests ntests = 3000 @@ -2769,6 +2775,7 @@ logical function remapping_unit_tests(verbose, num_comp_samp) call test_recon_consistency(test, 'C_PPM_CW', n0, ntests, h_neglect) call test_recon_consistency(test, 'C_PPM_CWK', n0, ntests, h_neglect) call test_recon_consistency(test, 'C_EPPM_CWK', n0, ntests, h_neglect) + call test_recon_consistency(test, 'C_PLM_WLS', n0, ntests, h_neglect) call test_preserve_uniform(test, 'PCM', n0, ntests, h_neglect) call test_preserve_uniform(test, 'C_PCM', n0, ntests, h_neglect) @@ -2795,6 +2802,7 @@ logical function remapping_unit_tests(verbose, num_comp_samp) call test_preserve_uniform(test, 'C_PPM_CW', n0, ntests, h_neglect) call test_preserve_uniform(test, 'C_PPM_CWK', n0, ntests, h_neglect) call test_preserve_uniform(test, 'C_EPPM_CWK', n0, ntests, h_neglect) + call test_preserve_uniform(test, 'C_PLM_WLS', n0, ntests, h_neglect) call test_unchanged_grid(test, 'C_PCM', n0, ntests, h_neglect) call test_unchanged_grid(test, 'C_PLM_CW', n0, ntests, h_neglect) @@ -2806,6 +2814,7 @@ logical function remapping_unit_tests(verbose, num_comp_samp) call test_unchanged_grid(test, 'C_PPM_CW', n0, ntests, h_neglect) call test_unchanged_grid(test, 'C_PPM_CWK', n0, ntests, h_neglect) call test_unchanged_grid(test, 'C_EPPM_CWK', n0, ntests, h_neglect) + call test_unchanged_grid(test, 'C_PLM_WLS', n0, ntests, h_neglect) ! Check that remapping to the exact same grid leaves values unchanged allocate( h0(8), u0(8) ) diff --git a/src/ALE/Recon1d_PLM_WLS.F90 b/src/ALE/Recon1d_PLM_WLS.F90 new file mode 100644 index 0000000000..fa38c782aa --- /dev/null +++ b/src/ALE/Recon1d_PLM_WLS.F90 @@ -0,0 +1,460 @@ +!> Piecewise Linear Method using Weighted Conservative Least Squares 1D reconstruction +module Recon1d_PLM_WLS + +! This file is part of MOM6. See LICENSE.md for the license. + +use Recon1d_type, only : Recon1d, testing + +implicit none ; private + +public PLM_WLS, testing + +!> PLM reconstruction using Weighted Least Squares constrained to conserve for central cell +!! +!! The source for the methods ultimately used by this class are: +!! - init() *locally defined +!! - reconstruct() *locally defined +!! - average() *locally defined +!! - f() *locally defined +!! - dfdx() *locally defined +!! - check_reconstruction() *locally defined +!! - unit_tests() *locally defined +!! - destroy() *locally defined +!! - remap_to_sub_grid() -> recon1d_type.remap_to_sub_grid() +!! - init_parent() -> init() +!! - reconstruct_parent() -> reconstruct() +type, extends (Recon1d) :: PLM_WLS + + real, allocatable :: ul(:) !< Left edge value [A] + real, allocatable :: ur(:) !< Right edge value [A] + real, allocatable, private :: slp(:) !< Difference across cell, ur - ul [A]. + !! This is redundant with ul and ur and not used + !! in any evaluations, but is needed for testing. + +contains + !> Implementation of the PLM_WLS initialization + procedure :: init => init + !> Implementation of the PLM_WLS reconstruction + procedure :: reconstruct => reconstruct + !> Implementation of the PLM_WLS average over an interval [A] + procedure :: average => average + !> Implementation of evaluating the PLM_WLS reconstruction at a point [A] + procedure :: f => f + !> Implementation of the derivative of the PLM_WLS reconstruction at a point [A] + procedure :: dfdx => dfdx + !> Implementation of deallocation for PLM_WLS + procedure :: destroy => destroy + !> Implementation of check reconstruction for the PLM_WLS reconstruction + procedure :: check_reconstruction => check_reconstruction + !> Implementation of unit tests for the PLM_WLS reconstruction + procedure :: unit_tests => unit_tests + + !> Duplicate interface to init() + procedure :: init_parent => init + !> Duplicate interface to reconstruct() + procedure :: reconstruct_parent => reconstruct + +end type PLM_WLS + +contains + +!> Initialize a 1D PLM reconstruction for n cells +subroutine init(this, n, h_neglect, check) + class(PLM_WLS), intent(out) :: this !< This reconstruction + integer, intent(in) :: n !< Number of cells in this column + real, optional, intent(in) :: h_neglect !< A negligibly small width used in cell reconstructions [H] + logical, optional, intent(in) :: check !< If true, enable some consistency checking + + this%n = n + + allocate( this%u_mean(n) ) + allocate( this%ul(n) ) + allocate( this%ur(n) ) + allocate( this%slp(n) ) + + this%h_neglect = tiny( this%u_mean(1) ) + if (present(h_neglect)) this%h_neglect = h_neglect + this%check = .false. + if (present(check)) this%check = check + +end subroutine init + +!> Calculate a 1D PLM_WLS reconstruction based on h(:) and u(:) +subroutine reconstruct(this, h, u) + class(PLM_WLS), intent(inout) :: this !< This reconstruction + real, intent(in) :: h(*) !< Grid spacing (thickness) [typically H] + real, intent(in) :: u(*) !< Cell mean values [A] + ! Local variables + real :: slp ! The PLM slopes (difference across cell) [A] + real :: u_l, u_r, u_c ! Left, right, and center values [A] + real :: h_l, h_c, h_r ! Thickness of left, center and right cells [H] + real :: h_l0, h_r0 ! Thickness of left and right cells with h_neglect added [H] + real :: hx2l, hx2r ! Contributions to denominator, [H3] + real :: hxyl, hxyr ! Contributions to numerator, [H2 A] + integer :: n, km1, k, kp1 + + n = this%n + + ! Loop over all cells + do k = 1, n + km1 = max(1, k-1) + kp1 = min(n, k+1) + u_l = u(km1) + u_c = u(k) + u_r = u(kp1) + + h_l = h(km1) * real( k - km1 ) ! This zeroes h_l at k==1 + h_c = h(k) + h_r = h(kp1) * real( kp1 - k ) ! This zeroes h_r at k==n + + ! This is the slope that minimizes the error + ! sum_l={-1,1} h(k+l) * [ u(k+l) - u(k) + slp * ( z(k+l) - z(k) ) ] + ! i.e. volume weighted least squares + h_l0 = h_l + this%h_neglect + h_r0 = h_r + this%h_neglect + hxyl = ( h_l * ( h_c + h_l ) ) * ( u_c - u_l ) + hxyr = ( h_r * ( h_c + h_r ) ) * ( u_r - u_c ) + hx2l = h_l0 * ( h_c + h_l0 )**2 + hx2r = h_r0 * ( h_c + h_r0 )**2 + slp = 2. * h_c * ( hxyr + hxyl ) / ( hx2l + hx2r ) + + ! Mean value + this%u_mean(k) = u_c + + ! Left edge + this%ul(k) = u_c - 0.5 * slp + + ! Right edge + this%ur(k) = u_c + 0.5 * slp + + ! Store slope + this%slp(k) = slp + enddo + +end subroutine reconstruct + +!> Value of PLM_WLS reconstruction at a point in cell k [A] +real function f(this, k, x) + class(PLM_WLS), intent(in) :: this !< This reconstruction + integer, intent(in) :: k !< Cell number + real, intent(in) :: x !< Non-dimensional position within element [nondim] + real :: du ! Difference across cell [A] + + du = this%ur(k) - this%ul(k) + + ! This expression might be used beyond the element to evaluate + ! LS errors. In other PLM implementations x is bounded to the + ! element and the expressions are constructed to not exceed + ! bounds. There are no such constraints for PLM_WLS. + f = this%u_mean(k) + du * ( x - 0.5) + !f = this%u_mean(k) + this%slp(k) * ( x - 0.5) + +end function f + +!> Derivative of PLM_WLS reconstruction at a point in cell k [A] +real function dfdx(this, k, x) + class(PLM_WLS), intent(in) :: this !< This reconstruction + integer, intent(in) :: k !< Cell number + real, intent(in) :: x !< Non-dimensional position within element [nondim] + + dfdx = this%ur(k) - this%ul(k) + +end function dfdx + +!> Average between xa and xb for cell k of a 1D PLM reconstruction [A] +real function average(this, k, xa, xb) + class(PLM_WLS), intent(in) :: this !< This reconstruction + integer, intent(in) :: k !< Cell number + real, intent(in) :: xa !< Start of averaging interval on element (0 to 1) + real, intent(in) :: xb !< End of averaging interval on element (0 to 1) + real :: xmab ! Mid-point between xa and xb (0 to 1) + real :: u_a, u_b ! Values at xa and xb [A] + + ! Mid-point between xa and xb + xmab = 0.5 * ( xa + xb ) + + ! This expression for u_a can overshoot u_r but is good for xmab<<1 + u_a = this%ul(k) + ( this%ur(k) - this%ul(k) ) * xmab + ! This expression for u_b can overshoot u_l but is good for 1-xmab<<1 + u_b = this%ur(k) + ( this%ul(k) - this%ur(k) ) * ( 1. - xmab ) + + ! Since u_a and u_b are both bounded, this will perserve uniformity but will the + ! sum be bounded? Emperically it seems to work... + average = 0.5 * ( u_a + u_b ) + +end function average + +!> Deallocate the PLM reconstruction +subroutine destroy(this) + class(PLM_WLS), intent(inout) :: this !< This reconstruction + + deallocate( this%u_mean, this%ul, this%ur ) + +end subroutine destroy + +!> Checks the PLM_WLS reconstruction for consistency +logical function check_reconstruction(this, h, u) + class(PLM_WLS), intent(in) :: this !< This reconstruction + real, intent(in) :: h(*) !< Grid spacing (thickness) [typically H] + real, intent(in) :: u(*) !< Cell mean values [A] + ! Local variables + integer :: k + real :: slp ! Cell slope [A] + type(PLM_WLS) :: perturbed !< A perturbed reconstruction + real :: u_l, u_r, u_c ! Left, right, and center values [A] + real :: h_l, h_c, h_r ! Thickness of left, center and right cells [H] + real :: h_l0, h_r0, h_c0 ! Thickness of left, right, center cells with h_neglect added [H] + real :: x_l, x_r ! Positions of left and right cells [H] + real :: hx2l, hx2r ! Contributions to denominator, [H3] + real :: hxyl, hxyr ! Contributions to numerator, [H2 A] + real :: hy2l, hy2r ! Contributions to error, [H3] + real :: y_l, y_r ! Left, right, value differencess [A] + real :: b_h, bp_h ! slp / h_c [A H-1] + integer :: km1, kp1 + + check_reconstruction = .false. + + do k = 1, this%n + if ( abs( this%u_mean(k) - u(k) ) > 0. ) check_reconstruction = .true. + enddo + + ! Check the cell reconstruction is monotonic within each cell (it should be as a straight line) + do k = 1, this%n + if ( ( this%u_mean(k) - this%ul(k) ) * ( this%ur(k) - this%u_mean(k) ) < 0. ) check_reconstruction = .true. + enddo + + ! Check the cell is a straight line (to within machine precision) + do k = 1, this%n + if ( abs(2. * this%u_mean(k) - ( this%ul(k) + this%ur(k) )) > epsilon(this%u_mean(1)) * & + max(abs(2. * this%u_mean(k)), abs(this%ul(k)), abs(this%ur(k))) ) check_reconstruction = .true. + enddo + + ! Create a perturbable reconstruction + call perturbed%init( this%n, h_neglect=this%h_neglect ) + call perturbed%reconstruct( h, u ) ! Should reproduce "this" + ! Check the copy is identical + do k = 1, this%n + if ( abs( perturbed%u_mean(k) - this%u_mean(k) ) > 0. ) check_reconstruction = .true. + if ( abs( perturbed%ul(k) - this%ul(k) ) > 0. ) check_reconstruction = .true. + if ( abs( perturbed%ur(k) - this%ur(k) ) > 0. ) check_reconstruction = .true. + if ( abs( perturbed%slp(k) - this%slp(k) ) > 0. ) check_reconstruction = .true. + enddo + ! Now perturb the slope. The local error should not decrease. + do k = 1, this%n + slp = this%slp(k) * ( 1.0 + 1. * epsilon(slp) ) + perturbed%slp(k) = slp + perturbed%ul(k) = u(k) - 0.5 * slp + perturbed%ur(k) = u(k) + 0.5 * slp + if ( LS_error(perturbed, k, h, u) < LS_error(this, k, h, u) ) check_reconstruction = .true. + + slp = this%slp(k) * ( 1.0 - 1. * epsilon(slp) ) + perturbed%slp(k) = slp + perturbed%ul(k) = u(k) - 0.5 * slp + perturbed%ur(k) = u(k) + 0.5 * slp + if ( LS_error(perturbed, k, h, u) < LS_error(this, k, h, u) ) check_reconstruction = .true. + enddo + +end function check_reconstruction + +!> Returns local least squares error for a particular cell +!! +!! Note that this is the error relative to the minimum of the loss function so that at the +!! true solution this function returns zero. See module documentation. +real function LS_error(this, k, h, u) + type(PLM_WLS), intent(in) :: this !< This reconstruction + integer, intent(in) :: k !< Cell number + real, intent(in) :: h(*) !< Grid spacing (thickness) [typically H] + real, intent(in) :: u(*) !< Cell mean values [A] + ! Local variables + real :: u_l, u_r, u_c ! Left, right, and center values [A] + real :: h_l, h_c, h_r ! Thickness of left, center and right cells [H] + real :: h_l0, h_r0, hc0 ! Thickness of left, right, center cells with h_neglect added [H] + real :: hx2l, hx2r ! Contributions to denominator, [H3] + real :: hxyl, hxyr ! Contributions to numerator, [H2 A] + integer :: km1, kp1 + + km1 = max(1, k-1) + kp1 = min(this%n, k+1) + u_l = u(km1) + u_c = u(k) + u_r = u(kp1) + + h_l = h(km1) * real( k - km1 ) ! This zeroes h_l at k==1 + h_r = h(kp1) * real( kp1 - k ) ! This zeroes h_r at k==n + h_c = h(k) + hc0 = h_c + this%h_neglect + + h_l0 = h_l + this%h_neglect + h_r0 = h_r + this%h_neglect + hxyl = ( h_l * 0.5 * ( h_c + h_l ) ) * ( u_c - u_l ) + hxyr = ( h_r * 0.5 * ( h_c + h_r ) ) * ( u_r - u_c ) + hx2l = h_l0 * 0.25 * ( h_c + h_l0 )**2 + hx2r = h_r0 * 0.25 * ( h_c + h_r0 )**2 + LS_error = h_c * ( ( hx2l + hx2r ) * this%slp(k) - h(k) * ( hxyl + hxyr ) )**2 + LS_error = LS_error / ( hc0 * ( hx2l + hx2r ) ) +end function LS_error + +!> Runs PLM_WLS reconstruction unit tests and returns True for any fails, False otherwise +logical function unit_tests(this, verbose, stdout, stderr) + class(PLM_WLS), intent(inout) :: this !< This reconstruction + logical, intent(in) :: verbose !< True, if verbose + integer, intent(in) :: stdout !< I/O channel for stdout + integer, intent(in) :: stderr !< I/O channel for stderr + ! Local variables + real, allocatable :: ul(:), ur(:), um(:) ! test values [A] + real, allocatable :: ull(:), urr(:) ! test values [A] + type(testing) :: test ! convenience functions + integer :: k + + call test%set( stdout=stdout ) ! Sets the stdout channel in test + call test%set( stderr=stderr ) ! Sets the stderr channel in test + call test%set( verbose=verbose ) ! Sets the verbosity flag in test + + call this%init(3, h_neglect=1.e-20) + call test%test( this%n /= 3, "Setting number of levels") + allocate( um(3), ul(3), ur(3), ull(3), urr(3) ) + + call this%reconstruct( (/1.,1.,1./), (/-1.,0.,2./) ) + call test%real_arr(3, this%slp, (/1.,1.5,2./), "(1,1,1)(-1,0,2) slope") + + do k = 1, 3 + um(k) = LS_error(this, k, (/1.,1.,1./), (/-1.,0.,2./) ) + enddo + call test%real_arr(3, um, (/0.,0.,0./), "(1,1,1)(-1,0,2) LS' rel error") + + call this%reconstruct( (/0.,1.,1./), (/-1.,0.,2./) ) + call test%real_arr(3, this%slp, (/0.,2.,2./), "(0,1,1)(-1,0,2) slope") + + do k = 1, 3 + um(k) = LS_error(this, k, (/0.,1.,1./), (/-1.,0.,2./) ) + enddo + call test%real_arr(3, um, (/0.,0.,0./), "(0,1,1)(-1,0,2) LS' rel error") + + call this%reconstruct( (/1.,1.,1./), (/-2.,0.,1./) ) + call test%real_arr(3, this%slp, (/2.,1.5,1./), "(1,1,1)(-2,0,1) slope") + + call this%reconstruct( (/1.,1.,0./), (/-2.,0.,1./) ) + call test%real_arr(3, this%slp, (/2.,2.,0./), "(1,1,0)(-2,0,1) slope") + + call this%destroy() + call this%init(3) ! Reset to defaults + + ! Straight line data on uniform grid + call this%reconstruct( (/2.,2.,2./), (/1.,3.,5./) ) + call test%real_arr(3, this%u_mean, (/1.,3.,5./), "Straight line data") + + do k = 1, 3 + ul(k) = this%f(k, 0.) + um(k) = this%f(k, 0.5) + ur(k) = this%f(k, 1.) + enddo + call test%real_arr(3, ul, (/0.,2.,4./), "Evaluation on left edge") + call test%real_arr(3, um, (/1.,3.,5./), "Evaluation in center") + call test%real_arr(3, ur, (/2.,4.,6./), "Evaluation on right edge") + + do k = 1, 3 + ul(k) = this%dfdx(k, 0.) + um(k) = this%dfdx(k, 0.5) + ur(k) = this%dfdx(k, 1.) + enddo + call test%real_arr(3, ul, (/2.,2.,2./), "dfdx on left edge") + call test%real_arr(3, um, (/2.,2.,2./), "dfdx in center") + call test%real_arr(3, ur, (/2.,2.,2./), "dfdx on right edge") + + do k = 1, 3 + um(k) = LS_error(this, k, (/2.,2.,2./), (/1.,3.,5./) ) + enddo + call test%real_arr(3, um, (/0.,0.,0./), "Rel error is 0") + + do k = 1, 3 + um(k) = this%average(k, 0.5, 0.75) ! Average from x=0.5 to 0.75 in each cell + enddo + call test%real_arr(3, um, (/1.25,3.25,5.25/), "Return interval average") + + call this%destroy() + deallocate( um, ul, ur, ull, urr ) + + allocate( um(4), ul(4), ur(4) ) + call this%init(4) + + deallocate( um, ul, ur ) + + unit_tests = test%summarize("PLM_WLS:unit_tests") + +end function unit_tests + +!> \namespace recon1d_plm_wls +!! +!! This implementation of PLM fits the slope using least squares, but retains conservation +!! for the central cell by passing through the central value. +!! Cell-wise reconstructions are NOT limited by neighbours. +!! Thus, this reconstruction does not yield monotonic profiles needed for the general remapping problem. +!! +!! The algorithm solves the least squares problem of fitting a straight line through +!! the neighboring data. The line is constained to pass through the center cell, +!! \f$ (x_{k}, y_{k}) \f$, so that the construction is conservative. The more general +!! function \f$ f(x) = a_{k} + b_{k} x \f$ would not conserve for arbitrary data. +!! +!! The unknown parameter \f$ b_{k} \f$ in the line +!! \f[ +!! f(x) = y_{k} + b_{k} ( x - x_{k} ) / h_{k} +!! \f] +!! is fit to neighbors \f$ x_{k-1}, y_{k-1} \f$ and \f$ x_{k+1}, y_{k+1} \f$. +!! +!! Denoting \f$ y'_{k+j} = y_{k+j} - y_{k} \f$ and \f$ x'_{k+j} = x_{k+j} - x_{k} \f$ +!! the local error is +!! \f{align}{ +!! e_{k+j} &= b_k \frac{ x_{k+j} - x_{k} }{ h_{k} } + y_{k} - y_{k+j} \\\\ +!! &= b_k \frac{ x'_{k+j} }{ h_{k} } - y'_{k+j} +!! \;\; . \f} +!! +!! We use volume weighting in the loss +!! \f[ +!! G(b) = h_{k-1} e_{k-1}^2 + h_{k+1} e_{k+1}^2 +!! \;\; . \f] +!! +!! When solving for \f$ b_k \f$, we solve \f$ dG/db = 0 \f$ where +!! \f{align}{ +!! dG/db &= 2 h_{k-1} e_{k-1} \frac{ de_{k-1} }{db} + 2 h_{k+1} e_{k+1} \frac{ de_{k+1} }{db} \\\\ +!! &= 2 h_{k-1} ( b_k \frac{ x'_{k-1} }{ h_{k} } - \frac{ y'_{k-1} ) x'_{k-1} }{ h_{k} } + +!! 2 h_{k+1} ( b_k \frac{ x'_{k+1} }{ h_{k} } - \frac{ y'_{k+1} ) x'_{k+1} }{ h_{k} } \\\\ +!! &= 4 b_k \frac{ < h x'^2 > }{ h_{k}^2 } - 4 \frac{ < h x' y' > }{ h_{k} } +!! \f} +!! and where \f$ < a > = \frac{1}{2} ( a_{k-1} + a_{k+1} ) \f$. +!! Thus +!! \f[ +!! b_k = \frac{ h_{k} < h x' y' > }{ < h x'^2 > } \;\; . +!! \f] +!! +!! When evaluating the loss, \f$ G \f$, some rearrangement is necessary to reduce truncation +!! errors. Since +!! \f{align}{ +!! e_{k+j}^2 &= \left( b \frac{ x'_{k+j} }{ h_{k} } - y'_{k+j} \right)^2 \\\\ +!! &= b^2 \frac{ {x'}_{k+j}^2 }{ h_{k}^2 } - 2 b \frac{ x'_{k+j} y'_{k+j} }{ h_{k} } + {y'}_{k+j}^2 +!! \f} +!! then +!! \f{align}{ +!! G(b) &= 2 < h e^2 > \\\\ +!! &= 2 b^2 \frac{ < h {x'}^2 > }{ h_{k}^2 } - 4 b \frac{ < h x' y' > }{ h_{k} } + 2 < h' {y'}^2 > +!! \;\; . +!! \f} +!! +!! If we denote the value of b that yields the minimum value as \f$ b^* \f$ then +!! \f[ +!! G(b^*) = < h {y'}^2 > - \frac{ < h x' y' >^2 }{ < h {x'}^2 > } +!! \;\; . +!! \f] +!! +!! Let +!! \f{align}{ +!! G''(b) &= G(b) - G(b^*) \\\\ +!! &= b^2 \frac{ < h {x'}^2 > }{ h_{k}^2 } - 2 b \frac{ < h x' y' > }{ h_{k} } +!! + \frac{ < h x' y' > }{ < h {x'}^2 > } \\\\ +!! &= \frac{ \left( b < h {x'}^2 > - h_{k} < h x' y' > \right)^2 }{ h_{k} < h {x'}^2 > } +!! \;\; . +!! \f} +!! Minimizing \f$ G''(b) \f$ is equivalent to minimizing \f$ G(b) \f$ for the same data. +!! \f$ G''(b^*)=0 \f$ so evaluation with the last form, in the vicinity of \f$ b^* \f$, avoids +!! large cancelling terms. + +end module Recon1d_PLM_WLS From e0f2469217e52d1f08fcefeebc6d5ce66ce68ed7 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 25 Nov 2025 13:24:26 -0500 Subject: [PATCH 08/64] Corrected unit descriptions in 64 comments Corrected the descriptions of variable units in 64 comments spread across 16 files, including a dozen instances where "arbitrary" was misspelled. All answers are bitwise identical and only comments were changed. --- src/ALE/MOM_ALE.F90 | 14 ++++---- src/ALE/MOM_regridding.F90 | 12 +++---- src/ALE/Recon1d_type.F90 | 8 ++--- src/ALE/regrid_edge_values.F90 | 3 +- src/ALE/regrid_interp.F90 | 20 +++++------ src/core/MOM_variables.F90 | 4 +-- src/framework/MOM_checksums.F90 | 36 +++++++++---------- src/framework/MOM_coms.F90 | 4 +-- src/framework/MOM_dyn_horgrid.F90 | 2 +- src/framework/MOM_intrinsic_functions.F90 | 4 +-- src/initialization/MOM_grid_initialize.F90 | 10 +++--- .../lateral/MOM_mixed_layer_restrat.F90 | 10 +++--- .../lateral/MOM_spherical_harmonics.F90 | 2 +- .../vertical/MOM_geothermal.F90 | 3 +- src/tracer/MOM_CFC_cap.F90 | 2 +- src/user/MOM_controlled_forcing.F90 | 2 +- 16 files changed, 69 insertions(+), 67 deletions(-) diff --git a/src/ALE/MOM_ALE.F90 b/src/ALE/MOM_ALE.F90 index ab9b7405ee..0997391cf3 100644 --- a/src/ALE/MOM_ALE.F90 +++ b/src/ALE/MOM_ALE.F90 @@ -1184,9 +1184,9 @@ subroutine ALE_remap_velocities(CS, G, GV, h_old_u, h_old_v, h_new_u, h_new_v, u ! First get barotropic component u_bt = 0.0 do k=1,nz - u_bt = u_bt + h2(k) * u_tgt(k) ! Dimensions [H L T-1] + u_bt = u_bt + h2(k) * u_tgt(k) ! Dimensions [H L T-1 ~> m2 s-1 or kg m-1 s-1] enddo - u_bt = u_bt / (sum(h2(1:nz)) + GV%H_subroundoff) ! Dimensions return to [L T-1] + u_bt = u_bt / (sum(h2(1:nz)) + GV%H_subroundoff) ! Dimensions return to [L T-1 ~> m s-1] ! Next get baroclinic ke = \int (u-u_bt)^2 from source and target ke_c_src = 0.0 ke_c_tgt = 0.0 @@ -1259,9 +1259,9 @@ subroutine ALE_remap_velocities(CS, G, GV, h_old_u, h_old_v, h_new_u, h_new_v, u ! First get barotropic component v_bt = 0.0 do k=1,nz - v_bt = v_bt + h2(k) * v_tgt(k) ! Dimensions [H L T-1] + v_bt = v_bt + h2(k) * v_tgt(k) ! Dimensions [H L T-1 ~> m2 s-1 or kg m-1 s-1] enddo - v_bt = v_bt / (sum(h2(1:nz)) + GV%H_subroundoff) ! Dimensions return to [L T-1] + v_bt = v_bt / (sum(h2(1:nz)) + GV%H_subroundoff) ! Dimensions return to [L T-1 ~> m s-1] ! Next get baroclinic ke = \int (u-u_bt)^2 from source and target ke_c_src = 0.0 ke_c_tgt = 0.0 @@ -1607,11 +1607,11 @@ subroutine TS_PPM_edge_values( CS, S_t, S_b, T_t, T_b, G, GV, tv, h, bdry_extrap ! Local variables integer :: i, j, k real :: hTmp(GV%ke) ! A 1-d copy of h [H ~> m or kg m-2] - real :: tmp(GV%ke) ! A 1-d copy of a column of temperature [degC] or salinity [ppt] + real :: tmp(GV%ke) ! A 1-d copy of a column of temperature [C ~> degC] or salinity [S ~> ppt] real, dimension(CS%nk,2) :: & - ppol_E ! Edge value of polynomial in [degC] or [ppt] + ppol_E ! Edge value of polynomial in [C ~> degC] or [S ~> ppt] real, dimension(CS%nk,3) :: & - ppol_coefs ! Coefficients of polynomial, all in [degC] or [ppt] + ppol_coefs ! Coefficients of polynomial, all in [C ~> degC] or [S ~> ppt] real :: h_neglect, h_neglect_edge ! Tiny thicknesses [H ~> m or kg m-2] if (CS%answer_date >= 20190101) then diff --git a/src/ALE/MOM_regridding.F90 b/src/ALE/MOM_regridding.F90 index 9f36ae9d89..2e20955ec6 100644 --- a/src/ALE/MOM_regridding.F90 +++ b/src/ALE/MOM_regridding.F90 @@ -217,7 +217,7 @@ subroutine initialize_regridding(CS, G, GV, US, max_depth, param_file, mdl, & integer :: np ! Number of profiles, for HYBRID_MAP integer :: nceiling ! ceiling of map index, for HYBRID_MAP integer :: nfloor ! floor of map index, for HYBRID_MAP - real :: nfrac ! fraction of map index, for HYBRID_MAP + real :: nfrac ! fraction of map index, for HYBRID_MAP [nondim] character(len=80) :: string, string2, varName ! Temporary strings character(len=40) :: coord_units, coord_res_param ! Temporary strings character(len=MAX_PARAM_LENGTH) :: param_name @@ -236,8 +236,8 @@ subroutine initialize_regridding(CS, G, GV, US, max_depth, param_file, mdl, & ! maximum_depth is large [m] (not in Z). real :: nominalDepth ! Depth of ocean bottom in thickness units (positive downward) [H ~> m or kg m-2] real :: depth_q ! A depth scale factor [nondim] - real :: depth_s ! The end of the shallow Z regime (m) - real :: depth_d ! The start of the deep Z regime (m) + real :: depth_s ! The end of the shallow Z regime [m] + real :: depth_d ! The start of the deep Z regime [m] real :: adaptTimeRatio, adaptZoomCoeff ! Temporary variables for input parameters [nondim] real :: adaptBuoyCoeff, adaptAlpha ! Temporary variables for input parameters [nondim] real :: adaptZoom ! The thickness of the near-surface zooming region with the adaptive coordinate [H ~> m or kg m-2] @@ -1208,7 +1208,7 @@ subroutine regridding_main( remapCS, CS, G, GV, US, h, tv, h_new, dzInterface, & !! coordinate [H ~> m or kg m-2] real, dimension(SZI_(G),SZJ_(G),CS%nk+1), intent(inout) :: dzInterface !< The change in position of each !! interface [H ~> m or kg m-2] - real, dimension(SZI_(G),SZJ_(G)), optional, intent(in ) :: frac_shelf_h !< Fractional ice shelf coverage [nomdim] + real, dimension(SZI_(G),SZJ_(G)), optional, intent(in ) :: frac_shelf_h !< Fractional ice shelf coverage [nondim] logical, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & optional, intent(out ) :: PCM_cell !< Use PCM remapping in cells where true @@ -2416,7 +2416,7 @@ subroutine setCoordinateResolution_3d( dz_3d, CS, scale ) !! dependent units, such as [m] for a z-coordinate or [kg m-3] !! for a density coordinate. type(regridding_CS), intent(inout) :: CS !< Regridding control structure - real, optional, intent(in) :: scale !< A scaling factor converting dz to coordRes [m -> Z] + real, optional, intent(in) :: scale !< A scaling factor converting dz to coordRes [Z m-1 ~> 1] if (.not.allocated(CS%coordinateResolution_3d)) & call MOM_error(FATAL,'setCoordinateResolution_3d: '//& @@ -2457,7 +2457,7 @@ end subroutine set_target_densities_from_GV subroutine set_target_densities_3d( CS, G, scale, rho_int_3d ) type(regridding_CS), intent(inout) :: CS !< Regridding control structure type(ocean_grid_type),intent(in) :: G !< Ocean grid structure - real, intent(in) :: scale !< A scaling factor converting densities [kg m-3 -> R] + real, intent(in) :: scale !< A scaling factor converting densities [R m3 kg-1 ~> 1] real, dimension(SZI_(G),SZJ_(G),CS%nk+1), intent(in) :: rho_int_3d !< Interface densities [kg m-3] if (.not.allocated(CS%target_density_3d)) & diff --git a/src/ALE/Recon1d_type.F90 b/src/ALE/Recon1d_type.F90 index 4411e1288e..c11d880cc8 100644 --- a/src/ALE/Recon1d_type.F90 +++ b/src/ALE/Recon1d_type.F90 @@ -15,7 +15,7 @@ module Recon1d_type integer :: n = 0 !< Number of cells in column real, allocatable, dimension(:) :: u_mean !< Cell mean [A] - real :: h_neglect = 0. !< A negligibly small width used in cell reconstructions [same as h, H] + real :: h_neglect = 0. !< A negligibly small width used in cell reconstructions in the same units as h [H] logical :: check = .false. !< If true, enable some consistency checking logical :: debug = .false. !< If true, dump info as calculations are made (do not enable) @@ -80,7 +80,7 @@ end subroutine i_init subroutine i_reconstruct(this, h, u) import :: Recon1d class(Recon1d), intent(inout) :: this !< This reconstruction - real, intent(in) :: h(*) !< Grid spacing (thickness) [typically H] + real, intent(in) :: h(*) !< Grid spacing (thickness), typically in [H] real, intent(in) :: u(*) !< Cell mean values [A] end subroutine i_reconstruct @@ -122,7 +122,7 @@ end function i_dfdx logical function i_check_reconstruction(this, h, u) import :: Recon1d class(Recon1d), intent(in) :: this !< This reconstruction - real, intent(in) :: h(*) !< Grid spacing (thickness) [typically H] + real, intent(in) :: h(*) !< Grid spacing (thickness), typically in [H] real, intent(in) :: u(*) !< Cell mean values [A] end function i_check_reconstruction @@ -145,7 +145,7 @@ end subroutine i_init_parent subroutine i_reconstruct_parent(this, h, u) import :: Recon1d class(Recon1d), intent(inout) :: this !< This reconstruction - real, intent(in) :: h(*) !< Grid spacing (thickness) [typically H] + real, intent(in) :: h(*) !< Grid spacing (thickness), typically in [H] real, intent(in) :: u(*) !< Cell mean values [A] end subroutine i_reconstruct_parent diff --git a/src/ALE/regrid_edge_values.F90 b/src/ALE/regrid_edge_values.F90 index 54cec45cba..e969a94023 100644 --- a/src/ALE/regrid_edge_values.F90 +++ b/src/ALE/regrid_edge_values.F90 @@ -1003,7 +1003,8 @@ subroutine edge_slopes_implicit_h5( N, h, u, edge_slopes, h_neglect, answer_date real, dimension(7) :: x ! Coordinate system with 0 at edges in the same units as h [H] real, parameter :: C1_12 = 1.0 / 12.0 ! A rational parameter [nondim] real, parameter :: C5_6 = 5.0 / 6.0 ! A rational parameter [nondim] - real :: dx, xavg ! Differences and averages of successive values of x [same units as h] + real :: dx ! Differences between successive values of x in the same units as h [H] + real :: xavg ! Average of successive values of x in the same units as h [H] real, dimension(6,6) :: Asys ! The matrix that is being inverted for a solution, ! in units that might vary with the second (j) index as [H^j] real, dimension(6) :: Bsys ! The right hand side of the system to solve for C in various diff --git a/src/ALE/regrid_interp.F90 b/src/ALE/regrid_interp.F90 index 6e0be9ebba..03e26ada3c 100644 --- a/src/ALE/regrid_interp.F90 +++ b/src/ALE/regrid_interp.F90 @@ -335,19 +335,19 @@ subroutine build_and_interpolate_grid(CS, densities, n0, h0, x0, target_values, integer, intent(in) :: n1 !< The number of points on the output grid real, dimension(n0), intent(in) :: densities !< Input cell densities [R ~> kg m-3] real, dimension(n1+1), intent(in) :: target_values !< Target values of interfaces [R ~> kg m-3] - real, dimension(n0), intent(in) :: h0 !< Initial cell widths [H] - real, dimension(n0+1), intent(in) :: x0 !< Source interface positions [H] - real, dimension(n1), intent(inout) :: h1 !< Output cell widths [H] - real, dimension(n1+1), intent(inout) :: x1 !< Target interface positions [H] + real, dimension(n0), intent(in) :: h0 !< Initial cell widths usually in [H ~> m or kg m-2] or [Z ~> m] + real, dimension(n0+1), intent(in) :: x0 !< Source interface positions [H ~> m or kg m-2] or [Z ~> m] + real, dimension(n1), intent(inout) :: h1 !< Output cell widths [H ~> m or kg m-2] or [Z ~> m] + real, dimension(n1+1), intent(inout) :: x1 !< Target interface positions [H ~> m or kg m-2] or [Z ~> m] real, intent(in) :: h_neglect !< A negligibly small width for the - !! purpose of cell reconstructions [H] - !! in the same units as h0. - real, optional, intent(in) :: h_neglect_edge !< A negligibly small width - !! for the purpose of edge value calculations [H] - !! in the same units as h0. + !! purpose of cell reconstructions in the same + !! units as h0 [H ~> m or kg m-2] or [Z ~> m]. + real, optional, intent(in) :: h_neglect_edge !< A negligibly small width for the + !! purpose of edge value calculations in the same + !! units as h0 [H ~> m or kg m-2] or [Z ~> m] real, dimension(n0,2) :: ppoly0_E ! Polynomial edge values [R ~> kg m-3] - real, dimension(n0,2) :: ppoly0_S ! Polynomial edge slopes [R H-1] + real, dimension(n0,2) :: ppoly0_S ! Polynomial edge slopes [R H-1 ~> kg m-4 or m-1] or [R Z-1 ~> kg m-4] real, dimension(n0,DEGREE_MAX+1) :: ppoly0_C ! Polynomial interpolant coeficients on the local 0-1 grid [R ~> kg m-3] integer :: degree diff --git a/src/core/MOM_variables.F90 b/src/core/MOM_variables.F90 index c6483f8cef..5061010d6a 100644 --- a/src/core/MOM_variables.F90 +++ b/src/core/MOM_variables.F90 @@ -89,9 +89,9 @@ module MOM_variables !! When conservative temperature is used, this is !! constant and exactly 3991.86795711963 J degC-1 kg-1. logical :: T_is_conT = .false. !< If true, the temperature variable tv%T is - !! actually the conservative temperature [degC]. + !! actually the conservative temperature [C ~> degC]. logical :: S_is_absS = .false. !< If true, the salinity variable tv%S is - !! actually the absolute salinity in units of [gSalt kg-1]. + !! actually the absolute salinity in units of [S ~> gSalt kg-1]. real :: min_salinity !< The minimum value of salinity when BOUND_SALINITY=True [S ~> ppt]. real, allocatable, dimension(:,:,:) :: SpV_avg !< The layer averaged in situ specific volume [R-1 ~> m3 kg-1]. diff --git a/src/framework/MOM_checksums.F90 b/src/framework/MOM_checksums.F90 index 9177eb8965..837c634e9b 100644 --- a/src/framework/MOM_checksums.F90 +++ b/src/framework/MOM_checksums.F90 @@ -2192,7 +2192,7 @@ end subroutine chksum_v_3d !> chksum1d does a checksum of a 1-dimensional array. subroutine chksum1d(array, mesg, start_i, end_i, compare_PEs, logunit) - real, dimension(:), intent(in) :: array !< The array to be summed (index starts at 1) [abitrary]. + real, dimension(:), intent(in) :: array !< The array to be summed (index starts at 1) in arbitrary units [A]. character(len=*), intent(in) :: mesg !< An identifying message. integer, optional, intent(in) :: start_i !< The starting index for the sum (default 1) integer, optional, intent(in) :: end_i !< The ending index for the sum (default all) @@ -2201,8 +2201,8 @@ subroutine chksum1d(array, mesg, start_i, end_i, compare_PEs, logunit) integer, optional, intent(in) :: logunit !< IO unit for checksum logging integer :: is, ie, i, bc, sum1, sum_bc, ioUnit - real :: sum ! The global sum of the array [arbitrary] - real, allocatable :: sum_here(:) ! The sum on each PE [arbitrary] + real :: sum ! The global sum of the array [A] + real, allocatable :: sum_here(:) ! The sum on each PE [A] logical :: compare integer :: pe_num ! pe number of the data integer :: nPEs ! Total number of processsors @@ -2253,12 +2253,12 @@ end subroutine chksum1d !> chksum2d does a checksum of all data in a 2-d array. subroutine chksum2d(array, mesg, logunit) - real, dimension(:,:), intent(in) :: array !< The array to be checksummed [arbitrary] + real, dimension(:,:), intent(in) :: array !< The array to be checksummed in arbitrary units [A] character(len=*), intent(in) :: mesg !< An identifying message integer, optional, intent(in) :: logunit !< IO unit for checksum logging integer :: xs, xe, ys, ye, i, j, sum1, bc, iounit - real :: sum ! The global sum of the array [arbitrary] + real :: sum ! The global sum of the array [A] iounit = error_unit ; if (present(logunit)) iounit = logunit @@ -2284,12 +2284,12 @@ end subroutine chksum2d !> chksum3d does a checksum of all data in a 2-d array. subroutine chksum3d(array, mesg, logunit) - real, dimension(:,:,:), intent(in) :: array !< The array to be checksummed [arbitrary] + real, dimension(:,:,:), intent(in) :: array !< The array to be checksummed in arbitrary units [A] character(len=*), intent(in) :: mesg !< An identifying message integer, optional, intent(in) :: logunit !< IO unit for checksum logging integer :: xs, xe, ys, ye, zs, ze, i, j, k, bc, sum1, iounit - real :: sum ! The global sum of the array [arbitrary] + real :: sum ! The global sum of the array [A] iounit = error_unit ; if (present(logunit)) iounit = logunit @@ -2315,7 +2315,7 @@ end subroutine chksum3d !> This function returns .true. if x is a NaN, and .false. otherwise. function is_NaN_0d(x) - real, intent(in) :: x !< The value to be checked for NaNs [arbitrary] + real, intent(in) :: x !< The value to be checked for NaNs in arbitrary units [A] logical :: is_NaN_0d !is_NaN_0d = (((x < 0.0) .and. (x >= 0.0)) .or. & @@ -2331,7 +2331,7 @@ end function is_NaN_0d !> Returns .true. if any element of x is a NaN, and .false. otherwise. function is_NaN_1d(x, skip_mpp) - real, dimension(:), intent(in) :: x !< The array to be checked for NaNs [arbitrary] + real, dimension(:), intent(in) :: x !< The array to be checked for NaNs in arbitrary units [A] logical, optional, intent(in) :: skip_mpp !< If true, only check this array only !! on the local PE (default false). logical :: is_NaN_1d @@ -2354,7 +2354,7 @@ end function is_NaN_1d !> Returns .true. if any element of x is a NaN, and .false. otherwise. function is_NaN_2d(x) - real, dimension(:,:), intent(in) :: x !< The array to be checked for NaNs [arbitrary] + real, dimension(:,:), intent(in) :: x !< The array to be checked for NaNs in arbitrary units [A] logical :: is_NaN_2d integer :: i, j, n @@ -2371,7 +2371,7 @@ end function is_NaN_2d !> Returns .true. if any element of x is a NaN, and .false. otherwise. function is_NaN_3d(x) - real, dimension(:,:,:), intent(in) :: x !< The array to be checked for NaNs [arbitrary] + real, dimension(:,:,:), intent(in) :: x !< The array to be checked for NaNs in arbitrary units [A] logical :: is_NaN_3d integer :: i, j, k, n @@ -2454,7 +2454,7 @@ function field_checksum_real_2d(field, pelist, mask_val, turns, unscale) & integer(kind=int64) :: chksum !< checksum of array ! Local variables - real, allocatable :: field_rot(:,:) ! A rotated version of field, with the same units [arbitrary] + real, allocatable :: field_rot(:,:) ! A rotated version of field, with the same units [A ~> a] integer :: qturns ! The number of quarter turns through which to rotate field logical :: do_unscale ! If true, unscale the variable before it is checksummed @@ -2494,7 +2494,7 @@ function field_checksum_real_3d(field, pelist, mask_val, turns, unscale) & integer(kind=int64) :: chksum !< checksum of array ! Local variables - real, allocatable :: field_rot(:,:,:) ! A rotated version of field, with the same units [arbitrary] + real, allocatable :: field_rot(:,:,:) ! A rotated version of field, with the same units [A ~> a] integer :: qturns ! The number of quarter turns through which to rotate field logical :: do_unscale ! If true, unscale the variable before it is checksummed @@ -2534,7 +2534,7 @@ function field_checksum_real_4d(field, pelist, mask_val, turns, unscale) & integer(kind=int64) :: chksum !< checksum of array ! Local variables - real, allocatable :: field_rot(:,:,:,:) ! A rotated version of field, with the same units [arbitrary] + real, allocatable :: field_rot(:,:,:,:) ! A rotated version of field, with the same units [A ~> a] integer :: qturns ! The number of quarter turns through which to rotate field logical :: do_unscale ! If true, unscale the variable before it is checksummed @@ -2641,9 +2641,9 @@ end subroutine chk_sum_msg2 subroutine chk_sum_msg3(fmsg, aMean, aMin, aMax, mesg, iounit) character(len=*), intent(in) :: fmsg !< A checksum code-location specific preamble character(len=*), intent(in) :: mesg !< An identifying message supplied by top-level caller - real, intent(in) :: aMean !< The mean value of the array [arbitrary] - real, intent(in) :: aMin !< The minimum value of the array [arbitrary] - real, intent(in) :: aMax !< The maximum value of the array [arbitrary] + real, intent(in) :: aMean !< The mean value of the array in arbitrary units [A] + real, intent(in) :: aMin !< The minimum value of the array [A] + real, intent(in) :: aMax !< The maximum value of the array [A] integer, intent(in) :: iounit !< Checksum logger IO unit ! NOTE: We add zero to aMin and aMax to remove any negative zeros. @@ -2676,7 +2676,7 @@ end subroutine chksum_error !> Does a bitcount of a number by first casting to an integer and then using BTEST !! to check bit by bit integer function bitcount(x) - real, intent(in) :: x !< Number to be bitcount [arbitrary] + real, intent(in) :: x !< Number to be bitcount in arbitrary units [A] integer, parameter :: xk = kind(x) !< Kind type of x diff --git a/src/framework/MOM_coms.F90 b/src/framework/MOM_coms.F90 index be9c9d9586..b0f4f2e575 100644 --- a/src/framework/MOM_coms.F90 +++ b/src/framework/MOM_coms.F90 @@ -359,7 +359,7 @@ function reproducing_sum_3d(array, isr, ier, jsr, jer, sums, EFP_sum, EFP_lay_su integer, optional, intent(in) :: jer !< The ending j-index of the sum, noting !! that the array indices starts at 1 real, dimension(:), optional, intent(out) :: sums !< The sums by vertical layer in the same - !! abitrary units as array [a] or [A ~> a] + !! arbitrary units as array [a] or [A ~> a] type(EFP_type), optional, intent(out) :: EFP_sum !< The result in extended fixed point format type(EFP_type), dimension(:), & optional, intent(out) :: EFP_lay_sums !< The sums by vertical layer in EFP format @@ -796,7 +796,7 @@ end subroutine EFP_assign !> Return the real number that an extended-fixed-point number corresponds with function EFP_to_real(EFP1) type(EFP_type), intent(inout) :: EFP1 !< The extended fixed point number being converted - real :: EFP_to_real !< The real version of the number in abitrary units [a] + real :: EFP_to_real !< The real version of the number in arbitrary units [a] call regularize_ints(EFP1%v) EFP_to_real = ints_to_real(EFP1%v) diff --git a/src/framework/MOM_dyn_horgrid.F90 b/src/framework/MOM_dyn_horgrid.F90 index 2e183cdbef..59edd72f9c 100644 --- a/src/framework/MOM_dyn_horgrid.F90 +++ b/src/framework/MOM_dyn_horgrid.F90 @@ -495,7 +495,7 @@ end subroutine set_derived_dyn_horgrid !> Adcroft_reciprocal(x) = 1/x for |x|>0 or 0 for x=0. function Adcroft_reciprocal(val) result(I_val) - real, intent(in) :: val !< The value being inverted in abitrary units [A ~> a] + real, intent(in) :: val !< The value being inverted in arbitrary units [A ~> a] real :: I_val !< The Adcroft reciprocal of val [A-1 ~> a-1]. I_val = 0.0 ; if (val /= 0.0) I_val = 1.0/val diff --git a/src/framework/MOM_intrinsic_functions.F90 b/src/framework/MOM_intrinsic_functions.F90 index fdafa8503d..5724e330c6 100644 --- a/src/framework/MOM_intrinsic_functions.F90 +++ b/src/framework/MOM_intrinsic_functions.F90 @@ -117,7 +117,7 @@ end function cuberoot !> Rescale `a` to the range [0.125, 1) and compute its cube-root exponent. pure subroutine rescale_cbrt(a, x, e_r, s_a) real, intent(in) :: a - !< The real parameter to be rescaled for cube root in abitrary units cubed [A3] + !< The real parameter to be rescaled for cube root in arbitrary units cubed [A3] real, intent(out) :: x !< The rescaled value of a in the range from 0.125 < asx <= 1.0, in ambiguous units cubed [B3] integer(kind=int64), intent(out) :: e_r @@ -168,7 +168,7 @@ pure function descale(x, e_a, s_a) result(a) integer(kind=int64), intent(in) :: s_a !< Sign bit of the unscaled value real :: a - !< Restored value with the corrected exponent and sign in abitrary units [A] + !< Restored value with the corrected exponent and sign in arbitrary units [A] integer(kind=int64) :: xb ! Bit-packed real number into integer form diff --git a/src/initialization/MOM_grid_initialize.F90 b/src/initialization/MOM_grid_initialize.F90 index 21b8a735d3..ba47206795 100644 --- a/src/initialization/MOM_grid_initialize.F90 +++ b/src/initialization/MOM_grid_initialize.F90 @@ -1135,11 +1135,11 @@ end function Int_dj_dy !> Extrapolates missing metric data into all the halo regions. subroutine extrapolate_metric(var, jh, missing) - real, dimension(:,:), intent(inout) :: var !< The array in which to fill in halos [abitrary] + real, dimension(:,:), intent(inout) :: var !< The array in which to fill in halos in arbitrary units [A] integer, intent(in) :: jh !< The size of the halos to be filled - real, optional, intent(in) :: missing !< The missing data fill value, 0 by default [abitrary] + real, optional, intent(in) :: missing !< The missing data fill value, 0 by default [A] ! Local variables - real :: badval ! A bad data value [abitrary] + real :: badval ! A bad data value [A] integer :: i, j badval = 0.0 ; if (present(missing)) badval = missing @@ -1169,8 +1169,8 @@ end subroutine extrapolate_metric !> This function implements Adcroft's rule for reciprocals, namely that !! Adcroft_Inv(x) = 1/x for |x|>0 or 0 for x=0. function Adcroft_reciprocal(val) result(I_val) - real, intent(in) :: val !< The value being inverted [abitrary] - real :: I_val !< The Adcroft reciprocal of val [abitrary-1] + real, intent(in) :: val !< The value being inverted in arbitrary units [A] + real :: I_val !< The Adcroft reciprocal of val [A-1] I_val = 0.0 if (val /= 0.0) I_val = 1.0/val diff --git a/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 b/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 index 2cff7cf7c8..add367f23e 100644 --- a/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 +++ b/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 @@ -488,7 +488,7 @@ subroutine mixedlayer_restrat_OM4(h, uhtr, vhtr, tv, forces, dt, h_MLD, VarMix, u_star = max(CS%ustar_min, 0.5*(U_star_2d(i,j) + U_star_2d(i+1,j))) absf = 0.5*(abs(G%CoriolisBu(I,J-1)) + abs(G%CoriolisBu(I,J))) - ! Compute I_LFront = 1 / (frontal length scale) [m-1] + ! Compute I_LFront = 1 / (frontal length scale) [L-1 ~> m-1] lfront = 0.5 * (mle_fl_2d(i,j) + mle_fl_2d(i+1,j)) ! Adcroft reciprocal I_LFront = 0.0 ; if (lfront /= 0.0) I_LFront = 1.0/lfront @@ -577,7 +577,7 @@ subroutine mixedlayer_restrat_OM4(h, uhtr, vhtr, tv, forces, dt, h_MLD, VarMix, !$OMP do do J=js-1,je ; do i=is,ie u_star = max(CS%ustar_min, 0.5*(U_star_2d(i,j) + U_star_2d(i,j+1))) - ! Compute I_LFront = 1 / (frontal length scale) [m-1] + ! Compute I_LFront = 1 / (frontal length scale) [L-1 ~> m-1] lfront = 0.5 * (mle_fl_2d(i,j) + mle_fl_2d(i,j+1)) ! Adcroft reciprocal I_LFront = 0.0 ; if (lfront /= 0.0) I_LFront = 1.0/lfront @@ -1183,7 +1183,7 @@ subroutine mixedlayer_restrat_Bodner(CS, G, GV, US, h, uhtr, vhtr, tv, forces, d end subroutine mixedlayer_restrat_Bodner -!> Two time-scale running mean [units of "signal" and "filtered"] +!> Two time-scale running mean in the same arbitrary units as "signal" and "filtered" !! !! If signal > filtered, returns running-mean with time scale "tau_growing". !! If signal <= filtered, returns running-mean with time scale "tau_decaying". @@ -1197,8 +1197,8 @@ end subroutine mixedlayer_restrat_Bodner !! rmean2ts with tau_growing=0 recovers the "resetting running mean" used in OM4. real elemental function rmean2ts(signal, filtered, tau_growing, tau_decaying, dt) ! Arguments - real, intent(in) :: signal ! Unfiltered signal [arbitrary units] - real, intent(in) :: filtered ! Current value of running mean [arbitrary units] + real, intent(in) :: signal ! Unfiltered signal in arbitrary units [A] + real, intent(in) :: filtered ! Current value of running mean in the same arbitrary units [A] real, intent(in) :: tau_growing ! Time scale for growing signal [T ~> s] real, intent(in) :: tau_decaying ! Time scale for decaying signal [T ~> s] real, intent(in) :: dt ! Time step [T ~> s] diff --git a/src/parameterizations/lateral/MOM_spherical_harmonics.F90 b/src/parameterizations/lateral/MOM_spherical_harmonics.F90 index 7606ac3ce1..08b5d0ab12 100644 --- a/src/parameterizations/lateral/MOM_spherical_harmonics.F90 +++ b/src/parameterizations/lateral/MOM_spherical_harmonics.F90 @@ -227,7 +227,7 @@ subroutine spherical_harmonics_init(G, param_file, CS) ! local variables real, parameter :: PI = 4.0*atan(1.0) ! 3.1415926... calculated as 4*atan(1) [nondim] - real, parameter :: RADIAN = PI / 180.0 ! Degree to Radian constant [rad/degree] + real, parameter :: RADIAN = PI / 180.0 ! Degree to Radian constant [radian degree-1] real, dimension(SZI_(G),SZJ_(G)) :: sin_clatT ! sine of colatitude at the t-cells [nondim]. real :: Pmm_coef ! = sqrt{ 1.0/(4.0*PI) * prod[(2k+1)/2k)] } [nondim]. integer :: is, ie, js, je diff --git a/src/parameterizations/vertical/MOM_geothermal.F90 b/src/parameterizations/vertical/MOM_geothermal.F90 index ac12bcdb1b..0ab77c4c6e 100644 --- a/src/parameterizations/vertical/MOM_geothermal.F90 +++ b/src/parameterizations/vertical/MOM_geothermal.F90 @@ -370,7 +370,8 @@ subroutine geothermal_in_place(h, tv, dt, G, GV, US, CS, BFlx_geothermal, halo) real, intent(in) :: dt !< Time increment [T ~> s]. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(geothermal_CS), intent(in) :: CS !< Geothermal heating control struct - real, dimension(SZI_(G), SZJ_(G)), intent(out) :: BFlx_geothermal !< Geothermal Buoyancy Flux [m2 s-3] + real, dimension(SZI_(G), SZJ_(G)), intent(out) :: BFlx_geothermal !< Geothermal buoyancy flux + !! in [Z2 T-3 ~> m2 s-3] integer, optional, intent(in) :: halo !< Halo width over which to work diff --git a/src/tracer/MOM_CFC_cap.F90 b/src/tracer/MOM_CFC_cap.F90 index f9aa421f86..21b29d496c 100644 --- a/src/tracer/MOM_CFC_cap.F90 +++ b/src/tracer/MOM_CFC_cap.F90 @@ -719,7 +719,7 @@ end function CFC_cap_unit_tests logical function compare_values(verbose, test_name, calc, ans, limit) logical, intent(in) :: verbose !< If true, write results to stdout character(len=80), intent(in) :: test_name !< Brief description of the unit test - real, intent(in) :: calc !< computed value in abitrary units [A] + real, intent(in) :: calc !< computed value in arbitrary units [A] real, intent(in) :: ans !< correct value [A] real, intent(in) :: limit !< value above which test fails [A] diff --git a/src/user/MOM_controlled_forcing.F90 b/src/user/MOM_controlled_forcing.F90 index cd7389b961..2335ec73ba 100644 --- a/src/user/MOM_controlled_forcing.F90 +++ b/src/user/MOM_controlled_forcing.F90 @@ -296,7 +296,7 @@ subroutine apply_ctrl_forcing(SST_anom, SSS_anom, SSS_mean, virt_heat, virt_prec m_u2 = periodic_int(m_st - 3.0, CS%num_cycle) m_u3 = periodic_int(m_st - 2.0, CS%num_cycle) - ! These loops restore the units of the CS%avg variables to [degC] or [ppt] + ! These loops restore the units of the CS%avg variables to [C ~> degC] or [S ~> ppt] if (CS%avg_time(m_u1) > 0.0) then do j=js,je ; do i=is,ie CS%avg_SST_anom(i,j,m_u1) = CS%avg_SST_anom(i,j,m_u1) / CS%avg_time(m_u1) From 970e5afdec8280222ab946ca02785e0332f6a32d Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 25 Nov 2025 16:57:51 -0500 Subject: [PATCH 09/64] *Update TC testing parameters for late 2025 Updated the values of about 21 parameters (many of which are repeated across TC test cases) used in the TC testing to test the most recent versions of code that is selected with ANSWER_DATE flags and to avoid testing the buggy versions of code that is regulated by _BUG flags. This includes some changes to broaden the range of equations of state that are being tested and to test some newer versions. This does change the details of the TC tests, but they should (and do) still pass TC regression tests across code versions. --- .testing/tc0/MOM_input | 8 +++++--- .testing/tc1.a/MOM_tc_variant | 5 +++-- .testing/tc1.b/MOM_tc_variant | 10 +++++++--- .testing/tc1/MOM_input | 33 ++++++++++++++++----------------- .testing/tc2/MOM_input | 32 +++++++++++++++++--------------- .testing/tc2/MOM_tc_variant | 3 +++ .testing/tc3/MOM_input | 21 ++++++++++++--------- .testing/tc4/MOM_input | 26 ++++++++++---------------- 8 files changed, 73 insertions(+), 65 deletions(-) diff --git a/.testing/tc0/MOM_input b/.testing/tc0/MOM_input index eacf4143de..17f4826c8c 100644 --- a/.testing/tc0/MOM_input +++ b/.testing/tc0/MOM_input @@ -233,9 +233,11 @@ ENERGYSAVEDAYS = 1.0 DIAG_AS_CHKSUM = True DEBUG = True -GRID_ROTATION_ANGLE_BUGS = True ! [Boolean] default = True -USE_GM_WORK_BUG = True ! [Boolean] default = True + USE_LAND_MASK_FOR_HVISC = False ! [Boolean] default = False GUST_CONST = 0.02 ! [Pa] default = 0.02 -FIX_USTAR_GUSTLESS_BUG = False ! [Boolean] default = False +! These are no longer necessary, as they are using the default value. +GRID_ROTATION_ANGLE_BUGS = False ! [Boolean] default = False +USE_GM_WORK_BUG = False ! [Boolean] default = False +USTAR_GUSTLESS_BUG = False ! [Boolean] default = False diff --git a/.testing/tc1.a/MOM_tc_variant b/.testing/tc1.a/MOM_tc_variant index ff2dabe065..88a38a8fa8 100644 --- a/.testing/tc1.a/MOM_tc_variant +++ b/.testing/tc1.a/MOM_tc_variant @@ -1,2 +1,3 @@ -#override SPLIT=False -#override UNSPLIT_DT_VISC_BUG = True ! [Boolean] default = False +#override SPLIT = False +#override UNSPLIT_DT_VISC_BUG = False ! [Boolean] default = False +#override EQN_OF_STATE = "ROQUET_RHO" ! default = "WRIGHT_FULL" diff --git a/.testing/tc1.b/MOM_tc_variant b/.testing/tc1.b/MOM_tc_variant index 878e582546..7e3d0aa6bd 100644 --- a/.testing/tc1.b/MOM_tc_variant +++ b/.testing/tc1.b/MOM_tc_variant @@ -1,3 +1,7 @@ -#override SPLIT=False -#override USE_RK2=True -#override UNSPLIT_DT_VISC_BUG = True ! [Boolean] default = False +#override SPLIT = False +#override USE_RK2 = True +#override UNSPLIT_DT_VISC_BUG = False ! [Boolean] default = False + +! There may be a problem with one of these settings. +! #override EQN_OF_STATE = "ROQUET_SPV" ! default = "WRIGHT_FULL" +! #override BOUSSINESQ = FALSE diff --git a/.testing/tc1/MOM_input b/.testing/tc1/MOM_input index ea16da62a8..c7add5d5b7 100644 --- a/.testing/tc1/MOM_input +++ b/.testing/tc1/MOM_input @@ -584,28 +584,27 @@ ENERGYSAVEDAYS = 0.125 ! [days] default = 3600.0 DIAG_AS_CHKSUM = True DEBUG = True USE_PSURF_IN_EOS = False ! [Boolean] default = False -GRID_ROTATION_ANGLE_BUGS = True ! [Boolean] default = True INTERPOLATE_RES_FN = True ! [Boolean] default = True GILL_EQUATORIAL_LD = False ! [Boolean] default = False -USE_GM_WORK_BUG = True ! [Boolean] default = True USE_LAND_MASK_FOR_HVISC = False ! [Boolean] default = False -KAPPA_SHEAR_ITER_BUG = True ! [Boolean] default = True -KAPPA_SHEAR_ALL_LAYER_TKE_BUG = True ! [Boolean] default = True -BULKML_CONV_MOMENTUM_BUG = True ! [Boolean] default = True PEN_SW_ABSORB_MINTHICK = 0.001 ! [m] default = 0.001 GUST_CONST = 0.02 ! [Pa] default = 0.02 -FIX_USTAR_GUSTLESS_BUG = False ! [Boolean] default = False -! Explicitly use the defaults from late 2024 -EQN_OF_STATE = "WRIGHT" ! default = "WRIGHT_FULL" -HOR_DIFF_ANSWER_DATE = 20240101 -HOR_DIFF_LIMIT_BUG = True +! Updated defaults reflecting the model status in late 2025 +DRAG_DIFFUSIVITY_ANSWER_DATE = 20251231 +EQN_OF_STATE = "WRIGHT_FULL" ! default = "WRIGHT_FULL" +HOR_DIFF_ANSWER_DATE = 20251231 +MASS_WEIGHT_IN_PRESSURE_GRADIENT_TOP = True ! [Boolean] default = True + +! These are no longer necessary, as they are using the default value. +HOR_DIFF_LIMIT_BUG = False ! [Boolean] default = False +GRID_ROTATION_ANGLE_BUGS = False ! [Boolean] default = False +USE_GM_WORK_BUG = False ! [Boolean] default = False +USTAR_GUSTLESS_BUG = False ! [Boolean] default = False +KAPPA_SHEAR_ITER_BUG = False ! [Boolean] default = False +KAPPA_SHEAR_ALL_LAYER_TKE_BUG = False ! [Boolean] default = False +VISC_REM_BUG = False ! [Boolean] default = False +FRICTWORK_BUG = False ! [Boolean] default = False +BULKML_CONV_MOMENTUM_BUG = False ! [Boolean] default = False -! Explicitly use the defaults from early 2025 -VISC_REM_BUG = True -DRAG_DIFFUSIVITY_ANSWER_DATE = 20250101 -FRICTWORK_BUG = True -HOR_DIFF_ANSWER_DATE = 20240101 -HOR_DIFF_LIMIT_BUG = True -MASS_WEIGHT_IN_PRESSURE_GRADIENT_TOP = False diff --git a/.testing/tc2/MOM_input b/.testing/tc2/MOM_input index 77a2a92678..fea7ca25d1 100644 --- a/.testing/tc2/MOM_input +++ b/.testing/tc2/MOM_input @@ -616,27 +616,29 @@ ENERGYSAVEDAYS = 0.5 ! [days] default = 3600.0 ! energies of the run and other globally summed diagnostics. DIAG_AS_CHKSUM = True DEBUG = True -USE_GM_WORK_BUG = False + USE_PSURF_IN_EOS = False ! [Boolean] default = False -GRID_ROTATION_ANGLE_BUGS = True ! [Boolean] default = True REMAP_UV_USING_OLD_ALG = True ! [Boolean] default = True USE_LAND_MASK_FOR_HVISC = False ! [Boolean] default = False -KAPPA_SHEAR_ITER_BUG = True ! [Boolean] default = True -KAPPA_SHEAR_ALL_LAYER_TKE_BUG = True ! [Boolean] default = True USE_MLD_ITERATION = False ! [Boolean] default = False PEN_SW_ABSORB_MINTHICK = 0.001 ! [m] default = 0.001 GUST_CONST = 0.02 ! [Pa] default = 0.02 -FIX_USTAR_GUSTLESS_BUG = False ! [Boolean] default = False -! Explicitly use the defaults from late 2024 +! Updated defaults reflecting the model status in late 2025 EQN_OF_STATE = "WRIGHT" ! default = "WRIGHT_FULL" -TIDES_ANSWER_DATE = 20230630 -NDIFF_ANSWER_DATE = 20240101 -BACKSCATTER_UNDERBOUND = True +TIDES_ANSWER_DATE = 20251231 +NDIFF_ANSWER_DATE = 20251231 +DRAG_DIFFUSIVITY_ANSWER_DATE = 20251231 +MASS_WEIGHT_IN_PRESSURE_GRADIENT_TOP = True ! [Boolean] default = True + +! These are no longer necessary, as they are using the default value. +GRID_ROTATION_ANGLE_BUGS = False ! [Boolean] default = False +USE_GM_WORK_BUG = False ! [Boolean] default = False +USTAR_GUSTLESS_BUG = False ! [Boolean] default = False +KAPPA_SHEAR_ITER_BUG = False ! [Boolean] default = False +KAPPA_SHEAR_ALL_LAYER_TKE_BUG = False ! [Boolean] default = False +VISC_REM_BUG = False ! [Boolean] default = False +FRICTWORK_BUG = False ! [Boolean] default = False -! Explicitly use the defaults from early 2025 -VISC_REM_BUG = True -DRAG_DIFFUSIVITY_ANSWER_DATE = 20250101 -FRICTWORK_BUG = True -NDIFF_ANSWER_DATE = 20240101 -MASS_WEIGHT_IN_PRESSURE_GRADIENT_TOP = False + +BACKSCATTER_UNDERBOUND = True diff --git a/.testing/tc2/MOM_tc_variant b/.testing/tc2/MOM_tc_variant index 8cdbf69de8..fd7e20784d 100644 --- a/.testing/tc2/MOM_tc_variant +++ b/.testing/tc2/MOM_tc_variant @@ -10,3 +10,6 @@ TIDE_Q1 = True TIDE_MF = True TIDE_MM = True TIDE_SAL_SCALAR_VALUE = 1. +BT_STRONG_DRAG = True ! [Boolean] default = False +RESCALE_STRONG_DRAG = True ! [Boolean] default = False + diff --git a/.testing/tc3/MOM_input b/.testing/tc3/MOM_input index 41ccf286aa..0c6a503db4 100644 --- a/.testing/tc3/MOM_input +++ b/.testing/tc3/MOM_input @@ -473,15 +473,18 @@ ENERGYSAVEDAYS = 3.0 ! [hours] default = 1.44E+04 DIAG_AS_CHKSUM = True DEBUG = True OBC_RADIATION_MAX = 10.0 ! [nondim] default = 10.0 -GRID_ROTATION_ANGLE_BUGS = True ! [Boolean] default = True -USE_GM_WORK_BUG = True ! [Boolean] default = True + USE_LAND_MASK_FOR_HVISC = False ! [Boolean] default = False -KAPPA_SHEAR_ITER_BUG = True ! [Boolean] default = True -KAPPA_SHEAR_ALL_LAYER_TKE_BUG = True ! [Boolean] default = True GUST_CONST = 0.02 ! [Pa] default = 0.02 -FIX_USTAR_GUSTLESS_BUG = False ! [Boolean] default = False -! Explicitly use the defaults from early 2025 -VISC_REM_BUG = True -DRAG_DIFFUSIVITY_ANSWER_DATE = 20250101 -FRICTWORK_BUG = True +! Updated defaults reflecting the model status in late 2025 +DRAG_DIFFUSIVITY_ANSWER_DATE = 20251231 + +! These are no longer necessary, as they are using the default value. +GRID_ROTATION_ANGLE_BUGS = False ! [Boolean] default = False +USE_GM_WORK_BUG = False ! [Boolean] default = False +USTAR_GUSTLESS_BUG = False ! [Boolean] default = False +KAPPA_SHEAR_ITER_BUG = False ! [Boolean] default = False +KAPPA_SHEAR_ALL_LAYER_TKE_BUG = False ! [Boolean] default = False +VISC_REM_BUG = False ! [Boolean] default = False +FRICTWORK_BUG = False ! [Boolean] default = False diff --git a/.testing/tc4/MOM_input b/.testing/tc4/MOM_input index 94ac6a7be8..fc9c42298d 100644 --- a/.testing/tc4/MOM_input +++ b/.testing/tc4/MOM_input @@ -92,10 +92,6 @@ ROTATION = "betaplane" ! default = "2omegasinlat" ! USER - call a user modified routine. F_0 = 1.0E-04 ! [s-1] default = 0.0 ! The reference value of the Coriolis parameter with the betaplane option. -GRID_ROTATION_ANGLE_BUGS = True ! [Boolean] default = False - ! If true, use an older algorithm to calculate the sine and cosines needed - ! rotate between grid-oriented directions and true north and east. Differences - ! arise at the tripolar fold. ! === module MOM_tracer_registry === @@ -234,9 +230,6 @@ KV = 1.0E-04 ! [m2 s-1] ! === module MOM_thickness_diffuse === KHTH = 500.0 ! [m2 s-1] default = 0.0 ! The background horizontal thickness diffusivity. -USE_GM_WORK_BUG = True ! [Boolean] default = False - ! If true, compute the top-layer work tendency on the u-grid with the incorrect - ! sign, for legacy reproducibility. ! === module MOM_porous_barriers === @@ -381,9 +374,6 @@ WIND_CONFIG = "zero" ! ! options include (file), (2gyre), (1gyre), (gyres), (zero), and (USER). GUST_CONST = 0.02 ! [Pa] default = 0.0 ! The background gustiness in the winds. -FIX_USTAR_GUSTLESS_BUG = False ! [Boolean] default = True - ! If true correct a bug in the time-averaging of the gustless wind friction - ! velocity ! === module MOM_main (MOM_driver) === DAYMAX = 0.25 ! [days] @@ -412,11 +402,15 @@ DEBUG = True INTERPOLATE_RES_FN = True ! [Boolean] default = True GILL_EQUATORIAL_LD = False ! [Boolean] default = False USE_LAND_MASK_FOR_HVISC = False ! [Boolean] default = False -KAPPA_SHEAR_ITER_BUG = True ! [Boolean] default = True -KAPPA_SHEAR_ALL_LAYER_TKE_BUG = True ! [Boolean] default = True USE_MLD_ITERATION = False ! [Boolean] default = False -! Explicitly use the defaults from early 2025 -VISC_REM_BUG = True -FRICTWORK_BUG = True -MASS_WEIGHT_IN_PRESSURE_GRADIENT_TOP = False +MASS_WEIGHT_IN_PRESSURE_GRADIENT_TOP = True ! [Boolean] default = True + +! These are no longer necessary, as they are using the default value. +GRID_ROTATION_ANGLE_BUGS = False ! [Boolean] default = False +USE_GM_WORK_BUG = False ! [Boolean] default = False +USTAR_GUSTLESS_BUG = False ! [Boolean] default = False +KAPPA_SHEAR_ITER_BUG = False ! [Boolean] default = False +KAPPA_SHEAR_ALL_LAYER_TKE_BUG = False ! [Boolean] default = False +VISC_REM_BUG = False ! [Boolean] default = False +FRICTWORK_BUG = False ! [Boolean] default = False From 96e186f66f223f622f5eff51b24acc3497566f2b Mon Sep 17 00:00:00 2001 From: Alex Huth Date: Tue, 2 Dec 2025 14:29:14 -0500 Subject: [PATCH 10/64] Added frazil to ice shelf (#985) * Added frazil to ice shelf The frazil mass flux to the ice-shelf base is calculated by multiplying frazil energy [J m-2] by the inverse of the timestep times the latent heat of fusion [kg J-1 s-1]. This frazil mass flux is incorporated as a negative water flux from the ice shelf. This negative water flux then acts to add the frazil mass to the ice shelf base (MOM_ice_shelf.F90/change_thickness_using_melt) and remove it from the ocean surface as evaporation (MOM_ice_shelf.F90/add_shelf_flux). Note frazil is reset to zero at the start of each therm timestep in MOM.F90/step_MOM. Some additional changes were also made to how the ice-shelf flux factor is implemented, so that is only scales ice-shelf melt without affecting the frazil mass flux. * Fixed a commented line where fluxes%water_flux should be ISS%water_flux --- src/ice_shelf/MOM_ice_shelf.F90 | 26 ++++++++++++++++++-------- src/ice_shelf/MOM_marine_ice.F90 | 2 +- 2 files changed, 19 insertions(+), 9 deletions(-) diff --git a/src/ice_shelf/MOM_ice_shelf.F90 b/src/ice_shelf/MOM_ice_shelf.F90 index 8ea1ec3d16..b0a930346b 100644 --- a/src/ice_shelf/MOM_ice_shelf.F90 +++ b/src/ice_shelf/MOM_ice_shelf.F90 @@ -300,6 +300,7 @@ subroutine shelf_calc_flux(sfc_state_in, fluxes_in, Time, time_step_in, CS) real :: Rf_crit !< critical flux Richardson number [nondim] real :: I_2Zeta_N !< Half the inverse of Zeta_N [nondim]. real :: I_LF !< The inverse of the latent heat of fusion [Q-1 ~> kg J-1]. + real :: I_dt_LHF ! The inverse of the timestep times the latent heat of fusion [Q-1 T-1 ~> kg J-1 s-1]. real :: I_VK !< The inverse of the Von Karman constant [nondim]. real :: PR, SC !< The Prandtl number and Schmidt number [nondim]. @@ -406,6 +407,7 @@ subroutine shelf_calc_flux(sfc_state_in, fluxes_in, Time, time_step_in, CS) Rf_crit = CS%Rc I_2Zeta_N = 0.5 / CS%Zeta_N I_LF = 1.0 / CS%Lat_fusion + I_dt_LHF = 1.0 / (time_step * CS%Lat_fusion) SC = CS%kv_molec/CS%kd_molec_salt PR = CS%kv_molec/CS%kd_molec_temp I_VK = 1.0/VK @@ -817,7 +819,12 @@ subroutine shelf_calc_flux(sfc_state_in, fluxes_in, Time, time_step_in, CS) do j=js,je ; do i=is,ie ! ISS%water_flux = net liquid water into the ocean [R Z T-1 ~> kg m-2 s-1] - fluxes%iceshelf_melt(i,j) = ISS%water_flux(i,j) * CS%flux_factor + if (CS%flux_factor/=1.0) then + ISS%water_flux(i,j) = ISS%water_flux(i,j) * CS%flux_factor + ISS%tflux_ocn(i,j) = ISS%tflux_ocn(i,j) * CS%flux_factor + if (CS%threeeq .and. ISS%tflux_ocn(i,j) < 0.0 .and. (.not. CS%insulator)) & + ISS%tflux_shelf(i,j)=ISS%tflux_ocn(i,j) + CS%Lat_fusion * ISS%water_flux(i,j) + endif if ((sfc_state%ocean_mass(i,j) > CS%col_mass_melt_threshold) .and. & (ISS%area_shelf_h(i,j) > 0.0) .and. (CS%isthermo)) then @@ -826,7 +833,6 @@ subroutine shelf_calc_flux(sfc_state_in, fluxes_in, Time, time_step_in, CS) ! This is needed for the ISOMIP test case. if (ISS%mass_shelf(i,j) < CS%Rho_ocn*CS%cutoff_depth) then ISS%water_flux(i,j) = 0.0 - fluxes%iceshelf_melt(i,j) = 0.0 endif ! Compute haline driving, which is one of the diags. used in ISOMIP if (exch_vel_s(i,j)>0.) haline_driving(i,j) = (ISS%water_flux(i,j) * Sbdry(i,j)) / (CS%Rho_ocn * exch_vel_s(i,j)) @@ -834,7 +840,7 @@ subroutine shelf_calc_flux(sfc_state_in, fluxes_in, Time, time_step_in, CS) !!!!!!!!!!!!!!!!!!!!!!!!!!!!Safety checks !!!!!!!!!!!!!!!!!!!!!!!!! !1)Check if haline_driving computed above is consistent with ! haline_driving = sfc_state%sss - Sbdry - !if (fluxes%iceshelf_melt(i,j) /= 0.0) then + !if (ISS%water_flux(i,j) /= 0.0) then ! if (haline_driving(i,j) /= (sfc_state%sss(i,j) - Sbdry(i,j))) then ! write(mesg,*) 'at i,j=',i,j,' haline_driving, sss-Sbdry',US%S_to_ppt*haline_driving(i,j), & ! US%S_to_ppt*(sfc_state%sss(i,j) - Sbdry(i,j)) @@ -845,8 +851,8 @@ subroutine shelf_calc_flux(sfc_state_in, fluxes_in, Time, time_step_in, CS) ! 2) check if |melt| > 0 when ustar_shelf = 0. ! this should never happen - if ((abs(fluxes%iceshelf_melt(i,j))>0.0) .and. (fluxes%ustar_shelf(i,j) == 0.0)) then - write(mesg,*) "|melt| = ",fluxes%iceshelf_melt(i,j)," > 0 and ustar_shelf = 0. at i,j", i, j + if ((abs(ISS%water_flux(i,j))>0.0) .and. (fluxes%ustar_shelf(i,j) == 0.0)) then + write(mesg,*) "|melt| = ",ISS%water_flux(i,j)," > 0 and ustar_shelf = 0. at i,j", i, j call MOM_error(FATAL, "shelf_calc_flux: "//trim(mesg)) endif !!!!!!!!!!!!!!!!!!!!!!!!!!!!End of safety checks !!!!!!!!!!!!!!!!!!! @@ -854,11 +860,15 @@ subroutine shelf_calc_flux(sfc_state_in, fluxes_in, Time, time_step_in, CS) ! This is grounded ice, that could be modified to melt if a geothermal heat flux were used. haline_driving(i,j) = 0.0 ISS%water_flux(i,j) = 0.0 - fluxes%iceshelf_melt(i,j) = 0.0 endif ! area_shelf_h ! mass flux [R Z L2 T-1 ~> kg s-1], part of ISOMIP diags. mass_flux(i,j) = ISS%water_flux(i,j) * ISS%area_shelf_h(i,j) + + !Add frazil formation + if (ISS%hmask(i,j) == 1 .or. ISS%hmask(i,j) == 2) & + ISS%water_flux(i,j) = ISS%water_flux(i,j) - sfc_state%frazil(i,j) * I_dt_LHF + fluxes%iceshelf_melt(i,j) = ISS%water_flux(i,j) enddo ; enddo ! i- and j-loops if (CS%active_shelf_dynamics .or. CS%override_shelf_movement) then @@ -1309,10 +1319,10 @@ subroutine add_shelf_flux(G, US, CS, sfc_state, fluxes, time_step) if (associated(fluxes%evap)) fluxes%evap(i,j) = frac_open * fluxes%evap(i,j) if (associated(fluxes%lprec)) then if (ISS%water_flux(i,j) > 0.0) then - fluxes%lprec(i,j) = frac_shelf*ISS%water_flux(i,j)*CS%flux_factor + frac_open * fluxes%lprec(i,j) + fluxes%lprec(i,j) = frac_shelf*ISS%water_flux(i,j) + frac_open * fluxes%lprec(i,j) else fluxes%lprec(i,j) = frac_open * fluxes%lprec(i,j) - fluxes%evap(i,j) = fluxes%evap(i,j) + frac_shelf*ISS%water_flux(i,j)*CS%flux_factor + fluxes%evap(i,j) = fluxes%evap(i,j) + frac_shelf*ISS%water_flux(i,j) endif endif diff --git a/src/ice_shelf/MOM_marine_ice.F90 b/src/ice_shelf/MOM_marine_ice.F90 index 3fec94e499..f718fcc81f 100644 --- a/src/ice_shelf/MOM_marine_ice.F90 +++ b/src/ice_shelf/MOM_marine_ice.F90 @@ -110,7 +110,7 @@ subroutine iceberg_fluxes(G, US, fluxes, use_ice_shelf, sfc_state, time_step, CS type(marine_ice_CS), pointer :: CS !< Pointer to the control structure for MOM_marine_ice real :: fraz ! refreezing rate [R Z T-1 ~> kg m-2 s-1] - real :: I_dt_LHF ! The inverse of the timestep times the latent heat of fusion times [Q-1 T-1 ~> kg J-1 s-1]. + real :: I_dt_LHF ! The inverse of the timestep times the latent heat of fusion [Q-1 T-1 ~> kg J-1 s-1]. integer :: i, j, is, ie, js, je, isd, ied, jsd, jed is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec isd = G%isd ; jsd = G%jsd ; ied = G%ied ; jed = G%jed From 196e491749f09bfa84b9bbfbb2ced339e8b18c2f Mon Sep 17 00:00:00 2001 From: Alistair Adcroft Date: Wed, 5 Nov 2025 14:37:49 -0500 Subject: [PATCH 11/64] Extend the PGF reconstruction to allow PLM-WLS The PLM reconstruction used within the pressure gradient force now supports the weighted least squares approach for slope estimation. In a catastrophic version of seamount/z where vanished layers slightly inflate, the regular finite volume PLM method is sensitive to values in the vanished layers and leads to a feedback that causes en error growth (spontaneous motion). The PLM-WLS method is insensitive to the vanished layers and in the same test leads only to round-off level noise in the flow. --- src/ALE/MOM_ALE.F90 | 41 +++++++++++++++++++++++++++++++ src/core/MOM_PressureForce_FV.F90 | 13 +++++++--- 2 files changed, 50 insertions(+), 4 deletions(-) diff --git a/src/ALE/MOM_ALE.F90 b/src/ALE/MOM_ALE.F90 index 0997391cf3..2f763c7827 100644 --- a/src/ALE/MOM_ALE.F90 +++ b/src/ALE/MOM_ALE.F90 @@ -53,6 +53,7 @@ module MOM_ALE use PLM_functions, only : PLM_reconstruction, PLM_boundary_extrapolation use PLM_functions, only : PLM_extrapolate_slope, PLM_monotonized_slope, PLM_slope_wa use PPM_functions, only : PPM_reconstruction, PPM_boundary_extrapolation +use Recon1d_PLM_WLS, only : PLM_WLS implicit none ; private #include @@ -140,6 +141,7 @@ module MOM_ALE public ALE_PLM_edge_values public TS_PLM_edge_values public TS_PPM_edge_values +public TS_PLM_WLS_edge_values public adjustGridForIntegrity public ALE_initRegridding public ALE_getCoordinate @@ -1670,6 +1672,45 @@ subroutine TS_PPM_edge_values( CS, S_t, S_b, T_t, T_b, G, GV, tv, h, bdry_extrap end subroutine TS_PPM_edge_values +!> Calculate edge values (top and bottom of layer) for T and S consistent with a PLM reconstruction +!! in the vertical direction that uses weighted least squares for the slope. +subroutine TS_PLM_WLS_edge_values(CS, S_t, S_b, T_t, T_b, G, GV, tv, h) + type(ocean_grid_type), intent(in) :: G !< ocean grid structure + type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure + type(ALE_CS), intent(inout) :: CS !< module control structure + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & + intent(inout) :: S_t !< Salinity at the top edge of each layer [S ~> ppt] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & + intent(inout) :: S_b !< Salinity at the bottom edge of each layer [S ~> ppt] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & + intent(inout) :: T_t !< Temperature at the top edge of each layer [C ~> degC] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & + intent(inout) :: T_b !< Temperature at the bottom edge of each layer [C ~> degC] + type(thermo_var_ptrs), intent(in) :: tv !< thermodynamics structure + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & + intent(in) :: h !< layer thickness [H ~> m or kg m-2] + ! Local variables + integer :: i, j, k + type(PLM_WLS) :: recon !< A PLM-WLS reconstruction + + call recon%init(GV%ke, h_neglect=GV%H_subroundoff) + + !$OMP parallel do default(shared) firstprivate(recon) + do j = G%jsc-1,G%jec+1 ; do i = G%isc-1,G%iec+1 + + call recon%reconstruct(h(i,j,:), tv%T(i,j,:)) + T_t(i,j,:) = recon%ul(:) + T_b(i,j,:) = recon%ur(:) + + call recon%reconstruct(h(i,j,:), tv%S(i,j,:)) + S_t(i,j,:) = recon%ul(:) + S_b(i,j,:) = recon%ur(:) + + enddo ; enddo + + call recon%destroy() + +end subroutine TS_PLM_WLS_edge_values !> Initializes regridding for the main ALE algorithm subroutine ALE_initRegridding(G, GV, US, max_depth, param_file, mdl, regridCS) diff --git a/src/core/MOM_PressureForce_FV.F90 b/src/core/MOM_PressureForce_FV.F90 index 6acdddf0a1..0f5e536c38 100644 --- a/src/core/MOM_PressureForce_FV.F90 +++ b/src/core/MOM_PressureForce_FV.F90 @@ -22,7 +22,7 @@ module MOM_PressureForce_FV use MOM_density_integrals, only : int_spec_vol_dp_generic_plm use MOM_density_integrals, only : int_density_dz_generic_pcm, int_spec_vol_dp_generic_pcm use MOM_density_integrals, only : diagnose_mass_weight_Z, diagnose_mass_weight_p -use MOM_ALE, only : TS_PLM_edge_values, TS_PPM_edge_values, ALE_CS +use MOM_ALE, only : TS_PLM_edge_values, TS_PPM_edge_values, TS_PLM_WLS_edge_values, ALE_CS implicit none ; private @@ -353,6 +353,8 @@ subroutine PressureForce_FV_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, AD call TS_PLM_edge_values(ALE_CSp, S_t, S_b, T_t, T_b, G, GV, tv, h, CS%boundary_extrap) elseif ( use_ALE .and. (CS%Recon_Scheme == 2) ) then call TS_PPM_edge_values(ALE_CSp, S_t, S_b, T_t, T_b, G, GV, tv, h, CS%boundary_extrap) + elseif ( use_ALE .and. (CS%Recon_Scheme == 3) ) then + call TS_PLM_WLS_edge_values(ALE_CSp, S_t, S_b, T_t, T_b, G, GV, tv, h) elseif (CS%reset_intxpa_integral) then do k=1,nz ; do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 T_b(i,j,k) = tv%T(i,j,k) ; S_b(i,j,k) = tv%S(i,j,k) @@ -365,7 +367,7 @@ subroutine PressureForce_FV_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, AD ! subsequent calculation. if (use_EOS) then if ( use_ALE .and. CS%Recon_Scheme > 0 ) then - if ( CS%Recon_Scheme == 1 ) then + if ( CS%Recon_Scheme == 1 .or. CS%Recon_Scheme == 3 ) then call int_spec_vol_dp_generic_plm( T_t(:,:,k), T_b(:,:,k), S_t(:,:,k), S_b(:,:,k), & p(:,:,K), p(:,:,K+1), alpha_ref, dp_neglect, p(:,:,nz+1), G%HI, & tv%eqn_of_state, US, dza(:,:,k), intp_dza(:,:,k), intx_dza(:,:,k), inty_dza(:,:,k), & @@ -1240,6 +1242,8 @@ subroutine PressureForce_FV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, ADp, call TS_PLM_edge_values(ALE_CSp, S_t, S_b, T_t, T_b, G, GV, tv, h, CS%boundary_extrap) elseif ( use_ALE .and. (CS%Recon_Scheme == 2) ) then call TS_PPM_edge_values(ALE_CSp, S_t, S_b, T_t, T_b, G, GV, tv, h, CS%boundary_extrap) + elseif ( use_ALE .and. (CS%Recon_Scheme == 3) ) then + call TS_PLM_WLS_edge_values(ALE_CSp, S_t, S_b, T_t, T_b, G, GV, tv, h) elseif (CS%reset_intxpa_integral) then do k=1,nz ; do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 T_b(i,j,k) = tv%T(i,j,k) ; S_b(i,j,k) = tv%S(i,j,k) @@ -1285,7 +1289,7 @@ subroutine PressureForce_FV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, ADp, ! is used, whereby densities within each layer are constant no matter ! where the layers are located. if ( use_ALE .and. CS%Recon_Scheme > 0 ) then - if ( CS%Recon_Scheme == 1 ) then + if ( CS%Recon_Scheme == 1 .or. CS%Recon_Scheme == 3 ) then call int_density_dz_generic_plm(k, tv, T_t, T_b, S_t, S_b, e, & rho_ref, rho0_int_density, GV%g_Earth, dz_neglect, G%bathyT, & G%HI, GV, tv%eqn_of_state, US, CS%use_stanley_pgf, dpa(:,:,k), intz_dpa(:,:,k), & @@ -2183,7 +2187,8 @@ subroutine PressureForce_FV_init(Time, G, GV, US, param_file, diag, CS, ADp, SAL "integrals within the FV pressure gradient calculation.\n"//& " 0: PCM or no reconstruction.\n"//& " 1: PLM reconstruction.\n"//& - " 2: PPM reconstruction.", default=1) + " 2: PPM reconstruction.\n"//& + " 3: PLM with least squares slope.", default=1) call get_param(param_file, mdl, "BOUNDARY_EXTRAPOLATION_PRESSURE", CS%boundary_extrap, & "If true, the reconstruction of T & S for pressure in "//& "boundary cells is extrapolated, rather than using PCM "//& From f2c89173d0b5446c30ddcc1e7cdb690f27fbd6e5 Mon Sep 17 00:00:00 2001 From: Chengzhu Xu <135884058+c2xu@users.noreply.github.com> Date: Wed, 3 Dec 2025 13:58:35 -0400 Subject: [PATCH 12/64] Spatially varying bottom drag coefficient (#983) * Spatially varying bottom drag coefficient The spatially varying bottom drag coefficient can be specified by providing a map of the spatially varying scaling factor. * Spatially varying bottom drag coefficient Fixed the inconsistency at open boundaries when CDRAG_MAP is true. --- .../vertical/MOM_set_viscosity.F90 | 85 +++++++++++++++++-- 1 file changed, 77 insertions(+), 8 deletions(-) diff --git a/src/parameterizations/vertical/MOM_set_viscosity.F90 b/src/parameterizations/vertical/MOM_set_viscosity.F90 index 6466b71dd5..8293b4ccde 100644 --- a/src/parameterizations/vertical/MOM_set_viscosity.F90 +++ b/src/parameterizations/vertical/MOM_set_viscosity.F90 @@ -75,6 +75,8 @@ module MOM_set_visc !! actual velocity in the bottommost `HBBL`, depending !! on whether linear_drag is true. !! Runtime parameter `BOTTOMDRAGLAW`. + logical :: bottomdragmap !< If true, apply the spatially varying drag coefficient (cdrag_2d) + !! instead of the spatially uniform drag coefficient (cdrag). logical :: body_force_drag !< If true, the bottom stress is imposed as an explicit body force !! applied over a fixed distance from the bottom, rather than as an !! implicit calculation based on an enhanced near-bottom viscosity. @@ -117,6 +119,8 @@ module MOM_set_visc type(diag_ctrl), pointer :: diag => NULL() !< A structure that is used to !! regulate the timing of diagnostic output. ! Allocatable data arrays + real, allocatable, dimension(:,:) :: cdrag_u !< The spatially varying quadratic drag coefficient [nondim] + real, allocatable, dimension(:,:) :: cdrag_v !< The spatially varying quadratic drag coefficient [nondim] real, allocatable, dimension(:,:) :: tideamp !< RMS tidal amplitude at h points [Z T-1 ~> m s-1] ! Diagnostic arrays real, allocatable, dimension(:,:) :: bbl_u !< BBL mean U current [L T-1 ~> m s-1] @@ -207,6 +211,7 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, pbv) real :: ustarsq ! 400 times the square of ustar, times ! Rho0 divided by G_Earth and the conversion ! from m to thickness units [H R ~> kg m-2 or kg2 m-5]. + real :: cdrag ! The drag coefficient [nondim]. real :: cdrag_sqrt ! Square root of the drag coefficient [nondim]. real :: cdrag_sqrt_H ! Square root of the drag coefficient, times a unit conversion factor ! from lateral lengths to layer thicknesses [H L-1 ~> nondim or kg m-3]. @@ -340,11 +345,13 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, pbv) use_BBL_EOS = associated(tv%eqn_of_state) .and. CS%BBL_use_EOS OBC => CS%OBC - cdrag_sqrt = sqrt(CS%cdrag) - cdrag_sqrt_H = cdrag_sqrt * US%L_to_m * GV%m_to_H - cdrag_sqrt_H_RL = cdrag_sqrt * US%L_to_Z * GV%RZ_to_H - cdrag_L_to_H = CS%cdrag * US%L_to_m * GV%m_to_H - cdrag_RL_to_H = CS%cdrag * US%L_to_Z * GV%RZ_to_H + if (.not.CS%bottomdragmap) then + cdrag_sqrt = sqrt(CS%cdrag) + cdrag_sqrt_H = cdrag_sqrt * US%L_to_m * GV%m_to_H + cdrag_sqrt_H_RL = cdrag_sqrt * US%L_to_Z * GV%RZ_to_H + cdrag_L_to_H = CS%cdrag * US%L_to_m * GV%m_to_H + cdrag_RL_to_H = CS%cdrag * US%L_to_Z * GV%RZ_to_H + endif BBL_thick_max = G%Rad_Earth_L * US%L_to_Z K2 = max(nkmb+1, 2) @@ -629,6 +636,16 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, pbv) dztot_vel = 0.0 ; dzwtot = 0.0 Thtot = 0.0 ; Shtot = 0.0 ; SpV_htot = 0.0 + if (CS%bottomdragmap) then + if (m==1) then + cdrag_sqrt = sqrt(CS%cdrag_u(i,j)) + else + cdrag_sqrt = sqrt(CS%cdrag_v(i,j)) + endif + cdrag_sqrt_H = cdrag_sqrt * US%L_to_m * GV%m_to_H + cdrag_sqrt_H_RL = cdrag_sqrt * US%L_to_Z * GV%RZ_to_H + endif + do k=nz,1,-1 if (htot_vel>=CS%Hbbl) exit ! terminate the k loop @@ -692,7 +709,17 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, pbv) endif ; enddo else - do i=is,ie ; ustar(i) = cdrag_sqrt_H*CS%drag_bg_vel ; enddo + do i=is,ie + if (CS%bottomdragmap) then + if (m==1) then + cdrag_sqrt = sqrt(CS%cdrag_u(i,j)) + else + cdrag_sqrt = sqrt(CS%cdrag_v(i,j)) + endif + cdrag_sqrt_H = cdrag_sqrt * US%L_to_m * GV%m_to_H + endif + ustar(i) = cdrag_sqrt_H * CS%drag_bg_vel + enddo endif ! Not linear_drag if (use_BBL_EOS) then @@ -723,6 +750,16 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, pbv) htot = 0.0 dztot = 0.0 + if (CS%bottomdragmap) then + if (m==1) then + cdrag = CS%cdrag_u(i,j) + else + cdrag = CS%cdrag_v(i,j) + endif + cdrag_L_to_H = cdrag * US%L_to_m * GV%m_to_H + cdrag_RL_to_H = cdrag * US%L_to_Z * GV%RZ_to_H + endif + ! Calculate the thickness of a stratification limited BBL ignoring rotation: ! h_N = Ci u* / N (limit of KW99 eq. 2.20 for |f|->0) ! For layer mode, N^2 = g'/h. Since (Ci u*)^2 = (h_N N)^2 = h_N g' then @@ -2899,6 +2936,7 @@ subroutine set_visc_init(Time, G, GV, US, param_file, diag, visc, CS, restart_CS ! is used in place of the absolute value of the local Coriolis ! parameter in the denominator of some expressions [nondim] real :: Chan_max_thick_dflt ! The default value for CHANNEL_DRAG_MAX_THICK [Z ~> m] + real, allocatable, dimension(:,:) :: cdrag_h !< The spatially varying quadratic drag coefficient [nondim] integer :: i, j, k, is, ie, js, je integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB, nz @@ -2909,8 +2947,8 @@ subroutine set_visc_init(Time, G, GV, US, param_file, diag, visc, CS, restart_CS ! isopycnal or stacked shallow water mode. logical :: use_temperature ! If true, temperature and salinity are used as state variables. logical :: use_EOS ! If true, density calculated from T & S using an equation of state. - character(len=200) :: filename, tideamp_file ! Input file names or paths - character(len=80) :: tideamp_var ! Input file variable names + character(len=200) :: filename, cdrag_file, tideamp_file ! Input file names or paths + character(len=80) :: cdrag_var, tideamp_var ! Input file variable names ! This include declares and sets the variable "version". # include "version_variable.h" character(len=40) :: mdl = "MOM_set_visc" ! This module's name. @@ -3026,6 +3064,16 @@ subroutine set_visc_init(Time, G, GV, US, param_file, diag, visc, CS, restart_CS "CDRAG is the drag coefficient relating the magnitude of "//& "the velocity field to the bottom stress. CDRAG is only "//& "used if BOTTOMDRAGLAW is defined.", units="nondim", default=0.003) + call get_param(param_file, mdl, "CDRAG_MAP", CS%bottomdragmap, & + "If true, apply a spatially varying scaling factor to CDRAG, "//& + "specified by CDRAG_VAR in CDRAG_FILE.", default=.false.) + call get_param(param_file, mdl, "CDRAG_FILE", cdrag_file, & + "The name of the file with the spatially varying bottom drag "//& + "scaling factor.", default="", do_not_log=.not.CS%bottomdragmap) + call get_param(param_file, mdl, "CDRAG_VAR", cdrag_var, & + "The name of the variable in CDRAG_FILE with the spatially "//& + "varying bottom drag scaling factor at h points.", & + default="", do_not_log=.not.CS%bottomdragmap) call get_param(param_file, mdl, "BBL_USE_TIDAL_BG", CS%BBL_use_tidal_bg, & "Flag to use the tidal RMS amplitude in place of constant "//& "background velocity for computing u* in the BBL. "//& @@ -3171,6 +3219,27 @@ subroutine set_visc_init(Time, G, GV, US, param_file, diag, visc, CS, restart_CS if (CS%id_bbl_v>0) then allocate(CS%bbl_v(isd:ied,JsdB:JedB), source=0.0) endif + if (CS%bottomdragmap) then + if (len_trim(cdrag_file)==0 .or. len_trim(cdrag_var)==0) then + call MOM_error(FATAL,"CDRAG_FILE and CDRAG_VAR are required when using CDRAG_MAP.") + endif + allocate(cdrag_h(isd:ied,jsd:jed), source=0.0) + allocate(CS%cdrag_u(IsdB:IedB,jsd:jed), source=0.0) + allocate(CS%cdrag_v(isd:ied,JsdB:JedB), source=0.0) + filename = trim(CS%inputdir) // trim(cdrag_file) + call log_param(param_file, mdl, "INPUTDIR/CDRAG_FILE", filename) + call MOM_read_data(filename, cdrag_var, cdrag_h, G%domain, scale=CS%cdrag) + call pass_var(cdrag_h, G%domain) + do j=js,je ; do I=is-1,ie ; if (G%mask2dCu(I,j) > 0) then + CS%cdrag_u(I,j) = (G%mask2dT(i,j) * cdrag_h(i,j) + G%mask2dT(i+1,j) * cdrag_h(i+1,j)) / & + (G%mask2dT(i,j) + G%mask2dT(i+1,j)) + endif ; enddo ; enddo + do J=js-1,je ; do i=is,ie ; if (G%mask2dCv(i,J) > 0) then + CS%cdrag_v(i,J) = (G%mask2dT(i,j) * cdrag_h(i,j) + G%mask2dT(i,j+1) * cdrag_h(i,j+1)) / & + (G%mask2dT(i,j) + G%mask2dT(i,j+1)) + endif ; enddo ; enddo + deallocate(cdrag_h) + endif if (CS%BBL_use_tidal_bg) then allocate(CS%tideamp(isd:ied,jsd:jed), source=0.0) filename = trim(CS%inputdir) // trim(tideamp_file) From ba6032bcd69596c5a45a1676efd64eaf4c5f457d Mon Sep 17 00:00:00 2001 From: He Wang Date: Wed, 24 Sep 2025 14:22:46 -0400 Subject: [PATCH 13/64] Correction on total column thickness for wetting In a number of cases, total resting column thickness is calucated as G%bathyT + G%Z_ref, which is largely correct but for wetting, i.e. G%bathyT < 0. This commit makes a correction for seven cases with this potential bug. There is no answer changes if no wetting points are used and G%Z_ref is zero. List of modules/processes affected: * MOM_barotropic * affects only surface stress when BT_NONLIN_STRESS is False. * MOM_wave_speed * h2 calculations in * subroutine internal_tides_init * subroutine int_tide_input_int * subroutine tidal_mixing_init * MOM_lateral_mixing_coeffs * MOM_MEKE --- src/ALE/MOM_hybgen_unmix.F90 | 2 +- src/core/MOM_barotropic.F90 | 11 +++++++---- src/diagnostics/MOM_wave_speed.F90 | 4 ++-- src/parameterizations/lateral/MOM_MEKE.F90 | 4 ++-- src/parameterizations/lateral/MOM_internal_tides.F90 | 2 +- .../lateral/MOM_lateral_mixing_coeffs.F90 | 6 ++++-- .../vertical/MOM_internal_tide_input.F90 | 2 +- src/parameterizations/vertical/MOM_tidal_mixing.F90 | 2 +- 8 files changed, 19 insertions(+), 14 deletions(-) diff --git a/src/ALE/MOM_hybgen_unmix.F90 b/src/ALE/MOM_hybgen_unmix.F90 index bb6f64c4d7..d87762b721 100644 --- a/src/ALE/MOM_hybgen_unmix.F90 +++ b/src/ALE/MOM_hybgen_unmix.F90 @@ -214,7 +214,7 @@ subroutine hybgen_unmix(G, GV, US, CS, tv, Reg, ntr, h) endif ! The following block of code is used to trigger z* stretching of the targets heights. - if (allocated(tv%SpV_avg)) then ! This is the fully non-Boussiesq version + if (allocated(tv%SpV_avg)) then ! This is the fully non-Boussinesq version dz_tot = 0.0 do k=1,nk dz_tot = dz_tot + GV%H_to_RZ * tv%SpV_avg(i,j,k) * h_col(k) diff --git a/src/core/MOM_barotropic.F90 b/src/core/MOM_barotropic.F90 index ac2e668f8e..777b45026a 100644 --- a/src/core/MOM_barotropic.F90 +++ b/src/core/MOM_barotropic.F90 @@ -5533,6 +5533,7 @@ subroutine barotropic_init(u, v, h, Time, G, GV, US, param_file, diag, CS, & ! name in wave_drag_file. real :: mean_SL ! The mean sea level that is used along with the bathymetry to estimate the ! geometry when LINEARIZED_BT_CORIOLIS is true or BT_NONLIN_STRESS is false [Z ~> m]. + real :: htot ! Total column thickness used when BT_NONLIN_STRESS is false [Z ~> m]. real :: Z_to_H ! A local unit conversion factor [H Z-1 ~> nondim or kg m-3] real :: H_to_Z ! A local unit conversion factor [Z H-1 ~> nondim or m3 kg-1] real :: det_de ! The partial derivative due to self-attraction and loading of the reference @@ -6437,15 +6438,17 @@ subroutine barotropic_init(u, v, h, Time, G, GV, US, param_file, diag, CS, & Mean_SL = G%Z_ref Z_to_H = GV%Z_to_H ; if (.not.GV%Boussinesq) Z_to_H = GV%RZ_to_H * CS%Rho_BT_lin do j=js,je ; do I=is-1,ie - if (G%OBCmaskCu(I,j) > 0.) then - CS%IDatu(I,j) = G%OBCmaskCu(I,j) * 2.0 / (Z_to_H * ((G%bathyT(i+1,j) + G%bathyT(i,j)) + 2.0*Mean_SL)) + htot = max(G%bathyT(i+1,j) + G%Z_ref, 0.0) + max(G%bathyT(i,j) + G%Z_ref, 0.0) + if (G%OBCmaskCu(I,j) * htot > 0.) then + CS%IDatu(I,j) = G%OBCmaskCu(I,j) * 2.0 / (Z_to_H * htot) else ! Both neighboring H points are masked out or this is an OBC face so IDatu(I,j) is unused CS%IDatu(I,j) = 0. endif enddo ; enddo do J=js-1,je ; do i=is,ie - if (G%OBCmaskCv(i,J) > 0.) then - CS%IDatv(i,J) = G%OBCmaskCv(i,J) * 2.0 / (Z_to_H * ((G%bathyT(i,j+1) + G%bathyT(i,j)) + 2.0*Mean_SL)) + htot = max(G%bathyT(i,j+1) + G%Z_ref, 0.0) + max(G%bathyT(i,j) + G%Z_ref, 0.0) + if (G%OBCmaskCv(i,J) * htot > 0.) then + CS%IDatv(i,J) = G%OBCmaskCv(i,J) * 2.0 / (Z_to_H * htot) else ! Both neighboring H points are masked out or this is an OBC face so IDatv(i,J) is unused CS%IDatv(i,J) = 0. endif diff --git a/src/diagnostics/MOM_wave_speed.F90 b/src/diagnostics/MOM_wave_speed.F90 index 7abdab0a90..b525efd149 100644 --- a/src/diagnostics/MOM_wave_speed.F90 +++ b/src/diagnostics/MOM_wave_speed.F90 @@ -550,8 +550,8 @@ subroutine wave_speed(h, tv, G, GV, US, cg1, CS, halo_size, use_ebt_mode, mono_N ! Determine whether N2 estimates should not be allowed to increase with depth. if (l_mono_N2_column_fraction>0.) then if (GV%Boussinesq .or. GV%semi_Boussinesq) then - below_mono_N2_frac = ((G%bathyT(i,j)+G%Z_ref) - GV%H_to_Z*sum_hc < & - l_mono_N2_column_fraction*(G%bathyT(i,j)+G%Z_ref)) + below_mono_N2_frac = (max(G%bathyT(i,j)+G%Z_ref, 0.0) - GV%H_to_Z*sum_hc < & + l_mono_N2_column_fraction*max(G%bathyT(i,j)+G%Z_ref, 0.0)) else below_mono_N2_frac = (htot(i) - sum_hc < l_mono_N2_column_fraction*htot(i)) endif diff --git a/src/parameterizations/lateral/MOM_MEKE.F90 b/src/parameterizations/lateral/MOM_MEKE.F90 index 41c98884ba..7abc24fe2d 100644 --- a/src/parameterizations/lateral/MOM_MEKE.F90 +++ b/src/parameterizations/lateral/MOM_MEKE.F90 @@ -372,12 +372,12 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h if (GV%Boussinesq) then !$OMP parallel do default(shared) do j=js-1,je+1 ; do i=is-1,ie+1 - depth_tot(i,j) = (G%bathyT(i,j) + G%Z_ref) * GV%Z_to_H + depth_tot(i,j) = max(G%bathyT(i,j) + G%Z_ref, 0.0) * GV%Z_to_H enddo ; enddo else !$OMP parallel do default(shared) do j=js-1,je+1 ; do i=is-1,ie+1 - depth_tot(i,j) = (G%bathyT(i,j) + G%Z_ref) * CS%rho_fixed_total_depth * GV%RZ_to_H + depth_tot(i,j) = max(G%bathyT(i,j) + G%Z_ref, 0.0) * CS%rho_fixed_total_depth * GV%RZ_to_H enddo ; enddo endif else diff --git a/src/parameterizations/lateral/MOM_internal_tides.F90 b/src/parameterizations/lateral/MOM_internal_tides.F90 index 1f51cc99a9..e4a48c84c5 100644 --- a/src/parameterizations/lateral/MOM_internal_tides.F90 +++ b/src/parameterizations/lateral/MOM_internal_tides.F90 @@ -3773,7 +3773,7 @@ subroutine internal_tides_init(Time, G, GV, US, param_file, diag, CS) do j=G%jsc,G%jec ; do i=G%isc,G%iec ! Restrict RMS topographic roughness to a fraction (10 percent by default) of the column depth. if (RMS_roughness_frac >= 0.0) then - h2(i,j) = max(min((RMS_roughness_frac*(G%bathyT(i,j)+G%Z_ref))**2, h2(i,j)), 0.0) + h2(i,j) = max(min((RMS_roughness_frac * max(G%bathyT(i,j)+G%Z_ref, 0.0))**2, h2(i,j)), 0.0) else h2(i,j) = max(h2(i,j), 0.0) endif diff --git a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 index 5c9130b6f7..2a7527ce9a 100644 --- a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 +++ b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 @@ -224,11 +224,13 @@ subroutine calc_depth_function(G, CS) expo = CS%depth_scaled_khth_exp !$OMP do do j=js,je ; do I=is-1,Ieq - CS%Depth_fn_u(I,j) = (MIN(1.0, (0.5*(G%bathyT(i,j) + G%bathyT(i+1,j)) + G%Z_ref)/H0))**expo + CS%Depth_fn_u(I,j) = (MIN(1.0, & + (0.5 * (max(G%bathyT(i,j) + G%Z_ref, 0.0) + max(G%bathyT(i+1,j) + G%Z_ref, 0.0))) / H0))**expo enddo ; enddo !$OMP do do J=js-1,Jeq ; do i=is,ie - CS%Depth_fn_v(i,J) = (MIN(1.0, (0.5*(G%bathyT(i,j) + G%bathyT(i,j+1)) + G%Z_ref)/H0))**expo + CS%Depth_fn_v(i,J) = (MIN(1.0, & + (0.5 * (max(G%bathyT(i,j) + G%Z_ref, 0.0) + max(G%bathyT(i,j+1) + G%Z_ref, 0.0))) / H0))**expo enddo ; enddo end subroutine calc_depth_function diff --git a/src/parameterizations/vertical/MOM_internal_tide_input.F90 b/src/parameterizations/vertical/MOM_internal_tide_input.F90 index 2384844f6e..2a7a3a2a7c 100644 --- a/src/parameterizations/vertical/MOM_internal_tide_input.F90 +++ b/src/parameterizations/vertical/MOM_internal_tide_input.F90 @@ -557,7 +557,7 @@ subroutine int_tide_input_init(Time, G, GV, US, param_file, diag, CS, itide) ! Restrict rms topo to a fraction (often 10 percent) of the column depth. if (max_frac_rough >= 0.0) & - itide%h2(i,j) = min((max_frac_rough*(G%bathyT(i,j)+G%Z_ref))**2, itide%h2(i,j)) + itide%h2(i,j) = min((max_frac_rough * max(G%bathyT(i,j)+G%Z_ref, 0.0))**2, itide%h2(i,j)) ! Compute the fixed part of internal tidal forcing; units are [R Z4 H-1 T-2 ~> J m-2 or J m kg-1] here. CS%TKE_itidal_coef(i,j,fr) = 0.5*US%L_to_Z*kappa_h2_factor * GV%H_to_RZ * & diff --git a/src/parameterizations/vertical/MOM_tidal_mixing.F90 b/src/parameterizations/vertical/MOM_tidal_mixing.F90 index 9a972e6e06..faeadbb8ab 100644 --- a/src/parameterizations/vertical/MOM_tidal_mixing.F90 +++ b/src/parameterizations/vertical/MOM_tidal_mixing.F90 @@ -516,7 +516,7 @@ logical function tidal_mixing_init(Time, G, GV, US, param_file, int_tide_CSp, di CS%h2(i,j) = hamp*hamp else if (max_frac_rough >= 0.0) & - CS%h2(i,j) = min((max_frac_rough*(G%bathyT(i,j)+G%Z_ref))**2, CS%h2(i,j)) + CS%h2(i,j) = min((max_frac_rough * max(G%bathyT(i,j)+G%Z_ref, 0.0))**2, CS%h2(i,j)) endif utide = CS%tideamp(i,j) From 7d90219ada6dd8748d55203fd9592dff5447a716 Mon Sep 17 00:00:00 2001 From: Alistair Adcroft Date: Thu, 4 Dec 2025 09:02:31 -0500 Subject: [PATCH 14/64] Allow overshoot for for grounding test In commit b8c807be327c0, we made the test for SSH penetrating the sea floor when using BT_LIMIT_INTEGRAL_TRANSPORT because we thought it could never happen. Unfortunately, floating-point round off allows violations and we were hitting the now fatal error. This commit calculates the precision we can expect for the current SSH and then if the ocean thickness has become negative within this precision, we reset to zero thickness. This should not change answers in that BT_LIMIT_INTEGRAL_TRANSPORT is a new option, and if anyone was using it they would have encountered a FATAL, and this fix does not alter any positive thicknesses. --- src/core/MOM_barotropic.F90 | 15 +++++++++++++++ 1 file changed, 15 insertions(+) diff --git a/src/core/MOM_barotropic.F90 b/src/core/MOM_barotropic.F90 index 777b45026a..c9f71ebd95 100644 --- a/src/core/MOM_barotropic.F90 +++ b/src/core/MOM_barotropic.F90 @@ -2506,6 +2506,7 @@ subroutine btstep_timeloop(eta, ubt, vbt, uhbt0, Datu, BTCL_u, vhbt0, Datv, BTCL ! to equal bebt, as they have similar roles and meanings. real :: eta_cor_multiplier ! Increases the rate of applying CS%eta_cor so that the mass ! source is all used up by the beginning of the filtering [nondim] + real :: eta_acc ! Change due to divergence of mass transport [H ~> m or kg m-2] logical :: do_hifreq_output ! If true, output occurs every barotropic step. logical :: do_ave ! If true, diagnostics are enabled on this step. logical :: evolving_face_areas @@ -2882,7 +2883,21 @@ subroutine btstep_timeloop(eta, ubt, vbt, uhbt0, Datu, BTCL_u, vhbt0, Datv, BTCL do j=jsv,jev ; do i=isv,iev eta(i,j) = (eta_IC(i,j) + eta_cor_multiplier*eta_src(i,j)) + CS%IareaT_OBCmask(i,j) * & ((uhbt_int(I-1,j) - uhbt_int(I,j)) + (vhbt_int(i,J-1) - vhbt_int(i,J))) + ! eta_acc contains the magnitude of the largest term in the above expression which + ! will be used to estimate a bound for round off when comparing to the bottom depth + eta_acc = abs( CS%IareaT_OBCmask(i,j) * & + ((uhbt_int(I-1,j) - uhbt_int(I,j)) + (vhbt_int(i,J-1) - vhbt_int(i,J))) ) + eta_acc = max( eta_acc, abs( eta_cor_multiplier*eta_src(i,j) ), abs( eta_IC(i,j) ) ) + if ( G%mask2dT(i,j) * ( eta(i,j) + GV%Z_to_H*G%bathyT(i,j) ) > & + -G%mask2dT(i,j) * eta_acc * epsilon(eta_acc) * 2. ) & + eta(i,j) = max( eta(i,j), -GV%Z_to_H*G%bathyT(i,j) ) eta_wtd(i,j) = eta_wtd(i,j) + eta(i,j) * wt_eta(n) + if ((eta(i,j) < -GV%Z_to_H*G%bathyT(i,j)) .and. (G%mask2dT(i,j) > 0.0)) then + write(mesg,'(ES24.16," vs. ",ES24.16, " at ", ES12.4, ES12.4, i7, i7)') GV%H_to_m*eta(i,j), & + -US%Z_to_m*G%bathyT(i,j), G%geoLonT(i,j), G%geoLatT(i,j), i + G%HI%idg_offset, j + G%HI%jdg_offset + if (CS%bt_limit_integral_transport) & + call MOM_error(FATAL, "btstep: eta has dropped below bathyT: "//trim(mesg)) + endif enddo ; enddo else !$OMP do From ff7ec3ebfb514c1795e93b7add878044cc3438b9 Mon Sep 17 00:00:00 2001 From: Alistair Adcroft Date: Thu, 4 Dec 2025 09:53:24 -0500 Subject: [PATCH 15/64] Initialize and integer only set on root_PE() When debugging with all run-time tests turned on, the integer `num_lines` was flagged as used but uninitialized when being passed to `broadcast()`. I don't think the code was wrong, just that the checks expected the "inout" argument to be set on all processors when the purpose of `broadcast()` is to take the value from root_PE and send to everyone else. I don't know why this hadn't been detected before - maybe compiler version. The fix is trivial and has no impact on production codes or answers. --- src/initialization/MOM_shared_initialization.F90 | 2 ++ 1 file changed, 2 insertions(+) diff --git a/src/initialization/MOM_shared_initialization.F90 b/src/initialization/MOM_shared_initialization.F90 index 9a4be62fc2..6f8ed1ed8e 100644 --- a/src/initialization/MOM_shared_initialization.F90 +++ b/src/initialization/MOM_shared_initialization.F90 @@ -884,6 +884,8 @@ subroutine reset_face_lengths_list(G, param_file, US) ! Count the number of u_width and v_width entries. call read_face_length_list(iounit, filename, num_lines, lines) + else + num_lines = 0 endif len_lon = 360.0 ; if (G%len_lon > 0.0) len_lon = G%len_lon From 367de745e3f7fef1236fb877984a2201ee4e0c20 Mon Sep 17 00:00:00 2001 From: Alistair Adcroft Date: Thu, 4 Dec 2025 10:01:14 -0500 Subject: [PATCH 16/64] Fix an uninitialized float in set_viscous_ML() `oldfn` was not initialized when used in a logical test. This did not matter for numerical results; the logical expression always evaluated to the False correctly due to other parts of the expression. Nevertheless, this variable was technically used uninitialized and a debugging executable doesn't get past this. Hence the fix. --- src/parameterizations/vertical/MOM_set_viscosity.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/parameterizations/vertical/MOM_set_viscosity.F90 b/src/parameterizations/vertical/MOM_set_viscosity.F90 index 8293b4ccde..747dcb2903 100644 --- a/src/parameterizations/vertical/MOM_set_viscosity.F90 +++ b/src/parameterizations/vertical/MOM_set_viscosity.F90 @@ -2367,7 +2367,7 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS) ustarsq = Rho0x400_G * ustar(i)**2 htot(i) = 0.0 ; dztot(i) = 0.0 if (use_EOS) then - Thtot(i) = 0.0 ; Shtot(i) = 0.0 + Thtot(i) = 0.0 ; Shtot(i) = 0.0 ; oldfn = 0.0 do k=1,nz-1 if (h_at_vel(i,k) <= 0.0) cycle T_Lay = 0.5 * (tv%T(i,j,k) + tv%T(i+1,j,k)) @@ -2646,7 +2646,7 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS) htot(i) = 0.0 dztot(i) = 0.0 if (use_EOS) then - Thtot(i) = 0.0 ; Shtot(i) = 0.0 + Thtot(i) = 0.0 ; Shtot(i) = 0.0 ; oldfn = 0.0 do k=1,nz-1 if (h_at_vel(i,k) <= 0.0) cycle T_Lay = 0.5 * (tv%T(i,j,k) + tv%T(i,j+1,k)) From 0f26d6958423d894823e0db79c6f9bfee64b0bfa Mon Sep 17 00:00:00 2001 From: Alistair Adcroft Date: Thu, 4 Dec 2025 10:33:18 -0500 Subject: [PATCH 17/64] Add floor to "h_marg" in continuity_PPM When debugging the ice sheet configuration, a non-zero barotropic transport could not be reconciled with the layer transports because the derivative of net layer transports was zero (d/dv hu). This arose due to all layer flows pointed from vanished to thick so that their marginal thicknesses were individually zero. Adding a floor to the marginal thickness allows the solver to find the adjustment that does reconciles the two estimates. I've made this optional via parameter CONT_USE_H_MARG_MIN, and with default of False. If this situation had occurred before, we surely would have had a crash so it's likely that always applying this floor would not change answers. However, there's the weak possibility that a teeny-tiny transport, smaller than H_subroundoff, has existed in a run and then this answer would change. With the default of False we can be sure there are no answer changes, but it is recommended to use this option for safety. --- src/core/MOM_continuity_PPM.F90 | 67 +++++++++++++++++++++++---------- 1 file changed, 48 insertions(+), 19 deletions(-) diff --git a/src/core/MOM_continuity_PPM.F90 b/src/core/MOM_continuity_PPM.F90 index d5e380391c..d74fa23ad8 100644 --- a/src/core/MOM_continuity_PPM.F90 +++ b/src/core/MOM_continuity_PPM.F90 @@ -49,6 +49,9 @@ module MOM_continuity_PPM !! discrepancies between the barotropic solution and !! the sum of the layer thicknesses [L T-1 ~> m s-1]. real :: CFL_limit_adjust !< The maximum CFL of the adjusted velocities [nondim] + real :: h_marg_min !< Negligible floor on h_marg, the marginal thickness + !! used to calculate the partial derivative of transports + !! with velocities [H ~> m or kg m-2] logical :: aggress_adjust !< If true, allow the adjusted velocities to have a !! relative CFL change up to 0.5. False by default. logical :: vol_CFL !< If true, use the ratio of the open face lengths @@ -625,7 +628,8 @@ subroutine zonal_mass_flux(u, h_in, h_W, h_E, uh, dt, G, GV, US, CS, OBC, por_fa enddo ; endif call zonal_flux_layer(u(:,j,k), h_in(:,j,k), h_W(:,j,k), h_E(:,j,k), & uh(:,j,k), duhdu(:,k), visc_rem(:,k), & - dt, G, US, j, ish, ieh, do_I, CS%vol_CFL, por_face_areaU(:,j,k), OBC) + dt, G, US, j, ish, ieh, do_I, CS%vol_CFL, por_face_areaU(:,j,k), & + CS%h_marg_min, OBC) if (local_specified_BC) then do I=ish-1,ieh ; if (OBC%segnum_u(I,j) /= 0) then l_seg = abs(OBC%segnum_u(I,j)) @@ -875,7 +879,8 @@ subroutine zonal_BT_mass_flux(u, h_in, h_W, h_E, uhbt, dt, G, GV, US, CS, OBC, p do k=1,nz ! This sets uh and duhdu. call zonal_flux_layer(u(:,j,k), h_in(:,j,k), h_W(:,j,k), h_E(:,j,k), uh, duhdu, ones, & - dt, G, US, j, ish, ieh, do_I, CS%vol_CFL, por_face_areaU(:,j,k), OBC) + dt, G, US, j, ish, ieh, do_I, CS%vol_CFL, por_face_areaU(:,j,k), & + CS%h_marg_min, OBC) if (OBC_in_row) then ; do I=ish-1,ieh ; if (OBC%segnum_u(I,j) /= 0) then l_seg = abs(OBC%segnum_u(I,j)) if (OBC%segment(l_seg)%specified) uh(I) = OBC%segment(l_seg)%normal_trans(I,j,k) @@ -894,7 +899,7 @@ end subroutine zonal_BT_mass_flux !> Evaluates the zonal mass or volume fluxes in a layer. subroutine zonal_flux_layer(u, h, h_W, h_E, uh, duhdu, visc_rem, dt, G, US, j, & - ish, ieh, do_I, vol_CFL, por_face_areaU, OBC) + ish, ieh, do_I, vol_CFL, por_face_areaU, h_marg_min, OBC) type(ocean_grid_type), intent(in) :: G !< Ocean's grid structure. real, dimension(SZIB_(G)), intent(in) :: u !< Zonal velocity [L T-1 ~> m s-1]. real, dimension(SZIB_(G)), intent(in) :: visc_rem !< Both the fraction of the @@ -918,6 +923,7 @@ subroutine zonal_flux_layer(u, h, h_W, h_E, uh, duhdu, visc_rem, dt, G, US, j, & logical, intent(in) :: vol_CFL !< If true, rescale the real, dimension(SZIB_(G)), intent(in) :: por_face_areaU !< fractional open area of U-faces [nondim] !! ratio of face areas to the cell areas when estimating the CFL number. + real, intent(in) :: h_marg_min !< Negligible floor on h_marg [H ~> m or kg m-2] type(ocean_OBC_type), optional, pointer :: OBC !< Open boundaries control structure. ! Local variables real :: CFL ! The CFL number based on the local velocity and grid spacing [nondim] @@ -952,6 +958,7 @@ subroutine zonal_flux_layer(u, h, h_W, h_E, uh, duhdu, visc_rem, dt, G, US, j, & uh(I) = 0.0 h_marg = 0.5 * (h_W(i+1) + h_E(i)) endif + h_marg = max(h_marg, h_marg_min) duhdu(I) = (G%dy_Cu(I,j) * por_face_areaU(I)) * h_marg * visc_rem(I) endif ; enddo @@ -960,10 +967,10 @@ subroutine zonal_flux_layer(u, h, h_W, h_E, uh, duhdu, visc_rem, dt, G, US, j, & if (OBC%segment(abs(OBC%segnum_u(I,j)))%open) then if (OBC%segnum_u(I,j) > 0) then ! OBC_DIRECTION_E uh(I) = (G%dy_Cu(I,j) * por_face_areaU(I)) * u(I) * h(i) - duhdu(I) = (G%dy_Cu(I,j) * por_face_areaU(I)) * h(i) * visc_rem(I) + duhdu(I) = (G%dy_Cu(I,j) * por_face_areaU(I)) * max(h(i), h_marg_min) * visc_rem(I) else ! OBC_DIRECTION_W uh(I) = (G%dy_Cu(I,j) * por_face_areaU(I)) * u(I) * h(i+1) - duhdu(I) = (G%dy_Cu(I,j)* por_face_areaU(I)) * h(i+1) * visc_rem(I) + duhdu(I) = (G%dy_Cu(I,j)* por_face_areaU(I)) * max(h(i+1), h_marg_min) * visc_rem(I) endif endif endif ; endif ; enddo @@ -1215,7 +1222,8 @@ subroutine zonal_flux_adjust(u, h_in, h_W, h_E, uhbt, uh_tot_0, duhdu_tot_0, & do I=ish-1,ieh ; u_new(I) = u(I,j,k) + du(I) * visc_rem(I,k) ; enddo call zonal_flux_layer(u_new, h_in(:,j,k), h_W(:,j,k), h_E(:,j,k), & uh_aux(:,k), duhdu(:,k), visc_rem(:,k), & - dt, G, US, j, ish, ieh, do_I, CS%vol_CFL, por_face_areaU(:,j,k), OBC) + dt, G, US, j, ish, ieh, do_I, CS%vol_CFL, por_face_areaU(:,j,k), & + CS%h_marg_min, OBC) enddo ; endif if (itt < max_itts) then @@ -1363,11 +1371,14 @@ subroutine set_zonal_BT_cont(u, h_in, h_W, h_E, BT_cont, uh_tot_0, duhdu_tot_0, u_0(I) = u(I,j,k) + du0(I) * visc_rem(I,k) endif ; enddo call zonal_flux_layer(u_0, h_in(:,j,k), h_W(:,j,k), h_E(:,j,k), uh_0, duhdu_0, & - visc_rem(:,k), dt, G, US, j, ish, ieh, do_I, CS%vol_CFL, por_face_areaU(:,j,k)) + visc_rem(:,k), dt, G, US, j, ish, ieh, do_I, CS%vol_CFL, & + por_face_areaU(:,j,k), CS%h_marg_min) call zonal_flux_layer(u_L, h_in(:,j,k), h_W(:,j,k), h_E(:,j,k), uh_L, duhdu_L, & - visc_rem(:,k), dt, G, US, j, ish, ieh, do_I, CS%vol_CFL, por_face_areaU(:,j,k)) + visc_rem(:,k), dt, G, US, j, ish, ieh, do_I, CS%vol_CFL, & + por_face_areaU(:,j,k), CS%h_marg_min) call zonal_flux_layer(u_R, h_in(:,j,k), h_W(:,j,k), h_E(:,j,k), uh_R, duhdu_R, & - visc_rem(:,k), dt, G, US, j, ish, ieh, do_I, CS%vol_CFL, por_face_areaU(:,j,k)) + visc_rem(:,k), dt, G, US, j, ish, ieh, do_I, CS%vol_CFL, & + por_face_areaU(:,j,k), CS%h_marg_min) do I=ish-1,ieh ; if (do_I(I)) then FAmt_0(I) = FAmt_0(I) + duhdu_0(I) FAmt_L(I) = FAmt_L(I) + duhdu_L(I) @@ -1518,7 +1529,8 @@ subroutine meridional_mass_flux(v, h_in, h_S, h_N, vh, dt, G, GV, US, CS, OBC, p enddo ; endif call merid_flux_layer(v(:,J,k), h_in(:,:,k), h_S(:,:,k), h_N(:,:,k), & vh(:,J,k), dvhdv(:,k), visc_rem(:,k), & - dt, G, US, J, ish, ieh, do_I, CS%vol_CFL, por_face_areaV(:,:,k), OBC) + dt, G, US, J, ish, ieh, do_I, CS%vol_CFL, por_face_areaV(:,:,k), & + CS%h_marg_min, OBC) if (local_specified_BC) then do i=ish,ieh ; if (OBC%segnum_v(i,J) /= 0) then l_seg = abs(OBC%segnum_v(i,J)) @@ -1765,7 +1777,8 @@ subroutine meridional_BT_mass_flux(v, h_in, h_S, h_N, vhbt, dt, G, GV, US, CS, O do k=1,nz ! This sets vh and dvhdv. call merid_flux_layer(v(:,J,k), h_in(:,:,k), h_S(:,:,k), h_N(:,:,k), vh, dvhdv, ones, & - dt, G, US, J, ish, ieh, do_I, CS%vol_CFL, por_face_areaV(:,:,k), OBC) + dt, G, US, J, ish, ieh, do_I, CS%vol_CFL, por_face_areaV(:,:,k), & + CS%h_marg_min, OBC) if (OBC_in_row) then ; do i=ish,ieh ; if (OBC%segnum_v(i,J) /= 0) then l_seg = abs(OBC%segnum_v(i,J)) if (OBC%segment(l_seg)%specified) vh(i) = OBC%segment(l_seg)%normal_trans(i,J,k) @@ -1785,7 +1798,7 @@ end subroutine meridional_BT_mass_flux !> Evaluates the meridional mass or volume fluxes in a layer. subroutine merid_flux_layer(v, h, h_S, h_N, vh, dvhdv, visc_rem, dt, G, US, J, & - ish, ieh, do_I, vol_CFL, por_face_areaV, OBC) + ish, ieh, do_I, vol_CFL, por_face_areaV, h_marg_min, OBC) type(ocean_grid_type), intent(in) :: G !< Ocean's grid structure. real, dimension(SZI_(G)), intent(in) :: v !< Meridional velocity [L T-1 ~> m s-1]. real, dimension(SZI_(G)), intent(in) :: visc_rem !< Both the fraction of the @@ -1813,6 +1826,7 @@ subroutine merid_flux_layer(v, h, h_S, h_N, vh, dvhdv, visc_rem, dt, G, US, J, & !! ratio of face areas to the cell areas when estimating the CFL number. real, dimension(SZI_(G),SZJB_(G)), & intent(in) :: por_face_areaV !< fractional open area of V-faces [nondim] + real, intent(in) :: h_marg_min !< Negligible floor on h_marg [H ~> m or kg m-2] type(ocean_OBC_type), optional, pointer :: OBC !< Open boundaries control structure. ! Local variables real :: CFL ! The CFL number based on the local velocity and grid spacing [nondim] @@ -1848,6 +1862,7 @@ subroutine merid_flux_layer(v, h, h_S, h_N, vh, dvhdv, visc_rem, dt, G, US, J, & vh(i) = 0.0 h_marg = 0.5 * (h_S(i,j+1) + h_N(i,j)) endif + h_marg = max(h_marg, h_marg_min) dvhdv(i) = (G%dx_Cv(i,J)*por_face_areaV(i,J)) * h_marg * visc_rem(i) endif ; enddo @@ -1857,10 +1872,10 @@ subroutine merid_flux_layer(v, h, h_S, h_N, vh, dvhdv, visc_rem, dt, G, US, J, & if (OBC%segment(abs(OBC%segnum_v(i,J)))%open) then if (OBC%segnum_v(i,J) > 0) then ! OBC_DIRECTION_N vh(i) = (G%dx_Cv(i,J)*por_face_areaV(i,J)) * v(i) * h(i,j) - dvhdv(i) = (G%dx_Cv(i,J)*por_face_areaV(i,J)) * h(i,j) * visc_rem(i) + dvhdv(i) = (G%dx_Cv(i,J)*por_face_areaV(i,J)) * max(h(i,j), h_marg_min) * visc_rem(i) else vh(i) = (G%dx_Cv(i,J)*por_face_areaV(i,J)) * v(i) * h(i,j+1) - dvhdv(i) = (G%dx_Cv(i,J)*por_face_areaV(i,J)) * h(i,j+1) * visc_rem(i) + dvhdv(i) = (G%dx_Cv(i,J)*por_face_areaV(i,J)) * max(h(i,j+1), h_marg_min) * visc_rem(i) endif endif endif @@ -2112,7 +2127,8 @@ subroutine meridional_flux_adjust(v, h_in, h_S, h_N, vhbt, vh_tot_0, dvhdv_tot_0 do i=ish,ieh ; v_new(i) = v(i,J,k) + dv(i) * visc_rem(i,k) ; enddo call merid_flux_layer(v_new, h_in(:,:,k), h_S(:,:,k), h_N(:,:,k), & vh_aux(:,k), dvhdv(:,k), visc_rem(:,k), & - dt, G, US, J, ish, ieh, do_I, CS%vol_CFL, por_face_areaV(:,:,k), OBC) + dt, G, US, J, ish, ieh, do_I, CS%vol_CFL, por_face_areaV(:,:,k), & + CS%h_marg_min, OBC) enddo ; endif if (itt < max_itts) then @@ -2260,11 +2276,14 @@ subroutine set_merid_BT_cont(v, h_in, h_S, h_N, BT_cont, vh_tot_0, dvhdv_tot_0, v_0(i) = v(I,j,k) + dv0(i) * visc_rem(i,k) endif ; enddo call merid_flux_layer(v_0, h_in(:,:,k), h_S(:,:,k), h_N(:,:,k), vh_0, dvhdv_0, & - visc_rem(:,k), dt, G, US, J, ish, ieh, do_I, CS%vol_CFL, por_face_areaV(:,:,k)) + visc_rem(:,k), dt, G, US, J, ish, ieh, do_I, CS%vol_CFL, & + por_face_areaV(:,:,k), CS%h_marg_min) call merid_flux_layer(v_L, h_in(:,:,k), h_S(:,:,k), h_N(:,:,k), vh_L, dvhdv_L, & - visc_rem(:,k), dt, G, US, J, ish, ieh, do_I, CS%vol_CFL, por_face_areaV(:,:,k)) + visc_rem(:,k), dt, G, US, J, ish, ieh, do_I, CS%vol_CFL, & + por_face_areaV(:,:,k), CS%h_marg_min) call merid_flux_layer(v_R, h_in(:,:,k), h_S(:,:,k), h_N(:,:,k), vh_R, dvhdv_R, & - visc_rem(:,k), dt, G, US, J, ish, ieh, do_I, CS%vol_CFL, por_face_areaV(:,:,k)) + visc_rem(:,k), dt, G, US, J, ish, ieh, do_I, CS%vol_CFL, & + por_face_areaV(:,:,k), CS%h_marg_min) do i=ish,ieh ; if (do_I(i)) then FAmt_0(i) = FAmt_0(i) + dvhdv_0(i) FAmt_L(i) = FAmt_L(i) + dvhdv_L(i) @@ -2720,7 +2739,7 @@ subroutine continuity_PPM_init(Time, G, GV, US, param_file, diag, CS, OBC) !! regulate diagnostic output. type(continuity_PPM_CS), intent(inout) :: CS !< Module's control structure. type(ocean_OBC_type), pointer :: OBC !< Open boundaries control structure. - logical :: local_open_BC + logical :: local_open_BC, use_h_marg_min type(OBC_segment_type), pointer :: segment => NULL() integer :: n @@ -2793,12 +2812,22 @@ subroutine continuity_PPM_init(Time, G, GV, US, param_file, diag, CS, OBC) "If true, use the marginal face areas from the continuity "//& "solver for use as the weights in the barotropic solver. "//& "Otherwise use the transport averaged areas.", default=.true.) + call get_param(param_file, mdl, "CONT_USE_H_MARG_MIN", use_h_marg_min, & + "If true, the marginal thickness used and returned from continuity "//& + "is bounded from below by a sub-roundoff value. Otherwise the "//& + "minimum is 0.", default=.false.) CS%diag => diag id_clock_reconstruct = cpu_clock_id('(Ocean continuity reconstruction)', grain=CLOCK_ROUTINE) id_clock_update = cpu_clock_id('(Ocean continuity update)', grain=CLOCK_ROUTINE) id_clock_correct = cpu_clock_id('(Ocean continuity correction)', grain=CLOCK_ROUTINE) + if (use_h_marg_min) then + CS%h_marg_min = GV%H_subroundoff + else + CS%h_marg_min = 0. + endif + if (local_open_BC) then do n=1, OBC%number_of_segments segment => OBC%segment(n) From 67f7637d9b98effe0189a46412f4a0b4c0113de5 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Wed, 3 Dec 2025 11:34:28 -0500 Subject: [PATCH 18/64] *+Fix CHANNEL_DRAG with bathymetry above sea level The CHANNEL_DRAG option was using a harmonic mean to interpolate adjacent bottom depths at velocity points to vorticity points. However, this is not well behaved when the bottom depth is negative (i.e., above sea level), as was noted as a part of PR #975. This commit adds the new runtime parameter CHANNEL_DRAG_SHELFBREAK_DEPTH to set a depth below which a harmonic mean bottom depth is still used to mimic a continental shelfbreak profile, but above which a simple arithmetic mean is used to interpolate bathymetry to vorticity points for use with CHANNEL_DRAG. The expressions vary continuously with depth and avoid the previous problems with division by zero or a badly formed harmonic mean. By default, all answers are bitwise identical in any cases that worked previously, but cases with oceans (or Great Lakes) in basins with bottoms that are above sea-level should now work sensibly when CHANNEL_DRAG is enabled. There is a new runtime parameter in some cases. --- .../vertical/MOM_set_viscosity.F90 | 80 +++++++++++++------ 1 file changed, 57 insertions(+), 23 deletions(-) diff --git a/src/parameterizations/vertical/MOM_set_viscosity.F90 b/src/parameterizations/vertical/MOM_set_viscosity.F90 index 747dcb2903..193fcdffca 100644 --- a/src/parameterizations/vertical/MOM_set_viscosity.F90 +++ b/src/parameterizations/vertical/MOM_set_viscosity.F90 @@ -89,6 +89,12 @@ module MOM_set_visc real :: Chan_drag_max_vol !< The maximum bottom boundary layer volume within which the !! channel drag is applied, normalized by the full cell area, !! or a negative value to apply no maximum [Z ~> m]. + real :: channel_break_depth !< When CHANNEL_DRAG is true, the bathymetric depth interpolated + !! to the vorticity point is a combination of the harmonic mean of the + !! adjacent velocity point depths below this depth [Z ~> m] and the + !! arithmetic mean of the adjacent depths above it, to roughly mimic a + !! continental shelf break profile. The internal version of this depth + !! uses the same offset (G%Z_ref) as the bathymetry. logical :: correct_BBL_bounds !< If true, uses the correct bounds on the BBL thickness and !! viscosity so that the bottom layer feels the intended drag. logical :: RiNo_mix !< If true, use Richardson number dependent mixing. @@ -260,8 +266,11 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, pbv) real :: p_ref(SZI_(G)) ! The pressure used to calculate the coordinate ! density [R L2 T-2 ~> Pa] (usually set to 2e7 Pa = 2000 dbar). - real :: D_vel ! The bottom depth at a velocity point [Z ~> m]. - real :: Dp, Dm ! The depths at the edges of a velocity cell [Z ~> m]. + real :: D_vel ! The bottom depth relative to the shelfbreak depth at a velocity point [Z ~> m]. + real :: Dp, Dm ! The bottom depths at the edges of a velocity cell relative to the + ! shelfbreak depth [Z ~> m]. + real :: D_vel_p, D_vel_m ! The bottom depths in adjacent velocity points relative to the + ! shelfbreak depth [Z ~> m]. real :: crv ! crv is the curvature of the bottom depth across a ! cell, times the cell width squared [Z ~> m]. real :: slope ! The absolute value of the bottom depth slope across @@ -373,23 +382,23 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, pbv) !$OMP parallel do default(shared) do J=js-1,je ; do i=is-1,ie+1 - D_v(i,J) = 0.5*(G%bathyT(i,j) + G%bathyT(i,j+1)) + G%Z_ref + D_v(i,J) = 0.5*(G%bathyT(i,j) + G%bathyT(i,j+1)) mask_v(i,J) = G%mask2dCv(i,J) enddo ; enddo !$OMP parallel do default(shared) do j=js-1,je+1 ; do I=is-1,ie - D_u(I,j) = 0.5*(G%bathyT(i,j) + G%bathyT(i+1,j)) + G%Z_ref + D_u(I,j) = 0.5*(G%bathyT(i,j) + G%bathyT(i+1,j)) mask_u(I,j) = G%mask2dCu(I,j) enddo ; enddo - if (associated(OBC)) then + if (associated(OBC) .and. CS%Channel_drag) then ! Use a one-sided projection of bottom depths at OBC points. if (OBC%v_N_OBCs_on_PE) then Js_OBC = max(js-1, OBC%Js_v_N_obc) ; Je_OBC = min(je, OBC%Je_v_N_obc) is_OBC = max(is-1, OBC%is_v_N_obc) ; ie_OBC = min(ie+1, OBC%ie_v_N_obc) !$OMP parallel do default(shared) do J=Js_OBC,Je_OBC ; do i=is_OBC,ie_OBC - if (OBC%segnum_v(i,J) > 0) D_v(i,J) = G%bathyT(i,j) + G%Z_ref ! OBC_DIRECTION_N + if (OBC%segnum_v(i,J) > 0) D_v(i,J) = G%bathyT(i,j) ! OBC_DIRECTION_N enddo ; enddo endif if (OBC%v_S_OBCs_on_PE) then @@ -397,7 +406,7 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, pbv) is_OBC = max(is-1, OBC%is_v_S_obc) ; ie_OBC = min(ie+1, OBC%ie_v_S_obc) !$OMP parallel do default(shared) do J=Js_OBC,Je_OBC ; do i=is_OBC,ie_OBC - if (OBC%segnum_v(i,J) < 0) D_v(i,J) = G%bathyT(i,j+1) + G%Z_ref ! OBC_DIRECTION_S + if (OBC%segnum_v(i,J) < 0) D_v(i,J) = G%bathyT(i,j+1) ! OBC_DIRECTION_S enddo ; enddo endif if (OBC%u_E_OBCs_on_PE) then @@ -405,7 +414,7 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, pbv) Is_OBC = max(is-1, OBC%Is_u_E_obc) ; Ie_OBC = min(ie, OBC%Ie_u_E_obc) !$OMP parallel do default(shared) do j=js_OBC,je_OBC ; do I=Is_OBC,Ie_OBC - if (OBC%segnum_u(I,j) > 0) D_u(I,j) = G%bathyT(i,j) + G%Z_ref ! OBC_DIRECTION_E + if (OBC%segnum_u(I,j) > 0) D_u(I,j) = G%bathyT(i,j) ! OBC_DIRECTION_E enddo ; enddo endif if (OBC%u_W_OBCs_on_PE) then @@ -413,12 +422,12 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, pbv) Is_OBC = max(is-1, OBC%Is_u_W_obc) ; Ie_OBC = min(ie, OBC%Ie_u_W_obc) !$OMP parallel do default(shared) do j=js_OBC,je_OBC ; do I=Is_OBC,Ie_OBC - if (OBC%segnum_u(I,j) < 0) D_u(I,j) = G%bathyT(i+1,j) + G%Z_ref ! OBC_DIRECTION_W + if (OBC%segnum_u(I,j) < 0) D_u(I,j) = G%bathyT(i+1,j) ! OBC_DIRECTION_W enddo ; enddo endif endif - if (associated(OBC)) then ; do n=1,OBC%number_of_segments + if (associated(OBC) .and. CS%Channel_drag) then ; do n=1,OBC%number_of_segments ! Now project bottom depths across cell-corner points in the OBCs. The two ! projections have to occur in sequence and can not be combined easily. if (.not. OBC%segment(n)%on_pe) cycle @@ -919,19 +928,29 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, pbv) vol_below(K) = vol_below(K+1) + dz_vel(i,k) enddo - !### The harmonic mean edge depths here are not invariant to offsets! + ! Find the bathymetry at adjacent points relative to the shelf break. For now this + ! shelf break depth is set with a global constant, but it could vary in space. if (m==1) then - D_vel = D_u(I,j) - tmp = G%mask2dCu(I,j+1) * D_u(I,j+1) - Dp = 2.0 * D_vel * tmp / (D_vel + tmp) - tmp = G%mask2dCu(I,j-1) * D_u(I,j-1) - Dm = 2.0 * D_vel * tmp / (D_vel + tmp) + D_vel = D_u(I,j) - CS%channel_break_depth + D_vel_p = G%mask2dCu(I,j+1) * (D_u(I,j+1) - CS%channel_break_depth) + D_vel_m = G%mask2dCu(I,j-1) * (D_u(I,j-1) - CS%channel_break_depth) else - D_vel = D_v(i,J) - tmp = G%mask2dCv(i+1,J) * D_v(i+1,J) - Dp = 2.0 * D_vel * tmp / (D_vel + tmp) - tmp = G%mask2dCv(i-1,J) * D_v(i-1,J) - Dm = 2.0 * D_vel * tmp / (D_vel + tmp) + D_vel = D_v(i,J) - CS%channel_break_depth + D_vel_p = G%mask2dCv(i+1,J) * (D_v(i+1,J) - CS%channel_break_depth) + D_vel_m = G%mask2dCv(i-1,J) * (D_v(i-1,J) - CS%channel_break_depth) + endif + ! This profile uses a harmonic mean bottom depth below some reference value to + ! roughly mimic the topographic shape at and beneath a continental shelf break. + ! Above this a simple arithmetic mean is used. + if ((D_vel > 0.0) .and. (D_vel_p > 0.0)) then + Dp = 2.0 * D_vel * D_vel_p / (D_vel + D_vel_p) + else ! This is above the shelf-break, noting that D is positive downward. + Dp = 0.5 * (min(D_vel, 0.0) + min(D_vel_p, 0.0)) + endif + if ((D_vel > 0.0) .and. (D_vel_m > 0.0)) then + Dm = 2.0 * D_vel * D_vel_m / (D_vel + D_vel_m) + else ! This is above the shelf-break, noting that D is positive downward. + Dm = 0.5 * (min(D_vel, 0.0) + min(D_vel_m, 0.0)) endif if (Dm > Dp) then ; tmp = Dp ; Dp = Dm ; Dm = tmp ; endif crv = 3.0*(Dp + Dm - 2.0*D_vel) @@ -2936,6 +2955,11 @@ subroutine set_visc_init(Time, G, GV, US, param_file, diag, visc, CS, restart_CS ! is used in place of the absolute value of the local Coriolis ! parameter in the denominator of some expressions [nondim] real :: Chan_max_thick_dflt ! The default value for CHANNEL_DRAG_MAX_THICK [Z ~> m] + real :: shelfbreak_depth ! When CHANNEL_DRAG is true, the bathymetric depth interpolated + ! to the vorticity point is a combination of the harmonic mean of the + ! adjacent velocity point depths below this depth [Z ~> m] and the + ! arithmetic mean of the adjacent depths above it, to roughly mimic a + ! continental shelf break profile. real, allocatable, dimension(:,:) :: cdrag_h !< The spatially varying quadratic drag coefficient [nondim] integer :: i, j, k, is, ie, js, je @@ -2990,8 +3014,18 @@ subroutine set_visc_init(Time, G, GV, US, param_file, diag, visc, CS, restart_CS default=.false., do_not_log=.not.CS%bottomdraglaw) call get_param(param_file, mdl, "CHANNEL_DRAG", CS%Channel_drag, & "If true, the bottom drag is exerted directly on each "//& - "layer proportional to the fraction of the bottom it "//& - "overlies.", default=.false.) + "layer proportional to the fraction of the bottom it overlies.", & + default=.false.) + call get_param(param_file, mdl, "CHANNEL_DRAG_SHELFBREAK_DEPTH", shelfbreak_depth, & + "When CHANNEL_DRAG is true, the bathymetric depth interpolated to the "//& + "vorticity point is a combination of the harmonic mean of the adjacent "//& + "velocity point depths below this depth and the arithmetic mean of the "//& + "depths above it, to roughly mimic a continental shelf break profile. "//& + "Setting this to exceed MAXIMUM_DEPTH leads to linear interpolation of "//& + "the topography between velocity points.", & + default=0.0, units="m", scale=US%m_to_Z, do_not_log=.not.CS%Channel_drag) + CS%channel_break_depth = shelfbreak_depth - G%Z_ref + call get_param(param_file, mdl, "LINEAR_DRAG", CS%linear_drag, & "If LINEAR_DRAG and BOTTOMDRAGLAW are defined the drag "//& "law is cdrag*DRAG_BG_VEL*u.", default=.false.) From 50b2c3b1cbbca1b9b036d78d3cee7e2c73e2a7aa Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Mon, 1 Dec 2025 14:24:04 -0500 Subject: [PATCH 19/64] Corrected 66 unit descriptions in comments Corrected the incorrect or inconsistent unit descriptions of 28 variables, added descriptions of the units of 4 others, and corrected the non-standard syntax (e.g. backwards or in the wrong order) in the description of 35 variables, scattered across 27 files. Only comments are changed and all answers are bitwise identical. --- src/core/MOM_barotropic.F90 | 14 +++++++------- src/core/MOM_check_scaling.F90 | 2 +- src/core/MOM_interface_heights.F90 | 2 +- src/core/MOM_verticalGrid.F90 | 2 +- src/diagnostics/MOM_diagnose_KdWork.F90 | 12 ++++++------ src/diagnostics/MOM_sum_output.F90 | 4 ++-- src/diagnostics/MOM_wave_speed.F90 | 6 +++--- src/equation_of_state/MOM_EOS_Wright.F90 | 2 +- src/equation_of_state/MOM_EOS_Wright_full.F90 | 2 +- src/equation_of_state/MOM_EOS_Wright_red.F90 | 2 +- src/ice_shelf/MOM_ice_shelf.F90 | 12 ++++++------ src/ice_shelf/MOM_ice_shelf_dynamics.F90 | 6 +++--- src/ice_shelf/MOM_ice_shelf_initialize.F90 | 6 +++--- src/initialization/MOM_state_initialization.F90 | 2 +- src/ocean_data_assim/MOM_oda_driver.F90 | 2 +- .../lateral/MOM_internal_tides.F90 | 10 +++++----- .../lateral/MOM_lateral_mixing_coeffs.F90 | 4 ++-- .../lateral/MOM_mixed_layer_restrat.F90 | 8 ++++---- .../lateral/MOM_self_attr_load.F90 | 2 +- .../stochastic/MOM_stochastics.F90 | 10 +++++----- .../vertical/MOM_bulk_mixed_layer.F90 | 4 ++-- .../vertical/MOM_energetic_PBL.F90 | 9 +++++---- src/parameterizations/vertical/MOM_geothermal.F90 | 2 +- src/parameterizations/vertical/MOM_kappa_shear.F90 | 2 +- .../vertical/MOM_set_diffusivity.F90 | 12 +++++------- .../vertical/MOM_set_viscosity.F90 | 4 ++-- .../vertical/MOM_tidal_mixing.F90 | 4 ++-- src/tracer/MARBL_tracers.F90 | 2 +- src/tracer/MOM_CFC_cap.F90 | 2 +- src/user/SCM_CVMix_tests.F90 | 2 +- 30 files changed, 76 insertions(+), 77 deletions(-) diff --git a/src/core/MOM_barotropic.F90 b/src/core/MOM_barotropic.F90 index c9f71ebd95..2c7e19be58 100644 --- a/src/core/MOM_barotropic.F90 +++ b/src/core/MOM_barotropic.F90 @@ -2470,9 +2470,9 @@ subroutine btstep_timeloop(eta, ubt, vbt, uhbt0, Datu, BTCL_u, vhbt0, Datv, BTCL PFu, & ! The zonal pressure force acceleration [L T-2 ~> m s-2] Cor_u, & ! The zonal Coriolis acceleration [L T-2 ~> m s-2] ubt_int, & ! The running time integral of ubt over the time steps [L ~> m] - uhbt_int, & ! The running time integral of uhbt over the time steps [H L2 ~> m3] + uhbt_int, & ! The running time integral of uhbt over the time steps [H L2 ~> m3 or kg] ubt_int_prev, & ! Previous value of time-integrated velocity stored for OBCs [L ~> m] - uhbt_int_prev ! Previous value of time-integrated transport stored for integral_BT_cont [L2 H ~> m3] + uhbt_int_prev ! Previous value of time-integrated transport stored for integral_BT_cont [H L2 ~> m3 or kg] real, dimension(SZIW_(CS),SZJBW_(CS)) :: & vhbt, & ! The meridional barotropic thickness fluxes [H L2 T-1 ~> m3 s-1 or kg s-1] vbt_prev, & ! The starting value of vbt in a barotropic step [L T-1 ~> m s-1] @@ -2480,14 +2480,14 @@ subroutine btstep_timeloop(eta, ubt, vbt, uhbt0, Datu, BTCL_u, vhbt0, Datv, BTCL PFv, & ! The meridional pressure force acceleration [L T-2 ~> m s-2] Cor_v, & ! The meridional Coriolis acceleration [L T-2 ~> m s-2] vbt_int, & ! The running time integral of vbt over the time steps [L ~> m] - vhbt_int, & ! The running time integral of vhbt over the time steps [H L2 ~> m3] + vhbt_int, & ! The running time integral of vhbt over the time steps [H L2 ~> m3 or kg] vbt_int_prev, & ! Previous value of time-integrated velocity stored for OBCs [L ~> m] - vhbt_int_prev ! Previous value of time-integrated transport stored for integral_BT_cont [L2 H ~> m3] + vhbt_int_prev ! Previous value of time-integrated transport stored for integral_BT_cont [H L2 ~> m3 or kg] real, target, dimension(SZIW_(CS),SZJW_(CS)) :: & eta_pred ! A predictor value of eta [H ~> m or kg m-2] like eta real, dimension(SZIW_(CS),SZJW_(CS)) :: & p_surf_dyn, & !< A dynamic surface pressure under rigid ice [L2 T-2 ~> m2 s-2] - cfl_ltd_vol !< The volume available after removing sinks used to limit uhbt_int and vhbt_int [H L2 ~> m3] + cfl_ltd_vol !< The volume available after removing sinks used to limit uhbt_int and vhbt_int [H L2 ~> m3 or kg] real, dimension(SZI_(G),SZJ_(G)) :: & eta_anom_PF ! The eta anomalies used to find the pressure force anomalies [H ~> m or kg m-2] real :: wt_end ! The weighting of the final value of eta_PF [nondim] @@ -3196,9 +3196,9 @@ subroutine btloop_eta_predictor(n, dtbt, ubt, vbt, eta, ubt_int, vbt_int, uhbt, real, dimension(SZIW_(CS),SZJBW_(CS)), intent(inout) :: & vhbt !< The meridional barotropic thickness fluxes [H L2 T-1 ~> m3 s-1 or kg s-1]. real, dimension(SZIBW_(CS),SZJW_(CS)), intent(inout) :: & - uhbt_int !< The running time integral of uhbt over the time steps [H L2 ~> m3]. + uhbt_int !< The running time integral of uhbt over the time steps [H L2 ~> m3 or kg]. real, dimension(SZIW_(CS),SZJBW_(CS)), intent(inout) :: & - vhbt_int !< The running time integral of vhbt over the time steps [H L2 ~> m3]. + vhbt_int !< The running time integral of vhbt over the time steps [H L2 ~> m3 or kg]. real, target, dimension(SZIW_(CS),SZJW_(CS)), intent(inout) :: & eta_pred !< A predictor value of eta [H ~> m or kg m-2] like eta. integer, intent(in) :: isv !< The starting i-index of eta_pred to calculate diff --git a/src/core/MOM_check_scaling.F90 b/src/core/MOM_check_scaling.F90 index 2841514924..07db537c64 100644 --- a/src/core/MOM_check_scaling.F90 +++ b/src/core/MOM_check_scaling.F90 @@ -126,7 +126,7 @@ subroutine compose_dimension_list(ns, des, wts) call add_scaling(ns, des, wts, "[S H ~> ppt m or ppt kg m-2]", 8) ! Depth integrated salinity call add_scaling(ns, des, wts, "[Z2 T-2 ~> m2 s-2]", 8) ! Turbulent kinetic energy call add_scaling(ns, des, wts, "[R L2 Z T-2 ~> Pa m]", 7) ! Vertically integrated pressure anomalies - call add_scaling(ns, des, wts, "[Z2 T-1 / Z3 T-3 = T2 Z-1 ~> s2 m-1]", 7) ! (TKE_to_Kd) + call add_scaling(ns, des, wts, "[T2 Z-1 ~> s2 m-1]", 7) ! (TKE_to_Kd) call add_scaling(ns, des, wts, "[L4 T-1 ~> m4 s-1]", 7) ! Biharmonic viscosity call add_scaling(ns, des, wts, "[L3 ~> m3]", 7) ! Metric dependent constants for viscosity call add_scaling(ns, des, wts, "[L2 T-3 ~> m2 s-3]", 7) ! Buoyancy flux or MEKE sources [L2 T-3 ~> W kg-1] diff --git a/src/core/MOM_interface_heights.F90 b/src/core/MOM_interface_heights.F90 index c9e4bc015e..5a66b4375e 100644 --- a/src/core/MOM_interface_heights.F90 +++ b/src/core/MOM_interface_heights.F90 @@ -480,7 +480,7 @@ subroutine find_rho_bottom(G, GV, US, tv, h, dz, pres_int, dz_avg, j, Rho_bot, h ! Local variables real :: hb(SZI_(G)) ! Running sum of the thickness in the bottom boundary layer [H ~> m or kg m-2] real :: SpV_h_bot(SZI_(G)) ! Running sum of the specific volume times thickness in the bottom - ! boundary layer [R-1 H ~> m4 kg-1 or m] + ! boundary layer [H R-1 ~> m4 kg-1 or m] real :: dz_bbl_rem(SZI_(G)) ! Vertical extent of the boundary layer that has yet to be accounted ! for [Z ~> m] real :: h_bbl_frac(SZI_(G)) ! Thickness of the fractional layer that makes up the top of the diff --git a/src/core/MOM_verticalGrid.F90 b/src/core/MOM_verticalGrid.F90 index 4713fb6797..13207121e7 100644 --- a/src/core/MOM_verticalGrid.F90 +++ b/src/core/MOM_verticalGrid.F90 @@ -74,7 +74,7 @@ module MOM_verticalGrid real :: H_to_m !< A constant that translates distances in the units of thickness !! to m [m H-1 ~> 1 or m3 kg-1]. real :: H_to_Pa !< A constant that translates the units of thickness to pressure - !! [Pa H-1 = kg m-1 s-2 H-1 ~> kg m-2 s-2 or m s-2]. + !! [Pa H-1 ~> kg m-2 s-2 or m s-2]. real :: H_to_Z !< A constant that translates thickness units to the units of !! depth [Z H-1 ~> 1 or m3 kg-1]. real :: Z_to_H !< A constant that translates depth units to thickness units diff --git a/src/diagnostics/MOM_diagnose_KdWork.F90 b/src/diagnostics/MOM_diagnose_KdWork.F90 index 8b89933169..06e7be36ae 100644 --- a/src/diagnostics/MOM_diagnose_KdWork.F90 +++ b/src/diagnostics/MOM_diagnose_KdWork.F90 @@ -32,13 +32,13 @@ module MOM_diagnose_kdwork ! 3d varying Kd contributions real, pointer, dimension(:,:,:) :: & Bflx_salt => NULL(), & !< Salinity contribution to buoyancy flux at interfaces - !! [H Z T-3 ~> m2 s-3 or kg m-1 s-3 = W m-3] + !! [H Z T-3 ~> m2 s-3 or W m-3] Bflx_temp => NULL(), & !< Temperature contribution to buoyancy flux at interfaces - !! [H Z T-3 ~> m2 s-3 or kg m-1 s-3 = W m-3] + !! [H Z T-3 ~> m2 s-3 or W m-3] Bflx_salt_dz => NULL(), & !< Salinity contribution to integral of buoyancy flux over layer - !! [H Z2 T-3 ~> m3 s-3 or kg m-1 s-3 = W m-2] + !! [H Z2 T-3 ~> m3 s-3 or W m-2] Bflx_temp_dz => NULL(), & !< Temperature contribution to integral of buoyancy flux over layer - !! [H Z2 T-3 ~> m3 s-3 or kg m-1 s-3 = W m-2] + !! [H Z2 T-3 ~> m3 s-3 or W m-2] ! The following are all allocatable arrays that store copies of process driven Kd, so that ! the process driven buoyancy flux and work can be derived at the end of the time step. Kd_salt => NULL(), & !< total diapycnal diffusivity of salt at interfaces [H Z T-1 ~> m2 s-1 or kg m-1 s-1] @@ -740,11 +740,11 @@ subroutine diagnoseKdWork(G, GV, N2, Kd, Bdif_flx, dz, Bdif_flx_dz) real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), & intent(in) :: Kd !< Diffusivity [H Z T-1 ~> m2 s-1 or kg m-1 s-1] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), & - intent(out) :: Bdif_flx !< Buoyancy flux [H Z T-3 ~> m2 s-3 or kg m-1 s-3 = W m-3] + intent(out) :: Bdif_flx !< Buoyancy flux [H Z T-3 ~> m2 s-3 or W m-3] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in), optional :: dz !< Grid spacing [Z ~> m] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & - intent(out), optional :: Bdif_flx_dz !< Buoyancy flux over layer [H Z2 T-3 ~> m3 s-3 or kg s-3 = W m-2] + intent(out), optional :: Bdif_flx_dz !< Buoyancy flux over layer [H Z2 T-3 ~> m3 s-3 or W m-2] integer :: i, j, k diff --git a/src/diagnostics/MOM_sum_output.F90 b/src/diagnostics/MOM_sum_output.F90 index a9a4daecc3..a861f7192f 100644 --- a/src/diagnostics/MOM_sum_output.F90 +++ b/src/diagnostics/MOM_sum_output.F90 @@ -409,9 +409,9 @@ subroutine write_energy(u, v, h, tv, day, n, G, GV, US, CS, tracer_CSp, dt_forci real :: QRZL2_to_J ! The combination of unit rescaling factors to convert integrated heat ! content into mks units [J Q-1 R-1 Z-1 L-2 ~> 1] real :: J_to_QRZL2 ! The combination of unit rescaling factors to rescale integrated heat - ! content from mks units into the internal units of MOM6 [Q R Z L J-1 ~> 1] + ! content from mks units into the internal units of MOM6 [Q R Z L2 J-1 ~> 1] real :: kg_to_RZL2 ! The combination of unit rescaling factors to rescale masses from - ! mks units into the internal units of MOM6 [R Z L kg-1 ~> 1] + ! mks units into the internal units of MOM6 [R Z L2 kg-1 ~> 1] real :: salt_to_kg ! A factor used to rescale salt contents [kg R-1 Z-1 L-2 ~> nondim] integer :: num_nc_fields ! The number of fields that will actually go into ! the NetCDF file. diff --git a/src/diagnostics/MOM_wave_speed.F90 b/src/diagnostics/MOM_wave_speed.F90 index b525efd149..be5b29ac0e 100644 --- a/src/diagnostics/MOM_wave_speed.F90 +++ b/src/diagnostics/MOM_wave_speed.F90 @@ -135,7 +135,7 @@ subroutine wave_speed(h, tv, G, GV, US, cg1, CS, halo_size, use_ebt_mode, mono_N real :: I_Hnew ! The inverse of a new layer thickness [H-1 ~> m-1 or m2 kg-1] real :: drxh_sum ! The sum of density differences across interfaces times thicknesses [R H ~> kg m-2 or kg2 m-5] real :: dSpVxh_sum ! The sum of specific volume differences across interfaces times - ! thicknesses [R-1 H ~> m4 kg-1 or m], negative for stable stratification. + ! thicknesses [H R-1 ~> m4 kg-1 or m], negative for stable stratification. real :: g_Rho0 ! G_Earth/Rho0 [L2 T-2 H-1 R-1 ~> m4 s-2 kg-1 or m7 s-2 kg-2]. real :: c2_scale ! A scaling factor for wave speeds to help control the growth of the determinant and ! its derivative with lam between rows of the Thomas algorithm solver [L2 s2 T-2 m-2 ~> nondim]. @@ -852,7 +852,7 @@ subroutine wave_speeds(h, tv, G, GV, US, nmodes, cn, CS, w_struct, u_struct, u_s real :: I_Hnew ! The inverse of a new layer thickness [H-1 ~> m-1 or m2 kg-1] real :: drxh_sum ! The sum of density differences across interfaces times thicknesses [R H ~> kg m-2 or kg2 m-5] real :: dSpVxh_sum ! The sum of specific volume differences across interfaces times - ! thicknesses [R-1 H ~> m4 kg-1 or m], negative for stable stratification. + ! thicknesses [H R-1 ~> m4 kg-1 or m], negative for stable stratification. real :: g_Rho0 ! G_Earth/Rho0 [L2 T-2 H-1 R-1 ~> m4 s-2 kg-1 or m7 s-2 kg-2]. real :: tol_Hfrac ! Layers that together are smaller than this fraction of ! the total water column can be merged for efficiency [nondim]. @@ -879,7 +879,7 @@ subroutine wave_speeds(h, tv, G, GV, US, nmodes, cn, CS, w_struct, u_struct, u_s real :: mode_struct(SZK_(GV)+1) ! The mode structure [nondim], but it is also temporarily ! in units of [L2 T-2 ~> m2 s-2] after it is modified inside of tdma6. real :: mode_struct_fder(SZK_(GV)) ! The mode structure 1st derivative [Z-1 ~> m-1], but it is also temporarily - ! in units of [Z-1 L2 T-2 ~> m s-2] after it is modified inside of tdma6. + ! in units of [L2 Z-1 T-2 ~> m s-2] after it is modified inside of tdma6. real :: mode_struct_sq(SZK_(GV)+1) ! The square of mode structure [nondim] real :: mode_struct_fder_sq(SZK_(GV)) ! The square of mode structure 1st derivative [Z-2 ~> m-2] diff --git a/src/equation_of_state/MOM_EOS_Wright.F90 b/src/equation_of_state/MOM_EOS_Wright.F90 index 874d3e784e..938fa07200 100644 --- a/src/equation_of_state/MOM_EOS_Wright.F90 +++ b/src/equation_of_state/MOM_EOS_Wright.F90 @@ -719,7 +719,7 @@ subroutine int_spec_vol_dp_wright(T, S, p_t, p_b, spv_ref, HI, dza, & real :: al0 ! A term in the Wright EOS [R-1 ~> m3 kg-1] real :: p0 ! A term in the Wright EOS [R L2 T-2 ~> Pa] real :: lambda ! A term in the Wright EOS [L2 T-2 ~> m2 s-2] - real :: al0_scale ! Scaling factor to convert al0 from MKS units [R-1 kg m-3 ~> 1] + real :: al0_scale ! Scaling factor to convert al0 from MKS units [kg m-3 R-1 ~> 1] real :: p0_scale ! Scaling factor to convert p0 from MKS units [R L2 T-2 Pa-1 ~> 1] real :: lam_scale ! Scaling factor to convert lambda from MKS units [L2 s2 T-2 m-2 ~> 1] real :: p_ave ! The layer average pressure [R L2 T-2 ~> Pa] diff --git a/src/equation_of_state/MOM_EOS_Wright_full.F90 b/src/equation_of_state/MOM_EOS_Wright_full.F90 index 4be5f2940e..fdbe01eb15 100644 --- a/src/equation_of_state/MOM_EOS_Wright_full.F90 +++ b/src/equation_of_state/MOM_EOS_Wright_full.F90 @@ -724,7 +724,7 @@ subroutine int_spec_vol_dp_wright_full(T, S, p_t, p_b, spv_ref, HI, dza, & real :: al0 ! A term in the Wright EOS [R-1 ~> m3 kg-1] real :: p0 ! A term in the Wright EOS [R L2 T-2 ~> Pa] real :: lambda ! A term in the Wright EOS [L2 T-2 ~> m2 s-2] - real :: al0_scale ! Scaling factor to convert al0 from MKS units [R-1 kg m-3 ~> 1] + real :: al0_scale ! Scaling factor to convert al0 from MKS units [kg m-3 R-1 ~> 1] real :: p0_scale ! Scaling factor to convert p0 from MKS units [R L2 T-2 Pa-1 ~> 1] real :: lam_scale ! Scaling factor to convert lambda from MKS units [L2 s2 T-2 m-2 ~> 1] real :: p_ave ! The layer average pressure [R L2 T-2 ~> Pa] diff --git a/src/equation_of_state/MOM_EOS_Wright_red.F90 b/src/equation_of_state/MOM_EOS_Wright_red.F90 index 1635f9e809..996d838f12 100644 --- a/src/equation_of_state/MOM_EOS_Wright_red.F90 +++ b/src/equation_of_state/MOM_EOS_Wright_red.F90 @@ -726,7 +726,7 @@ subroutine int_spec_vol_dp_wright_red(T, S, p_t, p_b, spv_ref, HI, dza, & real :: al0 ! A term in the Wright EOS [R-1 ~> m3 kg-1] real :: p0 ! A term in the Wright EOS [R L2 T-2 ~> Pa] real :: lambda ! A term in the Wright EOS [L2 T-2 ~> m2 s-2] - real :: al0_scale ! Scaling factor to convert al0 from MKS units [R-1 kg m-3 ~> 1] + real :: al0_scale ! Scaling factor to convert al0 from MKS units [kg m-3 R-1 ~> 1] real :: p0_scale ! Scaling factor to convert p0 from MKS units [R L2 T-2 Pa-1 ~> 1] real :: lam_scale ! Scaling factor to convert lambda from MKS units [L2 s2 T-2 m-2 ~> 1] real :: p_ave ! The layer average pressure [R L2 T-2 ~> Pa] diff --git a/src/ice_shelf/MOM_ice_shelf.F90 b/src/ice_shelf/MOM_ice_shelf.F90 index b0a930346b..a3819b3bdf 100644 --- a/src/ice_shelf/MOM_ice_shelf.F90 +++ b/src/ice_shelf/MOM_ice_shelf.F90 @@ -338,13 +338,13 @@ subroutine shelf_calc_flux(sfc_state_in, fluxes_in, Time, time_step_in, CS) real :: Sb_min, Sb_max ! Minimum and maximum boundary salinities [S ~> ppt] real :: dS_min, dS_max ! Minimum and maximum salinity changes [S ~> ppt] ! Variables used in iterating for wB_flux. - real :: wB_flux_next ! The next interation's guess for wB_flux [Z2 T-3 ~> m2 s-2] - real :: wB_flux_new ! An updated value of wB_flux when Gam_turb is based on wB_flux [Z2 T-3 ~> m2 s-2] - real :: wB_flux_max ! The upper bound on wB_flux [Z2 T-3 ~> m2 s-2] - real :: wB_flux_min ! The lower bound on wB_flux [Z2 T-3 ~> m2 s-2] + real :: wB_flux_next ! The next interation's guess for wB_flux [Z2 T-3 ~> m2 s-3] + real :: wB_flux_new ! An updated value of wB_flux when Gam_turb is based on wB_flux [Z2 T-3 ~> m2 s-3] + real :: wB_flux_max ! The upper bound on wB_flux [Z2 T-3 ~> m2 s-3] + real :: wB_flux_min ! The lower bound on wB_flux [Z2 T-3 ~> m2 s-3] real :: dDwB_dwB ! The slope of the change in wB_flux between iterations with wB_flux [nondim] - real :: DwB_max ! The change in wB_flux when it is wB_flux_max [Z2 T-3 ~> m2 s-2] - real :: DwB_min ! The change in wB_flux when it is wB_flux_min [Z2 T-3 ~> m2 s-2] + real :: DwB_max ! The change in wB_flux when it is wB_flux_max [Z2 T-3 ~> m2 s-3] + real :: DwB_min ! The change in wB_flux when it is wB_flux_min [Z2 T-3 ~> m2 s-3] real :: I_Gam_T, I_Gam_S ! Terms that vary inversely with Gam_mol_T or Gam_mol_S and Gam_turb [nondim] real :: dG_dwB ! The derivative of Gam_turb with wB [T3 Z-2 ~> s3 m-2] real :: taux2, tauy2 ! The squared surface stresses [R2 L2 Z2 T-4 ~> Pa2]. diff --git a/src/ice_shelf/MOM_ice_shelf_dynamics.F90 b/src/ice_shelf/MOM_ice_shelf_dynamics.F90 index 904624f924..4f8a9f0cf2 100644 --- a/src/ice_shelf/MOM_ice_shelf_dynamics.F90 +++ b/src/ice_shelf/MOM_ice_shelf_dynamics.F90 @@ -1085,7 +1085,7 @@ subroutine IS_dynamics_post_data(time_step, Time, CS, ISS, G) real, dimension(SZDI_(G),SZDJ_(G)) :: ice_visc ! area-averaged vertically integrated ice viscosity !! [R L2 Z T-1 ~> Pa s m] real, dimension(SZDI_(G),SZDJ_(G)) :: basal_tr ! area-averaged taub_beta field related to basal traction, - !! [R L1 T-1 ~> Pa s m-1] + !! [R L T-1 ~> Pa s m-1] real, dimension(SZDIB_(G),SZDJB_(G)) :: surf_slope ! the surface slope of the ice shelf/sheet [nondim] real, dimension(SZDIB_(G),SZDJB_(G)) :: ice_speed ! ice sheet flow speed [L T-1 ~> m s-1] @@ -3287,9 +3287,9 @@ subroutine calc_shelf_visc(CS, ISS, G, US, u_shlf, v_shlf) CS%ice_visc(i,j,1) = (G%areaT(i,j) * max(ISS%h_shelf(i,j),CS%min_h_shelf)) * & max(CS%AGlen_visc(i,j) ,CS%min_ice_visc) endif - ! Here CS%Aglen_visc(i,j) is the ice viscosity [Pa s ~> R L2 T-1] computed from obs and read from a file + ! Here CS%Aglen_visc(i,j) is the ice viscosity [R L2 T-1 ~> Pa s] computed from obs and read from a file elseif (model_qp1) then - !calculate viscosity at 1 cell-centered quadrature point per cell + ! calculate viscosity at 1 cell-centered quadrature point per cell Visc_coef = (CS%AGlen_visc(i,j))**(-1./n_g) ! Units of Aglen_visc [Pa-(n_g) s-1] diff --git a/src/ice_shelf/MOM_ice_shelf_initialize.F90 b/src/ice_shelf/MOM_ice_shelf_initialize.F90 index ec24aef2d0..a120f8a45e 100644 --- a/src/ice_shelf/MOM_ice_shelf_initialize.F90 +++ b/src/ice_shelf/MOM_ice_shelf_initialize.F90 @@ -311,7 +311,7 @@ subroutine initialize_ice_shelf_boundary_channel(u_face_mask_bdry, v_face_mask_b character(len=40) :: mdl = "initialize_ice_shelf_boundary_channel" ! This subroutine's name. integer :: i, j, isd, jsd, giec, gjec, gisc, gjsc,gisd,gjsd, isc, jsc, iec, jec, ied, jed real :: input_thick ! The input ice shelf thickness [Z ~> m] - real :: input_vel ! The input ice velocity per [L Z T-1 ~> m s-1] + real :: input_vel ! The input ice velocity at the upstream boundary [L T-1 ~> m s-1] real :: lenlat, len_stress, westlon, lenlon, southlat ! The input positions of the channel boundarises lenlat = G%len_lat @@ -649,10 +649,10 @@ subroutine initialize_ice_AGlen(AGlen, ice_viscosity_compute, G, US, PF) " initialize_ice_stiffness_from_file: Unable to open "//trim(filename)) if (trim(ice_viscosity_compute) == "OBS") then - !AGlen is the ice viscosity [Pa s ~> R L2 T-1] computed from obs and read from a file + ! AGlen is the ice viscosity [R L2 T-1 ~> Pa s] computed from obs and read from a file call MOM_read_data(filename, trim(varname), AGlen, G%Domain, scale=US%Pa_to_RL2_T2*US%s_to_T) else - !AGlen is the ice stiffness parameter [Pa-n_g s-1] + ! AGlen is the ice stiffness parameter [Pa-n_g s-1] call MOM_read_data(filename, trim(varname), AGlen, G%Domain) endif endif diff --git a/src/initialization/MOM_state_initialization.F90 b/src/initialization/MOM_state_initialization.F90 index 1ea49671a6..f5ed0a2b46 100644 --- a/src/initialization/MOM_state_initialization.F90 +++ b/src/initialization/MOM_state_initialization.F90 @@ -150,7 +150,7 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, US, PF, dirs, & !! by a floating ice shelf [nondim]. real, dimension(SZI_(G),SZJ_(G)), & optional, intent(in) :: mass_shelf !< The mass per unit area of the overlying - !! ice shelf [ R Z ~> kg m-2 ] + !! ice shelf [R Z ~> kg m-2] type(ocean_OBC_type), optional, pointer :: OBC_for_bug !< An open boundary condition control structure !! that might be used to store OBC temperatures and !! salinities if OBC_RESERVOIR_INIT_BUG is true. diff --git a/src/ocean_data_assim/MOM_oda_driver.F90 b/src/ocean_data_assim/MOM_oda_driver.F90 index 3b277578a3..7f9bcb19a1 100644 --- a/src/ocean_data_assim/MOM_oda_driver.F90 +++ b/src/ocean_data_assim/MOM_oda_driver.F90 @@ -125,7 +125,7 @@ module MOM_oda_driver_mod integer :: ensemble_id = 0 !< id of the current ensemble member integer, pointer, dimension(:,:) :: ensemble_pelist !< PE list for ensemble members integer, pointer, dimension(:) :: filter_pelist !< PE list for ensemble members - real :: assim_interval !< analysis interval [ T ~> s] + real :: assim_interval !< analysis interval [T ~> s] ! Profiles local to the analysis domain type(ocean_profile_type), pointer :: Profiles => NULL() !< pointer to linked list of all available profiles type(ocean_profile_type), pointer :: CProfiles => NULL()!< pointer to linked list of current profiles diff --git a/src/parameterizations/lateral/MOM_internal_tides.F90 b/src/parameterizations/lateral/MOM_internal_tides.F90 index e4a48c84c5..05c471cc17 100644 --- a/src/parameterizations/lateral/MOM_internal_tides.F90 +++ b/src/parameterizations/lateral/MOM_internal_tides.F90 @@ -48,7 +48,7 @@ module MOM_internal_tides integer :: nMode = 1 !< The number of internal tide vertical modes integer :: nAngle = 24 !< The number of internal tide angular orientations integer :: energized_angle = -1 !< If positive, only this angular band is energized for debugging purposes - real :: dt_itides !< The timestep for internal tides ray-tracing [s ~> T] + real :: dt_itides !< The timestep for internal tides ray-tracing [T ~> s] real :: uniform_test_cg !< Uniform group velocity of internal tide !! for testing internal tides [L T-1 ~> m s-1] logical :: corner_adv !< If true, use a corner advection rather than PPM. @@ -130,7 +130,7 @@ module MOM_internal_tides real, allocatable, dimension(:,:) :: tot_quad_loss !< Energy loss rates due to quadratic bottom drag, !! summed over angle, frequency and mode [H Z2 T-3 ~> m3 s-3 or W m-2] real, allocatable, dimension(:,:) :: tot_itidal_loss !< Energy loss rates due to small-scale drag, - !! summed over angle, frequency and mode [H Z2 T-3 ~> m3 s-3 or W m-2] + !! summed over angle, frequency and mode [H Z2 T-3 ~> m3 s-3 or W m-2] real, allocatable, dimension(:,:) :: tot_Froude_loss !< Energy loss rates due to wave breaking, !! summed over angle, frequency and mode [H Z2 T-3 ~> m3 s-3 or W m-2] real, allocatable, dimension(:,:) :: tot_residual_loss !< Energy loss rates due to residual on slopes, @@ -1363,7 +1363,7 @@ subroutine itidal_lowmode_loss(G, GV, US, CS, Nb, Rho_bot, Ub, En, TKE_loss_fixe if (En_tot > 0.0) then do a=1,CS%nAngle frac_per_sector = En(i,j,a,fr,m)/En_tot - TKE_loss(i,j,a,fr,m) = frac_per_sector*TKE_loss_tot ! [H Z2 T-3 ~> m3 s-3 or W m-2] + TKE_loss(i,j,a,fr,m) = frac_per_sector*TKE_loss_tot ! [H Z2 T-3 ~> m3 s-3 or W m-2] loss_rate = TKE_loss(i,j,a,fr,m) / (En(i,j,a,fr,m) + En_negl) ! [T-1 ~> s-1] En_b = En(i,j,a,fr,m) En_a = En(i,j,a,fr,m) / (1.0 + (dt*loss_rate)) @@ -1426,7 +1426,7 @@ subroutine get_lowmode_diffusivity(G, GV, h, tv, US, h_bot, k_bot, j, N2_lay, N2 !! dissipated within a layer and the !! diapycnal diffusivity within that layer, !! usually (~Rho_0 / (G_Earth * dRho_lay)) - !! [H Z T-1 / H Z2 T-3 = T2 Z-1 ~> s2 m-1] + !! [T2 Z-1 ~> s2 m-1] real, intent(in) :: Kd_max !< The maximum increment for diapycnal !! diffusivity due to TKE-based processes !! [H Z T-1 ~> m2 s-1 or kg m-1 s-1]. @@ -1460,7 +1460,7 @@ subroutine get_lowmode_diffusivity(G, GV, h, tv, US, h_bot, k_bot, j, N2_lay, N2 !! [H-1 ~> m-1 or m2 kg-1] ! local variables - real :: TKE_loss ! temp variable to pass value of internal tides TKE loss [R Z-3 T-3 ~> W m-2] + real :: TKE_loss ! temp variable to pass value of internal tides TKE loss [H Z2 T-3 ~> m3 s-3 or W m-2] real :: renorm_N ! renormalization for N profile [H T-1 ~> m s-1 or kg m-2 s-1] real :: renorm_N2 ! renormalization for N2 profile [H T-2 ~> m s-2 or kg m-2 s-2] real :: tmp_StLau ! tmp var for renormalization for StLaurent profile [nondim] diff --git a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 index 2a7527ce9a..baa4eb3d0c 100644 --- a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 +++ b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 @@ -843,9 +843,9 @@ subroutine calc_Visbeck_coeffs_old(h, slope_x, slope_y, N2_u, N2_v, G, GV, US, C integer :: OBC_dir_v(SZI_(G),SZJB_(G)) ! An integer indicating where there are v OBCs: +1 for ! northern OBCs, -1 for southern OBCs and 0 at points with no OBCs. real :: h4_u(SZIB_(G),SZJ_(G),SZK_(GV)+1) ! The product of the 4 thicknesses surrounding a u-point - ! interface or the inward equivalent with OBCs [H4 ~> m4 or kg2 m-4] + ! interface or the inward equivalent with OBCs [H4 ~> m4 or kg4 m-8] real :: h4_v(SZI_(G),SZJB_(G),SZK_(GV)+1) ! The product of the 4 thicknesses surrounding a v-point - ! interface or the inward equivalent with OBCs [H4 ~> m4 or kg2 m-4] + ! interface or the inward equivalent with OBCs [H4 ~> m4 or kg4 m-8] integer :: i, j, k, is, ie, js, je, nz if (.not. CS%initialized) call MOM_error(FATAL, "calc_Visbeck_coeffs_old: "// & diff --git a/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 b/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 index add367f23e..52b126de4f 100644 --- a/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 +++ b/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 @@ -227,8 +227,8 @@ subroutine mixedlayer_restrat_OM4(h, uhtr, vhtr, tv, forces, dt, h_MLD, VarMix, real :: g_Rho0 ! G_Earth/Rho0 times a thickness conversion factor ! [L2 H-1 T-2 R-1 ~> m4 s-2 kg-1 or m7 s-2 kg-2] real :: rho_ml(SZI_(G)) ! Potential density relative to the surface [R ~> kg m-3] - real :: rml_int_fast(SZI_(G)) ! The integral of density over the mixed layer depth [R H ~> kg m-2 or kg2 m-3] - real :: rml_int_slow(SZI_(G)) ! The integral of density over the mixed layer depth [R H ~> kg m-2 or kg2 m-3] + real :: rml_int_fast(SZI_(G)) ! The integral of density over the mixed layer depth [R H ~> kg m-2 or kg2 m-5] + real :: rml_int_slow(SZI_(G)) ! The integral of density over the mixed layer depth [R H ~> kg m-2 or kg2 m-5] real :: SpV_ml(SZI_(G)) ! Specific volume evaluated at the surface pressure [R-1 ~> m3 kg-1] real :: SpV_int_fast(SZI_(G)) ! Specific volume integrated through the mixed layer [H R-1 ~> m4 kg-1 or m] real :: SpV_int_slow(SZI_(G)) ! Specific volume integrated through the mixed layer [H R-1 ~> m4 kg-1 or m] @@ -813,7 +813,7 @@ subroutine mixedlayer_restrat_Bodner(CS, G, GV, US, h, uhtr, vhtr, tv, forces, d real :: grid_dsd ! combination of grid scales [L2 ~> m2] real :: h_sml ! "Little h", the active mixing depth with diurnal cycle removed [H ~> m or kg m-2] real :: h_big ! "Big H", the mixed layer depth based on a time filtered "little h" [H ~> m or kg m-2] - real :: grd_b ! The vertically average gradient of buoyancy [L H-1 T-2 ~> s-2 or m-3 kg-1 s-2] + real :: grd_b ! The vertically average gradient of buoyancy [L H-1 T-2 ~> s-2 or m3 kg-1 s-2] real :: psi_mag ! Magnitude of stream function [L2 H T-1 ~> m3 s-1 or kg s-1] real :: h_neglect ! tiny thickness usually lost in roundoff so can be neglected [H ~> m or kg m-2] real :: I4dt ! 1/(4 dt) [T-1 ~> s-1] @@ -1251,7 +1251,7 @@ subroutine mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, dt, G, GV, US, CS) real :: g_Rho0 ! G_Earth/Rho0 times a thickness conversion factor ! [L2 H-1 T-2 R-1 ~> m4 s-2 kg-1 or m7 s-2 kg-2] real :: Rho_ml(SZI_(G)) ! Potential density relative to the surface [R ~> kg m-3] - real :: rho_int(SZI_(G)) ! The integral of density over the mixed layer depth [R H ~> kg m-2 or kg2 m-3] + real :: rho_int(SZI_(G)) ! The integral of density over the mixed layer depth [R H ~> kg m-2 or kg2 m-5] real :: SpV_ml(SZI_(G)) ! Specific volume evaluated at the surface pressure [R-1 ~> m3 kg-1] real :: SpV_int(SZI_(G)) ! Specific volume integrated through the surface layer [H R-1 ~> m4 kg-1 or m] real :: p0(SZI_(G)) ! A pressure of 0 [R L2 T-2 ~> Pa] diff --git a/src/parameterizations/lateral/MOM_self_attr_load.F90 b/src/parameterizations/lateral/MOM_self_attr_load.F90 index bf3f0d50a2..eff707a412 100644 --- a/src/parameterizations/lateral/MOM_self_attr_load.F90 +++ b/src/parameterizations/lateral/MOM_self_attr_load.F90 @@ -38,7 +38,7 @@ module MOM_self_attr_load real :: eta_prop !< The partial derivative of eta_sal with the local value of eta [nondim]. real :: linear_scaling - !< Dimensional coefficients for scalar SAL [nondim or Z T2 L-2 R-1 ~> m Pa-1] + !< Dimensional coefficients for scalar SAL [nondim] or [Z T2 L-2 R-1 ~> m Pa-1] type(sht_CS), allocatable :: sht !< Spherical harmonic transforms (SHT) control structure integer :: sal_sht_Nd diff --git a/src/parameterizations/stochastic/MOM_stochastics.F90 b/src/parameterizations/stochastic/MOM_stochastics.F90 index 66f9dec0ea..cff7ffeadd 100644 --- a/src/parameterizations/stochastic/MOM_stochastics.F90 +++ b/src/parameterizations/stochastic/MOM_stochastics.F90 @@ -53,14 +53,14 @@ module MOM_stochastics !! dissipation rate used to set the amplitude of SKEBS [nondim] real :: skeb_frict_coef !< If skeb_use_frict is true, then skeb_gm_coef * GM_work is added to the !! dissipation rate used to set the amplitude of SKEBS [nondim] - real, allocatable :: skeb_diss(:,:,:) !< Dissipation rate used to set amplitude of SKEBS [L2 T-3 ~> m2 s-2] + real, allocatable :: skeb_diss(:,:,:) !< Dissipation rate used to set amplitude of SKEBS [L2 T-3 ~> m2 s-3] !! Index into this at h points. ! stochastic patterns real, allocatable :: sppt_wts(:,:) !< Random pattern for ocean SPPT - !! tendencies with a number between 0 and 2 - real, allocatable :: skeb_wts(:,:) !< Random pattern for ocean SKEB - real, allocatable :: epbl1_wts(:,:) !< Random pattern for K.E. generation - real, allocatable :: epbl2_wts(:,:) !< Random pattern for K.E. dissipation + !! tendencies with a number between 0 and 2 [nondim] + real, allocatable :: skeb_wts(:,:) !< Random pattern for ocean SKEB [nondim] + real, allocatable :: epbl1_wts(:,:) !< Random pattern for K.E. generation [nondim] + real, allocatable :: epbl2_wts(:,:) !< Random pattern for K.E. dissipation [nondim] type(time_type), pointer :: Time !< Pointer to model time (needed for sponges) type(diag_ctrl), pointer :: diag=>NULL() !< A structure that is used to regulate the diff --git a/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 b/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 index 690688dc1e..b54a1b70d7 100644 --- a/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 +++ b/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 @@ -278,7 +278,7 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, US, C ! over a time step from evaporating fresh water [H ~> m or kg m-2] Net_heat, & ! The net heating at the surface over a time step [C H ~> degC m or degC kg m-2] ! Any penetrating shortwave radiation is not included in Net_heat. - Net_salt, & ! The surface salt flux into the ocean over a time step [S H ~> ppt m or ppt kg m-2] + Net_salt, & ! The surface salt flux into the ocean over a time step [S H ~> ppt m or ppt kg m-2] Idecay_len_TKE, & ! The inverse of a turbulence decay length scale [H-1 ~> m-1 or m2 kg-1]. p_ref, & ! Reference pressure for the potential density governing mixed ! layer dynamics, almost always 0 (or 1e5) [R L2 T-2 ~> Pa]. @@ -1118,7 +1118,7 @@ subroutine mixedlayer_convection(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & real :: T_precip ! The temperature of the precipitation [C ~> degC]. real :: C1_3, C1_6 ! 1/3 and 1/6 [nondim] real :: En_fn, Frac, x1 ! Nondimensional temporary variables [nondim]. - real :: dr, dr0 ! Temporary variables [R H ~> kg m-2 or kg2 m-5] or [R-1 H ~> m4 kg-1 or m]. + real :: dr, dr0 ! Temporary variables [R H ~> kg m-2 or kg2 m-5] or [H R-1 ~> m4 kg-1 or m]. real :: dr_ent, dr_comp ! Temporary variables [R H ~> kg m-2 or kg2 m-5]. real :: dr_dh ! The partial derivative of dr_ent with h_ent [R ~> kg m-3]. real :: h_min, h_max ! The minimum and maximum estimates for h_ent [H ~> m or kg m-2] diff --git a/src/parameterizations/vertical/MOM_energetic_PBL.F90 b/src/parameterizations/vertical/MOM_energetic_PBL.F90 index 7a67cbb5a5..d4b8754762 100644 --- a/src/parameterizations/vertical/MOM_energetic_PBL.F90 +++ b/src/parameterizations/vertical/MOM_energetic_PBL.F90 @@ -458,7 +458,7 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, visc, dt, Kd_int, G, GV, BBL_Vel_Scale, & ! The velocity scale used in getting the BBL part of Kd [Z T-1 ~> m s-1] BBL_Mix_Length ! The length scale used in getting the BBL part of Kd [Z ~> m] real, dimension(SZI_(G),SZJ_(G)) :: & - ! The next 7 diagnostics are terms in the mixed layer TKE budget, all in [R Z3 T-3 ~> W m-2 = kg s-3]. + ! The next 7 diagnostics are terms in the mixed layer TKE budget, all in [R Z3 T-3 ~> W m-2]. diag_TKE_wind, & ! The wind source of TKE [R Z3 T-3 ~> W m-2] diag_TKE_MKE, & ! The resolved KE source of TKE [R Z3 T-3 ~> W m-2] diag_TKE_conv, & ! The convective source of TKE [R Z3 T-3 ~> W m-2] @@ -1028,7 +1028,8 @@ subroutine ePBL_column(h, dz, u, v, T0, S0, dSV_dT, dSV_dS, SpV_dt, TKE_forcing, real :: dz_neglect ! A vertical distance that is so small it is usually lost ! in roundoff and can be neglected [Z ~> m]. real :: dMass ! The mass per unit area within a layer [Z R ~> kg m-2]. - real :: dPres ! The hydrostatic pressure change across a layer [R Z2 T-2 ~> Pa = J m-3]. + real :: dPres ! The hydrostatic pressure change across a layer [R Z2 T-2 ~> Pa] or + ! equivalently [R Z2 T-2 ~> J m-3]. real :: dMKE_max ! The maximum amount of mean kinetic energy that could be ! converted to turbulent kinetic energy if the velocity in ! the layer below an interface were homogenized with all of @@ -2098,8 +2099,8 @@ subroutine ePBL_BBL_column(h, dz, u, v, T0, S0, dSV_dT, dSV_dS, SpV_dt, absf, & real :: dz_neglect ! A vertical distance that is so small it is usually lost ! in roundoff and can be neglected [Z ~> m]. real :: dMass ! The mass per unit area within a layer [Z R ~> kg m-2]. - real :: dPres ! The hydrostatic pressure change across a layer [R Z2 T-2 ~> Pa = J m-3]. - + real :: dPres ! The hydrostatic pressure change across a layer [R Z2 T-2 ~> Pa] or + ! equivalently [R Z2 T-2 ~> J m-3]. real :: dt_h ! The timestep divided by the averages of the vertical distances around ! a layer [T Z-1 ~> s m-1]. real :: dz_top ! The distance from the surface [Z ~> m]. diff --git a/src/parameterizations/vertical/MOM_geothermal.F90 b/src/parameterizations/vertical/MOM_geothermal.F90 index 0ab77c4c6e..93347b053a 100644 --- a/src/parameterizations/vertical/MOM_geothermal.F90 +++ b/src/parameterizations/vertical/MOM_geothermal.F90 @@ -397,7 +397,7 @@ subroutine geothermal_in_place(h, tv, dt, G, GV, US, CS, BFlx_geothermal, halo) real :: Idt ! inverse of the timestep [T-1 ~> s-1] real :: H_to_Pres ! A conversion factor from thicknesses to pressure [R L2 T-2 H-1 ~> Pa m-1 or Pa m2 kg-1] real :: I_Cp ! 1.0 / C_p [C Q-1 ~> kg degC J-1] - real :: I_Rho0Squared ! 1.0 / rho_0^2 (Boussinesq only) [ R-2 ~> kg2 m-6] + real :: I_Rho0Squared ! 1.0 / rho_0^2 (Boussinesq only) [R-2 ~> m6 kg-2] logical :: do_any ! True if there is more to be done on the current j-row. logical :: calc_diags ! True if diagnostic tendencies are needed. logical :: nonBous ! If true, do not make the Boussinesq approximation. diff --git a/src/parameterizations/vertical/MOM_kappa_shear.F90 b/src/parameterizations/vertical/MOM_kappa_shear.F90 index da2c261ad9..9dfd509e8c 100644 --- a/src/parameterizations/vertical/MOM_kappa_shear.F90 +++ b/src/parameterizations/vertical/MOM_kappa_shear.F90 @@ -183,7 +183,7 @@ subroutine Calculate_kappa_shear(u_in, v_in, h, tv, p_surf, kappa_io, tke_io, & u0xdz, & ! The initial zonal velocity times dz [H L T-1 ~> m2 s-1 or kg m-1 s-1] v0xdz, & ! The initial meridional velocity times dz [H L T-1 ~> m2 s-1 or kg m-1 s-1] T0xdz, & ! The initial temperature times thickness [C H ~> degC m or degC kg m-2] or if - ! temperature is not a state variable, the density times thickness [R H ~> kg m-2 or kg2 m-3] + ! temperature is not a state variable, the density times thickness [R H ~> kg m-2 or kg2 m-5] S0xdz ! The initial salinity times dz [S H ~> ppt m or ppt kg m-2]. real, dimension(SZK_(GV)+1) :: & kappa, & ! The shear-driven diapycnal diffusivity at an interface [H Z T-1 ~> m2 s-1 or Pa s] diff --git a/src/parameterizations/vertical/MOM_set_diffusivity.F90 b/src/parameterizations/vertical/MOM_set_diffusivity.F90 index caf0555d28..bebc693103 100644 --- a/src/parameterizations/vertical/MOM_set_diffusivity.F90 +++ b/src/parameterizations/vertical/MOM_set_diffusivity.F90 @@ -229,8 +229,7 @@ module MOM_set_diffusivity real, pointer, dimension(:,:,:) :: TKE_to_Kd => NULL() !< conversion rate (~1.0 / (G_Earth + dRho_lay)) between TKE - !! dissipated within a layer and Kd in that layer - !! [H Z T-1 / H Z2 T-3 = T2 Z-1 ~> s2 m-1] + !! dissipated within a layer and Kd in that layer [T2 Z-1 ~> s2 m-1] end type diffusivity_diags @@ -307,8 +306,7 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, Kd_i prof_Froude_2d, & !< vertical profile for Froude drag [Z-1 ~> m-1] prof_slope_2d, & !< vertical profile for critical slopes [Z-1 ~> m-1] TKE_to_Kd !< Conversion rate (~1.0 / (G_Earth + dRho_lay)) between - !< TKE dissipated within a layer and Kd in that layer - !< [H Z T-1 / H Z2 T-3 = T2 Z-1 ~> s2 m-1] + !< TKE dissipated within a layer and Kd in that layer [T2 Z-1 ~> s2 m-1] real, dimension(SZI_(G),SZK_(GV)+1) :: & N2_int, & !< squared buoyancy frequency associated at interfaces [T-2 ~> s-2] @@ -888,7 +886,7 @@ subroutine find_TKE_to_Kd(h, tv, dRho_int, N2_lay, j, dt, G, GV, US, CS, & !! TKE dissipated within a layer and the !! diapycnal diffusivity within that layer, !! usually (~Rho_0 / (G_Earth * dRho_lay)) - !! [H Z T-1 / H Z2 T-3 = T2 Z-1 ~> s2 m-1] + !! [T2 Z-1 ~> s2 m-1] real, dimension(SZI_(G),SZK_(GV)), intent(out) :: maxTKE !< The energy required to for a layer to entrain to its !! maximum realizable thickness [H Z2 T-3 ~> m3 s-3 or W m-2] integer, dimension(SZI_(G)), intent(out) :: kb !< Index of lightest layer denser than the buffer @@ -1382,7 +1380,7 @@ subroutine add_drag_diffusivity(h, u, v, tv, fluxes, visc, j, TKE_to_Kd, maxTKE, !! TKE dissipated within a layer and the !! diapycnal diffusivity within that layer, !! usually (~Rho_0 / (G_Earth * dRho_lay)) - !! [H Z T-1 / H Z2 T-3 = T2 Z-1 ~> s2 m-1] + !! [T2 Z-1 ~> s2 m-1] real, dimension(SZI_(G),SZK_(GV)), intent(in) :: maxTKE !< The energy required to for a layer to entrain to its !! maximum-realizable thickness [H Z2 T-3 ~> m3 s-3 or W m-2] integer, dimension(SZI_(G)), intent(in) :: kb !< Index of lightest layer denser than the buffer @@ -1805,7 +1803,7 @@ subroutine add_MLrad_diffusivity(dz, fluxes, tv, j, Kd_int, G, GV, US, CS, TKE_t !! TKE dissipated within a layer and the !! diapycnal diffusivity witin that layer, !! usually (~Rho_0 / (G_Earth * dRho_lay)) - !! [H Z T-1 / H Z2 T-3 = T2 Z-1 ~> s2 m-1] + !! [T2 Z-1 ~> s2 m-1] real, dimension(SZI_(G),SZK_(GV)), & optional, intent(inout) :: Kd_lay !< The diapycnal diffusivity in layers !! [H Z T-1 ~> m2 s-1 or kg m-1 s-1]. diff --git a/src/parameterizations/vertical/MOM_set_viscosity.F90 b/src/parameterizations/vertical/MOM_set_viscosity.F90 index 193fcdffca..9d0261f5cc 100644 --- a/src/parameterizations/vertical/MOM_set_viscosity.F90 +++ b/src/parameterizations/vertical/MOM_set_viscosity.F90 @@ -253,7 +253,7 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, pbv) ! magnitudes [H L T-1 ~> m2 s-1 or kg m-1 s-1]. real :: Thtot ! Running sum of thickness times temperature [C H ~> degC m or degC kg m-2]. real :: Shtot ! Running sum of thickness times salinity [S H ~> ppt m or ppt kg m-2]. - real :: SpV_htot ! Running sum of thickness times specific volume [R-1 H ~> m4 kg-1 or m] + real :: SpV_htot ! Running sum of thickness times specific volume [H R-1 ~> m4 kg-1 or m] real :: hweight ! The thickness of a layer that is within Hbbl ! of the bottom [H ~> m or kg m-2]. real :: dzweight ! The counterpart of hweight in height units [Z ~> m]. @@ -1996,7 +1996,7 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS) ! surface mixed layer [H C ~> m degC or kg degC m-2]. Shtot, & ! The integrated salt of layers that are within the ! surface mixed layer [H S ~> m ppt or kg ppt m-2]. - SpV_htot, & ! Running sum of thickness times specific volume [R-1 H ~> m4 kg-1 or m] + SpV_htot, & ! Running sum of thickness times specific volume [H R-1 ~> m4 kg-1 or m] Rhtot, & ! The integrated density of layers that are within the surface mixed layer ! [H R ~> kg m-2 or kg2 m-5]. Rhtot is only used if no ! equation of state is used. diff --git a/src/parameterizations/vertical/MOM_tidal_mixing.F90 b/src/parameterizations/vertical/MOM_tidal_mixing.F90 index faeadbb8ab..13b76a77a1 100644 --- a/src/parameterizations/vertical/MOM_tidal_mixing.F90 +++ b/src/parameterizations/vertical/MOM_tidal_mixing.F90 @@ -713,7 +713,7 @@ subroutine calculate_tidal_mixing(dz, j, N2_bot, Rho_bot, N2_lay, N2_int, TKE_to !! dissipated within a layer and the !! diapycnal diffusivity within that layer, !! usually (~Rho_0 / (G_Earth * dRho_lay)) - !! [H Z T-1 / H Z2 T-3 = T2 Z-1 ~> s2 m-1] + !! [T2 Z-1 ~> s2 m-1] real, dimension(SZI_(G),SZK_(GV)), intent(in) :: max_TKE !< The energy required for a layer to !! entrain to its maximum realizable !! thickness [H Z2 T-3 ~> m3 s-3 or W m-2] @@ -1009,7 +1009,7 @@ subroutine add_int_tide_diffusivity(dz, j, N2_bot, Rho_bot, N2_lay, TKE_to_Kd, m !! dissipated within a layer and the !! diapycnal diffusivity within that layer, !! usually (~Rho_0 / (G_Earth * dRho_lay)) - !! [H Z T-1 / H Z2 T-3 = T2 Z-1 ~> s2 m-1] + !! [T2 Z-1 ~> s2 m-1] real, dimension(SZI_(G),SZK_(GV)), intent(in) :: max_TKE !< The energy required for a layer !! to entrain to its maximum realizable !! thickness [H Z2 T-3 ~> m3 s-3 or W m-2] diff --git a/src/tracer/MARBL_tracers.F90 b/src/tracer/MARBL_tracers.F90 index 847a174d36..ec9b2fc874 100644 --- a/src/tracer/MARBL_tracers.F90 +++ b/src/tracer/MARBL_tracers.F90 @@ -1308,7 +1308,7 @@ subroutine MARBL_tracers_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, real, dimension(SZI_(G),SZJ_(G)) :: flux_from_salt_flux ! Surface tracer flux from salt flux ! [conc Z T-1 ~> conc m s-1]. real, dimension(SZI_(G),SZJ_(G)) :: ref_mask ! Mask for 2D MARBL diags using ref_depth [1] - real, dimension(SZI_(G),SZJ_(G)) :: riv_flux_loc ! Local copy of CS%RIV_FLUXES*dt [mmol m-2 ~> conc H] + real, dimension(SZI_(G),SZJ_(G)) :: riv_flux_loc ! Local copy of CS%RIV_FLUXES*dt [conc H ~> mmol m-2] real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: h_work ! Used so that h can be modified [H ~> m or kg m-2] real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: bot_flux_to_tend ! Conversion factor for bottom tlux -> tend ! [Z-1 ~> m-1] diff --git a/src/tracer/MOM_CFC_cap.F90 b/src/tracer/MOM_CFC_cap.F90 index 21b29d496c..362497e869 100644 --- a/src/tracer/MOM_CFC_cap.F90 +++ b/src/tracer/MOM_CFC_cap.F90 @@ -516,7 +516,7 @@ subroutine CFC_cap_set_forcing(sfc_state, fluxes, day_start, day_interval, G, US ! Gas exchange/piston velocity parameter !--------------------------------------------------------------------- ! From a = 0.251 cm/hr s^2/m^2 in Wannikhof 2014 - ! = 6.97e-7 [m/s s^2/m^2] [Z T-1 T2 L-2] = [Z T L-2 ~> s / m] + ! = 6.97e-7 [m/s s^2/m^2] [Z T-1 T2 L-2] = [Z T L-2 ~> s m-1] kw_coeff = (US%m_to_Z*US%s_to_T*US%L_to_m**2) * 6.97e-7 ! set unit conversion factors diff --git a/src/user/SCM_CVMix_tests.F90 b/src/user/SCM_CVMix_tests.F90 index def4c59568..39ae327faa 100644 --- a/src/user/SCM_CVMix_tests.F90 +++ b/src/user/SCM_CVMix_tests.F90 @@ -251,7 +251,7 @@ subroutine SCM_CVMix_tests_buoyancy_forcing(sfc_state, fluxes, day, G, US, CS) IsdB = G%IsdB ; IedB = G%IedB ; JsdB = G%JsdB ; JedB = G%JedB if (CS%UseHeatFlux) then - ! Note CVMix test inputs give Heat flux in [Z C T-1 ~> m K/s] + ! Note CVMix test inputs give Heat flux in [Z C T-1 ~> m K s-1] ! therefore must convert to [Q R Z T-1 ~> W m-2] by multiplying ! by Rho0*Cp do J=Jsq,Jeq ; do i=is,ie From c008a017025af9b6fdb6380a4b20643b0aaa58d6 Mon Sep 17 00:00:00 2001 From: Alex Huth Date: Tue, 9 Dec 2025 16:34:45 -0500 Subject: [PATCH 20/64] Fix for ice-shelf friction velocity bugs (#995) * Fix for ice-shelf friction velocity bugs Fixed an incorrect area used to calculate cell-centered ocean surface velocity under the ice_shelf, which can impact the calculation of ice-shelf friction velocity. Added missing flags to some allocate_surface_state calls so that sfc_state%taux_shelf and sfc_state%tauy_shelf are allocated. This is required for the surface-stress-based (rather than surface-velocity-based) calculation of ice-shelf friction velocity. Also added taux_shelf and tauy_shelf as diagnostics for the surface stress under the ice shelf. * Removed unneeded taux_shelf and tauy_shelf diagnostics * Added ustar_from_vel_bugfix flag, which if true, fixes the ustar from ocean velocity bug --- config_src/drivers/FMS_cap/ocean_model_MOM.F90 | 3 ++- .../drivers/STALE_mct_cap/mom_ocean_model_mct.F90 | 3 ++- config_src/drivers/nuopc_cap/mom_ocean_model_nuopc.F90 | 3 ++- src/ice_shelf/MOM_ice_shelf.F90 | 10 +++++++++- 4 files changed, 15 insertions(+), 4 deletions(-) diff --git a/config_src/drivers/FMS_cap/ocean_model_MOM.F90 b/config_src/drivers/FMS_cap/ocean_model_MOM.F90 index e3b7b0cec7..4285fcda19 100644 --- a/config_src/drivers/FMS_cap/ocean_model_MOM.F90 +++ b/config_src/drivers/FMS_cap/ocean_model_MOM.F90 @@ -372,7 +372,8 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, wind_stagger, gas !allocate(OS%sfc_state) call allocate_surface_state(OS%sfc_state, OS%grid, use_temperature, do_integrals=.true., & - gas_fields_ocn=gas_fields_ocn, use_meltpot=use_melt_pot) + gas_fields_ocn=gas_fields_ocn, use_meltpot=use_melt_pot, & + use_iceshelves=OS%use_ice_shelf) if (present(wind_stagger)) then call surface_forcing_init(Time_in, OS%grid, OS%US, param_file, OS%diag, & diff --git a/config_src/drivers/STALE_mct_cap/mom_ocean_model_mct.F90 b/config_src/drivers/STALE_mct_cap/mom_ocean_model_mct.F90 index d1c46f4254..24e547b0e7 100644 --- a/config_src/drivers/STALE_mct_cap/mom_ocean_model_mct.F90 +++ b/config_src/drivers/STALE_mct_cap/mom_ocean_model_mct.F90 @@ -362,7 +362,8 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, gas_fields_ocn, i ! Consider using a run-time flag to determine whether to do the diagnostic ! vertical integrals, since the related 3-d sums are not negligible in cost. call allocate_surface_state(OS%sfc_state, OS%grid, use_temperature, & - do_integrals=.true., gas_fields_ocn=gas_fields_ocn, use_meltpot=use_melt_pot) + do_integrals=.true., gas_fields_ocn=gas_fields_ocn, & + use_meltpot=use_melt_pot, use_iceshelves=OS%use_ice_shelf) call surface_forcing_init(Time_in, OS%grid, OS%US, param_file, OS%diag, & OS%forcing_CSp, OS%restore_salinity, OS%restore_temp) diff --git a/config_src/drivers/nuopc_cap/mom_ocean_model_nuopc.F90 b/config_src/drivers/nuopc_cap/mom_ocean_model_nuopc.F90 index a83576028a..e4357dfda2 100644 --- a/config_src/drivers/nuopc_cap/mom_ocean_model_nuopc.F90 +++ b/config_src/drivers/nuopc_cap/mom_ocean_model_nuopc.F90 @@ -387,7 +387,8 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, gas_fields_ocn, i ! vertical integrals, since the related 3-d sums are not negligible in cost. call allocate_surface_state(OS%sfc_state, OS%grid, use_temperature, & do_integrals=.true., gas_fields_ocn=gas_fields_ocn, & - use_meltpot=use_melt_pot, use_marbl_tracers=OS%use_MARBL) + use_meltpot=use_melt_pot, use_iceshelves=OS%use_ice_shelf, & + use_marbl_tracers=OS%use_MARBL) call surface_forcing_init(Time_in, OS%grid, OS%US, param_file, OS%diag, & OS%forcing_CSp, OS%restore_salinity, OS%restore_temp, OS%use_waves) diff --git a/src/ice_shelf/MOM_ice_shelf.F90 b/src/ice_shelf/MOM_ice_shelf.F90 index a3819b3bdf..f2ba6d6818 100644 --- a/src/ice_shelf/MOM_ice_shelf.F90 +++ b/src/ice_shelf/MOM_ice_shelf.F90 @@ -197,6 +197,7 @@ module MOM_ice_shelf !! divided by the von Karman constant VK [nondim]. Was 1/8. real :: Vk !< Von Karman's constant [nondim] real :: Rc !< critical flux Richardson number [nondim] + logical :: ustar_from_vel_bugfix !< If true, fixes ustar from ocean velocity bug logical :: buoy_flux_itt_bugfix !< If true, fixes buoyancy iteration bug logical :: salt_flux_itt_bugfix !< If true, fixes salt iteration bug real :: buoy_flux_tol !< Fractional buoyancy iteration tolerance for convergence [nondim] @@ -465,7 +466,11 @@ subroutine shelf_calc_flux(sfc_state_in, fluxes_in, Time, time_step_in, CS) tauy2 = (((asv1 * (sfc_state%tauy_shelf(i,J-1)**2)) + (asv2 * (sfc_state%tauy_shelf(i,J)**2)) ) * I_av) endif u2_av = (((asu1 * (sfc_state%u(I-1,j)**2)) + (asu2 * sfc_state%u(I,j)**2)) * I_au) - v2_av = (((asv1 * (sfc_state%v(i,J-1)**2)) + (asu2 * sfc_state%v(i,J)**2)) * I_av) + if (CS%ustar_from_vel_bugfix) then + v2_av = (((asv1 * (sfc_state%v(i,J-1)**2)) + (asv2 * sfc_state%v(i,J)**2)) * I_av) + else + v2_av = (((asv1 * (sfc_state%v(i,J-1)**2)) + (asu2 * sfc_state%v(i,J)**2)) * I_av) + endif if ((taux2 + tauy2 > 0.0) .and. .not.CS%ustar_shelf_from_vel) then if (CS%ustar_max >= 0.0) then @@ -1792,6 +1797,9 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, Time_init, call get_param(param_file, mdl, "ICE_SHELF_RC", CS%Rc, & "Critical flux Richardson number for ice melt ", & units="nondim", default=0.20) + call get_param(param_file, mdl, "ICE_SHELF_USTAR_FROM_VEL_BUGFIX", CS%ustar_from_vel_bugfix, & + "Bug fix for ice-area weighting of squared ocean velocities "//& + "used to calculate friction velocity under ice shelves", default=.false.) call get_param(param_file, mdl, "ICE_SHELF_BUOYANCY_FLUX_ITT_BUGFIX", CS%buoy_flux_itt_bugfix, & "Bug fix of buoyancy iteration", default=.true., old_name="ICE_SHELF_BUOYANCY_FLUX_ITT_BUG") call get_param(param_file, mdl, "ICE_SHELF_SALT_FLUX_ITT_BUGFIX", CS%salt_flux_itt_bugfix, & From 9e48380aff274dd4d450381220f17317f9105b79 Mon Sep 17 00:00:00 2001 From: Marshall Ward Date: Fri, 5 Dec 2025 17:02:02 -0500 Subject: [PATCH 21/64] (+) Decouple FMS infra from framework This patch undoes a coupling of the FMS infra layer to the MOM6 framework code. In the current FMS infra layers, the `get_extern_field_info()` and `init_extern_field()` functions require content defined in `src/framework`. This prevents the development of new independent infra layers, which much also depend on infra-agnostic content. In particular, the FMS2 implementation of `get_extern_field_axes()` relies exclusively on the framework function, `get_var_axes_info()`. Both infras also return the `axes_info` type, a MOM-specific framework-level descriptor, rather than the infra `axistype`. This patch resolves these inconsistencies. * `axis_info` no longer appears at infra-level. All relevant functions now reference `axistype`. * `src/framework/MOM_io.F90` now provide functions for translating `axistype` to `axis_info`. Some specific changes are summarized below. * `get_external_field_info` is now a framework-level function of `MOM_interpolate.F90` , using infra-level implementations of `get_extern_field_(size|axes|missing)`. Each is now explicitly defined at the infra-level. * The FMS2 `get_external_field_axes` is now an entirely new function, and is largely a duplicate of `get_var_axes_info()`. The major difference is that it returns a list of `axistype`. It also replaces the fixed x-y-z fetch with a slightly more generic list of axes. (It still requires at least three dimensions, however.) * `set_axis_data` is only used internally by the FMS2 infra. It is included in FMS1 but raises an nonimplementation error. There is one minor API change. * The `name` argument was added to `get_axis_data`. It is now the second argument, to match the style of existing functions, and size was moved to the third argument. Other minor framework references have been removed. * `MOM_error` and `FATAL` now refernce their `MOM_error_infra` equivalents. * `lowercase`, which was previously only defined in FMS1, has been added to the FMS2 infra. Note that this is a duplication of the function in `src/framework/MOM_string_functions.F90`. --- config_src/infra/FMS1/MOM_interp_infra.F90 | 56 +++---- config_src/infra/FMS1/MOM_io_infra.F90 | 34 +++- config_src/infra/FMS2/MOM_interp_infra.F90 | 148 ++++++++++++++++-- config_src/infra/FMS2/MOM_io_infra.F90 | 70 +++++++-- src/framework/MOM_horizontal_regridding.F90 | 2 +- src/framework/MOM_interpolate.F90 | 50 +++++- src/framework/MOM_netcdf.F90 | 2 +- src/ocean_data_assim/MOM_oda_driver.F90 | 3 +- .../vertical/MOM_ALE_sponge.F90 | 3 +- 9 files changed, 293 insertions(+), 75 deletions(-) diff --git a/config_src/infra/FMS1/MOM_interp_infra.F90 b/config_src/infra/FMS1/MOM_interp_infra.F90 index 70bc99827e..4fa3f7374b 100644 --- a/config_src/infra/FMS1/MOM_interp_infra.F90 +++ b/config_src/infra/FMS1/MOM_interp_infra.F90 @@ -4,15 +4,14 @@ module MOM_interp_infra ! This file is part of MOM6. See LICENSE.md for the license. use MOM_domain_infra, only : MOM_domain_type, domain2d -use MOM_io, only : axis_info -use MOM_io, only : set_axis_info use MOM_time_manager, only : time_type use horiz_interp_mod, only : horiz_interp_new, horiz_interp, horiz_interp_init, horiz_interp_type use mpp_io_mod, only : axistype, mpp_get_axis_data, mpp_get_atts use time_interp_external_mod, only : time_interp_external use time_interp_external_mod, only : init_external_field, time_interp_external_init use time_interp_external_mod, only : get_external_field_size -use time_interp_external_mod, only : get_external_field_axes, get_external_field_missing +use time_interp_external_mod, only : get_external_field_axes +use time_interp_external_mod, only : get_external_field_missing implicit none ; private @@ -158,34 +157,13 @@ function get_extern_field_size(index) end function get_extern_field_size -!> get axes of an external field from field index -function get_extern_field_axes(index) result(axes) - - integer, intent(in) :: index !< FMS interpolation field index - type(axis_info) :: axes(4) !< MOM IO field axes handle - - type(axistype), dimension(4) :: fms_axes(4) - ! FMS axis handles - character(len=32) :: name - ! Axis name - real, allocatable :: points(:) - ! Axis line points - integer :: length - ! Axis line point length - integer :: i - ! Loop index - - fms_axes = get_external_field_axes(index) - - do i = 1, 4 - call mpp_get_atts(fms_axes(i), name=name, len=length) +!> get size of an external field from field index +function get_extern_field_axes(index) - allocate(points(length)) - call mpp_get_axis_data(fms_axes(i), points) - call set_axis_info(axes(i), name=name, ax_data=points) + integer, intent(in) :: index !< field index + type(axistype) :: get_extern_field_axes(4) !< field size - deallocate(points) - enddo + get_extern_field_axes = get_external_field_axes(index) end function get_extern_field_axes @@ -202,25 +180,27 @@ end function get_extern_field_missing !> Get information about the external fields. subroutine get_external_field_info(field, size, axes, missing) - type(external_field), intent(in) :: field !< Handle for time interpolated external - !! field returned from a previous - !! call to init_external_field() - integer, optional, intent(inout) :: size(4) !< Dimension sizes for the input data - type(axis_info), optional, intent(inout) :: axes(4) !< Axis types for the input data - real, optional, intent(inout) :: missing !< Missing value for the input data + type(external_field), intent(in) :: field + !< Handle for time interpolated external field returned from a previous + !! call to init_external_field() + integer, optional, intent(inout) :: size(4) + !< Dimension sizes for the input data + type(axistype), optional, intent(inout) :: axes(4) + !< Axis types for the input data + real, optional, intent(inout) :: missing + !< Missing value for the input data if (present(size)) then - size(1:4) = get_extern_field_size(field%id) + size(:) = get_extern_field_size(field%id) endif if (present(axes)) then - axes(1:4) = get_extern_field_axes(field%id) + axes(:) = get_extern_field_axes(field%id) endif if (present(missing)) then missing = get_extern_field_missing(field%id) endif - end subroutine get_external_field_info diff --git a/config_src/infra/FMS1/MOM_io_infra.F90 b/config_src/infra/FMS1/MOM_io_infra.F90 index e37e5db3cb..55a304e13e 100644 --- a/config_src/infra/FMS1/MOM_io_infra.F90 +++ b/config_src/infra/FMS1/MOM_io_infra.F90 @@ -32,7 +32,8 @@ module MOM_io_infra public :: open_file, open_ASCII_file, file_is_open, close_file, flush_file, file_exists public :: get_file_info, get_file_fields, get_file_times, get_filename_suffix public :: read_field, read_vector, write_metadata, write_field -public :: field_exists, get_field_atts, get_field_size, get_axis_data, read_field_chksum +public :: field_exists, get_field_atts, get_field_size, read_field_chksum +public :: get_axis_data, set_axis_data public :: io_infra_init, io_infra_end, MOM_namelist_file, check_namelist_error, write_version public :: stdout_if_root ! These types are inherited from underlying infrastructure code, to act as containers for @@ -404,13 +405,34 @@ subroutine get_field_size(filename, fieldname, sizes, field_found, no_domain) end subroutine get_field_size !> Extracts and returns the axis data stored in an axistype. -subroutine get_axis_data( axis, dat ) - type(axistype), intent(in) :: axis !< An axis type - real, dimension(:), intent(out) :: dat !< The data in the axis variable - - call mpp_get_axis_data( axis, dat ) +subroutine get_axis_data(axis, axis_name, axis_data) + type(axistype), intent(in) :: axis + !< Infra axis + character(len=256), intent(out) :: axis_name + !< Axis name + real, dimension(:), intent(out) :: axis_data + !< Axis points + + call mpp_get_atts(axis, name=axis_name) + call mpp_get_axis_data(axis, axis_data) end subroutine get_axis_data + +! NOTE: Unused, but provided to match the FMS2 API + +!> Return a new axistype based on axis specs +subroutine set_axis_data(axis, axis_name, axis_data) + type(axistype), intent(inout) :: axis + !< Target axis + character(len=256), intent(in) :: axis_name + !< Target axis name + real, intent(in) :: axis_data(:) + !< Target axis values + + call MOM_error(FATAL, "set_axis_data in FMS1 is not yet implemented.") +end subroutine set_axis_data + + !> This routine uses the fms_io subroutine read_data to read a scalar named !! "fieldname" from a single or domain-decomposed file "filename". subroutine read_field_0d(filename, fieldname, data, timelevel, scale, MOM_Domain, & diff --git a/config_src/infra/FMS2/MOM_interp_infra.F90 b/config_src/infra/FMS2/MOM_interp_infra.F90 index 0b45b752ae..1e4d712c3a 100644 --- a/config_src/infra/FMS2/MOM_interp_infra.F90 +++ b/config_src/infra/FMS2/MOM_interp_infra.F90 @@ -4,10 +4,10 @@ module MOM_interp_infra ! This file is part of MOM6. See LICENSE.md for the license. use MOM_domain_infra, only : MOM_domain_type, domain2d -use MOM_io, only : axis_info -use MOM_io, only : get_var_axes_info +use MOM_io_infra, only : axistype +use MOM_io_infra, only : set_axis_data use MOM_time_manager, only : time_type -use MOM_error_handler, only : MOM_error, FATAL +use MOM_error_infra, only : MOM_error => MOM_err, FATAL use MOM_string_functions, only : lowercase use horiz_interp_mod, only : horiz_interp_new, horiz_interp, horiz_interp_init, horiz_interp_type use netcdf_io_mod, only : FmsNetcdfFile_t, netcdf_file_open, netcdf_file_close @@ -17,6 +17,17 @@ module MOM_interp_infra use time_interp_external2_mod, only : get_external_field_size use time_interp_external2_mod, only : get_external_field_missing +! Use primitive netCDF, to replicate get_var_axes_info() +use netcdf, only : nf90_open +use netcdf, only : nf90_close +use netcdf, only : nf90_inq_varid +use netcdf, only : nf90_inquire_variable +use netcdf, only : nf90_inquire_dimension +use netcdf, only : nf90_get_var +use netcdf, only : NF90_NOWRITE +use netcdf, only : NF90_NOERR + + implicit none ; private public :: horiz_interp_type, horizontal_interp_init @@ -153,10 +164,115 @@ end function get_extern_field_size !> get axes of an external field from field index function get_extern_field_axes(field) result(axes) - type(external_field), intent(in) :: field !< Field handle - type(axis_info), dimension(4) :: axes !< Field axes + type(external_field), intent(in) :: field + !< Field handle + type(axistype), dimension(4) :: axes + !< Field axes + + integer :: ndims + ! Number of variable dimensions + integer, allocatable :: dims(:) + ! netCDF dimension IDs of variable + character(len=256) :: dim_name + ! Dimension name + integer :: dim_len + ! Dimension length + integer :: var_dim + ! netCDF ID of the variable associated with dimension of the same name + real, allocatable :: axis_points(:) + ! Axis values + + integer :: ncid + ! netCDF file ID + integer :: varid + ! netCDF variable ID + integer :: rc + ! netCDF return code + + ! netCDF requires the following to be length-1 arrays + integer :: nc_start(1) + ! netCDF start index + integer :: nc_count(1) + ! netCDF index count + + integer :: d + ! Dimension index + character(len=2) :: d_str + ! Display string of d + + ! This is a reimplementation of get_var_axes_info(), maybe it can be used + ! by the existing get_var_axes_info() ? + + ! Open field%filename + rc = nf90_open(trim(field%filename), NF90_NOWRITE, ncid) + if (rc /= NF90_NOERR) & + call MOM_error(FATAL, "Error opening file " // trim(field%filename) // ".") + + ! Use field%label to get the netCDF varid + rc = nf90_inq_varid(ncid, trim(field%label), varid) + if (rc /= NF90_NOERR) & + call MOM_error(FATAL, "Error finding variable " // trim(field%label) & + // " in " // trim(field%filename) // ".") + + ! Use the varid to get the number of dims (ndims) and their IDs (dims(:)) + ! Verify that ndims >= 3 + rc = nf90_inquire_variable(ncid, varid, ndims=ndims) + if (rc /= NF90_NOERR) & + call MOM_error(FATAL, "Error querying variable " // trim(field%label) & + // " in " // trim(field%filename) // ".") + + if (ndims < 3) & + call MOM_error(FATAL, trim(field%label) // " in " // trim(field%filename) & + // " has too few dimensions to be read as a 3D array.") + + allocate(dims(ndims)) + + rc = nf90_inquire_variable(ncid, varid, dimids=dims) + if (rc /= NF90_NOERR) & + call MOM_error(FATAL, "Error querying variable " // trim(field%label) & + // " in " // trim(field%filename) // ".") + + do d=1,ndims + ! Determine the name of each dimension + rc = nf90_inquire_dimension(ncid, dims(d), dim_name, len=dim_len) + if (rc /= NF90_NOERR) then + write(d_str, '(i0)') d + call MOM_error(FATAL, "Error querying dimension " // trim(d_str) & + // " of " // trim(field%label) // " in " // trim(field%filename) & + // ".") + endif + + ! Now locate a variable with the same name as the dimension (e.g. "x") + rc = nf90_inq_varid(ncid, dim_name, var_dim) + if (rc /= NF90_NOERR) & + call MOM_error(FATAL, "Error finding dimension variable " & + // trim(dim_name) // " of " // trim(field%label) // " in " & + // trim(field%filename)) + + allocate(axis_points(dim_len)) + + ! Get the dimensional axis values + nc_start(1) = 1 + nc_count(1) = dim_len + rc = nf90_get_var(ncid, var_dim, axis_points, nc_start, nc_count) + if (rc /= NF90_NOERR) & + call MOM_error(FATAL, "Error reading dimension " // trim(dim_name) & + // " axis data of " // trim(field%label) // " in " & + // trim(field%filename)) + + ! write via set_axis_info() equivalent for axistype + call set_axis_data(axes(d), dim_name, axis_points) + + deallocate(axis_points) + enddo + + deallocate(dims) + + ! Close external file + rc = nf90_close(ncid) + if (rc /= NF90_NOERR) & + call MOM_error(FATAL, "Error closing file "//trim(field%filename)//".") - call get_var_axes_info(field%filename, field%label, axes) end function get_extern_field_axes @@ -173,25 +289,27 @@ end function get_extern_field_missing !> Get information about the external fields. subroutine get_external_field_info(field, size, axes, missing) - type(external_field), intent(in) :: field !< Handle for time interpolated external - !! field returned from a previous - !! call to init_external_field() - integer, dimension(4), optional, intent(inout) :: size !< Dimension sizes for the input data - type(axis_info), dimension(4), optional, intent(inout) :: axes !< Axis types for the input data - real, optional, intent(inout) :: missing !< Missing value for the input data + type(external_field), intent(in) :: field + !< handle for time interpolated external field returned from a previous + !! call to init_external_field() + integer, optional, intent(inout) :: size(4) + !< Dimension sizes for the input data + type(axistype), optional, intent(inout) :: axes(4) + !< Axis types for the input data + real, optional, intent(inout) :: missing + !< Missing value for the input data if (present(size)) then - size(1:4) = get_extern_field_size(field%id) + size(:) = get_extern_field_size(field%id) endif if (present(axes)) then - axes(1:4) = get_extern_field_axes(field) + axes(:) = get_extern_field_axes(field) endif if (present(missing)) then missing = get_extern_field_missing(field%id) endif - end subroutine get_external_field_info diff --git a/config_src/infra/FMS2/MOM_io_infra.F90 b/config_src/infra/FMS2/MOM_io_infra.F90 index a43b4e9344..7e8c78c220 100644 --- a/config_src/infra/FMS2/MOM_io_infra.F90 +++ b/config_src/infra/FMS2/MOM_io_infra.F90 @@ -6,8 +6,6 @@ module MOM_io_infra use MOM_domain_infra, only : MOM_domain_type, rescale_comp_data, AGRID, BGRID_NE, CGRID_NE use MOM_domain_infra, only : domain2d, domain1d, CENTER, CORNER, NORTH_FACE, EAST_FACE use MOM_error_infra, only : MOM_error=>MOM_err, NOTE, FATAL, WARNING, is_root_PE -use MOM_string_functions, only : lowercase - use fms2_io_mod, only : fms2_open_file => open_file, check_if_open, fms2_close_file => close_file use fms2_io_mod, only : fms2_flush_file => flush_file use fms2_io_mod, only : FmsNetcdfDomainFile_t, FmsNetcdfFile_t, fms2_read_data => read_data @@ -46,7 +44,8 @@ module MOM_io_infra public :: open_file, open_ASCII_file, file_is_open, close_file, flush_file, file_exists public :: get_file_info, get_file_fields, get_file_times, get_filename_suffix public :: read_field, read_vector, write_metadata, write_field -public :: field_exists, get_field_atts, get_field_size, get_axis_data, read_field_chksum +public :: field_exists, get_field_atts, get_field_size, read_field_chksum +public :: get_axis_data, set_axis_data public :: io_infra_init, io_infra_end, MOM_namelist_file, check_namelist_error, write_version public :: stdout_if_root ! These types act as containers for information about files, fields and axes, respectively, @@ -716,20 +715,50 @@ end function find_index !> Extracts and returns the axis data stored in an axistype. -subroutine get_axis_data( axis, dat ) - type(axistype), intent(in) :: axis !< An axis type - real, dimension(:), intent(out) :: dat !< The data in the axis variable +subroutine get_axis_data(axis, axis_name, axis_data) + type(axistype), intent(in) :: axis + !< Infra axis + character(len=256), intent(out) :: axis_name + !< Axis name + real, dimension(:), intent(out) :: axis_data + !< Axis points integer :: i - ! This routine might not be needed for MOM6. if (allocated(axis%ax_data)) then - if (size(axis%ax_data) > size(dat)) call MOM_error(FATAL, & - "get_axis_data called with too small of an output data array for "//trim(axis%name)) - do i=1,size(axis%ax_data) ; dat(i) = axis%ax_data(i) ; enddo + if (size(axis%ax_data) > size(axis_data)) & + call MOM_error(FATAL, "get_axis_data called with too small of an " & + // "output data array for " // trim(axis%name) // ".") + do i=1,size(axis%ax_data) + axis_data(i) = axis%ax_data(i) + enddo endif + + axis_name = axis%name end subroutine get_axis_data + +!> Return a new axistype based on axis specs +subroutine set_axis_data(axis, axis_name, axis_data) + type(axistype), intent(inout) :: axis + !< Target axis + character(len=256), intent(in) :: axis_name + !< Target axis name + real, intent(in) :: axis_data(:) + !< Target axis values + + axis%name = axis_name + + if (allocated(axis%ax_data)) deallocate(axis%ax_data) + allocate(axis%ax_data(size(axis_data))) + + axis%ax_data(:) = axis_data(:) + + ! NOTE: We do not yet consider domain-decomposed axes. + axis%domain_decomposed = .false. +end subroutine set_axis_data + + !> This routine uses the fms_io subroutine read_data to read a scalar named !! "fieldname" from a single or domain-decomposed file "filename". subroutine read_field_0d(filename, fieldname, data, timelevel, scale, MOM_Domain, & @@ -2036,4 +2065,25 @@ function find_unlimited_dimension_name(fileobj) result(label) label = '' end function find_unlimited_dimension_name +! NOTE: `lowercase is duplicated from `src/framework/MOM_string_functions.F90` +! in order to avoid any dependency of the infra on the framework. + +!> Return a string in which all uppercase letters have been replaced by +!! their lowercase counterparts. +function lowercase(input_string) + character(len=*), intent(in) :: input_string !< The string to modify + character(len=len(input_string)) :: lowercase !< The modified output string +! This function returns a string in which all uppercase letters have been +! replaced by their lowercase counterparts. It is loosely based on the +! lowercase function in mpp_util.F90. + integer, parameter :: co=iachar('a')-iachar('A') ! case offset + integer :: k + + lowercase = input_string + do k=1, len_trim(input_string) + if (lowercase(k:k) >= 'A' .and. lowercase(k:k) <= 'Z') & + lowercase(k:k) = achar(ichar(lowercase(k:k))+co) + enddo +end function lowercase + end module MOM_io_infra diff --git a/src/framework/MOM_horizontal_regridding.F90 b/src/framework/MOM_horizontal_regridding.F90 index 3b296e8b65..64a1fadff2 100644 --- a/src/framework/MOM_horizontal_regridding.F90 +++ b/src/framework/MOM_horizontal_regridding.F90 @@ -16,7 +16,7 @@ module MOM_horizontal_regridding use MOM_interpolate, only : time_interp_external use MOM_interp_infra, only : run_horiz_interp, build_horiz_interp_weights use MOM_interp_infra, only : horiz_interp_type, horizontal_interp_init -use MOM_interp_infra, only : get_external_field_info +use MOM_interpolate, only : get_external_field_info use MOM_interp_infra, only : external_field use MOM_time_manager, only : time_type use MOM_io, only : axis_info, get_axis_info, get_var_axes_info, MOM_read_data diff --git a/src/framework/MOM_interpolate.F90 b/src/framework/MOM_interpolate.F90 index 5a830fb028..aa393e8990 100644 --- a/src/framework/MOM_interpolate.F90 +++ b/src/framework/MOM_interpolate.F90 @@ -7,9 +7,13 @@ module MOM_interpolate use MOM_error_handler, only : MOM_error, FATAL use MOM_interp_infra, only : time_interp_extern, init_external_field=>init_extern_field use MOM_interp_infra, only : time_interp_external_init=>time_interp_extern_init -use MOM_interp_infra, only : horiz_interp_type, get_external_field_info +use MOM_interp_infra, only : horiz_interp_type +use MOM_interp_infra, only : get_external_field_info_infra => get_external_field_info use MOM_interp_infra, only : run_horiz_interp, build_horiz_interp_weights use MOM_interp_infra, only : external_field +use MOM_io_infra, only : axistype +use MOM_io_infra, only : get_axis_data +use MOM_io, only : axis_info, set_axis_info use MOM_time_manager, only : time_type, set_date, operator(+), operator(<), operator(>) implicit none ; private @@ -26,7 +30,8 @@ module MOM_interpolate type(time_type) :: m2d_offset !< add to model time to get data time end type forcing_timeseries_dataset -public :: time_interp_external, init_external_field, time_interp_external_init, get_external_field_info +public :: time_interp_external, init_external_field, time_interp_external_init +public :: get_external_field_info public :: horiz_interp_type, run_horiz_interp, build_horiz_interp_weights public :: external_field public :: forcing_timeseries_set_time_type_vars @@ -277,4 +282,45 @@ function map_model_time_to_forcing_time(Time, forcing_dataset) end function map_model_time_to_forcing_time + +subroutine get_external_field_info(field, size, axes, missing) + type(external_field), intent(in) :: field + !< Handle for time interpolated external field returned from a previous + !! call to init_external_field() + integer, optional, intent(inout) :: size(4) + !< Dimension sizes for the input data + type(axis_info), optional, intent(inout) :: axes(4) + !< Axis types for the input data + real, optional, intent(inout) :: missing + !< Missing value for the input data + + type(axistype) :: axes_infra(4) + ! Axis as represented in the infra + character(len=256) :: axis_name + ! Axis name + real, allocatable :: ax_data(:) + ! Axis points + + integer :: n + ! Axis index + + if (present(axes)) then + call get_external_field_info_infra(field, size=size, axes=axes_infra, & + missing=missing) + ! TODO: Most of these methods were written to expect four dimensions. + ! I would not expect a generic field to be well-behaved, but I am unsure + ! how to validate such a field. + do n=1,4 + ! Convert axistype to axis_info + allocate(ax_data(size(n))) + call get_axis_data(axes_infra(n), axis_name, ax_data) + call set_axis_info(axes(n), trim(axis_name), ax_data=ax_data) + deallocate(ax_data) + enddo + else + call get_external_field_info_infra(field, size=size, missing=missing) + endif +end subroutine get_external_field_info + + end module MOM_interpolate diff --git a/src/framework/MOM_netcdf.F90 b/src/framework/MOM_netcdf.F90 index 4a7a61ec1c..122d2797ba 100644 --- a/src/framework/MOM_netcdf.F90 +++ b/src/framework/MOM_netcdf.F90 @@ -799,7 +799,7 @@ subroutine check_netcdf_call(ncerr, header, message) character(len=:), allocatable :: errmsg ! Full error message, including netCDF message - if (ncerr /= nf90_noerr) then + if (ncerr /= NF90_NOERR) then errmsg = trim(header) // ": " // trim(message) // new_line('/') & // trim(nf90_strerror(ncerr)) call MOM_error(FATAL, errmsg) diff --git a/src/ocean_data_assim/MOM_oda_driver.F90 b/src/ocean_data_assim/MOM_oda_driver.F90 index 7f9bcb19a1..3dada6e41f 100644 --- a/src/ocean_data_assim/MOM_oda_driver.F90 +++ b/src/ocean_data_assim/MOM_oda_driver.F90 @@ -15,9 +15,10 @@ module MOM_oda_driver_mod use MOM_ensemble_manager, only : get_ensemble_pelist, get_ensemble_filter_pelist use MOM_error_handler, only : stdout, stdlog, MOM_error use MOM_io, only : SINGLE_FILE -use MOM_interp_infra, only : init_extern_field, get_external_field_info +use MOM_interp_infra, only : init_extern_field use MOM_interp_infra, only : time_interp_extern use MOM_interpolate, only : external_field +use MOM_interpolate, only : get_external_field_info use MOM_remapping, only : remappingSchemesDoc use MOM_time_manager, only : time_type, real_to_time, get_date use MOM_time_manager, only : operator(+), operator(>=), operator(/=) diff --git a/src/parameterizations/vertical/MOM_ALE_sponge.F90 b/src/parameterizations/vertical/MOM_ALE_sponge.F90 index ebbba53b37..773b92ec84 100644 --- a/src/parameterizations/vertical/MOM_ALE_sponge.F90 +++ b/src/parameterizations/vertical/MOM_ALE_sponge.F90 @@ -21,7 +21,8 @@ module MOM_ALE_sponge use MOM_file_parser, only : get_param, log_param, log_version, param_file_type use MOM_grid, only : ocean_grid_type use MOM_horizontal_regridding, only : horiz_interp_and_extrap_tracer -use MOM_interpolate, only : init_external_field, get_external_field_info, time_interp_external_init +use MOM_interpolate, only : init_external_field, time_interp_external_init +use MOM_interpolate, only : get_external_field_info use MOM_interpolate, only : external_field use MOM_io, only : axis_info use MOM_remapping, only : remapping_cs, remapping_core_h, initialize_remapping From eac630c3eccd2e68898f81cb428aad1c5de7e60b Mon Sep 17 00:00:00 2001 From: alex-huth Date: Wed, 10 Dec 2025 16:00:49 -0500 Subject: [PATCH 22/64] Added latent heat flux from ice shelf to ocean fluxes --- src/ice_shelf/MOM_ice_shelf.F90 | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/src/ice_shelf/MOM_ice_shelf.F90 b/src/ice_shelf/MOM_ice_shelf.F90 index f2ba6d6818..772a21483a 100644 --- a/src/ice_shelf/MOM_ice_shelf.F90 +++ b/src/ice_shelf/MOM_ice_shelf.F90 @@ -1332,10 +1332,12 @@ subroutine add_shelf_flux(G, US, CS, sfc_state, fluxes, time_step) endif if (associated(fluxes%sens)) & - fluxes%sens(i,j) = frac_shelf*ISS%tflux_ocn(i,j)*CS%flux_factor + frac_open * fluxes%sens(i,j) + fluxes%sens(i,j) = frac_shelf*ISS%tflux_ocn(i,j) + frac_open * fluxes%sens(i,j) ! The salt flux should be mostly from sea ice, so perhaps none should be intercepted and this should be changed. if (associated(fluxes%salt_flux)) & fluxes%salt_flux(i,j) = frac_shelf * ISS%salt_flux(i,j)*CS%flux_factor + frac_open * fluxes%salt_flux(i,j) + if (associated(fluxes%latent)) & + fluxes%latent(i,j) = fluxes%latent(i,j) - frac_shelf * ISS%water_flux(i,j) * CS%Lat_Fusion endif ; enddo ; enddo if (CS%debug) then From 760f765fa8b64feb8ddc97ab0d5228ef2d70cc9a Mon Sep 17 00:00:00 2001 From: Alistair Adcroft Date: Fri, 19 Dec 2025 14:14:32 -0500 Subject: [PATCH 23/64] Fixes wrong number of levels in z-coord diags When a z-coordinate diagnostic grid is specified via the "PARAM" method of coordinate definition, then the number of levels was always the same as the main model. This commit fixes this by first allowing for upto a 1000 levels in the new grid, checking for the actual requested size, and then allocating to that size. It appears we have no examples using this mode, which is probably how this bug has persisted so long. This "PARAM" method of specifying grids is being used in a range of new CMIP7 diagnostics in both MOM6 and COBALT. --- src/ALE/MOM_regridding.F90 | 12 ++++++++++-- 1 file changed, 10 insertions(+), 2 deletions(-) diff --git a/src/ALE/MOM_regridding.F90 b/src/ALE/MOM_regridding.F90 index 2e20955ec6..872766bbab 100644 --- a/src/ALE/MOM_regridding.F90 +++ b/src/ALE/MOM_regridding.F90 @@ -432,8 +432,16 @@ subroutine initialize_regridding(CS, G, GV, US, max_depth, param_file, mdl, & trim(message), units=trim(coord_units)) elseif (trim(string)=='PARAM') then ! Read coordinate resolution (main model = ALE_RESOLUTION) - ke = GV%ke ! Use model nk by default - allocate(dz(ke)) + allocate(dz(1001)) + dz(:) = -1. ! Setting to <0 allows detection of unset elements + call get_param(param_file, mdl, coord_res_param, dz, "Scan", units="", do_not_log=.true.) + if (dz(1001)>=0.) call MOM_error(FATAL,trim(mdl)//", initialize_regridding: "// & + "PARAM specification is limited to 1000 values. Hack the code to use more!") + do ke=1,1000 ! Find number of defined levels + if (dz(ke+1)<0.) exit + enddo + deallocate(dz) + allocate(dz(ke)) ! Allocate with the correct number of levels, and re-read thicknesses call get_param(param_file, mdl, coord_res_param, dz, & trim(message), units=trim(coord_units), fail_if_missing=.true.) elseif (index(trim(string),'FILE:')==1) then From d4a5fddfa318996c919a246c932bd81abe444c42 Mon Sep 17 00:00:00 2001 From: Andrew Ross <5852283+andrew-c-ross@users.noreply.github.com> Date: Fri, 26 Dec 2025 16:09:32 -0500 Subject: [PATCH 24/64] Fix bug in registration of ALE sponge diagnostics for generic tracers (#1003) * Init all sponge tendency diag IDs to -1 immediately * No need to reset to -1 since initialized when declared * Move init_ALE_sponge_diags to after all tracers have been set up --- src/core/MOM.F90 | 7 +++---- src/parameterizations/vertical/MOM_ALE_sponge.F90 | 6 +++--- 2 files changed, 6 insertions(+), 7 deletions(-) diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index 71832ba76c..c2b8104827 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -3602,13 +3602,9 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, & if (associated(CS%sponge_CSp)) & call init_sponge_diags(Time, G, GV, US, diag, CS%sponge_CSp) - if (associated(CS%ALE_sponge_CSp)) & - call init_ALE_sponge_diags(Time, G, diag, CS%ALE_sponge_CSp, US) - if (associated(CS%oda_incupd_CSp)) & call init_oda_incupd_diags(Time, G, GV, diag, CS%oda_incupd_CSp, US) - call tracer_advect_init(Time, G, US, param_file, diag, CS%tracer_adv_CSp) call tracer_hor_diff_init(Time, G, GV, US, param_file, diag, CS%tv%eqn_of_state, CS%diabatic_CSp, & CS%tracer_diff_CSp) @@ -3642,6 +3638,9 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, & CS%ALE_sponge_CSp, CS%tv) if (present(tracer_flow_CSp)) tracer_flow_CSp => CS%tracer_flow_CSp + if (associated(CS%ALE_sponge_CSp)) & + call init_ALE_sponge_diags(Time, G, diag, CS%ALE_sponge_CSp, US) + ! If running in offline tracer mode, initialize the necessary control structure and ! parameters if (present(offline_tracer_mode)) offline_tracer_mode=CS%offline_tracer_mode diff --git a/src/parameterizations/vertical/MOM_ALE_sponge.F90 b/src/parameterizations/vertical/MOM_ALE_sponge.F90 index 773b92ec84..a137fa35db 100644 --- a/src/parameterizations/vertical/MOM_ALE_sponge.F90 +++ b/src/parameterizations/vertical/MOM_ALE_sponge.F90 @@ -142,8 +142,9 @@ module MOM_ALE_sponge !! It is not clear why this needs to be greater than 0. !>@{ Diagnostic IDs - integer, dimension(MAX_FIELDS_) :: id_sp_tendency !< Diagnostic ids for tracer - !! tendencies due to sponges + integer, dimension(MAX_FIELDS_) :: id_sp_tendency = reshape([-1], [MAX_FIELDS_], [-1]) !< Diagnostic ids for tracer + !! tendencies due to sponges. + !! Init all to -1. integer :: id_sp_u_tendency !< Diagnostic id for zonal momentum tendency due to !! Rayleigh damping integer :: id_sp_v_tendency !< Diagnostic id for meridional momentum tendency due to @@ -671,7 +672,6 @@ subroutine init_ALE_sponge_diags(Time, G, diag, CS, US) CS%diag => diag do m=1,CS%fldno - CS%id_sp_tendency(m) = -1 if ((trim(CS%Ref_val(m)%unit) == 'none') .or. (len_trim(CS%Ref_val(m)%unit) == 0)) then tend_unit = "s-1" else From bf1716f65ce6b84920502f653245fb58cf645ab5 Mon Sep 17 00:00:00 2001 From: Alistair Adcroft Date: Mon, 22 Dec 2025 12:33:06 -0500 Subject: [PATCH 25/64] Fix reference of (rarely) unassociated pointer These two references to members of a pointer don't seem to be hit except under special circumstances but nevertheless I ran in to them when debugging an unrelated problem. There are two references to members of `diag%axes` that assume `diag%axes` are associated, but in the specific case I was debugging this was not the case. --- src/framework/MOM_diag_mediator.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/framework/MOM_diag_mediator.F90 b/src/framework/MOM_diag_mediator.F90 index 58b7d39a4c..9373ffe9a6 100644 --- a/src/framework/MOM_diag_mediator.F90 +++ b/src/framework/MOM_diag_mediator.F90 @@ -1495,12 +1495,12 @@ subroutine post_data_2d_low(diag, field, diag_cs, is_static, mask) if (present(mask)) then locmask => mask - elseif (.NOT. is_stat) then + elseif (.NOT. is_stat .and. associated(diag%axes)) then if (associated(diag%axes%mask2d)) locmask => diag%axes%mask2d endif dl=1 - if (.NOT. is_stat) dl = diag%axes%downsample_level !static field downsample i not supported yet + if (.NOT. is_stat .and. associated(diag%axes)) dl = diag%axes%downsample_level !static field downsample not supported !Downsample the diag field and mask (if present) if (dl > 1) then isv_o = isv ; jsv_o = jsv From 7ee13cdd1a09210dcd4fa34462788d6b1e6affd0 Mon Sep 17 00:00:00 2001 From: Alistair Adcroft Date: Mon, 22 Dec 2025 12:03:40 -0500 Subject: [PATCH 26/64] Adds 5 CMIP7 diagnostics for vertically integrated heat/salt content Five vertically integrated diagnostics are requested in CMIP7. These ultimately are to be for four vertical intervals (0-300m, 300-700m, etc.) but we will handle that through addition of a 4-level diagnostic grid, configured at run-time. This commit handles the conversion from temperature or salt to heat content or salt content (by mass) and registers a "vertically extensive" quantity so that the diagnostics know to re-integrate rather than remap. Changes: - Added diagnostics absscint, pfscint, scint, chcint and phcint - Moved registration of temp_int and salt_int to within an existing `if (use_temperature)` block - Made public 2 GSW conversion functions in MOM_EOS --- src/diagnostics/MOM_diagnostics.F90 | 140 ++++++++++++++++++++++++---- src/equation_of_state/MOM_EOS.F90 | 2 + 2 files changed, 125 insertions(+), 17 deletions(-) diff --git a/src/diagnostics/MOM_diagnostics.F90 b/src/diagnostics/MOM_diagnostics.F90 index 6c220c79cf..3b3e395fc7 100644 --- a/src/diagnostics/MOM_diagnostics.F90 +++ b/src/diagnostics/MOM_diagnostics.F90 @@ -20,7 +20,9 @@ module MOM_diagnostics use MOM_domains, only : create_group_pass, do_group_pass, group_pass_type use MOM_domains, only : To_North, To_East use MOM_EOS, only : calculate_density, calculate_density_derivs, EOS_domain -use MOM_EOS, only : cons_temp_to_pot_temp, abs_saln_to_prac_saln +use MOM_EOS, only : calculate_spec_vol +use MOM_EOS, only : cons_temp_to_pot_temp, pot_temp_to_cons_temp +use MOM_EOS, only : prac_saln_to_abs_saln, abs_saln_to_prac_saln use MOM_error_handler, only : MOM_error, FATAL, WARNING use MOM_file_parser, only : get_param, log_version, param_file_type use MOM_grid, only : ocean_grid_type @@ -97,6 +99,9 @@ module MOM_diagnostics integer :: id_cg_ebt = -1, id_Rd_ebt = -1 integer :: id_p_ebt = -1 integer :: id_temp_int = -1, id_salt_int = -1 + integer :: id_absscint = -1, id_pfscint = -1 + integer :: id_scint = -1 + integer :: id_chcint = -1, id_phcint = -1 integer :: id_mass_wt = -1, id_col_mass = -1 integer :: id_masscello = -1, id_masso = -1 integer :: id_volcello = -1 @@ -904,9 +909,11 @@ subroutine calculate_vertical_integrals(h, tv, p_surf, G, GV, US, CS) ! at the ocean surface [R L2 T-2 ~> Pa]. tr_int ! vertical integral of a tracer times density, ! (Rho_0 in a Boussinesq model) [Conc R Z ~> Conc kg m-2]. + real :: tmp(SZI_(G),SZJ_(G),SZK_(GV)) ! Temporary array [defined at each usage] real :: IG_Earth ! Inverse of gravitational acceleration [T2 Z L-2 ~> s2 m-1]. integer :: i, j, k, is, ie, js, je, nz + integer, dimension(2) :: EOSdom ! The i-computational domain for the equation of state is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke if (CS%id_mass_wt > 0) then @@ -951,6 +958,84 @@ subroutine calculate_vertical_integrals(h, tv, p_surf, G, GV, US, CS) if (CS%id_col_mass > 0) call post_data(CS%id_col_mass, mass, CS%diag) endif + ! Practical salinity expressed as salt mass content + if (CS%id_scint > 0) then + EOSdom(:) = EOS_domain(G%HI) + if (tv%S_is_absS) then + do k=1,nz ; do j=js,je + call abs_saln_to_prac_saln(tv%S(:,j,k), tmp(:,j,k), tv%eqn_of_state, EOSdom) ! "tmp" [S ~> psu] + do i=is,ie + tmp(i,j,k) = ( GV%H_to_RZ * h(i,j,k) ) * tmp(i,j,k) ! "tmp" [R Z S ~> kg m-2] + enddo + enddo ; enddo + else + do k=1,nz ; do j=js,je ; do i=is,ie + tmp(i,j,k) = ( GV%H_to_RZ * h(i,j,k) ) * tv%S(i,j,k) ! "tmp" [R Z S ~> kg m-2] + enddo ; enddo ; enddo + endif + call post_data(CS%id_scint, tmp, CS%diag) + endif + ! Absolute salinities expressed as salt mass content + if (CS%id_absscint > 0 .or. CS%id_pfscint > 0) then + EOSdom(:) = EOS_domain(G%HI) + if (tv%S_is_absS) then + do k=1,nz ; do j=js,je ; do i=is,ie + tmp(i,j,k) = ( GV%H_to_RZ * h(i,j,k) ) * tv%S(i,j,k) ! "tmp" [R Z S ~> kg m-2] + enddo ; enddo ; enddo + else + do k=1,nz ; do j=js,je + call prac_saln_to_abs_saln(tv%S(:,j,k), tmp(:,j,k), tv%eqn_of_state, EOSdom) ! "tmp" [S ~> ppt] + do i=is,ie + tmp(i,j,k) = ( GV%H_to_RZ * h(i,j,k) ) * tmp(i,j,k) ! [R Z S ~> kg m-2] + enddo + enddo ; enddo + endif + if (CS%id_absscint > 0) call post_data(CS%id_absscint, tmp, CS%diag) + ! Based on the definitions in https://www.teos-10.org/pubs/gsw/pdf/TEOS-10_Manual.pdf + ! The preformed salinity, S*, is the conserved salinity used in models (page 8). + ! Although we appear to be labeling tv%S absolute salinity, we do not use the function + ! that calculates the "absolute salinity anomaly ratio" which accounts for the + ! geographic variations in the types of dissolved salts. + ! Hence, I think there is no difference between preformed and absolute salinity + ! for the current implementation of TEOS-10 and so we post the same data for + ! absscint and pfscint. -AJA + if (CS%id_pfscint > 0) call post_data(CS%id_pfscint, tmp, CS%diag) + endif + ! Potential temperature expressed as heat content + if (CS%id_phcint > 0) then + EOSdom(:) = EOS_domain(G%HI) + if (tv%T_is_conT) then + do k=1,nz ; do j=js,je + call cons_temp_to_pot_temp(tv%T(:,j,k), tv%S(:,j,k), tmp(:,j,k), tv%eqn_of_state, EOSdom) ! "tmp" [C ~> degC] + do i=is,ie + tmp(i,j,k) = ( ( tv%C_p * GV%H_to_RZ ) * h(i,j,k) ) * tmp(i,j,k) ! "tmp" [ Q R Z ~> J m-2] + enddo + enddo ; enddo + else + do k=1,nz ; do j=js,je ; do i=is,ie + tmp(i,j,k) = ( ( tv%C_p * GV%H_to_RZ ) * h(i,j,k) ) * tv%T(i,j,k) ! "tmp" [Q R Z ~> J m-2] + enddo ; enddo ; enddo + endif + call post_data(CS%id_phcint, tmp, CS%diag) + endif + ! Conservative temperature expressed as heat content + if (CS%id_chcint > 0) then + EOSdom(:) = EOS_domain(G%HI) + if (tv%T_is_conT) then + do k=1,nz ; do j=js,je ; do i=is,ie + tmp(i,j,k) = ( ( tv%C_p * GV%H_to_RZ ) * h(i,j,k) ) * tv%T(i,j,k) ! "tmp" [Q R Z ~> J m-2] + enddo ; enddo ; enddo + else + do k=1,nz ; do j=js,je + call pot_temp_to_cons_temp(tv%T(:,j,k), tv%S(:,j,k), tmp(:,j,k), tv%eqn_of_state, EOSdom) ! "tmp" [C ~> degC] + do i=is,ie + tmp(i,j,k) = ( ( tv%C_p * GV%H_to_RZ ) * h(i,j,k) ) * tmp(i,j,k) ! "tmp" [ Q R Z ~> J m-2] + enddo + enddo ; enddo + endif + call post_data(CS%id_chcint, tmp, CS%diag) + endif + end subroutine calculate_vertical_integrals !> This subroutine calculates terms in the mechanical energy budget. @@ -1891,6 +1976,43 @@ subroutine MOM_diagnostics_init(MIS, ADp, CDp, Time, G, GV, US, param_file, diag CS%id_abssosga = register_scalar_field('ocean_model', 'ssabss_global', Time, diag, & long_name='Global Area Average Sea Surface Absolute Salinity', & units='psu', conversion=US%S_to_ppt, standard_name='sea_surface_absolute_salinity') + + ! 2d column integrated + CS%id_temp_int = register_diag_field('ocean_model', 'temp_int', diag%axesT1, Time, & + 'Density weighted column integrated potential temperature', & + 'degC kg m-2', conversion=US%C_to_degC*US%RZ_to_kg_m2, & + cmor_field_name='opottempmint', & + cmor_long_name='integral_wrt_depth_of_product_of_sea_water_density_and_potential_temperature', & + cmor_standard_name='Depth integrated density times potential temperature') + CS%id_salt_int = register_diag_field('ocean_model', 'salt_int', diag%axesT1, Time, & + 'Density weighted column integrated salinity', & + 'psu kg m-2', conversion=US%S_to_ppt*US%RZ_to_kg_m2, v_extensive=.true., & + cmor_field_name='somint', & + cmor_long_name='integral_wrt_depth_of_product_of_sea_water_density_and_salinity', & + cmor_standard_name='Depth integrated density times salinity') + + ! 3d vertically integrated + CS%id_absscint = register_diag_field('ocean_model', 'absscint', diag%axesTL, Time, & + 'Integral wrt depth of seawater absolute salinity expressed as salt mass content', & + units='kg m-2', conversion=US%S_to_ppt*US%RZ_to_kg_m2, v_extensive=.true., & + standard_name='integral_wrt_depth_of_sea_water_absolute_salinity_expressed_as_salt_mass_content') + CS%id_pfscint = register_diag_field('ocean_model', 'pfscint', diag%axesTL, Time, & + ' Integral wrt depth of seawater preformed salinity expressed as salt mass content', & + units='kg m-2', conversion=US%S_to_ppt*US%RZ_to_kg_m2, v_extensive=.true., & + standard_name='integral_wrt_depth_of_sea_water_preformed_salinity_expressed_as_salt_mass_content') + CS%id_scint = register_diag_field('ocean_model', 'scint', diag%axesTL, Time, & + 'Integral wrt depth of seawater practical salinity expressed as salt mass content', & + units='kg m-2', conversion=US%S_to_ppt*US%RZ_to_kg_m2, v_extensive=.true., & + standard_name='integral_wrt_depth_of_sea_water_practical_salinity_expressed_as_salt_mass_content') + CS%id_chcint = register_diag_field('ocean_model', 'chcint', diag%axesTL, Time, & + 'Depth Integrated Seawater Conservative Temperature Expressed As Heat Content', & + units='J m-2', conversion=US%Q_to_J_kg*US%RZ_to_kg_m2, v_extensive=.true., & + standard_name='integral_wrt_depth_of_sea_water_conservative_temperature_expressed_as_heat_content') + CS%id_phcint = register_diag_field('ocean_model', 'phcint', diag%axesTL, Time, & + 'Integrated Ocean Heat Content from Potential Temperature', & + units='J m-2', conversion=US%Q_to_J_kg*US%RZ_to_kg_m2, v_extensive=.true., & + standard_name='integral_wrt_depth_of_sea_water_potential_temperature_expressed_as_heat_content') + endif CS%id_u = register_diag_field('ocean_model', 'u', diag%axesCuL, Time, & @@ -2077,22 +2199,6 @@ subroutine MOM_diagnostics_init(MIS, ADp, CDp, Time, G, GV, US, param_file, diag CS%id_mass_wt = register_diag_field('ocean_model', 'mass_wt', diag%axesT1, Time, & 'The column mass for calculating mass-weighted average properties', 'kg m-2', conversion=US%RZ_to_kg_m2) - if (use_temperature) then - CS%id_temp_int = register_diag_field('ocean_model', 'temp_int', diag%axesT1, Time, & - 'Density weighted column integrated potential temperature', & - 'degC kg m-2', conversion=US%C_to_degC*US%RZ_to_kg_m2, & - cmor_field_name='opottempmint', & - cmor_long_name='integral_wrt_depth_of_product_of_sea_water_density_and_potential_temperature', & - cmor_standard_name='Depth integrated density times potential temperature') - - CS%id_salt_int = register_diag_field('ocean_model', 'salt_int', diag%axesT1, Time, & - 'Density weighted column integrated salinity', & - 'psu kg m-2', conversion=US%S_to_ppt*US%RZ_to_kg_m2, & - cmor_field_name='somint', & - cmor_long_name='integral_wrt_depth_of_product_of_sea_water_density_and_salinity', & - cmor_standard_name='Depth integrated density times salinity') - endif - CS%id_col_mass = register_diag_field('ocean_model', 'col_mass', diag%axesT1, Time, & 'The column integrated in situ density', 'kg m-2', conversion=US%RZ_to_kg_m2) diff --git a/src/equation_of_state/MOM_EOS.F90 b/src/equation_of_state/MOM_EOS.F90 index ee49bd282d..121bf88825 100644 --- a/src/equation_of_state/MOM_EOS.F90 +++ b/src/equation_of_state/MOM_EOS.F90 @@ -50,7 +50,9 @@ module MOM_EOS public calculate_TFreeze public convert_temp_salt_for_TEOS10 public cons_temp_to_pot_temp +public pot_temp_to_cons_temp public abs_saln_to_prac_saln +public prac_saln_to_abs_saln public gsw_sp_from_sr public gsw_sr_from_sp public gsw_pt_from_ct From 3accd27d894d25ff4eeec05f8e6d7e2d168464af Mon Sep 17 00:00:00 2001 From: alex-huth Date: Mon, 9 Jun 2025 14:02:52 -0400 Subject: [PATCH 27/64] Optimized the ice-shelf CG scheme by reducing the number of times reproducing_sum (and therefore, mpp_sum) is called. Previously, several 2-D arrays were each being passed within their own reproducing_sum calls, which is now avoided by consolidating the 2-D arrays into one 3-D array that is passed to a single reproducing_sum call. --- src/ice_shelf/MOM_ice_shelf_dynamics.F90 | 49 ++++++++++++------------ 1 file changed, 25 insertions(+), 24 deletions(-) diff --git a/src/ice_shelf/MOM_ice_shelf_dynamics.F90 b/src/ice_shelf/MOM_ice_shelf_dynamics.F90 index 4f8a9f0cf2..59baa3bc8b 100644 --- a/src/ice_shelf/MOM_ice_shelf_dynamics.F90 +++ b/src/ice_shelf/MOM_ice_shelf_dynamics.F90 @@ -1738,9 +1738,11 @@ subroutine ice_shelf_solve_inner(CS, ISS, G, US, u_shlf, v_shlf, taudx, taudy, H RHSu, RHSv, & ! Right hand side of the stress balance [R L3 Z T-2 ~> m kg s-2] Au, Av, & ! The retarding lateral stress contributions [R L3 Z T-2 ~> kg m s-2] Du, Dv, & ! Velocity changes [L T-1 ~> m s-1] - sum_vec, sum_vec_2, sum_vec_3 !, & - !ubd, vbd ! Boundary stress contributions [R L3 Z T-2 ~> kg m s-2] - real :: beta_k, dot_p1, resid0tol2, cg_halo, max_cg_halo + sum_vec + real, dimension(SZDIB_(G),SZDJB_(G),3) :: sum_vec_3d + real :: beta_k, resid0tol2, cg_halo, max_cg_halo + real :: sv3dsum ! sum of sum_vec_3d + real :: sv3dsums(3) ! layer sums of sum_vec_3d real :: alpha_k ! A scaling factor for iterative corrections [nondim] real :: resid_scale ! A scaling factor for redimensionalizing the global residuals [m2 L-2 ~> 1] ! [m2 L-2 ~> 1] [R L3 Z T-2 ~> m kg s-2] @@ -1763,7 +1765,6 @@ subroutine ice_shelf_solve_inner(CS, ISS, G, US, u_shlf, v_shlf, taudx, taudy, H Zu(:,:) = 0 ; Zv(:,:) = 0 ; DIAGu(:,:) = 0 ; DIAGv(:,:) = 0 Ru(:,:) = 0 ; Rv(:,:) = 0 ; Au(:,:) = 0 ; Av(:,:) = 0 ; RHSu(:,:) = 0 ; RHSv(:,:) = 0 Du(:,:) = 0 ; Dv(:,:) = 0 - dot_p1 = 0 ! Determine the loop limits for sums, bearing in mind that the arrays will be starting at 1. ! Includes the edge of the tile is at the western/southern bdry (if symmetric) @@ -1848,23 +1849,24 @@ subroutine ice_shelf_solve_inner(CS, ISS, G, US, u_shlf, v_shlf, taudx, taudy, H call pass_vector(Au,Av,G%domain, TO_ALL, BGRID_NE) - sum_vec(:,:) = 0.0 ; sum_vec_2(:,:) = 0.0 + sum_vec_3d(:,:,1:2) = 0.0 do J=Jscq_sv,Jecq ; do I=Iscq_sv,Iecq if (CS%umask(I,J) == 1) then - sum_vec(I,J) = resid_scale * (Zu(I,J) * Ru(I,J)) - sum_vec_2(I,J) = resid_scale * (Du(I,J) * Au(I,J)) + sum_vec_3d(I,J,1) = resid_scale * (Zu(I,J) * Ru(I,J)) + sum_vec_3d(I,J,2) = resid_scale * (Du(I,J) * Au(I,J)) Ru_old(I,J) = Ru(I,J) ; Zu_old(I,J) = Zu(I,J) endif if (CS%vmask(I,J) == 1) then - sum_vec(I,J) = sum_vec(I,J) + resid_scale * (Zv(I,J) * Rv(I,J)) - sum_vec_2(I,J) = sum_vec_2(I,J) + resid_scale * (Dv(I,J) * Av(I,J)) + sum_vec_3d(I,J,1) = sum_vec_3d(I,J,1) + resid_scale * (Zv(I,J) * Rv(I,J)) + sum_vec_3d(I,J,2) = sum_vec_3d(I,J,2) + resid_scale * (Dv(I,J) * Av(I,J)) Rv_old(I,J) = Rv(I,J) ; Zv_old(I,J) = Zv(I,J) endif enddo ; enddo - alpha_k = reproducing_sum( sum_vec, Is_sum, Ie_sum, Js_sum, Je_sum ) / & - reproducing_sum( sum_vec_2, Is_sum, Ie_sum, Js_sum, Je_sum ) + sv3dsum = reproducing_sum( sum_vec_3d(:,:,1:2), Is_sum, Ie_sum, Js_sum, Je_sum, sums=sv3dsums(1:2) ) + + alpha_k = sv3dsums(1)/sv3dsums(2) do J=js,je-1 ; do I=is,ie-1 if (CS%umask(I,J) == 1) then @@ -1883,23 +1885,24 @@ subroutine ice_shelf_solve_inner(CS, ISS, G, US, u_shlf, v_shlf, taudx, taudy, H ! R,u,v,Z valid region moves in by 1 ! beta_k = (Z \dot R) / (Zold \dot Rold) - sum_vec(:,:) = 0.0 ; sum_vec_2(:,:) = 0.0 ; sum_vec_3(:,:) = 0.0 + sum_vec_3d(:,:,:) = 0.0; sv3dsums(:)=0.0 do J=jscq_sv,jecq ; do i=iscq_sv,iecq if (CS%umask(I,J) == 1) then - sum_vec(I,J) = resid_scale * (Zu(I,J) * Ru(I,J)) - sum_vec_2(I,J) = resid_scale * (Zu_old(I,J) * Ru_old(I,J)) - sum_vec_3(I,J) = resid2_scale * Ru(I,J)**2 + sum_vec_3d(I,J,1) = resid_scale * (Zu(I,J) * Ru(I,J)) + sum_vec_3d(I,J,2) = resid_scale * (Zu_old(I,J) * Ru_old(I,J)) + sum_vec_3d(I,J,3) = resid2_scale * Ru(I,J)**2 endif if (CS%vmask(I,J) == 1) then - sum_vec(I,J) = sum_vec(I,J) + resid_scale * (Zv(I,J) * Rv(I,J)) - sum_vec_2(I,J) = sum_vec_2(I,J) + resid_scale * (Zv_old(I,J) * Rv_old(I,J)) - sum_vec_3(I,J) = sum_vec_3(I,J) + resid2_scale * Rv(I,J)**2 + sum_vec_3d(I,J,1) = sum_vec_3d(I,J,1) + resid_scale * (Zv(I,J) * Rv(I,J)) + sum_vec_3d(I,J,2) = sum_vec_3d(I,J,2) + resid_scale * (Zv_old(I,J) * Rv_old(I,J)) + sum_vec_3d(I,J,3) = sum_vec_3d(I,J,3) + resid2_scale * Rv(I,J)**2 endif enddo ; enddo - beta_k = reproducing_sum(sum_vec, Is_sum, Ie_sum, Js_sum, Je_sum ) / & - reproducing_sum(sum_vec_2, Is_sum, Ie_sum, Js_sum, Je_sum ) + sv3dsum = reproducing_sum( sum_vec_3d, Is_sum, Ie_sum, Js_sum, Je_sum, sums=sv3dsums ) + + beta_k = sv3dsums(1)/sv3dsums(2) do J=js,je-1 ; do I=is,ie-1 if (CS%umask(I,J) == 1) Du(I,J) = Zu(I,J) + beta_k * Du(I,J) @@ -1908,10 +1911,8 @@ subroutine ice_shelf_solve_inner(CS, ISS, G, US, u_shlf, v_shlf, taudx, taudy, H ! D valid region moves in by 1 - dot_p1 = reproducing_sum( sum_vec_3, Is_sum, Ie_sum, Js_sum, Je_sum ) - - !if sqrt(dot_p1) <= (CS%cg_tolerance * resid0) - if (dot_p1 <= resid0tol2) then + !if sqrt(sv3dsums(3)) <= (CS%cg_tolerance * resid0) + if (sv3dsums(3) <= resid0tol2) then iters = iter conv_flag = 1 exit From 9030b2e3591bd870301d08b2456c8aa24fd67376 Mon Sep 17 00:00:00 2001 From: alex-huth Date: Mon, 29 Dec 2025 12:41:02 -0500 Subject: [PATCH 28/64] Check that frazil is allocated before adding it to ice-shelf water flux calculation. Needed for runs without frazil. --- src/ice_shelf/MOM_ice_shelf.F90 | 9 +++++++-- 1 file changed, 7 insertions(+), 2 deletions(-) diff --git a/src/ice_shelf/MOM_ice_shelf.F90 b/src/ice_shelf/MOM_ice_shelf.F90 index 772a21483a..d7e21436ac 100644 --- a/src/ice_shelf/MOM_ice_shelf.F90 +++ b/src/ice_shelf/MOM_ice_shelf.F90 @@ -359,7 +359,7 @@ subroutine shelf_calc_flux(sfc_state_in, fluxes_in, Time, time_step_in, CS) logical :: update_ice_vel ! If true, it is time to update the ice shelf velocities. logical :: coupled_GL ! If true, the grounding line position is determined based on ! coupled ice-ocean dynamics. - + logical :: add_frazil ! If true, allow frazil formation to modify ice-shelf water flux real, parameter :: c2_3 = 2.0/3.0 ! Two thirds [nondim] character(len=320) :: mesg ! The text of an error message integer, dimension(2) :: EOSdom ! The i-computational domain for the equation of state @@ -821,6 +821,11 @@ subroutine shelf_calc_flux(sfc_state_in, fluxes_in, Time, time_step_in, CS) enddo ! i-loop enddo ! j-loop + if (allocated(sfc_state%frazil)) then + add_frazil = .true. + else + add_frazil = .false. + endif do j=js,je ; do i=is,ie ! ISS%water_flux = net liquid water into the ocean [R Z T-1 ~> kg m-2 s-1] @@ -871,7 +876,7 @@ subroutine shelf_calc_flux(sfc_state_in, fluxes_in, Time, time_step_in, CS) mass_flux(i,j) = ISS%water_flux(i,j) * ISS%area_shelf_h(i,j) !Add frazil formation - if (ISS%hmask(i,j) == 1 .or. ISS%hmask(i,j) == 2) & + if (add_frazil .and. (ISS%hmask(i,j) == 1 .or. ISS%hmask(i,j) == 2)) & ISS%water_flux(i,j) = ISS%water_flux(i,j) - sfc_state%frazil(i,j) * I_dt_LHF fluxes%iceshelf_melt(i,j) = ISS%water_flux(i,j) enddo ; enddo ! i- and j-loops From a742bc33abd7d09f4b9718f860a67856d7f199f1 Mon Sep 17 00:00:00 2001 From: alex-huth Date: Thu, 25 Sep 2025 10:24:45 -0400 Subject: [PATCH 29/64] Added melt_mask for ice shelves --- src/ice_shelf/MOM_ice_shelf.F90 | 11 ++++----- src/ice_shelf/MOM_ice_shelf_initialize.F90 | 26 +++++++++++++++++----- src/ice_shelf/MOM_ice_shelf_state.F90 | 2 ++ 3 files changed, 29 insertions(+), 10 deletions(-) diff --git a/src/ice_shelf/MOM_ice_shelf.F90 b/src/ice_shelf/MOM_ice_shelf.F90 index d7e21436ac..1d33ebe757 100644 --- a/src/ice_shelf/MOM_ice_shelf.F90 +++ b/src/ice_shelf/MOM_ice_shelf.F90 @@ -502,7 +502,8 @@ subroutine shelf_calc_flux(sfc_state_in, fluxes_in, Time, time_step_in, CS) do i=is,ie if ((sfc_state%ocean_mass(i,j) > CS%col_mass_melt_threshold) .and. & - (ISS%area_shelf_h(i,j) > 0.0) .and. CS%isthermo) then + (ISS%area_shelf_h(i,j) > 0.0) .and. CS%isthermo & + .and. ISS%melt_mask(i,j)>0.0) then if (CS%threeeq) then ! Iteratively determine a self-consistent set of fluxes, with the ocean @@ -1925,8 +1926,8 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, Time_init, if (new_sim) then ! new simulation, initialize ice thickness as in the static case - call initialize_ice_thickness(ISS%h_shelf, ISS%area_shelf_h, ISS%hmask, CS%Grid, CS%Grid_in, US, param_file, & - CS%rotate_index, CS%turns) + call initialize_ice_thickness(ISS%h_shelf, ISS%area_shelf_h, ISS%hmask, ISS%melt_mask, CS%Grid, CS%Grid_in, & + US, param_file, CS%rotate_index, CS%turns) ! next make sure mass is consistent with thickness do j=G%jsd,G%jed ; do i=G%isd,G%ied @@ -2006,8 +2007,8 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, Time_init, if (new_sim .and. (.not. (CS%override_shelf_movement .and. CS%mass_from_file))) then ! This model is initialized internally or from a file. - call initialize_ice_thickness(ISS%h_shelf, ISS%area_shelf_h, ISS%hmask, CS%Grid, CS%Grid_in, US, param_file,& - CS%rotate_index, CS%turns) + call initialize_ice_thickness(ISS%h_shelf, ISS%area_shelf_h, ISS%hmask, ISS%melt_mask, CS%Grid, CS%Grid_in, & + US, param_file, CS%rotate_index, CS%turns) ! next make sure mass is consistent with thickness do j=G%jsd,G%jed ; do i=G%isd,G%ied if ((ISS%hmask(i,j) == 1) .or. (ISS%hmask(i,j) == 2) .or. (ISS%hmask(i,j) == 3)) then diff --git a/src/ice_shelf/MOM_ice_shelf_initialize.F90 b/src/ice_shelf/MOM_ice_shelf_initialize.F90 index a120f8a45e..8c3861b691 100644 --- a/src/ice_shelf/MOM_ice_shelf_initialize.F90 +++ b/src/ice_shelf/MOM_ice_shelf_initialize.F90 @@ -31,7 +31,7 @@ module MOM_ice_shelf_initialize contains !> Initialize ice shelf thickness -subroutine initialize_ice_thickness(h_shelf, area_shelf_h, hmask, G, G_in, US, PF, rotate_index, turns) +subroutine initialize_ice_thickness(h_shelf, area_shelf_h, hmask, melt_mask, G, G_in, US, PF, rotate_index, turns) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(ocean_grid_type), intent(in) :: G_in !< The ocean's unrotated grid structure real, dimension(SZDI_(G),SZDJ_(G)), & @@ -41,6 +41,8 @@ subroutine initialize_ice_thickness(h_shelf, area_shelf_h, hmask, G, G_in, US, P real, dimension(SZDI_(G),SZDJ_(G)), & intent(inout) :: hmask !< A mask indicating which tracer points are !! partly or fully covered by an ice-shelf + real, dimension(SZDI_(G),SZDJ_(G)), & + intent(inout) :: melt_mask !< A mask indicating where to allow ice-shelf melting type(unit_scale_type), intent(in) :: US !< A structure containing unit conversion factors type(param_file_type), intent(in) :: PF !< A structure to parse for run-time parameters logical, intent(in), optional :: rotate_index !< If true, this is a rotation test @@ -52,6 +54,7 @@ subroutine initialize_ice_thickness(h_shelf, area_shelf_h, hmask, G, G_in, US, P real, allocatable, dimension(:,:) :: tmp1_2d ! Temporary array for storing ice shelf input data real, allocatable, dimension(:,:) :: tmp2_2d ! Temporary array for storing ice shelf input data real, allocatable, dimension(:,:) :: tmp3_2d ! Temporary array for storing ice shelf input data + real, allocatable, dimension(:,:) :: tmp4_2d ! Temporary array for storing ice shelf input data call get_param(PF, mdl, "ICE_PROFILE_CONFIG", config, & "This specifies how the initial ice profile is specified. "//& @@ -64,20 +67,22 @@ subroutine initialize_ice_thickness(h_shelf, area_shelf_h, hmask, G, G_in, US, P allocate(tmp1_2d(G_in%isd:G_in%ied,G_in%jsd:G_in%jed), source=0.0) allocate(tmp2_2d(G_in%isd:G_in%ied,G_in%jsd:G_in%jed), source=0.0) allocate(tmp3_2d(G_in%isd:G_in%ied,G_in%jsd:G_in%jed), source=0.0) + allocate(tmp4_2d(G_in%isd:G_in%ied,G_in%jsd:G_in%jed), source=1.0) select case ( trim(config) ) case ("CHANNEL") ; call initialize_ice_thickness_channel (tmp1_2d, tmp2_2d, tmp3_2d, G_in, US, PF) - case ("FILE") ; call initialize_ice_thickness_from_file (tmp1_2d, tmp2_2d, tmp3_2d, G_in, US, PF) + case ("FILE") ; call initialize_ice_thickness_from_file (tmp1_2d, tmp2_2d, tmp3_2d, tmp4_2d, G_in, US, PF) case ("USER") ; call USER_init_ice_thickness (tmp1_2d, tmp2_2d, tmp3_2d, G_in, US, PF) case default ; call MOM_error(FATAL,"MOM_initialize: Unrecognized ice profile setup "//trim(config)) end select call rotate_array(tmp1_2d,turns, h_shelf) call rotate_array(tmp2_2d,turns, area_shelf_h) call rotate_array(tmp3_2d,turns, hmask) + call rotate_array(tmp4_2d,turns, melt_mask) deallocate(tmp1_2d,tmp2_2d,tmp3_2d) else select case ( trim(config) ) case ("CHANNEL") ; call initialize_ice_thickness_channel (h_shelf, area_shelf_h, hmask, G, US, PF) - case ("FILE") ; call initialize_ice_thickness_from_file (h_shelf, area_shelf_h, hmask, G, US, PF) + case ("FILE") ; call initialize_ice_thickness_from_file (h_shelf, area_shelf_h, hmask, melt_mask, G, US, PF) case ("USER") ; call USER_init_ice_thickness (h_shelf, area_shelf_h, hmask, G, US, PF) case default ; call MOM_error(FATAL,"MOM_initialize: Unrecognized ice profile setup "//trim(config)) end select @@ -86,7 +91,7 @@ subroutine initialize_ice_thickness(h_shelf, area_shelf_h, hmask, G, G_in, US, P end subroutine initialize_ice_thickness !> Initialize ice shelf thickness from file -subroutine initialize_ice_thickness_from_file(h_shelf, area_shelf_h, hmask, G, US, PF) +subroutine initialize_ice_thickness_from_file(h_shelf, area_shelf_h, hmask, melt_mask, G, US, PF) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure real, dimension(SZDI_(G),SZDJ_(G)), & intent(inout) :: h_shelf !< The ice shelf thickness [Z ~> m]. @@ -95,13 +100,15 @@ subroutine initialize_ice_thickness_from_file(h_shelf, area_shelf_h, hmask, G, U real, dimension(SZDI_(G),SZDJ_(G)), & intent(inout) :: hmask !< A mask indicating which tracer points are !! partly or fully covered by an ice-shelf + real, dimension(SZDI_(G),SZDJ_(G)), & + intent(inout) :: melt_mask !< A mask indicating where to allow ice-shelf melting type(unit_scale_type), intent(in) :: US !< A structure containing unit conversion factors type(param_file_type), intent(in) :: PF !< A structure to parse for run-time parameters ! This subroutine reads ice thickness and area from a file and puts it into ! h_shelf [Z ~> m] and area_shelf_h [L2 ~> m2] (and dimensionless) and updates hmask character(len=200) :: filename,thickness_file,inputdir ! Strings for file/path - character(len=200) :: thickness_varname, area_varname, hmask_varname ! Variable name in file + character(len=200) :: thickness_varname, area_varname, hmask_varname, melt_mask_varname ! Variable name in file character(len=40) :: mdl = "initialize_ice_thickness_from_file" ! This subroutine's name. integer :: i, j, isc, jsc, iec, jec logical :: hmask_set @@ -127,6 +134,9 @@ subroutine initialize_ice_thickness_from_file(h_shelf, area_shelf_h, hmask, G, U "The name of the area variable in ICE_THICKNESS_FILE.", & default="area_shelf_h") hmask_varname="h_mask" + call get_param(PF, mdl, "MELT_MASK_VARNAME", melt_mask_varname, & + "The name of the melt mask variable in ICE_THICKNESS_FILE.", & + default="melt_mask") if (.not.file_exists(filename, G%Domain)) call MOM_error(FATAL, & " initialize_topography_from_file: Unable to open "//trim(filename)) call MOM_read_data(filename, trim(thickness_varname), h_shelf, G%Domain, scale=US%m_to_Z) @@ -139,6 +149,12 @@ subroutine initialize_ice_thickness_from_file(h_shelf, area_shelf_h, hmask, G, U "from variable "//trim(hmask_varname)//", which does not exist in "//trim(filename)) hmask_set = .false. endif + if (field_exists(filename, trim(melt_mask_varname), MOM_domain=G%Domain)) then + call MOM_read_data(filename, trim(melt_mask_varname), melt_mask, G%Domain) + else + melt_mask(:,:)=1.0 + endif + isc = G%isc ; jsc = G%jsc ; iec = G%iec ; jec = G%jec if (.not.hmask_set) then diff --git a/src/ice_shelf/MOM_ice_shelf_state.F90 b/src/ice_shelf/MOM_ice_shelf_state.F90 index d789c08bd4..2da59bebc1 100644 --- a/src/ice_shelf/MOM_ice_shelf_state.F90 +++ b/src/ice_shelf/MOM_ice_shelf_state.F90 @@ -24,6 +24,7 @@ module MOM_ice_shelf_state real, pointer, dimension(:,:) :: & mass_shelf => NULL(), & !< The mass per unit area of the ice shelf or sheet [R Z ~> kg m-2]. area_shelf_h => NULL(), & !< The area per cell covered by the ice shelf [L2 ~> m2]. + melt_mask => NULL(), & !< Mask is > 0 where melting is allowed h_shelf => NULL(), & !< the thickness of the shelf [Z ~> m], redundant with mass but may !! make the code more readable dhdt_shelf => NULL(), & !< the change in thickness of the shelf over time [Z T-1 ~> m s-1] @@ -74,6 +75,7 @@ subroutine ice_shelf_state_init(ISS, G) allocate(ISS%mass_shelf(isd:ied,jsd:jed), source=0.0 ) allocate(ISS%area_shelf_h(isd:ied,jsd:jed), source=0.0 ) + allocate(ISS%melt_mask(isd:ied,jsd:jed), source=1.0 ) allocate(ISS%h_shelf(isd:ied,jsd:jed), source=0.0 ) allocate(ISS%dhdt_shelf(isd:ied,jsd:jed), source=0.0 ) allocate(ISS%hmask(isd:ied,jsd:jed), source=-2.0 ) From cc3f1a69c9b751d60896dc0efe7fc9012d34a6cc Mon Sep 17 00:00:00 2001 From: alex-huth Date: Thu, 4 Dec 2025 10:39:42 -0500 Subject: [PATCH 30/64] Added melt_mask to ice-shelf restart --- src/ice_shelf/MOM_ice_shelf.F90 | 2 ++ 1 file changed, 2 insertions(+) diff --git a/src/ice_shelf/MOM_ice_shelf.F90 b/src/ice_shelf/MOM_ice_shelf.F90 index 1d33ebe757..689feeb01b 100644 --- a/src/ice_shelf/MOM_ice_shelf.F90 +++ b/src/ice_shelf/MOM_ice_shelf.F90 @@ -1961,6 +1961,8 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, Time_init, "Ice shelf area in cell", "m2", conversion=US%L_to_m**2) call register_restart_field(ISS%h_shelf, "h_shelf", .true., CS%restart_CSp, & "ice sheet/shelf thickness", "m", conversion=US%Z_to_m) + call register_restart_field(ISS%melt_mask, "melt_mask", .false., CS%restart_CSp, & + "Mask that is >0 where ice-shelf melting is allowed", "none") if (CS%calve_ice_shelf_bergs) then call register_restart_field(ISS%calving, "shelf_calving", .true., CS%restart_CSp, & From b99fbd56ab95aa56d510f121104672408266f7ee Mon Sep 17 00:00:00 2001 From: alex-huth Date: Tue, 6 Jan 2026 14:10:39 -0500 Subject: [PATCH 31/64] comments and units --- src/ice_shelf/MOM_ice_shelf_dynamics.F90 | 12 +++++++----- src/ice_shelf/MOM_ice_shelf_initialize.F90 | 16 ++++++++-------- src/ice_shelf/MOM_ice_shelf_state.F90 | 2 +- 3 files changed, 16 insertions(+), 14 deletions(-) diff --git a/src/ice_shelf/MOM_ice_shelf_dynamics.F90 b/src/ice_shelf/MOM_ice_shelf_dynamics.F90 index 59baa3bc8b..66475f925e 100644 --- a/src/ice_shelf/MOM_ice_shelf_dynamics.F90 +++ b/src/ice_shelf/MOM_ice_shelf_dynamics.F90 @@ -1738,16 +1738,18 @@ subroutine ice_shelf_solve_inner(CS, ISS, G, US, u_shlf, v_shlf, taudx, taudy, H RHSu, RHSv, & ! Right hand side of the stress balance [R L3 Z T-2 ~> m kg s-2] Au, Av, & ! The retarding lateral stress contributions [R L3 Z T-2 ~> kg m s-2] Du, Dv, & ! Velocity changes [L T-1 ~> m s-1] - sum_vec - real, dimension(SZDIB_(G),SZDJB_(G),3) :: sum_vec_3d + sum_vec ! Global sum of squares of residuals in stress calculations [m2 kg2 s-4] + real, dimension(SZDIB_(G),SZDJB_(G),3) :: sum_vec_3d ! Array used for various global residuals + ! sum_vec_3d(:,:,1:2) [L T-1 ~> m s-1] [R L3 Z T-2 ~> m kg s-2] + ! sum_vec_3d(:,:,3) [R2 L6 Z2 T-4 ~> m2 kg2 s-4] real :: beta_k, resid0tol2, cg_halo, max_cg_halo real :: sv3dsum ! sum of sum_vec_3d real :: sv3dsums(3) ! layer sums of sum_vec_3d real :: alpha_k ! A scaling factor for iterative corrections [nondim] - real :: resid_scale ! A scaling factor for redimensionalizing the global residuals [m2 L-2 ~> 1] - ! [m2 L-2 ~> 1] [R L3 Z T-2 ~> m kg s-2] + real :: resid_scale ! A scaling factor for redimensionalizing the global residuals + ! [L T-1 ~> m s-1] [R L3 Z T-2 ~> m kg s-2] real :: resid2_scale ! A scaling factor for redimensionalizing the global squared residuals - ! [m2 L-2 ~> 1] [R L3 Z T-2 ~> m kg s-2] + ! [R2 L6 Z2 T-4 ~> m2 kg2 s-4] real :: rhoi_rhow ! The density of ice divided by a typical water density [nondim] integer :: iter, i, j, isd, ied, jsd, jed, isc, iec, jsc, jec, is, js, ie, je integer :: Is_sum, Js_sum, Ie_sum, Je_sum ! Loop bounds for global sums or arrays starting at 1. diff --git a/src/ice_shelf/MOM_ice_shelf_initialize.F90 b/src/ice_shelf/MOM_ice_shelf_initialize.F90 index 8c3861b691..d3d4ceb0a3 100644 --- a/src/ice_shelf/MOM_ice_shelf_initialize.F90 +++ b/src/ice_shelf/MOM_ice_shelf_initialize.F90 @@ -40,9 +40,9 @@ subroutine initialize_ice_thickness(h_shelf, area_shelf_h, hmask, melt_mask, G, intent(inout) :: area_shelf_h !< The area per cell covered by the ice shelf [L2 ~> m2]. real, dimension(SZDI_(G),SZDJ_(G)), & intent(inout) :: hmask !< A mask indicating which tracer points are - !! partly or fully covered by an ice-shelf + !! partly or fully covered by an ice-shelf [nondim] real, dimension(SZDI_(G),SZDJ_(G)), & - intent(inout) :: melt_mask !< A mask indicating where to allow ice-shelf melting + intent(inout) :: melt_mask !< A mask indicating where to allow ice-shelf melting [nondim] type(unit_scale_type), intent(in) :: US !< A structure containing unit conversion factors type(param_file_type), intent(in) :: PF !< A structure to parse for run-time parameters logical, intent(in), optional :: rotate_index !< If true, this is a rotation test @@ -51,10 +51,10 @@ subroutine initialize_ice_thickness(h_shelf, area_shelf_h, hmask, melt_mask, G, character(len=40) :: mdl = "initialize_ice_thickness" ! This subroutine's name. character(len=200) :: config logical :: rotate = .false. - real, allocatable, dimension(:,:) :: tmp1_2d ! Temporary array for storing ice shelf input data - real, allocatable, dimension(:,:) :: tmp2_2d ! Temporary array for storing ice shelf input data - real, allocatable, dimension(:,:) :: tmp3_2d ! Temporary array for storing ice shelf input data - real, allocatable, dimension(:,:) :: tmp4_2d ! Temporary array for storing ice shelf input data + real, allocatable, dimension(:,:) :: tmp1_2d ! Temporary array for storing ice shelf input data [Z~>m] + real, allocatable, dimension(:,:) :: tmp2_2d ! Temporary array for storing ice shelf input data [L2~>m2] + real, allocatable, dimension(:,:) :: tmp3_2d ! Temporary array for storing ice shelf input data [nondim] + real, allocatable, dimension(:,:) :: tmp4_2d ! Temporary array for storing ice shelf input data [nondim] call get_param(PF, mdl, "ICE_PROFILE_CONFIG", config, & "This specifies how the initial ice profile is specified. "//& @@ -99,9 +99,9 @@ subroutine initialize_ice_thickness_from_file(h_shelf, area_shelf_h, hmask, melt intent(inout) :: area_shelf_h !< The area per cell covered by the ice shelf [L2 ~> m2]. real, dimension(SZDI_(G),SZDJ_(G)), & intent(inout) :: hmask !< A mask indicating which tracer points are - !! partly or fully covered by an ice-shelf + !! partly or fully covered by an ice-shelf [nondim] real, dimension(SZDI_(G),SZDJ_(G)), & - intent(inout) :: melt_mask !< A mask indicating where to allow ice-shelf melting + intent(inout) :: melt_mask !< A mask indicating where to allow ice-shelf melting [nondim] type(unit_scale_type), intent(in) :: US !< A structure containing unit conversion factors type(param_file_type), intent(in) :: PF !< A structure to parse for run-time parameters diff --git a/src/ice_shelf/MOM_ice_shelf_state.F90 b/src/ice_shelf/MOM_ice_shelf_state.F90 index 2da59bebc1..6a4dee9a0e 100644 --- a/src/ice_shelf/MOM_ice_shelf_state.F90 +++ b/src/ice_shelf/MOM_ice_shelf_state.F90 @@ -24,7 +24,7 @@ module MOM_ice_shelf_state real, pointer, dimension(:,:) :: & mass_shelf => NULL(), & !< The mass per unit area of the ice shelf or sheet [R Z ~> kg m-2]. area_shelf_h => NULL(), & !< The area per cell covered by the ice shelf [L2 ~> m2]. - melt_mask => NULL(), & !< Mask is > 0 where melting is allowed + melt_mask => NULL(), & !< Mask is > 0 where melting is allowed [nondim] h_shelf => NULL(), & !< the thickness of the shelf [Z ~> m], redundant with mass but may !! make the code more readable dhdt_shelf => NULL(), & !< the change in thickness of the shelf over time [Z T-1 ~> m s-1] From d5ecb105e31343d46648118c3e37cf8004f7be66 Mon Sep 17 00:00:00 2001 From: alex-huth Date: Wed, 7 Jan 2026 15:31:23 -0500 Subject: [PATCH 32/64] subroutine ice_shelf_solve_inner: Completed variable descriptions and units; converted cg_halo and max_cg_halo from real to integer --- src/ice_shelf/MOM_ice_shelf_dynamics.F90 | 19 ++++++++++++------- 1 file changed, 12 insertions(+), 7 deletions(-) diff --git a/src/ice_shelf/MOM_ice_shelf_dynamics.F90 b/src/ice_shelf/MOM_ice_shelf_dynamics.F90 index 66475f925e..a8b53ad306 100644 --- a/src/ice_shelf/MOM_ice_shelf_dynamics.F90 +++ b/src/ice_shelf/MOM_ice_shelf_dynamics.F90 @@ -1738,19 +1738,24 @@ subroutine ice_shelf_solve_inner(CS, ISS, G, US, u_shlf, v_shlf, taudx, taudy, H RHSu, RHSv, & ! Right hand side of the stress balance [R L3 Z T-2 ~> m kg s-2] Au, Av, & ! The retarding lateral stress contributions [R L3 Z T-2 ~> kg m s-2] Du, Dv, & ! Velocity changes [L T-1 ~> m s-1] - sum_vec ! Global sum of squares of residuals in stress calculations [m2 kg2 s-4] - real, dimension(SZDIB_(G),SZDJB_(G),3) :: sum_vec_3d ! Array used for various global residuals - ! sum_vec_3d(:,:,1:2) [L T-1 ~> m s-1] [R L3 Z T-2 ~> m kg s-2] - ! sum_vec_3d(:,:,3) [R2 L6 Z2 T-4 ~> m2 kg2 s-4] - real :: beta_k, resid0tol2, cg_halo, max_cg_halo - real :: sv3dsum ! sum of sum_vec_3d - real :: sv3dsums(3) ! layer sums of sum_vec_3d + sum_vec ! Sum of squares of residuals in stress calculations [m2 kg2 s-4] + real, dimension(SZDIB_(G),SZDJB_(G),3) :: sum_vec_3d ! Array used for various residuals + ! sum_vec_3d(:,:,1:2) [m s-1] [m kg s-2] + ! sum_vec_3d(:,:,3) [m2 kg2 s-4] + real :: beta_k ! Ratio of residuals used to update search direction [nondim] + real :: resid0tol2 ! Convergence tolerance times the initial residual [m2 kg2 s-4] + real :: sv3dsum ! An unused variable returned when taking global sum of residuals [various] + real :: sv3dsums(3) ! The index-wise global sums of sum_vec_3d + ! sv3dsums(:,:,1:2) [m s-1] [m kg s-2] + ! sv3dsums(:,:,3) [m2 kg2 s-4] real :: alpha_k ! A scaling factor for iterative corrections [nondim] real :: resid_scale ! A scaling factor for redimensionalizing the global residuals ! [L T-1 ~> m s-1] [R L3 Z T-2 ~> m kg s-2] real :: resid2_scale ! A scaling factor for redimensionalizing the global squared residuals ! [R2 L6 Z2 T-4 ~> m2 kg2 s-4] real :: rhoi_rhow ! The density of ice divided by a typical water density [nondim] + integer :: cg_halo ! Number of halo vertices to include during a CG iteration + integer :: max_cg_halo ! Maximum possible number of halo vertices to include in the CG iterations integer :: iter, i, j, isd, ied, jsd, jed, isc, iec, jsc, jec, is, js, ie, je integer :: Is_sum, Js_sum, Ie_sum, Je_sum ! Loop bounds for global sums or arrays starting at 1. integer :: Isdq, Iedq, Jsdq, Jedq, Iscq, Iecq, Jscq, Jecq, nx_halo, ny_halo From f7611347fc805c1d86d3c5225b1f28666b3e2d85 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Fri, 2 Jan 2026 14:52:07 -0500 Subject: [PATCH 33/64] +Add trim_trailing_commas and ints_to_string Copied the function i2s from MOM_diag_mediator into the function ints_to_string in MOM_string_functions, and moved the code removing trailing commas from two places in MOM_diag_mediator into the new function trim_trailing_commas in MOM_string_functions. Because of the duplication of code between MOM6, SIS2 and the MOM6 ice shelf code, these functions would need to be replicated 3 or 6 times without these changes. Also added unit tests of both new functions to string_functions_unit_tests. All answers are bitwise identical but there are two new public functions in MOM_string_functions. --- src/framework/MOM_string_functions.F90 | 49 ++++++++++++++++++++++++++ 1 file changed, 49 insertions(+) diff --git a/src/framework/MOM_string_functions.F90 b/src/framework/MOM_string_functions.F90 index cabe0f6e40..ab7b8b8bd7 100644 --- a/src/framework/MOM_string_functions.F90 +++ b/src/framework/MOM_string_functions.F90 @@ -17,6 +17,8 @@ module MOM_string_functions public extract_real public remove_spaces public slasher +public trim_trailing_commas +public ints_to_string contains @@ -326,6 +328,10 @@ logical function string_functions_unit_tests(verbose) fail = fail .or. localTestS(v,left_reals(r(:)),'0.0, 1.0, -2.0, 1.3, 3*3.0E-11, -5.1E+12') fail = fail .or. localTestS(v,left_reals(r(:),sep=' '),'0.0 1.0 -2.0 1.3 3*3.0E-11 -5.1E+12') fail = fail .or. localTestS(v,left_reals(r(:),sep=','),'0.0,1.0,-2.0,1.3,3*3.0E-11,-5.1E+12') + fail = fail .or. localTestS(v,ints_to_string(i(:),5),'_-0001_0001_0003_0003_0000') + fail = fail .or. localTestS(v,ints_to_string(i(2:),2),'_0001_0003') + fail = fail .or. localTestS(v,ints_to_string(i(:)),'_-0001_0001_0003') + fail = fail .or. localTestS(v,trim_trailing_commas("One, Two, Three, "), "One, Two, Three") fail = fail .or. localTestS(v,extractWord("One Two,Three",1),"One") fail = fail .or. localTestS(v,extractWord("One Two,Three",2),"Two") fail = fail .or. localTestS(v,extractWord("One Two,Three",3),"Three") @@ -417,6 +423,49 @@ function slasher(dir) endif end function slasher +!> Returns a left-adjusted string with trailing blanks and commas removed. +function trim_trailing_commas(in_str) result(out_str) + character(len=*), intent(in) :: in_str !< A string that is to be left adjusted and have + !! its trailing commas and white space removed. + character(len=len(in_str)) :: out_str !< A left-adjusted version of in_str with + !! trailing commas and white space removed + + out_str = trim(adjustl(in_str)) + if (len_trim(out_str) > 0) then + if (out_str(len_trim(out_str):len_trim(out_str)) == ",") then + out_str = out_str(1:len_trim(out_str) - 1) + endif + out_str = trim(out_str) + endif + +end function trim_trailing_commas + +!> Convert the first n elements (3 by default) of an integer array into an underscore delimited string. +function ints_to_string(a, n) result(i2s) + integer, dimension(:), intent(in) :: a !< The array of integers to translate + integer, optional , intent(in) :: n !< The number of elements to translate, by default the lesser + !! of 3 or all of the integers + character(len=5*size(a)+1) :: i2s !< The returned underscore delimited string of integers + + character(len=8) :: i2s_temp + integer :: i, n_max + + n_max = 3 + if (present(n)) n_max = n + + i2s = '' + do i=1,min(size(a), n_max) + if (a(i) < 0) then + write (i2s_temp, '(I5.4)') a(i) + else + write (i2s_temp, '(I4.4)') a(i) + endif + i2s = trim(i2s) //'_'// trim(i2s_temp) + enddo + i2s = adjustl(i2s) +end function ints_to_string + + !> \namespace mom_string_functions !! !! By Alistair Adcroft and Robert Hallberg, last updated Sept. 2013. From 9f7aeb9c572999de3f4653a02d06f6cd4b3bc409 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Fri, 2 Jan 2026 14:52:40 -0500 Subject: [PATCH 34/64] Call trim_trailing_commas from register_diag_field Call trim_trailing_commas from register_diag_field and register_static_field and ints_to_string from trim_trailing_commas and eliminated the now redundant routine i2s. All code functions exactly as before but there is less duplicative code. --- src/framework/MOM_diag_mediator.F90 | 46 ++++------------------------- 1 file changed, 5 insertions(+), 41 deletions(-) diff --git a/src/framework/MOM_diag_mediator.F90 b/src/framework/MOM_diag_mediator.F90 index 9373ffe9a6..262ce67962 100644 --- a/src/framework/MOM_diag_mediator.F90 +++ b/src/framework/MOM_diag_mediator.F90 @@ -29,7 +29,7 @@ module MOM_diag_mediator use MOM_io, only : slasher, vardesc, query_vardesc, MOM_read_data use MOM_io, only : get_filename_appendix use MOM_safe_alloc, only : safe_alloc_ptr, safe_alloc_alloc -use MOM_string_functions, only : lowercase +use MOM_string_functions, only : lowercase, ints_to_string, trim_trailing_commas use MOM_time_manager, only : time_type use MOM_time_manager, only : get_time use MOM_unit_scaling, only : unit_scale_type @@ -1056,7 +1056,7 @@ subroutine define_axes_group(diag_cs, handles, axes, nz, vertical_coordinate_num n = size(handles) if (n<1 .or. n>3) call MOM_error(FATAL, "define_axes_group: wrong size for list of handles!") allocate( axes%handles(n) ) - axes%id = i2s(handles, n) ! Identifying string + axes%id = ints_to_string(handles, max(n,3)) ! Identifying string axes%rank = n axes%handles(:) = handles(:) axes%diag_cs => diag_cs ! A [circular] link back to the diag_cs structure @@ -1169,7 +1169,7 @@ subroutine define_axes_group_dsamp(diag_cs, handles, axes, dl, nz, vertical_coor n = size(handles) if (n<1 .or. n>3) call MOM_error(FATAL, "define_axes_group: wrong size for list of handles!") allocate( axes%handles(n) ) - axes%id = i2s(handles, n) ! Identifying string + axes%id = ints_to_string(handles, max(n,3)) ! Identifying string axes%rank = n axes%handles(:) = handles(:) axes%diag_cs => diag_cs ! A [circular] link back to the diag_cs structure @@ -2437,14 +2437,7 @@ integer function register_diag_field(module_name, field_name, axes_in, init_time if (axes_in%is_v_point) dimensions = trim(dimensions)//" xh, yq," if (axes_in%is_layer) dimensions = trim(dimensions)//" zl," if (axes_in%is_interface) dimensions = trim(dimensions)//" zi," - - if (len_trim(dimensions) > 0) then - dimensions = trim(adjustl(dimensions)) - if (dimensions(len_trim(dimensions):len_trim(dimensions)) == ",") then - dimensions = dimensions(1:len_trim(dimensions) - 1) - endif - dimensions = trim(dimensions) - endif + if (len_trim(dimensions) > 0) dimensions = trim_trailing_commas(dimensions) if (is_root_pe() .and. (diag_CS%available_diag_doc_unit > 0)) then msg = '' @@ -3181,14 +3174,7 @@ function register_static_field(module_name, field_name, axes, & if (axes%is_v_point) dimensions = trim(dimensions)//" xh, yq," if (axes%is_layer) dimensions = trim(dimensions)//" zl," if (axes%is_interface) dimensions = trim(dimensions)//" zi," - - if (len_trim(dimensions) > 0) then - dimensions = trim(adjustl(dimensions)) - if (dimensions(len_trim(dimensions):len_trim(dimensions)) == ",") then - dimensions = dimensions(1:len_trim(dimensions) - 1) - endif - dimensions = trim(dimensions) - endif + if (len_trim(dimensions) > 0) dimensions = trim_trailing_commas(dimensions) ! Document diagnostics in list of available diagnostics if (is_root_pe() .and. diag_CS%available_diag_doc_unit > 0) then @@ -3860,28 +3846,6 @@ subroutine diag_mediator_end(time, diag_CS, end_diag_manager) end subroutine diag_mediator_end -!> Convert the first n elements (up to 3) of an integer array to an underscore delimited string. -function i2s(a,n_in) - ! "Convert the first n elements of an integer array to a string." - ! Perhaps this belongs elsewhere in the MOM6 code? - integer, dimension(:), intent(in) :: a !< The array of integers to translate - integer, optional , intent(in) :: n_in !< The number of elements to translate, by default all - character(len=15) :: i2s !< The returned string - - character(len=15) :: i2s_temp - integer :: i,n - - n=size(a) - if (present(n_in)) n = n_in - - i2s = '' - do i=1,min(n,3) - write (i2s_temp, '(I4.4)') a(i) - i2s = trim(i2s) //'_'// trim(i2s_temp) - enddo - i2s = adjustl(i2s) -end function i2s - !> Returns a new diagnostic id, it may be necessary to expand the diagnostics array. integer function get_new_diag_id(diag_cs) type(diag_ctrl), intent(inout) :: diag_cs !< Diagnostics control structure From d3de0cb3296145a4aeaf1898c619926e7e63fdcb Mon Sep 17 00:00:00 2001 From: He Wang Date: Mon, 5 Jan 2026 14:40:01 -0500 Subject: [PATCH 35/64] Refactor nsten_halo in routine advect_tracer Move nsten_halo out of iteration loop --- src/tracer/MOM_tracer_advect.F90 | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/tracer/MOM_tracer_advect.F90 b/src/tracer/MOM_tracer_advect.F90 index 6ca6614791..2e3d3a8a0e 100644 --- a/src/tracer/MOM_tracer_advect.F90 +++ b/src/tracer/MOM_tracer_advect.F90 @@ -223,15 +223,15 @@ subroutine advect_tracer(h_end, uhtr, vhtr, OBC, dt, G, GV, US, CS, Reg, x_first !$OMP end parallel isv = is ; iev = ie ; jsv = js ; jev = je + nsten_halo = min(is - isd, ied - ie, js - jsd, jed - je) / stencil do itt=1,max_iter if (isv > is-stencil) then call do_group_pass(CS%pass_uhr_vhr_t_hprev, G%Domain, clock=id_clock_pass) - nsten_halo = min(is-isd,ied-ie,js-jsd,jed-je)/stencil - isv = is-nsten_halo*stencil ; jsv = js-nsten_halo*stencil - iev = ie+nsten_halo*stencil ; jev = je+nsten_halo*stencil + isv = is - nsten_halo * stencil ; jsv = js - nsten_halo * stencil + iev = ie + nsten_halo * stencil ; jev = je + nsten_halo * stencil ! Reevaluate domore_u & domore_v unless the valid range is the same size as ! before. Also, do this if there is Strang splitting. if ((nsten_halo > 1) .or. (itt==1)) then From a8f6945c029011aa8e22d3c23755fef2979a9e47 Mon Sep 17 00:00:00 2001 From: He Wang Date: Mon, 5 Jan 2026 14:51:57 -0500 Subject: [PATCH 36/64] Fix OBC indexing bug in MOM_tracer_advect Fix a bug that tracers in domain outside of the OBC is falsely updated when then the OBC is in the interior. The bug was due to an indexing error in routine advect_x. --- src/tracer/MOM_tracer_advect.F90 | 26 ++++++++++++-------------- 1 file changed, 12 insertions(+), 14 deletions(-) diff --git a/src/tracer/MOM_tracer_advect.F90 b/src/tracer/MOM_tracer_advect.F90 index 2e3d3a8a0e..27db3f5caa 100644 --- a/src/tracer/MOM_tracer_advect.F90 +++ b/src/tracer/MOM_tracer_advect.F90 @@ -680,13 +680,12 @@ subroutine advect_x(Tr, hprev, uhr, uh_neglect, OBC, domore_u, ntr, Idt, & ! Update do_i so that nothing changes outside of the OBC (problem for interior OBCs only) if (associated(OBC)) then - if ((.not.OBC%exterior_OBC_bug) .and. (OBC%OBC_pe)) then - if (OBC%specified_u_BCs_exist_globally .or. OBC%open_u_BCs_exist_globally) then - do i=is,ie-1 - if (OBC%segnum_u(I,j) > 0) do_i(i+1,j) = .false. ! OBC_DIRECTION_E - if (OBC%segnum_u(I,j) < 0) do_i(i,j) = .false. ! OBC_DIRECTION_W - enddo - endif + if ((.not.OBC%exterior_OBC_bug) .and. (OBC%OBC_pe) .and. & + (OBC%specified_u_BCs_exist_globally .or. OBC%open_u_BCs_exist_globally)) then + ! OBC_DIRECTION_E / OBC_DIRECTION_W on the west / east edge + do i=is,ie ; if ((OBC%segnum_u(I-1,j) > 0) .or. (OBC%segnum_u(I,j) < 0)) & + do_i(i,j) = .false. + enddo endif endif @@ -1093,13 +1092,12 @@ subroutine advect_y(Tr, hprev, vhr, vh_neglect, OBC, domore_v, ntr, Idt, & ! Update do_i so that nothing changes outside of the OBC (problem for interior OBCs only) if (associated(OBC)) then - if ((OBC%exterior_OBC_bug .eqv. .false.) .and. (OBC%OBC_pe)) then - if (OBC%specified_v_BCs_exist_globally .or. OBC%open_v_BCs_exist_globally) then - do i=is,ie - if (OBC%segnum_v(i,J-1) > 0) do_i(i,j) = .false. ! OBC_DIRECTION_N - if (OBC%segnum_v(i,J) < 0) do_i(i,j) = .false. ! OBC_DIRECTION_S - enddo - endif + if ((.not.OBC%exterior_OBC_bug) .and. (OBC%OBC_pe) .and. & + (OBC%specified_v_BCs_exist_globally .or. OBC%open_v_BCs_exist_globally)) then + ! OBC_DIRECTION_N / OBC_DIRECTION_S on the south / north edge + do i=is,ie ; if ((OBC%segnum_v(i,J-1) > 0) .or. (OBC%segnum_v(i,J) < 0)) & + do_i(i,j) = .false. + enddo endif endif From d19d9176b609b91864805d52b73aafdfbe9c869a Mon Sep 17 00:00:00 2001 From: Marshall Ward Date: Tue, 6 Jan 2026 14:01:23 -0500 Subject: [PATCH 37/64] MOM_interpolate: use get_axis_size() The prior version of `get_external_field_info` incorrectly relied on the `size` output of `get_external_field_info_infra` to determine the size of an external field's axes, since all external fields are assumed to be domain-decomposed. Since axis metadata is generally opaque, we have introduced a new infra function, `get_axis_data`, which returns the size of an axis. --- config_src/infra/FMS1/MOM_io_infra.F90 | 15 ++++++++++++++- config_src/infra/FMS2/MOM_io_infra.F90 | 13 ++++++++++++- src/framework/MOM_interpolate.F90 | 9 +++++---- 3 files changed, 31 insertions(+), 6 deletions(-) diff --git a/config_src/infra/FMS1/MOM_io_infra.F90 b/config_src/infra/FMS1/MOM_io_infra.F90 index 55a304e13e..14048c611b 100644 --- a/config_src/infra/FMS1/MOM_io_infra.F90 +++ b/config_src/infra/FMS1/MOM_io_infra.F90 @@ -14,6 +14,7 @@ module MOM_io_infra use mpp_io_mod, only : mpp_write_meta, mpp_write, mpp_read use mpp_io_mod, only : mpp_get_atts, mpp_attribute_exist use mpp_io_mod, only : mpp_get_axes, axistype, mpp_get_axis_data +use mpp_io_mod, only : mpp_get_axis_length use mpp_io_mod, only : mpp_get_fields, fieldtype use mpp_io_mod, only : mpp_get_info, mpp_get_times use mpp_io_mod, only : mpp_io_init @@ -33,7 +34,7 @@ module MOM_io_infra public :: get_file_info, get_file_fields, get_file_times, get_filename_suffix public :: read_field, read_vector, write_metadata, write_field public :: field_exists, get_field_atts, get_field_size, read_field_chksum -public :: get_axis_data, set_axis_data +public :: get_axis_size, get_axis_data, set_axis_data public :: io_infra_init, io_infra_end, MOM_namelist_file, check_namelist_error, write_version public :: stdout_if_root ! These types are inherited from underlying infrastructure code, to act as containers for @@ -404,6 +405,18 @@ subroutine get_field_size(filename, fieldname, sizes, field_found, no_domain) end subroutine get_field_size + +!> Get the size of the axis +function get_axis_size(axis) result(axis_size) + type(axistype), intent(in) :: axis + !< Infra axis + integer :: axis_size + !< Axis size + + axis_size = mpp_get_axis_length(axis) +end function get_axis_size + + !> Extracts and returns the axis data stored in an axistype. subroutine get_axis_data(axis, axis_name, axis_data) type(axistype), intent(in) :: axis diff --git a/config_src/infra/FMS2/MOM_io_infra.F90 b/config_src/infra/FMS2/MOM_io_infra.F90 index 7e8c78c220..efbf53009f 100644 --- a/config_src/infra/FMS2/MOM_io_infra.F90 +++ b/config_src/infra/FMS2/MOM_io_infra.F90 @@ -45,7 +45,7 @@ module MOM_io_infra public :: get_file_info, get_file_fields, get_file_times, get_filename_suffix public :: read_field, read_vector, write_metadata, write_field public :: field_exists, get_field_atts, get_field_size, read_field_chksum -public :: get_axis_data, set_axis_data +public :: get_axis_size, get_axis_data, set_axis_data public :: io_infra_init, io_infra_end, MOM_namelist_file, check_namelist_error, write_version public :: stdout_if_root ! These types act as containers for information about files, fields and axes, respectively, @@ -714,6 +714,17 @@ function find_index(vec) result(loc) end function find_index +!> Get the axis size from an axistype +function get_axis_size(axis) result(axis_size) + type(axistype), intent(in) :: axis + !< Infra axis + integer :: axis_size + !< Axis size + + axis_size = size(axis%ax_data) +end function get_axis_size + + !> Extracts and returns the axis data stored in an axistype. subroutine get_axis_data(axis, axis_name, axis_data) type(axistype), intent(in) :: axis diff --git a/src/framework/MOM_interpolate.F90 b/src/framework/MOM_interpolate.F90 index aa393e8990..d6ce5c720f 100644 --- a/src/framework/MOM_interpolate.F90 +++ b/src/framework/MOM_interpolate.F90 @@ -12,7 +12,7 @@ module MOM_interpolate use MOM_interp_infra, only : run_horiz_interp, build_horiz_interp_weights use MOM_interp_infra, only : external_field use MOM_io_infra, only : axistype -use MOM_io_infra, only : get_axis_data +use MOM_io_infra, only : get_axis_size, get_axis_data use MOM_io, only : axis_info, set_axis_info use MOM_time_manager, only : time_type, set_date, operator(+), operator(<), operator(>) @@ -303,16 +303,17 @@ subroutine get_external_field_info(field, size, axes, missing) integer :: n ! Axis index + integer :: ax_size + ! Axis size if (present(axes)) then call get_external_field_info_infra(field, size=size, axes=axes_infra, & missing=missing) ! TODO: Most of these methods were written to expect four dimensions. - ! I would not expect a generic field to be well-behaved, but I am unsure - ! how to validate such a field. do n=1,4 ! Convert axistype to axis_info - allocate(ax_data(size(n))) + ax_size = get_axis_size(axes_infra(n)) + allocate(ax_data(ax_size)) call get_axis_data(axes_infra(n), axis_name, ax_data) call set_axis_info(axes(n), trim(axis_name), ax_data=ax_data) deallocate(ax_data) From b03a7fb6c7d3025cd8583de03d06d5f4d4f5e684 Mon Sep 17 00:00:00 2001 From: Marshall Ward Date: Tue, 13 Jan 2026 16:07:46 -0500 Subject: [PATCH 38/64] ice-ocean-nolib: Fix SIS2 paths Patch to fix the SIS2 paths in the pipeline CI script. Explicitly excludes the icebergs stub, since we are using the actual icebergs model. --- .gitlab/pipeline-ci-tool.sh | 9 ++++++++- 1 file changed, 8 insertions(+), 1 deletion(-) diff --git a/.gitlab/pipeline-ci-tool.sh b/.gitlab/pipeline-ci-tool.sh index d948b72008..9d39907649 100755 --- a/.gitlab/pipeline-ci-tool.sh +++ b/.gitlab/pipeline-ci-tool.sh @@ -161,7 +161,14 @@ nolibs-ocean-ice-compile () { mkdir -p build-ocean-ice-nolibs-$1 cd build-ocean-ice-nolibs-$1 make -f ../tools/MRS/Makefile.build ./$1/env BUILD=. ENVIRON=../../environ -s - ../src/mkmf/bin/list_paths -l ../src/MOM6/config_src/{drivers/FMS_cap,memory/dynamic_symmetric,infra/FMS1,ext*} ../src/MOM6/src ../src/SIS2/*src ../src/icebergs/src ../src/{FMS1,coupler,ice_param,land_null,atmos_null} + ../src/mkmf/bin/list_paths -l \ + ../src/MOM6/config_src/{drivers/FMS_cap,memory/dynamic_symmetric,infra/FMS1,ext*} \ + ../src/MOM6/src \ + ../src/SIS2/src \ + ../src/SIS2/config_src/dynamic_symmetric \ + ../src/SIS2/config_src/Icepack_interfaces \ + ../src/icebergs/src \ + ../src/{FMS1,coupler,ice_param,land_null,atmos_null} sed -i '/FMS1\/.*\/test_/d' path_names ../src/mkmf/bin/mkmf -t ../src/mkmf/templates/ncrc5-$1.mk -p MOM6 -c"-Duse_libMPI -Duse_netCDF -D_USE_LEGACY_LAND_ -Duse_AM3_physics" path_names (source $1/env ; make NETCDF=3 REPRO=1 MOM6 -s -j) From 2076dc74d446f5ac5da6d7818e93fc8c74e06a42 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 13 Jan 2026 18:35:03 -0500 Subject: [PATCH 39/64] Correct the path to the Icepack interfaces The previous attempt to fix the automated no-library build of the ice-ocean model incorrectly specified the path to the Icepack_interfaces. This has now been corrected from `src/SIS2/config_src/external/Icepack_interfaces` to `src/SIS2/config_src/external/Icepack_interfaces` in pipeline-ci-tool.sh. The real mystery here is why the testing on the previous PR actually worked. --- .gitlab/pipeline-ci-tool.sh | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.gitlab/pipeline-ci-tool.sh b/.gitlab/pipeline-ci-tool.sh index 9d39907649..194794c202 100755 --- a/.gitlab/pipeline-ci-tool.sh +++ b/.gitlab/pipeline-ci-tool.sh @@ -166,7 +166,7 @@ nolibs-ocean-ice-compile () { ../src/MOM6/src \ ../src/SIS2/src \ ../src/SIS2/config_src/dynamic_symmetric \ - ../src/SIS2/config_src/Icepack_interfaces \ + ../src/SIS2/config_src/external/Icepack_interfaces \ ../src/icebergs/src \ ../src/{FMS1,coupler,ice_param,land_null,atmos_null} sed -i '/FMS1\/.*\/test_/d' path_names From 5875be701be63a2c0b4a93196eb6e8a2e2ccf6dd Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Mon, 29 Dec 2025 09:44:13 -0500 Subject: [PATCH 40/64] Delete unneeded masks args from 25 post_data calls Removed redundant mask arguments from 25 post_data() calls for 2-d arrays that were using masks that would have been set anyway based on the axes of these diagnostics. Explicit masks are only required for arrays that use unusual masks, pass atypically sized arrays (e.g., just the computational domain), or are static diagnostics that do not evolve in time. All answers and diagnostic output are bitwise identical. --- src/diagnostics/MOM_diagnostics.F90 | 49 +++++++++++++++-------------- src/tracer/MOM_tracer_hor_diff.F90 | 5 +-- 2 files changed, 26 insertions(+), 28 deletions(-) diff --git a/src/diagnostics/MOM_diagnostics.F90 b/src/diagnostics/MOM_diagnostics.F90 index 3b3e395fc7..c590b99501 100644 --- a/src/diagnostics/MOM_diagnostics.F90 +++ b/src/diagnostics/MOM_diagnostics.F90 @@ -414,7 +414,7 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & call cons_temp_to_pot_temp(tv%T(:,j,k), tv%S(:,j,k), work_3d(:,j,k), tv%eqn_of_state, EOSdom) enddo ; enddo if (CS%id_Tpot > 0) call post_data(CS%id_Tpot, work_3d, CS%diag) - if (CS%id_tob > 0) call post_data(CS%id_tob, work_3d(:,:,nz), CS%diag, mask=G%mask2dT) + if (CS%id_tob > 0) call post_data(CS%id_tob, work_3d(:,:,nz), CS%diag) ! volume mean potential temperature if (CS%id_thetaoga>0) then thetaoga = global_volume_mean(work_3d, h, G, GV, tmp_scale=US%C_to_degC) @@ -454,7 +454,7 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & endif else ! Internal T&S variables are potential temperature & practical salinity - if (CS%id_tob > 0) call post_data(CS%id_tob, tv%T(:,:,nz), CS%diag, mask=G%mask2dT) + if (CS%id_tob > 0) call post_data(CS%id_tob, tv%T(:,:,nz), CS%diag) if (CS%id_tosq > 0) then do k=1,nz ; do j=js,je ; do i=is,ie work_3d(i,j,k) = tv%T(i,j,k)*tv%T(i,j,k) @@ -490,7 +490,7 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & call abs_saln_to_prac_saln(tv%S(:,j,k), work_3d(:,j,k), tv%eqn_of_state, EOSdom) enddo ; enddo if (CS%id_Sprac > 0) call post_data(CS%id_Sprac, work_3d, CS%diag) - if (CS%id_sob > 0) call post_data(CS%id_sob, work_3d(:,:,nz), CS%diag, mask=G%mask2dT) + if (CS%id_sob > 0) call post_data(CS%id_sob, work_3d(:,:,nz), CS%diag) ! volume mean salinity if (CS%id_soga>0) then soga = global_volume_mean(work_3d, h, G, GV, tmp_scale=US%S_to_ppt) @@ -530,7 +530,7 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & endif else ! Internal T&S variables are potential temperature & practical salinity - if (CS%id_sob > 0) call post_data(CS%id_sob, tv%S(:,:,nz), CS%diag, mask=G%mask2dT) + if (CS%id_sob > 0) call post_data(CS%id_sob, tv%S(:,:,nz), CS%diag) if (CS%id_sosq > 0) then do k=1,nz ; do j=js,je ; do i=is,ie work_3d(i,j,k) = tv%S(i,j,k)*tv%S(i,j,k) @@ -1535,20 +1535,20 @@ subroutine post_surface_dyn_diags(IDs, G, diag, sfc_state, ssh) is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec if (IDs%id_ssh > 0) & - call post_data(IDs%id_ssh, ssh, diag, mask=G%mask2dT) + call post_data(IDs%id_ssh, ssh, diag) if (IDs%id_ssu > 0) & - call post_data(IDs%id_ssu, sfc_state%u, diag, mask=G%mask2dCu) + call post_data(IDs%id_ssu, sfc_state%u, diag) if (IDs%id_ssv > 0) & - call post_data(IDs%id_ssv, sfc_state%v, diag, mask=G%mask2dCv) + call post_data(IDs%id_ssv, sfc_state%v, diag) if (IDs%id_speed > 0) then do j=js,je ; do i=is,ie speed(i,j) = sqrt(0.5*((sfc_state%u(I-1,j)**2) + (sfc_state%u(I,j)**2)) + & 0.5*((sfc_state%v(i,J-1)**2) + (sfc_state%v(i,J)**2))) enddo ; enddo - call post_data(IDs%id_speed, speed, diag, mask=G%mask2dT) + call post_data(IDs%id_speed, speed, diag) endif if (IDs%id_ssu_east > 0 .or. IDs%id_ssv_north > 0) then @@ -1558,8 +1558,8 @@ subroutine post_surface_dyn_diags(IDs, G, diag, sfc_state, ssh) ssv_north(i,j) = ((0.5*(sfc_state%v(i,J-1) + sfc_state%v(i,J))) * G%cos_rot(i,j)) - & ((0.5*(sfc_state%u(I-1,j) + sfc_state%u(I,j))) * G%sin_rot(i,j)) enddo ; enddo - if (IDs%id_ssu_east > 0 ) call post_data(IDs%id_ssu_east, ssu_east, diag, mask=G%mask2dT) - if (IDs%id_ssv_north > 0 ) call post_data(IDs%id_ssv_north, ssv_north, diag, mask=G%mask2dT) + if (IDs%id_ssu_east > 0 ) call post_data(IDs%id_ssu_east, ssu_east, diag) + if (IDs%id_ssv_north > 0 ) call post_data(IDs%id_ssv_north, ssv_north, diag) endif end subroutine post_surface_dyn_diags @@ -1607,12 +1607,12 @@ subroutine post_surface_thermo_diags(IDs, G, GV, US, diag, dt_int, sfc_state, tv do j=js,je ; do i=is,ie zos(i,j) = ssh_ibc(i,j) - G%mask2dT(i,j)*zos_area_mean enddo ; enddo - if (IDs%id_zos > 0) call post_data(IDs%id_zos, zos, diag, mask=G%mask2dT) + if (IDs%id_zos > 0) call post_data(IDs%id_zos, zos, diag) if (IDs%id_zossq > 0) then do j=js,je ; do i=is,ie work_2d(i,j) = zos(i,j)*zos(i,j) enddo ; enddo - call post_data(IDs%id_zossq, work_2d, diag, mask=G%mask2dT) + call post_data(IDs%id_zossq, work_2d, diag) endif endif @@ -1633,7 +1633,7 @@ subroutine post_surface_thermo_diags(IDs, G, GV, US, diag, dt_int, sfc_state, tv do j=js,je ; do i=is,ie work_2d(i,j) = tv%frazil(i,j) * I_time_int enddo ; enddo - call post_data(IDs%id_fraz, work_2d, diag, mask=G%mask2dT) + call post_data(IDs%id_fraz, work_2d, diag) endif ! post time-averaged salt deficit @@ -1641,7 +1641,7 @@ subroutine post_surface_thermo_diags(IDs, G, GV, US, diag, dt_int, sfc_state, tv do j=js,je ; do i=is,ie work_2d(i,j) = tv%salt_deficit(i,j) * I_time_int enddo ; enddo - call post_data(IDs%id_salt_deficit, work_2d, diag, mask=G%mask2dT) + call post_data(IDs%id_salt_deficit, work_2d, diag) endif ! post temperature of P-E+R @@ -1649,7 +1649,7 @@ subroutine post_surface_thermo_diags(IDs, G, GV, US, diag, dt_int, sfc_state, tv do j=js,je ; do i=is,ie work_2d(i,j) = tv%TempxPmE(i,j) * (tv%C_p * I_time_int) enddo ; enddo - call post_data(IDs%id_Heat_PmE, work_2d, diag, mask=G%mask2dT) + call post_data(IDs%id_Heat_PmE, work_2d, diag) endif ! post geothermal heating or internal heat source/sinks @@ -1657,50 +1657,50 @@ subroutine post_surface_thermo_diags(IDs, G, GV, US, diag, dt_int, sfc_state, tv do j=js,je ; do i=is,ie work_2d(i,j) = tv%internal_heat(i,j) * (tv%C_p * I_time_int) enddo ; enddo - call post_data(IDs%id_intern_heat, work_2d, diag, mask=G%mask2dT) + call post_data(IDs%id_intern_heat, work_2d, diag) endif if (tv%T_is_conT) then ! Internal T&S variables are conservative temperature & absolute salinity - if (IDs%id_sstcon > 0) call post_data(IDs%id_sstcon, sfc_state%SST, diag, mask=G%mask2dT) + if (IDs%id_sstcon > 0) call post_data(IDs%id_sstcon, sfc_state%SST, diag) ! Use TEOS-10 function calls convert T&S diagnostics from conservative temp ! to potential temperature. EOSdom(:) = EOS_domain(G%HI) do j=js,je call cons_temp_to_pot_temp(sfc_state%SST(:,j), sfc_state%SSS(:,j), work_2d(:,j), tv%eqn_of_state, EOSdom) enddo - if (IDs%id_sst > 0) call post_data(IDs%id_sst, work_2d, diag, mask=G%mask2dT) + if (IDs%id_sst > 0) call post_data(IDs%id_sst, work_2d, diag) else ! Internal T&S variables are potential temperature & practical salinity - if (IDs%id_sst > 0) call post_data(IDs%id_sst, sfc_state%SST, diag, mask=G%mask2dT) + if (IDs%id_sst > 0) call post_data(IDs%id_sst, sfc_state%SST, diag) endif if (tv%S_is_absS) then ! Internal T&S variables are conservative temperature & absolute salinity - if (IDs%id_sssabs > 0) call post_data(IDs%id_sssabs, sfc_state%SSS, diag, mask=G%mask2dT) + if (IDs%id_sssabs > 0) call post_data(IDs%id_sssabs, sfc_state%SSS, diag) ! Use TEOS-10 function calls convert T&S diagnostics from absolute salinity ! to practical salinity. EOSdom(:) = EOS_domain(G%HI) do j=js,je call abs_saln_to_prac_saln(sfc_state%SSS(:,j), work_2d(:,j), tv%eqn_of_state, EOSdom) enddo - if (IDs%id_sss > 0) call post_data(IDs%id_sss, work_2d, diag, mask=G%mask2dT) + if (IDs%id_sss > 0) call post_data(IDs%id_sss, work_2d, diag) else ! Internal T&S variables are potential temperature & practical salinity - if (IDs%id_sss > 0) call post_data(IDs%id_sss, sfc_state%SSS, diag, mask=G%mask2dT) + if (IDs%id_sss > 0) call post_data(IDs%id_sss, sfc_state%SSS, diag) endif if (IDs%id_sst_sq > 0) then do j=js,je ; do i=is,ie work_2d(i,j) = sfc_state%SST(i,j)*sfc_state%SST(i,j) enddo ; enddo - call post_data(IDs%id_sst_sq, work_2d, diag, mask=G%mask2dT) + call post_data(IDs%id_sst_sq, work_2d, diag) endif if (IDs%id_sss_sq > 0) then do j=js,je ; do i=is,ie work_2d(i,j) = sfc_state%SSS(i,j)*sfc_state%SSS(i,j) enddo ; enddo - call post_data(IDs%id_sss_sq, work_2d, diag, mask=G%mask2dT) + call post_data(IDs%id_sss_sq, work_2d, diag) endif call coupler_type_send_data(sfc_state%tr_fields, get_diag_time_end(diag)) @@ -2430,6 +2430,7 @@ subroutine write_static_fields(G, GV, US, tv, diag) x_cell_method='mean', y_cell_method='mean', area_cell_method='mean') if (id > 0) then do j=G%jsc,G%jec ; do i=G%isc,G%iec ; work_2d(i,j) = G%bathyT(i,j)+G%Z_ref ; enddo ; enddo + ! A mask argument is required here because masks are not applied to static fields by default. call post_data(id, work_2d, diag, .true., mask=G%mask2dT) endif diff --git a/src/tracer/MOM_tracer_hor_diff.F90 b/src/tracer/MOM_tracer_hor_diff.F90 index 9a10826627..3e23483088 100644 --- a/src/tracer/MOM_tracer_hor_diff.F90 +++ b/src/tracer/MOM_tracer_hor_diff.F90 @@ -381,7 +381,7 @@ subroutine tracer_hordiff(h, dt, MEKE, VarMix, visc, G, GV, US, CS, Reg, tv, do_ call cpu_clock_end(id_clock_sync) num_itts = max(1, ceiling(max_CFL - 4.0*EPSILON(max_CFL))) I_numitts = 1.0 / (real(num_itts)) - if (CS%id_CFL > 0) call post_data(CS%id_CFL, CFL, CS%diag, mask=G%mask2dT) + if (CS%id_CFL > 0) call post_data(CS%id_CFL, CFL, CS%diag) elseif (CS%max_diff_CFL > 0.0) then num_itts = max(1, ceiling(CS%max_diff_CFL - 4.0*EPSILON(CS%max_diff_CFL))) I_numitts = 1.0 / (real(num_itts)) @@ -641,7 +641,6 @@ subroutine tracer_hordiff(h, dt, MEKE, VarMix, visc, G, GV, US, CS, Reg, tv, do_ enddo enddo endif - !call post_data(CS%id_KhTr_u, Kh_u, CS%diag, is_static=.false., mask=G%mask2dCu) call post_data(CS%id_KhTr_u, Kh_u, CS%diag) endif if (CS%id_KhTr_v > 0) then @@ -657,7 +656,6 @@ subroutine tracer_hordiff(h, dt, MEKE, VarMix, visc, G, GV, US, CS, Reg, tv, do_ enddo enddo endif - !call post_data(CS%id_KhTr_v, Kh_v, CS%diag, is_static=.false., mask=G%mask2dCv) call post_data(CS%id_KhTr_v, Kh_v, CS%diag) endif if (CS%id_KhTr_h > 0) then @@ -681,7 +679,6 @@ subroutine tracer_hordiff(h, dt, MEKE, VarMix, visc, G, GV, US, CS, Reg, tv, do_ enddo endif enddo ; enddo - !call post_data(CS%id_KhTr_h, Kh_h, CS%diag, is_static=.false., mask=G%mask2dT) call post_data(CS%id_KhTr_h, Kh_h, CS%diag) endif From 7343006800434668772e0ab12004b325c680ac66 Mon Sep 17 00:00:00 2001 From: He Wang Date: Wed, 17 Sep 2025 15:50:05 -0400 Subject: [PATCH 41/64] Add 2D meanSL field The spatially varying time mean sea level meanSL is used as a reference height to calculate, e.g., time mean ocean column thickness max(meanSL + bathyT, 0.0). This field allows the model run in a domain with spatically varying mean height, e.g. the Great Lakes system. This first commit insulates the changes from the rest of the model. It only adds the field to ocean_grid_type and dyn_horgrid_type, the transcription between the two types, and a routine to read it from a file. The field is not yet used by the rest of the code. --- src/core/MOM_grid.F90 | 19 ++++++++-- src/core/MOM_transcribe_grid.F90 | 4 ++ src/framework/MOM_dyn_horgrid.F90 | 24 +++++++++--- .../MOM_fixed_initialization.F90 | 17 ++++++++- .../MOM_shared_initialization.F90 | 37 +++++++++++++++++++ 5 files changed, 90 insertions(+), 11 deletions(-) diff --git a/src/core/MOM_grid.F90 b/src/core/MOM_grid.F90 index 94583673c2..4e8c1a9cc2 100644 --- a/src/core/MOM_grid.F90 +++ b/src/core/MOM_grid.F90 @@ -158,7 +158,16 @@ module MOM_grid y_ax_unit_short !< A short description of the y-axis units for documenting parameter units real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: & - bathyT !< Ocean bottom depth at tracer points, in depth units [Z ~> m]. + bathyT !< Ocean bottom depth, referenced to Z_ref at tracer points. bathyT is in + !! depth units and positive *below* Z_ref [Z ~> m]. + real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: & + meanSL !< Spatially varying time mean sea level, referenced to Z_ref at tracer points. + !! meanSL is in height units and positive *above* Z_ref. It is used + !! a) as the height where p = p_atm or zero; + !! b) to calculate time mean thickness of the water column, where + !! mean thickness = max(meanSL + bathyT, 0.0). + !! meanSL is 2D for the consideration of a domain with spatically varying mean + !! height, e.g. the Great Lakes system [Z ~> m]. real :: Z_ref !< A reference value for all geometric height fields, such as bathyT [Z ~> m]. logical :: bathymetry_at_vel !< If true, there are separate values for the @@ -584,6 +593,7 @@ subroutine allocate_metrics(G) ALLOC_(G%IareaCv(isd:ied,JsdB:JedB)) ; G%IareaCv(:,:) = 0.0 ALLOC_(G%bathyT(isd:ied, jsd:jed)) ; G%bathyT(:,:) = -G%Z_ref + ALLOC_(G%meanSL(isd:ied, jsd:jed)) ; G%meanSL(:,:) = G%Z_ref ALLOC_(G%CoriolisBu(IsdB:IedB, JsdB:JedB)) ; G%CoriolisBu(:,:) = 0.0 ALLOC_(G%Coriolis2Bu(IsdB:IedB, JsdB:JedB)) ; G%Coriolis2Bu(:,:) = 0.0 ALLOC_(G%dF_dx(isd:ied, jsd:jed)) ; G%dF_dx(:,:) = 0.0 @@ -631,9 +641,10 @@ subroutine MOM_grid_end(G) DEALLOC_(G%dx_Cv) ; DEALLOC_(G%dy_Cu) - DEALLOC_(G%bathyT) ; DEALLOC_(G%CoriolisBu) ; DEALLOC_(G%Coriolis2Bu) - DEALLOC_(G%dF_dx) ; DEALLOC_(G%dF_dy) - DEALLOC_(G%sin_rot) ; DEALLOC_(G%cos_rot) + DEALLOC_(G%bathyT) ; DEALLOC_(G%meanSL) + DEALLOC_(G%CoriolisBu) ; DEALLOC_(G%Coriolis2Bu) + DEALLOC_(G%dF_dx) ; DEALLOC_(G%dF_dy) + DEALLOC_(G%sin_rot) ; DEALLOC_(G%cos_rot) DEALLOC_(G%porous_DminU) ; DEALLOC_(G%porous_DmaxU) ; DEALLOC_(G%porous_DavgU) DEALLOC_(G%porous_DminV) ; DEALLOC_(G%porous_DmaxV) ; DEALLOC_(G%porous_DavgV) diff --git a/src/core/MOM_transcribe_grid.F90 b/src/core/MOM_transcribe_grid.F90 index d9ca19985f..5fd28164a2 100644 --- a/src/core/MOM_transcribe_grid.F90 +++ b/src/core/MOM_transcribe_grid.F90 @@ -56,6 +56,7 @@ subroutine copy_dyngrid_to_MOM_grid(dG, oG, US) oG%dyT(i,j) = dG%dyT(i+ido,j+jdo) oG%areaT(i,j) = dG%areaT(i+ido,j+jdo) oG%bathyT(i,j) = dG%bathyT(i+ido,j+jdo) - oG%Z_ref + oG%meanSL(i,j) = dG%meanSL(i+ido,j+jdo) + oG%Z_ref oG%dF_dx(i,j) = dG%dF_dx(i+ido,j+jdo) oG%dF_dy(i,j) = dG%dF_dy(i+ido,j+jdo) @@ -145,6 +146,7 @@ subroutine copy_dyngrid_to_MOM_grid(dG, oG, US) ! Update the halos in case the dynamic grid has smaller halos than the ocean grid. call pass_var(oG%areaT, oG%Domain) call pass_var(oG%bathyT, oG%Domain) + call pass_var(oG%meanSL, oG%Domain) call pass_var(oG%geoLonT, oG%Domain) call pass_var(oG%geoLatT, oG%Domain) call pass_vector(oG%dxT, oG%dyT, oG%Domain, To_All+Scalar_Pair, AGRID) @@ -217,6 +219,7 @@ subroutine copy_MOM_grid_to_dyngrid(oG, dG, US) dG%dyT(i,j) = oG%dyT(i+ido,j+jdo) dG%areaT(i,j) = oG%areaT(i+ido,j+jdo) dG%bathyT(i,j) = oG%bathyT(i+ido,j+jdo) + oG%Z_ref + dG%meanSL(i,j) = oG%meanSL(i+ido,j+jdo) - oG%Z_ref dG%dF_dx(i,j) = oG%dF_dx(i+ido,j+jdo) dG%dF_dy(i,j) = oG%dF_dy(i+ido,j+jdo) @@ -307,6 +310,7 @@ subroutine copy_MOM_grid_to_dyngrid(oG, dG, US) ! Update the halos in case the dynamic grid has smaller halos than the ocean grid. call pass_var(dG%areaT, dG%Domain) call pass_var(dG%bathyT, dG%Domain) + call pass_var(dG%meanSL, dG%Domain) call pass_var(dG%geoLonT, dG%Domain) call pass_var(dG%geoLatT, dG%Domain) call pass_vector(dG%dxT, dG%dyT, dG%Domain, To_All+Scalar_Pair, AGRID) diff --git a/src/framework/MOM_dyn_horgrid.F90 b/src/framework/MOM_dyn_horgrid.F90 index 59edd72f9c..e5c6c1dab5 100644 --- a/src/framework/MOM_dyn_horgrid.F90 +++ b/src/framework/MOM_dyn_horgrid.F90 @@ -157,7 +157,16 @@ module MOM_dyn_horgrid y_ax_unit_short !< A short description of the y-axis units for documenting parameter units real, allocatable, dimension(:,:) :: & - bathyT !< Ocean bottom depth at tracer points, in depth units [Z ~> m]. + bathyT !< Ocean bottom depth, referenced to a zero reference height at tracer points. + !! bathyT is in depth units and positive *below* the reference height [Z ~> m]. + real, allocatable, dimension(:,:) :: & + meanSL !< Spatially varying time mean sea level, referenced to a zero reference height + !! at tracer points. meanSL is in height units and positive *above* zero. It is used + !! a) as the height where p = p_atm or zero; + !! b) to calculate time mean thickness of the water column, where + !! mean thickness = max(meanSL + bathyT, 0.0). + !! meanSL is 2D for the consideration of a domain with spatically varying mean + !! height, e.g. the Great Lakes system [Z ~> m]. logical :: bathymetry_at_vel !< If true, there are separate values for the !! basin depths at velocity points. Otherwise the effects of @@ -290,8 +299,8 @@ subroutine create_dyn_horgrid(G, HI, bathymetry_at_vel) allocate(G%porous_DmaxV(isd:ied,JsdB:JedB), source=0.0) allocate(G%porous_DavgV(isd:ied,JsdB:JedB), source=0.0) - allocate(G%bathyT(isd:ied, jsd:jed), source=0.0) + allocate(G%meanSL(isd:ied, jsd:jed), source=0.0) allocate(G%CoriolisBu(IsdB:IedB, JsdB:JedB), source=0.0) allocate(G%Coriolis2Bu(IsdB:IedB, JsdB:JedB), source=0.0) allocate(G%dF_dx(isd:ied, jsd:jed), source=0.0) @@ -333,6 +342,7 @@ subroutine rotate_dyn_horgrid(G_in, G, US, turns) call rotate_array_pair(G_in%dxT, G_in%dyT, turns, G%dxT, G%dyT) call rotate_array(G_in%areaT, turns, G%areaT) call rotate_array(G_in%bathyT, turns, G%bathyT) + call rotate_array(G_in%meanSL, turns, G%meanSL) call rotate_array_pair(G_in%df_dx, G_in%df_dy, turns, G%df_dx, G%df_dy) call rotate_array(G_in%sin_rot, turns, G%sin_rot) @@ -435,6 +445,7 @@ subroutine rescale_dyn_horgrid_bathymetry(G, m_in_new_units) rescale = 1.0 / m_in_new_units do j=jsd,jed ; do i=isd,ied G%bathyT(i,j) = rescale*G%bathyT(i,j) + G%meanSL(i,j) = rescale*G%meanSL(i,j) enddo ; enddo if (G%bathymetry_at_vel) then ; do j=jsd,jed ; do I=IsdB,IedB G%Dblock_u(I,j) = rescale*G%Dblock_u(I,j) ; G%Dopen_u(I,j) = rescale*G%Dopen_u(I,j) @@ -519,7 +530,7 @@ subroutine destroy_dyn_horgrid(G) deallocate(G%areaT) ; deallocate(G%IareaT) deallocate(G%areaBu) ; deallocate(G%IareaBu) deallocate(G%areaCu) ; deallocate(G%IareaCu) - deallocate(G%areaCv) ; deallocate(G%IareaCv) + deallocate(G%areaCv) ; deallocate(G%IareaCv) deallocate(G%mask2dT) ; deallocate(G%mask2dCu) ; deallocate(G%OBCmaskCu) deallocate(G%mask2dCv) ; deallocate(G%OBCmaskCv) ; deallocate(G%mask2dBu) @@ -534,9 +545,10 @@ subroutine destroy_dyn_horgrid(G) deallocate(G%porous_DminU) ; deallocate(G%porous_DmaxU) ; deallocate(G%porous_DavgU) deallocate(G%porous_DminV) ; deallocate(G%porous_DmaxV) ; deallocate(G%porous_DavgV) - deallocate(G%bathyT) ; deallocate(G%CoriolisBu) ; deallocate(G%Coriolis2Bu) - deallocate(G%dF_dx) ; deallocate(G%dF_dy) - deallocate(G%sin_rot) ; deallocate(G%cos_rot) + deallocate(G%bathyT) ; deallocate(G%meanSL) + deallocate(G%CoriolisBu) ; deallocate(G%Coriolis2Bu) + deallocate(G%dF_dx) ; deallocate(G%dF_dy) + deallocate(G%sin_rot) ; deallocate(G%cos_rot) if (allocated(G%Dblock_u)) deallocate(G%Dblock_u) if (allocated(G%Dopen_u)) deallocate(G%Dopen_u) diff --git a/src/initialization/MOM_fixed_initialization.F90 b/src/initialization/MOM_fixed_initialization.F90 index 78559c72f2..dd4701e34f 100644 --- a/src/initialization/MOM_fixed_initialization.F90 +++ b/src/initialization/MOM_fixed_initialization.F90 @@ -25,6 +25,7 @@ module MOM_fixed_initialization use MOM_shared_initialization, only : read_face_length_list, set_velocity_depth_max, set_velocity_depth_min use MOM_shared_initialization, only : set_subgrid_topo_at_vel_from_file use MOM_shared_initialization, only : compute_global_grid_integrals +use MOM_shared_initialization, only : set_meanSL_from_file use MOM_unit_scaling, only : unit_scale_type use user_initialization, only : user_initialize_topography @@ -61,7 +62,8 @@ subroutine MOM_initialize_fixed(G, US, OBC, PF) ! Local variables character(len=200) :: inputdir ! The directory where NetCDF input files are. character(len=200) :: config - logical :: read_porous_file, OBC_projection_bug, open_corners, enable_bugs + logical :: OBC_projection_bug, open_corners, enable_bugs + logical :: read_porous_file, read_meanSL_file character(len=40) :: mdl = "MOM_fixed_initialization" ! This module's name. integer :: I, J logical :: debug @@ -87,6 +89,13 @@ subroutine MOM_initialize_fixed(G, US, OBC, PF) ! To initialize masks, the bathymetry in halo regions must be filled in call pass_var(G%bathyT, G%Domain) + ! Calculate time mean ocean total thickness + call get_param(PF, mdl, "READ_MEAN_SEA_LEVEL", read_meanSL_file, & + "If true, use a 2D map for time mean sea level, which is used to calculate "// & + "time mean ocean total thickness.", default=.False.) + if (read_meanSL_file) & + call set_meanSL_from_file(G%meanSL, G, PF, US) + ! Determine the position of any open boundaries call open_boundary_config(G, US, PF, OBC) @@ -103,6 +112,12 @@ subroutine MOM_initialize_fixed(G, US, OBC, PF) default=enable_bugs, do_not_log=.not.associated(OBC)) open_corners = .not.OBC_projection_bug + if (associated(OBC) .and. OBC_projection_bug .and. read_meanSL_file) & + ! OBC_projection_bug modifies bathyT outside of the open boundaries, so meanSL would have to be + ! modified as well. + call MOM_error(FATAL, "MOM_initialize_fixed: To read mean sea level file, "//& + "OBC_PROJECTION_BUG needs to be False.") + ! This call sets masks that prohibit flow over any point interpreted as land if (associated(OBC)) then if (OBC_projection_bug) & diff --git a/src/initialization/MOM_shared_initialization.F90 b/src/initialization/MOM_shared_initialization.F90 index 6f8ed1ed8e..132dc069e7 100644 --- a/src/initialization/MOM_shared_initialization.F90 +++ b/src/initialization/MOM_shared_initialization.F90 @@ -30,6 +30,7 @@ module MOM_shared_initialization public read_face_length_list, set_velocity_depth_max, set_velocity_depth_min public set_subgrid_topo_at_vel_from_file public compute_global_grid_integrals, write_ocean_geometry_file +public set_meanSL_from_file ! 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 @@ -136,6 +137,42 @@ function diagnoseMaximumDepth(D, G) call max_across_PEs(diagnoseMaximumDepth) end function diagnoseMaximumDepth +!> Read time mean ocean sea level from a file +subroutine set_meanSL_from_file(meanSL, G, param_file, US) + type(dyn_horgrid_type), intent(in) :: G !< The dynamic horizontal grid type + real, dimension(G%isd:G%ied,G%jsd:G%jed), & + intent(out) :: meanSL !< Mean sea level referenced to a zero + !! reference height at tracer points [Z ~> m]. + type(param_file_type), intent(in) :: param_file !< Parameter file structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + ! Local variables + logical :: read_meanSL_file + character(len=200) :: filename, file, inputdir ! Strings for file/path + character(len=200) :: varname ! Variable name in file + character(len=40) :: mdl = "set_meanSL_from_file" ! This subroutine's name. + integer :: i, j + + call callTree_enter(trim(mdl)//"(), MOM_shared_initialization.F90") + + call get_param(param_file, mdl, "INPUTDIR", inputdir, default=".") + inputdir = slasher(inputdir) + call get_param(param_file, mdl, "MEAN_SEA_LEVEL_FILE", file, & + "The file from which the mean sea level is read.", & + default="mean_sea_level.nc") + call get_param(param_file, mdl, "MEAN_SEA_LEVEL_VARNAME", varname, & + "The name of the mean sea level variable in MEAN_SEA_LEVEL_FILE.", & + default="meanSL") + filename = trim(inputdir)//trim(file) + call log_param(param_file, mdl, "INPUTDIR/TOPO_FILE", filename) + + if (.not.file_exists(filename, G%Domain)) & + call MOM_error(FATAL, " "//mdl//": Unable to open "//trim(filename)) + + call MOM_read_data(filename, trim(varname), meanSL, G%Domain, scale=US%m_to_Z) + call pass_var(meanSL, G%Domain) + + call callTree_leave(trim(mdl)//'()') +end subroutine set_meanSL_from_file !> Read gridded depths from file subroutine initialize_topography_from_file(D, G, param_file, US) From f1b9c45486e262c45583db09dc28d3941f0e0e80 Mon Sep 17 00:00:00 2001 From: He Wang Date: Thu, 18 Sep 2025 14:51:46 -0400 Subject: [PATCH 42/64] Use meanSL to calcualte mean column thickness This commit uses G%meanSL in 13 modules. The change is essentially replacing G%bathyT + G%Z_ref with G%meanSL + G%bathyT. Note that this does NOT mean parameter G%Z_ref is replaced by G%meanSL. G%Z_ref is factored in both G%meanSL and G%bathyT and it is kept as a useful consistency testing tool. Another cosmetic change is made by using G%meanSL + G%bathyT, instead of G%bathyT + G%meanSL, which (hopefully) can be easily interpreted as G%meanSL - (-G%bathyT). --- src/ALE/MOM_ALE.F90 | 2 +- src/ALE/MOM_hybgen_unmix.F90 | 12 ++--- src/ALE/MOM_regridding.F90 | 8 +-- src/core/MOM.F90 | 4 +- src/core/MOM_PressureForce_FV.F90 | 13 +++-- src/core/MOM_PressureForce_Montgomery.F90 | 8 +-- src/core/MOM_barotropic.F90 | 51 ++++++++++--------- src/diagnostics/MOM_wave_speed.F90 | 5 +- src/parameterizations/lateral/MOM_MEKE.F90 | 4 +- .../lateral/MOM_internal_tides.F90 | 2 +- .../lateral/MOM_lateral_mixing_coeffs.F90 | 26 ++++++---- .../vertical/MOM_internal_tide_input.F90 | 4 +- .../vertical/MOM_tidal_mixing.F90 | 6 +-- 13 files changed, 79 insertions(+), 66 deletions(-) diff --git a/src/ALE/MOM_ALE.F90 b/src/ALE/MOM_ALE.F90 index 2f763c7827..da93c37c10 100644 --- a/src/ALE/MOM_ALE.F90 +++ b/src/ALE/MOM_ALE.F90 @@ -1835,7 +1835,7 @@ subroutine ALE_initThicknessToCoord( CS, G, GV, h, height_units ) scale = GV%Z_to_H if (present(height_units)) then ; if (height_units) scale = 1.0 ; endif do j = G%jsd,G%jed ; do i = G%isd,G%ied - h(i,j,:) = scale * getStaticThickness( CS%regridCS, 0., G%bathyT(i,j)+G%Z_ref ) + h(i,j,:) = scale * getStaticThickness( CS%regridCS, 0., max(G%meanSL(i,j)+G%bathyT(i,j), 0.0) ) enddo ; enddo end subroutine ALE_initThicknessToCoord diff --git a/src/ALE/MOM_hybgen_unmix.F90 b/src/ALE/MOM_hybgen_unmix.F90 index d87762b721..5d8b8c9c10 100644 --- a/src/ALE/MOM_hybgen_unmix.F90 +++ b/src/ALE/MOM_hybgen_unmix.F90 @@ -219,18 +219,18 @@ subroutine hybgen_unmix(G, GV, US, CS, tv, Reg, ntr, h) do k=1,nk dz_tot = dz_tot + GV%H_to_RZ * tv%SpV_avg(i,j,k) * h_col(k) enddo - if (dz_tot <= CS%min_dilate*(G%bathyT(i,j)+G%Z_ref)) then + if (dz_tot <= CS%min_dilate * (G%meanSL(i,j) + G%bathyT(i,j))) then dilate = CS%min_dilate - elseif (dz_tot >= CS%max_dilate*(G%bathyT(i,j)+G%Z_ref)) then + elseif (dz_tot >= CS%max_dilate * (G%meanSL(i,j) + G%bathyT(i,j))) then dilate = CS%max_dilate else - dilate = dz_tot / (G%bathyT(i,j)+G%Z_ref) + dilate = dz_tot / (G%meanSL(i,j) + G%bathyT(i,j)) endif else - nominalDepth = (G%bathyT(i,j)+G%Z_ref)*GV%Z_to_H - if (h_tot <= CS%min_dilate*nominalDepth) then + nominalDepth = (G%meanSL(i,j) + G%bathyT(i,j)) * GV%Z_to_H + if (h_tot <= CS%min_dilate * nominalDepth) then dilate = CS%min_dilate - elseif (h_tot >= CS%max_dilate*nominalDepth) then + elseif (h_tot >= CS%max_dilate * nominalDepth) then dilate = CS%max_dilate else dilate = h_tot / nominalDepth diff --git a/src/ALE/MOM_regridding.F90 b/src/ALE/MOM_regridding.F90 index 872766bbab..2564b9a3bf 100644 --- a/src/ALE/MOM_regridding.F90 +++ b/src/ALE/MOM_regridding.F90 @@ -871,7 +871,7 @@ subroutine initialize_regridding(CS, G, GV, US, max_depth, param_file, mdl, & endif do i=G%isc-1,G%iec+1; do j=G%jsc-1,G%jec+1 if (G%mask2dT(i,j)>0.) then - nominalDepth = (G%bathyT(i,j)+G%Z_ref)*US%Z_to_m + nominalDepth = max(G%meanSL(i,j) + G%bathyT(i,j), 0.0) * US%Z_to_m if (nominalDepth <= depth_s) then do k= 1,n_sigma dz_3d(i,j,k) = dz_shallow(k) @@ -1251,15 +1251,15 @@ subroutine regridding_main( remapCS, CS, G, GV, US, h, tv, h_new, dzInterface, & tot_dz(i,j) = tot_dz(i,j) + GV%H_to_RZ * tv%SpV_avg(i,j,k) * h(i,j,k) enddo ; enddo ; enddo do j=G%jsc-1,G%jec+1 ; do i=G%isc-1,G%iec+1 - if ((tot_dz(i,j) > 0.0) .and. (G%bathyT(i,j)+G%Z_ref > 0.0)) then - nom_depth_H(i,j) = (G%bathyT(i,j)+G%Z_ref) * (tot_h(i,j) / tot_dz(i,j)) + if (tot_dz(i,j) > 0.0) then + nom_depth_H(i,j) = max(G%meanSL(i,j) + G%bathyT(i,j), 0.0) * (tot_h(i,j) / tot_dz(i,j)) else nom_depth_H(i,j) = 0.0 endif enddo ; enddo else do j=G%jsc-1,G%jec+1 ; do i=G%isc-1,G%iec+1 - nom_depth_H(i,j) = max((G%bathyT(i,j)+G%Z_ref) * Z_to_H, 0.0) + nom_depth_H(i,j) = max(G%meanSL(i,j) + G%bathyT(i,j), 0.0) * Z_to_H enddo ; enddo endif diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index c2b8104827..2350791f4d 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -4285,8 +4285,8 @@ subroutine extract_surface_state(CS, sfc_state_in) do j=js,je ; do i=is,ie if (G%mask2dT(i,j)>0.) then localError = sfc_state%sea_lev(i,j) < -G%bathyT(i,j) - G%Z_ref & - .or. sfc_state%sea_lev(i,j) >= CS%bad_val_ssh_max & - .or. sfc_state%sea_lev(i,j) <= -CS%bad_val_ssh_max & + .or. sfc_state%sea_lev(i,j) >= CS%bad_val_ssh_max + (G%meanSL(i,j) - G%Z_ref) & + .or. sfc_state%sea_lev(i,j) <= -CS%bad_val_ssh_max + (G%meanSL(i,j) - G%Z_ref) & .or. sfc_state%sea_lev(i,j) + G%bathyT(i,j) + G%Z_ref < CS%bad_val_col_thick if (use_temperature) localError = localError & .or. sfc_state%SSS(i,j)<0. & diff --git a/src/core/MOM_PressureForce_FV.F90 b/src/core/MOM_PressureForce_FV.F90 index 0f5e536c38..6a16392c3a 100644 --- a/src/core/MOM_PressureForce_FV.F90 +++ b/src/core/MOM_PressureForce_FV.F90 @@ -438,8 +438,9 @@ subroutine PressureForce_FV_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, AD else !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - SSH(i,j) = (za(i,j,1) - alpha_ref*p(i,j,1)) * I_gEarth - G%Z_ref & - - max(-G%bathyT(i,j)-G%Z_ref, 0.0) + SSH(i,j) = (za(i,j,1) - alpha_ref*p(i,j,1)) * I_gEarth - G%Z_ref + ! Remove above sea level topography at floodable cells + SSH(i,j) = SSH(i,j) - max(-G%bathyT(i,j)-G%meanSL(i,j), 0.0) enddo ; enddo call calc_SAL(SSH, e_sal, G, CS%SAL_CSp, tmp_scale=US%Z_to_m) endif @@ -1163,7 +1164,7 @@ subroutine PressureForce_FV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, ADp, !$OMP parallel do default(shared) do j=Jsq,Jeq+1 do i=Isq,Ieq+1 - SSH(i,j) = min(-G%bathyT(i,j) - G%Z_ref, 0.0) + SSH(i,j) = min(-G%bathyT(i,j) - G%meanSL(i,j), 0.0) enddo do k=1,nz ; do i=Isq,Ieq+1 SSH(i,j) = SSH(i,j) + h(i,j,k)*GV%H_to_Z @@ -1275,7 +1276,7 @@ subroutine PressureForce_FV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, ADp, enddo ; enddo else do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - Z_0p(i,j) = G%Z_ref + Z_0p(i,j) = G%meanSL(i,j) enddo ; enddo endif @@ -1359,7 +1360,9 @@ subroutine PressureForce_FV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, ADp, else !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - SSH(i,j) = e(i,j,1) - max(-G%bathyT(i,j) - G%Z_ref, 0.0) ! Remove topography above sea level + SSH(i,j) = e(i,j,1) - G%Z_ref + ! Remove above sea level topography at floodable cells + SSH(i,j) = SSH(i,j) - max(-G%bathyT(i,j)-G%meanSL(i,j), 0.0) enddo ; enddo call calc_SAL(SSH, e_sal, G, CS%SAL_CSp, tmp_scale=US%Z_to_m) endif diff --git a/src/core/MOM_PressureForce_Montgomery.F90 b/src/core/MOM_PressureForce_Montgomery.F90 index 1529af9d83..0098470502 100644 --- a/src/core/MOM_PressureForce_Montgomery.F90 +++ b/src/core/MOM_PressureForce_Montgomery.F90 @@ -197,7 +197,7 @@ subroutine PressureForce_Mont_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, pb ! of self-attraction and loading. !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - SSH(i,j) = min(-G%bathyT(i,j) - G%Z_ref, 0.0) + SSH(i,j) = min(-G%bathyT(i,j) - G%meanSL(i,j), 0.0) enddo ; enddo if (use_EOS) then !$OMP parallel do default(shared) @@ -476,7 +476,7 @@ subroutine PressureForce_Mont_Bouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, pbce, ! barotropic tides. !$OMP parallel do default(shared) do j=Jsq,Jeq+1 - do i=Isq,Ieq+1 ; SSH(i,j) = min(-G%bathyT(i,j) - G%Z_ref, 0.0) ; enddo + do i=Isq,Ieq+1 ; SSH(i,j) = min(-G%bathyT(i,j) - G%meanSL(i,j), 0.0) ; enddo do k=1,nz ; do i=Isq,Ieq+1 SSH(i,j) = SSH(i,j) + h(i,j,k)*GV%H_to_Z enddo ; enddo @@ -707,7 +707,7 @@ 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)) + dz_neglect) - press(i) = -Rho0xG*(e(i,j,1) - G%Z_ref) + press(i) = -Rho0xG*(e(i,j,1) - G%meanSL(i,j)) enddo call calculate_density(tv%T(:,j,1), tv%S(:,j,1), press, rho_in_situ, & tv%eqn_of_state, EOSdom) @@ -716,7 +716,7 @@ subroutine Set_pbce_Bouss(e, tv, G, GV, US, Rho0, GFS_scale, pbce, rho_star) enddo do k=2,nz do i=Isq,Ieq+1 - press(i) = -Rho0xG*(e(i,j,K) - G%Z_ref) + press(i) = -Rho0xG*(e(i,j,K) - G%meanSL(i,j)) T_int(i) = 0.5*(tv%T(i,j,k-1)+tv%T(i,j,k)) S_int(i) = 0.5*(tv%S(i,j,k-1)+tv%S(i,j,k)) enddo diff --git a/src/core/MOM_barotropic.F90 b/src/core/MOM_barotropic.F90 index 2c7e19be58..156ab6234c 100644 --- a/src/core/MOM_barotropic.F90 +++ b/src/core/MOM_barotropic.F90 @@ -5373,14 +5373,14 @@ subroutine find_face_areas(Datu, Datv, G, GV, US, CS, MS, halo, eta, add_max) H1 = CS%bathyT(i,j)*GV%Z_to_H + eta(i,j) ; H2 = CS%bathyT(i+1,j)*GV%Z_to_H + eta(i+1,j) Datu(I,j) = 0.0 ; if ((H1 > 0.0) .and. (H2 > 0.0)) & Datu(I,j) = CS%dy_Cu(I,j) * (2.0 * H1 * H2) / (H1 + H2) -! Datu(I,j) = CS%dy_Cu(I,j) * 0.5 * (H1 + H2) + ! Datu(I,j) = CS%dy_Cu(I,j) * 0.5 * (H1 + H2) enddo ; enddo !$OMP do do J=js-1-hs,je+hs ; do i=is-hs,ie+hs H1 = CS%bathyT(i,j)*GV%Z_to_H + eta(i,j) ; H2 = CS%bathyT(i,j+1)*GV%Z_to_H + eta(i,j+1) Datv(i,J) = 0.0 ; if ((H1 > 0.0) .and. (H2 > 0.0)) & Datv(i,J) = CS%dx_Cv(i,J) * (2.0 * H1 * H2) / (H1 + H2) -! Datv(i,J) = CS%dy_v(i,J) * 0.5 * (H1 + H2) + ! Datv(i,J) = CS%dy_v(i,J) * 0.5 * (H1 + H2) enddo ; enddo else !$OMP do @@ -5403,27 +5403,31 @@ subroutine find_face_areas(Datu, Datv, G, GV, US, CS, MS, halo, eta, add_max) !$OMP do do j=js-hs,je+hs ; do I=is-1-hs,ie+hs - Datu(I,j) = CS%dy_Cu(I,j) * Z_to_H * & - max(max(CS%bathyT(i+1,j), CS%bathyT(i,j)) + (G%Z_ref + add_max), 0.0) + H1 = max((G%meanSL(i+1,j) + add_max) + G%bathyT(i+1,j), 0.0) + H2 = max((G%meanSL(i,j) + add_max) + G%bathyT(i,j), 0.0) + Datu(I,j) = CS%dy_Cu(I,j) * Z_to_H * max(H1, H2) enddo ; enddo !$OMP do do J=js-1-hs,je+hs ; do i=is-hs,ie+hs - Datv(i,J) = CS%dx_Cv(i,J) * Z_to_H * & - max(max(CS%bathyT(i,j+1), CS%bathyT(i,j)) + (G%Z_ref + add_max), 0.0) + H1 = max((G%meanSL(i,j+1) + add_max) + G%bathyT(i,j+1), 0.0) + H2 = max((G%meanSL(i,j) + add_max) + G%bathyT(i,j), 0.0) + Datv(i,J) = CS%dx_Cv(i,J) * Z_to_H * max(H1, H2) enddo ; enddo else Z_to_H = GV%Z_to_H ; if (.not.GV%Boussinesq) Z_to_H = GV%RZ_to_H * CS%Rho_BT_lin !$OMP do do j=js-hs,je+hs ; do I=is-1-hs,ie+hs - H1 = (CS%bathyT(i,j) + G%Z_ref) * Z_to_H ; H2 = (CS%bathyT(i+1,j) + G%Z_ref) * Z_to_H + H1 = max(G%meanSL(i,j) + G%bathyT(i,j), 0.0) * Z_to_H + H2 = max(G%meanSL(i+1,j) + G%bathyT(i+1,j), 0.0) * Z_to_H Datu(I,j) = 0.0 if ((H1 > 0.0) .and. (H2 > 0.0)) & Datu(I,j) = CS%dy_Cu(I,j) * (2.0 * H1 * H2) / (H1 + H2) enddo ; enddo !$OMP do do J=js-1-hs,je+hs ; do i=is-hs,ie+hs - H1 = (CS%bathyT(i,j) + G%Z_ref) * Z_to_H ; H2 = (CS%bathyT(i,j+1) + G%Z_ref) * Z_to_H + H1 = max(G%meanSL(i,j) + G%bathyT(i,j), 0.0) * Z_to_H + H2 = max(G%meanSL(i,j+1) + G%bathyT(i,j+1), 0.0) * Z_to_H Datv(i,J) = 0.0 if ((H1 > 0.0) .and. (H2 > 0.0)) & Datv(i,J) = CS%dx_Cv(i,J) * (2.0 * H1 * H2) / (H1 + H2) @@ -5546,8 +5550,6 @@ subroutine barotropic_init(u, v, h, Time, G, GV, US, param_file, diag, CS, & ! name in wave_drag_file. character(len=80) :: wave_drag_v ! The wave drag piston velocity variable ! name in wave_drag_file. - real :: mean_SL ! The mean sea level that is used along with the bathymetry to estimate the - ! geometry when LINEARIZED_BT_CORIOLIS is true or BT_NONLIN_STRESS is false [Z ~> m]. real :: htot ! Total column thickness used when BT_NONLIN_STRESS is false [Z ~> m]. real :: Z_to_H ! A local unit conversion factor [H Z-1 ~> nondim or kg m-3] real :: H_to_Z ! A local unit conversion factor [Z H-1 ~> nondim or m3 kg-1] @@ -6150,25 +6152,26 @@ subroutine barotropic_init(u, v, h, Time, G, GV, US, param_file, diag, CS, & Z_to_H = GV%Z_to_H ; if (.not.GV%Boussinesq) Z_to_H = GV%RZ_to_H * CS%Rho_BT_lin - Mean_SL = G%Z_ref do j=js,je ; do I=is-1,ie - CS%D_u_Cor(I,j) = 0.5 * (max(Mean_SL+G%bathyT(i+1,j),0.0) + max(Mean_SL+G%bathyT(i,j),0.0)) * Z_to_H + CS%D_u_Cor(I,j) = 0.5 * ( max(G%meanSL(i+1,j) + G%bathyT(i+1,j), 0.0) & + + max(G%meanSL(i,j) + G%bathyT(i,j), 0.0) ) * Z_to_H enddo ; enddo if (CS%interior_OBC_PV .and. CS%BT_OBC%u_OBCs_on_PE) then ; do j=js,je ; do I=is-1,ie if (CS%BT_OBC%u_OBC_type(I,j) < 0) & ! Western boundary condition - CS%D_u_Cor(I,j) = max(Mean_SL+G%bathyT(i+1,j),0.0) * Z_to_H + CS%D_u_Cor(I,j) = max(G%meanSL(i+1,j) + G%bathyT(i+1,j), 0.0) * Z_to_H if (CS%BT_OBC%u_OBC_type(I,j) > 0) & ! Eastern boundary condition - CS%D_u_Cor(I,j) = max(Mean_SL+G%bathyT(i,j),0.0) * Z_to_H + CS%D_u_Cor(I,j) = max(G%meanSL(i,j) + G%bathyT(i,j), 0.0) * Z_to_H enddo ; enddo ; endif do J=js-1,je ; do i=is,ie - CS%D_v_Cor(i,J) = 0.5 * (max(Mean_SL+G%bathyT(i,j+1),0.0) + max(Mean_SL+G%bathyT(i,j),0.0)) * Z_to_H + CS%D_v_Cor(i,J) = 0.5 * ( max(G%meanSL(i,j+1) + G%bathyT(i,j+1), 0.0) & + + max(G%meanSL(i,j) + G%bathyT(i,j), 0.0) ) * Z_to_H enddo ; enddo if (CS%interior_OBC_PV .and. CS%BT_OBC%v_OBCs_on_PE) then ; do J=js-1,je ; do i=is,ie if (CS%BT_OBC%v_OBC_type(i,J) < 0) & ! Southern boundary condition - CS%D_v_Cor(i,J) = max(Mean_SL+G%bathyT(i,j+1),0.0) * Z_to_H + CS%D_v_Cor(i,J) = max(G%meanSL(i,j+1) + G%bathyT(i,j+1), 0.0) * Z_to_H if (CS%BT_OBC%v_OBC_type(i,J) > 0) & ! Northern boundary condition - CS%D_v_Cor(i,J) = max(Mean_SL+G%bathyT(i,j),0.0) * Z_to_H + CS%D_v_Cor(i,J) = max(G%meanSL(i,j) + G%bathyT(i,j), 0.0) * Z_to_H enddo ; enddo ; endif h_a_neglect = GV%H_subroundoff * 1.0 * US%m_to_L**2 @@ -6176,10 +6179,11 @@ subroutine barotropic_init(u, v, h, Time, G, GV, US, param_file, diag, CS, & if ((CS%q_wt(1,I,J) + CS%q_wt(4,I,J)) + (CS%q_wt(2,I,J) + CS%q_wt(3,I,J)) > 0.) then CS%q_D(I,J) = 0.25 * (CS%BT_Coriolis_scale * G%CoriolisBu(I,J)) * & ((CS%q_wt(1,I,J) + CS%q_wt(4,I,J)) + (CS%q_wt(2,I,J) + CS%q_wt(3,I,J))) / & - max(Z_to_H * (((CS%q_wt(1,I,J) * max(Mean_SL+G%bathyT(i,j),0.0)) + & - (CS%q_wt(4,I,J) * max(Mean_SL+G%bathyT(i+1,j+1),0.0))) + & - ((CS%q_wt(2,I,J) * max(Mean_SL+G%bathyT(i+1,j),0.0)) + & - (CS%q_wt(3,I,J) * max(Mean_SL+G%bathyT(i,j+1),0.0)))), h_a_neglect) + max(Z_to_H * (((CS%q_wt(1,I,J) * max(G%meanSL(i,j) + G%bathyT(i,j), 0.0)) + & + (CS%q_wt(4,I,J) * max(G%meanSL(i+1,j+1) + G%bathyT(i+1,j+1), 0.0))) + & + ((CS%q_wt(2,I,J) * max(G%meanSL(i+1,j) + G%bathyT(i+1,j), 0.0)) + & + (CS%q_wt(3,I,J) * max(G%meanSL(i,j+1) + G%bathyT(i,j+1), 0.0)))), & + h_a_neglect) else ! All four h points are masked out so q_D(I,J) is meaningless CS%q_D(I,J) = 0. endif @@ -6450,10 +6454,9 @@ subroutine barotropic_init(u, v, h, Time, G, GV, US, param_file, diag, CS, & ! Calculate other constants which are used for btstep. if (.not.CS%nonlin_stress) then - Mean_SL = G%Z_ref Z_to_H = GV%Z_to_H ; if (.not.GV%Boussinesq) Z_to_H = GV%RZ_to_H * CS%Rho_BT_lin do j=js,je ; do I=is-1,ie - htot = max(G%bathyT(i+1,j) + G%Z_ref, 0.0) + max(G%bathyT(i,j) + G%Z_ref, 0.0) + htot = max(G%meanSL(i+1,j) + G%bathyT(i+1,j), 0.0) + max(G%meanSL(i,j) + G%bathyT(i,j), 0.0) if (G%OBCmaskCu(I,j) * htot > 0.) then CS%IDatu(I,j) = G%OBCmaskCu(I,j) * 2.0 / (Z_to_H * htot) else ! Both neighboring H points are masked out or this is an OBC face so IDatu(I,j) is unused @@ -6461,7 +6464,7 @@ subroutine barotropic_init(u, v, h, Time, G, GV, US, param_file, diag, CS, & endif enddo ; enddo do J=js-1,je ; do i=is,ie - htot = max(G%bathyT(i,j+1) + G%Z_ref, 0.0) + max(G%bathyT(i,j) + G%Z_ref, 0.0) + htot = max(G%meanSL(i,j+1) + G%bathyT(i,j+1), 0.0) + max(G%meanSL(i,j) + G%bathyT(i,j), 0.0) if (G%OBCmaskCv(i,J) * htot > 0.) then CS%IDatv(i,J) = G%OBCmaskCv(i,J) * 2.0 / (Z_to_H * htot) else ! Both neighboring H points are masked out or this is an OBC face so IDatv(i,J) is unused diff --git a/src/diagnostics/MOM_wave_speed.F90 b/src/diagnostics/MOM_wave_speed.F90 index be5b29ac0e..09bb083c72 100644 --- a/src/diagnostics/MOM_wave_speed.F90 +++ b/src/diagnostics/MOM_wave_speed.F90 @@ -550,8 +550,9 @@ subroutine wave_speed(h, tv, G, GV, US, cg1, CS, halo_size, use_ebt_mode, mono_N ! Determine whether N2 estimates should not be allowed to increase with depth. if (l_mono_N2_column_fraction>0.) then if (GV%Boussinesq .or. GV%semi_Boussinesq) then - below_mono_N2_frac = (max(G%bathyT(i,j)+G%Z_ref, 0.0) - GV%H_to_Z*sum_hc < & - l_mono_N2_column_fraction*max(G%bathyT(i,j)+G%Z_ref, 0.0)) + below_mono_N2_frac = & + (max(G%meanSL(i,j) + G%bathyT(i,j), 0.0) - GV%H_to_Z * sum_hc < & + l_mono_N2_column_fraction * max(G%meanSL(i,j) + G%bathyT(i,j), 0.0)) else below_mono_N2_frac = (htot(i) - sum_hc < l_mono_N2_column_fraction*htot(i)) endif diff --git a/src/parameterizations/lateral/MOM_MEKE.F90 b/src/parameterizations/lateral/MOM_MEKE.F90 index 7abc24fe2d..5f3ad1e19d 100644 --- a/src/parameterizations/lateral/MOM_MEKE.F90 +++ b/src/parameterizations/lateral/MOM_MEKE.F90 @@ -372,12 +372,12 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h if (GV%Boussinesq) then !$OMP parallel do default(shared) do j=js-1,je+1 ; do i=is-1,ie+1 - depth_tot(i,j) = max(G%bathyT(i,j) + G%Z_ref, 0.0) * GV%Z_to_H + depth_tot(i,j) = max(G%meanSL(i,j) + G%bathyT(i,j), 0.0) * GV%Z_to_H enddo ; enddo else !$OMP parallel do default(shared) do j=js-1,je+1 ; do i=is-1,ie+1 - depth_tot(i,j) = max(G%bathyT(i,j) + G%Z_ref, 0.0) * CS%rho_fixed_total_depth * GV%RZ_to_H + depth_tot(i,j) = max(G%meanSL(i,j) + G%bathyT(i,j), 0.0) * CS%rho_fixed_total_depth * GV%RZ_to_H enddo ; enddo endif else diff --git a/src/parameterizations/lateral/MOM_internal_tides.F90 b/src/parameterizations/lateral/MOM_internal_tides.F90 index 05c471cc17..73ff57adbc 100644 --- a/src/parameterizations/lateral/MOM_internal_tides.F90 +++ b/src/parameterizations/lateral/MOM_internal_tides.F90 @@ -3773,7 +3773,7 @@ subroutine internal_tides_init(Time, G, GV, US, param_file, diag, CS) do j=G%jsc,G%jec ; do i=G%isc,G%iec ! Restrict RMS topographic roughness to a fraction (10 percent by default) of the column depth. if (RMS_roughness_frac >= 0.0) then - h2(i,j) = max(min((RMS_roughness_frac * max(G%bathyT(i,j)+G%Z_ref, 0.0))**2, h2(i,j)), 0.0) + h2(i,j) = max(min((RMS_roughness_frac * max(G%meanSL(i,j) + G%bathyT(i,j), 0.0))**2, h2(i,j)), 0.0) else h2(i,j) = max(h2(i,j), 0.0) endif diff --git a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 index baa4eb3d0c..2a1bea4b0b 100644 --- a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 +++ b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 @@ -206,6 +206,7 @@ subroutine calc_depth_function(G, CS) integer :: is, ie, js, je, Isq, Ieq, Jsq, Jeq integer :: i, j real :: H0 ! The depth above which KHTH is linearly scaled away [Z ~> m] + real :: h1, h2 ! Temporary total thicknesses [Z ~> m] real :: expo ! exponent used in the depth dependent scaling [nondim] is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB @@ -224,13 +225,15 @@ subroutine calc_depth_function(G, CS) expo = CS%depth_scaled_khth_exp !$OMP do do j=js,je ; do I=is-1,Ieq - CS%Depth_fn_u(I,j) = (MIN(1.0, & - (0.5 * (max(G%bathyT(i,j) + G%Z_ref, 0.0) + max(G%bathyT(i+1,j) + G%Z_ref, 0.0))) / H0))**expo + h1 = max(G%meanSL(i,j) + G%bathyT(i,j), 0.0) + h2 = max(G%meanSL(i+1,j) + G%bathyT(i+1,j), 0.0) + CS%Depth_fn_u(I,j) = (MIN(1.0, (0.5 * (h1 + h2)) / H0))**expo enddo ; enddo !$OMP do do J=js-1,Jeq ; do i=is,ie - CS%Depth_fn_v(i,J) = (MIN(1.0, & - (0.5 * (max(G%bathyT(i,j) + G%Z_ref, 0.0) + max(G%bathyT(i,j+1) + G%Z_ref, 0.0))) / H0))**expo + h1 = max(G%meanSL(i,j) + G%bathyT(i,j), 0.0) + h2 = max(G%meanSL(i,j+1) + G%bathyT(i,j+1), 0.0) + CS%Depth_fn_v(i,J) = (MIN(1.0, (0.5 * (h1 + h2)) / H0))**expo enddo ; enddo end subroutine calc_depth_function @@ -1194,6 +1197,7 @@ subroutine calc_slope_functions_using_just_e(h, G, GV, US, CS, e) ! real :: dz(SZI_(G),SZJ_(G),SZK_(GV)) ! The vertical distance across each layer [Z ~> m] real :: H_cutoff ! Local estimate of a minimum thickness for masking [H ~> m or kg m-2] real :: dZ_cutoff ! A minimum water column depth for masking [H ~> m or kg m-2] + real :: h1, h2 ! Temporary total thicknesses [Z ~> m] real :: h_neglect ! A thickness that is so small it is usually lost ! in roundoff and can be neglected [H ~> m or kg m-2]. real :: S2 ! Interface slope squared [Z2 L-2 ~> nondim] @@ -1303,9 +1307,10 @@ subroutine calc_slope_functions_using_just_e(h, G, GV, US, CS, e) enddo else do I=is-1,ie - if ( min(G%bathyT(i,j), G%bathyT(i+1,j)) + G%Z_ref > dZ_cutoff ) then - CS%SN_u(I,j) = G%OBCmaskCu(I,j) * sqrt( CS%SN_u(I,j) / & - (max(G%bathyT(i,j), G%bathyT(i+1,j)) + G%Z_ref) ) + h1 = max(G%meanSL(i,j) + G%bathyT(i,j), 0.0) + h2 = max(G%meanSL(i+1,j) + G%bathyT(i+1,j), 0.0) + if ( min(h1, h2) > dZ_cutoff ) then + CS%SN_u(I,j) = G%OBCmaskCu(I,j) * sqrt( CS%SN_u(I,j) / max(h1, h2) ) else CS%SN_u(I,j) = 0.0 endif @@ -1328,9 +1333,10 @@ subroutine calc_slope_functions_using_just_e(h, G, GV, US, CS, e) ! There is a primordial horizontal indexing bug on the following line from the previous ! versions of the code. This comment should be deleted by the end of 2024. ! if ( min(G%bathyT(i,j), G%bathyT(i+1,j)) + G%Z_ref > dZ_cutoff ) then - if ( min(G%bathyT(i,j), G%bathyT(i,j+1)) + G%Z_ref > dZ_cutoff ) then - CS%SN_v(i,J) = G%OBCmaskCv(i,J) * sqrt( CS%SN_v(i,J) / & - (max(G%bathyT(i,j), G%bathyT(i,j+1)) + G%Z_ref) ) + h1 = max(G%meanSL(i,j) + G%bathyT(i,j), 0.0) + h2 = max(G%meanSL(i,j+1) + G%bathyT(i,j+1), 0.0) + if ( min(h1, h2) > dZ_cutoff ) then + CS%SN_v(i,J) = G%OBCmaskCv(i,J) * sqrt( CS%SN_v(i,J) / max(h1, h2) ) else CS%SN_v(i,J) = 0.0 endif diff --git a/src/parameterizations/vertical/MOM_internal_tide_input.F90 b/src/parameterizations/vertical/MOM_internal_tide_input.F90 index 2a7a3a2a7c..4bf0351039 100644 --- a/src/parameterizations/vertical/MOM_internal_tide_input.F90 +++ b/src/parameterizations/vertical/MOM_internal_tide_input.F90 @@ -551,13 +551,13 @@ subroutine int_tide_input_init(Time, G, GV, US, param_file, diag, CS, itide) do fr=1,num_freq ; do j=js,je ; do i=is,ie mask_itidal = 1.0 - if (G%bathyT(i,j) + G%Z_ref < min_zbot_itides) mask_itidal = 0.0 + if (G%meanSL(i,j) + G%bathyT(i,j) < min_zbot_itides) mask_itidal = 0.0 CS%tideamp(i,j,fr) = CS%tideamp(i,j,fr) * mask_itidal * G%mask2dT(i,j) ! Restrict rms topo to a fraction (often 10 percent) of the column depth. if (max_frac_rough >= 0.0) & - itide%h2(i,j) = min((max_frac_rough * max(G%bathyT(i,j)+G%Z_ref, 0.0))**2, itide%h2(i,j)) + itide%h2(i,j) = min((max_frac_rough * max(G%meanSL(i,j) + G%bathyT(i,j), 0.0))**2, itide%h2(i,j)) ! Compute the fixed part of internal tidal forcing; units are [R Z4 H-1 T-2 ~> J m-2 or J m kg-1] here. CS%TKE_itidal_coef(i,j,fr) = 0.5*US%L_to_Z*kappa_h2_factor * GV%H_to_RZ * & diff --git a/src/parameterizations/vertical/MOM_tidal_mixing.F90 b/src/parameterizations/vertical/MOM_tidal_mixing.F90 index 13b76a77a1..714a4efd50 100644 --- a/src/parameterizations/vertical/MOM_tidal_mixing.F90 +++ b/src/parameterizations/vertical/MOM_tidal_mixing.F90 @@ -507,16 +507,16 @@ logical function tidal_mixing_init(Time, G, GV, US, param_file, int_tide_CSp, di units="nondim", default=0.1) do j=js,je ; do i=is,ie - if (G%bathyT(i,j)+G%Z_ref < CS%min_zbot_itides) CS%mask_itidal(i,j) = 0.0 + if (max(G%meanSL(i,j) + G%bathyT(i,j), 0.0) < CS%min_zbot_itides) CS%mask_itidal(i,j) = 0.0 CS%tideamp(i,j) = CS%tideamp(i,j) * CS%mask_itidal(i,j) * G%mask2dT(i,j) ! Restrict rms topo to a fraction (often 10 percent) of the column depth. if ((CS%tidal_answer_date < 20190101) .and. (max_frac_rough >= 0.0)) then - hamp = min(max_frac_rough*(G%bathyT(i,j)+G%Z_ref), sqrt(CS%h2(i,j))) + hamp = min(max_frac_rough * max(G%meanSL(i,j) + G%bathyT(i,j), 0.0), sqrt(CS%h2(i,j))) CS%h2(i,j) = hamp*hamp else if (max_frac_rough >= 0.0) & - CS%h2(i,j) = min((max_frac_rough * max(G%bathyT(i,j)+G%Z_ref, 0.0))**2, CS%h2(i,j)) + CS%h2(i,j) = min((max_frac_rough * max(G%meanSL(i,j) + G%bathyT(i,j), 0.0))**2, CS%h2(i,j)) endif utide = CS%tideamp(i,j) From cbcc0123b9e0d4a6bda147fd0df310041e1cee89 Mon Sep 17 00:00:00 2001 From: He Wang Date: Thu, 2 Oct 2025 14:18:03 -0400 Subject: [PATCH 43/64] Modify max_depth calculation using meanSL max_depth is really used as a maximum static thickness throughout the model, so meanSL needs to be considered. --- .../MOM_fixed_initialization.F90 | 51 +++++++++++++------ 1 file changed, 35 insertions(+), 16 deletions(-) diff --git a/src/initialization/MOM_fixed_initialization.F90 b/src/initialization/MOM_fixed_initialization.F90 index dd4701e34f..78266f2749 100644 --- a/src/initialization/MOM_fixed_initialization.F90 +++ b/src/initialization/MOM_fixed_initialization.F90 @@ -81,14 +81,6 @@ subroutine MOM_initialize_fixed(G, US, OBC, PF) ! Set up the parameters of the physical domain (i.e. the grid), G call set_grid_metrics(G, PF, US) - ! Set up the bottom depth, G%bathyT either analytically or from file - ! This also sets G%max_depth based on the input parameter MAXIMUM_DEPTH, - ! or, if absent, is diagnosed as G%max_depth = max( G%D(:,:) ) - call MOM_initialize_topography(G%bathyT, G%max_depth, G, PF, US) - - ! To initialize masks, the bathymetry in halo regions must be filled in - call pass_var(G%bathyT, G%Domain) - ! Calculate time mean ocean total thickness call get_param(PF, mdl, "READ_MEAN_SEA_LEVEL", read_meanSL_file, & "If true, use a 2D map for time mean sea level, which is used to calculate "// & @@ -96,6 +88,14 @@ subroutine MOM_initialize_fixed(G, US, OBC, PF) if (read_meanSL_file) & call set_meanSL_from_file(G%meanSL, G, PF, US) + ! Set up the bottom depth, G%bathyT either analytically or from file + ! This also sets G%max_depth based on the input parameter MAXIMUM_DEPTH, + ! or, if absent, is diagnosed as G%max_depth = max( G%D(:,:) ) + call MOM_initialize_topography(G%bathyT, G%max_depth, G, PF, US, meanSL=G%meanSL) + + ! To initialize masks, the bathymetry in halo regions must be filled in + call pass_var(G%bathyT, G%Domain) + ! Determine the position of any open boundaries call open_boundary_config(G, US, PF, OBC) @@ -209,21 +209,29 @@ subroutine MOM_initialize_fixed(G, US, OBC, PF) end subroutine MOM_initialize_fixed !> MOM_initialize_topography makes the appropriate call to set up the bathymetry in units of [Z ~> m]. -subroutine MOM_initialize_topography(D, max_depth, G, PF, US) +subroutine MOM_initialize_topography(D, max_depth, G, PF, US, meanSL) type(dyn_horgrid_type), intent(in) :: G !< The dynamic horizontal grid type real, dimension(G%isd:G%ied,G%jsd:G%jed), & intent(out) :: D !< Ocean bottom depth [Z ~> m] type(param_file_type), intent(in) :: PF !< Parameter file structure - real, intent(out) :: max_depth !< Maximum depth of model [Z ~> m] + real, intent(out) :: max_depth !< Maximum depth or geometric thickness, + !! with meanSL present, of model [Z ~> m] type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + real, dimension(G%isd:G%ied,G%jsd:G%jed), & + optional, intent(in) :: meanSL !< Mean sea level [Z ~> m] ! This subroutine makes the appropriate call to set up the bottom depth. ! This is a separate subroutine so that it can be made public and shared with ! the ice-sheet code or other components. ! Local variables + real :: max_depth_default = -1.e9 ! Default value of MAXIMUM_DEPTH parameter [m] character(len=40) :: mdl = "MOM_initialize_topography" ! This subroutine's name. character(len=200) :: config + real, dimension(G%isd:G%ied, G%jsd:G%jed) :: D_meanSL ! depth (positive below meanSL) referenced + ! to meanSL. A temporary field used to diagnose maximum + ! static column thickness. D_meanSL = D + meanSL [Z ~> m]. + integer :: i, j call get_param(PF, mdl, "TOPO_CONFIG", config, & "This specifies how bathymetry is specified: \n"//& @@ -253,7 +261,8 @@ subroutine MOM_initialize_topography(D, max_depth, G, PF, US) " \t dense - Denmark Strait-like dense water formation and overflow.\n"//& " \t USER - call a user modified routine.", & fail_if_missing=.true.) - call get_param(PF, mdl, "MAXIMUM_DEPTH", max_depth, units="m", default=-1.e9, scale=US%m_to_Z, do_not_log=.true.) + call get_param(PF, mdl, "MAXIMUM_DEPTH", max_depth, units="m", default=max_depth_default, & + scale=US%m_to_Z, do_not_log=.true.) select case ( trim(config) ) case ("file"); call initialize_topography_from_file(D, G, PF, US) case ("flat"); call initialize_topography_named(D, G, PF, config, max_depth, US) @@ -277,17 +286,27 @@ subroutine MOM_initialize_topography(D, max_depth, G, PF, US) case default ; call MOM_error(FATAL,"MOM_initialize_topography: "// & "Unrecognized topography setup '"//trim(config)//"'") end select - if (max_depth>0.) then + if (max_depth /= max_depth_default * US%m_to_Z) then call log_param(PF, mdl, "MAXIMUM_DEPTH", max_depth, & "The maximum depth of the ocean.", units="m", unscale=US%Z_to_m) + if (trim(config) /= "DOME") then + call limit_topography(D, G, PF, max_depth, US) + endif else - max_depth = diagnoseMaximumDepth(D,G) + if (present(meanSL)) then + D_meanSL(:,:) = 0.0 + do j=G%jsc,G%jec ; do i=G%isc,G%iec ; D_meanSL(i,j) = D(i,j) + meanSL(i,j) ; enddo ; enddo + max_depth = diagnoseMaximumDepth(D_meanSL, G) + else + max_depth = diagnoseMaximumDepth(D, G) + endif call log_param(PF, mdl, "!MAXIMUM_DEPTH", max_depth, & "The (diagnosed) maximum depth of the ocean.", & units="m", unscale=US%Z_to_m, like_default=.true.) - endif - if (trim(config) /= "DOME") then - call limit_topography(D, G, PF, max_depth, US) + if (trim(config) /= "DOME") then + ! MAXIMUM_DEPTH is not set and topography does not need to be trimmed by its maximum depth. + call limit_topography(D, G, PF, -max_depth_default * US%m_to_Z, US) + endif endif end subroutine MOM_initialize_topography From c2787154eaf954ed0ff5b64935a6ba81a17ad5e5 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Mon, 29 Dec 2025 16:32:07 -0500 Subject: [PATCH 44/64] +Fix how missing values are handled in post_data At no point does MOM6 code actually set arrays passed to the post_data() to have a missing value. Instead a missing value is set in output files entirely by masking. This commit eliminates the logic that would (inaccurately) try to reset fields that seem to match rescaled missing values to the output missing value. The previous code was inaccurate, in that a rescaled field could have taken on the unscaled missing value as a valid data point and still have been incorrectly marked is missing, although the odds of this happening are exceptionally small and it would only be cases with dimensional rescaling where this could have applied. For 2-d diagnostics, this commit eliminates a duplicative array syntax math expression that did exactly what the code now does. All solutions are identical, and because the missing value was not being explicitly it is unlikely that any diagnostics will change. --- src/framework/MOM_diag_mediator.F90 | 19 +++---------------- 1 file changed, 3 insertions(+), 16 deletions(-) diff --git a/src/framework/MOM_diag_mediator.F90 b/src/framework/MOM_diag_mediator.F90 index 262ce67962..ed3fb907db 100644 --- a/src/framework/MOM_diag_mediator.F90 +++ b/src/framework/MOM_diag_mediator.F90 @@ -1356,11 +1356,7 @@ subroutine post_data_1d_k(diag_field_id, field, diag_cs, is_static) allocate( locfield( ks:ke ) ) do k=ks,ke - if (field(k) == diag_cs%missing_value) then - locfield(k) = diag_cs%missing_value - else - locfield(k) = field(k) * diag%conversion_factor - endif + locfield(k) = field(k) * diag%conversion_factor enddo else locfield => field @@ -1482,13 +1478,8 @@ subroutine post_data_2d_low(diag, field, diag_cs, is_static, mask) if ((diag%conversion_factor /= 0.) .and. (diag%conversion_factor /= 1.)) then allocate( locfield( lbound(field,1):ubound(field,1), lbound(field,2):ubound(field,2) ) ) do j=jsv,jev ; do i=isv,iev - if (field(i,j) == diag_cs%missing_value) then - locfield(i,j) = diag_cs%missing_value - else - locfield(i,j) = field(i,j) * diag%conversion_factor - endif + locfield(i,j) = field(i,j) * diag%conversion_factor enddo ; enddo - locfield(isv:iev,jsv:jev) = field(isv:iev,jsv:jev) * diag%conversion_factor else locfield => field endif @@ -1829,11 +1820,7 @@ subroutine post_data_3d_low(diag, field, diag_cs, is_static, mask) endif do k=ks,ke ; do j=jsv,jev ; do i=isv,iev - if (field(i,j,k) == diag_cs%missing_value) then - locfield(i,j,k) = diag_cs%missing_value - else - locfield(i,j,k) = field(i,j,k) * diag%conversion_factor - endif + locfield(i,j,k) = field(i,j,k) * diag%conversion_factor enddo ; enddo ; enddo else locfield => field From 2e8793fa759cc6fdf04097c5e5c6d24e8f266bf2 Mon Sep 17 00:00:00 2001 From: alex-huth Date: Thu, 8 Jan 2026 15:23:20 -0500 Subject: [PATCH 45/64] Remove ice-sheet melting/freezing contribution to fluxes%latent because it is already accounted for in fluxes%sens --- src/ice_shelf/MOM_ice_shelf.F90 | 2 -- 1 file changed, 2 deletions(-) diff --git a/src/ice_shelf/MOM_ice_shelf.F90 b/src/ice_shelf/MOM_ice_shelf.F90 index 689feeb01b..dde79f8855 100644 --- a/src/ice_shelf/MOM_ice_shelf.F90 +++ b/src/ice_shelf/MOM_ice_shelf.F90 @@ -1342,8 +1342,6 @@ subroutine add_shelf_flux(G, US, CS, sfc_state, fluxes, time_step) ! The salt flux should be mostly from sea ice, so perhaps none should be intercepted and this should be changed. if (associated(fluxes%salt_flux)) & fluxes%salt_flux(i,j) = frac_shelf * ISS%salt_flux(i,j)*CS%flux_factor + frac_open * fluxes%salt_flux(i,j) - if (associated(fluxes%latent)) & - fluxes%latent(i,j) = fluxes%latent(i,j) - frac_shelf * ISS%water_flux(i,j) * CS%Lat_Fusion endif ; enddo ; enddo if (CS%debug) then From 8f92390357c3d38d011c745cbf1dca9aa4d8e4e3 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sat, 17 Jan 2026 14:53:08 -0500 Subject: [PATCH 46/64] +Add G%IdxCu_OBCmask and G%IdyCv_OBCmask Added the new elements `IdxCu_OBCmask` and `IdyCv_OBCmask` to the `ocean_grid_type` and `dyn_horgrid_type` to facilitate the application of no-gradient open boundary conditions at faces with essentially no added overhead. These new arrays are set initially in `set_derived_metrics()` and `set_derived_dyn_horgrid()`, but may be reset in `initialize_masks()` and `open_boundary_impose_land_mask()`. All answers are bitwise identical but there are a pair of new 2-d arrays in two transparent grid types. --- src/core/MOM_grid.F90 | 8 ++++++++ src/core/MOM_open_boundary.F90 | 12 ++++++------ src/framework/MOM_dyn_horgrid.F90 | 7 +++++++ src/initialization/MOM_grid_initialize.F90 | 2 ++ 4 files changed, 23 insertions(+), 6 deletions(-) diff --git a/src/core/MOM_grid.F90 b/src/core/MOM_grid.F90 index 4e8c1a9cc2..d5d319dc47 100644 --- a/src/core/MOM_grid.F90 +++ b/src/core/MOM_grid.F90 @@ -95,6 +95,7 @@ module MOM_grid geoLonCu, & !< The geographic longitude at u points [degrees_E] or [km] or [m]. dxCu, & !< dxCu is delta x at u points [L ~> m]. IdxCu, & !< 1/dxCu [L-1 ~> m-1]. + IdxCu_OBCmask, & !< 1/dxCu or 0 at boundary or OBC points [L-1 ~> m-1]. dyCu, & !< dyCu is delta y at u points [L ~> m]. IdyCu, & !< 1/dyCu [L-1 ~> m-1]. dy_Cu, & !< The unblocked lengths of the u-faces of the h-cell [L ~> m]. @@ -110,6 +111,7 @@ module MOM_grid IdxCv, & !< 1/dxCv [L-1 ~> m-1]. dyCv, & !< dyCv is delta y at v points [L ~> m]. IdyCv, & !< 1/dyCv [L-1 ~> m-1]. + IdyCv_OBCmask, & !< 1/dxCv or 0 at boundary or OBC points [L-1 ~> m-1]. dx_Cv, & !< The unblocked lengths of the v-faces of the h-cell [L ~> m]. IareaCv, & !< The masked inverse areas of v-grid cells [L-2 ~> m-2]. areaCv !< The areas of the v-grid cells [L2 ~> m2]. @@ -442,6 +444,7 @@ subroutine set_derived_metrics(G, US) if (G%dyCu(I,j) < 0.0) G%dyCu(I,j) = 0.0 G%IdxCu(I,j) = Adcroft_reciprocal(G%dxCu(I,j)) G%IdyCu(I,j) = Adcroft_reciprocal(G%dyCu(I,j)) + G%IdxCu_OBCmask(I,j) = G%OBCmaskCu(I,j) * G%IdxCu(I,j) ! This may be reset if masks are reset. enddo ; enddo do J=JsdB,JedB ; do i=isd,ied @@ -449,6 +452,7 @@ subroutine set_derived_metrics(G, US) if (G%dyCv(i,J) < 0.0) G%dyCv(i,J) = 0.0 G%IdxCv(i,J) = Adcroft_reciprocal(G%dxCv(i,J)) G%IdyCv(i,J) = Adcroft_reciprocal(G%dyCv(i,J)) + G%IdyCv_OBCmask(i,J) = G%OBCmaskCv(i,J) * G%IdyCv(i,J) ! This may be reset if masks are reset. enddo ; enddo do J=JsdB,JedB ; do I=IsdB,IedB @@ -544,6 +548,7 @@ subroutine allocate_metrics(G) ALLOC_(G%dxBu(IsdB:IedB,JsdB:JedB)) ; G%dxBu(:,:) = 0.0 ALLOC_(G%IdxT(isd:ied,jsd:jed)) ; G%IdxT(:,:) = 0.0 ALLOC_(G%IdxCu(IsdB:IedB,jsd:jed)) ; G%IdxCu(:,:) = 0.0 + ALLOC_(G%IdxCu_OBCmask(IsdB:IedB,jsd:jed)) ; G%IdxCu_OBCmask(:,:) = 0.0 ALLOC_(G%IdxCv(isd:ied,JsdB:JedB)) ; G%IdxCv(:,:) = 0.0 ALLOC_(G%IdxBu(IsdB:IedB,JsdB:JedB)) ; G%IdxBu(:,:) = 0.0 @@ -554,6 +559,7 @@ subroutine allocate_metrics(G) ALLOC_(G%IdyT(isd:ied,jsd:jed)) ; G%IdyT(:,:) = 0.0 ALLOC_(G%IdyCu(IsdB:IedB,jsd:jed)) ; G%IdyCu(:,:) = 0.0 ALLOC_(G%IdyCv(isd:ied,JsdB:JedB)) ; G%IdyCv(:,:) = 0.0 + ALLOC_(G%IdyCv_OBCmask(isd:ied,JsdB:JedB)) ; G%IdyCv_OBCmask(:,:) = 0.0 ALLOC_(G%IdyBu(IsdB:IedB,JsdB:JedB)) ; G%IdyBu(:,:) = 0.0 ALLOC_(G%areaT(isd:ied,jsd:jed)) ; G%areaT(:,:) = 0.0 @@ -626,6 +632,8 @@ subroutine MOM_grid_end(G) DEALLOC_(G%dyT) ; DEALLOC_(G%dyCu) ; DEALLOC_(G%dyCv) ; DEALLOC_(G%dyBu) DEALLOC_(G%IdyT) ; DEALLOC_(G%IdyCu) ; DEALLOC_(G%IdyCv) ; DEALLOC_(G%IdyBu) + DEALLOC_(G%IdxCu_OBCmask) ; DEALLOC_(G%IdyCv_OBCmask) + DEALLOC_(G%areaT) ; DEALLOC_(G%IareaT) DEALLOC_(G%areaBu) ; DEALLOC_(G%IareaBu) DEALLOC_(G%areaCu) ; DEALLOC_(G%IareaCu) diff --git a/src/core/MOM_open_boundary.F90 b/src/core/MOM_open_boundary.F90 index 2ebbce6475..ebc054a7c6 100644 --- a/src/core/MOM_open_boundary.F90 +++ b/src/core/MOM_open_boundary.F90 @@ -2264,9 +2264,9 @@ subroutine open_boundary_impose_land_mask(OBC, G, areaCu, areaCv, US) enddo do J=segment%HI%JsdB+1,segment%HI%JedB-1 if (segment%direction == OBC_DIRECTION_W) then - G%mask2dCv(i,J) = 0 ; G%OBCmaskCv(i,J) = 0.0 + G%mask2dCv(i,J) = 0 ; G%OBCmaskCv(i,J) = 0.0 ; G%IdyCv_OBCmask(i,J) = 0.0 else - G%mask2dCv(i+1,J) = 0.0 ; G%OBCmaskCv(i+1,J) = 0.0 + G%mask2dCv(i+1,J) = 0.0 ; G%OBCmaskCv(i+1,J) = 0.0 ; G%IdyCv_OBCmask(i+1,J) = 0.0 endif enddo else @@ -2282,9 +2282,9 @@ subroutine open_boundary_impose_land_mask(OBC, G, areaCu, areaCv, US) enddo do I=segment%HI%IsdB+1,segment%HI%IedB-1 if (segment%direction == OBC_DIRECTION_S) then - G%mask2dCu(I,j) = 0.0 ; G%OBCmaskCu(I,j) = 0.0 + G%mask2dCu(I,j) = 0.0 ; G%OBCmaskCu(I,j) = 0.0 ; G%IdxCu_OBCmask(I,j) = 0.0 else - G%mask2dCu(I,j+1) = 0.0 ; G%OBCmaskCu(I,j+1) = 0.0 + G%mask2dCu(I,j+1) = 0.0 ; G%OBCmaskCu(I,j+1) = 0.0 ; G%IdxCu_OBCmask(I,j+1) = 0.0 endif enddo endif @@ -2298,12 +2298,12 @@ subroutine open_boundary_impose_land_mask(OBC, G, areaCu, areaCv, US) if (segment%is_E_or_W) then I=segment%HI%IsdB do j=segment%HI%jsd,segment%HI%jed - G%OBCmaskCu(I,j) = 0.0 + G%OBCmaskCu(I,j) = 0.0 ; G%IdxCu_OBCmask(I,j) = 0.0 enddo else J=segment%HI%JsdB do i=segment%HI%isd,segment%HI%ied - G%OBCmaskCv(i,J) = 0.0 + G%OBCmaskCv(i,J) = 0.0 ; G%IdyCv_OBCmask(i,J) = 0.0 enddo endif enddo diff --git a/src/framework/MOM_dyn_horgrid.F90 b/src/framework/MOM_dyn_horgrid.F90 index e5c6c1dab5..b599031e78 100644 --- a/src/framework/MOM_dyn_horgrid.F90 +++ b/src/framework/MOM_dyn_horgrid.F90 @@ -92,6 +92,7 @@ module MOM_dyn_horgrid geoLonCu, & !< The geographic longitude at u points [degrees of longitude] or [m]. dxCu, & !< dxCu is delta x at u points [L ~> m]. IdxCu, & !< 1/dxCu [L-1 ~> m-1]. + IdxCu_OBCmask, & !< 1/dxCu or 0 at boundary or OBC points [L-1 ~> m-1]. dyCu, & !< dyCu is delta y at u points [L ~> m]. IdyCu, & !< 1/dyCu [L-1 ~> m-1]. dy_Cu, & !< The unblocked lengths of the u-faces of the h-cell [L ~> m]. @@ -107,6 +108,7 @@ module MOM_dyn_horgrid IdxCv, & !< 1/dxCv [L-1 ~> m-1]. dyCv, & !< dyCv is delta y at v points [L ~> m]. IdyCv, & !< 1/dyCv [L-1 ~> m-1]. + IdyCv_OBCmask, & !< 1/dxCv or 0 at boundary or OBC points [L-1 ~> m-1]. dx_Cv, & !< The unblocked lengths of the v-faces of the h-cell [L ~> m]. IareaCv, & !< The masked inverse areas of v-grid cells [L-2 ~> m-2]. areaCv !< The areas of the v-grid cells [L2 ~> m2]. @@ -251,6 +253,7 @@ subroutine create_dyn_horgrid(G, HI, bathymetry_at_vel) allocate(G%dxBu(IsdB:IedB,JsdB:JedB), source=0.0) allocate(G%IdxT(isd:ied,jsd:jed), source=0.0) allocate(G%IdxCu(IsdB:IedB,jsd:jed), source=0.0) + allocate(G%IdxCu_OBCmask(IsdB:IedB,jsd:jed), source=0.0) allocate(G%IdxCv(isd:ied,JsdB:JedB), source=0.0) allocate(G%IdxBu(IsdB:IedB,JsdB:JedB), source=0.0) @@ -261,6 +264,7 @@ subroutine create_dyn_horgrid(G, HI, bathymetry_at_vel) allocate(G%IdyT(isd:ied,jsd:jed), source=0.0) allocate(G%IdyCu(IsdB:IedB,jsd:jed), source=0.0) allocate(G%IdyCv(isd:ied,JsdB:JedB), source=0.0) + allocate(G%IdyCv_OBCmask(isd:ied,JsdB:JedB), source=0.0) allocate(G%IdyBu(IsdB:IedB,JsdB:JedB), source=0.0) allocate(G%areaT(isd:ied,jsd:jed), source=0.0) @@ -482,6 +486,7 @@ subroutine set_derived_dyn_horgrid(G, US) if (G%dyCu(I,j) < 0.0) G%dyCu(I,j) = 0.0 G%IdxCu(I,j) = Adcroft_reciprocal(G%dxCu(I,j)) G%IdyCu(I,j) = Adcroft_reciprocal(G%dyCu(I,j)) + G%IdxCu_OBCmask(I,j) = G%OBCmaskCu(I,j) * G%IdxCu(I,j) ! This may be reset when the masks are set. enddo ; enddo do J=JsdB,JedB ; do i=isd,ied @@ -489,6 +494,7 @@ subroutine set_derived_dyn_horgrid(G, US) if (G%dyCv(i,J) < 0.0) G%dyCv(i,J) = 0.0 G%IdxCv(i,J) = Adcroft_reciprocal(G%dxCv(i,J)) G%IdyCv(i,J) = Adcroft_reciprocal(G%dyCv(i,J)) + G%IdyCv_OBCmask(i,J) = G%OBCmaskCv(i,J) * G%IdyCv(i,J) ! This may be reset when the masks are set. enddo ; enddo do J=JsdB,JedB ; do I=IsdB,IedB @@ -534,6 +540,7 @@ subroutine destroy_dyn_horgrid(G) deallocate(G%mask2dT) ; deallocate(G%mask2dCu) ; deallocate(G%OBCmaskCu) deallocate(G%mask2dCv) ; deallocate(G%OBCmaskCv) ; deallocate(G%mask2dBu) + deallocate(G%IdxCu_OBCmask) ; deallocate(G%IdyCv_OBCmask) deallocate(G%geoLatT) ; deallocate(G%geoLatCu) deallocate(G%geoLatCv) ; deallocate(G%geoLatBu) diff --git a/src/initialization/MOM_grid_initialize.F90 b/src/initialization/MOM_grid_initialize.F90 index ba47206795..4408783db4 100644 --- a/src/initialization/MOM_grid_initialize.F90 +++ b/src/initialization/MOM_grid_initialize.F90 @@ -1332,6 +1332,7 @@ subroutine initialize_masks(G, PF, US, OBC_dir_u, OBC_dir_v, open_corner_OBCs) do j=G%jsd,G%jed ; do I=G%IsdB,G%IedB ! This open face length may be revised later. G%dy_Cu(I,j) = G%mask2dCu(I,j) * G%dyCu(I,j) + G%IdxCu_OBCmask(I,j) = G%OBCmaskCu(I,j) * G%IdxCu(I,j) G%areaCu(I,j) = G%dxCu(I,j) * G%dy_Cu(I,j) G%IareaCu(I,j) = G%mask2dCu(I,j) * Adcroft_reciprocal(G%areaCu(I,j)) enddo ; enddo @@ -1339,6 +1340,7 @@ subroutine initialize_masks(G, PF, US, OBC_dir_u, OBC_dir_v, open_corner_OBCs) do J=G%JsdB,G%JedB ; do i=G%isd,G%ied ! This open face length may be revised later. G%dx_Cv(i,J) = G%mask2dCv(i,J) * G%dxCv(i,J) + G%IdyCv_OBCmask(i,J) = G%OBCmaskCv(i,J) * G%IdyCv(i,J) G%areaCv(i,J) = G%dyCv(i,J) * G%dx_Cv(i,J) G%IareaCv(i,J) = G%mask2dCv(i,J) * Adcroft_reciprocal(G%areaCv(i,J)) enddo ; enddo From 99c32b769edffd23682d02e5a51f19a89dd72078 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sun, 18 Jan 2026 18:42:17 -0500 Subject: [PATCH 47/64] Use G%IdxCu_OBCmask in 7 places Modified the code to use `G%IdxCu_OBCmask` and `G%IdyCv_OBCmask` in 7 places each in 6 modules. They are used instead of `G%OBCmaskCu*G%IdxCu` and `G%OBCmaskCv*G%IdyCv`, to which they are equivalent. This change should slightly speed up the model, and as expected all answers are bitwise identical. --- src/core/MOM_barotropic.F90 | 4 ++-- src/core/MOM_open_boundary.F90 | 2 +- src/parameterizations/lateral/MOM_MEKE.F90 | 4 ++-- .../lateral/MOM_interface_filter.F90 | 4 ++-- .../lateral/MOM_mixed_layer_restrat.F90 | 12 ++++++------ .../lateral/MOM_thickness_diffuse.F90 | 4 ++-- 6 files changed, 15 insertions(+), 15 deletions(-) diff --git a/src/core/MOM_barotropic.F90 b/src/core/MOM_barotropic.F90 index 156ab6234c..3d4e5a3e65 100644 --- a/src/core/MOM_barotropic.F90 +++ b/src/core/MOM_barotropic.F90 @@ -6039,10 +6039,10 @@ subroutine barotropic_init(u, v, h, Time, G, GV, US, param_file, diag, CS, & ! This sets pressure force diagnostics on land, at coastlines and at OBC points to zero. if (mask_coastal_pressure_force) then do j=G%jsd,G%jed ; do I=G%IsdB,G%IedB - CS%IdxCu(I,j) = G%OBCmaskCu(I,j) * G%IdxCu(I,j) + CS%IdxCu(I,j) = G%IdxCu_OBCmask(I,j) enddo ; enddo do J=G%JsdB,G%JedB ; do i=G%isd,G%ied - CS%IdyCv(i,J) = G%OBCmaskCv(i,J) * G%IdyCv(i,J) + CS%IdyCv(i,J) = G%IdyCv_OBCmask(i,J) enddo ; enddo endif diff --git a/src/core/MOM_open_boundary.F90 b/src/core/MOM_open_boundary.F90 index ebc054a7c6..eb9f8c6c13 100644 --- a/src/core/MOM_open_boundary.F90 +++ b/src/core/MOM_open_boundary.F90 @@ -2576,7 +2576,7 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, GV, US, type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure type(ocean_OBC_type), pointer :: OBC !< Open boundary control structure real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), intent(inout) :: u_new !< On exit, new u values on open boundaries - !! On entry, the old time-level v but including + !! On entry, the old time-level u but including !! barotropic accelerations [L T-1 ~> m s-1]. real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), intent(in) :: u_old !< Original unadjusted u [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), intent(inout) :: v_new !< On exit, new v values on open boundaries. diff --git a/src/parameterizations/lateral/MOM_MEKE.F90 b/src/parameterizations/lateral/MOM_MEKE.F90 index 5f3ad1e19d..a16c9ef32a 100644 --- a/src/parameterizations/lateral/MOM_MEKE.F90 +++ b/src/parameterizations/lateral/MOM_MEKE.F90 @@ -617,7 +617,7 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h !$OMP parallel do default(shared) do j=js-1,je+1 ; do I=is-2,ie+1 ! MEKE_uflux is used here as workspace with units of [L2 T-2 ~> m2 s-2]. - MEKE_uflux(I,j) = ((G%dy_Cu(I,j)*G%IdxCu(I,j)) * G%OBCmaskCu(I,j)) * & + MEKE_uflux(I,j) = (G%dy_Cu(I,j)*G%IdxCu_OBCmask(I,j)) * & (MEKE%MEKE(i+1,j) - MEKE%MEKE(i,j)) ! This would have units of [R Z L2 T-2 ~> kg s-2] ! MEKE_uflux(I,j) = ((G%dy_Cu(I,j)*G%IdxCu(I,j)) * & @@ -627,7 +627,7 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h !$OMP parallel do default(shared) do J=js-2,je+1 ; do i=is-1,ie+1 ! MEKE_vflux is used here as workspace with units of [L2 T-2 ~> m2 s-2]. - MEKE_vflux(i,J) = ((G%dx_Cv(i,J)*G%IdyCv(i,J)) * G%OBCmaskCv(i,J)) * & + MEKE_vflux(i,J) = (G%dx_Cv(i,J)*G%IdyCv_OBCmask(i,J)) * & (MEKE%MEKE(i,j+1) - MEKE%MEKE(i,j)) ! This would have units of [R Z L2 T-2 ~> kg s-2] ! MEKE_vflux(i,J) = ((G%dx_Cv(i,J)*G%IdyCv(i,J)) * & diff --git a/src/parameterizations/lateral/MOM_interface_filter.F90 b/src/parameterizations/lateral/MOM_interface_filter.F90 index 12bda8c020..d66341acf5 100644 --- a/src/parameterizations/lateral/MOM_interface_filter.F90 +++ b/src/parameterizations/lateral/MOM_interface_filter.F90 @@ -296,7 +296,7 @@ subroutine filter_interface(h, e, Lsm2_u, Lsm2_v, uhD, vhD, tv, G, GV, US, halo_ do I=is-1,ie ; uhtot(I,j) = 0.0 ; enddo do K=nz,2,-1 do I=is-1,ie - Slope = ((e(i,j,K)-e(i+1,j,K))*G%IdxCu(I,j)) * G%OBCmaskCu(I,j) + Slope = (e(i,j,K)-e(i+1,j,K)) * G%IdxCu_OBCmask(I,j) if (allocated(tv%SpV_avg)) then ! This is the fully non-Boussinesq version. @@ -336,7 +336,7 @@ subroutine filter_interface(h, e, Lsm2_u, Lsm2_v, uhD, vhD, tv, G, GV, US, halo_ do i=is,ie ; vhtot(i,J) = 0.0 ; enddo do K=nz,2,-1 do i=is,ie - Slope = ((e(i,j,K)-e(i,j+1,K))*G%IdyCv(i,J)) * G%OBCmaskCv(i,J) + Slope = (e(i,j,K)-e(i,j+1,K)) * G%IdyCv_OBCmask(i,J) if (allocated(tv%SpV_avg)) then ! This is the fully non-Boussinesq version. diff --git a/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 b/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 index 52b126de4f..e03ad39296 100644 --- a/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 +++ b/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 @@ -510,7 +510,7 @@ subroutine mixedlayer_restrat_OM4(h, uhtr, vhtr, tv, forces, dt, h_MLD, VarMix, timescale = timescale * CS%ml_restrat_coef if (res_upscale) timescale = timescale * res_scaling_fac - uDml(I) = timescale * G%OBCmaskCu(I,j)*G%dyCu(I,j)*G%IdxCu(I,j) * & + uDml(I) = timescale * G%dyCu(I,j)*G%IdxCu_OBCmask(I,j) * & (Rml_av_fast(i+1,j)-Rml_av_fast(i,j)) * (h_vel**2) ! As above but using the slow filtered MLD @@ -525,7 +525,7 @@ subroutine mixedlayer_restrat_OM4(h, uhtr, vhtr, tv, forces, dt, h_MLD, VarMix, timescale = timescale * CS%ml_restrat_coef2 if (res_upscale) timescale = timescale * res_scaling_fac - uDml_slow(I) = timescale * G%OBCmaskCu(I,j)*G%dyCu(I,j)*G%IdxCu(I,j) * & + uDml_slow(I) = timescale * G%dyCu(I,j)*G%IdxCu_OBCmask(I,j) * & (Rml_av_slow(i+1,j)-Rml_av_slow(i,j)) * (h_vel**2) if (uDml(I) + uDml_slow(I) == 0.) then @@ -600,7 +600,7 @@ subroutine mixedlayer_restrat_OM4(h, uhtr, vhtr, tv, forces, dt, h_MLD, VarMix, timescale = timescale * CS%ml_restrat_coef if (res_upscale) timescale = timescale * res_scaling_fac - vDml(i) = timescale * G%OBCmaskCv(i,J)*G%dxCv(i,J)*G%IdyCv(i,J) * & + vDml(i) = timescale * G%dxCv(i,J)*G%IdyCv_OBCmask(i,J) * & (Rml_av_fast(i,j+1)-Rml_av_fast(i,j)) * (h_vel**2) ! As above but using the slow filtered MLD @@ -615,7 +615,7 @@ subroutine mixedlayer_restrat_OM4(h, uhtr, vhtr, tv, forces, dt, h_MLD, VarMix, timescale = timescale * CS%ml_restrat_coef2 if (res_upscale) timescale = timescale * res_scaling_fac - vDml_slow(i) = timescale * G%OBCmaskCv(i,J)*G%dxCv(i,J)*G%IdyCv(i,J) * & + vDml_slow(i) = timescale * G%dxCv(i,J)*G%IdyCv_OBCmask(i,J) * & (Rml_av_slow(i,j+1)-Rml_av_slow(i,j)) * (h_vel**2) if (vDml(i) + vDml_slow(i) == 0.) then @@ -1383,7 +1383,7 @@ subroutine mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, dt, G, GV, US, CS) timescale = timescale * CS%ml_restrat_coef ! timescale = timescale*(2?)*(L_def/L_MLI) * min(EKE/MKE,1.0 + (G%dyCv(i,j)/L_def)**2) - uDml(I) = timescale * G%OBCmaskCu(I,j)*G%dyCu(I,j)*G%IdxCu(I,j) * & + uDml(I) = timescale * G%dyCu(I,j)*G%IdxCu_OBCmask(I,j) * & (Rml_av(i+1,j)-Rml_av(i,j)) * (h_vel**2) if (uDml(I) == 0) then @@ -1434,7 +1434,7 @@ subroutine mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, dt, G, GV, US, CS) timescale = timescale * CS%ml_restrat_coef ! timescale = timescale*(2?)*(L_def/L_MLI) * min(EKE/MKE,1.0 + (G%dyCv(i,j)/L_def)**2) - vDml(i) = timescale * G%OBCmaskCv(i,J)*G%dxCv(i,J)*G%IdyCv(i,J) * & + vDml(i) = timescale * G%dxCv(i,J)*G%IdyCv_OBCmask(i,J) * & (Rml_av(i,j+1)-Rml_av(i,j)) * (h_vel**2) if (vDml(i) == 0) then do k=1,nkml ; vhml(i,J,k) = 0.0 ; enddo diff --git a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 index 1bfa3d340b..acd13d3492 100644 --- a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 +++ b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 @@ -1086,7 +1086,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV if (present_slope_x) then Slope = slope_x(I,j,k) else - Slope = ((e(i+1,j,K)-e(i,j,K))*G%IdxCu(I,j)) * G%OBCmaskCu(I,j) + Slope = (e(i+1,j,K)-e(i,j,K)) * G%IdxCu_OBCmask(I,j) endif if (CS%id_slope_x > 0) CS%diagSlopeX(I,j,k) = Slope Sfn_unlim_u(I,K) = -(KH_u(I,j,K)*G%dy_Cu(I,j))*Slope @@ -1406,7 +1406,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV if (present_slope_y) then Slope = slope_y(i,J,k) else - Slope = ((e(i,j+1,K)-e(i,j,K))*G%IdyCv(i,J)) * G%OBCmaskCv(i,J) + Slope = (e(i,j+1,K)-e(i,j,K)) * G%IdyCv_OBCmask(i,J) endif if (CS%id_slope_y > 0) CS%diagSlopeY(I,j,k) = Slope Sfn_unlim_v(i,K) = -((KH_v(i,J,K)*G%dx_Cv(i,J))*Slope) From 5801592b4ba8f8dede8069a4fbbdb93df2ebece9 Mon Sep 17 00:00:00 2001 From: Brandon Reichl Date: Sun, 1 Feb 2026 18:11:07 -0500 Subject: [PATCH 48/64] Add option to scale tidal amplitude for bottom ustar. (#1016) * Add option to scale tidal amplitude for bottom ustar. - previously we used the tidal amplitude to compute ustar. - The additional factor translates between amplitude and time mean tidal current. - Setting the factor TIDEAMP_FACTOR<0 preserves old answers. * Update tideamp factor implementation for efficiency - factor out the negative "default" value to automatically set to multiply by 1.0 instead of using an if-block. - factor in the c-grid averaging 0.5 to further reduce extra operations, but clearly label the parameter to reflect this. --------- Co-authored-by: brandon.reichl --- .../vertical/MOM_set_viscosity.F90 | 22 +++++++++++++++++-- 1 file changed, 20 insertions(+), 2 deletions(-) diff --git a/src/parameterizations/vertical/MOM_set_viscosity.F90 b/src/parameterizations/vertical/MOM_set_viscosity.F90 index 9d0261f5cc..6b873a99fd 100644 --- a/src/parameterizations/vertical/MOM_set_viscosity.F90 +++ b/src/parameterizations/vertical/MOM_set_viscosity.F90 @@ -111,6 +111,10 @@ module MOM_set_visc real :: omega_frac !< When setting the decay scale for turbulence, use this !! fraction of the absolute rotation rate blended with the local !! value of f, as sqrt((1-of)*f^2 + of*4*omega^2) [nondim] + real :: tideampfac2 !< A factor to multiply by tideamp to convert to a mean ustar, + !! accounts for conversion of amplitude to mean magnitude over + !! a time average much longer than the tidal periods and for + !! non-commuting conversion of mean tideamp to mean ustar**3 [nondim] logical :: concave_trigonometric_L !< If true, use trigonometric expressions to determine the !! fractional open interface lengths for concave topography. integer :: answer_date !< The vintage of the order of arithmetic and expressions in the set @@ -315,6 +319,7 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, pbv) real :: h_bbl_fr ! The fraction of the bottom boundary layer in a layer [nondim]. real :: h_sum ! The sum of the thicknesses of the layers below the one being ! worked on [H ~> m or kg m-2]. + real :: tideampfac2_x_0p5 ! tideampfac2 multiplied by the c-grid averaging factor of 0.5 real, parameter :: C1_3 = 1.0/3.0, C1_6 = 1.0/6.0, C1_12 = 1.0/12.0 ! Rational constants [nondim] real :: tmp ! A temporary variable, sometimes in [Z ~> m] logical :: use_BBL_EOS, do_i(SZIB_(G)) @@ -330,6 +335,7 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, pbv) dz_neglect = GV%dZ_subroundoff Rho0x400_G = 400.0*(GV%H_to_RZ / GV%g_Earth_Z_T2) + tideampfac2_x_0p5 = CS%tideampfac2*0.5 if (.not.CS%initialized) call MOM_error(FATAL,"MOM_set_viscosity(BBL): "//& "Module must be initialized before it is used.") @@ -624,10 +630,10 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, pbv) ! Set the "back ground" friction velocity scale to either the tidal amplitude or place-holder constant if (CS%BBL_use_tidal_bg) then do i=is,ie ; if (do_i(i)) then ; if (m==1) then - u2_bg(I) = 0.5*( G%mask2dT(i,j)*(CS%tideamp(i,j)*CS%tideamp(i,j))+ & + u2_bg(I) = tideampfac2_x_0p5 * ( G%mask2dT(i,j)*(CS%tideamp(i,j)*CS%tideamp(i,j))+ & G%mask2dT(i+1,j)*(CS%tideamp(i+1,j)*CS%tideamp(i+1,j)) ) else - u2_bg(i) = 0.5*( G%mask2dT(i,j)*(CS%tideamp(i,j)*CS%tideamp(i,j))+ & + u2_bg(i) = tideampfac2_x_0p5 * ( G%mask2dT(i,j)*(CS%tideamp(i,j)*CS%tideamp(i,j))+ & G%mask2dT(i,j+1)*(CS%tideamp(i,j+1)*CS%tideamp(i,j+1)) ) endif ; endif ; enddo else @@ -2955,6 +2961,7 @@ subroutine set_visc_init(Time, G, GV, US, param_file, diag, visc, CS, restart_CS ! is used in place of the absolute value of the local Coriolis ! parameter in the denominator of some expressions [nondim] real :: Chan_max_thick_dflt ! The default value for CHANNEL_DRAG_MAX_THICK [Z ~> m] + real :: tideamp_factor ! A factor to multiply by tideamp when converting to mean tidal magnitude [nondim] real :: shelfbreak_depth ! When CHANNEL_DRAG is true, the bathymetric depth interpolated ! to the vorticity point is a combination of the harmonic mean of the ! adjacent velocity point depths below this depth [Z ~> m] and the @@ -3125,6 +3132,17 @@ subroutine set_visc_init(Time, G, GV, US, param_file, diag, visc, CS, restart_CS ! nor dimensional testing in this mode. If we ever detect a dimensional sensitivity to ! this parameter, in this mode, then it means it is being used inappropriately. CS%drag_bg_vel = 1.e30 + call get_param(param_file, mdl, "TIDEAMP_FACTOR", tideamp_factor, & + "A parameter to multiply by tideamp when converting to ustar. "//& + "It accounts for converting the amplitude to a mean magintude (approx 1/sqrt(2)) "//& + "and possibly also for non-commuting averaging operators when converting to ustar**3. "//& + "It is ignored if negative and uncapped so it can be greater than 1 if desired.",& + units="nondim", default=-1.0) + if (tideamp_factor < 0.0) then + CS%tideampfac2 = 1.0 + else + CS%tideampfac2 = tideamp_factor*tideamp_factor + endif else call get_param(param_file, mdl, "DRAG_BG_VEL", CS%drag_bg_vel, & "DRAG_BG_VEL is either the assumed bottom velocity (with "//& From ac64aaa92e06037cf24c54731a0237ca7311d9f7 Mon Sep 17 00:00:00 2001 From: Aakash Sane Date: Mon, 2 Feb 2026 09:46:34 -0500 Subject: [PATCH 49/64] Add vertical tracer flux diagnostic for dye tracers (#1022) * Add vertical tracer flux diagnostic for dye tracers - Register vertical flux diagnostic in initialize_dye_tracer - Calculate net vertical flux from entrainment (positive upward) - Post flux diagnostic in dye_tracer_column_physics * changed diagnostic registration to be at interface, made sure boundary fluxes are zero * changed lines 338 and 354 as needed. Fixed accidental space on Line 1. --- src/tracer/MOM_tracer_flow_control.F90 | 2 +- src/tracer/dye_example.F90 | 47 ++++++++++++++++++++++++-- 2 files changed, 46 insertions(+), 3 deletions(-) diff --git a/src/tracer/MOM_tracer_flow_control.F90 b/src/tracer/MOM_tracer_flow_control.F90 index 2fce6325ad..efad2c4dcf 100644 --- a/src/tracer/MOM_tracer_flow_control.F90 +++ b/src/tracer/MOM_tracer_flow_control.F90 @@ -345,7 +345,7 @@ subroutine tracer_flow_control_init(restart, day, G, GV, US, h, param_file, diag call initialize_MARBL_tracers(restart, day, G, GV, US, h, param_file, diag, OBC, CS%MARBL_tracers_CSp, & sponge_CSp) if (CS%use_regional_dyes) & - call initialize_dye_tracer(restart, day, G, GV, h, diag, OBC, CS%dye_tracer_CSp, sponge_CSp, tv) + call initialize_dye_tracer(restart, day, G, GV, US, h, diag, OBC, CS%dye_tracer_CSp, sponge_CSp, tv) if (CS%use_oil) & call initialize_oil_tracer(restart, day, G, GV, US, h, diag, OBC, CS%oil_tracer_CSp, sponge_CSp) if (CS%use_advection_test_tracer) & diff --git a/src/tracer/dye_example.F90 b/src/tracer/dye_example.F90 index c1146e19f9..bbd37ad26e 100644 --- a/src/tracer/dye_example.F90 +++ b/src/tracer/dye_example.F90 @@ -5,7 +5,7 @@ module regional_dyes use MOM_coms, only : EFP_type use MOM_coupler_types, only : set_coupler_type_data, atmos_ocn_coupler_flux -use MOM_diag_mediator, only : diag_ctrl +use MOM_diag_mediator, only : diag_ctrl, post_data, register_diag_field use MOM_error_handler, only : MOM_error, FATAL, WARNING use MOM_file_parser, only : get_param, log_param, log_version, param_file_type use MOM_forcing_type, only : forcing @@ -59,6 +59,8 @@ module regional_dyes integer, allocatable, dimension(:) :: ind_tr !< Indices returned by atmos_ocn_coupler_flux if it is used and the !! surface tracer concentrations are to be provided to the coupler. + integer, allocatable, dimension(:) :: id_tr_dia_diff !< Diagnostic IDs for vertical tracer fluxes (positive up) + type(diag_ctrl), pointer :: diag => NULL() !< A structure that is used to !! regulate the timing of diagnostic output. type(MOM_restart_CS), pointer :: restart_CSp => NULL() !< A pointer to the restart control structure @@ -116,6 +118,8 @@ function register_dye_tracer(HI, GV, US, param_file, CS, tr_Reg, restart_CS) CS%dye_source_maxdepth(CS%ntr)) allocate(CS%ind_tr(CS%ntr)) allocate(CS%tr_desc(CS%ntr)) + allocate(CS%id_tr_dia_diff(CS%ntr)) + CS%id_tr_dia_diff(:) = -1 CS%dye_source_minlon(:) = -1.e30 call get_param(param_file, mdl, "DYE_SOURCE_MINLON", CS%dye_source_minlon, & @@ -204,12 +208,13 @@ end function register_dye_tracer !> This subroutine initializes the CS%ntr tracer fields in tr(:,:,:,:) !! and it sets up the tracer output. -subroutine initialize_dye_tracer(restart, day, G, GV, h, diag, OBC, CS, sponge_CSp, tv) +subroutine initialize_dye_tracer(restart, day, G, GV, US, h, diag, OBC, CS, sponge_CSp, tv) logical, intent(in) :: restart !< .true. if the fields have already been !! read from a restart file. type(time_type), target, intent(in) :: day !< Time of the start of the run. 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),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] type(diag_ctrl), target, intent(in) :: diag !< Structure used to regulate diagnostic output. type(ocean_OBC_type), pointer :: OBC !< This open boundary condition type specifies @@ -222,6 +227,7 @@ subroutine initialize_dye_tracer(restart, day, G, GV, h, diag, OBC, CS, sponge_C type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various thermodynamic variables ! Local variables + character(len=64) :: var_name, longname real :: dz(SZI_(G),SZK_(GV)) ! Height change across layers [Z ~> m] real :: z_bot ! Height of the bottom of the layer relative to the sea surface [Z ~> m] real :: z_center ! Height of the center of the layer relative to the sea surface [Z ~> m] @@ -232,6 +238,14 @@ subroutine initialize_dye_tracer(restart, day, G, GV, h, diag, OBC, CS, sponge_C CS%diag => diag + ! Register vertical flux diagnostic + do m = 1, CS%ntr + write(var_name,'(A,I3.3,A)') "dye",m,"_dia_diff" + write(longname,'(A,I3.3,A)') "Vertical diffusive flux of dye ",m," (positive up)" + CS%id_tr_dia_diff(m) = register_diag_field('ocean_model', trim(var_name), & + diag%axesTi, day, trim(longname), 'conc H s-1', conversion=GV%H_to_MKS*US%s_to_T) + enddo + ! Establish location of source do j=G%jsc,G%jec call thickness_to_dz(h, tv, dz, j, G, GV) @@ -292,9 +306,12 @@ subroutine dye_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, US ! Local variables real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: h_work ! Used so that h can be modified [H ~> m or kg m-2] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1) :: vert_flux ! Vertical tracer flux positive upward + !! [conc H T-1 ~> conc m s-1] real :: dz(SZI_(G),SZK_(GV)) ! Height change across layers [Z ~> m] real :: z_bot ! Height of the bottom of the layer relative to the sea surface [Z ~> m] real :: z_center ! Height of the center of the layer relative to the sea surface [Z ~> m] + real :: Idt ! Inverse of timestep [T-1 ~> s-1] integer :: i, j, k, is, ie, js, je, nz, m is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke @@ -302,6 +319,8 @@ subroutine dye_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, US if (.not.associated(CS)) return if (CS%ntr < 1) return + Idt = 1.0 / dt + if (present(evap_CFL_limit) .and. present(minimum_forcing_depth)) then do m=1,CS%ntr do k=1,nz ; do j=js,je ; do i=is,ie @@ -310,10 +329,34 @@ subroutine dye_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, US call applyTracerBoundaryFluxesInOut(G, GV, CS%tr(:,:,:,m), dt, fluxes, h_work, & evap_CFL_limit, minimum_forcing_depth) call tracer_vertdiff(h_work, ea, eb, dt, CS%tr(:,:,:,m), G, GV) + + ! Calculate net vertical flux from entrainment + ! Net flux = upward component - downward component + ! Upward (from below): eb(k) * tr(k+1), Downward (from above): ea(k+1) * tr(k) + do K=2,nz ; do j=js,je ; do i=is,ie + vert_flux(i,j,K) = (eb(i,j,k-1) * CS%tr(i,j,k,m) - ea(i,j,k) * CS%tr(i,j,k-1,m)) * Idt + enddo ; enddo ; enddo + do j=js,je ; do i=is,ie ; vert_flux(i,j,1) = 0.0 ; vert_flux(i,j,nz+1) = 0.0 ; enddo ; enddo + + ! Post diagnostic + if (CS%id_tr_dia_diff(m) > 0) & + call post_data(CS%id_tr_dia_diff(m), vert_flux, CS%diag) enddo else do m=1,CS%ntr call tracer_vertdiff(h_old, ea, eb, dt, CS%tr(:,:,:,m), G, GV) + + ! Calculate net vertical flux from entrainment + ! Net flux = upward component - downward component + ! Upward (from below): eb(k) * tr(k+1), Downward (from above): ea(k+1) * tr(k) + do K=2,nz ; do j=js,je ; do i=is,ie + vert_flux(i,j,K) = (eb(i,j,k-1) * CS%tr(i,j,k,m) - ea(i,j,k) * CS%tr(i,j,k-1,m)) * Idt + enddo ; enddo ; enddo + do j=js,je ; do i=is,ie ; vert_flux(i,j,1) = 0.0 ; vert_flux(i,j,nz+1) = 0.0 ; enddo ; enddo + + ! Post diagnostic + if (CS%id_tr_dia_diff(m) > 0) & + call post_data(CS%id_tr_dia_diff(m), vert_flux, CS%diag) enddo endif From ff6b3b03306d9459b0b40b7f0bbb014ab4a5941c Mon Sep 17 00:00:00 2001 From: He Wang Date: Thu, 15 Jan 2026 19:05:33 -0500 Subject: [PATCH 50/64] Regroup MOM_initialize_fixed params in param_doc This commit is meant to fix the issue that all parameters in MOM_initialize_fixed after OBC are logged under module MOM_open_boundary in MOM_parameter_doc. By moving log_version call after OBC, parameters from MOM_initialize_fixed are now logged under three "modules" in MOM_parameter_doc: 1. Parameters before OBC are under module MOM_grid_init, which also (incorrectly) includes topography relatd parameters. 2. module MOM_open_boundary 3. Parameters after OBC are under module MOM_initialize_fixed. The change makes sure OBC parameters are well separated from the other parameters. This is a hack rather than a fix. --- .../MOM_fixed_initialization.F90 | 25 ++++++++----------- .../MOM_state_initialization.F90 | 1 - 2 files changed, 11 insertions(+), 15 deletions(-) diff --git a/src/initialization/MOM_fixed_initialization.F90 b/src/initialization/MOM_fixed_initialization.F90 index 78266f2749..4ec9cacd02 100644 --- a/src/initialization/MOM_fixed_initialization.F90 +++ b/src/initialization/MOM_fixed_initialization.F90 @@ -60,7 +60,6 @@ subroutine MOM_initialize_fixed(G, US, OBC, PF) !! to parse for model parameter values. ! Local variables - character(len=200) :: inputdir ! The directory where NetCDF input files are. character(len=200) :: config logical :: OBC_projection_bug, open_corners, enable_bugs logical :: read_porous_file, read_meanSL_file @@ -71,20 +70,15 @@ subroutine MOM_initialize_fixed(G, US, OBC, PF) # include "version_variable.h" call callTree_enter("MOM_initialize_fixed(), MOM_fixed_initialization.F90") - call log_version(PF, mdl, version, "") call get_param(PF, mdl, "DEBUG", debug, default=.false.) - call get_param(PF, mdl, "INPUTDIR", inputdir, & - "The directory in which input files are found.", default=".") - inputdir = slasher(inputdir) - ! Set up the parameters of the physical domain (i.e. the grid), G call set_grid_metrics(G, PF, US) - ! Calculate time mean ocean total thickness + ! Read time mean sea level from file call get_param(PF, mdl, "READ_MEAN_SEA_LEVEL", read_meanSL_file, & - "If true, use a 2D map for time mean sea level, which is used to calculate "// & - "time mean ocean total thickness.", default=.False.) + "If true, use a 2D map for time mean sea level, which is used to calculate "// & + "time mean ocean total thickness.", default=.False.) if (read_meanSL_file) & call set_meanSL_from_file(G%meanSL, G, PF, US) @@ -138,6 +132,9 @@ subroutine MOM_initialize_fixed(G, US, OBC, PF) call qchksum(G%mask2dBu, 'MOM_initialize_fixed: mask2dBu ', G%HI) endif + ! Set up other fixed quantities + ! Parameters below are logged under "module MOM_fixed_initialization". + call log_version(PF, mdl, version, "") ! Modulate geometric scales according to geography. call get_param(PF, mdl, "CHANNEL_CONFIG", config, & "A parameter that determines which set of channels are \n"//& @@ -182,12 +179,12 @@ subroutine MOM_initialize_fixed(G, US, OBC, PF) if (read_porous_file) & call set_subgrid_topo_at_vel_from_file(G, PF, US) -! Calculate the value of the Coriolis parameter at the latitude ! -! of the q grid points [T-1 ~> s-1]. + ! Calculate the value of the Coriolis parameter at the latitude ! + ! of the q grid points [T-1 ~> s-1]. call MOM_initialize_rotation(G%CoriolisBu, G, PF, US=US) -! Calculate the components of grad f (beta) + ! Calculate the components of grad f (beta) call MOM_calculate_grad_Coriolis(G%dF_dx, G%dF_dy, G, US=US) -! Calculate the square of the Coriolis parameter + ! Calculate the square of the Coriolis parameter do I=G%IsdB,G%IedB ; do J=G%JsdB,G%JedB G%Coriolis2Bu(I,J) = G%CoriolisBu(I,J)**2 enddo ; enddo @@ -201,7 +198,7 @@ subroutine MOM_initialize_fixed(G, US, OBC, PF) call initialize_grid_rotation_angle(G, PF) -! Compute global integrals of grid values for later use in scalar diagnostics ! + ! Compute global integrals of grid values for later use in scalar diagnostics ! call compute_global_grid_integrals(G, US=US) call callTree_leave('MOM_initialize_fixed()') diff --git a/src/initialization/MOM_state_initialization.F90 b/src/initialization/MOM_state_initialization.F90 index f5ed0a2b46..b55dd4d05d 100644 --- a/src/initialization/MOM_state_initialization.F90 +++ b/src/initialization/MOM_state_initialization.F90 @@ -24,7 +24,6 @@ module MOM_state_initialization use MOM_open_boundary, only : fill_temp_salt_segments, setup_OBC_tracer_reservoirs use MOM_open_boundary, only : fill_thickness_segments use MOM_open_boundary, only : set_initialized_OBC_tracer_reservoirs -use MOM_grid_initialize, only : initialize_masks, set_grid_metrics use MOM_restart, only : restore_state, is_new_run, copy_restart_var, copy_restart_vector use MOM_restart, only : restart_registry_lock, MOM_restart_CS use MOM_sponge, only : set_up_sponge_field, set_up_sponge_ML_density From 27f42433461ff8d64c26d2573dafe4ec9f1ee909 Mon Sep 17 00:00:00 2001 From: He Wang Date: Thu, 15 Jan 2026 20:36:58 -0500 Subject: [PATCH 51/64] Minor open_boundary_config refactor * Make OBC related calls in MOM_initialize_fixed explicitly conditional for readibility. * Early return in open_boundary_config if there is no segment, so that OBC is not allocated and then deallocated. --- src/core/MOM_open_boundary.F90 | 35 ++++++------- .../MOM_fixed_initialization.F90 | 50 +++++++++---------- 2 files changed, 39 insertions(+), 46 deletions(-) diff --git a/src/core/MOM_open_boundary.F90 b/src/core/MOM_open_boundary.F90 index eb9f8c6c13..8de939756e 100644 --- a/src/core/MOM_open_boundary.F90 +++ b/src/core/MOM_open_boundary.F90 @@ -506,6 +506,7 @@ subroutine open_boundary_config(G, US, param_file, OBC) type(ocean_OBC_type), pointer :: OBC !< Open boundary control structure ! Local variables + integer :: num_of_segs ! Number of open boundary segments integer :: n, n_seg ! For looping over segments logical :: debug, mask_outside, reentrant_x, reentrant_y character(len=15) :: segment_param_str ! The run-time parameter name for each segment @@ -522,17 +523,17 @@ subroutine open_boundary_config(G, US, param_file, OBC) ! This include declares and sets the variable "version". # include "version_variable.h" - allocate(OBC) - - call get_param(param_file, mdl, "OBC_NUMBER_OF_SEGMENTS", OBC%number_of_segments, & - default=0, do_not_log=.true.) call log_version(param_file, mdl, version, & "Controls where open boundaries are located, what kind of boundary condition "//& - "to impose, and what data to apply, if any.", & - all_default=(OBC%number_of_segments<=0)) - call get_param(param_file, mdl, "OBC_NUMBER_OF_SEGMENTS", OBC%number_of_segments, & - "The number of open boundary segments.", & - default=0) + "to impose, and what data to apply, if any.", all_default=.false.) + ! Parameter OBC_NUMBER_OF_SEGMENTS is always logged. + call get_param(param_file, mdl, "OBC_NUMBER_OF_SEGMENTS", num_of_segs, & + "The number of open boundary segments.", default=0) + if (num_of_segs <= 0) & ! Do nothing if there is no OBC segments + return + + allocate(OBC) + OBC%number_of_segments = num_of_segs call get_param(param_file, mdl, "OBC_USER_CONFIG", config1, & "A string that sets how the open boundary conditions are "//& " configured: \n", default="none", do_not_log=.true.) @@ -606,12 +607,7 @@ subroutine open_boundary_config(G, US, param_file, OBC) call get_param(param_file, mdl, "OBC_TIDE_N_CONSTITUENTS", OBC%n_tide_constituents, & "Number of tidal constituents being added to the open boundary.", & default=0) - - if (OBC%n_tide_constituents > 0) then - OBC%add_tide_constituents = .true. - else - OBC%add_tide_constituents = .false. - endif + OBC%add_tide_constituents = (OBC%n_tide_constituents > 0) call get_param(param_file, mdl, "DEBUG", debug, default=.false.) call get_param(param_file, mdl, "DEBUG_OBCS", OBC%debug, & @@ -634,7 +630,6 @@ subroutine open_boundary_config(G, US, param_file, OBC) "for dependencies on the order with which the OBC segments are applied.", & default=.false., debuggingParam=.true., do_not_log=(OBC%number_of_segments<2)) - call get_param(param_file, mdl, "OBC_SILLY_THICK", OBC%silly_h, & "A silly value of thicknesses used outside of open boundary "//& "conditions for debugging.", units="m", default=0.0, scale=US%m_to_Z, & @@ -656,9 +651,7 @@ subroutine open_boundary_config(G, US, param_file, OBC) "If true, set the OBC tracer reservoirs at the startup of a new run from the "//& "interior tracer concentrations regardless of properties that may be explicitly "//& "specified for the reservoir concentrations.", default=enable_bugs, do_not_log=.true.) - reentrant_x = .false. call get_param(param_file, mdl, "REENTRANT_X", reentrant_x, default=.true.) - reentrant_y = .false. call get_param(param_file, mdl, "REENTRANT_Y", reentrant_y, default=.false.) ! Allocate everything @@ -732,8 +725,8 @@ subroutine open_boundary_config(G, US, param_file, OBC) ! Need this for ocean_only mode boundary interpolation. call time_interp_external_init() endif - ! if (open_boundary_query(OBC, needs_ext_seg_data=.true.)) & - ! call initialize_segment_data(G, OBC, param_file) + ! if (open_boundary_query(OBC, needs_ext_seg_data=.true.)) & + ! call initialize_segment_data(G, OBC, param_file) if (open_boundary_query(OBC, apply_open_OBC=.true.)) then call get_param(param_file, mdl, "OBC_RADIATION_MAX", OBC%rx_max, & @@ -847,7 +840,7 @@ subroutine open_boundary_config(G, US, param_file, OBC) endif ! OBC%number_of_segments > 0 - ! Safety check + ! Safety check if ((OBC%open_u_BCs_exist_globally .or. OBC%open_v_BCs_exist_globally) .and. & .not.G%symmetric ) call MOM_error(FATAL, & "MOM_open_boundary, open_boundary_config: "//& diff --git a/src/initialization/MOM_fixed_initialization.F90 b/src/initialization/MOM_fixed_initialization.F90 index 4ec9cacd02..4b28689483 100644 --- a/src/initialization/MOM_fixed_initialization.F90 +++ b/src/initialization/MOM_fixed_initialization.F90 @@ -90,40 +90,40 @@ subroutine MOM_initialize_fixed(G, US, OBC, PF) ! To initialize masks, the bathymetry in halo regions must be filled in call pass_var(G%bathyT, G%Domain) - ! Determine the position of any open boundaries + ! Determine the position of any open boundaries and create OBC call open_boundary_config(G, US, PF, OBC) - ! Make bathymetry consistent with open boundaries - call get_param(PF, mdl, "ENABLE_BUGS_BY_DEFAULT", enable_bugs, & - default=.true., do_not_log=.true.) ! This is logged from MOM.F90. - call get_param(PF, mdl, "OBC_PROJECTION_BUG", OBC_projection_bug, & - "If false, use only interior ocean points at OBCs to specify several "//& - "calculations at OBC points, and it avoids applying a land mask at the bay-like "//& - "intersection of orthogonal OBC segments. Otherwise the calculation of terms "//& - "like the potential vorticity used in the barotropic solver relies on bathymetry "//& - "or other fields being projected outward across OBCs. This option changes "//& - "answers for some configurations that use OBCs.", & - default=enable_bugs, do_not_log=.not.associated(OBC)) - open_corners = .not.OBC_projection_bug - - if (associated(OBC) .and. OBC_projection_bug .and. read_meanSL_file) & - ! OBC_projection_bug modifies bathyT outside of the open boundaries, so meanSL would have to be - ! modified as well. - call MOM_error(FATAL, "MOM_initialize_fixed: To read mean sea level file, "//& - "OBC_PROJECTION_BUG needs to be False.") - - ! This call sets masks that prohibit flow over any point interpreted as land + ! Make bathymetry (if OBC_PROJECTION_BUG) and masks consistent with open boundaries. if (associated(OBC)) then + call get_param(PF, mdl, "ENABLE_BUGS_BY_DEFAULT", enable_bugs, & + default=.true., do_not_log=.true.) ! This is logged from MOM.F90. + call get_param(PF, mdl, "OBC_PROJECTION_BUG", OBC_projection_bug, & + "If false, use only interior ocean points at OBCs to specify several "//& + "calculations at OBC points, and it avoids applying a land mask at the "//& + "bay-like intersection of orthogonal OBC segments. Otherwise the "//& + "calculation of terms like the potential vorticity used in the barotropic "//& + "solver relies on bathymetry or other fields being projected outward across "//& + "OBCs. This option changes answers for some configurations that use OBCs.", & + default=enable_bugs) + open_corners = .not.OBC_projection_bug + + if (OBC_projection_bug .and. read_meanSL_file) & + ! OBC_projection_bug modifies bathyT outside of the open boundaries, so meanSL would have to be + ! modified as well. + call MOM_error(FATAL, "MOM_initialize_fixed: To read mean sea level file, "//& + "OBC_PROJECTION_BUG needs to be False.") + + ! This call sets masks that prohibit flow over any point interpreted as land if (OBC_projection_bug) & call open_boundary_impose_normal_slope(OBC, G, G%bathyT) - call initialize_masks(G, PF, US, OBC_dir_u=OBC%segnum_u, OBC_dir_v=OBC%segnum_v, open_corner_OBCs=open_corners) + call initialize_masks(G, PF, US, OBC_dir_u=OBC%segnum_u, OBC_dir_v=OBC%segnum_v, & + open_corner_OBCs=open_corners) + ! Make OBC mask consistent with land mask + call open_boundary_impose_land_mask(OBC, G, G%areaCu, G%areaCv, US) else call initialize_masks(G, PF, US) endif - ! Make OBC mask consistent with land mask - call open_boundary_impose_land_mask(OBC, G, G%areaCu, G%areaCv, US) - if (debug) then call hchksum(G%bathyT, 'MOM_initialize_fixed: depth ', G%HI, haloshift=1, unscale=US%Z_to_m) call hchksum(G%mask2dT, 'MOM_initialize_fixed: mask2dT ', G%HI) From a5da88f87e66c4d675f807ed5361e84c6e6ea210 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sun, 18 Jan 2026 22:44:10 -0500 Subject: [PATCH 52/64] Refactor gradKE with simpler treatment of OBCs Refactored gradKE() to only take a single layer of velocities and thicknesses and to use G%IdxCu_OBCmask and G%IdyCv_OBCmask to avoid extra loops over the OBC segments for efficiency. With these changes, there is also an expectation that gradKE() will be more likely to be inlined or threaded and hence become more efficient. All solutions are bitwise identical, but there are some diagnostics of accelerations that are fully or partially set to zero at solid (masked) boundaries. --- src/core/MOM_CoriolisAdv.F90 | 114 +++++++++++++++-------------------- 1 file changed, 49 insertions(+), 65 deletions(-) diff --git a/src/core/MOM_CoriolisAdv.F90 b/src/core/MOM_CoriolisAdv.F90 index 5495164782..688f834cb1 100644 --- a/src/core/MOM_CoriolisAdv.F90 +++ b/src/core/MOM_CoriolisAdv.F90 @@ -676,7 +676,7 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS, pbv, Wav endif ! Calculate KE and the gradient of KE - call gradKE(u, v, h, KE, KEx, KEy, k, OBC, G, GV, US, CS) + call gradKE(u(:,:,k), v(:,:,k), h(:,:,k), KE, KEx, KEy, G, GV, US, CS) ! Calculate the tendencies of zonal velocity due to the Coriolis ! force and momentum advection. On a Cartesian grid, this is @@ -1231,22 +1231,20 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS, pbv, Wav end subroutine CorAdCalc -!> Calculates the acceleration due to the gradient of kinetic energy. -subroutine gradKE(u, v, h, KE, KEx, KEy, k, OBC, G, GV, US, CS) - type(ocean_grid_type), intent(in) :: G !< Ocean grid structure - type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure - real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), intent(in) :: u !< Zonal velocity [L T-1 ~> m s-1] - real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), intent(in) :: v !< Meridional velocity [L T-1 ~> m s-1] - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer thickness [H ~> m or kg m-2] - real, dimension(SZI_(G) ,SZJ_(G) ), intent(out) :: KE !< Kinetic energy per unit mass [L2 T-2 ~> m2 s-2] - real, dimension(SZIB_(G),SZJ_(G) ), intent(out) :: KEx !< Zonal acceleration due to kinetic - !! energy gradient [L T-2 ~> m s-2] - real, dimension(SZI_(G) ,SZJB_(G)), intent(out) :: KEy !< Meridional acceleration due to kinetic - !! energy gradient [L T-2 ~> m s-2] - integer, intent(in) :: k !< Layer number to calculate for - type(ocean_OBC_type), pointer :: OBC !< Open boundary control structure - type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - type(CoriolisAdv_CS), intent(in) :: CS !< Control structure for MOM_CoriolisAdv +!> Calculates the acceleration due to the gradient of kinetic energy in one layer. +subroutine gradKE(u, v, h, KE, KEx, KEy, G, GV, US, CS) + type(ocean_grid_type), intent(in) :: G !< Ocean grid structure + type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure + real, dimension(SZIB_(G),SZJ_(G)), intent(in) :: u !< Zonal velocity [L T-1 ~> m s-1] + real, dimension(SZI_(G),SZJB_(G)), intent(in) :: v !< Meridional velocity [L T-1 ~> m s-1] + real, dimension(SZI_(G),SZJ_(G)), intent(in) :: h !< Layer thickness [H ~> m or kg m-2] + real, dimension(SZI_(G),SZJ_(G)), intent(out) :: KE !< Kinetic energy per unit mass [L2 T-2 ~> m2 s-2] + real, dimension(SZIB_(G),SZJ_(G)), intent(out) :: KEx !< Zonal acceleration due to kinetic + !! energy gradient [L T-2 ~> m s-2] + real, dimension(SZI_(G),SZJB_(G)), intent(out) :: KEy !< Meridional acceleration due to kinetic + !! energy gradient [L T-2 ~> m s-2] + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + type(CoriolisAdv_CS), intent(in) :: CS !< Control structure for MOM_CoriolisAdv ! Local variables real :: um, up, vm, vp ! Temporary variables [L T-1 ~> m s-1]. real :: um2, up2, vm2, vp2 ! Temporary variables [L2 T-2 ~> m2 s-2]. @@ -1265,29 +1263,29 @@ subroutine gradKE(u, v, h, KE, KEx, KEy, k, OBC, G, GV, US, CS) ! identified in Arakawa & Lamb 1982 as important for KE conservation. It ! also includes the possibility of partially-blocked tracer cell faces. do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - KE(i,j) = ( ( (G%areaCu( I ,j)*(u( I ,j,k)*u( I ,j,k))) + & - (G%areaCu(I-1,j)*(u(I-1,j,k)*u(I-1,j,k))) ) + & - ( (G%areaCv(i, J )*(v(i, J ,k)*v(i, J ,k))) + & - (G%areaCv(i,J-1)*(v(i,J-1,k)*v(i,J-1,k))) ) )*0.25*G%IareaT(i,j) + KE(i,j) = ( ( (G%areaCu( I ,j)*(u( I ,j)*u( I ,j))) + & + (G%areaCu(I-1,j)*(u(I-1,j)*u(I-1,j))) ) + & + ( (G%areaCv(i, J )*(v(i, J )*v(i, J ))) + & + (G%areaCv(i,J-1)*(v(i,J-1)*v(i,J-1))) ) )*0.25*G%IareaT(i,j) enddo ; enddo elseif (CS%KE_Scheme == KE_SIMPLE_GUDONOV) then ! The following discretization of KE is based on the one-dimensional Gudonov ! scheme which does not take into account any geometric factors do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - up = 0.5*( u(I-1,j,k) + ABS( u(I-1,j,k) ) ) ; up2 = up*up - um = 0.5*( u( I ,j,k) - ABS( u( I ,j,k) ) ) ; um2 = um*um - vp = 0.5*( v(i,J-1,k) + ABS( v(i,J-1,k) ) ) ; vp2 = vp*vp - vm = 0.5*( v(i, J ,k) - ABS( v(i, J ,k) ) ) ; vm2 = vm*vm + up = 0.5*( u(I-1,j) + ABS( u(I-1,j) ) ) ; up2 = up*up + um = 0.5*( u( I ,j) - ABS( u( I ,j) ) ) ; um2 = um*um + vp = 0.5*( v(i,J-1) + ABS( v(i,J-1) ) ) ; vp2 = vp*vp + vm = 0.5*( v(i, J ) - ABS( v(i, J ) ) ) ; vm2 = vm*vm KE(i,j) = ( max(up2,um2) + max(vp2,vm2) ) *0.5 enddo ; enddo elseif (CS%KE_Scheme == KE_GUDONOV) then ! The following discretization of KE is based on the one-dimensional Gudonov ! scheme but has been adapted to take horizontal grid factors into account do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - up = 0.5*( u(I-1,j,k) + ABS( u(I-1,j,k) ) ) ; up2a = up*up*G%areaCu(I-1,j) - um = 0.5*( u( I ,j,k) - ABS( u( I ,j,k) ) ) ; um2a = um*um*G%areaCu( I ,j) - vp = 0.5*( v(i,J-1,k) + ABS( v(i,J-1,k) ) ) ; vp2a = vp*vp*G%areaCv(i,J-1) - vm = 0.5*( v(i, J ,k) - ABS( v(i, J ,k) ) ) ; vm2a = vm*vm*G%areaCv(i, J ) + up = 0.5*( u(I-1,j) + ABS( u(I-1,j) ) ) ; up2a = up*up*G%areaCu(I-1,j) + um = 0.5*( u( I ,j) - ABS( u( I ,j) ) ) ; um2a = um*um*G%areaCu( I ,j) + vp = 0.5*( v(i,J-1) + ABS( v(i,J-1) ) ) ; vp2a = vp*vp*G%areaCv(i,J-1) + vm = 0.5*( v(i, J ) - ABS( v(i, J ) ) ) ; vm2a = vm*vm*G%areaCv(i, J ) KE(i,j) = ( max(um2a,up2a) + max(vm2a,vp2a) )*0.5*G%IareaT(i,j) enddo ; enddo elseif (CS%KE_Scheme == KE_UP3) then @@ -1300,14 +1298,14 @@ subroutine gradKE(u, v, h, KE, KEx, KEy, k, OBC, G, GV, US, CS) G%mask2dCu(I,j) * G%mask2dCu(I+1,j)) if (third_order_u == 1) then - up = (7.0 * (u(I-1,j,k) + u(I,j,k)) - (u(I-2,j,k) + u(I+1,j,k))) * C1_12 - call UP3_Koren_limiter_reconstruction(u(I-2:I+1,j,k), up, um) + up = (7.0 * (u(I-1,j) + u(I,j)) - (u(I-2,j) + u(I+1,j))) * C1_12 + call UP3_Koren_limiter_reconstruction(u(I-2:I+1,j), up, um) else - up = (u(I-1,j,k) + u(I,j,k))*0.5 + up = (u(I-1,j) + u(I,j))*0.5 if (up>0.) then - um = u(I-1,j,k) + um = u(I-1,j) elseif (up<0.) then - um = u(I,j,k) + um = u(I,j) else um = up endif @@ -1316,14 +1314,14 @@ subroutine gradKE(u, v, h, KE, KEx, KEy, k, OBC, G, GV, US, CS) third_order_v = (G%mask2dCv(i,J-2) * G%mask2dCv(i,J-1)* & G%mask2dCv(i,J) * G%mask2dCv(i,J+1)) if (third_order_v ==1) then - vp = (7.0 * (v(i,J-1,k) + v(i,J,k)) - (v(i,J-2,k) + v(i,J+1,k))) * C1_12 - call UP3_Koren_limiter_reconstruction(v(i,J-2:J+1,k), vp, vm) + vp = (7.0 * (v(i,J-1) + v(i,J)) - (v(i,J-2) + v(i,J+1))) * C1_12 + call UP3_Koren_limiter_reconstruction(v(i,J-2:J+1), vp, vm) else - vp = (v(i,J-1,k) + v(i,J,k))*0.5 + vp = (v(i,J-1) + v(i,J))*0.5 if (vp>0.) then - vm = v(i,J-1,k) + vm = v(i,J-1) elseif (vp<0.) then - vm = v(i,J,k) + vm = v(i,J) else vm = vp endif @@ -1338,14 +1336,14 @@ subroutine gradKE(u, v, h, KE, KEx, KEy, k, OBC, G, GV, US, CS) G%mask2dCu(I,j) * G%mask2dCu(I+1,j)) if (third_order_u == 1) then - up = (7.0 * (u(I-1,j,k) + u(I,j,k)) - (u(I-2,j,k) + u(I+1,j,k))) * C1_12 - call UP3_reconstruction(u(I-2:I+1,j,k), up, um) + up = (7.0 * (u(I-1,j) + u(I,j)) - (u(I-2,j) + u(I+1,j))) * C1_12 + call UP3_reconstruction(u(I-2:I+1,j), up, um) else - up = (u(I-1,j,k) + u(I,j,k))*0.5 + up = (u(I-1,j) + u(I,j))*0.5 if (up>0.) then - um = u(I-1,j,k) + um = u(I-1,j) elseif (up<0.) then - um = u(I,j,k) + um = u(I,j) else um = up endif @@ -1354,14 +1352,14 @@ subroutine gradKE(u, v, h, KE, KEx, KEy, k, OBC, G, GV, US, CS) third_order_v = (G%mask2dCv(i,J-2) * G%mask2dCv(i,J-1)* & G%mask2dCv(i,J) * G%mask2dCv(i,J+1)) if (third_order_v ==1) then - vp = (7.0 * (v(i,J-1,k) + v(i,J,k)) - (v(i,J-2,k) + v(i,J+1,k))) * C1_12 - call UP3_reconstruction(v(i,J-2:J+1,k), vp, vm) + vp = (7.0 * (v(i,J-1) + v(i,J)) - (v(i,J-2) + v(i,J+1))) * C1_12 + call UP3_reconstruction(v(i,J-2:J+1), vp, vm) else - vp = (v(i,J-1,k) + v(i,J,k))*0.5 + vp = (v(i,J-1) + v(i,J))*0.5 if (vp>0.) then - vm = v(i,J-1,k) + vm = v(i,J-1) elseif (vp<0.) then - vm = v(i,J,k) + vm = v(i,J) else vm = vp endif @@ -1374,28 +1372,14 @@ subroutine gradKE(u, v, h, KE, KEx, KEy, k, OBC, G, GV, US, CS) ! Term - d(KE)/dx. do j=js,je ; do I=Isq,Ieq - KEx(I,j) = (KE(i+1,j) - KE(i,j)) * G%IdxCu(I,j) + KEx(I,j) = (KE(i+1,j) - KE(i,j)) * G%IdxCu_OBCmask(I,j) enddo ; enddo ! Term - d(KE)/dy. do J=Jsq,Jeq ; do i=is,ie - KEy(i,J) = (KE(i,j+1) - KE(i,j)) * G%IdyCv(i,J) + KEy(i,J) = (KE(i,j+1) - KE(i,j)) * G%IdyCv_OBCmask(i,J) enddo ; enddo - if (associated(OBC)) then - do n=1,OBC%number_of_segments - if (OBC%segment(n)%is_N_or_S) then - do i=OBC%segment(n)%HI%isd,OBC%segment(n)%HI%ied - KEy(i,OBC%segment(n)%HI%JsdB) = 0. - enddo - elseif (OBC%segment(n)%is_E_or_W) then - do j=OBC%segment(n)%HI%jsd,OBC%segment(n)%HI%jed - KEx(OBC%segment(n)%HI%IsdB,j) = 0. - enddo - endif - enddo - endif - end subroutine gradKE !> Reconstruct the scalar (e.g., pv, vorticity) onto point i-1/2 using a third-order upwind scheme From 85aacaaa4b2aa2851c0a10e4b5ba0673c1807eab Mon Sep 17 00:00:00 2001 From: Marshall Ward Date: Tue, 30 Dec 2025 14:36:26 -0500 Subject: [PATCH 53/64] Autoconf: Build dependencies as libraries This patch significantly modifies the Autoconf-based builds to separate external content in `pkg/` from the main MOM6 source code. These changes are meant to address the challenges with analysis of source code which is outside of our control. Such content is now built separately, isolating it from the usual MOM6 code requirements. A secondary benefit is that a submodule checkout is no longer required for ocean-only builds. The patch includes the following specific changes. * Builds relying on `ac/deps/` now build libraries for GibbsSeaWater (`libgsw.a`) and CVMix (`libcvmix.a`) alongside `libFMS.a`. This replaces any content placed externally into `pkg/`. * A new macro, `MOM6_FC_CHECK_LIB`, improves library detection tests by including support for both subroutines and functions, as well as generic argument lists. * Makefiles across the build system (`ac/deps/`, `.testing/`, etc.) have been updated to generate and use the new libraries. These changes are not intended to break existing builds, as summarized below. * `src/parameters/CVMix/` and `TEOS10/` are explicitly excluded from the makedep source trees, but the symbolic links to `pkg/` are retained, and existing builds which assume their presence should still work. * The legacy `AX_FC_CHECK_LIB` macro has been retained, so that it remains available to any external MOM6-examples builds. * The git submodules have not been removed, although the GitHub Actions no longer uses then in testing. The patch also includes the following related minor modifications. * The GitHub Actions FMS build stages now includes GSW and CVMix * `.gitignore` files are modified to target files produced by the build system, rather than globbing of various incidental files. * A non-POSIX shell operation `==` in `configure.ac` has been replaced. --- .github/workflows/verify-linux.yml | 97 +++++++++-------------- .github/workflows/verify-macos.yml | 58 +++++--------- .gitignore | 21 ----- .testing/Makefile | 40 ++++++++-- .testing/tc4/.gitignore | 2 + .testing/tc4/configure.ac | 39 +++++---- ac/Makefile.in | 7 +- ac/configure.ac | 122 ++++++++++++++++++++--------- ac/deps/.gitignore | 2 + ac/deps/Makefile | 75 +++++++++++------- ac/deps/Makefile.cvmix.in | 30 +++++++ ac/deps/Makefile.gsw.in | 30 +++++++ ac/deps/configure.cvmix.ac | 82 +++++++++++++++++++ ac/deps/configure.gsw.ac | 82 +++++++++++++++++++ ac/m4/mom6_fc_check_lib.m4 | 82 +++++++++++++++++++ 15 files changed, 559 insertions(+), 210 deletions(-) create mode 100644 ac/deps/Makefile.cvmix.in create mode 100644 ac/deps/Makefile.gsw.in create mode 100644 ac/deps/configure.cvmix.ac create mode 100644 ac/deps/configure.gsw.ac create mode 100644 ac/m4/mom6_fc_check_lib.m4 diff --git a/.github/workflows/verify-linux.yml b/.github/workflows/verify-linux.yml index 4c2817f4ee..2931c7fdc9 100644 --- a/.github/workflows/verify-linux.yml +++ b/.github/workflows/verify-linux.yml @@ -14,8 +14,6 @@ jobs: steps: - uses: actions/checkout@v4 - with: - submodules: recursive - name: Check white space (non-blocking) run: | @@ -50,13 +48,14 @@ jobs: steps: - uses: actions/checkout@v4 - with: - submodules: recursive - uses: ./.github/actions/ubuntu-setup/ - - name: Compile FMS - run: make -C .testing -j build/deps/lib/libFMS.a + - name: Compile dependencies + run: | + make -C .testing -j build/deps/lib/libFMS.a + make -C .testing -j build/deps/lib/libgsw.a + make -C .testing -j build/deps/lib/libcvmix.a - name: Compile MOM6 with symmetric indexing run: make -C .testing -j build/symmetric/MOM6 @@ -75,13 +74,14 @@ jobs: steps: - uses: actions/checkout@v4 - with: - submodules: recursive - uses: ./.github/actions/ubuntu-setup/ - - name: Compile FMS - run: make -C .testing -j build/deps/lib/libFMS.a + - name: Compile dependencies + run: | + make -C .testing -j build/deps/lib/libFMS.a + make -C .testing -j build/deps/lib/libgsw.a + make -C .testing -j build/deps/lib/libcvmix.a - name: Compile MOM6 with asymmetric indexing run: make -C .testing -j build/asymmetric/MOM6 @@ -100,13 +100,14 @@ jobs: steps: - uses: actions/checkout@v4 - with: - submodules: recursive - uses: ./.github/actions/ubuntu-setup/ - - name: Compile FMS - run: make -C .testing -j build/deps/lib/libFMS.a + - name: Compile dependencies + run: | + make -C .testing -j build/deps/lib/libFMS.a + make -C .testing -j build/deps/lib/libgsw.a + make -C .testing -j build/deps/lib/libcvmix.a - name: Compile MOM6 with bit-reproducible optimization run: make -C .testing -j build/repro/MOM6 @@ -125,13 +126,14 @@ jobs: steps: - uses: actions/checkout@v4 - with: - submodules: recursive - uses: ./.github/actions/ubuntu-setup/ - - name: Compile FMS - run: make -C .testing -j build/deps/lib/libFMS.a + - name: Compile dependencies + run: | + make -C .testing -j build/deps/lib/libFMS.a + make -C .testing -j build/deps/lib/libgsw.a + make -C .testing -j build/deps/lib/libcvmix.a - name: Compile MOM6 supporting OpenMP run: make -C .testing -j build/openmp/MOM6 @@ -151,12 +153,10 @@ jobs: steps: - uses: actions/checkout@v4 - with: - submodules: recursive - uses: ./.github/actions/ubuntu-setup/ - - name: Compile target FMS + - name: Compile target depedencies run: | make -C .testing \ DO_REGRESSION_TESTS=1 \ @@ -184,13 +184,14 @@ jobs: steps: - uses: actions/checkout@v4 - with: - submodules: recursive - uses: ./.github/actions/ubuntu-setup/ - - name: Compile FMS - run: make -C .testing -j build/deps/lib/libFMS.a + - name: Compile dependencies + run: | + make -C .testing -j build/deps/lib/libFMS.a + make -C .testing -j build/deps/lib/libgsw.a + make -C .testing -j build/deps/lib/libcvmix.a - name: Compile MOM6 with aggressive optimization run: make -C .testing -j build/opt/MOM6 @@ -217,12 +218,10 @@ jobs: steps: - uses: actions/checkout@v4 - with: - submodules: recursive - uses: ./.github/actions/ubuntu-setup/ - - name: Compile target FMS + - name: Compile target dependencies run: | make -C .testing \ DO_REGRESSION_TESTS=1 \ @@ -260,13 +259,14 @@ jobs: steps: - uses: actions/checkout@v4 - with: - submodules: recursive - uses: ./.github/actions/ubuntu-setup/ - - name: Compile FMS - run: make -C .testing -j build/deps/lib/libFMS.a + - name: Compile dependencies + run: | + make -C .testing -j build/deps/lib/libFMS.a + make -C .testing -j build/deps/lib/libgsw.a + make -C .testing -j build/deps/lib/libcvmix.a - name: Compile MOM6 with code coverage run: make -C .testing -j build/cov/MOM6 @@ -296,13 +296,14 @@ jobs: steps: - uses: actions/checkout@v4 - with: - submodules: recursive - uses: ./.github/actions/ubuntu-setup/ - - name: Compile FMS - run: make -C .testing -j build/deps/lib/libFMS.a + - name: Compile dependencies + run: | + make -C .testing -j build/deps/lib/libFMS.a + make -C .testing -j build/deps/lib/libgsw.a + make -C .testing -j build/deps/lib/libcvmix.a - name: Compile MOM6 for the GFDL coupled driver run: make -C .testing -j check_mom6_api_coupled @@ -317,8 +318,6 @@ jobs: steps: - uses: actions/checkout@v4 - with: - submodules: recursive - uses: ./.github/actions/ubuntu-setup @@ -350,8 +349,6 @@ jobs: steps: - uses: actions/checkout@v4 - with: - submodules: recursive - uses: ./.github/actions/ubuntu-setup @@ -375,8 +372,6 @@ jobs: steps: - uses: actions/checkout@v4 - with: - submodules: recursive - uses: ./.github/actions/ubuntu-setup @@ -400,8 +395,6 @@ jobs: steps: - uses: actions/checkout@v4 - with: - submodules: recursive - uses: ./.github/actions/ubuntu-setup @@ -425,8 +418,6 @@ jobs: steps: - uses: actions/checkout@v4 - with: - submodules: recursive - uses: ./.github/actions/ubuntu-setup @@ -460,8 +451,6 @@ jobs: steps: - uses: actions/checkout@v4 - with: - submodules: recursive - uses: ./.github/actions/ubuntu-setup @@ -487,8 +476,6 @@ jobs: steps: - uses: actions/checkout@v4 - with: - submodules: recursive - uses: ./.github/actions/ubuntu-setup @@ -522,8 +509,6 @@ jobs: steps: - uses: actions/checkout@v4 - with: - submodules: recursive - uses: ./.github/actions/ubuntu-setup @@ -558,8 +543,6 @@ jobs: steps: - uses: actions/checkout@v4 - with: - submodules: recursive - uses: ./.github/actions/ubuntu-setup @@ -592,8 +575,6 @@ jobs: steps: - uses: actions/checkout@v4 - with: - submodules: recursive - uses: ./.github/actions/ubuntu-setup @@ -638,8 +619,6 @@ jobs: steps: - uses: actions/checkout@v4 - with: - submodules: recursive - uses: ./.github/actions/ubuntu-setup @@ -670,8 +649,6 @@ jobs: steps: - uses: actions/checkout@v4 - with: - submodules: recursive - uses: ./.github/actions/ubuntu-setup diff --git a/.github/workflows/verify-macos.yml b/.github/workflows/verify-macos.yml index d058336053..f4f473290d 100644 --- a/.github/workflows/verify-macos.yml +++ b/.github/workflows/verify-macos.yml @@ -16,13 +16,14 @@ jobs: steps: - uses: actions/checkout@v4 - with: - submodules: recursive - uses: ./.github/actions/macos-setup/ - - name: Compile FMS - run: make -C .testing -j build/deps/lib/libFMS.a + - name: Compile dependencies + run: | + make -C .testing -j build/deps/lib/libFMS.a + make -C .testing -j build/deps/lib/libgsw.a + make -C .testing -j build/deps/lib/libcvmix.a - name: Compile MOM6 with symmetric indexing run: make -C .testing -j build/symmetric/MOM6 @@ -41,13 +42,14 @@ jobs: steps: - uses: actions/checkout@v4 - with: - submodules: recursive - uses: ./.github/actions/macos-setup/ - - name: Compile FMS - run: make -C .testing -j build/deps/lib/libFMS.a + - name: Compile dependencies + run: | + make -C .testing -j build/deps/lib/libFMS.a + make -C .testing -j build/deps/lib/libgsw.a + make -C .testing -j build/deps/lib/libcvmix.a - name: Compile MOM6 with asymmetric indexing run: make -C .testing -j build/asymmetric/MOM6 @@ -66,13 +68,14 @@ jobs: steps: - uses: actions/checkout@v4 - with: - submodules: recursive - uses: ./.github/actions/macos-setup/ - - name: Compile FMS - run: make -C .testing -j build/deps/lib/libFMS.a + - name: Compile dependencies + run: | + make -C .testing -j build/deps/lib/libFMS.a + make -C .testing -j build/deps/lib/libgsw.a + make -C .testing -j build/deps/lib/libcvmix.a - name: Compile MOM6 with bit-reproducible optimization run: make -C .testing -j build/repro/MOM6 @@ -91,13 +94,14 @@ jobs: steps: - uses: actions/checkout@v4 - with: - submodules: recursive - uses: ./.github/actions/macos-setup/ - - name: Compile FMS - run: make -C .testing -j build/deps/lib/libFMS.a + - name: Compile dependencies + run: | + make -C .testing -j build/deps/lib/libFMS.a + make -C .testing -j build/deps/lib/libgsw.a + make -C .testing -j build/deps/lib/libcvmix.a - name: Compile MOM6 supporting OpenMP run: make -C .testing -j build/openmp/MOM6 @@ -117,12 +121,10 @@ jobs: steps: - uses: actions/checkout@v4 - with: - submodules: recursive - uses: ./.github/actions/macos-setup/ - - name: Compile target FMS + - name: Compile target dependencies run: | make -C .testing \ DO_REGRESSION_TESTS=1 \ @@ -155,8 +157,6 @@ jobs: steps: - uses: actions/checkout@v4 - with: - submodules: recursive - uses: ./.github/actions/macos-setup @@ -188,8 +188,6 @@ jobs: steps: - uses: actions/checkout@v4 - with: - submodules: recursive - uses: ./.github/actions/macos-setup @@ -213,8 +211,6 @@ jobs: steps: - uses: actions/checkout@v4 - with: - submodules: recursive - uses: ./.github/actions/macos-setup @@ -238,8 +234,6 @@ jobs: steps: - uses: actions/checkout@v4 - with: - submodules: recursive - uses: ./.github/actions/macos-setup @@ -263,8 +257,6 @@ jobs: steps: - uses: actions/checkout@v4 - with: - submodules: recursive - uses: ./.github/actions/macos-setup @@ -298,8 +290,6 @@ jobs: steps: - uses: actions/checkout@v4 - with: - submodules: recursive - uses: ./.github/actions/macos-setup @@ -325,8 +315,6 @@ jobs: steps: - uses: actions/checkout@v4 - with: - submodules: recursive - uses: ./.github/actions/macos-setup @@ -360,8 +348,6 @@ jobs: steps: - uses: actions/checkout@v4 - with: - submodules: recursive - uses: ./.github/actions/macos-setup @@ -396,8 +382,6 @@ jobs: steps: - uses: actions/checkout@v4 - with: - submodules: recursive - uses: ./.github/actions/macos-setup diff --git a/.gitignore b/.gitignore index c57b950fc2..d246027b44 100644 --- a/.gitignore +++ b/.gitignore @@ -1,23 +1,2 @@ -# Ignore vim and emacs files -*.swp -*~ -html - - # Build output -*.o -*.mod -MOM6 build/ -deps/ -pkg/MARBL - - -# Autoconf output -aclocal.m4 -autom4te.cache/ -config.log -config.status -configure -/Makefile -Makefile.mkmf diff --git a/.testing/Makefile b/.testing/Makefile index 71d5b464f0..0d80e28fde 100644 --- a/.testing/Makefile +++ b/.testing/Makefile @@ -311,7 +311,7 @@ $(BUILD)/opt_target: | $(TARGET_CODEBASE) $(BUILD)/%/Makefile: $(BUILD)/%/Makefile.in $(BUILD)/%/config.status cd $(@D) && ./config.status -$(BUILD)/%/config.status: $(BUILD)/%/configure $(DEPS)/lib/libFMS.a +$(BUILD)/%/config.status: $(BUILD)/%/configure $(DEPS)/lib/libFMS.a $(DEPS)/lib/libgsw.a $(DEPS)/lib/libcvmix.a cd $(@D) && $(MOM_ENV) ./configure -n --srcdir=$(AC_SRCDIR) $(MOM_ACFLAGS) \ || (cat config.log && false) @@ -340,19 +340,18 @@ $(TARGET_CODEBASE): endif -## FMS +## Dependencies # Set up the FMS build environment variables -FMS_ENV = \ +DEPS_ENV = \ PATH="${PATH}:$(realpath ../ac)" \ FCFLAGS="$(FCFLAGS_FMS)" \ REPORT_ERROR_LOGS="$(REPORT_ERROR_LOGS)" -$(DEPS)/lib/libFMS.a: $(DEPS)/Makefile $(DEPS)/Makefile.fms.in $(DEPS)/configure.fms.ac $(DEPS)/m4 - $(FMS_ENV) $(MAKE) -C $(DEPS) lib/libFMS.a +# FMS -$(DEPS)/Makefile: ../ac/deps/Makefile | $(DEPS) - cp ../ac/deps/Makefile $(DEPS)/Makefile +$(DEPS)/lib/libFMS.a: $(DEPS)/Makefile $(DEPS)/Makefile.fms.in $(DEPS)/configure.fms.ac $(DEPS)/m4 + $(DEPS_ENV) $(MAKE) -C $(DEPS) lib/libFMS.a $(DEPS)/Makefile.fms.in: ../ac/deps/Makefile.fms.in | $(DEPS) cp ../ac/deps/Makefile.fms.in $(DEPS)/Makefile.fms.in @@ -360,6 +359,33 @@ $(DEPS)/Makefile.fms.in: ../ac/deps/Makefile.fms.in | $(DEPS) $(DEPS)/configure.fms.ac: ../ac/deps/configure.fms.ac | $(DEPS) cp ../ac/deps/configure.fms.ac $(DEPS)/configure.fms.ac +# GSW + +$(DEPS)/lib/libgsw.a: $(DEPS)/Makefile $(DEPS)/Makefile.gsw.in $(DEPS)/configure.gsw.ac $(DEPS)/m4 + $(DEPS_ENV) $(MAKE) -C $(DEPS) lib/libgsw.a + +$(DEPS)/Makefile.gsw.in: ../ac/deps/Makefile.gsw.in | $(DEPS) + cp ../ac/deps/Makefile.gsw.in $(DEPS)/Makefile.gsw.in + +$(DEPS)/configure.gsw.ac: ../ac/deps/configure.gsw.ac | $(DEPS) + cp ../ac/deps/configure.gsw.ac $(DEPS)/configure.gsw.ac + +# CVMix + +$(DEPS)/lib/libcvmix.a: $(DEPS)/Makefile $(DEPS)/Makefile.cvmix.in $(DEPS)/configure.cvmix.ac $(DEPS)/m4 + $(DEPS_ENV) $(MAKE) -C $(DEPS) lib/libcvmix.a + +$(DEPS)/Makefile.cvmix.in: ../ac/deps/Makefile.cvmix.in | $(DEPS) + cp ../ac/deps/Makefile.cvmix.in $(DEPS)/Makefile.cvmix.in + +$(DEPS)/configure.cvmix.ac: ../ac/deps/configure.cvmix.ac | $(DEPS) + cp ../ac/deps/configure.cvmix.ac $(DEPS)/configure.cvmix.ac + +# Generic dependency content + +$(DEPS)/Makefile: ../ac/deps/Makefile | $(DEPS) + cp ../ac/deps/Makefile $(DEPS)/Makefile + $(DEPS)/m4: ../ac/deps/m4 | $(DEPS) cp -r ../ac/deps/m4 $(DEPS)/ diff --git a/.testing/tc4/.gitignore b/.testing/tc4/.gitignore index 4f9cc2826f..0532a48da7 100644 --- a/.testing/tc4/.gitignore +++ b/.testing/tc4/.gitignore @@ -3,7 +3,9 @@ aclocal.m4 autom4te.cache/ config.log config.status +configure configure~ +Makefile # Output gen_grid diff --git a/.testing/tc4/configure.ac b/.testing/tc4/configure.ac index c431ad65ef..4b9ad55a06 100644 --- a/.testing/tc4/configure.ac +++ b/.testing/tc4/configure.ac @@ -47,24 +47,29 @@ AX_FC_CHECK_C_LIB([netcdf], [nc_create], [], [ ]) # Confirm that the Fortran compiler can link to the netCDF Fortran library. -# NOTE: -# - We test nf_create, rather than nf90_create, since AX_FC_CHECK_LIB can -# not currently probe the Fortran 90 interfaces. -# - nf-config does not have --libdir, so we parse the --flibs output. -AX_FC_CHECK_LIB([netcdff], [nf_create], [], [], [ - AS_UNSET([ax_fc_cv_lib_netcdff_nf_create]) - AC_PATH_PROG([NF_CONFIG], [nf-config]) - AS_IF([test -n "$NF_CONFIG"], [ - AC_SUBST([LDFLAGS], - ["$LDFLAGS $($NF_CONFIG --flibs | xargs -n1 | grep "^-L" | sort -u | xargs)"] +# NOTE: nf-config does not have --libdir, so we parse the --flibs output. +MOM6_FC_CHECK_LIB([netcdff], [nf90_create], [netcdf], [path,cmode,ncid], [rc], [ + character :: path + integer :: cmode, ncid, rc], + [], [ + AS_UNSET([mom6_fc_cv_lib_netcdff_nf90_create]) + AC_PATH_PROG([NF_CONFIG], [nf-config]) + AS_IF([test -n "$NF_CONFIG"], [ + AC_SUBST([LDFLAGS], + ["$LDFLAGS $($NF_CONFIG --flibs | xargs -n1 | grep "^-L" | sort -u | xargs)"] + ) + ], [ + AC_MSG_ERROR([Could not find nf-config.]) + ]) + MOM6_FC_CHECK_LIB([netcdff], [nf90_create], [netcdf], [path,cmode,ncid], [rc], [ + character :: path + integer :: cmode, ncid, rc], + [], [ + AC_MSG_ERROR([Could not find netCDF Fortran library.]) + ] ) - ], [ - AC_MSG_ERROR([Could not find nf-config.]) - ]) - AX_FC_CHECK_LIB([netcdff], [nf_create], [], [], [ - AC_MSG_ERROR([Could not find netCDF Fortran library.]) - ]) -]) + ] +) AC_CONFIG_FILES([Makefile]) diff --git a/ac/Makefile.in b/ac/Makefile.in index c4d23efdfb..1821bda43d 100644 --- a/ac/Makefile.in +++ b/ac/Makefile.in @@ -14,8 +14,7 @@ CPPFLAGS = @CPPFLAGS@ FCFLAGS = @FCFLAGS@ LDFLAGS = @LDFLAGS@ LIBS = @LIBS@ -SRC_DIRS = @SRC_DIRS@ - +MAKEDEP_FLAGS = @MAKEDEP_FLAGS@ -include Makefile.dep @@ -31,8 +30,8 @@ rwildcard=$(foreach d,$(wildcard $(1:=/*)),$(call rwildcard,$d,$2) $(filter $(su # Generate dependencies .PHONY: depend depend: Makefile.dep -Makefile.dep: $(MAKEDEP) $(call rwildcard,$(SRC_DIRS),*.h *.c *.inc *.F90) - $(PYTHON) $(MAKEDEP) $(DEFS) -o Makefile.dep -e $(SRC_DIRS) +Makefile.dep: $(call rwildcard,$(SRC_DIRS),*.h *.c *.inc *.F90) + $(PYTHON) $(MAKEDEP) $(DEFS) -o Makefile.dep $(MAKEDEP_FLAGS) # Delete any files associated with configuration (including the Makefile). diff --git a/ac/configure.ac b/ac/configure.ac index 071f43f5a9..16fa4b8939 100644 --- a/ac/configure.ac +++ b/ac/configure.ac @@ -51,7 +51,7 @@ AS_VAR_IF([MOM_MEMORY], [], ) # Confirm that MOM_MEMORY is named 'MOM_memory.h' -AS_IF([test $(basename "${MOM_MEMORY}") == "MOM_memory.h"], [], +AS_IF([test $(basename "${MOM_MEMORY}") = "MOM_memory.h"], [], [AC_MSG_ERROR([MOM_MEMORY header ${MOM_MEMORY} must be named 'MOM_memory.h'])] ) @@ -138,31 +138,36 @@ AX_FC_CHECK_C_LIB([netcdf], [nc_create], [], [ ]) # Confirm that the Fortran compiler can link to the netCDF Fortran library. -# NOTE: -# - We test nf_create, rather than nf90_create, since AX_FC_CHECK_LIB can -# not currently probe the Fortran 90 interfaces. -# - nf-config does not have --libdir, so we parse the --flibs output. -AX_FC_CHECK_LIB([netcdff], [nf_create], [], [], [ - AS_UNSET([ax_fc_cv_lib_netcdff_nf_create]) - AC_PATH_PROG([NF_CONFIG], [nf-config]) - AS_IF([test -n "$NF_CONFIG"], [ - AC_SUBST([LDFLAGS], - ["$LDFLAGS $($NF_CONFIG --flibs | xargs -n1 | grep "^-L" | sort -u | xargs)"] +# NOTE: nf-config does not have --libdir, so we parse the --flibs output. +MOM6_FC_CHECK_LIB([netcdff], [nf90_create], [netcdf], [path,cmode,ncid], [rc], [ + character :: path + integer :: cmode, ncid, rc], + [], [ + AS_UNSET([mom6_fc_cv_lib_netcdff_nf90_create]) + AC_PATH_PROG([NF_CONFIG], [nf-config]) + AS_IF([test -n "$NF_CONFIG"], [ + AC_SUBST([LDFLAGS], + ["$LDFLAGS $($NF_CONFIG --flibs | xargs -n1 | grep "^-L" | sort -u | xargs)"] + ) + ], [ + AC_MSG_ERROR([Could not find nf-config.]) + ]) + MOM6_FC_CHECK_LIB([netcdff], [nf90_create], [netcdf], [path,cmode,ncid], [rc], [ + character :: path + integer :: cmode, ncid, rc], + [], [ + AC_MSG_ERROR([Could not find netCDF Fortran library.]) + ] ) - ], [ - AC_MSG_ERROR([Could not find nf-config.]) - ]) - AX_FC_CHECK_LIB([netcdff], [nf_create], [], [], [ - AC_MSG_ERROR([Could not find netCDF Fortran library.]) - ]) -]) + ] +) # Force 8-byte reals AX_FC_REAL8 -AS_IF( - [test "$enable_real8" != no], - [FCFLAGS="$FCFLAGS $REAL8_FCFLAGS"]) +AS_IF([test "$enable_real8" != no], + [FCFLAGS="$FCFLAGS $REAL8_FCFLAGS"] +) # OpenMP configuration @@ -177,8 +182,7 @@ m4_version_prereq([2.69], [AC_OPENMP], [ ]) # NOTE: Only apply OpenMP flags if explicitly enabled. -AS_IF( - [test "$enable_openmp" = yes], [ +AS_IF([test "$enable_openmp" = yes], [ FCFLAGS="$FCFLAGS $OPENMP_FCFLAGS" LDFLAGS="$LDFLAGS $OPENMP_FCFLAGS" ]) @@ -192,19 +196,22 @@ AX_FC_CHECK_MODULE([fms_mod], [], [ AX_FC_CHECK_MODULE([fms_mod], [AC_SUBST([FCFLAGS], ["-I${srcdir}/ac/deps/include $FCFLAGS"])], [AC_MSG_ERROR([Could not find fms_mod Fortran module.])], - [-I${srcdir}/ac/deps/include]) + [-I${srcdir}/ac/deps/include] + ) ]) # Test for fms_init to verify FMS library linking -AX_FC_CHECK_LIB([FMS], [fms_init], [fms_mod], +MOM6_FC_CHECK_LIB([FMS], [fms_init], [fms_mod], [], [], [], [], [ - AS_UNSET([ax_fc_cv_lib_FMS_fms_init]) - AX_FC_CHECK_LIB([FMS], [fms_init], [fms_mod], [ - AC_SUBST([LDFLAGS], ["-L${srcdir}/ac/deps/lib $LDFLAGS"]) - AC_SUBST([LIBS], ["-lFMS $LIBS"]) - ], - [AC_MSG_ERROR([Could not find FMS library.])], - [-L${srcdir}/ac/deps/lib]) + AS_UNSET([mom6_fc_cv_lib_FMS_fms_init]) + MOM6_FC_CHECK_LIB([FMS], [fms_init], [fms_mod], [], [], [], + [ + AC_SUBST([LDFLAGS], ["-L${srcdir}/ac/deps/lib $LDFLAGS"]) + AC_SUBST([LIBS], ["-lFMS $LIBS"]) + ], [ + AC_MSG_ERROR([Could not find FMS library.]) + ], [-L${srcdir}/ac/deps/lib] + ) ] ) @@ -231,7 +238,29 @@ AX_FC_CHECK_MODULE([fms2_io_mod], [ ]) -# Python interpreter test +# GSW configuration +AX_FC_CHECK_MODULE([gsw_mod_toolbox], [], [ + AC_MSG_ERROR([Could not find module gsw_mod_toolbox.]) +]) +MOM6_FC_CHECK_LIB([gsw], [gsw_rho], [gsw_mod_toolbox], [sa,ct,p], [rho], [], + [], [ + AC_MSG_ERROR([Could not find gsw_rho in gsw_mod_toolbox.]) + ] +) + + +# CVMix configuration +AX_FC_CHECK_MODULE([cvmix_utils], [], [ + AC_MSG_ERROR([Could not find module cvmix_utils.]) +]) +MOM6_FC_CHECK_LIB([cvmix], [cvmix_init_kpp], [cvmix_kpp], [], [], [], + [], [ + AC_MSG_ERROR([Could not find cvmix_update_wrap in cvmix_utils.]) + ] +) + + +## Python configuration # Declare the Python interpreter variable AC_ARG_VAR([PYTHON], [Python interpreter command]) @@ -255,14 +284,33 @@ AC_PATH_PROG([MAKEDEP], [makedep], [${srcdir}/ac/makedep]) AC_SUBST([MAKEDEP]) -# Generate source list and configure dependency command -AC_SUBST([SRC_DIRS], ["\\ +# Generate Makedep source list and configure dependency command +MAKEDEP_FLAGS="-e" + +# NOTE: Some pattern rules for this multiline flag constructor. +# - Previous args have no line continuation, so the next arg leads with `\\`. +# - Flag lines precede with a space ` -s` for syntax clarity. +EXCLUDE_DIRS="\\ + -s ${srcdir}/src/equation_of_state/TEOS10 \\ + -s ${srcdir}/src/parameterizations/CVmix" + +# TODO: This may be optional in the future, so we use AS_IF. +AS_IF([test -n "${EXCLUDE_DIRS}"], [ + MAKEDEP_FLAGS="${MAKEDEP_FLAGS} ${EXCLUDE_DIRS}" +]) + +SRC_DIRS="\\ ${srcdir}/src \\ ${MODEL_FRAMEWORK} \\ ${srcdir}/config_src/external \\ ${DRIVER_DIR} \\ - ${MOM_MEMORY_DIR}"] -) + ${MOM_MEMORY_DIR}" +MAKEDEP_FLAGS="${MAKEDEP_FLAGS} ${SRC_DIRS}" + +MAKEDEP_FLAGS="${MAKEDEP_FLAGS# }" +AC_SUBST([MAKEDEP_FLAGS]) + +# Add makedep to config.status AC_CONFIG_COMMANDS(Makefile.dep, [make depend]) diff --git a/ac/deps/.gitignore b/ac/deps/.gitignore index 8cfaa6ebcb..80256cfe1d 100644 --- a/ac/deps/.gitignore +++ b/ac/deps/.gitignore @@ -1,5 +1,7 @@ /bin/ /fms/ +/gsw/ +/cvmix/ /include/ /lib/ /mkmf/ diff --git a/ac/deps/Makefile b/ac/deps/Makefile index 01431cef8c..452369f93b 100644 --- a/ac/deps/Makefile +++ b/ac/deps/Makefile @@ -10,6 +10,12 @@ MAKEFLAGS += -R FMS_URL ?= https://github.com/NOAA-GFDL/FMS.git FMS_COMMIT ?= 2023.03 +GSW_URL ?= https://github.com/mom-ocean/GSW-Fortran.git +GSW_COMMIT ?= 29e64d652786e1d076a05128c920f394202bfe10 + +CVMIX_URL ?= https://github.com/mom-ocean/CVMix-src.git +CVMIX_COMMIT ?= 65ef5c73bc7f5663d5688f75c3855d431da4baea + # List of source files to link this Makefile's dependencies to model Makefiles # Assumes a depth of two, and the following extensions: F90 inc c h @@ -18,6 +24,8 @@ SOURCE = \ $(foreach ext,F90 inc c h,$(wildcard $(1)/*/*.$(ext) $(1)/*/*/*.$(ext))) FMS_SOURCE = $(call SOURCE,fms/src) +GSW_SOURCE = $(call SOURCE,gsw/src) +CVMIX_SOURCE = $(call SOURCE,CVMix-src/src/shared) # If `true`, print logs if an error is encountered. @@ -29,53 +37,66 @@ REPORT_ERROR_LOGS ?= .PHONY: all all: lib/libFMS.a +all: lib/libgsw.a +all: lib/libcvmix.a -#--- -# FMS build +# Library build rules template +# +# $(1): target library +# $(2): dependency label +# $(3): library source files +# $(4): library source URL +# $(5): library source commit -# NOTE: We emulate the automake `make install` stage by storing libFMS.a to -# ${srcdir}/deps/lib and copying module files to ${srcdir}/deps/include. -lib/libFMS.a: fms/build/libFMS.a - mkdir -p lib include - cp fms/build/libFMS.a lib/libFMS.a - cp fms/build/*.mod include +define LIB_RULES +lib/$(1): $(2)/build/$(1) + mkdir -p $$(@D) include/ + cp $$< $$@ + cp $$(dir $$<)/*.mod include/ -fms/build/libFMS.a: fms/build/Makefile - $(MAKE) -C fms/build libFMS.a +$(2)/build/$(1): $(2)/build/Makefile + $$(MAKE) -C $$(@D) $(1) -fms/build/Makefile: fms/build/Makefile.in fms/build/configure - cd $(@D) && { \ +$(2)/build/Makefile: $(2)/build/Makefile.in $(2)/build/configure + cd $$(@D) && { \ ./configure --srcdir=../src \ || { \ - if [ "${REPORT_ERROR_LOGS}" = true ]; then cat config.log ; fi ; \ + if [ "$${REPORT_ERROR_LOGS}" = true ]; then cat config.log ; fi ; \ false; \ } \ } -fms/build/Makefile.in: Makefile.fms.in | fms/build - cp Makefile.fms.in fms/build/Makefile.in +$(2)/build/Makefile.in: Makefile.$(2).in | $(2)/build + cp $$< $$@ + +$(2)/build/configure: $(2)/build/configure.ac $(3) | $(2)/src + autoreconf $$(@D) + +$(2)/build/configure.ac: configure.$(2).ac m4 | $(2)/build + cp $$< $$@ + cp -r m4 $$(@D) + +$(2)/build: + mkdir -p $$@ -fms/build/configure: fms/build/configure.ac $(FMS_SOURCE) | fms/src - autoreconf fms/build +$(2)/src: + git clone $(4) $$@ + git -C $$@ checkout $(5) -fms/build/configure.ac: configure.fms.ac m4 | fms/build - cp configure.fms.ac fms/build/configure.ac - cp -r m4 fms/build +endef -fms/build: - mkdir -p fms/build +$(eval $(call LIB_RULES,libFMS.a,fms,$(FMS_SOURCE),$(FMS_URL),$(FMS_COMMIT))) +$(eval $(call LIB_RULES,libgsw.a,gsw,$(GSW_SOURCE),$(GSW_URL),$(GSW_COMMIT))) +$(eval $(call LIB_RULES,libcvmix.a,cvmix,$(CVMIX_SOURCE),$(CVMIX_URL),$(CVMIX_COMMIT))) -fms/src: - git clone $(FMS_URL) $@ - git -C $@ checkout $(FMS_COMMIT) # Cleanup .PHONY: clean clean: - rm -rf fms/build lib include + rm -rf fms/build gsw/build cvmix/build lib include .PHONY: distclean distclean: clean - rm -rf fms + rm -rf fms gsw cvmix diff --git a/ac/deps/Makefile.cvmix.in b/ac/deps/Makefile.cvmix.in new file mode 100644 index 0000000000..b8254d9b11 --- /dev/null +++ b/ac/deps/Makefile.cvmix.in @@ -0,0 +1,30 @@ +# Makefile template for CVMix +# +# Compiler flags are configured by autoconf's configure script. +# +# Source code dependencies are configured by makedep and saved to Makefile.dep. + +FC = @FC@ +LD = @FC@ +AR = @AR@ +PYTHON = @PYTHON@ +MAKEDEP = @MAKEDEP@ + +DEFS = @DEFS@ +CPPFLAGS = @CPPFLAGS@ +FCFLAGS = @FCFLAGS@ +LDFLAGS = @LDFLAGS@ +LIBS = @LIBS@ +ARFLAGS = @ARFLAGS@ + +-include Makefile.dep + +# Generate Makefile from template +Makefile: Makefile.in config.status + ./config.status + + +.PHONY: depend +depend: Makefile.dep +Makefile.dep: + $(PYTHON) $(MAKEDEP) $(DEFS) -o Makefile.dep -e -x libcvmix.a @srcdir@/src/shared diff --git a/ac/deps/Makefile.gsw.in b/ac/deps/Makefile.gsw.in new file mode 100644 index 0000000000..5cbc14bbbe --- /dev/null +++ b/ac/deps/Makefile.gsw.in @@ -0,0 +1,30 @@ +# Makefile template for GSW +# +# Compiler flags are configured by autoconf's configure script. +# +# Source code dependencies are configured by makedep and saved to Makefile.dep. + +FC = @FC@ +LD = @FC@ +AR = @AR@ +PYTHON = @PYTHON@ +MAKEDEP = @MAKEDEP@ + +DEFS = @DEFS@ +CPPFLAGS = @CPPFLAGS@ +FCFLAGS = @FCFLAGS@ +LDFLAGS = @LDFLAGS@ +LIBS = @LIBS@ +ARFLAGS = @ARFLAGS@ + +-include Makefile.dep + +# Generate Makefile from template +Makefile: Makefile.in config.status + ./config.status + + +.PHONY: depend +depend: Makefile.dep +Makefile.dep: + $(PYTHON) $(MAKEDEP) $(DEFS) -o Makefile.dep -e -x libgsw.a @srcdir@ diff --git a/ac/deps/configure.cvmix.ac b/ac/deps/configure.cvmix.ac new file mode 100644 index 0000000000..9105a62ddd --- /dev/null +++ b/ac/deps/configure.cvmix.ac @@ -0,0 +1,82 @@ +# Autoconf configuration +AC_PREREQ([2.63]) + +AC_INIT( + [GSW], + [ ], + [https://github.com/TEOS-10/GSW-Fortran/issues]) + +# Validate srdcir and configure input +AC_CONFIG_SRCDIR([src/shared/cvmix_utils.F90]) +AC_CONFIG_MACRO_DIR([m4]) + + +# Standard Fortran configuration +AC_LANG([Fortran]) +AC_FC_SRCEXT([f90]) +AC_PROG_FC + + +# netCDF configuration + +# Check for netcdf.h header function declarations. +# If unavailable, then try to invoke nc-create. +AC_LANG_PUSH([C]) +AC_CHECK_HEADERS([netcdf.h], [], [ + AS_UNSET([ac_cv_header_netcdf_h]) + AC_PATH_PROG([NC_CONFIG], [nc-config]) + AS_IF([test -n "$NC_CONFIG"], [ + AC_SUBST([CPPFLAGS], ["$CPPFLAGS -I$($NC_CONFIG --includedir)"]) + ], + [AC_MSG_ERROR([Could not find nc-config.])] + ) + AC_CHECK_HEADERS([netcdf.h], [], [ + AC_MSG_ERROR([Could not find netcdf.h]) + ]) +]) +AC_LANG_POP([C]) + +# Search for the Fortran netCDF module, fallback to nf-config. +AX_FC_CHECK_MODULE([netcdf], [], [ + AS_UNSET([ax_fc_cv_mod_netcdf]) + AC_PATH_PROG([NF_CONFIG], [nf-config]) + AS_IF([test -n "$NF_CONFIG"], [ + AC_SUBST([FCFLAGS], ["$FCFLAGS -I$($NF_CONFIG --includedir)"]) + ], + [AC_MSG_ERROR([Could not find nf-config.])] + ) + AX_FC_CHECK_MODULE([netcdf], [], [ + AC_MSG_ERROR([Could not find netcdf module.]) + ]) +]) + + +# Verify that Python is available +AC_PATH_PROGS([PYTHON], [python python3 python2], [ + AC_MSG_ERROR([Could not find python.]) +]) +AC_ARG_VAR([PYTHON], [Python interpreter command]) + + +# Verify that makedep is available +AC_PATH_PROGS([MAKEDEP], [makedep], [], ["${PATH}:${srcdir}/../../.."]) +AS_IF([test -n "${MAKEDEP}"], [ + AC_SUBST([MAKEDEP]) +], [ + AC_MSG_ERROR(["Could not find makedep."]) +]) + + +# Autoconf does not configure the archiver (ar), as it is handled by Automake. +AR=ar +ARFLAGS=rv +AC_SUBST([AR]) +AC_SUBST([ARFLAGS]) + +AC_CONFIG_COMMANDS([Makefile.dep], [make depend]) + +AC_SUBST([CPPFLAGS]) + +# Prepare output +AC_CONFIG_FILES([Makefile]) +AC_OUTPUT diff --git a/ac/deps/configure.gsw.ac b/ac/deps/configure.gsw.ac new file mode 100644 index 0000000000..237ac74e0d --- /dev/null +++ b/ac/deps/configure.gsw.ac @@ -0,0 +1,82 @@ +# Autoconf configuration +AC_PREREQ([2.63]) + +AC_INIT( + [GSW], + [ ], + [https://github.com/TEOS-10/GSW-Fortran/issues]) + +# Validate srdcir and configure input +AC_CONFIG_SRCDIR([modules/gsw_mod_toolbox.f90]) +AC_CONFIG_MACRO_DIR([m4]) + + +# Standard Fortran configuration +AC_LANG([Fortran]) +AC_FC_SRCEXT([f90]) +AC_PROG_FC + + +# netCDF configuration + +# Check for netcdf.h header function declarations. +# If unavailable, then try to invoke nc-create. +AC_LANG_PUSH([C]) +AC_CHECK_HEADERS([netcdf.h], [], [ + AS_UNSET([ac_cv_header_netcdf_h]) + AC_PATH_PROG([NC_CONFIG], [nc-config]) + AS_IF([test -n "$NC_CONFIG"], [ + AC_SUBST([CPPFLAGS], ["$CPPFLAGS -I$($NC_CONFIG --includedir)"]) + ], + [AC_MSG_ERROR([Could not find nc-config.])] + ) + AC_CHECK_HEADERS([netcdf.h], [], [ + AC_MSG_ERROR([Could not find netcdf.h]) + ]) +]) +AC_LANG_POP([C]) + +# Search for the Fortran netCDF module, fallback to nf-config. +AX_FC_CHECK_MODULE([netcdf], [], [ + AS_UNSET([ax_fc_cv_mod_netcdf]) + AC_PATH_PROG([NF_CONFIG], [nf-config]) + AS_IF([test -n "$NF_CONFIG"], [ + AC_SUBST([FCFLAGS], ["$FCFLAGS -I$($NF_CONFIG --includedir)"]) + ], + [AC_MSG_ERROR([Could not find nf-config.])] + ) + AX_FC_CHECK_MODULE([netcdf], [], [ + AC_MSG_ERROR([Could not find netcdf module.]) + ]) +]) + + +# Verify that Python is available +AC_PATH_PROGS([PYTHON], [python python3 python2], [ + AC_MSG_ERROR([Could not find python.]) +]) +AC_ARG_VAR([PYTHON], [Python interpreter command]) + + +# Verify that makedep is available +AC_PATH_PROGS([MAKEDEP], [makedep], [], ["${PATH}:${srcdir}/../../.."]) +AS_IF([test -n "${MAKEDEP}"], [ + AC_SUBST([MAKEDEP]) +], [ + AC_MSG_ERROR(["Could not find makedep."]) +]) + + +# Autoconf does not configure the archiver (ar), as it is handled by Automake. +AR=ar +ARFLAGS=rv +AC_SUBST([AR]) +AC_SUBST([ARFLAGS]) + +AC_CONFIG_COMMANDS([Makefile.dep], [make depend]) + +AC_SUBST([CPPFLAGS]) + +# Prepare output +AC_CONFIG_FILES([Makefile]) +AC_OUTPUT diff --git a/ac/m4/mom6_fc_check_lib.m4 b/ac/m4/mom6_fc_check_lib.m4 new file mode 100644 index 0000000000..03f6496acb --- /dev/null +++ b/ac/m4/mom6_fc_check_lib.m4 @@ -0,0 +1,82 @@ +dnl MOM6_FC_CHECK_LIB(LIBRARY, PROCEDURE, +dnl [MODULE], [ARGS], [FUNC-RESULT], [DECLS], +dnl [ACTION-IF-FOUND], [ACTION-IF-NOT-FOUND], +dnl [OTHER-LDFLAGS], [OTHER-LIBS]) +dnl +dnl This macro checks if a Fortran library containing a designated function +dnl is available to the compiler. For the most part, this macro should behave +dnl like the Autoconf AC_CHECK_LIB macro. +dnl +dnl This macro differs from AC_CHECK_LIB, since it includes several additional +dnl arguments. Although the next four arguments are optional, they are +dnl required for many function tests. +dnl +dnl - MODULE specifies the Fortran module containing the procedure. +dnl +dnl - ARGS is used to specify any arguments of the procedure. +dnl +dnl - FUNC-RESULT, if set, identifies the procedure as a function rather than +dnl a subroutine, and specifies the function test result. +dnl +dnl - DECLS is used as a code block to explicitly declare variables, when +dnl implicit typing is not sufficient. +dnl +dnl The following argument has also been added. +dnl +dnl - OTHER-LDFLAGS allows specification of supplemental LDFLAGS arguments. +dnl This can be used, for example, to test for the library with different +dnl -L flags, or perhaps other ld configurations. +dnl +dnl Results are cached in the mom6_fc_cv_lib_LIBRARY_PROCEDURE variable. +dnl +AC_DEFUN([MOM6_FC_CHECK_LIB],[ + AS_VAR_PUSHDEF([mom6_fc_Lib], [mom6_fc_cv_lib_$1_$2]) + m4_ifval([$9], + [mom6_fc_lib_msg_LDFLAGS=" with $9"], + [mom6_fc_lib_msg_LDFLAGS=""] + ) + AC_CACHE_CHECK( + [for $2 in -l$1$mom6_fc_lib_msg_LDFLAGS], + [mom6_fc_Lib],[ + mom6_fc_check_lib_save_LDFLAGS=$LDFLAGS + LDFLAGS="$9 $LDFLAGS" + mom6_fc_check_lib_save_LIBS=$LIBS + LIBS="-l$1 $10 $LIBS" + AS_IF([test -n "$3"], + [mom6_fc_use_mod="use $3"], + [mom6_fc_use_mod=""] + ) + AS_IF([test -n "$5"], + [mom6_fc_proc="$5 = $2"], + [mom6_fc_proc="call $2"] + ) + AS_IF([test -n "$4"], + [mom6_fc_proc="${mom6_fc_proc}($4)"] + ) + AS_IF([test -n "$6"], + [mom6_fc_decls="$6"], + [mom6_fc_decls=""] + ) + AC_LANG_PUSH([Fortran]) + AC_LINK_IFELSE([dnl +dnl Begin 7-column code block +AC_LANG_PROGRAM([], [dnl + $mom6_fc_use_mod + $mom6_fc_decls + $mom6_fc_proc])dnl +dnl End code block + ], + [AS_VAR_SET([mom6_fc_Lib], [yes])], + [AS_VAR_SET([mom6_fc_Lib], [no])] + ) + AC_LANG_POP([Fortran]) + LIBS=$mom6_fc_check_lib_save_LIBS + LDFLAGS=$mom6_fc_check_lib_save_LDFLAGS + ] + ) + AS_VAR_IF([mom6_fc_Lib], [yes], + [m4_default([$7], [LIBS="-l$1 $LIBS"])], + [$8] + ) + AS_VAR_POPDEF([mom6_fc_Lib]) +]) From 0e9061eb0258c46204b50c37366768a9234f0155 Mon Sep 17 00:00:00 2001 From: Marshall Ward Date: Wed, 4 Feb 2026 13:44:58 -0500 Subject: [PATCH 54/64] ac: Configure use of pkg/ source `ac/deps/Makefile` and `.testing/Makefile` now provide optional configuration of a target `pkg/` directory, using the PKG macro. To build using the submodule source code, PKG is unset:: make -j In this case, symbolic links to `pkg/` are used to build CVMix and GSW libraries. Modifications to the equivalent files in `src/` will be seen by the library builds. Developers who prefer to edit symbolic links from rogue submodules can still work as before. To build using `libcvmix.a` and `libgsw.a`, unset `PKG`:: PKG= make -j or make -j PKG= To accommodate this, there are now explicit macros `MAKEDEP` to specify the path of `makedep`. This prevents some of the "pathing up" issues that should never have been used, and were exposed by the new symlinks in to `pkg/`. In just about every normal use case, these are pre-configured. Macros for Python and autoconf detection were also modified to check preset `PYTHON` and `MAKEDEP` settings before attempting to search `PATH`. Following autoconf convention, the preset values of `PYTHON` and `MAKEDEP` are not reported. --- .github/workflows/verify-linux.yml | 28 ++++++++++---------- .github/workflows/verify-macos.yml | 16 ++++++------ .testing/Makefile | 13 +++++++--- ac/configure.ac | 4 +-- ac/deps/Makefile | 41 +++++++++++++++++++++++------- ac/deps/configure.cvmix.ac | 25 ++++++++++++------ ac/deps/configure.fms.ac | 25 ++++++++++++------ ac/deps/configure.gsw.ac | 24 +++++++++++------ 8 files changed, 115 insertions(+), 61 deletions(-) diff --git a/.github/workflows/verify-linux.yml b/.github/workflows/verify-linux.yml index 2931c7fdc9..2d7bb6446e 100644 --- a/.github/workflows/verify-linux.yml +++ b/.github/workflows/verify-linux.yml @@ -54,8 +54,8 @@ jobs: - name: Compile dependencies run: | make -C .testing -j build/deps/lib/libFMS.a - make -C .testing -j build/deps/lib/libgsw.a - make -C .testing -j build/deps/lib/libcvmix.a + make -C .testing -j PKG= build/deps/lib/libgsw.a + make -C .testing -j PKG= build/deps/lib/libcvmix.a - name: Compile MOM6 with symmetric indexing run: make -C .testing -j build/symmetric/MOM6 @@ -80,8 +80,8 @@ jobs: - name: Compile dependencies run: | make -C .testing -j build/deps/lib/libFMS.a - make -C .testing -j build/deps/lib/libgsw.a - make -C .testing -j build/deps/lib/libcvmix.a + make -C .testing -j PKG= build/deps/lib/libgsw.a + make -C .testing -j PKG= build/deps/lib/libcvmix.a - name: Compile MOM6 with asymmetric indexing run: make -C .testing -j build/asymmetric/MOM6 @@ -106,8 +106,8 @@ jobs: - name: Compile dependencies run: | make -C .testing -j build/deps/lib/libFMS.a - make -C .testing -j build/deps/lib/libgsw.a - make -C .testing -j build/deps/lib/libcvmix.a + make -C .testing -j PKG= build/deps/lib/libgsw.a + make -C .testing -j PKG= build/deps/lib/libcvmix.a - name: Compile MOM6 with bit-reproducible optimization run: make -C .testing -j build/repro/MOM6 @@ -132,8 +132,8 @@ jobs: - name: Compile dependencies run: | make -C .testing -j build/deps/lib/libFMS.a - make -C .testing -j build/deps/lib/libgsw.a - make -C .testing -j build/deps/lib/libcvmix.a + make -C .testing -j PKG= build/deps/lib/libgsw.a + make -C .testing -j PKG= build/deps/lib/libcvmix.a - name: Compile MOM6 supporting OpenMP run: make -C .testing -j build/openmp/MOM6 @@ -190,8 +190,8 @@ jobs: - name: Compile dependencies run: | make -C .testing -j build/deps/lib/libFMS.a - make -C .testing -j build/deps/lib/libgsw.a - make -C .testing -j build/deps/lib/libcvmix.a + make -C .testing -j PKG= build/deps/lib/libgsw.a + make -C .testing -j PKG= build/deps/lib/libcvmix.a - name: Compile MOM6 with aggressive optimization run: make -C .testing -j build/opt/MOM6 @@ -265,8 +265,8 @@ jobs: - name: Compile dependencies run: | make -C .testing -j build/deps/lib/libFMS.a - make -C .testing -j build/deps/lib/libgsw.a - make -C .testing -j build/deps/lib/libcvmix.a + make -C .testing -j PKG= build/deps/lib/libgsw.a + make -C .testing -j PKG= build/deps/lib/libcvmix.a - name: Compile MOM6 with code coverage run: make -C .testing -j build/cov/MOM6 @@ -302,8 +302,8 @@ jobs: - name: Compile dependencies run: | make -C .testing -j build/deps/lib/libFMS.a - make -C .testing -j build/deps/lib/libgsw.a - make -C .testing -j build/deps/lib/libcvmix.a + make -C .testing -j PKG= build/deps/lib/libgsw.a + make -C .testing -j PKG= build/deps/lib/libcvmix.a - name: Compile MOM6 for the GFDL coupled driver run: make -C .testing -j check_mom6_api_coupled diff --git a/.github/workflows/verify-macos.yml b/.github/workflows/verify-macos.yml index f4f473290d..e58e824dde 100644 --- a/.github/workflows/verify-macos.yml +++ b/.github/workflows/verify-macos.yml @@ -22,8 +22,8 @@ jobs: - name: Compile dependencies run: | make -C .testing -j build/deps/lib/libFMS.a - make -C .testing -j build/deps/lib/libgsw.a - make -C .testing -j build/deps/lib/libcvmix.a + make -C .testing -j PKG= build/deps/lib/libgsw.a + make -C .testing -j PKG= build/deps/lib/libcvmix.a - name: Compile MOM6 with symmetric indexing run: make -C .testing -j build/symmetric/MOM6 @@ -48,8 +48,8 @@ jobs: - name: Compile dependencies run: | make -C .testing -j build/deps/lib/libFMS.a - make -C .testing -j build/deps/lib/libgsw.a - make -C .testing -j build/deps/lib/libcvmix.a + make -C .testing -j PKG= build/deps/lib/libgsw.a + make -C .testing -j PKG= build/deps/lib/libcvmix.a - name: Compile MOM6 with asymmetric indexing run: make -C .testing -j build/asymmetric/MOM6 @@ -74,8 +74,8 @@ jobs: - name: Compile dependencies run: | make -C .testing -j build/deps/lib/libFMS.a - make -C .testing -j build/deps/lib/libgsw.a - make -C .testing -j build/deps/lib/libcvmix.a + make -C .testing -j PKG= build/deps/lib/libgsw.a + make -C .testing -j PKG= build/deps/lib/libcvmix.a - name: Compile MOM6 with bit-reproducible optimization run: make -C .testing -j build/repro/MOM6 @@ -100,8 +100,8 @@ jobs: - name: Compile dependencies run: | make -C .testing -j build/deps/lib/libFMS.a - make -C .testing -j build/deps/lib/libgsw.a - make -C .testing -j build/deps/lib/libcvmix.a + make -C .testing -j PKG= build/deps/lib/libgsw.a + make -C .testing -j PKG= build/deps/lib/libcvmix.a - name: Compile MOM6 supporting OpenMP run: make -C .testing -j build/openmp/MOM6 diff --git a/.testing/Makefile b/.testing/Makefile index 0d80e28fde..f6a6f994ae 100644 --- a/.testing/Makefile +++ b/.testing/Makefile @@ -71,7 +71,8 @@ MAKEFLAGS += --no-builtin-variables .SUFFIXES: # Determine the MOM6 autoconf srcdir -AC_SRCDIR := $(dir $(abspath $(lastword $(MAKEFILE_LIST))))../ac +CODEBASE := $(dir $(abspath $(lastword $(MAKEFILE_LIST)))).. +AC_SRCDIR := $(CODEBASE)/ac # User-defined configuration -include config.mk @@ -144,6 +145,10 @@ BUILD ?= $(WORKSPACE)/build DEPS ?= $(BUILD)/deps WORK ?= $(WORKSPACE)/work +# External tools +MAKEDEP ?= $(abspath $(AC_SRCDIR)/makedep) +PKG ?= $(abspath $(CODEBASE)/pkg) + # Experiment configuration EXECS ?= symmetric/MOM6 asymmetric/MOM6 openmp/MOM6 CONFIGS ?= $(wildcard tc*) @@ -344,8 +349,8 @@ endif # Set up the FMS build environment variables DEPS_ENV = \ - PATH="${PATH}:$(realpath ../ac)" \ FCFLAGS="$(FCFLAGS_FMS)" \ + MAKEDEP=$(MAKEDEP) \ REPORT_ERROR_LOGS="$(REPORT_ERROR_LOGS)" # FMS @@ -362,7 +367,7 @@ $(DEPS)/configure.fms.ac: ../ac/deps/configure.fms.ac | $(DEPS) # GSW $(DEPS)/lib/libgsw.a: $(DEPS)/Makefile $(DEPS)/Makefile.gsw.in $(DEPS)/configure.gsw.ac $(DEPS)/m4 - $(DEPS_ENV) $(MAKE) -C $(DEPS) lib/libgsw.a + $(DEPS_ENV) PKG=$(PKG) $(MAKE) -C $(DEPS) lib/libgsw.a $(DEPS)/Makefile.gsw.in: ../ac/deps/Makefile.gsw.in | $(DEPS) cp ../ac/deps/Makefile.gsw.in $(DEPS)/Makefile.gsw.in @@ -373,7 +378,7 @@ $(DEPS)/configure.gsw.ac: ../ac/deps/configure.gsw.ac | $(DEPS) # CVMix $(DEPS)/lib/libcvmix.a: $(DEPS)/Makefile $(DEPS)/Makefile.cvmix.in $(DEPS)/configure.cvmix.ac $(DEPS)/m4 - $(DEPS_ENV) $(MAKE) -C $(DEPS) lib/libcvmix.a + $(DEPS_ENV) PKG=$(PKG) $(MAKE) -C $(DEPS) lib/libcvmix.a $(DEPS)/Makefile.cvmix.in: ../ac/deps/Makefile.cvmix.in | $(DEPS) cp ../ac/deps/Makefile.cvmix.in $(DEPS)/Makefile.cvmix.in diff --git a/ac/configure.ac b/ac/configure.ac index 16fa4b8939..5f60a4b7da 100644 --- a/ac/configure.ac +++ b/ac/configure.ac @@ -250,8 +250,8 @@ MOM6_FC_CHECK_LIB([gsw], [gsw_rho], [gsw_mod_toolbox], [sa,ct,p], [rho], [], # CVMix configuration -AX_FC_CHECK_MODULE([cvmix_utils], [], [ - AC_MSG_ERROR([Could not find module cvmix_utils.]) +AX_FC_CHECK_MODULE([cvmix_kpp], [], [ + AC_MSG_ERROR([Could not find module cvmix_kpp.]) ]) MOM6_FC_CHECK_LIB([cvmix], [cvmix_init_kpp], [cvmix_kpp], [], [], [], [], [ diff --git a/ac/deps/Makefile b/ac/deps/Makefile index 452369f93b..93f3e588db 100644 --- a/ac/deps/Makefile +++ b/ac/deps/Makefile @@ -32,6 +32,10 @@ CVMIX_SOURCE = $(call SOURCE,CVMix-src/src/shared) REPORT_ERROR_LOGS ?= +# If set, use the submodule repositories in pkg/ +PKG ?= $(abspath ../../pkg) +MAKEDEP ?= $(abspath ../makedep) + #--- # Rules @@ -46,8 +50,6 @@ all: lib/libcvmix.a # $(1): target library # $(2): dependency label # $(3): library source files -# $(4): library source URL -# $(5): library source commit define LIB_RULES lib/$(1): $(2)/build/$(1) @@ -60,6 +62,7 @@ $(2)/build/$(1): $(2)/build/Makefile $(2)/build/Makefile: $(2)/build/Makefile.in $(2)/build/configure cd $$(@D) && { \ + MAKEDEP=$$(MAKEDEP) \ ./configure --srcdir=../src \ || { \ if [ "$${REPORT_ERROR_LOGS}" = true ]; then cat config.log ; fi ; \ @@ -79,16 +82,36 @@ $(2)/build/configure.ac: configure.$(2).ac m4 | $(2)/build $(2)/build: mkdir -p $$@ +endef -$(2)/src: - git clone $(4) $$@ - git -C $$@ checkout $(5) +$(eval $(call LIB_RULES,libFMS.a,fms,$(FMS_SOURCE))) +$(eval $(call LIB_RULES,libgsw.a,gsw,$(GSW_SOURCE))) +$(eval $(call LIB_RULES,libcvmix.a,cvmix,$(CVMIX_SOURCE))) -endef -$(eval $(call LIB_RULES,libFMS.a,fms,$(FMS_SOURCE),$(FMS_URL),$(FMS_COMMIT))) -$(eval $(call LIB_RULES,libgsw.a,gsw,$(GSW_SOURCE),$(GSW_URL),$(GSW_COMMIT))) -$(eval $(call LIB_RULES,libcvmix.a,cvmix,$(CVMIX_SOURCE),$(CVMIX_URL),$(CVMIX_COMMIT))) +# Dependency source + +fms/src: + git clone $(FMS_URL) $@ + git -C $@ checkout $(FMS_COMMIT) + + +ifdef PKG +gsw/src: | gsw/build + ln -s $(PKG)/GSW-Fortran gsw/src + +cvmix/src: | cvmix/build + ln -s $(PKG)/CVMix-src cvmix/src + +else +gsw/src: + git clone $(GSW_URL) $@ + git -C $@ checkout $(GSW_COMMIT) + +cvmix/src: + git clone $(CVMIX_URL) $@ + git -C $@ checkout $(CVMIX_COMMIT) +endif # Cleanup diff --git a/ac/deps/configure.cvmix.ac b/ac/deps/configure.cvmix.ac index 9105a62ddd..714ab803a4 100644 --- a/ac/deps/configure.cvmix.ac +++ b/ac/deps/configure.cvmix.ac @@ -11,7 +11,12 @@ AC_CONFIG_SRCDIR([src/shared/cvmix_utils.F90]) AC_CONFIG_MACRO_DIR([m4]) -# Standard Fortran configuration +# Build dependencies +AC_ARG_VAR([PYTHON], [Python interpreter command]) +AC_ARG_VAR([MAKEDEP], [Makefile dependency generator]) + + +# Fortran configuration AC_LANG([Fortran]) AC_FC_SRCEXT([f90]) AC_PROG_FC @@ -52,19 +57,23 @@ AX_FC_CHECK_MODULE([netcdf], [], [ # Verify that Python is available -AC_PATH_PROGS([PYTHON], [python python3 python2], [ +AS_IF([test -z "$PYTHON"], [ + AC_PATH_PROGS([PYTHON], [python python3 python2]) +]) +AS_IF([test -z "$PYTHON"], [ AC_MSG_ERROR([Could not find python.]) ]) -AC_ARG_VAR([PYTHON], [Python interpreter command]) +AC_SUBST([PYTHON]) # Verify that makedep is available -AC_PATH_PROGS([MAKEDEP], [makedep], [], ["${PATH}:${srcdir}/../../.."]) -AS_IF([test -n "${MAKEDEP}"], [ - AC_SUBST([MAKEDEP]) -], [ - AC_MSG_ERROR(["Could not find makedep."]) +AS_IF([test -z "$MAKEDEP"], [ + AC_PATH_PROG([MAKEDEP], [makedep]) +]) +AS_IF([test -z "$MAKEDEP"], [ + AC_MSG_ERROR([Could not find makedep.]) ]) +AC_SUBST([MAKEDEP]) # Autoconf does not configure the archiver (ar), as it is handled by Automake. diff --git a/ac/deps/configure.fms.ac b/ac/deps/configure.fms.ac index 7d68daa3c7..dfc7ad7a21 100644 --- a/ac/deps/configure.fms.ac +++ b/ac/deps/configure.fms.ac @@ -11,6 +11,11 @@ AC_CONFIG_SRCDIR([fms/fms.F90]) AC_CONFIG_MACRO_DIR([m4]) +# Build dependencies +AC_ARG_VAR([PYTHON], [Python interpreter command]) +AC_ARG_VAR([MAKEDEP], [Makefile dependency generator]) + + # C configuration # Autoconf assumes that LDFLAGS can be passed to CFLAGS, even though this is @@ -68,7 +73,7 @@ AC_CHECK_FUNCS([sched_getaffinity], [], [AC_DEFINE([__APPLE__])]) LDFLAGS="$FC_LDFLAGS" -# Standard Fortran configuration +# Fortran configuration AC_LANG([Fortran]) AC_FC_SRCEXT([f90]) AC_PROG_FC @@ -171,19 +176,23 @@ FCFLAGS="$FCFLAGS $ALLOW_ARG_MISMATCH_FCFLAGS" # Verify that Python is available -AC_PATH_PROGS([PYTHON], [python python3 python2], [ +AS_IF([test -z "$PYTHON"], [ + AC_PATH_PROGS([PYTHON], [python python3 python2]) +]) +AS_IF([test -z "$PYTHON"], [ AC_MSG_ERROR([Could not find python.]) ]) -AC_ARG_VAR([PYTHON], [Python interpreter command]) +AC_SUBST([PYTHON]) # Verify that makedep is available -AC_PATH_PROGS([MAKEDEP], [makedep], [], ["${PATH}:${srcdir}/../../.."]) -AS_IF([test -n "${MAKEDEP}"], [ - AC_SUBST([MAKEDEP]) -], [ - AC_MSG_ERROR(["Could not find makedep."]) +AS_IF([test -z "$MAKEDEP"], [ + AC_PATH_PROG([MAKEDEP], [makedep]) +]) +AS_IF([test -z "$MAKEDEP"], [ + AC_MSG_ERROR([Could not find makedep.]) ]) +AC_SUBST([MAKEDEP]) # Autoconf does not configure the archiver (ar), as it is handled by Automake. diff --git a/ac/deps/configure.gsw.ac b/ac/deps/configure.gsw.ac index 237ac74e0d..be61eb7040 100644 --- a/ac/deps/configure.gsw.ac +++ b/ac/deps/configure.gsw.ac @@ -10,8 +10,12 @@ AC_INIT( AC_CONFIG_SRCDIR([modules/gsw_mod_toolbox.f90]) AC_CONFIG_MACRO_DIR([m4]) +# Dependency configuration +AC_ARG_VAR([PYTHON], [Python interpreter command]) +AC_ARG_VAR([MAKEDEP], [Makefile dependency generator]) + -# Standard Fortran configuration +# Fortran compiler test AC_LANG([Fortran]) AC_FC_SRCEXT([f90]) AC_PROG_FC @@ -52,19 +56,23 @@ AX_FC_CHECK_MODULE([netcdf], [], [ # Verify that Python is available -AC_PATH_PROGS([PYTHON], [python python3 python2], [ +AS_IF([test -z "$PYTHON"], [ + AC_PATH_PROGS([PYTHON], [python python3 python2]) +]) +AS_IF([test -z "$PYTHON"], [ AC_MSG_ERROR([Could not find python.]) ]) -AC_ARG_VAR([PYTHON], [Python interpreter command]) +AC_SUBST([PYTHON]) # Verify that makedep is available -AC_PATH_PROGS([MAKEDEP], [makedep], [], ["${PATH}:${srcdir}/../../.."]) -AS_IF([test -n "${MAKEDEP}"], [ - AC_SUBST([MAKEDEP]) -], [ - AC_MSG_ERROR(["Could not find makedep."]) +AS_IF([test -z "$MAKEDEP"], [ + AC_PATH_PROG([MAKEDEP], [makedep]) +]) +AS_IF([test -z "$MAKEDEP"], [ + AC_MSG_ERROR([Could not find makedep.]) ]) +AC_SUBST([MAKEDEP]) # Autoconf does not configure the archiver (ar), as it is handled by Automake. From ae752b682c6040fad60e97c69398fd50e7923537 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Wed, 4 Feb 2026 19:38:46 -0500 Subject: [PATCH 55/64] Deleted about 170 unused internal variables Eliminated about 170 unused internal variables scattered across 26 files. Most of these were deleted outright, but a few that are associated with commented out blocks of code were just commented out. All answers are bitwise identical. --- src/core/MOM.F90 | 12 +++--------- src/core/MOM_CoriolisAdv.F90 | 4 +--- src/core/MOM_PressureForce_FV.F90 | 14 ++------------ src/core/MOM_barotropic.F90 | 18 ++---------------- src/core/MOM_continuity_PPM.F90 | 1 - src/core/MOM_dynamics_split_RK2b.F90 | 13 +++++-------- src/core/MOM_forcing_type.F90 | 4 ++-- src/core/MOM_open_boundary.F90 | 14 ++++---------- src/diagnostics/MOM_diagnostics.F90 | 1 - src/diagnostics/MOM_wave_speed.F90 | 3 --- src/equation_of_state/MOM_EOS.F90 | 7 ------- .../MOM_shared_initialization.F90 | 1 - .../MOM_state_initialization.F90 | 6 ------ .../lateral/MOM_Zanna_Bolton.F90 | 15 ++++----------- .../lateral/MOM_interface_filter.F90 | 2 -- .../lateral/MOM_internal_tides.F90 | 16 ++++------------ .../lateral/MOM_lateral_mixing_coeffs.F90 | 7 +++---- .../lateral/MOM_mixed_layer_restrat.F90 | 9 +++------ .../lateral/MOM_thickness_diffuse.F90 | 12 +++--------- .../vertical/MOM_ALE_sponge.F90 | 1 - .../vertical/MOM_CVMix_KPP.F90 | 1 - .../vertical/MOM_bkgnd_mixing.F90 | 3 --- .../vertical/MOM_diabatic_driver.F90 | 8 ++------ .../vertical/MOM_energetic_PBL.F90 | 9 ++------- .../vertical/MOM_set_viscosity.F90 | 2 +- .../vertical/MOM_vert_friction.F90 | 4 ++-- 26 files changed, 43 insertions(+), 144 deletions(-) diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index 2350791f4d..fc5acc1c02 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -1597,13 +1597,11 @@ subroutine step_MOM_thermo(CS, G, GV, US, u, v, h, tv, fluxes, dtdia, & logical :: debug_redundant ! If true, check redundant values on PE boundaries when debugging. logical :: showCallTree - type(group_pass_type) :: pass_T_S, pass_T_S_h, pass_uv_T_S_h + type(group_pass_type) :: pass_T_S integer :: dynamics_stencil ! The computational stencil for the calculations ! in the dynamic core. integer :: halo_sz ! The size of a halo where data must be valid. - integer :: i, j, k, is, ie, js, je, nz - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke showCallTree = callTree_showQuery() if (showCallTree) call callTree_enter("step_MOM_thermo(), MOM.F90") if (CS%debug) call query_debugging_checks(do_redundant=debug_redundant) @@ -1764,9 +1762,7 @@ subroutine ALE_regridding_and_remapping(CS, G, GV, US, u, v, h, tv, dtdia, Time_ logical :: use_ice_shelf ! Needed for selecting the right ALE interface. logical :: debug_redundant ! If true, check redundant values on PE boundaries when debugging. logical :: showCallTree - type(group_pass_type) :: pass_T_S, pass_T_S_h, pass_uv_T_S_h - integer :: dynamics_stencil ! The computational stencil for the calculations - ! in the dynamic core. + type(group_pass_type) :: pass_T_S_h integer :: i, j, k, is, ie, js, je, nz is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke @@ -1929,12 +1925,10 @@ subroutine post_diabatic_halo_updates(CS, G, GV, US, u, v, h, tv) logical :: debug_redundant ! If true, check redundant values on PE boundaries when debugging. logical :: showCallTree - type(group_pass_type) :: pass_T_S, pass_T_S_h, pass_uv_T_S_h + type(group_pass_type) :: pass_uv_T_S_h integer :: dynamics_stencil ! The computational stencil for the calculations ! in the dynamic core. - integer :: i, j, k, is, ie, js, je, nz - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke showCallTree = callTree_showQuery() if (showCallTree) call callTree_enter("post_diabatic_halo_updates, MOM.F90") if (CS%debug) call query_debugging_checks(do_redundant=debug_redundant) diff --git a/src/core/MOM_CoriolisAdv.F90 b/src/core/MOM_CoriolisAdv.F90 index 688f834cb1..6e491c676c 100644 --- a/src/core/MOM_CoriolisAdv.F90 +++ b/src/core/MOM_CoriolisAdv.F90 @@ -246,9 +246,7 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS, pbv, Wav logical :: Stokes_VF real :: u_v, v_u ! u_v is the u velocity at v point, v_u is the v velocity at u point [L T-1 ~> m s-1] real :: q_v, q_u ! PV at the u and v points [H-1 T-1 ~> m-1 s-1 or m2 kg-1 s-1] - real :: h_v, h_u ! h_v is the thickness at v point, h_u is the thickness at u point [H ~> m or kg m-2] - integer :: seventh_order, fifth_order, third_order, second_order ! Order of accuracy for the WENO calculations - real :: psi ! Ratio of PV gradient for the Koren limiter [nondim] + integer :: seventh_order, fifth_order, third_order ! Order of accuracy for the WENO calculations real :: u_q8(8) ! Eight-point zonal velocity at WENO stencils [L T-1 ~> m s-1] real :: u_q6(6) ! Six-point zonal velocity at WENO stencils [L T-1 ~> m s-1] real :: u_q4(4) ! Four-point zonal velocity at WENO stencils [L T-1 ~> m s-1] diff --git a/src/core/MOM_PressureForce_FV.F90 b/src/core/MOM_PressureForce_FV.F90 index 6a16392c3a..b8cc03f405 100644 --- a/src/core/MOM_PressureForce_FV.F90 +++ b/src/core/MOM_PressureForce_FV.F90 @@ -184,8 +184,7 @@ subroutine PressureForce_FV_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, AD inty_dza ! The change in inty_za through a layer [L2 T-2 ~> m2 s-2]. real, dimension(SZI_(G),SZJ_(G)) :: & T_top, & ! Temperature of top layer used with correction_intxpa [C ~> degC] - S_top, & ! Salinity of top layer used with correction_intxpa [S ~> ppt] - SpV_top ! Specific volume anomaly of top layer used with correction_intxpa [R-1 ~> m3 kg-1] + S_top ! Salinity of top layer used with correction_intxpa [S ~> ppt] real, dimension(SZIB_(G),SZJ_(G)) :: & intx_za_cor ! Correction for curvature in intx_za [L2 T-2 ~> m2 s-2] real, dimension(SZI_(G),SZJB_(G)) :: & @@ -197,8 +196,6 @@ subroutine PressureForce_FV_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, AD T_int_W, T_int_E, & ! Temperatures on the reference interface to the east and west of a u-point [C ~> degC] S_int_W, S_int_E, & ! Salinities on the reference interface to the east and west of a u-point [S ~> ppt] p_int_W, p_int_E, & ! Pressures on the reference interface to the east and west of a u-point [R L2 T-2 ~> Pa] - SpV_x_W, SpV_x_E, & ! Specific volume anomalies on the reference interface to the east and west - ! of a u-point [R-1 ~> m3 kg-1] intx_za_nonlin, & ! Deviations in the previous version of intx_pa for the reference interface ! from the value that would be obtained from assuming that pressure varies ! linearly with depth along that interface [R L2 T-2 ~> Pa]. @@ -208,8 +205,6 @@ subroutine PressureForce_FV_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, AD T_int_S, T_int_N, & ! Temperatures on the reference interface to the north and south of a v-point [C ~> degC] S_int_S, S_int_N, & ! Salinities on the reference interface to the north and south of a v-point [S ~> ppt] p_int_S, p_int_N, & ! Pressures on the reference interface to the north and south of a v-point [R L2 T-2 ~> Pa] - SpV_y_S, SpV_y_N, & ! Specific volume anomalies on the reference interface to the north and south - ! of a v-point [R L2 T-2 ~> Pa] inty_za_nonlin, & ! Deviations in the previous version of intx_pa for the reference interface ! from the value that would be obtained from assuming that pressure varies ! linearly with depth along that interface [L2 T-2 ~> m2 s-2]. @@ -1016,8 +1011,6 @@ subroutine PressureForce_FV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, ADp, T_int_W, T_int_E, & ! Temperatures on the reference interface to the east and west of a u-point [C ~> degC] S_int_W, S_int_E, & ! Salinities on the reference interface to the east and west of a u-point [S ~> ppt] p_int_W, p_int_E, & ! Pressures on the reference interface to the east and west of a u-point [R L2 T-2 ~> Pa] - rho_x_W, rho_x_E, & ! Density anomalies on the reference interface to the east and west - ! of a u-point [R ~> kg m-3] intx_pa_nonlin, & ! Deviations in the previous version of intx_pa for the reference interface ! from the value that would be obtained from assuming that pressure varies ! linearly with depth along that interface [R L2 T-2 ~> Pa]. @@ -1027,8 +1020,6 @@ subroutine PressureForce_FV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, ADp, T_int_S, T_int_N, & ! Temperatures on the reference interface to the north and south of a v-point [C ~> degC] S_int_S, S_int_N, & ! Salinities on the reference interface to the north and south of a v-point [S ~> ppt] p_int_S, p_int_N, & ! Pressures on the reference interface to the north and south of a v-point [R L2 T-2 ~> Pa] - rho_y_S, rho_y_N, & ! Density anomalies on the reference interface to the north and south - ! of a v-point [R ~> kg m-3] inty_pa_nonlin, & ! Deviations in the previous version of intx_pa for the reference interface ! from the value that would be obtained from assuming that pressure varies ! linearly with depth along that interface [R L2 T-2 ~> Pa]. @@ -1108,7 +1099,7 @@ subroutine PressureForce_FV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, ADp, integer, dimension(2) :: EOSdom_u ! The i-computational domain for the equation of state at u-velocity points integer, dimension(2) :: EOSdom_v ! The i-computational domain for the equation of state at v-velocity points integer :: is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz, nkmb - integer :: i, j, k, m, k2 + integer :: i, j, k, m is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke nkmb=GV%nk_rho_varies @@ -2045,7 +2036,6 @@ subroutine PressureForce_FV_init(Time, G, GV, US, param_file, diag, CS, ADp, SAL logical :: useMassWghtInterp ! If true, use near-bottom mass weighting for T and S logical :: MassWghtInterpTop ! If true, use near-surface mass weighting for T and S under ice shelves logical :: MassWghtInterp_NonBous_bug ! If true, use a buggy mass weighting when non-Boussinesq - logical :: MassWghtInterpVanOnly ! If true, turn of mass weighting unless one side is vanished logical :: enable_bugs ! If true, the defaults for recently added bug-fix flags are set to ! recreate the bugs, or if false bugs are only used if actively selected. ! This include declares and sets the variable "version". diff --git a/src/core/MOM_barotropic.F90 b/src/core/MOM_barotropic.F90 index 3d4e5a3e65..095e639845 100644 --- a/src/core/MOM_barotropic.F90 +++ b/src/core/MOM_barotropic.F90 @@ -600,13 +600,9 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, uhbt0, & ! The difference between the sum of the layer zonal thickness ! fluxes and the barotropic thickness flux using the same ! velocity [H L2 T-1 ~> m3 s-1 or kg s-1]. - ubt_prev, & ! The starting value of ubt in a barotropic step [L T-1 ~> m s-1]. ubt_first, & ! The starting value of ubt in a series of barotropic steps [L T-1 ~> m s-1]. - ubt_trans, & ! The latest value of ubt used for a transport [L T-1 ~> m s-1]. - Cor_u, & ! The zonal Coriolis acceleration [L T-2 ~> m s-2]. Cor_ref_u, & ! The zonal barotropic Coriolis acceleration due ! to the reference velocities [L T-2 ~> m s-2]. - PFu, & ! The zonal pressure force acceleration [L T-2 ~> m s-2]. Rayleigh_u, & ! A Rayleigh drag timescale operating at u-points for drag parameterizations ! that introduced directly into the barotropic solver rather than coming in via ! the visc_rem_u arrays from the layered equations [T-1 ~> s-1]. @@ -627,13 +623,9 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, vhbt0, & ! The difference between the sum of the layer meridional ! thickness fluxes and the barotropic thickness flux using ! the same velocities [H L2 T-1 ~> m3 s-1 or kg s-1]. - vbt_prev, & ! The starting value of vbt in a barotropic step [L T-1 ~> m s-1]. vbt_first, & ! The starting value of vbt in a series of barotropic steps [L T-1 ~> m s-1]. - vbt_trans, & ! The latest value of vbt used for a transport [L T-1 ~> m s-1]. - Cor_v, & ! The meridional Coriolis acceleration [L T-2 ~> m s-2]. Cor_ref_v, & ! The meridional barotropic Coriolis acceleration due ! to the reference velocities [L T-2 ~> m s-2]. - PFv, & ! The meridional pressure force acceleration [L T-2 ~> m s-2]. Rayleigh_v, & ! A Rayleigh drag timescale operating at v-points for drag parameterizations ! that introduced directly into the barotropic solver rather than coming ! in via the visc_rem_v arrays from the layered equations [T-1 ~> s-1]. @@ -662,9 +654,8 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, real, dimension(SZI_(G),SZJB_(G)) :: Drag_v ! The meridional acceleration due to frequency-dependent drag [L T-2 ~> m s-2] real, target, dimension(SZIW_(CS),SZJW_(CS)) :: & - eta, & ! The barotropic free surface height anomaly or column mass + eta ! The barotropic free surface height anomaly or column mass ! anomaly [H ~> m or kg m-2] - eta_pred ! A predictor value of eta [H ~> m or kg m-2] like eta. real, dimension(SZIW_(CS),SZJW_(CS)) :: & eta_sum, & ! eta summed across the timesteps [H ~> m or kg m-2]. eta_wtd, & ! A weighted estimate used to calculate eta_out [H ~> m or kg m-2]. @@ -694,7 +685,6 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, ! End of wide-sized variables. real :: visc_rem ! A work variable that may equal visc_rem_[uv] [nondim] - real :: vel_prev ! The previous velocity [L T-1 ~> m s-1]. real :: dtbt ! The barotropic time step [T ~> s]. real :: Idt ! The inverse of dt [T-1 ~> s-1]. real :: det_de ! The partial derivative due to self-attraction and loading @@ -755,13 +745,11 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, logical :: apply_OBCs, apply_OBC_flather type(memory_size_type) :: MS character(len=200) :: mesg - integer :: isv, iev, jsv, jev ! The valid array size at the end of a step. integer :: stencil ! The stencil size of the algorithm, often 1 or 2. integer :: isvf, ievf, jsvf, jevf, num_cycles integer :: i, j, k, n integer :: is, ie, js, je, nz, Isq, Ieq, Jsq, Jeq integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB - integer :: l_seg if (.not.CS%module_is_initialized) call MOM_error(FATAL, & "btstep: Module MOM_barotropic must be initialized before it is used.") @@ -3057,7 +3045,7 @@ subroutine btstep_find_Cor(q, DCor_u, DCor_v, f_4_u, f_4_v, isvf, ievf, jsvf, je integer, intent(in) :: jsvf !< The starting j-index of the largest valid range for tracer points integer, intent(in) :: jevf !< The ending j-index of the largest valid range for tracer points - real :: C1_3 ! One third [nondim] + ! real :: C1_3 ! One third [nondim] integer :: i, j if (CS%Sadourny) then @@ -3548,7 +3536,6 @@ subroutine btloop_update_u(dtbt, ubt, vbt, u_accel_bt, & type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type ! Local variables - real :: vel_prev ! The previous velocity [L T-1 ~> m s-1]. integer :: i, j !$OMP do schedule(static) @@ -4605,7 +4592,6 @@ subroutine btcalc(h, G, GV, CS, h_u, h_v, may_use_default, OBC) logical :: use_default, test_dflt integer :: is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz, i, j, k - integer :: is_v, ie_v, Js_v, Je_v if (.not.CS%module_is_initialized) call MOM_error(FATAL, & "btcalc: Module MOM_barotropic must be initialized before it is used.") diff --git a/src/core/MOM_continuity_PPM.F90 b/src/core/MOM_continuity_PPM.F90 index d74fa23ad8..7e9bfe88ac 100644 --- a/src/core/MOM_continuity_PPM.F90 +++ b/src/core/MOM_continuity_PPM.F90 @@ -930,7 +930,6 @@ subroutine zonal_flux_layer(u, h, h_W, h_E, uh, duhdu, visc_rem, dt, G, US, j, & real :: curv_3 ! A measure of the thickness curvature over a grid length [H ~> m or kg m-2] real :: h_marg ! The marginal thickness of a flux [H ~> m or kg m-2]. integer :: i - integer :: l_seg logical :: local_open_BC local_open_BC = .false. diff --git a/src/core/MOM_dynamics_split_RK2b.F90 b/src/core/MOM_dynamics_split_RK2b.F90 index 9835c0c02e..192b9bc1c6 100644 --- a/src/core/MOM_dynamics_split_RK2b.F90 +++ b/src/core/MOM_dynamics_split_RK2b.F90 @@ -369,10 +369,10 @@ subroutine step_MOM_dyn_split_RK2b(u_av, v_av, h, tv, visc, Time_local, dt, forc ! saved for use in the Flather open boundary condition code [L T-1 ~> m s-1] ! GMM, TODO: make these allocatable? - real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)) :: uold ! u-velocity before vert_visc is applied, for fpmix - ! [L T-1 ~> m s-1] - real, dimension(SZI_(G),SZJB_(G),SZK_(GV)) :: vold ! v-velocity before vert_visc is applied, for fpmix - ! [L T-1 ~> m s-1] + ! real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)) :: uold ! u-velocity before vert_visc is applied, for fpmix + ! ! [L T-1 ~> m s-1] + ! real, dimension(SZI_(G),SZJB_(G),SZK_(GV)) :: vold ! v-velocity before vert_visc is applied, for fpmix + ! ! [L T-1 ~> m s-1] real :: pres_to_eta ! A factor that converts pressures to the units of eta ! [H T2 R-1 L-2 ~> m Pa-1 or kg m-2 Pa-1] real, pointer, dimension(:,:) :: & @@ -392,7 +392,7 @@ subroutine step_MOM_dyn_split_RK2b(u_av, v_av, h, tv, visc, Time_local, dt, forc uh_ptr => NULL(), & ! A pointer to a zonal volume or mass transport [H L2 T-1 ~> m3 s-1 or kg s-1] vh_ptr => NULL() ! A pointer to a meridional volume or mass transport [H L2 T-1 ~> m3 s-1 or kg s-1] - real, dimension(SZI_(G),SZJ_(G)) :: hbl ! Boundary layer depth from Cvmix [H ~> m or kg m-2] + ! real, dimension(SZI_(G),SZJ_(G)) :: hbl ! Boundary layer depth from Cvmix [H ~> m or kg m-2] real :: dt_pred ! The time step for the predictor part of the baroclinic time stepping [T ~> s]. real :: Idt_bc ! Inverse of the baroclinic timestep [T-1 ~> s-1] logical :: dyn_p_surf @@ -1186,7 +1186,6 @@ subroutine register_restarts_dyn_split_RK2b(HI, GV, US, param_file, CS, restart_ real, dimension(SZI_(HI),SZJB_(HI),SZK_(GV)), & target, intent(inout) :: vh !< merid volume or mass transport [H L2 T-1 ~> m3 s-1 or kg s-1] - character(len=40) :: mdl = "MOM_dynamics_split_RK2b" ! This module's name. type(vardesc) :: vd(2) character(len=48) :: thickness_units, flux_units @@ -1320,13 +1319,11 @@ subroutine initialize_dyn_split_RK2b(u, v, h, tv, uh, vh, eta, Time, G, GV, US, !! solver and Coriolis scheme. ! local variables - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: h_tmp ! A temporary copy of the layer thicknesses [H ~> m or kg m-2] character(len=40) :: mdl = "MOM_dynamics_split_RK2b" ! This module's name. ! This include declares and sets the variable "version". # include "version_variable.h" character(len=48) :: thickness_units, flux_units, eta_rest_name logical :: debug_truncations - logical :: read_uv, read_h2 logical :: enable_bugs ! If true, the defaults for recently added bug-fix flags are set to ! recreate the bugs, or if false bugs are only used if actively selected. logical :: visc_rem_bug ! Stores the value of runtime paramter VISC_REM_BUG. diff --git a/src/core/MOM_forcing_type.F90 b/src/core/MOM_forcing_type.F90 index f51ec928b6..6d36ab155d 100644 --- a/src/core/MOM_forcing_type.F90 +++ b/src/core/MOM_forcing_type.F90 @@ -1186,7 +1186,7 @@ subroutine find_ustar_fluxes(fluxes, tv, U_star, G, GV, US, halo, H_T_units) ! density [H2 Z-2 R-1 ~> m3 kg-1 or kg m-3] logical :: Z_T_units ! If true, U_star is returned in units of [Z T-1 ~> m s-1], otherwise it is ! returned in [H T-1 ~> m s-1 or kg m-2 s-1] - integer :: i, j, k, is, ie, js, je, hs + integer :: i, j, is, ie, js, je, hs hs = 0 ; if (present(halo)) hs = max(halo, 0) is = G%isc - hs ; ie = G%iec + hs ; js = G%jsc - hs ; je = G%jec + hs @@ -1251,7 +1251,7 @@ subroutine find_ustar_mech_forcing(forces, tv, U_star, G, GV, US, halo, H_T_unit ! the rescaled reference density [H2 Z-2 R-1 ~> m3 kg-1 or kg m-3] logical :: Z_T_units ! If true, U_star is returned in units of [Z T-1 ~> m s-1], otherwise it is ! returned in [H T-1 ~> m s-1 or kg m-2 s-1] - integer :: i, j, k, is, ie, js, je, hs + integer :: i, j, is, ie, js, je, hs hs = 0 ; if (present(halo)) hs = max(halo, 0) is = G%isc - hs ; ie = G%iec + hs ; js = G%jsc - hs ; je = G%jec + hs diff --git a/src/core/MOM_open_boundary.F90 b/src/core/MOM_open_boundary.F90 index 8de939756e..66b0d9f56d 100644 --- a/src/core/MOM_open_boundary.F90 +++ b/src/core/MOM_open_boundary.F90 @@ -514,12 +514,10 @@ subroutine open_boundary_config(G, US, param_file, OBC) character(len=200) :: config1 ! String for OBC_USER_CONFIG real :: Lscale_in, Lscale_out ! parameters controlling tracer values at the boundaries [L ~> m] integer :: default_answer_date ! The default setting for the various ANSWER_DATE flags. - logical :: check_remapping, force_bounds_in_subcell logical :: enable_bugs ! If true, the defaults for recently added bug-fix flags are set to ! recreate the bugs, or if false bugs are only used if actively selected. logical :: debugging_tests ! If true, do additional calls resetting values to help debug the performance ! of the open boundary condition code. - logical :: om4_remap_via_sub_cells ! If true, use the OM4 remapping algorithm ! This include declares and sets the variable "version". # include "version_variable.h" @@ -2494,7 +2492,7 @@ subroutine set_initialized_OBC_tracer_reservoirs(G, OBC, restart_CS) type(ocean_OBC_type), intent(in) :: OBC !< Open boundary control structure type(MOM_restart_CS), intent(inout) :: restart_CS !< MOM restart control structure character(len=12) :: x_var_name, y_var_name - integer :: i, j, k, m, n + integer :: m do m=1,OBC%ntr ! Set the names of the reservoirs for this tracer in the restart file @@ -4939,8 +4937,6 @@ subroutine segment_thickness_reservoir_init(GV, US, OBC, param_file) ! salinity, or other various units depending on what rescaling has occurred previously. integer :: nseg, m, isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB integer :: fd_id - character(len=256) :: mesg ! Message for error messages. - character(len=32) :: name type(OBC_segment_type), pointer :: segment => NULL() ! pointer to segment type list integer, save :: init_calls = 0 @@ -5198,8 +5194,8 @@ subroutine register_obgc_segments(GV, OBC, tr_Reg, param_file, tr_name) type(param_file_type), intent(in) :: param_file !< file to parse for model parameter values character(len=*), intent(in) :: tr_name !< Tracer name ! Local variables - integer :: isd, ied, IsdB, IedB, jsd, jed, JsdB, JedB, nz, nf, ntr_id, fd_id - integer :: i, j, k, n, m + integer :: ntr_id, fd_id + integer :: n, m type(OBC_segment_type), pointer :: segment => NULL() ! pointer to segment type list type(tracer_type), pointer :: tr_ptr => NULL() @@ -5424,7 +5420,6 @@ subroutine mask_outside_OBCs(G, US, param_file, OBC) ! Local variables integer :: i, j - integer :: l_seg logical :: fatal_error = .False. real :: min_depth ! The minimum depth for ocean points [Z ~> m] real :: mask_depth ! The masking depth for ocean points [Z ~> m] @@ -5944,7 +5939,7 @@ subroutine update_segment_thickness_reservoirs(G, GV, uhr, vhr, h, OBC) real :: fac1 ! The denominator of the expression for tracer updates [nondim] real :: I_scale ! The inverse of the scaling factor for the tracers. ! For salinity the units would be [ppt S-1 ~> 1] - integer :: i, j, k, m, n, nz, fd_id + integer :: i, j, k, n, nz, fd_id integer :: ishift, idir, jshift, jdir real :: resrv_lfac_out ! The reservoir inverse length scale scaling factor for the outward ! direction per field [nondim] @@ -7025,7 +7020,6 @@ subroutine chksum_OBC_segment_data(segment, GV, US, nk, nseg_out) real :: norm ! A sign change used when rotating a normal component [nondim] real :: tang ! A sign change used when rotating a tangential component [nondim] character(len=8) :: sn, segno - character(len=1024) :: mesg integer :: dir ! This indicates the internal logical orientation of a segment dir = segment%direction diff --git a/src/diagnostics/MOM_diagnostics.F90 b/src/diagnostics/MOM_diagnostics.F90 index c590b99501..b6ac8b772a 100644 --- a/src/diagnostics/MOM_diagnostics.F90 +++ b/src/diagnostics/MOM_diagnostics.F90 @@ -910,7 +910,6 @@ subroutine calculate_vertical_integrals(h, tv, p_surf, G, GV, US, CS) tr_int ! vertical integral of a tracer times density, ! (Rho_0 in a Boussinesq model) [Conc R Z ~> Conc kg m-2]. real :: tmp(SZI_(G),SZJ_(G),SZK_(GV)) ! Temporary array [defined at each usage] - real :: IG_Earth ! Inverse of gravitational acceleration [T2 Z L-2 ~> s2 m-1]. integer :: i, j, k, is, ie, js, je, nz integer, dimension(2) :: EOSdom ! The i-computational domain for the equation of state diff --git a/src/diagnostics/MOM_wave_speed.F90 b/src/diagnostics/MOM_wave_speed.F90 index 09bb083c72..025c25de06 100644 --- a/src/diagnostics/MOM_wave_speed.F90 +++ b/src/diagnostics/MOM_wave_speed.F90 @@ -884,9 +884,6 @@ subroutine wave_speeds(h, tv, G, GV, US, nmodes, cn, CS, w_struct, u_struct, u_s real :: mode_struct_sq(SZK_(GV)+1) ! The square of mode structure [nondim] real :: mode_struct_fder_sq(SZK_(GV)) ! The square of mode structure 1st derivative [Z-2 ~> m-2] - - real :: ms_min, ms_max ! The minimum and maximum mode structure values returned from tdma6 [L2 T-2 ~> m2 s-2] - real :: ms_sq ! The sum of the square of the values returned from tdma6 [L4 T-4 ~> m4 s-4] real :: w2avg ! A total for renormalization [H L4 T-4 ~> m5 s-4 or kg m2 s-4] real, parameter :: a_int = 0.5 ! Integral total for normalization [nondim] real :: renorm ! Normalization factor [T2 L-2 ~> s2 m-2] diff --git a/src/equation_of_state/MOM_EOS.F90 b/src/equation_of_state/MOM_EOS.F90 index 121bf88825..e8560d8ea2 100644 --- a/src/equation_of_state/MOM_EOS.F90 +++ b/src/equation_of_state/MOM_EOS.F90 @@ -418,7 +418,6 @@ subroutine calculate_spec_vol_array(T, S, pressure, specvol, start, npts, EOS, s real, optional, intent(in) :: scale !< A multiplicative factor by which to scale specific !! volume in combination with scaling stored in EOS [various] - real, dimension(size(specvol)) :: rho ! Density [kg m-3] integer :: j if (.not. allocated(EOS%type)) call MOM_error(FATAL, & @@ -853,8 +852,6 @@ subroutine calculate_density_derivs_scalar(T, S, pressure, drho_dT, drho_dS, EOS real :: pres(1) ! Pressure converted to [Pa] real :: Ta(1) ! Temperature converted to [degC] real :: Sa(1) ! Salinity converted to [ppt] - real :: dR_dT(1) ! A copy of drho_dT in mks units [kg m-3 degC-1] - real :: dR_dS(1) ! A copy of drho_dS in mks units [kg m-3 ppt-1] pres(1) = EOS%RL2_T2_to_Pa*pressure Ta(1) = EOS%C_to_degC * T @@ -1958,7 +1955,6 @@ subroutine abs_saln_to_prac_saln(S, prSaln, EOS, dom, scale) !! while the default is equivalent to EOS%ppt_to_S. ! Local variables - real, dimension(size(S)) :: Sa ! Salinity converted to [ppt] real :: S_scale ! A factor to convert practical salinity from ppt to the desired units [S PSU-1 ~> 1] real, parameter :: Sprac_Sref = (35.0/35.16504) ! The TEOS 10 conversion factor to go from ! reference salinity to practical salinity [PSU ppt-1] @@ -1999,7 +1995,6 @@ subroutine prac_saln_to_abs_saln(S, absSaln, EOS, dom, scale) !! while the default is equivalent to EOS%ppt_to_S. ! Local variables - real, dimension(size(S)) :: Sp ! Salinity converted to [ppt] real :: S_scale ! A factor to convert absolute salinity from ppt to the desired units [S ppt-1 ~> 1] real, parameter :: Sref_Sprac = (35.16504/35.0) ! The TEOS 10 conversion factor to go from ! practical salinity to reference salinity [PSU ppt-1] @@ -2188,7 +2183,6 @@ logical function test_TS_conversion_consistency(T_cons, S_abs, T_pot, S_prac, EO real :: Ttol ! Roundoff error on a typical value of temperatures [degC] logical :: test_OK ! True if a particular test is consistent. logical :: OK ! True if all checks so far are consistent. - integer :: i, j, n OK = .true. @@ -2236,7 +2230,6 @@ logical function test_TFr_consistency(S_test, p_test, EOS, verbose, EOS_name, TF real, dimension(-3:3,-3:3) :: S ! Salinities at the test value and perturbed points [S ~> ppt] real, dimension(-3:3,-3:3) :: P ! Pressures at the test value and perturbed points [R L2 T-2 ~> Pa] real, dimension(-3:3,-3:3,2) :: TFr ! Freezing point at the test value and perturbed points [C ~> degC] - character(len=200) :: mesg real :: dS ! Magnitude of salinity perturbations [S ~> ppt] real :: dp ! Magnitude of pressure perturbations [R L2 T-2 ~> Pa] ! real :: tol ! The nondimensional tolerance from roundoff [nondim] diff --git a/src/initialization/MOM_shared_initialization.F90 b/src/initialization/MOM_shared_initialization.F90 index 132dc069e7..08ee0f015d 100644 --- a/src/initialization/MOM_shared_initialization.F90 +++ b/src/initialization/MOM_shared_initialization.F90 @@ -146,7 +146,6 @@ subroutine set_meanSL_from_file(meanSL, G, param_file, US) type(param_file_type), intent(in) :: param_file !< Parameter file structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type ! Local variables - logical :: read_meanSL_file character(len=200) :: filename, file, inputdir ! Strings for file/path character(len=200) :: varname ! Variable name in file character(len=40) :: mdl = "set_meanSL_from_file" ! This subroutine's name. diff --git a/src/initialization/MOM_state_initialization.F90 b/src/initialization/MOM_state_initialization.F90 index b55dd4d05d..d72b843e2c 100644 --- a/src/initialization/MOM_state_initialization.F90 +++ b/src/initialization/MOM_state_initialization.F90 @@ -158,8 +158,6 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, US, PF, dirs, & real :: dz(SZI_(G),SZJ_(G),SZK_(GV)) ! The layer thicknesses in geopotential (z) units [Z ~> m] character(len=200) :: inputdir ! The directory where NetCDF input files are. character(len=200) :: config, h_config - real :: H_rescale ! A rescaling factor for thicknesses from the representation in - ! a restart file to the internal representation in this run [various units ~> 1] real :: dt ! The baroclinic dynamics timestep for this run [T ~> s]. logical :: from_Z_file, useALE @@ -2042,7 +2040,6 @@ subroutine initialize_sponges_file(G, GV, US, use_temperature, tv, u, v, depth_t ! Local variables real, allocatable, dimension(:,:,:) :: eta ! The target interface heights [Z ~> m]. real, allocatable, dimension(:,:,:) :: dz ! The target interface thicknesses in height units [Z ~> m] - real, allocatable, dimension(:,:,:) :: h ! The target interface thicknesses [H ~> m or kg m-2]. real, dimension (SZI_(G),SZJ_(G),SZK_(GV)) :: & tmp, & ! A temporary array for temperatures [C ~> degC] or other tracers. @@ -2645,11 +2642,8 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, depth_tot, G, GV, US, PF, just ! from data when finding the initial interface locations in ! layered mode from a dataset of T and S. character(len=64) :: remappingScheme - real :: tempAvg ! Spatially averaged temperatures on a layer [C ~> degC] - real :: saltAvg ! Spatially averaged salinities on a layer [S ~> ppt] logical :: om4_remap_via_sub_cells ! If true, use the OM4 remapping algorithm (only used if useALEremapping) logical :: do_conv_adj, ignore - integer :: nPoints integer :: id_clock_routine, id_clock_ALE id_clock_routine = cpu_clock_id('(Initialize from Z)', grain=CLOCK_ROUTINE) diff --git a/src/parameterizations/lateral/MOM_Zanna_Bolton.F90 b/src/parameterizations/lateral/MOM_Zanna_Bolton.F90 index 075ec9049c..831e10cbb9 100644 --- a/src/parameterizations/lateral/MOM_Zanna_Bolton.F90 +++ b/src/parameterizations/lateral/MOM_Zanna_Bolton.F90 @@ -444,14 +444,8 @@ subroutine ZB2020_lateral_stress(u, v, h, diffu, diffv, G, GV, CS, & real, dimension(SZIB_(G),SZJB_(G)), intent(in) :: dx2q !< dx^2 at q points [L2 ~> m2] real, dimension(SZIB_(G),SZJB_(G)), intent(in) :: dy2q !< dy^2 at q points [L2 ~> m2] - integer :: is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz - integer :: i, j, k, n - call cpu_clock_begin(CS%id_clock_module) - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke - Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB - ! Compute attenuation if specified call compute_c_diss(G, GV, CS) @@ -498,7 +492,7 @@ subroutine compute_c_diss(G, GV, CS) type(ZB2020_CS), intent(inout) :: CS !< ZB2020 control structure. integer :: is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz - integer :: i, j, k, n + integer :: i, j, k real :: shear ! Shear in Klower2018 formula at h points [T-1 ~> s-1] @@ -573,7 +567,7 @@ subroutine compute_stress(G, GV, CS) real :: vort_sh ! vort_xy*sh_xy in h point [T-2 ~> s-2] integer :: is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz - integer :: i, j, k, n + integer :: i, j, k logical :: sum_sq_flag ! Flag to compute trace logical :: vort_sh_scheme_0, vort_sh_scheme_1 ! Flags to compute diagonal trace-free part @@ -664,7 +658,7 @@ subroutine compute_stress_ANN_collocated(G, GV, CS) type(ZB2020_CS), intent(inout) :: CS !< ZB2020 control structure. integer :: is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz - integer :: i, j, k, n, m + integer :: i, j, k, m integer :: ii, jj integer :: nij @@ -676,7 +670,6 @@ subroutine compute_stress_ANN_collocated(G, GV, CS) ! (Txy,Txx,Tyy) [nondim] real :: yy(3) ! Vector of dimensional ! output features (Txy,Txx,Tyy) [L2 T-2 ~> m2 s-2] - real :: input_norm ! Norm of input features [T-1 ~> s-1] real :: tmp ! Temporal value of squared norm [T-2 ~> s-2] integer :: offset ! Half the stencil size. Used for selection integer :: stencil_points ! The number of points after flattening @@ -940,7 +933,7 @@ subroutine filter_velocity_gradients(G, GV, CS) integer :: niter ! required number of iterations integer :: is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz - integer :: i, j, k, n + integer :: i, j, k niter = CS%HPF_iter diff --git a/src/parameterizations/lateral/MOM_interface_filter.F90 b/src/parameterizations/lateral/MOM_interface_filter.F90 index d66341acf5..ec899f6533 100644 --- a/src/parameterizations/lateral/MOM_interface_filter.F90 +++ b/src/parameterizations/lateral/MOM_interface_filter.F90 @@ -383,9 +383,7 @@ subroutine interface_filter_init(Time, G, GV, US, param_file, diag, CDp, CS) character(len=40) :: mdl = "MOM_interface_filter" ! This module's name. ! This include declares and sets the variable "version". # include "version_variable.h" - real :: grid_sp ! The local grid spacing [L ~> m] real :: interface_filter_time ! The grid-scale interface height filtering timescale [T ~> s] - integer :: i, j CS%initialized = .true. CS%diag => diag diff --git a/src/parameterizations/lateral/MOM_internal_tides.F90 b/src/parameterizations/lateral/MOM_internal_tides.F90 index 73ff57adbc..3ddcecee37 100644 --- a/src/parameterizations/lateral/MOM_internal_tides.F90 +++ b/src/parameterizations/lateral/MOM_internal_tides.F90 @@ -338,15 +338,12 @@ subroutine propagate_int_tide(h, tv, Nb, Rho_bot, dt, G, GV, US, inttide_input_C real :: U_mag ! rescaled magnitude of horizontal profile [L Z T-1 ~> m2 s-1] real :: W0 ! rescaled magnitude of vertical profile [Z T-1 ~> m s-1] real :: c_phase ! The phase speed [L T-1 ~> m s-1] - real :: loss_rate ! An energy loss rate [T-1 ~> s-1] + ! real :: loss_rate ! An energy loss rate [T-1 ~> s-1] real :: Fr2_max ! The column maximum internal wave Froude number squared [nondim] real :: cn_subRO ! A tiny wave speed to prevent division by zero [L T-1 ~> m s-1] real :: en_subRO ! A tiny energy to prevent division by zero [H Z2 T-2 ~> m3 s-2 or J m-2] real :: En_a, En_b ! Energies for time stepping [H Z2 T-2 ~> m3 s-2 or J m-2] - real :: En_new, En_check ! Energies for debugging [H Z2 T-2 ~> m3 s-2 or J m-2] real :: En_sumtmp ! Energies for debugging [H Z2 L2 T-2 ~> m5 s-2 or J] - real :: En_initial, Delta_E_check ! Energies for debugging [H Z2 T-2 ~> m3 s-2 or J m-2] - real :: TKE_Froude_loss_check, TKE_Froude_loss_tot ! Energy losses for debugging [H Z2 T-3 ~> m3 s-3 or W m-2] real :: HZ2_T2_to_J_m2 ! unit conversion factor for Energy from internal units ! to mks [T2 kg H-1 Z-2 s-2 ~> kg m-3 or 1] real :: J_m2_to_HZ2_T2 ! unit conversion factor for Energy from mks to internal @@ -2105,8 +2102,6 @@ subroutine propagate(En, cn, freq, dt, G, GV, US, CS, NAngle, test, halo_size, r intent(inout) :: residual_loss !< internal tide energy loss due !! to the residual at slopes [H Z2 T-3 ~> m3 s-3 or W m-2]. ! Local variables - real, dimension(G%IsdB:G%IedB,G%JsdB:G%JedB) :: & - speed ! The magnitude of the group velocity at the q points for corner adv [L T-1 ~> m s-1]. integer, parameter :: stencil = 2 real, dimension(SZIB_(G),SZJ_(G)) :: & speed_x ! The magnitude of the group velocity at the Cu points [L T-1 ~> m s-1]. @@ -2648,7 +2643,6 @@ subroutine turning_latitude(En, NAngle, freq2, CS, G, LB) real, dimension(1:Nangle) :: En_reflected ! Energy reflected [H Z2 T-2 ~> m3 s-2 or J m-2]. real :: TwoPi ! 2*pi = 6.2831853... [nondim] - real :: Pi_2 ! pi/2 [nondim] real :: Angle_size ! size of beam wedge [rad] real :: I_Angle_size ! inverse of size of beam wedge [rad-1] real :: f2 @@ -3256,10 +3250,9 @@ subroutine register_int_tide_restarts(G, GV, US, param_file, CS, restart_CS) logical :: non_Bous ! If true, this run is fully non-Boussinesq logical :: Boussinesq ! If true, this run is fully Boussinesq logical :: semi_Boussinesq ! If true, this run is partially non-Boussinesq - logical :: use_int_tides - integer :: num_freq, num_angle , num_mode, period_1 - integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB, i, j, a, fr, m - character(64) :: var_name, cfr, units + integer :: num_freq, num_angle, num_mode + integer :: isd, ied, jsd, jed, i, j, a, fr, m + character(64) :: units type(axis_info) :: axes_inttides(2) real, dimension(:), allocatable :: angles, freqs ! Lables for angles and frequencies [nondim] @@ -3411,7 +3404,6 @@ subroutine internal_tides_init(Time, G, GV, US, param_file, diag, CS) real :: kappa_h2_factor ! A roughness scaling factor [nondim] real :: RMS_roughness_frac ! The maximum RMS topographic roughness as a fraction of the ! nominal ocean depth, or a negative value for no limit [nondim] - real :: period_1 ! The period of the gravest modeled mode [T ~> s] real :: period ! A tidal period read from namelist [T ~> s] real :: HZ2_T2_to_J_m2 ! unit conversion factor for Energy from internal units ! to mks [T2 kg H-1 Z-2 s-2 ~> kg m-3 or 1] diff --git a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 index 2a1bea4b0b..bcfabc6cc6 100644 --- a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 +++ b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 @@ -1052,7 +1052,7 @@ subroutine calc_Eady_growth_rate_2D(CS, G, GV, US, h, e, dzu, dzv, dzSxN, dzSyN, real :: dz_neglect ! A negligibly small distance to avoid division by zero [Z ~> m] real :: r_crp_dist ! The inverse of the distance over which to scale the cropping [Z-1 ~> m-1] real :: dB, dT ! Elevation variables used when cropping [Z ~> m] - integer :: i, j, k, l_seg + integer :: i, j, k logical :: crop dz_neglect = GV%dZ_subroundoff @@ -1073,7 +1073,7 @@ subroutine calc_Eady_growth_rate_2D(CS, G, GV, US, h, e, dzu, dzv, dzSxN, dzSyN, CS%SN_v(i,j) = 0.0 enddo ; enddo - !$OMP parallel do default(shared) private(dnew,dz,weight,l_seg,vint_SN,sum_dz,dT,dB) + !$OMP parallel do default(shared) private(dnew,dz,weight,vint_SN,sum_dz,dT,dB) do j=G%jsc-1,G%jec+1 do I=G%isc-1,G%iec vint_SN(I) = 0. @@ -1116,7 +1116,7 @@ subroutine calc_Eady_growth_rate_2D(CS, G, GV, US, h, e, dzu, dzv, dzSxN, dzSyN, enddo enddo - !$OMP parallel do default(shared) private(dnew,dz,weight,l_seg,vint_SN,sum_dz,dT,dB) + !$OMP parallel do default(shared) private(dnew,dz,weight,vint_SN,sum_dz,dT,dB) do J=G%jsc-1,G%jec do i=G%isc-1,G%iec+1 vint_SN(i) = 0. @@ -1212,7 +1212,6 @@ subroutine calc_slope_functions_using_just_e(h, G, GV, US, CS, e) ! bathymetric depth for certain calculations. integer :: is, ie, js, je, nz integer :: i, j, k - integer :: l_seg if (.not. CS%initialized) call MOM_error(FATAL, "calc_slope_functions_using_just_e: "// & "Module must be initialized before it is used.") diff --git a/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 b/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 index e03ad39296..ef1e8e7c38 100644 --- a/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 +++ b/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 @@ -243,7 +243,7 @@ subroutine mixedlayer_restrat_OM4(h, uhtr, vhtr, tv, forces, dt, h_MLD, VarMix, real :: h_min ! The minimum layer thickness [H ~> m or kg m-2]. h_min could be 0. real :: h_neglect ! tiny thickness usually lost in roundoff so can be neglected [H ~> m or kg m-2] real :: I4dt ! 1/(4 dt) [T-1 ~> s-1] - real :: Ihtot,Ihtot_slow! Inverses of the total mixed layer thickness [H-1 ~> m-1 or m2 kg-1] + real :: Ihtot, Ihtot_slow ! Inverses of the total mixed layer thickness [H-1 ~> m-1 or m2 kg-1] real :: a(SZK_(GV)) ! A non-dimensional value relating the overall flux ! magnitudes (uDml & vDml) to the realized flux in a ! layer [nondim]. The vertical sum of a() through the pieces of @@ -817,13 +817,12 @@ subroutine mixedlayer_restrat_Bodner(CS, G, GV, US, h, uhtr, vhtr, tv, forces, d real :: psi_mag ! Magnitude of stream function [L2 H T-1 ~> m3 s-1 or kg s-1] real :: h_neglect ! tiny thickness usually lost in roundoff so can be neglected [H ~> m or kg m-2] real :: I4dt ! 1/(4 dt) [T-1 ~> s-1] - real :: Ihtot,Ihtot_slow! Inverses of the total mixed layer thickness [H-1 ~> m-1 or m2 kg-1] + real :: Ihtot ! Inverses of the total mixed layer thickness [H-1 ~> m-1 or m2 kg-1] real :: hAtVel ! Thickness at the velocity points [H ~> m or kg m-2] real :: sigint ! Fractional position within the mixed layer of the interface above a layer [nondim] real :: muzb ! mu(z) at bottom of the layer [nondim] real :: muza ! mu(z) at top of the layer [nondim] real :: dh ! Portion of the layer thickness that is in the mixed layer [H ~> m or kg m-2] - real :: res_scaling_fac ! The resolution-dependent scaling factor [nondim] real :: Z3_T3_to_m3_s3 ! Conversion factors to undo scaling and permit terms to be raised to a ! fractional power [T3 m3 Z-3 s-3 ~> 1] real :: m2_s2_to_Z2_T2 ! Conversion factors to restore scaling after a term is raised to a @@ -1639,7 +1638,6 @@ logical function mixedlayer_restrat_init(Time, G, GV, US, param_file, diag, CS, character(len=32) :: fl_varname ! Name of front-length scale variable in mle_fl_file. # include "version_variable.h" - integer :: i, j character(len=200) :: filename, varname ! Read all relevant parameters and write them to the model log. @@ -2013,8 +2011,8 @@ end subroutine mixedlayer_restrat_register_restarts !! Returns false otherwise. logical function mixedlayer_restrat_unit_tests(verbose) logical, intent(in) :: verbose !< If true, write results to stdout + ! Local variables - type(mixedlayer_restrat_CS) :: CS ! Control structure logical :: this_test print *,'===== mixedlayer_restrat: mixedlayer_restrat_unit_tests ==================' @@ -2066,7 +2064,6 @@ logical function test_answer(verbose, u, u_true, label, tol) real, optional, intent(in) :: tol !< The tolerance for differences between u and u_true [A] ! Local variables real :: tolerance ! The tolerance for differences between u and u_true [A] - integer :: k tolerance = 0.0 ; if (present(tol)) tolerance = tol test_answer = .false. diff --git a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 index acd13d3492..7de1723543 100644 --- a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 +++ b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 @@ -783,14 +783,8 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV ! times unit conversion factors [L2 Z-2 T-2 ~> s-2] real :: N2_unlim ! An unlimited estimate of the buoyancy frequency ! times unit conversion factors [L2 Z-2 T-2 ~> s-2] - real :: Tl(5) ! copy of T in local stencil [C ~> degC] - real :: mn_T ! mean of T in local stencil [C ~> degC] - real :: mn_T2 ! mean of T**2 in local stencil [C2 ~> degC2] - real :: hl(5) ! Copy of local stencil of H [H ~> m] - real :: r_sm_H ! Reciprocal of sum of H in local stencil [H-1 ~> m-1] real :: Z_to_H ! A conversion factor from heights to thicknesses, perhaps based on ! a spatially variable local density [H Z-1 ~> nondim or kg m-3] - real :: Tsgs2(SZI_(G),SZJ_(G),SZK_(GV)) ! Sub-grid temperature variance [C2 ~> degC2] real :: diag_sfn_x(SZIB_(G),SZJ_(G),SZK_(GV)+1) ! Diagnostic of the x-face streamfunction ! [H L2 T-1 ~> m3 s-1 or kg s-1] real :: diag_sfn_unlim_x(SZIB_(G),SZJ_(G),SZK_(GV)+1) ! Diagnostic of the x-face streamfunction before @@ -858,7 +852,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV if (CS%use_FGNV_streamfn .and. .not. associated(cg1)) call MOM_error(FATAL, & "cg1 must be associated when using FGNV streamfunction.") - !$OMP parallel default(shared) private(hl,r_sm_H,Tl,mn_T,mn_T2) + !$OMP parallel default(shared) ! Find the maximum and minimum permitted streamfunction. !$OMP do do j=js-1,je+1 ; do i=is-1,ie+1 @@ -904,7 +898,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV !$OMP h_neglect2,hn_2,I_slope_max2,int_slope_u,KH_u,uhtot, & !$OMP h_frac,h_avail_rsum,uhD,h_avail,Work_u,CS,slope_x,cg1, & !$OMP diag_sfn_x,diag_sfn_unlim_x,N2_floor,EOSdom_u,EOSdom_h1, & - !$OMP use_stanley,Tsgs2,present_slope_x,G_rho0,Slope_x_PE,hN2_x_PE) & + !$OMP use_stanley,present_slope_x,G_rho0,Slope_x_PE,hN2_x_PE) & !$OMP private(drdiA,drdiB,drdkL,drdkR,pres_u,T_u,S_u,G_scale, & !$OMP drho_dT_u,drho_dS_u,hg2A,hg2B,hg2L,hg2R,haA, & !$OMP drho_dT_dT_h,scrap,pres_h,T_h,S_h,N2_unlim, & @@ -1219,7 +1213,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV !$OMP h_neglect2,int_slope_v,KH_v,vhtot,h_frac,h_avail_rsum, & !$OMP I_slope_max2,vhD,h_avail,Work_v,CS,slope_y,cg1,hn_2,& !$OMP diag_sfn_y,diag_sfn_unlim_y,N2_floor,EOSdom_v,use_stanley,& - !$OMP Tsgs2, present_slope_y,G_rho0,Slope_y_PE,hN2_y_PE) & + !$OMP present_slope_y,G_rho0,Slope_y_PE,hN2_y_PE) & !$OMP private(drdjA,drdjB,drdkL,drdkR,pres_v,T_v,S_v,S_h,S_hr, & !$OMP drho_dT_v,drho_dS_v,hg2A,hg2B,hg2L,hg2R,haA,G_scale, & !$OMP drho_dT_dT_h,drho_dT_dT_hr,scrap,pres_h,T_h,T_hr, & diff --git a/src/parameterizations/vertical/MOM_ALE_sponge.F90 b/src/parameterizations/vertical/MOM_ALE_sponge.F90 index a137fa35db..a0331c6395 100644 --- a/src/parameterizations/vertical/MOM_ALE_sponge.F90 +++ b/src/parameterizations/vertical/MOM_ALE_sponge.F90 @@ -189,7 +189,6 @@ subroutine initialize_ALE_sponge_fixed(Iresttime, G, GV, param_file, CS, data_h, # include "version_variable.h" character(len=64) :: remapScheme logical :: use_sponge - logical :: data_h_to_Z logical :: bndExtrapolation = .true. ! If true, extrapolate boundaries integer :: default_answer_date ! The default setting for the various ANSWER_DATE flags. logical :: om4_remap_via_sub_cells ! If true, use the OM4 remapping algorithm diff --git a/src/parameterizations/vertical/MOM_CVMix_KPP.F90 b/src/parameterizations/vertical/MOM_CVMix_KPP.F90 index bf8de60a27..fa44f1b593 100644 --- a/src/parameterizations/vertical/MOM_CVMix_KPP.F90 +++ b/src/parameterizations/vertical/MOM_CVMix_KPP.F90 @@ -1076,7 +1076,6 @@ subroutine KPP_compute_BLD(CS, G, GV, US, h, Temp, Salt, u, v, tv, uStar, buoyFl ! [L T-1 ~> m s-1] real :: StokesXI ! Stokes similarity parameter [nondim] real, dimension( GV%ke ) :: StokesXI_1d , StokesVt_1d ! Parameters of TKE production ratio [nondim] - real :: Llimit ! Stable boundary Layer Limit = vonk Lstar [Z ~> m] integer :: kbl ! index of cell containing boundary layer depth if (CS%Stokes_Mixing .and. .not.associated(Waves)) call MOM_error(FATAL, & diff --git a/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 b/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 index d6c51201a6..af7fe4a94e 100644 --- a/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 +++ b/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 @@ -335,9 +335,6 @@ subroutine calculate_bkgnd_mixing(h, tv, N2_lay, Kd_lay, Kd_int, Kv_bkgnd, j, G, real, dimension(SZI_(G),SZK_(GV)) :: dz !< Height change across layers [Z ~> m] real :: depth_c !< depth of the center of a layer [H ~> m or kg m-2] real :: I_Hmix !< inverse of fixed mixed layer thickness [H-1 ~> m-1 or m2 kg-1] - real :: I_2Omega !< 1/(2 Omega) [T ~> s] - real :: N_2Omega ! The ratio of the stratification to the Earth's rotation rate [nondim] - real :: N02_N2 ! The ratio a reference stratification to the actual stratification [nondim] real :: I_x30 !< 2/acos(2) = 1/(sin(30 deg) * acosh(1/sin(30 deg))) [nondim] real :: deg_to_rad !< factor converting degrees to radians [radians degree-1], pi/180. real :: abs_sinlat !< absolute value of sine of latitude [nondim] diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index 63470312f3..7c9ec42038 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -309,7 +309,7 @@ subroutine diabatic(u, v, h, tv, BLD, fluxes, visc, ADp, CDp, dt, Time_end, & real, dimension(SZI_(G),SZK_(GV)) :: & pressure ! The pressure at the middle of each layer [R L2 T-2 ~> Pa]. real :: H_to_RL2_T2 ! A conversion factor from thicknesses in H to pressure [R L2 T-2 H-1 ~> Pa m-1 or Pa m2 kg-1] - integer :: i, j, k, m, is, ie, js, je, nz + integer :: i, j, k, is, ie, js, je, nz logical :: showCallTree ! If true, show the call tree real, allocatable, dimension(:,:,:) :: h_in ! thickness before thermodynamics [H ~> m or kg m-2] @@ -594,7 +594,6 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, BLD, fluxes, visc, ADp, CDp, dt, Tim real, dimension(SZI_(G)) :: & p_i ,& ! Pressure at the interface [R L2 T-2 ~> Pa] - d_pres, & ! pressure change across a layer [R L2 T-2 ~> Pa] T_i, & ! Temperature at the interface [C ~> degC] S_i, & ! Salinity at the interface [S ~> ppt] drhodS, & ! Local change in density w.r.t. salinity using model EOS & state [R C-1 ~> kg m-3 ppt-1] @@ -1312,7 +1311,6 @@ subroutine diabatic_ALE(u, v, h, tv, BLD, fluxes, visc, ADp, CDp, dt, Time_end, real, dimension(SZI_(G)) :: & p_i ,& ! Pressure at the interface [R L2 T-2 ~> Pa] - d_pres, & ! pressure change across a layer [R L2 T-2 ~> Pa] T_i, & ! Temperature at the interface [C ~> degC] S_i, & ! Salinity at the interface [S ~> ppt] drhodS, & ! Local change in density w.r.t. salinity using model EOS & state [R C-1 ~> kg m-3 ppt-1] @@ -3241,10 +3239,8 @@ subroutine diabatic_driver_init(Time, G, GV, US, param_file, useALEalgorithm, di # include "version_variable.h" character(len=40) :: mdl = "MOM_diabatic_driver" ! This module's name. character(len=48) :: thickness_units - character(len=40) :: var_name - character(len=160) :: var_descript logical :: physical_OBL_scheme - integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB, nz, nbands, m + integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB, nz, nbands isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed ; nz = GV%ke IsdB = G%IsdB ; IedB = G%IedB ; JsdB = G%JsdB ; JedB = G%JedB diff --git a/src/parameterizations/vertical/MOM_energetic_PBL.F90 b/src/parameterizations/vertical/MOM_energetic_PBL.F90 index d4b8754762..99c0711fd1 100644 --- a/src/parameterizations/vertical/MOM_energetic_PBL.F90 +++ b/src/parameterizations/vertical/MOM_energetic_PBL.F90 @@ -477,8 +477,7 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, visc, dt, Kd_int, G, GV, diag_mstar_LT, & ! mstar due to Langmuir turbulence [nondim] diag_LA, & ! Langmuir number [nondim] diag_LA_mod, & ! Modified Langmuir number [nondim] - diag_ustar, & ! The surface boundary layer friction velocity [Z T-1 ~> m s-1] - diag_bflx ! The surface boundary layer buoyancy flux [Z2 T-3 ~> m2 s-3] + diag_ustar ! The surface boundary layer friction velocity [Z T-1 ~> m s-1] ! The following variables are only used for diagnosing sensitivities to ePBL settings real, dimension(SZK_(GV)+1) :: & @@ -2069,8 +2068,6 @@ subroutine ePBL_BBL_column(h, dz, u, v, T0, S0, dSV_dT, dSV_dS, SpV_dt, absf, & c1, & ! c1 is used by the tridiagonal solver [nondim]. Te, & ! Estimated final values of T in the column [C ~> degC]. Se, & ! Estimated final values of S in the column [S ~> ppt]. - dTe, & ! Running (1-way) estimates of temperature change [C ~> degC]. - dSe, & ! Running (1-way) estimates of salinity change [S ~> ppt]. hp_a, & ! An effective pivot thickness of the layer including the effects ! of coupling with layers above [H ~> m or kg m-2]. This is the first term ! in the denominator of b1 in a downward-oriented tridiagonal solver. @@ -2157,7 +2154,6 @@ subroutine ePBL_BBL_column(h, dz, u, v, T0, S0, dSV_dT, dSV_dS, SpV_dt, absf, & real :: min_BBLD, max_BBLD ! Iteration bounds on BBLD [Z ~> m], which are adjusted at each step real :: dBBLD_min ! The change in diagnosed mixed layer depth when the guess is min_BLD [Z ~> m] real :: dBBLD_max ! The change in diagnosed mixed layer depth when the guess is max_BLD [Z ~> m] - logical :: BBL_converged ! Flag for convergence of BBLD integer :: BBL_it ! Iteration counter real :: Surface_Scale ! Surface decay scale for vstar [nondim] @@ -2778,8 +2774,7 @@ subroutine kappa_eqdisc(shape_func, CS, GV, dz, absf, B_flux, u_star, MLD_guess) ! variables used for optimizing computations: real :: sm_h ! sigma_max multiplied by boundary layer depth [Z ~> m] - real :: sm_h_I ! inverse of sm_h,[Z-1 ~> m-1] - real :: sm_h_I2 ! An inverse variable given by 1.0/(h - sm_h), [Z-1 ~> m-1] + real :: sm_h_I ! inverse of sm_h [Z-1 ~> m-1] real :: hz_n ! z depth to avoid calling hz multiple times [Z ~> m] real :: z_minus_sm_h ! depth z minus \sigma_m * MLD_Guess [Z ~> m] real :: z_minus_sm_h2 ! (depth z minus \sigma_m * MLD_Guess)^2 [Z2 ~> m2] diff --git a/src/parameterizations/vertical/MOM_set_viscosity.F90 b/src/parameterizations/vertical/MOM_set_viscosity.F90 index 6b873a99fd..e9e52ed1f0 100644 --- a/src/parameterizations/vertical/MOM_set_viscosity.F90 +++ b/src/parameterizations/vertical/MOM_set_viscosity.F90 @@ -2969,7 +2969,7 @@ subroutine set_visc_init(Time, G, GV, US, param_file, diag, visc, CS, restart_CS ! continental shelf break profile. real, allocatable, dimension(:,:) :: cdrag_h !< The spatially varying quadratic drag coefficient [nondim] - integer :: i, j, k, is, ie, js, je + integer :: i, j, is, ie, js, je integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB, nz integer :: default_answer_date ! The default setting for the various ANSWER_DATE flags. logical :: adiabatic, use_omega, MLE_use_PBL_MLD diff --git a/src/parameterizations/vertical/MOM_vert_friction.F90 b/src/parameterizations/vertical/MOM_vert_friction.F90 index b4e75c56d2..e3161a8210 100644 --- a/src/parameterizations/vertical/MOM_vert_friction.F90 +++ b/src/parameterizations/vertical/MOM_vert_friction.F90 @@ -247,7 +247,7 @@ subroutine vertFPmix(ui, vi, uold, vold, hbl_h, h, forces, dt, lpost, Cemp_NL, G real :: Gat1, Gsig, dGdsig !< Shape parameters [nondim] real :: du, dv !< Intermediate velocity differences [L T-1 ~> m s-1] real :: depth !< Cumulative of thicknesses [H ~> m] - integer :: b, kbld, kp1, k, nz !< band and vertical indices + integer :: b, kp1, k, nz !< band and vertical indices integer :: i, j, is, ie, js, je, Isq, Ieq, Jsq, Jeq !< horizontal indices is = G%isc ; ie = G%iec; js = G%jsc; je = G%jec @@ -1359,7 +1359,7 @@ subroutine vertvisc_coef(u, v, h, dz, forces, visc, tv, dt, G, GV, US, CS, OBC, logical :: do_any_shelf integer :: zi_dir ! A ternary logical indicating which thickness to use for finding z_clear. - integer :: i, j, k, is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz, ij + integer :: i, j, k, is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB ; nz = GV%ke From 0f977a412b3532626be4be826a5063836586a7cb Mon Sep 17 00:00:00 2001 From: He Wang Date: Fri, 6 Feb 2026 23:09:19 -0500 Subject: [PATCH 56/64] Decrease open_boundary_config indentation This is a follow up to commit 27f4243 (break down for easy review). if (OBC%number_of_segments > 0) is removed from open_boundary_config, so that the indentation level can be reduced for most part of the routine. --- src/core/MOM_open_boundary.F90 | 475 ++++++++++++++++----------------- 1 file changed, 236 insertions(+), 239 deletions(-) diff --git a/src/core/MOM_open_boundary.F90 b/src/core/MOM_open_boundary.F90 index 66b0d9f56d..e8f5f13334 100644 --- a/src/core/MOM_open_boundary.F90 +++ b/src/core/MOM_open_boundary.F90 @@ -521,9 +521,9 @@ subroutine open_boundary_config(G, US, param_file, OBC) ! This include declares and sets the variable "version". # include "version_variable.h" - call log_version(param_file, mdl, version, & - "Controls where open boundaries are located, what kind of boundary condition "//& - "to impose, and what data to apply, if any.", all_default=.false.) + call log_version(param_file, mdl, version, "Controls where open boundaries are located, "//& + "what kind of boundary condition to impose, and what data to apply, if any.", & + all_default=.false.) ! Parameter OBC_NUMBER_OF_SEGMENTS is always logged. call get_param(param_file, mdl, "OBC_NUMBER_OF_SEGMENTS", num_of_segs, & "The number of open boundary segments.", default=0) @@ -540,304 +540,301 @@ subroutine open_boundary_config(G, US, param_file, OBC) if (config1 /= "none" .and. config1 /= "dyed_obcs") OBC%user_BCs_set_globally = .true. - if (OBC%number_of_segments > 0) then - call get_param(param_file, mdl, "OBC_ZERO_VORTICITY", OBC%zero_vorticity, & - "If true, sets relative vorticity to zero on open boundaries.", & - default=.false.) - call get_param(param_file, mdl, "OBC_FREESLIP_VORTICITY", OBC%freeslip_vorticity, & - "If true, sets the normal gradient of tangential velocity to "//& - "zero in the relative vorticity on open boundaries. This cannot "//& - "be true if another OBC_XXX_VORTICITY option is True.", default=.true.) - call get_param(param_file, mdl, "OBC_COMPUTED_VORTICITY", OBC%computed_vorticity, & - "If true, uses the external values of tangential velocity "//& - "in the relative vorticity on open boundaries. This cannot "//& - "be true if another OBC_XXX_VORTICITY option is True.", default=.false.) - call get_param(param_file, mdl, "OBC_SPECIFIED_VORTICITY", OBC%specified_vorticity, & - "If true, uses the external values of tangential velocity "//& - "in the relative vorticity on open boundaries. This cannot "//& - "be true if another OBC_XXX_VORTICITY option is True.", default=.false.) - if ((OBC%zero_vorticity .and. OBC%freeslip_vorticity) .or. & - (OBC%zero_vorticity .and. OBC%computed_vorticity) .or. & - (OBC%zero_vorticity .and. OBC%specified_vorticity) .or. & - (OBC%freeslip_vorticity .and. OBC%computed_vorticity) .or. & - (OBC%freeslip_vorticity .and. OBC%specified_vorticity) .or. & - (OBC%computed_vorticity .and. OBC%specified_vorticity)) & - call MOM_error(FATAL, "MOM_open_boundary.F90, open_boundary_config:\n"//& - "Only one of OBC_ZERO_VORTICITY, OBC_FREESLIP_VORTICITY, OBC_COMPUTED_VORTICITY\n"//& - "and OBC_IMPORTED_VORTICITY can be True at once.") - call get_param(param_file, mdl, "OBC_ZERO_STRAIN", OBC%zero_strain, & - "If true, sets the strain used in the stress tensor to zero on open boundaries.", & - default=.false.) - call get_param(param_file, mdl, "OBC_FREESLIP_STRAIN", OBC%freeslip_strain, & - "If true, sets the normal gradient of tangential velocity to "//& - "zero in the strain use in the stress tensor on open boundaries. This cannot "//& - "be true if another OBC_XXX_STRAIN option is True.", default=.true.) - call get_param(param_file, mdl, "OBC_COMPUTED_STRAIN", OBC%computed_strain, & - "If true, sets the normal gradient of tangential velocity to "//& - "zero in the strain use in the stress tensor on open boundaries. This cannot "//& - "be true if another OBC_XXX_STRAIN option is True.", default=.false.) - call get_param(param_file, mdl, "OBC_SPECIFIED_STRAIN", OBC%specified_strain, & - "If true, sets the normal gradient of tangential velocity to "//& - "zero in the strain use in the stress tensor on open boundaries. This cannot "//& - "be true if another OBC_XXX_STRAIN option is True.", default=.false.) - if ((OBC%zero_strain .and. OBC%freeslip_strain) .or. & - (OBC%zero_strain .and. OBC%computed_strain) .or. & - (OBC%zero_strain .and. OBC%specified_strain) .or. & - (OBC%freeslip_strain .and. OBC%computed_strain) .or. & - (OBC%freeslip_strain .and. OBC%specified_strain) .or. & - (OBC%computed_strain .and. OBC%specified_strain)) & - call MOM_error(FATAL, "MOM_open_boundary.F90, open_boundary_config: \n"//& - "Only one of OBC_ZERO_STRAIN, OBC_FREESLIP_STRAIN, OBC_COMPUTED_STRAIN \n"//& - "and OBC_IMPORTED_STRAIN can be True at once.") - call get_param(param_file, mdl, "OBC_ZERO_BIHARMONIC", OBC%zero_biharmonic, & - "If true, zeros the Laplacian of flow on open boundaries in the biharmonic "//& - "viscosity term.", default=.false.) - call get_param(param_file, mdl, "MASK_OUTSIDE_OBCS", mask_outside, & - "If true, set the areas outside open boundaries to be land.", & - default=.false.) - call get_param(param_file, mdl, "RAMP_OBCS", OBC%ramp, & - "If true, ramps from zero to the external values over time, with"//& - "a ramping timescale given by RAMP_TIMESCALE. Ramping SSH only so far", & - default=.false.) - call get_param(param_file, mdl, "OBC_RAMP_TIMESCALE", OBC%ramp_timescale, & - "If RAMP_OBCS is true, this sets the ramping timescale.", & - units="days", default=1.0, scale=86400.0*US%s_to_T) - call get_param(param_file, mdl, "OBC_TIDE_N_CONSTITUENTS", OBC%n_tide_constituents, & - "Number of tidal constituents being added to the open boundary.", & - default=0) - OBC%add_tide_constituents = (OBC%n_tide_constituents > 0) - - call get_param(param_file, mdl, "DEBUG", debug, default=.false.) - call get_param(param_file, mdl, "DEBUG_OBCS", OBC%debug, & + call get_param(param_file, mdl, "OBC_ZERO_VORTICITY", OBC%zero_vorticity, & + "If true, sets relative vorticity to zero on open boundaries.", & + default=.false.) + call get_param(param_file, mdl, "OBC_FREESLIP_VORTICITY", OBC%freeslip_vorticity, & + "If true, sets the normal gradient of tangential velocity to "//& + "zero in the relative vorticity on open boundaries. This cannot "//& + "be true if another OBC_XXX_VORTICITY option is True.", default=.true.) + call get_param(param_file, mdl, "OBC_COMPUTED_VORTICITY", OBC%computed_vorticity, & + "If true, uses the external values of tangential velocity "//& + "in the relative vorticity on open boundaries. This cannot "//& + "be true if another OBC_XXX_VORTICITY option is True.", default=.false.) + call get_param(param_file, mdl, "OBC_SPECIFIED_VORTICITY", OBC%specified_vorticity, & + "If true, uses the external values of tangential velocity "//& + "in the relative vorticity on open boundaries. This cannot "//& + "be true if another OBC_XXX_VORTICITY option is True.", default=.false.) + if ((OBC%zero_vorticity .and. OBC%freeslip_vorticity) .or. & + (OBC%zero_vorticity .and. OBC%computed_vorticity) .or. & + (OBC%zero_vorticity .and. OBC%specified_vorticity) .or. & + (OBC%freeslip_vorticity .and. OBC%computed_vorticity) .or. & + (OBC%freeslip_vorticity .and. OBC%specified_vorticity) .or. & + (OBC%computed_vorticity .and. OBC%specified_vorticity)) & + call MOM_error(FATAL, "MOM_open_boundary.F90, open_boundary_config:\n"//& + "Only one of OBC_ZERO_VORTICITY, OBC_FREESLIP_VORTICITY, OBC_COMPUTED_VORTICITY\n"//& + "and OBC_IMPORTED_VORTICITY can be True at once.") + call get_param(param_file, mdl, "OBC_ZERO_STRAIN", OBC%zero_strain, & + "If true, sets the strain used in the stress tensor to zero on open boundaries.", & + default=.false.) + call get_param(param_file, mdl, "OBC_FREESLIP_STRAIN", OBC%freeslip_strain, & + "If true, sets the normal gradient of tangential velocity to "//& + "zero in the strain use in the stress tensor on open boundaries. This cannot "//& + "be true if another OBC_XXX_STRAIN option is True.", default=.true.) + call get_param(param_file, mdl, "OBC_COMPUTED_STRAIN", OBC%computed_strain, & + "If true, sets the normal gradient of tangential velocity to "//& + "zero in the strain use in the stress tensor on open boundaries. This cannot "//& + "be true if another OBC_XXX_STRAIN option is True.", default=.false.) + call get_param(param_file, mdl, "OBC_SPECIFIED_STRAIN", OBC%specified_strain, & + "If true, sets the normal gradient of tangential velocity to "//& + "zero in the strain use in the stress tensor on open boundaries. This cannot "//& + "be true if another OBC_XXX_STRAIN option is True.", default=.false.) + if ((OBC%zero_strain .and. OBC%freeslip_strain) .or. & + (OBC%zero_strain .and. OBC%computed_strain) .or. & + (OBC%zero_strain .and. OBC%specified_strain) .or. & + (OBC%freeslip_strain .and. OBC%computed_strain) .or. & + (OBC%freeslip_strain .and. OBC%specified_strain) .or. & + (OBC%computed_strain .and. OBC%specified_strain)) & + call MOM_error(FATAL, "MOM_open_boundary.F90, open_boundary_config: \n"//& + "Only one of OBC_ZERO_STRAIN, OBC_FREESLIP_STRAIN, OBC_COMPUTED_STRAIN \n"//& + "and OBC_IMPORTED_STRAIN can be True at once.") + call get_param(param_file, mdl, "OBC_ZERO_BIHARMONIC", OBC%zero_biharmonic, & + "If true, zeros the Laplacian of flow on open boundaries in the biharmonic "//& + "viscosity term.", default=.false.) + call get_param(param_file, mdl, "MASK_OUTSIDE_OBCS", mask_outside, & + "If true, set the areas outside open boundaries to be land.", & + default=.false.) + call get_param(param_file, mdl, "RAMP_OBCS", OBC%ramp, & + "If true, ramps from zero to the external values over time, with"//& + "a ramping timescale given by RAMP_TIMESCALE. Ramping SSH only so far", & + default=.false.) + call get_param(param_file, mdl, "OBC_RAMP_TIMESCALE", OBC%ramp_timescale, & + "If RAMP_OBCS is true, this sets the ramping timescale.", & + units="days", default=1.0, scale=86400.0*US%s_to_T) + call get_param(param_file, mdl, "OBC_TIDE_N_CONSTITUENTS", OBC%n_tide_constituents, & + "Number of tidal constituents being added to the open boundary.", & + default=0) + OBC%add_tide_constituents = (OBC%n_tide_constituents > 0) + + call get_param(param_file, mdl, "DEBUG", debug, default=.false.) + call get_param(param_file, mdl, "DEBUG_OBCS", OBC%debug, & "If true, do additional calls to help debug the performance "//& "of the open boundary condition code.", & default=.false., debuggingParam=.true.) - if (OBC%debug .and. (num_PEs() > 1)) & - call MOM_error(FATAL, "DEBUG_OBCS = True is currently only supported for single PE runs.") - call get_param(param_file, mdl, "OBC_DEBUGGING_TESTS", debugging_tests, & + if (OBC%debug .and. (num_PEs() > 1)) & + call MOM_error(FATAL, "DEBUG_OBCS = True is currently only supported for single PE runs.") + call get_param(param_file, mdl, "OBC_DEBUGGING_TESTS", debugging_tests, & "If true, do additional calls resetting certain values to help verify the correctness "//& "of the open boundary condition code.", & default=.false., old_name="DEBUG_OBC", debuggingParam=.true.) - call get_param(param_file, mdl, "NK_OBC_DEBUG", OBC%nk_OBC_debug, & + call get_param(param_file, mdl, "NK_OBC_DEBUG", OBC%nk_OBC_debug, & "The number of layers of OBC segment data to write out in full "//& "when DEBUG_OBCS is true.", & default=0, debuggingParam=.true., do_not_log=.not.OBC%debug) - call get_param(param_file, mdl, "OBC_REVERSE_SEGMENT_ORDER", OBC%reverse_segment_order, & + call get_param(param_file, mdl, "OBC_REVERSE_SEGMENT_ORDER", OBC%reverse_segment_order, & "If true, store the OBC segments internally and handle them in the reverse "//& "order from that with which they are specified via external parameters to test "//& "for dependencies on the order with which the OBC segments are applied.", & default=.false., debuggingParam=.true., do_not_log=(OBC%number_of_segments<2)) - call get_param(param_file, mdl, "OBC_SILLY_THICK", OBC%silly_h, & + call get_param(param_file, mdl, "OBC_SILLY_THICK", OBC%silly_h, & "A silly value of thicknesses used outside of open boundary "//& "conditions for debugging.", units="m", default=0.0, scale=US%m_to_Z, & do_not_log=.not.debugging_tests, debuggingParam=.true.) - call get_param(param_file, mdl, "OBC_SILLY_VEL", OBC%silly_u, & + call get_param(param_file, mdl, "OBC_SILLY_VEL", OBC%silly_u, & "A silly value of velocities used outside of open boundary "//& "conditions for debugging.", units="m/s", default=0.0, scale=US%m_s_to_L_T, & do_not_log=.not.debugging_tests, debuggingParam=.true.) - call get_param(param_file, mdl, "ENABLE_BUGS_BY_DEFAULT", enable_bugs, & + call get_param(param_file, mdl, "ENABLE_BUGS_BY_DEFAULT", enable_bugs, & default=.true., do_not_log=.true.) ! This is logged from MOM.F90. - call get_param(param_file, mdl, "EXTERIOR_OBC_BUG", OBC%exterior_OBC_bug, & + call get_param(param_file, mdl, "EXTERIOR_OBC_BUG", OBC%exterior_OBC_bug, & "If true, recover a bug in barotropic solver and other routines when "//& "boundary contitions interior to the domain are used.", & default=enable_bugs) - call get_param(param_file, mdl, "OBC_HOR_INDEXING_BUG", OBC%hor_index_bug, & + call get_param(param_file, mdl, "OBC_HOR_INDEXING_BUG", OBC%hor_index_bug, & "If true, recover set of a horizontal indexing bugs in the OBC code.", & default=enable_bugs) - call get_param(param_file, mdl, "OBC_RESERVOIR_INIT_BUG", OBC%reservoir_init_bug, & + call get_param(param_file, mdl, "OBC_RESERVOIR_INIT_BUG", OBC%reservoir_init_bug, & "If true, set the OBC tracer reservoirs at the startup of a new run from the "//& "interior tracer concentrations regardless of properties that may be explicitly "//& "specified for the reservoir concentrations.", default=enable_bugs, do_not_log=.true.) - call get_param(param_file, mdl, "REENTRANT_X", reentrant_x, default=.true.) - call get_param(param_file, mdl, "REENTRANT_Y", reentrant_y, default=.false.) + call get_param(param_file, mdl, "REENTRANT_X", reentrant_x, default=.true.) + call get_param(param_file, mdl, "REENTRANT_Y", reentrant_y, default=.false.) - ! Allocate everything - allocate(OBC%segment(1:OBC%number_of_segments)) - do n=1,OBC%number_of_segments - OBC%segment(n)%Flather = .false. - OBC%segment(n)%radiation = .false. - OBC%segment(n)%radiation_tan = .false. - OBC%segment(n)%radiation_grad = .false. - OBC%segment(n)%oblique = .false. - OBC%segment(n)%oblique_tan = .false. - OBC%segment(n)%oblique_grad = .false. - OBC%segment(n)%nudged = .false. - OBC%segment(n)%nudged_tan = .false. - OBC%segment(n)%nudged_grad = .false. - OBC%segment(n)%specified = .false. - OBC%segment(n)%specified_tan = .false. - OBC%segment(n)%specified_grad = .false. - OBC%segment(n)%open = .false. - OBC%segment(n)%gradient = .false. - OBC%segment(n)%values_needed = .false. - OBC%segment(n)%u_values_needed = .false. - OBC%segment(n)%uamp_values_needed = OBC%add_tide_constituents - OBC%segment(n)%uphase_values_needed = OBC%add_tide_constituents - OBC%segment(n)%v_values_needed = .false. - OBC%segment(n)%vamp_values_needed = OBC%add_tide_constituents - OBC%segment(n)%vphase_values_needed = OBC%add_tide_constituents - OBC%segment(n)%t_values_needed = .false. - OBC%segment(n)%s_values_needed = .false. - OBC%segment(n)%z_values_needed = .false. - OBC%segment(n)%zamp_values_needed = OBC%add_tide_constituents - OBC%segment(n)%zphase_values_needed = OBC%add_tide_constituents - OBC%segment(n)%g_values_needed = .false. - OBC%segment(n)%direction = OBC_NONE - OBC%segment(n)%is_N_or_S = .false. - OBC%segment(n)%is_E_or_W = .false. - OBC%segment(n)%is_E_or_W_2 = .false. - OBC%segment(n)%Velocity_nudging_timescale_in = 0.0 - OBC%segment(n)%Velocity_nudging_timescale_out = 0.0 - OBC%segment(n)%num_fields = 0 - enddo - allocate(OBC%segnum_u(G%IsdB:G%IedB,G%jsd:G%jed), source=0) - allocate(OBC%segnum_v(G%isd:G%ied,G%JsdB:G%JedB), source=0) - OBC%u_OBCs_on_PE = .false. - OBC%v_OBCs_on_PE = .false. + ! Allocate everything + allocate(OBC%segment(1:OBC%number_of_segments)) + do n=1,OBC%number_of_segments + OBC%segment(n)%Flather = .false. + OBC%segment(n)%radiation = .false. + OBC%segment(n)%radiation_tan = .false. + OBC%segment(n)%radiation_grad = .false. + OBC%segment(n)%oblique = .false. + OBC%segment(n)%oblique_tan = .false. + OBC%segment(n)%oblique_grad = .false. + OBC%segment(n)%nudged = .false. + OBC%segment(n)%nudged_tan = .false. + OBC%segment(n)%nudged_grad = .false. + OBC%segment(n)%specified = .false. + OBC%segment(n)%specified_tan = .false. + OBC%segment(n)%specified_grad = .false. + OBC%segment(n)%open = .false. + OBC%segment(n)%gradient = .false. + OBC%segment(n)%values_needed = .false. + OBC%segment(n)%u_values_needed = .false. + OBC%segment(n)%uamp_values_needed = OBC%add_tide_constituents + OBC%segment(n)%uphase_values_needed = OBC%add_tide_constituents + OBC%segment(n)%v_values_needed = .false. + OBC%segment(n)%vamp_values_needed = OBC%add_tide_constituents + OBC%segment(n)%vphase_values_needed = OBC%add_tide_constituents + OBC%segment(n)%t_values_needed = .false. + OBC%segment(n)%s_values_needed = .false. + OBC%segment(n)%z_values_needed = .false. + OBC%segment(n)%zamp_values_needed = OBC%add_tide_constituents + OBC%segment(n)%zphase_values_needed = OBC%add_tide_constituents + OBC%segment(n)%g_values_needed = .false. + OBC%segment(n)%direction = OBC_NONE + OBC%segment(n)%is_N_or_S = .false. + OBC%segment(n)%is_E_or_W = .false. + OBC%segment(n)%is_E_or_W_2 = .false. + OBC%segment(n)%Velocity_nudging_timescale_in = 0.0 + OBC%segment(n)%Velocity_nudging_timescale_out = 0.0 + OBC%segment(n)%num_fields = 0 + enddo + allocate(OBC%segnum_u(G%IsdB:G%IedB,G%jsd:G%jed), source=0) + allocate(OBC%segnum_v(G%isd:G%ied,G%JsdB:G%JedB), source=0) + OBC%u_OBCs_on_PE = .false. + OBC%v_OBCs_on_PE = .false. - do n=1,OBC%number_of_segments - n_seg = n ; if (OBC%reverse_segment_order) n_seg = OBC%number_of_segments + 1 - n - write(segment_param_str(1:15),"('OBC_SEGMENT_',i3.3)") n - call get_param(param_file, mdl, segment_param_str, segment_str, & - "Documentation needs to be dynamic?????", & - fail_if_missing=.true.) - segment_str = remove_spaces(segment_str) - if (segment_str(1:2) == 'I=') then - call setup_u_point_obc(OBC, G, US, segment_str, n_seg, n, param_file, reentrant_y) - elseif (segment_str(1:2) == 'J=') then - call setup_v_point_obc(OBC, G, US, segment_str, n_seg, n, param_file, reentrant_x) - else - call MOM_error(FATAL, "MOM_open_boundary.F90, open_boundary_config: "//& - "Unable to interpret "//segment_param_str//" = "//trim(segment_str)) - endif - enddo - ! Set arrays indicating the segment number and segment direction, and also store the - ! range of indices within which various orientations of OBCs can be found on this PE. - call set_segnum_signs(OBC, G) - - ! Moved this earlier because time_interp_external_init needs to be called - ! before anything that uses time_interp_external (such as initialize_segment_data) - if (OBC%specified_u_BCs_exist_globally .or. OBC%specified_v_BCs_exist_globally .or. & - OBC%open_u_BCs_exist_globally .or. OBC%open_v_BCs_exist_globally) then - ! Need this for ocean_only mode boundary interpolation. - call time_interp_external_init() + do n=1,OBC%number_of_segments + n_seg = n ; if (OBC%reverse_segment_order) n_seg = OBC%number_of_segments + 1 - n + write(segment_param_str(1:15),"('OBC_SEGMENT_',i3.3)") n + call get_param(param_file, mdl, segment_param_str, segment_str, & + "Documentation needs to be dynamic?????", & + fail_if_missing=.true.) + segment_str = remove_spaces(segment_str) + if (segment_str(1:2) == 'I=') then + call setup_u_point_obc(OBC, G, US, segment_str, n_seg, n, param_file, reentrant_y) + elseif (segment_str(1:2) == 'J=') then + call setup_v_point_obc(OBC, G, US, segment_str, n_seg, n, param_file, reentrant_x) + else + call MOM_error(FATAL, "MOM_open_boundary.F90, open_boundary_config: "//& + "Unable to interpret "//segment_param_str//" = "//trim(segment_str)) endif - ! if (open_boundary_query(OBC, needs_ext_seg_data=.true.)) & - ! call initialize_segment_data(G, OBC, param_file) + enddo + ! Set arrays indicating the segment number and segment direction, and also store the + ! range of indices within which various orientations of OBCs can be found on this PE. + call set_segnum_signs(OBC, G) + + ! Moved this earlier because time_interp_external_init needs to be called + ! before anything that uses time_interp_external (such as initialize_segment_data) + if (OBC%specified_u_BCs_exist_globally .or. OBC%specified_v_BCs_exist_globally .or. & + OBC%open_u_BCs_exist_globally .or. OBC%open_v_BCs_exist_globally) then + ! Need this for ocean_only mode boundary interpolation. + call time_interp_external_init() + endif + ! if (open_boundary_query(OBC, needs_ext_seg_data=.true.)) & + ! call initialize_segment_data(G, OBC, param_file) - if (open_boundary_query(OBC, apply_open_OBC=.true.)) then - call get_param(param_file, mdl, "OBC_RADIATION_MAX", OBC%rx_max, & + if (open_boundary_query(OBC, apply_open_OBC=.true.)) then + call get_param(param_file, mdl, "OBC_RADIATION_MAX", OBC%rx_max, & "The maximum magnitude of the baroclinic radiation velocity (or speed of "//& "characteristics), in gridpoints per timestep. This is only "//& "used if one of the open boundary segments is using Orlanski.", & units="nondim", default=1.0) - call get_param(param_file, mdl, "OBC_RAD_VEL_WT", OBC%gamma_uv, & + call get_param(param_file, mdl, "OBC_RAD_VEL_WT", OBC%gamma_uv, & "The relative weighting for the baroclinic radiation "//& "velocities (or speed of characteristics) at the new "//& "time level (1) or the running mean (0) for velocities. "//& "Valid values range from 0 to 1. This is only used if "//& "one of the open boundary segments is using Orlanski.", & units="nondim", default=0.3) - endif + endif - Lscale_in = 0. - Lscale_out = 0. - if (open_boundary_query(OBC, apply_open_OBC=.true.)) then - call get_param(param_file, mdl, "OBC_TRACER_RESERVOIR_LENGTH_SCALE_OUT ", Lscale_out, & - "An effective length scale for restoring the tracer concentration "//& - "at the boundaries to externally imposed values when the flow "//& - "is exiting the domain.", units="m", default=0.0, scale=US%m_to_L) - - call get_param(param_file, mdl, "OBC_TRACER_RESERVOIR_LENGTH_SCALE_IN ", Lscale_in, & - "An effective length scale for restoring the tracer concentration "//& - "at the boundaries to values from the interior when the flow "//& - "is entering the domain.", units="m", default=0.0, scale=US%m_to_L) - endif + Lscale_in = 0. + Lscale_out = 0. + if (open_boundary_query(OBC, apply_open_OBC=.true.)) then + call get_param(param_file, mdl, "OBC_TRACER_RESERVOIR_LENGTH_SCALE_OUT ", Lscale_out, & + "An effective length scale for restoring the tracer concentration "//& + "at the boundaries to externally imposed values when the flow "//& + "is exiting the domain.", units="m", default=0.0, scale=US%m_to_L) + + call get_param(param_file, mdl, "OBC_TRACER_RESERVOIR_LENGTH_SCALE_IN ", Lscale_in, & + "An effective length scale for restoring the tracer concentration "//& + "at the boundaries to values from the interior when the flow "//& + "is entering the domain.", units="m", default=0.0, scale=US%m_to_L) + endif - if (mask_outside) call mask_outside_OBCs(G, US, param_file, OBC) + if (mask_outside) call mask_outside_OBCs(G, US, param_file, OBC) - ! All tracers are using the same restoring length scale for now, but we may want to make this - ! tracer-specific in the future for example, in cases where certain tracers are poorly constrained - ! by data while others are well constrained - MJH. - do n=1,OBC%number_of_segments - OBC%segment(n)%Tr_InvLscale_in = 0.0 - if (Lscale_in>0.) OBC%segment(n)%Tr_InvLscale_in = 1.0/Lscale_in - OBC%segment(n)%Tr_InvLscale_out = 0.0 - if (Lscale_out>0.) OBC%segment(n)%Tr_InvLscale_out = 1.0/Lscale_out - enddo + ! All tracers are using the same restoring length scale for now, but we may want to make this + ! tracer-specific in the future for example, in cases where certain tracers are poorly constrained + ! by data while others are well constrained - MJH. + do n=1,OBC%number_of_segments + OBC%segment(n)%Tr_InvLscale_in = 0.0 + if (Lscale_in>0.) OBC%segment(n)%Tr_InvLscale_in = 1.0/Lscale_in + OBC%segment(n)%Tr_InvLscale_out = 0.0 + if (Lscale_out>0.) OBC%segment(n)%Tr_InvLscale_out = 1.0/Lscale_out + enddo - Lscale_in = 0. - Lscale_out = 0. - if (open_boundary_query(OBC, apply_open_OBC=.true.)) then - call get_param(param_file, mdl, "OBC_THICKNESS_RESERVOIR_LENGTH_SCALE_OUT ", Lscale_out, & - "An effective length scale for restoring the layer thickness "//& - "at the boundaries to externally imposed values when the flow "//& - "is exiting the domain.", units="m", default=0.0, scale=US%m_to_L) - - call get_param(param_file, mdl, "OBC_THICKNESS_RESERVOIR_LENGTH_SCALE_IN ", Lscale_in, & - "An effective length scale for restoring the layer thickness "//& - "at the boundaries to values from the interior when the flow "//& - "is entering the domain.", units="m", default=0.0, scale=US%m_to_L) - endif + Lscale_in = 0. + Lscale_out = 0. + if (open_boundary_query(OBC, apply_open_OBC=.true.)) then + call get_param(param_file, mdl, "OBC_THICKNESS_RESERVOIR_LENGTH_SCALE_OUT ", Lscale_out, & + "An effective length scale for restoring the layer thickness "//& + "at the boundaries to externally imposed values when the flow "//& + "is exiting the domain.", units="m", default=0.0, scale=US%m_to_L) + + call get_param(param_file, mdl, "OBC_THICKNESS_RESERVOIR_LENGTH_SCALE_IN ", Lscale_in, & + "An effective length scale for restoring the layer thickness "//& + "at the boundaries to values from the interior when the flow "//& + "is entering the domain.", units="m", default=0.0, scale=US%m_to_L) + endif - do n=1,OBC%number_of_segments - OBC%segment(n)%Th_InvLscale_in = 0.0 - if (Lscale_in>0.) OBC%segment(n)%Th_InvLscale_in = 1.0/Lscale_in - OBC%segment(n)%Th_InvLscale_out = 0.0 - if (Lscale_out>0.) OBC%segment(n)%Th_InvLscale_out = 1.0/Lscale_out - if (Lscale_in>0. .or. Lscale_out>0.) then - if (OBC%segment(n)%is_E_or_W_2) then - OBC%thickness_x_reservoirs_used = .true. - OBC%use_h_res = .true. - else - OBC%thickness_y_reservoirs_used = .true. - OBC%use_h_res = .true. - endif + do n=1,OBC%number_of_segments + OBC%segment(n)%Th_InvLscale_in = 0.0 + if (Lscale_in>0.) OBC%segment(n)%Th_InvLscale_in = 1.0/Lscale_in + OBC%segment(n)%Th_InvLscale_out = 0.0 + if (Lscale_out>0.) OBC%segment(n)%Th_InvLscale_out = 1.0/Lscale_out + if (Lscale_in>0. .or. Lscale_out>0.) then + if (OBC%segment(n)%is_E_or_W_2) then + OBC%thickness_x_reservoirs_used = .true. + OBC%use_h_res = .true. + else + OBC%thickness_y_reservoirs_used = .true. + OBC%use_h_res = .true. endif - enddo + endif + enddo - call get_param(param_file, mdl, "REMAPPING_SCHEME", OBC%remappingScheme, & - default=remappingDefaultScheme, do_not_log=.true.) - call get_param(param_file, mdl, "OBC_REMAPPING_SCHEME", OBC%remappingScheme, & - "This sets the reconstruction scheme used "//& - "for OBC vertical remapping for all variables. "//& - "It can be one of the following schemes: \n"//& - trim(remappingSchemesDoc), default=OBC%remappingScheme) - call get_param(param_file, mdl, "FATAL_CHECK_RECONSTRUCTIONS", OBC%check_reconstruction, & - "If true, cell-by-cell reconstructions are checked for "//& - "consistency and if non-monotonicity or an inconsistency is "//& - "detected then a FATAL error is issued.", default=.false., do_not_log=.true.) - call get_param(param_file, mdl, "FATAL_CHECK_REMAPPING", OBC%check_remapping, & - "If true, the results of remapping are checked for "//& - "conservation and new extrema and if an inconsistency is "//& - "detected then a FATAL error is issued.", default=.false., do_not_log=.true.) - call get_param(param_file, mdl, "BRUSHCUTTER_MODE", OBC%brushcutter_mode, & - "If true, read external OBC data on the supergrid.", & - default=.false.) - call get_param(param_file, mdl, "REMAP_BOUND_INTERMEDIATE_VALUES", OBC%force_bounds_in_subcell, & - "If true, the values on the intermediate grid used for remapping "//& - "are forced to be bounded, which might not be the case due to "//& - "round off.", default=.false., do_not_log=.true.) - call get_param(param_file, mdl, "DEFAULT_ANSWER_DATE", default_answer_date, & + call get_param(param_file, mdl, "REMAPPING_SCHEME", OBC%remappingScheme, & + default=remappingDefaultScheme, do_not_log=.true.) + call get_param(param_file, mdl, "OBC_REMAPPING_SCHEME", OBC%remappingScheme, & + "This sets the reconstruction scheme used "//& + "for OBC vertical remapping for all variables. "//& + "It can be one of the following schemes: \n"//& + trim(remappingSchemesDoc), default=OBC%remappingScheme) + call get_param(param_file, mdl, "FATAL_CHECK_RECONSTRUCTIONS", OBC%check_reconstruction, & + "If true, cell-by-cell reconstructions are checked for "//& + "consistency and if non-monotonicity or an inconsistency is "//& + "detected then a FATAL error is issued.", default=.false., do_not_log=.true.) + call get_param(param_file, mdl, "FATAL_CHECK_REMAPPING", OBC%check_remapping, & + "If true, the results of remapping are checked for "//& + "conservation and new extrema and if an inconsistency is "//& + "detected then a FATAL error is issued.", default=.false., do_not_log=.true.) + call get_param(param_file, mdl, "BRUSHCUTTER_MODE", OBC%brushcutter_mode, & + "If true, read external OBC data on the supergrid.", & + default=.false.) + call get_param(param_file, mdl, "REMAP_BOUND_INTERMEDIATE_VALUES", OBC%force_bounds_in_subcell, & + "If true, the values on the intermediate grid used for remapping "//& + "are forced to be bounded, which might not be the case due to "//& + "round off.", default=.false., do_not_log=.true.) + call get_param(param_file, mdl, "DEFAULT_ANSWER_DATE", default_answer_date, & "This sets the default value for the various _ANSWER_DATE parameters.", & default=99991231) - call get_param(param_file, mdl, "REMAPPING_ANSWER_DATE", OBC%remap_answer_date, & + call get_param(param_file, mdl, "REMAPPING_ANSWER_DATE", OBC%remap_answer_date, & "The vintage of the expressions and order of arithmetic to use for remapping. "//& "Values below 20190101 result in the use of older, less accurate expressions "//& "that were in use at the end of 2018. Higher values result in the use of more "//& "robust and accurate forms of mathematically equivalent expressions.", & default=default_answer_date) - call get_param(param_file, mdl, "REMAPPING_USE_OM4_SUBCELLS", OBC%om4_remap_via_sub_cells, & - do_not_log=.true., default=.true.) + call get_param(param_file, mdl, "REMAPPING_USE_OM4_SUBCELLS", OBC%om4_remap_via_sub_cells, & + do_not_log=.true., default=.true.) - call get_param(param_file, mdl, "OBC_REMAPPING_USE_OM4_SUBCELLS", OBC%om4_remap_via_sub_cells, & + call get_param(param_file, mdl, "OBC_REMAPPING_USE_OM4_SUBCELLS", OBC%om4_remap_via_sub_cells, & "If true, use the OM4 remapping-via-subcells algorithm for neutral diffusion. "//& "See REMAPPING_USE_OM4_SUBCELLS for more details. "//& "We recommend setting this option to false.", default=OBC%om4_remap_via_sub_cells) - endif ! OBC%number_of_segments > 0 - ! Safety check if ((OBC%open_u_BCs_exist_globally .or. OBC%open_v_BCs_exist_globally) .and. & .not.G%symmetric ) call MOM_error(FATAL, & From 412c177794f86bdc806a2e88ff932cb596fcf2d1 Mon Sep 17 00:00:00 2001 From: He Wang Date: Thu, 5 Feb 2026 14:12:11 -0500 Subject: [PATCH 57/64] Correct the unit of diagnostic "eta_cor" It should be in thickness unit (m for Boussinesq and kg/m2 for non-Boussinesq). The long name description is also slightly changed. --- src/core/MOM_barotropic.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/core/MOM_barotropic.F90 b/src/core/MOM_barotropic.F90 index 095e639845..abe1fd94fd 100644 --- a/src/core/MOM_barotropic.F90 +++ b/src/core/MOM_barotropic.F90 @@ -6315,7 +6315,7 @@ subroutine barotropic_init(u, v, h, Time, G, GV, US, param_file, diag, CS, & CS%id_vbtav = register_diag_field('ocean_model', 'vbtav', diag%axesCv1, Time, & 'Barotropic time-average meridional velocity', 'm s-1', conversion=US%L_T_to_m_s) CS%id_eta_cor = register_diag_field('ocean_model', 'eta_cor', diag%axesT1, Time, & - 'Corrective mass flux within a timestep', 'm', conversion=GV%H_to_m) + 'Corrective mass or volume flux within a timestep', thickness_units, conversion=GV%H_to_MKS) CS%id_visc_rem_u = register_diag_field('ocean_model', 'visc_rem_u', diag%axesCuL, Time, & 'Viscous remnant at u', 'nondim') CS%id_visc_rem_v = register_diag_field('ocean_model', 'visc_rem_v', diag%axesCvL, Time, & From aefec490a653b8150a309ff747a5e73b4065542b Mon Sep 17 00:00:00 2001 From: He Wang Date: Fri, 31 Jan 2025 13:13:37 -0500 Subject: [PATCH 58/64] Merge [uv]bt_st and [uv]bt_first in btstep The two pairs are used for different purposes. `[uv]bt_st`` are used for diagnosing barotropic momentum tendency and `[uv]bt_first` are used for OBC. But they are equivalent (initial BT velocity) and neither uses wide halo. This commit merges the two. Extra halo points in assigning `[uv]bt_st` are also removed. --- src/core/MOM_barotropic.F90 | 24 +++++++----------------- 1 file changed, 7 insertions(+), 17 deletions(-) diff --git a/src/core/MOM_barotropic.F90 b/src/core/MOM_barotropic.F90 index abe1fd94fd..4dbac78c98 100644 --- a/src/core/MOM_barotropic.F90 +++ b/src/core/MOM_barotropic.F90 @@ -600,7 +600,6 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, uhbt0, & ! The difference between the sum of the layer zonal thickness ! fluxes and the barotropic thickness flux using the same ! velocity [H L2 T-1 ~> m3 s-1 or kg s-1]. - ubt_first, & ! The starting value of ubt in a series of barotropic steps [L T-1 ~> m s-1]. Cor_ref_u, & ! The zonal barotropic Coriolis acceleration due ! to the reference velocities [L T-2 ~> m s-2]. Rayleigh_u, & ! A Rayleigh drag timescale operating at u-points for drag parameterizations @@ -623,7 +622,6 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, vhbt0, & ! The difference between the sum of the layer meridional ! thickness fluxes and the barotropic thickness flux using ! the same velocities [H L2 T-1 ~> m3 s-1 or kg s-1]. - vbt_first, & ! The starting value of vbt in a series of barotropic steps [L T-1 ~> m s-1]. Cor_ref_v, & ! The meridional barotropic Coriolis acceleration due ! to the reference velocities [L T-2 ~> m s-2]. Rayleigh_v, & ! A Rayleigh drag timescale operating at v-points for drag parameterizations @@ -1316,8 +1314,11 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, uhbt(:,:) = 0.0 ; vhbt(:,:) = 0.0 u_accel_bt(:,:) = 0.0 ; v_accel_bt(:,:) = 0.0 - if (apply_OBCs) then - ubt_first(:,:) = ubt(:,:) ; vbt_first(:,:) = vbt(:,:) + if (apply_OBCs .or. (CS%id_ubtdt > 0)) then + do j=js,je ; do I=is-1,ie ; ubt_st(I,j) = ubt(I,j) ; enddo ; enddo + endif + if (apply_OBCs .or. (CS%id_vbtdt > 0)) then + do J=js-1,je ; do i=is,ie ; vbt_st(i,J) = vbt(i,J) ; enddo ; enddo endif ! Here the vertical average accelerations due to the Coriolis, advective, @@ -1788,17 +1789,6 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, endif endif - if (CS%id_ubtdt > 0) then - do j=js-1,je+1 ; do I=is-1,ie - ubt_st(I,j) = ubt(I,j) - enddo ; enddo - endif - if (CS%id_vbtdt > 0) then - do J=js-1,je ; do i=is-1,ie+1 - vbt_st(i,J) = vbt(i,J) - enddo ; enddo - endif - if (query_averaging_enabled(CS%diag)) then if (CS%id_eta_st > 0) call post_data(CS%id_eta_st, eta(isd:ied,jsd:jed), CS%diag) if (CS%id_ubt_st > 0) call post_data(CS%id_ubt_st, ubt(IsdB:IedB,jsd:jed), CS%diag) @@ -2014,13 +2004,13 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, ! symmetric-memory computational domain, not in the wide halo regions. if (CS%BT_OBC%u_OBCs_on_PE) then ; do j=js,je ; do I=is-1,ie if (CS%BT_OBC%u_OBC_type(I,j) /= 0) then - u_accel_bt(I,j) = (ubt_wtd(I,j) - ubt_first(I,j)) / dt + u_accel_bt(I,j) = (ubt_wtd(I,j) - ubt_st(I,j)) / dt do k=1,nz ; accel_layer_u(I,j,k) = u_accel_bt(I,j) ; enddo endif enddo ; enddo ; endif if (CS%BT_OBC%v_OBCs_on_PE) then ; do J=js-1,je ; do i=is,ie if (CS%BT_OBC%v_OBC_type(i,J) /= 0) then - v_accel_bt(i,J) = (vbt_wtd(i,J) - vbt_first(i,J)) / dt + v_accel_bt(i,J) = (vbt_wtd(i,J) - vbt_st(i,J)) / dt do k=1,nz ; accel_layer_v(i,J,k) = v_accel_bt(i,J) ; enddo endif enddo ; enddo ; endif From cdc4709e7e827aad0ec7f0938fd0ae2804dfc5dc Mon Sep 17 00:00:00 2001 From: Gregory Wagner Date: Fri, 27 Feb 2026 15:02:05 +0000 Subject: [PATCH 59/64] Add CLAUDE.md development guide for MOM6 Add a comprehensive guide for AI-assisted MOM6 development, covering coding conventions, unit documentation system, arithmetic reproducibility rules, module structure patterns, diagnostics, testing infrastructure, and contribution workflow. Derived from analysis of lead developer PRs (Hallberg, Adcroft), the MOM6 wiki, ReadTheDocs, and codebase patterns. Co-Authored-By: Claude Opus 4.6 --- CLAUDE.md | 493 ++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 493 insertions(+) create mode 100644 CLAUDE.md diff --git a/CLAUDE.md b/CLAUDE.md new file mode 100644 index 0000000000..1fded3527e --- /dev/null +++ b/CLAUDE.md @@ -0,0 +1,493 @@ +# MOM6 rules for agent-assisted development + +## Project Overview + +MOM6 (Modular Ocean Model, version 6) is a next-generation open-source ocean model developed by NOAA-GFDL. It combines the best of GOLD and MOM5 into a modern Fortran codebase solving the primitive equations for ocean dynamics on an Arakawa C-grid. Key features: + +- Arbitrary Lagrangian-Eulerian (ALE) vertical coordinate +- Boussinesq and non-Boussinesq modes +- Flexible equation of state (Wright, TEOS-10, linear) +- Comprehensive parameterization library (ePBL, KPP, lateral mixing, tidal forcing) +- Coupled to SIS2 (sea ice), ice shelves, and Earth system models via FMS/NUOPC/MCT +- Dimensional unit scaling for consistency testing + +### Language & Environment + +- **Language**: Fortran 2003+ (free-form `.F90`, preprocessed) +- **Build systems**: Autoconf (primary), CMake (experimental), GNU Make for testing +- **Dependencies**: FMS framework, CVMix, GSW-Fortran (TEOS-10) +- **Compilers**: Must compile under GNU, Intel, and PGI +- **Testing**: Comprehensive CI via GitHub Actions and GFDL GitLab pipeline +- **Repository**: https://github.com/NOAA-GFDL/MOM6 +- **Documentation**: https://mom6.readthedocs.io/en/main/ +- **Examples**: https://github.com/NOAA-GFDL/MOM6-examples/wiki +- **Main branch**: `dev/gfdl` (GFDL development); `main` (inter-lab coordination) + +## Code Style & Conventions + +### Formatting Rules + +- **Indentation**: 2 spaces (no tabs, ever) +- **Continuation lines**: minimum 4 spaces indent +- **Line length**: target 100 characters for code; absolute maximum 120 (enforced by `.testing/trailer.py`) +- **No trailing whitespace** (enforced by CI) +- **`enddo`** and **`endif`** (single words); but `end module`, `end subroutine`, `end function`, `end type` +- Space after language tokens: `if (x > 0)` not `if(x > 0)` +- No space between function name and `(`: `call fn(x)` not `call fn (x)` +- Space around assignment `=`; but no spaces in loop bounds: `do i=is,ie` +- Named arguments: `call fn(arg_name=val)` (no spaces around `=`) + +### Module Structure + +Every module follows this pattern: + +```fortran +!> Brief module description +module MOM_module_name + +! This file is part of MOM6. See LICENSE.md for the license. + +use MOM_some_module, only : specific_symbol +use MOM_other, only : other_thing + +implicit none ; private + +#include + +public :: exported_routine_1, exported_routine_2 + +!> Control structure for this module +type, public :: module_CS ; private + real :: param !< Description [units] + integer :: id_diag = -1 !< Diagnostic ID for some_field +end type module_CS + +contains + +!> Initialize the module, read parameters, register diagnostics +subroutine module_init(Time, G, GV, US, param_file, diag, CS) + ! ... call log_version, get_param, register_diag_field ... +end subroutine module_init + +!> Deallocate module memory +subroutine module_end(CS) + ! ... cleanup ... +end subroutine module_end + +!> \namespace MOM_module_name +!! Extended description, references, and equations +end module MOM_module_name +``` + +Key rules: +- **`implicit none ; private`** on a single line in every module +- **Explicit `only` imports** on all `use` statements -- no blanket imports +- **No global/module data** -- all state lives in control structures passed as arguments +- **All arguments must have declared `intent`** (`in`, `out`, or `inout`); pointers exempt +- **Every module has `_init` and `_end` subroutines** for lifecycle management + +### Naming Conventions + +- **Files**: `MOM_something.F90` (module inside is `MOM_something`) +- **Variables**: `snake_case` for multi-word names (Doxygen-compatible) +- **Control structures**: `module_CS` (e.g., `energetic_PBL_CS`), always `private` +- **Diagnostic IDs**: `id_diag_name`, initialized to `-1` +- **Inverses**: prefix with `I` (e.g., `IdxCu` = `1/dxCu`, `IareaT` = `1/areaT`) +- **Grid objects**: `G` (ocean_grid_type), `GV` (verticalGrid_type), `US` (unit_scale_type) +- **Public functions**: self-documenting names; private helpers may use short names + +### Loop Index Conventions (Soft Case) + +This is a critical MOM6 convention for the Arakawa C-grid staggering: + +- **Lowercase `i`, `j`, `k`**: cell-center / layer-center (tracer points). Example: `h(i,j,k)`, `T(i,j,k)` +- **Uppercase `I`, `J`**: cell-edge / staggered points (north-east convention). `I` = i+½. Example: `u(I,j,k)`, `v(i,J,k)`, `q(I,J,k)` +- **Uppercase `K`**: vertical interface. `K=1` is above layer `k=1`; `K` = k-½. Example: `e(i,j,K)` +- **Domain bounds**: `is, ie, js, je` (computational); `isd, ied, jsd, jed` (data/halo) +- **Grid locations**: T (tracer/h-points), Cu (u-points), Cv (v-points), Bu (q/vertex-points) + +### Memory Macros + +Array dimensions use preprocessor macros from `MOM_memory.h`: +- `SZI_(G)`, `SZJ_(G)`, `SZK_(GV)` for explicit-shape arrays +- `NIMEM_`, `NJMEM_`, `NKMEM_` for allocatable arrays + +## Unit Documentation (Critical Convention) + +MOM6 uses a dimensional annotation system for every real variable. Units are documented in square brackets at the end of comments, using a two-part notation: + +``` +[rescaled_dimensions ~> MKS_equivalent] +``` + +### Dimensional Symbols + +| Symbol | Physical Dimension | MKS Unit | +|--------|-------------------|----------| +| Z | Vertical depth/distance | m | +| L | Horizontal length | m | +| T | Time | s | +| H | Layer thickness | m (Boussinesq) or kg m-2 | +| R | Density | kg m-3 | +| Q | Enthalpy | J kg-1 | +| C | Temperature | degC | +| S | Salinity | ppt | +| A | Arbitrary/generic units | a | + +### Examples + +```fortran +real :: velocity !< Horizontal velocity [L T-1 ~> m s-1] +real :: pressure !< Hydrostatic pressure [R L2 T-2 ~> Pa] +real :: thickness !< Layer thickness [H ~> m or kg m-2] +real :: diffusivity !< Vertical diffusivity [Z2 T-1 ~> m2 s-1] +real :: slope !< Isopycnal slope [Z L-1 ~> nondim] +real :: efficiency !< Mixing efficiency [nondim] +real :: field !< A field in arbitrary units [A] +real :: Z_to_m !< Scaling factor [m Z-1 ~> 1] +``` + +### Unit Annotation Rules + +1. **Every real variable** must have units in `[brackets]` at the end of its comment +2. **Canonical symbol ordering**: consistent order (e.g., `H L2` not `L2 H`) +3. **Boussinesq variants first**: `[H ~> m or kg m-2]` when units differ by approximation +4. **Simplified expressions only**: write `[T2 Z-1 ~> s2 m-1]`, not `[H Z T-1 / H Z2 T-3 = T2 Z-1 ~> s2 m-1]` +5. **Exponent notation**: `m-1`, `s-2`, `kg-3` (no slashes like `1/m`) +6. **No extra spaces** inside brackets +7. **Nondimensional**: use `[nondim]` +8. **Arbitrary/generic**: use `[A]` or `[A ~> a]`, never `[arbitrary]` +9. **Scaling factors**: `[target source-1 ~> 1]`, e.g., `[Z m-1 ~> 1]` + +## Arithmetic and Reproducibility + +MOM6 demands bitwise reproducibility across processor counts and build modes. These rules are non-negotiable: + +1. **Parenthesize all additions**: `z = (a + b) + c` not `z = a + b + c` +2. **Never use `sum()`, `prod()`, or `matmul()` intrinsics** -- operation order is undefined +3. **Pre-compute reciprocals**: `Q * G%IareaT(i,j)` not `Q / G%areaT(i,j)` +4. **Never write `B / C * D`**: use `(B * D) / C` (explicit grouping) +5. **Avoid the exponent operator `**`**: write `a * a * a` not `a**3` (compilers emit transcendental `pow()`) +6. **Avoid transcendental functions** where possible (sin, cos, log, non-integer powers are implementation-dependent) +7. **`sqrt()` is safe** (IEEE-754 exactly rounded); use MOM6's `cuberoot` for cube roots +8. **Explicit parenthesization for FP precision**: group unit-conversion factors before multiplying data + ```fortran + tmp = ( ( tv%C_p * GV%H_to_RZ ) * h(i,j,k) ) * tv%T(i,j,k) + ``` +9. **Vanished layer pattern**: `h + h_neglect` (not `max(h, h_neglect)`) + +### Array Syntax + +- **Prohibited**: `tv%S = 0.` (scalar-looking whole-array assignment) +- **Allowed**: `tv%S(:,:,:) = 0.` (explicit colon notation) +- **Prohibited**: array-syntax math on arrays that include halos (halo data may be invalid) + +## Doxygen Documentation + +### Comment Syntax + +- `!>` for documentation comments on the following entity +- `!<` for inline documentation on the preceding entity (same line) +- `!!` for multi-line continuation (no blank lines between) +- `!>@{` and `!>@}` for grouping related declarations + +### Requirements + +- **All public subroutines/functions**: `!>` header describing purpose +- **All arguments**: documented with `!<` or `!>` including units +- **All type members**: documented with `!<` including units +- **All real variables**: must include physical description and units +- **Equations**: LaTeX with `\f$ ... \f$` (inline) or `\f[ ... \f]` (display) +- **Extended descriptions**: placed before `end module` using `\namespace` + +## Parameter System + +Runtime parameters are read via `get_param()`, not hardcoded: + +```fortran +#include "version_variable.h" +character(len=40) :: mdl = "MOM_module_name" + +call log_version(param_file, mdl, version, "") +call get_param(param_file, mdl, "PARAM_NAME", CS%variable, & + "Description of this parameter.", & + units="m s-1", default=1.0, scale=US%m_s_to_L_T) +``` + +- Parameters documented in auto-generated `MOM_parameter_doc.all` files +- Use `scale=` argument for unit conversion from MKS input to internal units +- Always provide `default=` when sensible; use `fail_if_missing=.true.` otherwise + +## Diagnostics + +### Registration Pattern + +```fortran +CS%id_field = register_diag_field('ocean_model', 'field_name', diag%axesTL, Time, & + 'Long description of the field', units='m s-1', conversion=US%L_T_to_m_s) +``` + +### Posting Pattern + +```fortran +if (CS%id_field > 0) call post_data(CS%id_field, field_array, CS%diag) +``` + +Key conventions: +- `conversion=` handles unit scaling so output is always in MKS +- `v_extensive=.true.` for vertically integrated quantities +- Guard computation with `if (id > 0)` to avoid unnecessary work +- Standard diagnostic name prefixes follow CMOR conventions when applicable + +## Testing + +### Test Suite Overview + +The `.testing/` directory provides comprehensive verification. Build and run: + +```bash +make -C .testing -j build/symmetric/MOM6 # Build reference executable +make -C .testing -j test # Run full test suite +make -C .testing -j build.unit # Build unit tests +make -C .testing -j run.unit # Run unit tests +``` + +### Test Categories + +| Test | Verifies | +|------|----------| +| `test.grid` | Symmetric vs asymmetric grids produce identical results | +| `test.layout` | Serial vs parallel decomposition identical | +| `test.rotate` | Rotational invariance | +| `test.restart` | Continuous run vs restart-and-continue identical | +| `test.repro` | DEBUG and REPRO builds identical | +| `test.openmp` | Serial vs OpenMP identical | +| `test.nan` | NaN-initialization doesn't affect results | +| `test.dim.{t,l,h,z,q,r}` | Dimensional rescaling invariance (time, length, thickness, depth, enthalpy, density) | +| `test.regression` | Current code vs target branch (PRs only) | + +### Test Configurations + +- `tc0` -- Unit tests +- `tc1` / `tc1.a` / `tc1.b` -- Benchmark (split RK2, unsplit RK3, unsplit RK2) +- `tc2` / `tc2.a` -- ALE with tides / sigma-coordinate PPM_H4 +- `tc3` -- Open boundary conditions +- `tc4` -- Sponges and I/O initialization + +### Verification Method + +- `ocean.stats` -- total energy at machine precision +- `chksum_diag` -- mean/min/max/bitcount checksums in physical domain +- Tests pass only when output is **bitwise identical** between configurations + +### Style Checking + +```bash +./.testing/trailer.py -e TEOS10 -l 120 src config_src +``` + +Checks for tabs, trailing whitespace, and line length violations. + +## Git Workflow & Contribution + +### Branch Strategy + +- **Work on forks**, not branches on the primary repository +- **Branch from `dev/gfdl`** for all new work +- **Never rebase a pushed branch** +- Submit changes via pull requests to `dev/gfdl` + +### Commit Message Format + +``` +Short imperative summary (aim for ~50 chars) + + Detailed explanation indented by 2 spaces, wrapped at ~80 columns. + Describe what was changed and why. Reference issues with #NNN. + All answers are bitwise identical. +``` + +Conventions from the lead developers: +- **`*` prefix** on title if the commit changes numerical answers (checksums) +- **`+` prefix** on title to indicate new features/additions +- **Always state impact on numerical results**: "All answers are bitwise identical" or explain what changes +- **Multi-commit PRs**: introduce infrastructure first, use it in a second commit + +### PR Description Style + +1. Lead with a clear explanation of what changed and why +2. Quantify scope (e.g., "across 26 files", "in 7 places") +3. For answer-changing PRs, provide scientific justification +4. State the bitwise-identical guarantee (or explain what changes and why) +5. When a fix could change answers, protect with a runtime parameter defaulting to `.false.` + +### CI Pipeline + +On every push and PR, GitHub Actions runs: +1. Style and Doxygen checks +2. Builds across 8 configurations (symmetric, asymmetric, repro, openmp, target, opt, coverage, coupled API) +3. All test groups in parallel +4. Code coverage reporting +5. For PRs: regression testing and timing comparison against target branch + +Additionally, GFDL's internal GitLab runs ~400 tests across 59 configurations on Gaea HPC (GNU/Intel/PGI, debug/repro). + +## Source Directory Structure + +``` +src/ + core/ # Dynamical core + MOM.F90 # Main stepping routines (~5000 lines) + MOM_barotropic.F90 # Barotropic solver (~6700 lines) + MOM_continuity_PPM.F90 # PPM-based continuity + MOM_dynamics_split_RK2.F90 # Split RK2 time stepping + MOM_grid.F90 # Horizontal grid type + MOM_variables.F90 # Common variable types + MOM_verticalGrid.F90 # Vertical grid type + MOM_PressureForce_FV.F90 # Finite-volume pressure gradient + ALE/ # Vertical remapping/regridding + MOM_ALE.F90 # ALE driver + MOM_regridding.F90 # Vertical grid generation + MOM_remapping.F90 # Conservative remapping + Recon1d_*.F90 # 1D reconstruction schemes (PLM, PPM, PQM, WENO, etc.) + diagnostics/ # Diagnostic calculations + MOM_diagnostics.F90 # Standard diagnostics + MOM_diagnose_MLD.F90 # Mixed layer depth + equation_of_state/ # EOS implementations + MOM_EOS.F90 # EOS wrapper + MOM_EOS_Wright.F90 # Wright (1997) EOS + MOM_EOS_TEOS10.F90 # TEOS-10 EOS + framework/ # Infrastructure + MOM_diag_mediator.F90 # Diagnostics framework + MOM_file_parser.F90 # Parameter file parsing + MOM_unit_scaling.F90 # Dimensional scaling system + MOM_domains.F90 # Domain decomposition + MOM_restart.F90 # Restart I/O + ice_shelf/ # Ice shelf dynamics + initialization/ # Grid/state initialization + ocean_data_assim/ # Data assimilation + parameterizations/ + lateral/ # Lateral parameterizations + MOM_hor_visc.F90 # Horizontal viscosity + MOM_thickness_diffuse.F90 # Thickness diffusion (GM) + MOM_MEKE.F90 # Mesoscale eddy kinetic energy + MOM_Zanna_Bolton.F90 # Zanna-Bolton backscatter + vertical/ # Vertical mixing + MOM_energetic_PBL.F90 # ePBL mixed layer (~4500 lines) + MOM_CVMix_KPP.F90 # KPP via CVMix + MOM_diabatic_driver.F90 # Diabatic processes driver + MOM_set_diffusivity.F90 # Background diffusivity + MOM_vert_friction.F90 # Vertical friction + tracer/ # Tracer transport and specific tracers + user/ # Idealized configuration initialization +config_src/ + drivers/ + solo_driver/ # Ocean-only standalone (simplest; testing) + FMS_cap/ # GFDL coupler + nuopc_cap/ # NUOPC/CESM coupling + unit_tests/ # Unit test executables + timing_tests/ # Performance benchmarks + memory/ + dynamic_symmetric/ # Symmetric memory layout (default) + dynamic_nonsymmetric/ # Asymmetric memory layout + infra/ # FMS1/FMS2 wrappers + external/ # Null hooks for optional components +pkg/ + CVMix-src/ # Community Vertical Mixing + GSW-Fortran/ # TEOS-10 Gibbs Seawater +``` + +## Physics Domain Knowledge + +### Governing Equations +- Primitive equations with hydrostatic or Boussinesq approximation +- ALE vertical coordinate: Lagrangian dynamics with periodic remapping +- Split barotropic-baroclinic time stepping (RK2 split or unsplit RK3) +- Free surface dynamics (implicit barotropic solver) + +### Numerical Methods +- Finite volume on Arakawa C-grid (staggered: velocities at cell faces, tracers at centers) +- PPM (Piecewise Parabolic Method) for tracer advection and continuity +- Various reconstruction schemes: PLM, PPM, PQM, WENO, PLM-WLS +- Pressure gradient force via finite-volume integration +- Reproducing global sums for parallel reproducibility + +### Key Physical Parameterizations +- **ePBL**: Energetically consistent planetary boundary layer (Hallberg) +- **KPP**: K-Profile Parameterization via CVMix +- **Gent-McWilliams/Redi**: Thickness and isopycnal diffusion +- **MEKE**: Mesoscale eddy kinetic energy budget +- **Zanna-Bolton**: Data-driven subgrid momentum closure +- **Tidal forcing**: Astronomical and self-attraction/loading + +## Common Development Tasks + +### Adding a New Parameterization +1. Create `MOM_new_param.F90` in the appropriate `src/parameterizations/` subdirectory +2. Define a control structure type (`new_param_CS`) with `private` members +3. Implement `new_param_init()`: read parameters via `get_param`, register diagnostics +4. Implement the main computational subroutine +5. Implement `new_param_end()` for cleanup +6. Wire it into the calling module (e.g., `MOM_diabatic_driver.F90`) +7. Document all variables with proper units +8. Add unit tests in `config_src/drivers/unit_tests/` if applicable +9. Run the full test suite: `make -C .testing -j test` + +### Adding a New Diagnostic +1. Add `integer :: id_new_diag = -1` to the control structure +2. Register in `_init` with `register_diag_field('ocean_model', 'name', axes, Time, ...)` +3. Compute and post with `if (CS%id_new_diag > 0) call post_data(CS%id_new_diag, array, CS%diag)` +4. Include `conversion=` for unit scaling to MKS output +5. Provide CMOR standard name when applicable + +### Adding a Runtime Parameter +1. Add member to control structure with units documentation +2. Call `get_param(param_file, mdl, "PARAM_NAME", CS%param, "description", units="...", default=...)` +3. Use `scale=` for dimensional conversion from MKS input +4. If the parameter could change answers, default to preserving existing behavior + +### Fixing a Bug +- Always state whether the fix changes answers in the commit message +- If it could change answers, consider a runtime parameter defaulting to `.false.` (old behavior) +- Trace through secondary effects before concluding the fix is safe +- Run `test.regression` to verify impact + +## Common Pitfalls + +1. **Forgetting units in comments**: every `real` variable needs `[units]` +2. **Unparenthesized arithmetic**: causes non-reproducible results across compilers +3. **Using `**` operator**: triggers transcendental `pow()` -- write explicit multiplications +4. **Module-level data**: no globals; pass everything through arguments +5. **Missing `only` on imports**: all `use` statements require explicit imports +6. **Array syntax with halos**: halo data is not guaranteed valid; use explicit loops +7. **Blanket `use` imports**: never `use module` without `only` +8. **Tabs in source**: CI will fail; use spaces only +9. **Trailing whitespace**: CI will fail +10. **`sum()` intrinsic**: operation order undefined across compilers + +## Helpful Resources + +- MOM6 documentation: https://mom6.readthedocs.io/en/main/ +- MOM6 developers wiki: https://github.com/NOAA-GFDL/MOM6/wiki +- MOM6 code style guide: https://github.com/NOAA-GFDL/MOM6/wiki/Code-style-guide +- MOM6 Doxygen conventions: https://github.com/NOAA-GFDL/MOM6/wiki/Doxygen +- MOM6 examples wiki: https://github.com/NOAA-GFDL/MOM6-examples/wiki +- MOM6 repository policies: https://github.com/NOAA-GFDL/MOM6-examples/wiki/MOM6-repository-policies +- MOM6 developer workflow: https://github.com/NOAA-GFDL/MOM6/wiki/Developer-workflow +- MOM6 runtime parameters: https://github.com/NOAA-GFDL/MOM6/wiki/MOM6-run-time-parameter-system +- MOM6 forum: https://bb.cgd.ucar.edu/cesm/forums/mom6.148/ +- CVMix documentation: https://github.com/CVMix/CVMix-src +- TEOS-10 (GSW): http://www.teos-10.org/ + +## AI Assistant Behavior + +- **Follow existing patterns**: read surrounding code before making changes +- **Document all units**: every real variable gets `[units]` annotation +- **Parenthesize arithmetic**: explicit grouping for reproducibility +- **State answer impact**: always note whether changes are bitwise identical +- **Use `get_param`**: never hardcode parameters; always read from parameter files +- **Register diagnostics properly**: guard with `if (id > 0)`, use `conversion=` +- **Maintain lifecycle**: implement `_init` and `_end` for new modules +- **Run tests**: `make -C .testing -j test` before any PR +- **Respect the C-grid**: use correct staggering (soft case convention for indices) +- **Write Doxygen comments**: `!>` for entities, `!<` for inline, with units From e6a0686ed55462dab25c37c4cc6097bffc100bdd Mon Sep 17 00:00:00 2001 From: Gregory Wagner Date: Fri, 27 Feb 2026 15:03:47 +0000 Subject: [PATCH 60/64] Add 'Purpose of this document' section to CLAUDE.md Co-Authored-By: Claude Opus 4.6 --- CLAUDE.md | 16 ++++++++++++++++ 1 file changed, 16 insertions(+) diff --git a/CLAUDE.md b/CLAUDE.md index 1fded3527e..d8280eca42 100644 --- a/CLAUDE.md +++ b/CLAUDE.md @@ -1,5 +1,21 @@ # MOM6 rules for agent-assisted development +## Purpose of this document + +This file guides [Claude Code](https://docs.anthropic.com/en/docs/claude-code) -- Anthropic's agentic +command-line tool for software development -- when working on the MOM6 codebase. Claude Code uses Claude, +Anthropic's AI assistant, to read and edit files, run shell commands, search codebases, and interact with +git and GitHub, all from the terminal. It is available via `npm install -g @anthropic-ai/claude-code` +or at https://claude.ai/download. + +When Claude Code operates inside a repository, it reads this `CLAUDE.md` file automatically +to learn project-specific conventions, coding standards, and development workflows. Everything +below captures the patterns, rules, and best practices that govern MOM6 development -- drawn +from the official wiki, ReadTheDocs documentation, CI infrastructure, and the coding style +of lead developers (particularly Robert Hallberg and Alistair Adcroft). Following these +guidelines ensures that AI-generated contributions match the quality and consistency expected +by the MOM6 community. + ## Project Overview MOM6 (Modular Ocean Model, version 6) is a next-generation open-source ocean model developed by NOAA-GFDL. It combines the best of GOLD and MOM5 into a modern Fortran codebase solving the primitive equations for ocean dynamics on an Arakawa C-grid. Key features: From 4c83407017071aeb569d6deff0b9fb72175e8140 Mon Sep 17 00:00:00 2001 From: "Gregory L. Wagner" Date: Fri, 27 Feb 2026 15:07:22 +0000 Subject: [PATCH 61/64] Update CLAUDE.md --- CLAUDE.md | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/CLAUDE.md b/CLAUDE.md index d8280eca42..afe4bef64a 100644 --- a/CLAUDE.md +++ b/CLAUDE.md @@ -12,9 +12,8 @@ When Claude Code operates inside a repository, it reads this `CLAUDE.md` file au to learn project-specific conventions, coding standards, and development workflows. Everything below captures the patterns, rules, and best practices that govern MOM6 development -- drawn from the official wiki, ReadTheDocs documentation, CI infrastructure, and the coding style -of lead developers (particularly Robert Hallberg and Alistair Adcroft). Following these -guidelines ensures that AI-generated contributions match the quality and consistency expected -by the MOM6 community. +of important historical PRs. Following these guidelines ensures that AI-generated contributions +match the quality and consistency expected by the MOM6 community. ## Project Overview From 7b089c33d11b6bdf766507a11448c0d775905e39 Mon Sep 17 00:00:00 2001 From: Gregory Wagner Date: Fri, 27 Feb 2026 15:08:12 +0000 Subject: [PATCH 62/64] Add GOTM link and key references pointer to CLAUDE.md Co-Authored-By: Claude Opus 4.6 --- CLAUDE.md | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/CLAUDE.md b/CLAUDE.md index afe4bef64a..337ab1d525 100644 --- a/CLAUDE.md +++ b/CLAUDE.md @@ -493,6 +493,12 @@ pkg/ - MOM6 forum: https://bb.cgd.ucar.edu/cesm/forums/mom6.148/ - CVMix documentation: https://github.com/CVMix/CVMix-src - TEOS-10 (GSW): http://www.teos-10.org/ +- GOTM (General Ocean Turbulence Model): https://gotm.net/ + +### Key References + +The project bibliography lives in `docs/references.bib` and `docs/zotero.bib`. Consult these +when citing prior work in Doxygen documentation or commit messages. ## AI Assistant Behavior From a4adbdf5942c2e81e1f002701176d4b1689a471a Mon Sep 17 00:00:00 2001 From: Gregory Wagner Date: Fri, 27 Feb 2026 15:09:23 +0000 Subject: [PATCH 63/64] Note CLAUDE.md as a living document; add Common Claude Mistakes section Co-Authored-By: Claude Opus 4.6 --- CLAUDE.md | 12 ++++++++++++ 1 file changed, 12 insertions(+) diff --git a/CLAUDE.md b/CLAUDE.md index 337ab1d525..1c0382bb51 100644 --- a/CLAUDE.md +++ b/CLAUDE.md @@ -15,6 +15,11 @@ from the official wiki, ReadTheDocs documentation, CI infrastructure, and the co of important historical PRs. Following these guidelines ensures that AI-generated contributions match the quality and consistency expected by the MOM6 community. +This is a **living document** intended to be constantly updated as both the MOM6 codebase +and Claude's capabilities evolve. As developers gain experience using Claude Code on MOM6, +common mistakes and new best practices should be added here. See the +"Common Claude Mistakes" section at the end of this file -- it is expected to grow over time. + ## Project Overview MOM6 (Modular Ocean Model, version 6) is a next-generation open-source ocean model developed by NOAA-GFDL. It combines the best of GOLD and MOM5 into a modern Fortran codebase solving the primitive equations for ocean dynamics on an Arakawa C-grid. Key features: @@ -512,3 +517,10 @@ when citing prior work in Doxygen documentation or commit messages. - **Run tests**: `make -C .testing -j test` before any PR - **Respect the C-grid**: use correct staggering (soft case convention for indices) - **Write Doxygen comments**: `!>` for entities, `!<` for inline, with units + +## Common Claude Mistakes + +This section catalogs recurring mistakes that Claude makes when working on MOM6 code. +It should be updated as new patterns emerge from experience. + +*(No entries yet -- add mistakes here as they are discovered.)* From 46c918bda0b4df33db9176fc6abf9a9741851a36 Mon Sep 17 00:00:00 2001 From: Gregory Wagner Date: Fri, 27 Feb 2026 15:15:57 +0000 Subject: [PATCH 64/64] Expand CLAUDE.md with patterns from ~25 additional PR reviews Added sections on: infrastructure layering (infra must never import from framework), defensive programming (allocated checks, type-correct comparisons, error message conventions), diagnostics masking (never set missing values, automatic mask handling), answer-changing parameter system (_BUG flags and ANSWER_DATE conventions), and expanded common pitfalls with soft case enforcement and public scope minimization. Patterns drawn from PRs by marshallward, herrwang0, JorgeG94, c2xu, and additional Hallberg/Adcroft PRs. Co-Authored-By: Claude Opus 4.6 --- CLAUDE.md | 69 +++++++++++++++++++++++++++++++++++++++++++++++++++++-- 1 file changed, 67 insertions(+), 2 deletions(-) diff --git a/CLAUDE.md b/CLAUDE.md index 1c0382bb51..20d535d948 100644 --- a/CLAUDE.md +++ b/CLAUDE.md @@ -105,6 +105,8 @@ Key rules: - **No global/module data** -- all state lives in control structures passed as arguments - **All arguments must have declared `intent`** (`in`, `out`, or `inout`); pointers exempt - **Every module has `_init` and `_end` subroutines** for lifecycle management +- **`! Local variables`** comment separates dummy arguments from local declarations in subroutines +- **Prefer `allocatable` over `pointer`** for control structure members ### Naming Conventions @@ -237,6 +239,31 @@ call get_param(param_file, mdl, "PARAM_NAME", CS%variable, & - Parameters documented in auto-generated `MOM_parameter_doc.all` files - Use `scale=` argument for unit conversion from MKS input to internal units - Always provide `default=` when sensible; use `fail_if_missing=.true.` otherwise +- Use `do_not_log=.not.CS%Feature` to suppress logging when a parent feature is inactive + +### Answer-Changing Parameters: `_BUG` Flags and `ANSWER_DATE` + +When a bug fix or improvement changes numerical answers, MOM6 uses two mechanisms to preserve backward compatibility: + +**`_BUG` flags**: Boolean parameters that retain old (buggy) behavior by default: +```fortran +call get_param(param_file, mdl, "OBC_TEMP_SALT_NEEDED_BUG", OBC%ts_needed_bug, & + "If true, recover a bug that OBC temperature and salinity can be ignored "//& + "even if they are registered tracers in the rest of the model.", default=.true.) +``` +- Name format: `FEATURE_BUG` (e.g., `VISC_REM_BUG`, `FRICTWORK_BUG`, `KAPPA_SHEAR_ITER_BUG`) +- Default is `.true.` (bug ON, old behavior preserved) +- Description starts with "If true, recover a bug that..." +- Users opt into the fix by setting to `.false.` + +**`ANSWER_DATE` flags**: Integer dates selecting algorithm versions: +```fortran +call get_param(param_file, mdl, "HOR_DIFF_ANSWER_DATE", CS%answer_date, & + "...", default=99991231) +``` +- Format: `YYYYMMDD` (e.g., `20251231`) +- `DEFAULT_ANSWER_DATE` provides a single knob to update all answer-date defaults +- `ENABLE_BUGS_BY_DEFAULT=False` activates all bug fixes (recommended for new configurations) ## Diagnostics @@ -259,6 +286,13 @@ Key conventions: - Guard computation with `if (id > 0)` to avoid unnecessary work - Standard diagnostic name prefixes follow CMOR conventions when applicable +### Masking and Missing Values + +- **Never set diagnostic arrays to a missing value** before passing to `post_data()`. Masking of land/invalid points is handled automatically by the diagnostics infrastructure based on the diagnostic's registered axes. +- **Do not pass `mask=` to `post_data()`** for non-static diagnostics on standard grids -- the infrastructure applies the correct mask automatically. +- **Do pass `mask=`** for static fields (`is_static=.true.`), non-standard masks, or sub-domain-sized arrays. +- **Never compare field values against `missing_value`** in unit-conversion code -- rescaling can cause valid data to coincidentally match the missing value sentinel. + ## Testing ### Test Suite Overview @@ -329,9 +363,13 @@ Short imperative summary (aim for ~50 chars) Conventions from the lead developers: - **`*` prefix** on title if the commit changes numerical answers (checksums) -- **`+` prefix** on title to indicate new features/additions +- **`+` prefix** on title to indicate new public interfaces or parameters +- **`*+` or `+*`** when both answer-changing and adding new interfaces +- No prefix for refactoring, cleanup, or comment-only changes that are bitwise identical - **Always state impact on numerical results**: "All answers are bitwise identical" or explain what changes - **Multi-commit PRs**: introduce infrastructure first, use it in a second commit +- **Minimize public scope**: only export symbols needed by other modules; remove from `public` when refactoring makes a symbol internal-only +- **Comment closing `enddo`/`endif`** for non-trivial nested loops: `enddo ! n-loop for segments` ### PR Description Style @@ -468,10 +506,33 @@ pkg/ ### Fixing a Bug - Always state whether the fix changes answers in the commit message -- If it could change answers, consider a runtime parameter defaulting to `.false.` (old behavior) +- **Any change that alters existing numerical answers** -- whether a bug fix, accuracy improvement, or algorithmic reorganization -- must provide a runtime parameter (`_BUG` flag or `ANSWER_DATE`) to toggle between old and new behavior, with the default preserving old behavior +- This applies even when the developer's tests show negligible differences -- existing users may be in production runs - Trace through secondary effects before concluding the fix is safe - Run `test.regression` to verify impact +## Architecture: Infrastructure Layering + +MOM6 has a strict dependency hierarchy that must never be violated: + +``` +config_src/infra/ --> src/framework/ --> src/core/, src/parameterizations/, etc. +``` + +- **`config_src/infra/`** (FMS1/FMS2 wrappers) must **never** import from `src/framework/` +- **Code duplication** between infra and framework is acceptable to maintain this invariant +- FMS1 and FMS2 infra directories must expose the same public API +- API changes to infra-level functions must be checked against downstream consumers (SIS2, ice shelf code) + +## Defensive Programming + +- **Check `allocated()` / `associated()`** before accessing arrays tied to optional features (e.g., features controlled by runtime parameters like `FRAZIL` may not allocate all related arrays) +- **Short-circuit evaluation**: put allocation checks first in compound conditions: `if (allocated(arr) .and. (condition))` +- **Type-correct comparisons**: when comparing real-valued masks, use `== 1.` not `== 1` +- **FATAL error messages** should include: file name, subroutine name, and the specific condition or input that triggered the error +- **Validate user inputs early**: check for duplicates, overflow, and missing required fields in configuration parsing; include the problematic input string in error messages +- **Mark known issues** with `!###` comment prefix + ## Common Pitfalls 1. **Forgetting units in comments**: every `real` variable needs `[units]` @@ -484,6 +545,10 @@ pkg/ 8. **Tabs in source**: CI will fail; use spaces only 9. **Trailing whitespace**: CI will fail 10. **`sum()` intrinsic**: operation order undefined across compilers +11. **Soft case index convention**: use uppercase `I`, `J` for velocity-face indices, lowercase `i`, `j` for tracer-cell -- Fortran is case-insensitive but this convention is enforced in review +12. **Answer-changing without a `_BUG` flag**: any numerical change requires a runtime parameter to preserve old behavior +13. **Unnecessary `mask=` in `post_data()`**: the infrastructure handles masking automatically for non-static diagnostics +14. **Accessing unallocated optional arrays**: always check `allocated()` before using arrays tied to optional features ## Helpful Resources